summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Roxborough <irox@redhat.com>2001-09-09 22:40:53 +0000
committerIan Roxborough <irox@redhat.com>2001-09-09 22:40:53 +0000
commita850c17c374d03259483e799b09326d255e17487 (patch)
treef1d024951a993f0453aa49d4ba808d6c38fa4321
parent57e8350a3895a1579b77cc134d6d7d49b056678e (diff)
downloadgdb-a850c17c374d03259483e799b09326d255e17487.tar.gz
Tcl 8.3 upgradeTCL_8_3
-rw-r--r--tcl/ChangeLog4623
-rw-r--r--tcl/Makefile.in9
-rw-r--r--tcl/README471
-rw-r--r--tcl/changes1317
-rw-r--r--tcl/compat/README1
-rw-r--r--tcl/compat/getcwd.c47
-rw-r--r--tcl/compat/stdlib.h2
-rw-r--r--tcl/compat/strftime.c15
-rw-r--r--tcl/compat/string.h4
-rw-r--r--tcl/compat/waitpid.c12
-rwxr-xr-xtcl/configure38
-rw-r--r--tcl/configure.in10
-rw-r--r--tcl/cygtcl.m4310
-rw-r--r--tcl/doc/Access.371
-rw-r--r--tcl/doc/AddErrInfo.337
-rw-r--r--tcl/doc/AppInit.32
-rw-r--r--tcl/doc/AssocData.32
-rw-r--r--tcl/doc/Async.314
-rw-r--r--tcl/doc/BackgdErr.32
-rw-r--r--tcl/doc/Backslash.328
-rw-r--r--tcl/doc/ByteArrObj.391
-rw-r--r--tcl/doc/ChnlStack.390
-rw-r--r--tcl/doc/CrtChannel.3299
-rw-r--r--tcl/doc/CrtInterp.316
-rw-r--r--tcl/doc/CrtMathFnc.32
-rw-r--r--tcl/doc/CrtObjCmd.324
-rw-r--r--tcl/doc/CrtSlave.32
-rw-r--r--tcl/doc/DString.38
-rw-r--r--tcl/doc/DumpActiveMemory.368
-rw-r--r--tcl/doc/Encoding.3522
-rw-r--r--tcl/doc/Eval.3189
-rw-r--r--tcl/doc/Exit.345
-rw-r--r--tcl/doc/ExprLong.37
-rw-r--r--tcl/doc/FindExec.35
-rw-r--r--tcl/doc/GetCwd.354
-rw-r--r--tcl/doc/GetHostName.329
-rw-r--r--tcl/doc/GetIndex.334
-rw-r--r--tcl/doc/GetInt.33
-rw-r--r--tcl/doc/GetOpnFl.33
-rw-r--r--tcl/doc/GetVersion.349
-rw-r--r--tcl/doc/Hash.32
-rw-r--r--tcl/doc/Init.337
-rw-r--r--tcl/doc/InitStubs.391
-rw-r--r--tcl/doc/Interp.34
-rw-r--r--tcl/doc/LinkVar.33
-rw-r--r--tcl/doc/ListObj.324
-rw-r--r--tcl/doc/Notifier.3136
-rw-r--r--tcl/doc/Object.316
-rw-r--r--tcl/doc/OpenFileChnl.3383
-rw-r--r--tcl/doc/OpenTcp.39
-rw-r--r--tcl/doc/ParseCmd.3439
-rw-r--r--tcl/doc/PkgRequire.347
-rw-r--r--tcl/doc/RecEvalObj.39
-rw-r--r--tcl/doc/RecordEval.33
-rw-r--r--tcl/doc/RegExp.3253
-rw-r--r--tcl/doc/SaveResult.365
-rw-r--r--tcl/doc/SetErrno.317
-rw-r--r--tcl/doc/SetRecLmt.32
-rw-r--r--tcl/doc/SetResult.319
-rw-r--r--tcl/doc/SetVar.3209
-rw-r--r--tcl/doc/SourceRCFile.338
-rw-r--r--tcl/doc/SplitList.323
-rw-r--r--tcl/doc/StaticPkg.314
-rw-r--r--tcl/doc/StrMatch.320
-rw-r--r--tcl/doc/StringObj.3162
-rw-r--r--tcl/doc/TCL_MEM_DEBUG.381
-rw-r--r--tcl/doc/Tcl.n66
-rw-r--r--tcl/doc/TclInitStubs.391
-rw-r--r--tcl/doc/Thread.3195
-rw-r--r--tcl/doc/ToUpper.390
-rw-r--r--tcl/doc/TraceVar.343
-rw-r--r--tcl/doc/Translate.311
-rw-r--r--tcl/doc/UpVar.34
-rw-r--r--tcl/doc/Utf.3233
-rw-r--r--tcl/doc/WrongNumArgs.33
-rw-r--r--tcl/doc/array.n15
-rw-r--r--tcl/doc/binary.n37
-rw-r--r--tcl/doc/catch.n56
-rw-r--r--tcl/doc/clock.n41
-rw-r--r--tcl/doc/dde.n135
-rw-r--r--tcl/doc/encoding.n79
-rw-r--r--tcl/doc/exec.n64
-rw-r--r--tcl/doc/expr.n97
-rw-r--r--tcl/doc/fconfigure.n193
-rw-r--r--tcl/doc/file.n75
-rw-r--r--tcl/doc/filename.n8
-rw-r--r--tcl/doc/format.n6
-rw-r--r--tcl/doc/glob.n89
-rw-r--r--tcl/doc/http.n184
-rw-r--r--tcl/doc/info.n4
-rw-r--r--tcl/doc/interp.n26
-rw-r--r--tcl/doc/library.n169
-rw-r--r--tcl/doc/lindex.n6
-rw-r--r--tcl/doc/linsert.n20
-rw-r--r--tcl/doc/load.n18
-rw-r--r--tcl/doc/lreplace.n34
-rw-r--r--tcl/doc/lsearch.n3
-rw-r--r--tcl/doc/lsort.n35
-rw-r--r--tcl/doc/man.macros2
-rw-r--r--tcl/doc/memory.n82
-rw-r--r--tcl/doc/msgcat.n244
-rw-r--r--tcl/doc/namespace.n61
-rw-r--r--tcl/doc/open.n44
-rw-r--r--tcl/doc/package.n12
-rw-r--r--tcl/doc/packagens.n53
-rw-r--r--tcl/doc/pkgMkIndex.n81
-rw-r--r--tcl/doc/puts.n4
-rw-r--r--tcl/doc/re_syntax.n932
-rw-r--r--tcl/doc/read.n34
-rw-r--r--tcl/doc/regexp.n177
-rw-r--r--tcl/doc/registry.n8
-rw-r--r--tcl/doc/regsub.n40
-rw-r--r--tcl/doc/resource.n12
-rw-r--r--tcl/doc/safe.n17
-rw-r--r--tcl/doc/scan.n103
-rw-r--r--tcl/doc/seek.n8
-rw-r--r--tcl/doc/socket.n13
-rw-r--r--tcl/doc/string.n269
-rw-r--r--tcl/doc/switch.n11
-rw-r--r--tcl/doc/tclsh.13
-rw-r--r--tcl/doc/tcltest.n759
-rw-r--r--tcl/doc/tclvars.n70
-rw-r--r--tcl/doc/tell.n10
-rw-r--r--tcl/doc/trace.n4
-rw-r--r--tcl/doc/update.n3
-rw-r--r--tcl/doc/upvar.n22
-rw-r--r--tcl/doc/variable.n4
-rw-r--r--tcl/doc/vwait.n6
-rw-r--r--tcl/generic/patchlevel.h23
-rw-r--r--tcl/generic/regc_color.c778
-rw-r--r--tcl/generic/regc_cvec.c198
-rw-r--r--tcl/generic/regc_lex.c1061
-rw-r--r--tcl/generic/regc_locale.c930
-rw-r--r--tcl/generic/regc_nfa.c1575
-rw-r--r--tcl/generic/regcomp.c2175
-rw-r--r--tcl/generic/regcustom.h114
-rw-r--r--tcl/generic/rege_dfa.c677
-rw-r--r--tcl/generic/regerror.c109
-rw-r--r--tcl/generic/regerrs.h18
-rw-r--r--tcl/generic/regex.h341
-rw-r--r--tcl/generic/regexec.c1038
-rw-r--r--tcl/generic/regfree.c53
-rw-r--r--tcl/generic/regfronts.c83
-rw-r--r--tcl/generic/regguts.h418
-rw-r--r--tcl/generic/tcl.decls1489
-rw-r--r--tcl/generic/tcl.h1417
-rw-r--r--tcl/generic/tclAlloc.c312
-rw-r--r--tcl/generic/tclAsync.c15
-rw-r--r--tcl/generic/tclBasic.c1517
-rw-r--r--tcl/generic/tclBinary.c900
-rw-r--r--tcl/generic/tclCkalloc.c375
-rw-r--r--tcl/generic/tclClock.c126
-rw-r--r--tcl/generic/tclCmdAH.c1534
-rw-r--r--tcl/generic/tclCmdIL.c653
-rw-r--r--tcl/generic/tclCmdMZ.c2722
-rw-r--r--tcl/generic/tclCompCmds.c2023
-rw-r--r--tcl/generic/tclCompExpr.c2588
-rw-r--r--tcl/generic/tclCompile.c8181
-rw-r--r--tcl/generic/tclCompile.h500
-rw-r--r--tcl/generic/tclDate.c664
-rw-r--r--tcl/generic/tclDecls.h3462
-rw-r--r--tcl/generic/tclEncoding.c2767
-rw-r--r--tcl/generic/tclEnv.c463
-rw-r--r--tcl/generic/tclEvent.c584
-rw-r--r--tcl/generic/tclExecute.c2443
-rw-r--r--tcl/generic/tclExpr.c2061
-rw-r--r--tcl/generic/tclFCmd.c117
-rw-r--r--tcl/generic/tclFHandle.c259
-rw-r--r--tcl/generic/tclFileName.c1083
-rw-r--r--tcl/generic/tclGet.c72
-rw-r--r--tcl/generic/tclGetDate.y396
-rw-r--r--tcl/generic/tclHash.c5
-rw-r--r--tcl/generic/tclHistory.c24
-rw-r--r--tcl/generic/tclIO.c7688
-rw-r--r--tcl/generic/tclIO.h379
-rw-r--r--tcl/generic/tclIOCmd.c734
-rw-r--r--tcl/generic/tclIOGT.c1359
-rw-r--r--tcl/generic/tclIOSock.c35
-rw-r--r--tcl/generic/tclIOUtil.c154
-rw-r--r--tcl/generic/tclIndexObj.c174
-rw-r--r--tcl/generic/tclInitScript.h93
-rw-r--r--tcl/generic/tclInt.decls870
-rw-r--r--tcl/generic/tclInt.h1026
-rw-r--r--tcl/generic/tclIntDecls.h1394
-rw-r--r--tcl/generic/tclIntPlatDecls.h535
-rw-r--r--tcl/generic/tclInterp.c4528
-rw-r--r--tcl/generic/tclLink.c39
-rw-r--r--tcl/generic/tclListObj.c13
-rw-r--r--tcl/generic/tclLiteral.c1062
-rw-r--r--tcl/generic/tclLoad.c259
-rw-r--r--tcl/generic/tclLoadNone.c38
-rw-r--r--tcl/generic/tclMain.c206
-rw-r--r--tcl/generic/tclNamesp.c270
-rw-r--r--tcl/generic/tclNotify.c537
-rw-r--r--tcl/generic/tclObj.c374
-rw-r--r--tcl/generic/tclPanic.c123
-rw-r--r--tcl/generic/tclParse.c2606
-rw-r--r--tcl/generic/tclParseExpr.c1852
-rw-r--r--tcl/generic/tclPatch.h23
-rw-r--r--tcl/generic/tclPipe.c125
-rw-r--r--tcl/generic/tclPkg.c631
-rw-r--r--tcl/generic/tclPlatDecls.h152
-rw-r--r--tcl/generic/tclPort.h8
-rw-r--r--tcl/generic/tclPosixStr.c11
-rw-r--r--tcl/generic/tclPreserve.c215
-rw-r--r--tcl/generic/tclProc.c216
-rw-r--r--tcl/generic/tclRegexp.c1029
-rw-r--r--tcl/generic/tclRegexp.h69
-rw-r--r--tcl/generic/tclResult.c1052
-rw-r--r--tcl/generic/tclScan.c1133
-rw-r--r--tcl/generic/tclStringObj.c1221
-rw-r--r--tcl/generic/tclStubInit.c817
-rw-r--r--tcl/generic/tclStubLib.c117
-rw-r--r--tcl/generic/tclStubs.c3267
-rw-r--r--tcl/generic/tclTest.c1984
-rw-r--r--tcl/generic/tclTestObj.c254
-rw-r--r--tcl/generic/tclThread.c580
-rw-r--r--tcl/generic/tclThreadTest.c967
-rw-r--r--tcl/generic/tclTimer.c386
-rw-r--r--tcl/generic/tclUniData.c586
-rw-r--r--tcl/generic/tclUtf.c1586
-rw-r--r--tcl/generic/tclUtil.c1596
-rw-r--r--tcl/generic/tclVar.c1124
-rw-r--r--tcl/library/auto.tcl587
-rwxr-xr-xtcl/library/dde1.0/pkgIndex.tcl1
-rw-r--r--tcl/library/dde1.1/pkgIndex.tcl5
-rw-r--r--tcl/library/encoding/ascii.enc20
-rw-r--r--tcl/library/encoding/big5.enc1516
-rw-r--r--tcl/library/encoding/cp1250.enc20
-rw-r--r--tcl/library/encoding/cp1251.enc20
-rw-r--r--tcl/library/encoding/cp1252.enc20
-rw-r--r--tcl/library/encoding/cp1253.enc20
-rw-r--r--tcl/library/encoding/cp1254.enc20
-rw-r--r--tcl/library/encoding/cp1255.enc20
-rw-r--r--tcl/library/encoding/cp1256.enc20
-rw-r--r--tcl/library/encoding/cp1257.enc20
-rw-r--r--tcl/library/encoding/cp1258.enc20
-rw-r--r--tcl/library/encoding/cp437.enc20
-rw-r--r--tcl/library/encoding/cp737.enc20
-rw-r--r--tcl/library/encoding/cp775.enc20
-rw-r--r--tcl/library/encoding/cp850.enc20
-rw-r--r--tcl/library/encoding/cp852.enc20
-rw-r--r--tcl/library/encoding/cp855.enc20
-rw-r--r--tcl/library/encoding/cp857.enc20
-rw-r--r--tcl/library/encoding/cp860.enc20
-rw-r--r--tcl/library/encoding/cp861.enc20
-rw-r--r--tcl/library/encoding/cp862.enc20
-rw-r--r--tcl/library/encoding/cp863.enc20
-rw-r--r--tcl/library/encoding/cp864.enc20
-rw-r--r--tcl/library/encoding/cp865.enc20
-rw-r--r--tcl/library/encoding/cp866.enc20
-rw-r--r--tcl/library/encoding/cp869.enc20
-rw-r--r--tcl/library/encoding/cp874.enc20
-rw-r--r--tcl/library/encoding/cp932.enc785
-rw-r--r--tcl/library/encoding/cp936.enc2162
-rw-r--r--tcl/library/encoding/cp949.enc2128
-rw-r--r--tcl/library/encoding/cp950.enc1499
-rw-r--r--tcl/library/encoding/dingbats.enc20
-rw-r--r--tcl/library/encoding/euc-cn.enc1397
-rw-r--r--tcl/library/encoding/euc-jp.enc1346
-rw-r--r--tcl/library/encoding/euc-kr.enc1533
-rw-r--r--tcl/library/encoding/gb12345.enc1414
-rw-r--r--tcl/library/encoding/gb1988.enc20
-rw-r--r--tcl/library/encoding/gb2312.enc1380
-rw-r--r--tcl/library/encoding/iso2022-jp.enc12
-rw-r--r--tcl/library/encoding/iso2022-kr.enc7
-rw-r--r--tcl/library/encoding/iso2022.enc16
-rw-r--r--tcl/library/encoding/iso8859-1.enc20
-rw-r--r--tcl/library/encoding/iso8859-2.enc20
-rw-r--r--tcl/library/encoding/iso8859-3.enc20
-rw-r--r--tcl/library/encoding/iso8859-4.enc20
-rw-r--r--tcl/library/encoding/iso8859-5.enc20
-rw-r--r--tcl/library/encoding/iso8859-6.enc20
-rw-r--r--tcl/library/encoding/iso8859-7.enc20
-rw-r--r--tcl/library/encoding/iso8859-8.enc20
-rw-r--r--tcl/library/encoding/iso8859-9.enc20
-rw-r--r--tcl/library/encoding/jis0201.enc20
-rw-r--r--tcl/library/encoding/jis0208.enc1312
-rw-r--r--tcl/library/encoding/jis0212.enc1159
-rw-r--r--tcl/library/encoding/koi8-r.enc20
-rw-r--r--tcl/library/encoding/ksc5601.enc1516
-rw-r--r--tcl/library/encoding/macCentEuro.enc20
-rw-r--r--tcl/library/encoding/macCroatian.enc20
-rw-r--r--tcl/library/encoding/macCyrillic.enc20
-rw-r--r--tcl/library/encoding/macDingbats.enc20
-rw-r--r--tcl/library/encoding/macGreek.enc20
-rw-r--r--tcl/library/encoding/macIceland.enc20
-rw-r--r--tcl/library/encoding/macJapan.enc785
-rw-r--r--tcl/library/encoding/macRoman.enc20
-rw-r--r--tcl/library/encoding/macRomania.enc20
-rw-r--r--tcl/library/encoding/macThai.enc20
-rw-r--r--tcl/library/encoding/macTurkish.enc20
-rw-r--r--tcl/library/encoding/macUkraine.enc20
-rw-r--r--tcl/library/encoding/shiftjis.enc683
-rw-r--r--tcl/library/encoding/symbol.enc20
-rw-r--r--tcl/library/history.tcl4
-rw-r--r--tcl/library/http1.0/http.tcl2
-rw-r--r--tcl/library/init.tcl1125
-rw-r--r--tcl/library/ldAout.tcl365
-rw-r--r--tcl/library/msgcat1.0/msgcat.tcl202
-rw-r--r--tcl/library/msgcat1.0/pkgIndex.tcl1
-rw-r--r--tcl/library/opt0.4/optparse.tcl1090
-rw-r--r--tcl/library/opt0.4/pkgIndex.tcl11
-rw-r--r--tcl/library/package.tcl632
-rwxr-xr-xtcl/library/reg1.0/pkgIndex.tcl7
-rw-r--r--tcl/library/safe.tcl355
-rw-r--r--tcl/library/safeinit.tcl461
-rw-r--r--tcl/library/tclIndex59
-rw-r--r--tcl/library/tcltest1.0/pkgIndex.tcl18
-rw-r--r--tcl/library/tcltest1.0/tcltest.tcl1906
-rw-r--r--tcl/library/word.tcl28
-rw-r--r--tcl/mac/MW_TclAppleScriptHeader.h7
-rw-r--r--tcl/mac/MW_TclAppleScriptHeader.pch8
-rw-r--r--tcl/mac/MW_TclHeader.h7
-rw-r--r--tcl/mac/MW_TclHeader.pch2
-rw-r--r--tcl/mac/MW_TclTestHeader.h7
-rw-r--r--tcl/mac/MW_TclTestHeader.pch54
-rw-r--r--tcl/mac/README172
-rw-r--r--tcl/mac/bugs.doc12
-rw-r--r--tcl/mac/tclMac.h65
-rw-r--r--tcl/mac/tclMacAlloc.c2
-rw-r--r--tcl/mac/tclMacAppInit.c10
-rw-r--r--tcl/mac/tclMacApplication.r6
-rw-r--r--tcl/mac/tclMacBOAAppInit.c2
-rw-r--r--tcl/mac/tclMacBOAMain.c25
-rw-r--r--tcl/mac/tclMacChan.c172
-rw-r--r--tcl/mac/tclMacExit.c2
-rw-r--r--tcl/mac/tclMacFCmd.c497
-rw-r--r--tcl/mac/tclMacFile.c881
-rw-r--r--tcl/mac/tclMacInit.c648
-rw-r--r--tcl/mac/tclMacInt.h51
-rw-r--r--tcl/mac/tclMacLibrary.c8
-rw-r--r--tcl/mac/tclMacLibrary.r10
-rw-r--r--tcl/mac/tclMacLoad.c61
-rw-r--r--tcl/mac/tclMacNotify.c170
-rw-r--r--tcl/mac/tclMacOSA.c34
-rw-r--r--tcl/mac/tclMacOSA.r4
-rw-r--r--tcl/mac/tclMacPort.h269
-rw-r--r--tcl/mac/tclMacProjects.sea.hqx4765
-rw-r--r--tcl/mac/tclMacResource.c85
-rw-r--r--tcl/mac/tclMacResource.r8
-rw-r--r--tcl/mac/tclMacShLib.exp11
-rw-r--r--tcl/mac/tclMacSock.c377
-rw-r--r--tcl/mac/tclMacTclCode.r37
-rw-r--r--tcl/mac/tclMacTest.c29
-rw-r--r--tcl/mac/tclMacThrd.c829
-rw-r--r--tcl/mac/tclMacThrd.h20
-rw-r--r--tcl/mac/tclMacTime.c3
-rw-r--r--tcl/mac/tclMacUnix.c143
-rw-r--r--tcl/mac/tclMacUtil.c11
-rw-r--r--tcl/tests/README231
-rw-r--r--tcl/tests/all.tcl56
-rw-r--r--tcl/tests/append.test28
-rw-r--r--tcl/tests/assocd.test24
-rw-r--r--tcl/tests/async.test25
-rw-r--r--tcl/tests/autoMkindex.tcl21
-rw-r--r--tcl/tests/autoMkindex.test190
-rw-r--r--tcl/tests/basic.test230
-rw-r--r--tcl/tests/binary.test40
-rw-r--r--tcl/tests/case.test23
-rw-r--r--tcl/tests/clock.test278
-rw-r--r--tcl/tests/cmdAH.test863
-rw-r--r--tcl/tests/cmdIL.test63
-rw-r--r--tcl/tests/cmdInfo.test26
-rw-r--r--tcl/tests/cmdMZ.test413
-rw-r--r--tcl/tests/compExpr-old.test691
-rw-r--r--tcl/tests/compExpr.test342
-rw-r--r--tcl/tests/compile.test65
-rw-r--r--tcl/tests/concat.test23
-rw-r--r--tcl/tests/dcall.test26
-rw-r--r--tcl/tests/defs.tcl1091
-rw-r--r--tcl/tests/dstring.test25
-rw-r--r--tcl/tests/encoding.test318
-rw-r--r--tcl/tests/env.test162
-rw-r--r--tcl/tests/error.test23
-rw-r--r--tcl/tests/eval.test23
-rw-r--r--tcl/tests/event.test610
-rw-r--r--tcl/tests/exec.test432
-rw-r--r--tcl/tests/execute.test516
-rw-r--r--tcl/tests/expr-old.test47
-rw-r--r--tcl/tests/expr.test96
-rw-r--r--tcl/tests/fCmd.test577
-rw-r--r--tcl/tests/fileName.test422
-rw-r--r--tcl/tests/for-old.test22
-rw-r--r--tcl/tests/for.test179
-rw-r--r--tcl/tests/foreach.test38
-rw-r--r--tcl/tests/format.test274
-rw-r--r--tcl/tests/get.test41
-rw-r--r--tcl/tests/history.test25
-rw-r--r--tcl/tests/http.test380
-rw-r--r--tcl/tests/httpd215
-rw-r--r--tcl/tests/httpold.test189
-rw-r--r--tcl/tests/if-old.test23
-rw-r--r--tcl/tests/if.test602
-rw-r--r--tcl/tests/incr-old.test23
-rw-r--r--tcl/tests/incr.test279
-rw-r--r--tcl/tests/indexObj.test24
-rw-r--r--tcl/tests/info.test311
-rw-r--r--tcl/tests/init.test39
-rw-r--r--tcl/tests/interp.test209
-rw-r--r--tcl/tests/io.test2671
-rw-r--r--tcl/tests/ioCmd.test84
-rw-r--r--tcl/tests/ioUtil.test320
-rw-r--r--tcl/tests/iogt.test940
-rw-r--r--tcl/tests/join.test21
-rw-r--r--tcl/tests/lindex.test13
-rw-r--r--tcl/tests/link.test27
-rw-r--r--tcl/tests/linsert.test15
-rw-r--r--tcl/tests/list.test23
-rw-r--r--tcl/tests/listObj.test33
-rw-r--r--tcl/tests/llength.test23
-rw-r--r--tcl/tests/load.test110
-rw-r--r--tcl/tests/lrange.test15
-rw-r--r--tcl/tests/lreplace.test16
-rw-r--r--tcl/tests/lsearch.test29
-rw-r--r--tcl/tests/macFCmd.test166
-rw-r--r--tcl/tests/misc.test30
-rw-r--r--tcl/tests/msgcat.test413
-rw-r--r--tcl/tests/namespace-old.test23
-rw-r--r--tcl/tests/namespace.test70
-rw-r--r--tcl/tests/obj.test176
-rw-r--r--tcl/tests/opt.test48
-rw-r--r--tcl/tests/osa.test41
-rw-r--r--tcl/tests/package.test72
-rw-r--r--tcl/tests/parse.test1264
-rw-r--r--tcl/tests/parseExpr.test639
-rw-r--r--tcl/tests/parseOld.test552
-rw-r--r--tcl/tests/pid.test28
-rw-r--r--tcl/tests/pkg.test107
-rw-r--r--tcl/tests/pkg/import.tcl16
-rw-r--r--tcl/tests/pkg/license.terms39
-rw-r--r--tcl/tests/pkg/magicchar.tcl6
-rw-r--r--tcl/tests/pkg/magicchar2.tcl1
-rw-r--r--tcl/tests/pkg/samename.tcl25
-rw-r--r--tcl/tests/pkg/spacename.tcl3
-rw-r--r--tcl/tests/pkgMkIndex.test128
-rw-r--r--tcl/tests/platform.test41
-rw-r--r--tcl/tests/proc-old.test22
-rw-r--r--tcl/tests/proc.test23
-rw-r--r--tcl/tests/pwd.test23
-rw-r--r--tcl/tests/reg.test995
-rw-r--r--tcl/tests/regexp.test265
-rw-r--r--tcl/tests/registry.test330
-rw-r--r--tcl/tests/remote.tcl11
-rw-r--r--tcl/tests/rename.test21
-rw-r--r--tcl/tests/resource.test142
-rw-r--r--tcl/tests/result.test103
-rw-r--r--tcl/tests/safe.test111
-rw-r--r--tcl/tests/scan.test541
-rw-r--r--tcl/tests/security.test55
-rw-r--r--tcl/tests/set-old.test36
-rw-r--r--tcl/tests/set.test294
-rw-r--r--tcl/tests/socket.test554
-rw-r--r--tcl/tests/source.test56
-rw-r--r--tcl/tests/split.test23
-rw-r--r--tcl/tests/stack.test12
-rw-r--r--tcl/tests/string.test1176
-rw-r--r--tcl/tests/stringObj.test258
-rw-r--r--tcl/tests/subst.test25
-rw-r--r--tcl/tests/switch.test27
-rw-r--r--tcl/tests/tcltest.test407
-rw-r--r--tcl/tests/thread.test236
-rw-r--r--tcl/tests/timer.test103
-rw-r--r--tcl/tests/trace.test28
-rw-r--r--tcl/tests/unixFCmd.test197
-rw-r--r--tcl/tests/unixFile.test53
-rw-r--r--tcl/tests/unixInit.test209
-rw-r--r--tcl/tests/unixNotfy.test77
-rw-r--r--tcl/tests/unknown.test23
-rw-r--r--tcl/tests/uplevel.test23
-rw-r--r--tcl/tests/upvar.test23
-rw-r--r--tcl/tests/utf.test294
-rw-r--r--tcl/tests/util.test230
-rw-r--r--tcl/tests/var.test304
-rw-r--r--tcl/tests/while-old.test23
-rw-r--r--tcl/tests/while.test324
-rw-r--r--tcl/tests/winConsole.test53
-rw-r--r--tcl/tests/winDde.test169
-rw-r--r--tcl/tests/winFCmd.test427
-rw-r--r--tcl/tests/winFile.test80
-rw-r--r--tcl/tests/winNotify.test56
-rw-r--r--tcl/tests/winPipe.test314
-rw-r--r--tcl/tests/winTime.test51
-rw-r--r--tcl/tools/Makefile.in69
-rw-r--r--tcl/tools/README28
-rw-r--r--tcl/tools/checkLibraryDoc.tcl296
-rwxr-xr-xtcl/tools/configure749
-rw-r--r--tcl/tools/configure.in33
-rw-r--r--tcl/tools/cvtEOL.tcl35
-rw-r--r--tcl/tools/genStubs.tcl894
-rw-r--r--tcl/tools/genWinImage.tcl158
-rw-r--r--tcl/tools/index.tcl202
-rw-r--r--tcl/tools/man2help.tcl130
-rw-r--r--tcl/tools/man2help2.tcl970
-rw-r--r--tcl/tools/man2html.tcl181
-rw-r--r--tcl/tools/man2html1.tcl269
-rw-r--r--tcl/tools/man2html2.tcl871
-rw-r--r--tcl/tools/man2tcl.c405
-rw-r--r--tcl/tools/regexpTestLib.tcl266
-rw-r--r--tcl/tools/tcl.hpj.in19
-rw-r--r--tcl/tools/tcl.wse.in2356
-rw-r--r--tcl/tools/tclSplash.bmpbin0 -> 162030 bytes
-rwxr-xr-xtcl/tools/tcltk-man2html.tcl1675
-rw-r--r--tcl/tools/uniClass.tcl61
-rw-r--r--tcl/tools/uniParse.tcl386
-rw-r--r--tcl/tools/white.bmpbin0 -> 20522 bytes
-rw-r--r--tcl/unix/ChangeLog12
-rw-r--r--tcl/unix/Makefile.in698
-rw-r--r--tcl/unix/README77
-rw-r--r--tcl/unix/aclocal.m4537
-rw-r--r--tcl/unix/bp.c127
-rwxr-xr-xtcl/unix/configure4233
-rwxr-xr-xtcl/unix/configure.in1110
-rw-r--r--tcl/unix/dltest/Makefile.in22
-rw-r--r--tcl/unix/dltest/README3
-rwxr-xr-xtcl/unix/dltest/configure23
-rw-r--r--tcl/unix/dltest/configure.in16
-rw-r--r--tcl/unix/dltest/pkga.c64
-rw-r--r--tcl/unix/dltest/pkgb.c77
-rw-r--r--tcl/unix/dltest/pkgc.c69
-rw-r--r--tcl/unix/dltest/pkgd.c71
-rw-r--r--tcl/unix/dltest/pkge.c19
-rw-r--r--tcl/unix/dltest/pkgf.c9
-rwxr-xr-xtcl/unix/ldAix13
-rwxr-xr-xtcl/unix/mkLinks1208
-rw-r--r--tcl/unix/porting.old384
-rw-r--r--tcl/unix/tcl.m41882
-rw-r--r--tcl/unix/tcl.spec53
-rw-r--r--tcl/unix/tclAppInit.c63
-rw-r--r--tcl/unix/tclConfig.sh.in59
-rw-r--r--tcl/unix/tclLoadAix.c5
-rw-r--r--tcl/unix/tclLoadAout.c75
-rw-r--r--tcl/unix/tclLoadDl.c81
-rw-r--r--tcl/unix/tclLoadDl2.c113
-rw-r--r--tcl/unix/tclLoadDld.c46
-rw-r--r--tcl/unix/tclLoadDyld.c171
-rw-r--r--tcl/unix/tclLoadNext.c40
-rw-r--r--tcl/unix/tclLoadOSF.c41
-rw-r--r--tcl/unix/tclLoadShl.c56
-rw-r--r--tcl/unix/tclMtherr.c12
-rw-r--r--tcl/unix/tclUnixChan.c608
-rw-r--r--tcl/unix/tclUnixEvent.c3
-rw-r--r--tcl/unix/tclUnixFCmd.c933
-rw-r--r--tcl/unix/tclUnixFile.c758
-rw-r--r--tcl/unix/tclUnixInit.c647
-rw-r--r--tcl/unix/tclUnixNotfy.c679
-rw-r--r--tcl/unix/tclUnixPipe.c137
-rw-r--r--tcl/unix/tclUnixPort.h177
-rw-r--r--tcl/unix/tclUnixSock.c56
-rw-r--r--tcl/unix/tclUnixTest.c116
-rw-r--r--tcl/unix/tclUnixThrd.c726
-rw-r--r--tcl/unix/tclUnixThrd.h21
-rw-r--r--tcl/unix/tclUnixTime.c74
-rw-r--r--tcl/unix/tclXtNotify.c1322
-rw-r--r--tcl/unix/tclXtTest.c10
-rw-r--r--tcl/win/Makefile.in1076
-rw-r--r--tcl/win/README174
-rw-r--r--tcl/win/aclocal.m42
-rw-r--r--tcl/win/cat.c2
-rwxr-xr-xtcl/win/configure2233
-rwxr-xr-xtcl/win/configure.in295
-rw-r--r--tcl/win/license.terms2
-rw-r--r--tcl/win/makefile.vc473
-rw-r--r--tcl/win/mkd.bat5
-rw-r--r--tcl/win/rmd.bat4
-rw-r--r--tcl/win/stub16.c5
-rw-r--r--tcl/win/tcl.m4637
-rw-r--r--tcl/win/tcl.rc19
-rw-r--r--tcl/win/tclAppInit.c71
-rw-r--r--tcl/win/tclConfig.sh.in185
-rw-r--r--tcl/win/tclWin32Dll.c484
-rw-r--r--tcl/win/tclWinChan.c658
-rw-r--r--tcl/win/tclWinConsole.c1269
-rw-r--r--tcl/win/tclWinDde.c1351
-rw-r--r--tcl/win/tclWinError.c5
-rw-r--r--tcl/win/tclWinFCmd.c1065
-rw-r--r--tcl/win/tclWinFile.c1119
-rw-r--r--tcl/win/tclWinInit.c687
-rw-r--r--tcl/win/tclWinInt.h71
-rw-r--r--tcl/win/tclWinLoad.c121
-rw-r--r--tcl/win/tclWinMtherr.c15
-rw-r--r--tcl/win/tclWinNotify.c371
-rw-r--r--tcl/win/tclWinPipe.c2168
-rw-r--r--tcl/win/tclWinPort.h437
-rw-r--r--tcl/win/tclWinReg.c482
-rw-r--r--tcl/win/tclWinSerial.c1206
-rw-r--r--tcl/win/tclWinSock.c1097
-rw-r--r--tcl/win/tclWinTest.c72
-rw-r--r--tcl/win/tclWinThrd.c914
-rw-r--r--tcl/win/tclWinThrd.h23
-rw-r--r--tcl/win/tclWinTime.c129
-rw-r--r--tcl/win/tclWinUtil.c66
-rw-r--r--tcl/win/tclsh.icobin0 -> 3630 bytes
-rw-r--r--tcl/win/tclsh.rc19
594 files changed, 175553 insertions, 46908 deletions
diff --git a/tcl/ChangeLog b/tcl/ChangeLog
index c217f8dc24c..17a6b9308bd 100644
--- a/tcl/ChangeLog
+++ b/tcl/ChangeLog
@@ -1,179 +1,4567 @@
-2000-01-26 DJ Delorie <dj@cygnus.com>
+2001-08-08 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4 (TCL_TOOL_PATH, TCL_TOOL_SHARED_LIB_LONGNAME):
+ Raise an error if the CYGPATH variable is not defined when
+ TCL_TOOL_PATH is invoked. Add cygwin to the list of hosts
+ that do not use a "lib" prefix for shared library names.
+ * unix/configure: Regen.
+ * win/configure: Regen.
+
+2001-08-06 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4 (TCL_TOOL_STATIC_LIB_LONGNAME,
+ TCL_TOOL_SHARED_LIB_LONGNAME,
+ TCL_TOOL_LIB_SHORTNAME): Use TCL_VENDOR_PREFIX instead
+ of VENDORPREFIX to support using these macros in
+ extensions that load tclConfig.sh.
+ * unix/configure: Regen.
+ * unix/configure.in: Subst VENDORPREFIX into tclConfig.sh.
+ * unix/tclConfig.sh.in: Add TCL_VENDOR_PREFIX.
+ * win/configure: Regen.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Set vendor prefix to "rh"
+ instead of "sn" when compiling with VC++ or gcc. When
+ compiling with Cygwin set the prefix to "cyg". Set the
+ TCL_VENDOR_PREFIX to support the tcl tool macros in Tcl.
+ * win/tclConfig.sh.in: Add TCL_VENDOR_PREFIX.
+
+2001-08-06 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in: Subst DDE_DLL_FILE, DDE_LIB_FILE, REG_DLL_FILE,
+ REG_LIB_FILE, and PIPE_DLL_FILE from the configure script instead
+ of figuring them out in the Makefile.
+ * win/configure: Regen.
+ * win/configure.in: Use TCL_TOOL_STATIC_LIB_LONGNAME and
+ TCL_TOOL_SHARED_LIB_LONGNAME macros to figure out values for
+ DDE_DLL_FILE, DDE_LIB_FILE, REG_DLL_FILE, REG_LIB_FILE, and
+ PIPE_DLL_FILE and subst them into the Makefile.
+
+2001-08-01 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4 (TCL_TOOL_STATIC_LIB_LONGNAME,
+ TCL_TOOL_SHARED_LIB_LONGNAME): Rename
+ TCL_TOOL_LIB_LONGNAME to TCL_TOOL_STATIC_LIB_LONGNAME.
+ Add new TCL_TOOL_SHARED_LIB_LONGNAME to construct
+ shared library names in a cross platform way.
+ * unix/configure: Regen.
+ * unix/configure.in: Use TCL_TOOL_SHARED_LIB_LONGNAME
+ and TCL_TOOL_STATIC_LIB_LONGNAME to generate lib names.
+ * win/configure: Regen.
+ * win/configure.in: Use TCL_TOOL_SHARED_LIB_LONGNAME
+ and TCL_TOOL_STATIC_LIB_LONGNAME to generate lib names.
+
+2001-07-24 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't pass explicit
+ Cygwin libs on the command line since linking is now
+ done using $CC and not $LD.
+
+2001-07-24 Mo DeJong <mdejong@redhat.com>
+
+ * win/tclWinThrd.c (Tcl_CreateThread, TclpThreadExit):
+ When building under Cygwin, call CreateThread instead
+ of _beginthreadex and call ExitThread instead of
+ _endthreadex. Cygwin does not support these msvcrt
+ methods and does not suffer from the memory leak
+ problems that prompted their use.
+
+2001-07-24 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure: Regen.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Check for bug in
+ Cygwin version of windres and work around that
+ case by passing a POSIX path instead of a Windows
+ native path. One can't always pass a POSIX path
+ because the mingw native toolchain accepts only
+ Windows native paths.
+
+2001-07-24 Mo DeJong <mdejong@redhat.com>
+
+ * win/tclWinThrd.c (Tcl_CreateThread): Close Windows
+ HANDLE returned by _beginthreadex. The MS documentation
+ states that this handle is not closed by a later call to
+ _endthreadex.
+
+2001-07-16 Mo DeJong <mdejong@redhat.com>
+
+ * generic/tcl.h: Define __WIN32__ when
+ __CYGWIN__ or __MINGW32__ is defined.
+ * generic/tclAlloc.c: Define caddr_t when
+ compiling with VC++ or mingw. This type is
+ already defined when compiling with Cygwin.
+
+2001-07-16 Mo DeJong <mdejong@redhat.com>
+
+ * win/tclWinConsole.c:
+ * win/tclWinPipe.c:
+ * win/tclWinPort.h:
+ * win/tclWinThrd.c:
+ Remove unnecessary #includes of dos.h, direct.h,
+ and tchar.h. This will help the Cygwin porting
+ effort since these headers do not exist under Cygwin.
+
+2001-07-12 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in:
+ * unix/configure: Regen.
+ * unix/configure.in:
+ * unix/tcl.m4:
+ * win/Makefile.in:
+ * win/configure: Regen.
+ * win/configure.in:
+ * win/tcl.m4:
+ Revert ill-conceived EXTRA_CFLAGS changes made on 2001-07-09.
+ The change ended up causing big problems with the
+ tclConfig.sh file since it exported EXTRA_CFLAGS and did
+ not deal with the debug/non-debug case.
+
+2001-07-11 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Avoid using AC_CHECK_TOOL
+ since Tcl's configure script is not setup properly.
+
+2001-07-11 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Add AR variable for use in STLIB_LD.
+ * unix/configure: Regen.
+ * unix/configure.in: Use STLIB_LD when defining MAKE_LIB
+ and MAKE_STUB_LIB. Subst RANLIB and AR.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add doc comment about
+ STLIB_LD command. Check ${AR} env var when setting
+ STLIB_LD and delay evaluation until make time.
+ * win/configure: Regen.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Pass AR arguments in
+ STLIB_LD to better match the Unix implementation. Don't
+ bother defining AR when using VC++ since it is not used.
+
+2001-07-10 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Use STLIB_LD in MAKE_LIB instead
+ of AR which can be overridden on the make command line.
+
+2001-07-09 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Fix quoting of CYGPATH
+ argument to AC_CHECK_PROG.
+
+2001-07-09 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Add EXTRA_CFLAGS_DEBUG and EXTRA_CFLAGS_OPTIMIZE
+ variables. These two do not actually differ in the unix version
+ but are there to keep in sync with the Windows version.
+ * unix/configure: Regen.
+ * unix/configure.in: Don't subst EXTRA_CFLAGS. Subst EXTRA_CFLAGS_DEFAULT,
+ EXTRA_CFLAGS_DEBUG, and EXTRA_CFLAGS_OPTIMIZE.
+ * unix/tcl.m4 (SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS): Define
+ EXTRA_CFLAGS_DEFAULT based on the --enable-smbols option.
+ Set EXTRA_CFLAGS_DEBUG instead of EXTRA_CFLAGS and then set
+ EXTRA_CFLAGS_OPTIMIZE to the value of EXTRA_CFLAGS_DEBUG since
+ they are the same under Unix.
+ * win/Makefile.in: Add EXTRA_CFLAGS_DEBUG and EXTRA_CFLAGS_OPTIMIZE
+ variables. This is needed so that the proper runtime lib gets linked
+ into VC++ produced .obj files when CFLAGS is reset on the command line.
+ * win/configure: Regen.
+ * win/configure.in: Don't subst EXTRA_CFLAGS. Subst EXTRA_CFLAGS_DEFAULT,
+ EXTRA_CFLAGS_DEBUG, and EXTRA_CFLAGS_OPTIMIZE.
+ * win/tcl.m4 :(SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS): Define
+ EXTRA_CFLAGS_DEFAULT based on the --enable-smbols option. Set
+ EXTRA_CFLAGS_DEBUG and EXTRA_CFLAGS_OPTIMIZE based on the runtime
+ option when compiled with VC++.
+
+2001-07-06 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure: Regen.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Pass -e _WinMain@16 in
+ addition to the -mwindows flag to work around a problem
+ with ld when it incorrectly uses main() as the executable
+ entry point when both WinMain() and main() are available.
+
+2001-07-06 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/configure.in: Replace call to SC_ENABLE_GCC with
+ AC_PROG_CC so that CC passed in from the caller is respected.
+ * unix/tcl.m4: Remove the unused SC_ENABLE_GCC macro.
+ * win/configure: Regen.
+ * win/configure.in: Replace call to SC_ENABLE_GCC with
+ AC_PROG_CC so that CC passed in from the caller is respected.
+ * win/tcl.m4: Remove unused SC_ENABLE_GCC macro.
+
+2001-07-06 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in: Subst DEPARG directly instead
+ of relying on a variable. This will make Cygwin
+ builds faster since an extra exec will be avoided.
+ * win/configure: Regen.
+ * win/configure.in: Subst DEPARG.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Set DEPARG based
+ on CYGPATH.
+
+2001-06-26 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4 (TCL_TOOL_PATH): Use CYGPATH variable instead of
+ invoking cygpath directly. Handle cross compile by not
+ using CYGPATH when set to echo.
+ * unix/configure: Regen.
+ * win/Makefile.in: Remove PATHTYPE variable.
+ * win/configure: regen.
+ * win/configure.in: Remove PATHTYPE subst + extra CYGPATH subst.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove PATHTYPE variable. Search
+ for cygpath in the PATH and set CYGPATH="cygpath -w" if found.
+ Remove old cross compiling hack.
+
+2001-06-26 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in: Don't use VPSEP in the VPATH,
+ just use : as the spearator.
+ * win/configure: Regen.
+ * win/configure.in: Don't subst VPSEP.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove VPSEP.
+
+2001-06-25 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure: Regen.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): When building with
+ gcc, don't attempt to link with LD or support dllwrap.
+ Simply require a recent version of Cygwin gcc or Mingw
+ gcc that supports -shared. When linking, use gcc instead
+ of ld since gcc automatically includes libs like -lmsvcrt.
+
+2001-06-22 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@.
+ Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. Add LDFLAGS_DEBUG
+ and LDFLAGS_OPTIMIZE to match the way CFLAGS_DEFAULT works.
+ This will support user set CFLAGS or LDFLAGS at configure time.
+ * unix/configure: Regen.
+ * unix/configure.in: Don't set CFLAGS to CFLAGS_DEFAULT, instead
+ subst CFLAGS_DEFAULT into the Makefile. Add AC_SUBST for CFLAGS_DEFAULT,
+ LDFLAGS_DEFAULT, LDFLAGS_DEBUG, and LDFLAGS_OPTIMIZE.
+ * unix/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that
+ it uses a Makefile variable just like CFLAGS_DEFAULT.
+ * win/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@.
+ Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@.
+ This will support user set CFLAGS or LDFLAGS at configure time.
+ * win/configure: Regen.
+ * win/configure.in: Don't set CFLAGS or LDFLAGS, instead subst
+ CFLAGS_DEFAULT and LDFLAGS_DEFAULT into the Makefile.
+ * win/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that
+ it uses a Makefile variable just like CFLAGS_DEFAULT.
+
+2001-06-22 Mo DeJong <mdejong@redhat.com>
+
+ * configure: Regen.
+ * configure.in: When a windows32 host is detected
+ configure in the win subdirectory.
+ * cygtcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_LONGNAME,
+ TCL_TOOL_LIB_SHORTNAME, TCL_TOOL_LIB_SPEC):
+ Add support for mingw32 and windows32 hosts. Remove
+ check for cygwin since we are really cross compiling
+ when building win32 executables.
+ * unix/configure: Regen.
+ * win/configure: Regen.
+
+2001-06-22 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't set LDFLAGS_DEBUG
+ to -g or LDFLAGS_OPTIMIZE to -O when compiling with gcc.
+ These flags are not needed and can cause problems with
+ the Cygwin version of ld.
+
+2001-06-20 Mo DeJong <mdejong@redhat.com>
+
+ * generic/tcl.h: Define __WIN32__ when __MINGW32__
+ is defined to support building under Cygwin gcc
+ with the -mno-cygwin flag.
+
+2001-06-14 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Avoid burning install TCL_LIBRARY into
+ tclUnixInit.o at compile time.
+ * unix/tclUnixInit.c (TclpInitLibraryPath): Fix location
+ independence by searching for Tcl library in share/tclX.X
+ instead of lib/tclX.X. This logic is no longer effected by a
+ burned in TCL_LIBRARY.
+ * win/tclWinInit.c (TclpInitLibraryPath): Search for Tcl library
+ in share/tclX.X instead of lib/tclX.X. Remove a couple of
+ Cygnus local hacks since they were not doing anything useful.
+
+2001-06-08 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in: Set TCL_LIBRARY to
+ $INSTALL/share/tcl8.3 instead of
+ $INSTALL/lib/tcl8.3.
+
+2001-06-08 Mo DeJong <mdejong@redhat.com>
+
+ * win/tclConfig.sh.in: Correct the definition
+ of TCL_LIB_FULL_PATH. It was inclosed in `
+ characters instead of ' characters.
+
+2001-06-05 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add a TCL_LIB_SUFFIX variable
+ to make the TCL_TOOL_LIB_SHORTNAME macro happy.
+ * unix/tclConfig.sh.in: Add TCL_LIB_SUFFIX variable.
+
+2001-06-05 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4 (TCL_TOOL_LIB_PATH): Call TCL_TOOL_PATH so that a
+ Windows native path is generated for PATH variables.
+ * unix/configure: Regen.
+ * win/configure: Regen.
+
+2001-06-01 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_SHORTNAME): Check that argument to
+ TCL_TOOL_PATH is not "". Use new TCL_LIB_SUFFIX variable in the
+ TCL_TOOL_LIB_SHORTNAME macro under Windows.
+ * unix/configure: Regen.
+ * win/configure: Regen.
+ * win/configure.in: Don't subst SHLIB_SUFFIX.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Set TCL_LIB_SUFFIX so that Tcl
+ sees the same variable name that an extension will.
+ * win/tclConfig.sh.in: Set the TCL_SHLIB_SUFFIX and TCL_LIB_SUFFIX vars.
+
+2001-05-30 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4 (SC_PATH_TCLCONFIG, SC_PATH_TKCONFIG):
+ Check in win subdirectory in addition to unix subdirectory for
+ tclConfig.sh and tkConfig.sh files.
+
+2001-05-30 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4: Add FIXME note.
+ * unix/configure: Regen.
+ * unix/tcl.m4 (SC_PATH_TCLCONFIG, SC_PATH_TKCONFIG):
+ Generate an error instead of a warning if the Tcl, or Tk
+ configuration files cannot be found.
+
+2001-05-26 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_LONGNAME,
+ TCL_TOOL_LIB_SHORTNAME, TCL_TOOL_LIB_SPEC): Create cross
+ platform versions of the TCL_TOOL* macros.
+ * unix/aclocal.m4: Include ../cygtcl.m4.
+ * unix/configure: Regen.
+ * unix/tcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_LONGNAME,
+ TCL_TOOL_LIB_SHORTNAME, TCL_TOOL_LIB_SPEC): Remove macros.
+ * win/aclocal.m4: Include ../cygtcl.m4.
+ * win/configure: Regen.
+ * win/tcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_LONGNAME,
+ TCL_TOOL_LIB_SHORTNAME, TCL_TOOL_LIB_SPEC): Remove macros.
+
+2001-05-24 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/configure.in: Add missing TCL_LIB_FULL_PATH
+ variable.
+
+2001-05-11 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure:
+ * unix/tcl.m4 (SC_ENABLE_SYMBOLS):
+ * win/configure:
+ * win/tcl.m4 (SC_ENABLE_SYMBOLS): Back port of CFLAGS_DEFAULT fix
+ from Tcl 8.4. A Makefile variable name is now used for the CFLAGS.
+
+2001-05-09 Mo DeJong <mdejong@redhat.com>
+
+ * win/tcl.m4 (TCL_TOOL_PATH): Assign literal macro
+ value to a tmp variable before running cygpath
+ thus avoiding a problem with a quoted argument.
+
+2001-05-09 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Use TCL_STUB_LIB_FILE instead of
+ STUB_LIB_FILE subst when defining STUB_LIB_FILE.
+ * unix/configure: Regen.
+ * unix/configure.in: Use new path macros.
+ * unix/tcl.m4 (TCL_TOOL_LIB_LONGNAME, TCL_TOOL_LIB_SHORTNAME,
+ TCL_TOOL_LIB_SPEC, TCL_TOOL_LIB_PATH): Add macros
+ to deal with library path translations.
+ * win/Makefile.in: Add FIXME note.
+ * win/configure: Regen.
+ * win/configure.in: Use new path macros.
+ * win/tcl.m4 (TCL_TOOL_LIB_LONGNAME, TCL_TOOL_LIB_SHORTNAME,
+ TCL_TOOL_LIB_SPEC, TCL_TOOL_LIB_PATH): Add macros
+ to deal with library path translations.
+
+2001-04-09 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4: Add placeholder TCL_TOOL_PATH macro.
+ * win/configure: Regen.
+ * win/configure.in: Set TCL_LIB_FLAG, TCL_BUILD_LIB_SPEC,
+ TCL_LIB_SPEC, TCL_LIB_FULL_PATH and subst them.
+ * win/tcl.m4: Add TCL_TOOL_PATH macro, it will call
+ cygpath -w and replace \ with / to create a native
+ Windows path that VC++ will understand.
+ * win/tclConfig.sh.in: Add TCL_LIB_FULL_PATH variable.
+
+2001-04-05 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure: Regen.
+ * win/configure.in: Subst the TCL_LIB_VERSIONS_OK variable.
+ * win/tcl.m4: Add Cygnus local search for tcl8.1/win directory. Add
+ TCL_LIB_VERSIONS_OK variable, it will get substituted into the
+ tclConfig.sh file. Remve the SC_PROG_TCLSH macro.
+
+2001-04-05 Mo DeJong <mdejong@redhat.com>
+
+ * generic/tclAlloc.c:
+ * win/tclWinPort.h:
+ Check for #define of WIN32 instead of VC++ specific symbol.
+
+2001-03-31 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Remove second
+ assignment to SCRIPT_INSTALL_DIR
+ variable. This seems to have been
+ a merge error. It was installing
+ Tcl lib files in the lib directory
+ instead of share/tcl8.3.
+
+2001-03-28 Ian Roxborough <irox@redhat.com>
+
+ * unix/tclConfig.sh.in: Set TCL_CFLAGS to CFLAGS,
+ otherwise tclConfig.sh won't work correctly.
+
+2000-09-15 Syd Polk <spolk@redhat.com>
+
+ * Updated for the 8.3.2 release.
+
+2000-08-08 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ 8.3.2 RELEASE finalized
+
+ * changes: updated for release notes version of ChangeLog
+
+ * library/msgcat1.0/pkgIndex.tcl:
+ * library/msgcat1.0/msgcat.tcl: bumped msgcat version to 1.1.
+
+2000-08-07 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * doc/ChnlStack.3:
+ * doc/CrtChannel.3: updated the docs to be aware of the
+ TCL_CHANNEL_VERSION_2 style of Tcl channels.
+
+ * generic/tclIO.c (Tcl_CreateChannel): added assertion to verify
+ that the new channel versioning will be binary compatible with
+ older channel drivers.
+
+ * BACKPORTED FROM 8.4 (HEAD) BRANCH:
+
+ * doc/memory.n: Man page for Tcl "memory" command, which is
+ created when TCL_MEM_DEBUG is defined at compile time.
+
+ * doc/TCL_MEM_DEBUG.3: Man page with overall information about
+ TCL_MEM_DEBUG usage.
+
+ * doc/DumpActiveMemory.3: Man page for Tcl_DumpActiveMemory,
+ Tcl_InitMemory, and Tcl_ValidateAllMemory [Bug: 1816, 1835].
+
+ * doc/Init.3: Man page for Tcl_Init [Bug: 1820].
+
+ * unix/Makefile.in: add tclsh.ico and tcl.spec to dist target
+
+ * unix/mkLinks: Regen'd with new mkLinks.tcl.
+ * unix/mkLinks.tcl: Fixed indentation, made link setup more
+ intelligent (only do one existance test per man page, instead of
+ one per function).
+
+ * doc/AddErrInfo.3:
+ * doc/ChnlStack.3:
+ * doc/Exit.3:
+ * doc/GetIndex.3:
+ * doc/Notifier.3:
+ * doc/Object.3:
+ * doc/RegExp.3:
+ * doc/SetResult.3:
+ * doc/SplitList.3:
+ * doc/Thread.3: Added missing entries to NAME section.
+
+ * doc/AddErrInfo.3:
+ * doc/CrtObjCmd.3:
+ * doc/RecEvalObj.3: Changed Tcl_EvalObj to Tcl_EvalObjEx
+
+ * doc/library.n: Added entries for auto_qualify and auto_import
+ [Bug: 1271].
+ * doc/library.n: Fixed .SH NAME macro to include each function
+ documented on the page, so that mkLinks will know about the
+ functions listed there, and so that the Windows help file index
+ will get set up correctly [Bug: 1898, 5273].
+
+ * doc/expr.n: Added documentation for each of the math library
+ functions that expr supports [Bug: 1054].
+
+ * doc/regsub.n: correct regsub docs [Bug: 5346]
+
+ * doc/scan.n: minor doc fixes [Bug: 5396]
+
+ * doc/RegExp.3: Replaced instances of "Tcl_GetRegExpInfo" with
+ "Tcl_RegExpGetInfo", the correct name of the function [Bug: 5901].
+
+ * doc/package.n: Corrected information about [package forget]
+ arguments [Bug: 5418].
+
+ * generic/tclCkalloc.c: Fixed some function headers.
+
+ * tests/clock.test: Added test for "2 days 2 hours ago" style
+ specifications.
- * win/tclWin32Dll.c (DllMain): Use standard _imp__reent_data,
- not old-style __imp_reent_data
- * generic/tclEnv.c (environ): ditto for _imp____cygwin_environ
+ * generic/tclDate.c: Regenerated from tclGetDate.y.
-2000-01-17 Drew Moseley <dmoseley@cygnus.com>
+ * generic/tclGetDate.y: Tweaked grammar to properly handle the
+ "ago" keyword when it follows multiple relative unit specifiers,
+ as in "2 days 2 hours ago". [Bug: 5497].
- * cygwin/configure.in: Fixed bug in setting of shell variable which
- caused it to be interpreted as a subcommand rather than a variable.
- * cygwin/configure: Regenerated.
+ * generic/tclClock.c (FormatClock): correct code to handle locale
+ specific return values from strftime, if any. [Bug: 3345]
-1999-11-09 DJ Delorie <dj@cygnus.com>
+ * unix/tclUnixInit.c (TclpSetInitialEncodings): attempt to
+ correct setlocale calls for XIM support and locale issues.
+ [BUG: 5422 3345 4236 2522 2521]
- * cygwin/*: redone with automake for cygwin-specific info (from cgf)
- to support cross-host builds
+ * library/init.tcl (auto_import): added check to see if a valid
+ pattern was coming in, to avoid simple error cases [Bug: 3326]
-1999-10-26 DJ Delorie <dj@cygnus.com>
+ * library/history.tcl: Corrected an off-by-one error in HistIndex,
+ which was causing [history redo] to start its search at the wrong
+ event index. [Bug: 1269].
- * cygwin/*: new; replicate unix/* setup (other modules look
- in unix/* for "local" builds; we don't want them to find the
- cygwin version)
- * unix/Makefile.in: undo
- * configure.in: For cygwin, build win and cygwin
- * Makefile.in: re-enable multi-dir support
+ * generic/tclPosixStr.c (Tcl_SignalMsg): clarified #defines for
+ Linux on Sparc to compile correctly. [Bug: 5364]
-Tue Oct 26 13:16:09 1999 Christopher Faylor <cgf@cygnus.com>
+ * generic/tclEnv.c: cast cleanup [Bug: 5624]
+ * win/tclWinFCmd.c: cast cleanup [Bug: 5627]
- * win/configure.in: Add better detection of cross-compilation
- environment.
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Corrected
+ caching of the index ptr to account for offsets != sizeof(char *).
+ [Bug: 5153]
+
+ * tests/opt.test:
+ * library/opt0.4/optparse.tcl: Applied patch from [Bug: 5922], which
+ corrected an incorrect use of [string match].
+
+ * tests/stringObj.test: Tweaked tests to avoid hardcoded
+ high-ASCII characters (which will fail in multibyte locales);
+ instead used \uXXXX syntax. [Bug: 3842].
+
+2000-08-05 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclIOGT.c (TclChannelTransform): fixed segfault that
+ would occur when transforming a channel with a proc that did not
+ yet exist. (Kupries)
+
+ * generic/tclTest.c (TestChannelCmd): added some lint init'ing of
+ statePtr and chan vars.
+
+2000-07-28 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in:
+ * win/configure.in:
+ * win/tcl.m4:
+ * win/tclConfig.sh.in: Back port of gcc for windows
+ build system from 8.4.
+
+2000-07-26 Jeff Hobbs <hobbs@scriptics.com>
+
+ * merged core-8-3-1-io-rewrite back into core-8-3-1-branch.
+ The core-8-3-1-io-rewrite branch should now be considered defunct.
+
+ * generic/tclStubInit.c:
+ * generic/tclDecls.h:
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclIO.c: moved the Tcl_Channel* macros from tcl.h to
+ tclIO.c and made them proper stubbed functions. These are:
+ Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc,
+ Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc,
+ Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelSetOptionProc,
+ Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc,
+ Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc,
+ and Tcl_ChannelHandlerProc. These should be used to access the
+ Tcl_ChannelType structure instead of direct pointer dereferencing.
+
+ * unix/Makefile.in: undid 07-25 Makefile.in changes because we
+ don't really want to force all private makefiles on everyone.
+ This needs to be addressed again in the future. Best possible
+ solution is to create a tcl/ subdir in the installing include dir
+ (as is done already with the lib dir).
+
+ * tests/iogt.test: added RCS string, marked tests 2.* to be
+ unixOnly due to underlying system differences.
+
+ * tests/all.tcl: corrected additional sets by Kupries for testing.
+
+2000-07-26 Syd Polk <spolk@redhat.com>
+
+ * win/tcl.m4: Building libraries is significantly different on Cygwin
+ now; rewhacked.
+ * win/configure.in: Ditto.
+ * win/Makefile.in: Ditto.
+ * win/configure: Regenerated.
+ * win/tclWinPort.h: tchar.h and direct.h are not defined on Cygwin,
+ nor or they needed.
+
+
+2000-07-25 Brent Welch <welch@ajubasolutions.com>
+
+ * unix/Makefile.in: Need to install all the Tcl headers because
+ Itcl depends on internal headers.
+
+2000-07-25 Andreas Kupries <a.kupries@westend.com>
+
+ * tests/iogt.test: (line 866f) New tests iogt-6.[01], highlighting
+ buffering trouble when stacking and unstacking transformations.
+ iogt-6.0 is solved, see the changes below. iogt-6.1 remains, for
+ now, due to the perceived complexity of solutions.
+
+ * generic/tclIO.h: (line 139f) struct Channel, added a buffer
+ queue, to hold data pushed back when stacking a transformation.
+
+ * generic/tclIO.c:
+ (line 91f, line 7434f) New internal function 'CopyBuffer'.
+ Derived from 'CopyAndTranslateBuffer', with translation
+ removed.
+ (line 1025f, line 1212f): Initialization of new queue.
+ (line 1164f, Tcl_StackChannel): Pushback of input queue.
+ (line 1293f, Tcl_UnstackChannel): Discard input and pushback.
+ (line 3748f, Tcl_ReadRaw): Modified to use data in the push back
+ area before going to the driver. Uses 'CopyBuffer', s.a.
+ (line 4702f, GetInput): Modified to use data in the push back
+ area before going to the driver.
+ (line 4867f, Tcl_Seek): Modified to take pushback of the topmost
+ channel in a stack into account.
+ (line 5620f, Tcl_InputBuffered): See above. Added
+ 'Tcl_ChannelBuffered'. Analogue to 'Tcl_InputBuffered' but for
+ the buffer area in the channel.
+
+ * generic/tcl.decls: New public API 'Tcl_ChannelBuffered'. S.a.
+
+2000-07-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/socket.test: removed doTestsWithRemoteServer constraint
+ from socket-12.*. It requires 'exec', not a remote server.
+ Cleaned up some coding errors.
+
+2000-07-18 Brent Welch <welch@ajubasolutions.com>
+
+ * win/Makefile.in: Added rules for static tcldde and tclreg libraries.
+
+2000-07-17 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * win/README:
+ * win/README.binary:
+ * win/configure.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * tools/tcl.wse.in:
+ * generic/tcl.h (TCL_RELEASE_SERIAL): updated to patchlevel 8.3.2
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: added tclIOGT.c to objects list to compile.
+
+ * generic/tclStubInit.c:
+ * generic/tclIntDecls.h:
+ * generic/tclInt.decls: commented out internal decls for
+ TclTestChannelCmd and TclTestChannelEventCmd as they were moved to
+ tclTest.c. Added new decls for TclChannelEventScriptInvoker and
+ TclChannelTransform.
+
+ * generic/tclIO.h: new file that contains the main internal
+ structures of Tcl_Channel code to allow for multiple files to
+ access them.
+ * generic/tclTest.c:
+ * generic/tclIO.c: broke into 3 files - tclIO.c core code, tclIO.h
+ header code, and tclIOGT.c - the giot test code from Kupries. The
+ channel test code also moved to tclTest.c.
+ * generic/tclIO.c (CloseChannel): stopped masking out of the
+ TCL_READABLE|TCL_WRITABLE bits from the state flags in
+ CloseChannel, instead adding extra intelligence to
+ CheckChannelErrors with a new CHANNEL_RAW_MODE bit for special
+ behavior when called from Raw channel APIs.
+
+2000-07-13 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclIO.c (StackSetBlockMode): moved set of chanPtr
+ outside of blockModeProc check to avoid infinite loop when
+ blockModeProc was NULL (Kupries). updated TransformSeekProc to
+ not call Tcl_Seek directly (Kupries).
+
+ * win/tclWinChan.c: updated fileChannelType to v2 channel struct
+ * win/tclWinConsole.c: updated consoleChannelType to v2 channel struct
+ * win/tclWinPipe.c: updated pipeChannelType to v2 channel struct
+ * win/tclWinSerial.c: updated serialChannelType to v2 channel struct
+ * win/tclWinSock.c: updated tcpChannelType to v2 channel struct
+
+2000-07-11 Brent Welch <welch@ajubasolutions.com>
+
+ * win/tclConfig.sh.in: Cleaned up unix-specific autoconf variables.
+
+2000-07-11 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/iogt.test: made tests [345].0 not run by default as they
+ were failing in the new design, but I'm not convinced that the
+ returned result isn't correct.
+
+ * generic/tclDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tcl.decls: added Tcl_GetTopChannel C API that returns
+ the current top channel of a channel stack. Tcl_GetChannel was
+ changed earlier to return the bottommost channel of a stack
+ because that is the one that is guaranteed to stay around the
+ longest, and this was needed to compensate for certain
+ operations that want to look at the state of the main channel.
+ Most channel APIs already compensate for grabbing the top, so it
+ shouldn't be needed often.
+
+ * generic/tclIO.c (Tcl_StackChannel, Tcl_UnstackChannel): Added
+ flushing of buffers (Kupries), removed use of DownChannel macro,
+ added Tcl_GetTopChannel public API to get to the top channel of
+ the channel stack (necessary for TLS). Rewrote Tcl_NotifyChannel
+ for new channel design (Kupries). Did some code cleanup in the
+ transform code. tclIO.c must still be broken into bits (separate
+ out test code and giot code, create tclIO.h).
+
+2000-07-10 Andreas Kupries <a.kupries@westend.com>
+
+ * tests/iogt.test: Reverted some earlier changes as a fix by Jeff
+ revived the original and correct behaviour. IOW, the tests showed
+ a genuine error and I didn't see it :(.
+
+ * generic/tclIO.c (Tcl_Read|Write_Raw): Changed to directly use
+ the drivers and not DoRead|DoWrite. The latter use the buffering
+ system, encoding and eol-translation and this wreaks havoc with
+ the data going through the transformations. Both procedures use
+ CheckForchannelErrors and let it believe that there is no
+ background copy in progress or else stacked channels could not
+ be used for that.
+
+ * generic/tclIO.c (TclCopyChannel, CopyData): Moved access to the
+ topmost channel from the first to the second procedure to make
+ the decision about that at the last possible time (Callbacks can
+ change the stacking).
+
+ test suite: failures of iogt-[345].0
+
+2000-07-06 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/iogt.test: new tests for stacked channel stuff based off
+ new 'testchannel transform|unstack' code (Kupries IOGT extension).
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclDecls.h:
+ * generic/tclStubsInit.c:
+ * generic/tclIO.c: complete rewrite of Tcl Channel code for
+ stacked channels. Channels are now designed to work in a more
+ stacked fashion with a shared ChannelState data structure.
+
+2000-06-16 Syd Polk <spolk@redhat.com>
+
+ * generic/tclEnv.c win/tclWin32Dll.c: Fix impurePtr to work with
+ modern Cygwin.
+ * win/tcl.m4: Use --compat-implib.
* win/configure: Regenerate.
-1999-10-20 DJ Delorie <dj@cygnus.com>
+2000-06-02 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclIO.c (CloseChannel): removed the &ing out of
+ (TCL_READABLE|TCL_WRITABLE) from the flags, as CloseChannel does
+ this on the next pass through for the top channel, and it appeared
+ to be causing hangs by not allowing the final flush.
+
+2000-06-01 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclIO.c (CloseChannel): Rewrote CloseChannel code to
+ unstack a channel during the close process. Fixed a refcount bug
+ in Tcl_UnstackChannel. [Bug: 5623]
+ (CloseChannel): further extended CloseChannel in the stacked case
+ to effect certain operations on the next channel that would have
+ been done in Tcl_Close. Also added CHANNEL_CLOSED and removed
+ (TCL_READABLE|TCL_WRITABLE) bits from chanPtr->flags. Changed
+ final reset of the WatchProc to check the chanDownPtr's (next)
+ interestMask.
+
+2000-05-29 Sandeep Tamhankar <sandeep@scriptics.com>
+
+ * tests/http.test
+ * doc/http.n
+ * library/http2.3/http.tcl: Fixed bug 5741, where unsuccessful
+ geturl calls sometimes leaked memory and resources (sockets).
+ Also, switched around some of the logic so that http::wait never
+ throws an exception. This is because in an asynchronous geturl,
+ the command callback will probably end up doing all the error
+ handling anyway, and in an asynchronous situation, the user
+ expects to check the state when the transaction completes, as
+ opposed to being thrown an exception. For the http package, this
+ menas the user can check http::status for "error" and http::error
+ for the error message after doing the http::wait.
+
+2000-04-26 Jeff Hobbs <hobbs@scriptics.com>
+
+ 8.3.1 RELEASE
+
+ * README:
+ * mac/README:
+ * tools/tcl.wse.in:
+ * unix/README:
+ * unix/tcl.spec:
+ * win/README:
+ * win/README.binary: Updating URLs to reference dev.scriptics.com
+
+2000-04-25 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: updated for http change and some cleanup
+ * library/http2.[13]: moved dir http2.1 to http2.3 to match version
+
+ * doc/Utf.3: clarified docs for Tcl_(UniChar|Utf)AtIndex
+
+ * unix/tclUnixThrd.c: removed {}s around PTHREAD_MUTEX_INITIALIZER
+ [Bug: 5254]
+
+ * unix/tclLoadDyld.c (TclpLoadFile): removed use of interp->result
+
+2000-04-25 Eric Melski <ericm@scriptics.com>
+
+ * unix/mkLinks:
+ * doc/AddErrInfo.3: Added information about Tcl_LogCommandInfo
+ [Bug: 1818].
+
+2000-04-24 Eric Melski <ericm@scriptics.com>
+
+ * unix/mkLinks:
+ * doc/OpenFileChnl.3: Added man entry for Tcl_Ungets [Bug: 1834].
+
+ * unix/mkLinks:
+ * doc/SourceRCFile.3: Man page for Tcl_SourceRCFile [Bug: 1833].
+
+ * unix/mkLinks:
+ * doc/ParseCmd.3: Added documentation for Tcl_ParseVar [Bug: 1828].
+
+2000-04-24 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/tclUnixNotfy.c (Tcl_FinalizeNotifier, NotifierThreadProc):
+ added write of 'q' into triggerPipe for notifier in threaded case,
+ so that Tcl doesn't hang when children are still running [Bug: 4139]
+
+ * unix/tclUnixThrd.c (Tcl_MutexLock): minor comment fixes.
+
+2000-04-23 Jim Ingham <jingham@cygnus.com>
+
+ These changes make some error handling marginally better for Mac
+ sockets. It is still somewhat flakey, however.
+
+ * mac/tclMacSock.c (TcpClose): Add timeouts to the close - these
+ don't seem to be honored, however.
+ Use a separate PB for the release, since an async connect socket
+ will still be using the original buffer.
+ Make sure TCPRelease returns noErr before freeing the recvBuff.
+ If the call returns an error, then the buffer is not right.
+ * mac/tclMacSock.c (CreateSocket): Add timeouts to the async
+ create. These don't seem to trigger, however. Sigh...
+ * mac/tclMacSock.c (WaitForSocketEvent): If an TCP_ASYNC_CONNECT
+ socket errors out, then return EWOULDBLOCK & error out.
+ * mac/tclMacSock.c (NotifyRoutine): Added a NotifyRoutine for
+ experimenting with MacTCP.
+
+2000-04-22 Jim Ingham <jingham@cygnus.com>
+
+ * library/package.tcl (tclPkgUnknown): Fixed a typo in the Mac package
+ search part of tclPkgUnknown.
+
+2000-04-21 Sandeep Tamhankar <sandeep@scriptics.com>
+
+ * library/http2.1/http.tcl: Fixed a newly introduced bug where if
+ there's a -command callback and something goes wrong, geturl threw
+ an exception, called the callback, and unset the token. I changed
+ it so that it will not call the callback when throwing an
+ exception (so the caller only finds out about a given error from
+ one place). Also, fixed http::ncode so that it actually gives you
+ back the http return code (i.e. 200, 404, etc.) instead of the
+ first digit of the version of HTTP being used (i.e. 1).
+
+2000-04-21 Brent Welch <welch@scriptics.com>
+
+ * library/http2.1/http.tcl: More thrashing with the "server closes
+ without reading post data" scenario. Reverted to the previous
+ filevent configuratiuon, which seems to work better with small
+ amounts of post data.
+
+2000-04-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclAlloc.c: wrapped caddr_t define to not be done on Unix
+ * unix/tclUnixPort.h: added Tclp*Alloc defines to allow the use of
+ USE_TCLALLOC on Unix. [Bug: 4731]
+
+2000-04-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/dde1.1/pkgIndex.tcl:
+ * library/reg1.0/pkgIndex.tcl:
+ * win/tclWinChan.c:
+ * win/tclWinThrd.c: converted CRLF to LF the */tcl.hpj.in files
+ were not converted, as it confuses hcw locally. [Bug: 5096]
+
+ * win/Makefile.in: expanded cleanup target for help files
+
+ * doc/Thread.3: minor macro cleanup
+
+ * generic/tclFileName.c (SplitUnixPath): added support for QNX
+ node ids.
+
+2000-04-18 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+ * win/README.binary: bumped version to 8.3.1
+
+ * win/tcl.hpj.in: updated copyright date
+
+ * generic/tclEnv.c: environment support for Mac OS/X
+ * unix/tclUnixPort.h: environment support for Mac OS/X
+ * unix/tclLoadDyld.c: new file for Mac OS/X dl functions
+ * unix/Makefile.in: added install-strip target; bindir, libdir,
+ mandir, includedir vars; tclLoadDyld.c target [Bug: 2527]
+
+ * unix/tclUnixChan.c (CreateSocket): force a socket back into
+ blocking mode (default state) after a -async connect succeeds.
+ [Bug: 4388]
+
+ * generic/tclEvent.c (TclInitSubsystems): Moved tclLibraryPath to
+ thread-local storage to prevent thread-related race condition.
+ [Bug: 5033]
+ * unix/tclAppInit.c (main): removed #ifdef TCL_TEST that sets the
+ library path as it was unnecessary and conflicts with move of
+ tclLibraryPath to thread-local storage.
+
+2000-04-18 Scott Redman <redman@scriptics.com>
+
+ * win/Makefile.in:
+ * win/tcl.rc:
+ * win/tclsh.rc:
+ * win/tclsh.ico: Modified copyright dates in Windows resource
+ files. Added an icon for tclsh.exe.
+
+2000-04-17 Brent Welch <welch@scriptics.com>
+
+ * generic/tcl.h, generic/tclThreadTest.c, unix/tclUnixThrd.c,
+ win/tclWinThread.c, mac/tclMacThread.c:
+ Added Tcl_CreateThreadType and TCL_RETURN_THREAD_TYPE
+ macros for declaring the NewThread callback proc.
+
+2000-04-14 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/tclUnixChan.c (TtyParseMode): Only allow setting mark/space
+ parity on platforms that support it [Bug: 5089]
+
+ * generic/tclBasic.c (Tcl_GetVersion): adjusted use of major/minor
+ to not conflict with global decl on some systems [Bug: 2882]
+
+ * doc/AppInit.3:
+ * doc/Async.3:
+ * doc/BackgdErr.3:
+ * doc/CrtChannel.3:
+ * doc/CrtInterp.3:
+ * doc/CrtMathFnc.3:
+ * doc/DString.3:
+ * doc/Eval.3:
+ * doc/ExprLong.3:
+ * doc/GetInt.3:
+ * doc/GetOpnFl.3:
+ * doc/Interp.3:
+ * doc/LinkVar.3:
+ * doc/OpenFileChnl.3:
+ * doc/OpenTcp.3:
+ * doc/PkgRequire.3:
+ * doc/RecordEval.3:
+ * doc/SetResult.3:
+ * doc/SplitList.3:
+ * doc/StaticPkg.3:
+ * doc/TraceVar.3:
+ * doc/Translate.3:
+ * doc/UpVar.3:
+ * doc/load.n: removed or updated references to interp->result use.
+
+2000-04-13 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/regexp.n: doc clarification [Bug: 5037]
+ * doc/update.n: typo fix [Bug: 4996]
+
+ * unix/tcl.m4 (SC_ENABLE_THREADS): enhanced the detection of
+ pthread_mutex_init [Bug: 4359] and (SC_CONFIG_CFLAGS) added
+ --enable-64bit-vis switch for Sparc VIS compilation [Bug: 4995]
+
+2000-04-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/dde.n: corrected dde poke docs. [Bug: 4991]
+
+2000-04-11 Eric Melski <ericm@scriptics.com>
+
+ * win/tclWinPipe.c: Added "CONST" keyword to declaration of char
+ *native in TclpCreateTempFile, to supress compiler warnings.
+
+2000-04-10 Brent Welch <welch@scriptics.com>
+
+ * generic/tcl.h: Fixed Tcl_CreateThread declaration.
+ * library/tcltest1.0/tcltest.tcl: Fixed the "mainThread"
+ initialization to work with either testthread or the thread extension
+ * unix/tclUnixThrd.c: Fixed compiler warning when compiling
+ with -DTCL_THREADS
+
+2000-04-10 Eric Melski <ericm@scriptics.com>
+
+ * win/tclWinPipe.c (TclpCreateTempFile): Added conversion of
+ contents string from UTF to native encoding [Bug: 4030].
+
+ * tests/regexp.test: Added tests for infinite looping in [regexp
+ -all].
+
+ * generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all]
+ [Bug: 4981].
+
+ * tests/*.test: Changed all occurances of "namespace import
+ ::tcltest" to "namespace import -force ::tcltest" [Bug: 3948].
+
+2000-04-09 Brent Welch <welch@scriptics.com>
+
+ * lib/httpd2.1/http.tcl: Worked on the "server closes before
+ reading post data" case, which unfortunately causes different
+ error cases on Solaris, which can read the reply, and Linux
+ and Windows, which cannot read anything. This is all in the
+ loop-back case - client and server on the same host. Also
+ unified the error handling so the "ioerror" status goes away
+ and errors are reflected in a more uniform way. Updated the
+ man page to document the behavior.
+
+2000-04-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/reg.test (matchexpected): corrected tests to use tcltest
+ constraint types to skip certain tests.
+
+ * generic/tclBasic.c (Tcl_SetCommandInfo): comment fix
+
+ * unix/tclUnixThrd.c (Tcl_CreateThread): moved TCL_THREADS ifdef
+ inside of func as it is declared for non-threads builds as well.
+ In the non-threads case, it always returns TCL_ERROR (couldn't
+ create thread).
+
+2000-04-08 Andreas Kupries <a.kupries@westend.com>
+
+ * Overall change: Definition of a public API for the creation of
+ new threads.
+
+ * generic/tclInt.h (line 1802f): Removed the definition of
+ 'TclpThreadCreate'. (line 793f) Removed the definition of
+ 'Tcl_ThreadCreateProc'.
+
+ * generic/tcl.h (line 388f): Readded the definition of
+ 'Tcl_ThreadCreateProc'. Added Win32 stuff send in by David
+ Graveraux <davygrvy@bigfoot.com> to that too (__stdcall,
+ ...). Added macros for the default stacksize and allowed flags.
+
+ * generic/tcl.decls (line 1356f): Added definition of
+ 'Tcl_CreateThread', slot 393 of the stub table. Two new
+ arguments in the public API, for stacksize and flags.
+
+ * win/tclWinThrd.c:
+ * mac/tclMacThrd.c: Renamed TclpThreadCreate to Tcl_CreateThread,
+ added handling of the stacksize. Flags are currently ignored.
+
+ * unix/tclUnixThrd.c: See above, but handles joinable
+ flag. Ignores the specified stacksize if the macro
+ HAVE_PTHREAD_ATTR_SETSTACKSIZE is not defined.
+
+ * generic/tclThreadTest.c (line 363): See below.
+
+ * unix/tclUnixNotfy.c (line 210): Adapted to the changes
+ above. Uses default stacksize and no flags now.
+
+ * unic/tcl.m4 (line 382f): Added a check for
+ 'pthread_attr_setstacksize' to detect platforms not implementing
+ this feature of pthreads. If it is implemented, configure will
+ define the macro HAVE_PTHREAD_ATTR_SETSTACKSIZE (See
+ unix/tclUnixThrd.c too).
+
+ * doc/Thread.3: Added Tcl_CreateThread and its arguments to the
+ list of described functions. Removed stuff about not providing a
+ public C-API for thread-creation.
+
+2000-04-07 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/binary.n: clarified docs on sign extension in binary scan
+ [Bug: 3466]
+
+ * library/tcltest1.0/tcltest.tcl (initConstraints): removed win32s
+ references (no longer supported)
+
+ * tests/fCmd.test: marked test 8.1 knownBug because it is
+ dangerous on poorly configured systems [Bug: 3881]
+ and added 8.2 to keep essence of 8.1 tested.
+
+2000-04-05 Andreas Kupries <a.kupries@westend.com>
+
+ * generic/tclIO.c (Tcl_UnstackChannel, line 1831): Forcing
+ interest mask to the correct value after an unstack and
+ re-initialization of the notifier via the watchProc. Without this
+ the first fileevent after an unstack will come through and be
+ processed, but no more. [Bug: ??].
+
+2000-03-04 Brent Welch <welch@scriptics.com>
+
+ * {win,unix}/Makefile.in: added dependency of tclStubInit.c on
+ tcl.decls and tclInt.decls
+ * generic/tclThread.c: Tweak so this compiles w/out TCL_THREADS
+ * generic/{tcl.decls,tclStubInit.c}: Just touched the tcl.decls and
+ regenerated the tclStubInit.c file
+
+2000-03-29 Sandeep Tamhankar <sandeep@scriptics.com>
+
+ * library/http2.1/http.tcl: For the -querychannel option,
+ fconfigure the socket to be binary so that we don't translate
+ anything while reading the data. This is because we determine the
+ content length of the data on the channel by using seek (to the end
+ of the file) and tell on the file handle, and we need the
+ content-length to match the amount of data actually sent, and
+ translation can affect the number of bytes posted.
+
+2000-04-03 Andreas Kupries <a.kupries@westend.com>
+
+ * Overall change: Definition of public API's for the finalization
+ of conditions and mutexes. [Bug: 4199].
+
+ * generic/tclInt.h: Removed definitions of TclFinalizeMutex and
+ TclFinalizeCondition.
+
+ * generic/tcl.decls: Added declarations of Tcl_MutexFinalize and
+ Tcl_ConditionFinalize.
+
+ * generic/tclThread.c: Renamed TclFinalizeMutex to
+ Tcl_MutexFinalize. Renamed TclFinalizeCondition to
+ Tcl_ConditionFinalize.
+
+ * generic/tclNotify.c: Changed usage of TclFinalizeMutex to
+ Tcl_MutexFinalize.
+
+ * unix/tclUnixNotfy.c:
+ * generic/tclThreadTest.c: Changed usages of TclFinalizeCondition to
+ Tcl_ConditionFinalize.
+
+ * generic/tcl.h: Added empty macros for Tcl_MutexFinalize and
+ Tcl_ConditionFinalize, to be used when the core is compiled
+ without threads.
+
+ * doc/Thread.3: Added description the new API's.
+
+2000-04-03 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclCmdIL.c (InfoVarsCmd): checked for non-NULL procPtr
+ to prevent itcl info override crash [Bug: 4064]
+
+ * tests/foreach.test:
+ * tests/namespace.test:
+ * tests/var.test: Added lsorts to avoid random sorted return
+ problems. [Bug: 2682]
+
+ * tests/fileName.test: fixed 14.1 test fragility [Bug: 1482]
+
+ * tools/man2help2.tcl: fixed winhelp cross-linking error [Bug: 4156]
+ improved translation to winhelp [Bug: 3679]
+
+ * unix/Makefile.in (MAN_INSTALL_DIR): patch to accept --mandir
+ correctly [Bug: 4085]
+
+ * unix/dltest/pkg[a-e].c: Cleaned up test packages [Bug: 2293]
+
+2000-04-03 Eric Melski <ericm@scriptics.com>
+
+ * unix/tclUnixFCmd.c (SetGroupAttribute):
+ * unix/tclUnixFCmd.c (SetOwnerAttribute): Added (uid_t) and (gid_t)
+ casts to avoid compiler warnings.
+
+2000-03-31 Eric Melski <ericm@scriptics.com>
+
+ * generic/tclGet.c (Tcl_GetDouble): Added additional conditions to
+ error test (previously only errno was checked, but the return
+ value of strtod() should be checked as well). [Bug: 4118].
+
+ * tests/exec.test: Added test for proper conversion of UTF data
+ when used with "<< $dataWithUTF" on exec's.
+
+ * unix/tclUnixPipe.c (TclpCreateTempFile): Added
+ Tcl_UtfToExternalDString call, so that if there is UTF content in
+ the string it will be properly converted to the system encoding
+ before being written [Bug: 4030].
+ (TclpCreateTempFile): Added a check on the return value of tmpnam;
+ some systems (Linux, for example) will start to return NULL after
+ tmpnam has been called TMP_MAX times; not checking for this can
+ have bad results (overwriting temp files, core dumps, etc.)
+
+2000-03-30 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Added comments
+ noting the need to pair ckalloc with ckfree. [Bug: 4262]
+
+ * generic/tclInt.decls:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c:
+ * win/tclWin32Dll.c: removed TclWinSynchSpawn (vestige of Win32s
+ support).
+
+ * win/tclWinReg.c: made use of TclWinGetPlatformId instead of
+ getting info again
+
+ * win/tclWinPort.h:
+ * win/Makefile.in:
+ * win/configure.in:
+ * win/tcl.m4: Added support for gcc/mingw on Windows [Bug: 4234]
+
+2000-03-29 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclCompile.c (TclCleanupByteCode): made ByteCode cleanup
+ more aware of TCL_BYTECODE_PRECOMPILED flagged structs (gen'd by
+ tbcload), to correctly clean them up.
+
+ * generic/tclClock.c (FormatClock): moved check for empty format
+ earlier, commented 0 result return value
+
+2000-03-29 Sandeep Tamhankar <sandeep@scriptics.com>
+
+ * library/http2.1/http.tcl: Removed an unnecessary fileevent
+ statement from the error processing part of the Write method.
+ Also, fixed two potential memory leaks in wait and reset, in which
+ the state array wasn't being unset before throwing an exception.
+ Prior to this version, Brent checked in a fix to catch a
+ fileevent statement that was sometimes causing a stack trace when
+ geturl was called with -timeout. I believe Brent's fix is
+ necessary because TLS closes bad sockets for secure connections,
+ and the fileevent was trying to act on a socket that no longer
+ existed.
+
+2000-03-27 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/httpd: removed unnecessary 'puts stderr "Post Dispatch"'
+
+ * tests/namespace.test:
+ * generic/tclNamesp.c (Tcl_Export): added a uniq'ing test to the
+ export list so only one instance of each export pattern would
+ exist in the list.
+
+ * generic/tclExecute.c (TclExecuteByteCode): optimized case for
+ the empty string in ==/!= comparisons
+
+2000-03-27 Eric Melski <ericm@scriptics.com>
+
+ * unix/tclUnixChan.c: Added (off_t) type casts in lseek() call
+ [Bug: 4409].
+
+ * unix/tclLoadAout.c:
+ * unix/tclUnixPipe.c: Added (off_t) type casts in lseek() calls
+ [Bug: 4410].
+
+2000-03-22 Sandeep Tamhankar <sandeep@scriptics.com>
+
+ * library/http2.1/http.tcl: Fixed a bug where string query data
+ that was bigger than queryblocksize would get duplicate characters
+ at block boundaries.
+
+2000-03-22 Sandeep Tamhankar <sandeep@scriptics.com>
+
+ * library/http2.1/http.tcl: Fixed bug 4463, where we were getting
+ a stack trace if we tried to publish a project to a good host but
+ a port where there was no server listening. It turned out the
+ problem was a stray fileevent that needed to be cleared. Also,
+ fixed a bug where http::code could stack trace if called on a bad
+ token (one which didn't represent a successful geturl) by adding
+ an http element to the state array in geturl.
+
+2000-03-21 Eric Melski <ericm@scriptics.com>
+
+ * tests/clock.test: Modified some tests that were not robust with
+ respect to the time zone in which they were run and were thus
+ failing.
+
+ * doc/clock.n: Clarified meaning of -gmt with respect to -base
+ when used with [clock scan] (-gmt does not affect the
+ interpretation of -base).
+
+2000-03-19 Sandeep Tamhankar <sandeep@scriptics.com>
+
+ * library/http2.1/http.tcl: geturl used to throw an exception when
+ the connection failed; I accidentally returned a token with the
+ error info, breaking backwards compatibility. I changed it back
+ to throwing an exception, but unsetting the state array first
+ (thus still eliminating the original memory leak problem).
+
+2000-03-19 Sandeep Tamhankar <sandeep@scriptics.com>
+
+ * library/http2.1/http.tcl: Added -querychannel option and altered
+ some of Brent's modifications to allow asynchronous posts (via
+ -command). Also modified -queryprogress so that it calls the
+ query callback as <callback> <token> <total size> <current size>
+ to be consistent with -progress. Added -queryblocksize option
+ with default 8192 bytes for post blocksize. Fixed a bunch of
+ potential memory leaks for the case when geturl receives bad args
+ or can't open a socket, etc. Overall, the package really rocks
+ now.
+
+ * doc/http.n: Added -queryblocksize, -querychannel, and
+ -queryprogress. Also, changed the description of -blocksize,
+ which states that the -progress callback will be called for each
+ block, to now qualify that with an "if -progress is specified".
+
+ * tests/http.test: Added a querychannel test for synchronous and
+ asynchronous posts, altered the queryprogress test such that the
+ callback conforms to the -progress format. Also, had to use the
+ -queryblocksize option to do the post 16K at a time to match
+ Brent's expected results (and to test that -queryblocksize works).
+
+2000-03-15 Brent Welch <welch@scriptics.com>
+
+ * library/http2.1/http.tcl: Added -queryprogress callback to
+ http::geturl and also changed it so that writing the post data
+ is event driven if the queryprogress callback or a timeout is given.
+ This allows a timeout to occur when writing lots of post data.
+ The queryprogress callback is called after each block of query
+ data is posted. It has the same signature as the -progress callback.
+
+2000-03-06 Eric Melski <ericm@scriptics.com>
+
+ * library/package.tcl: Applied patch from Bug: 2570; rather than
+ setting geometry of slave interp to 0x0 when Tk was loaded, it now
+ does "wm withdraw .". Both remove the main window from the
+ display, but the former caused some internal structures to get
+ initialized to zero, which caused crashes with some extensions.
+
+2000-03-02 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/package.tcl (tclPkgUnknown): extended to allow
+ recognizes changes in the auto_path while sourcing in other
+ pkgIndex.tcl files
+
+ * doc/FindExec.3: fixed doc for declaration of Tcl_FindExecutable
+ [Bug: 4275]
+
+ * generic/tclFileName.c (Tcl_TranslateFileName): Applied patch
+ from Newman to significantly speedup file split/join on Windows
+ (replaces regexp with custom parser). [Bug: 2867]
+
+ * win/README.binary: change mailing lists from @consortium.org
+ to @scriptics.com [Bug: 4173]
+
+2000-02-28 Eric Melski <ericm@scriptics.com>
+
+ * tests/clock.test: Added test for ISO bases < 100000
+
+ * generic/tclDate.c: (generated on Solaris)
+ * generic/tclGetDate.y: Changed condition for deciding if a number
+ is an ISO 8601 base from number >= 100000 to numberOfDigits >= 6.
+ Previously it would fail to recognize 000000 as an ISO base.
+
+2000-02-14 Eric Melski <ericm@scriptics.com>
+
+ * unix/Makefile.in: Added rpm target to generate Tcl binary RPM.
+
+ * unix/tcl.spec: RPM specification file for a Tcl binary RPM for
+ Linux.
+
+2000-02-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ 8.3.0 RELEASE
+
+ * changes: updated for 8.3.0 release
+
+ * doc/load.n: added notes about dll load errors on Windows
+
+ * unix/README:
+ * unix/Makefile.in (dist): removed porting.notes and porting.old
+ from distribution and CVS. The information was very outdated. Now
+ refer to http://dev.scriptics.com/services/support/platforms.html
+
+ * tests/unixInit.test: fixed japanese LANG encoding test [Bug: 3549]
+
+ * unix/configure.in:
+ * unix/tcl.m4: correct CFLAG_WARNING setting,
+ fixed gcc config for AIX,
+ added -export-dynamic to LDFLAGS for FreeBSD-3+ [Bug: 2998]
+
+ * win/tclWinLoad.c (TclpLoadFile): improved error message for load
+ failures, could perhaps be even more intelligent.
+
+2000-02-09 Jim Ingham <jingham@cygnus.com>
+
+ * mac/tclMacSock.c: Don't panic when you get an error closing an async
+ socket. This doesn't seem to hurt anything, and we return the error so
+ the caller can do the right thing.
+
+ New Files:
+ * mac/MW_TclHeader.h:
+ * mac/MW_TclTestHeader.h:
+ * mac/MW_TclTestHeader.pch:
+ * mac/MW_TclAppleScriptHeader.h: More convenient to use .h prefix files
+ in the preference panels...
+
+ The above are curtesy of Daniel Steffen (steffen@math.mq.edu.au)
+
+2000-02-08 Eric Melski <ericm@scriptics.com>
+
+ * tests/clock.test: Added tests for "next monthname" constructs.
+ * generic/tclDate.c:
+ * generic/tclGetDate.y (Message): Added a grammar rule for "next
+ monthname" so that we can handle "next january" and similar
+ constructs (bug #4146).
+
+2000-02-08 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * win/configure.in:
+ * win/README:
+ * win/README.binary:
+ * generic/tcl.h (TCL_RELEASE_SERIAL): Moved to 8.3.0 patchlevel
+
+ * doc/library.n:
+ * library/auto.tcl: fixed crufty puts code and docs [Bug: 4122]
+
+ * library/tcltest1.0/tcltest.tcl: correctly protected searchDirectory
+ list to allow dirnames with spaces
+
+ * unix/tcl.m4: changed all -fpic to -fPIC
+
+ * generic/tclDecls.h:
+ * generic/tcl.decls: change Tcl_GetOpenFile to use decl of 'int
+ forWriting' instead of 'int write' to avoid shadowing [Bug: 4121]
+
+ * tests/httpold.test: changed test script to source in the httpd
+ server procs from httpd instead of having its own set.
+
+ * tests/httpd: improved query support in test httpd to handle fix
+ in http.tcl. [Bug: 4089 change 2000-02-01]
+
+ * unix/README: fixed notes about --enable-shared and add note
+ about --disable-shared.
+
+2000-02-07 Eric Melski <ericm@scriptics.com>
+
+ * tests/package.test:
+ * library/tclIndex:
+ * library/package.tcl: Renamed ::package namespace to ::pkg.
+
+2000-02-03 Eric Melski <ericm@scriptics.com>
+
+ * doc/Package.n:
+ * doc/packagens.n: Renamed Package.n -> packagens.n because Windows
+ can't deal with case-sensitive names.
+
+2000-02-02 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/regexp.test: added tests for -all and -inline switches
+ * doc/regexp.n: added docs for -all and -inline switches
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): added extra comments for
+ new -all and -inline switches to regexp command
+
+2000-02-01 Eric Melski <ericm@scriptics.com>
+
+ * library/init.tcl: Applied patch from rfe 1734 regarding
+ auto_load errors not setting error message and errorInfo properly.
+
+2000-02-01 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/Makefile.in (install-*): reduced verbosity of install
+
+ * generic/tclFileName.c (Tcl_JoinPath): improved support for special
+ QNX node id prefixes in pathnames [Bug: 4053]
+
+ * library/http1.0/http.tcl:
+ * library/http2.1/http.tcl: The query data POSTed was newline
+ terminated when it shouldn't be altered [Bug: 4089]
+
+2000-01-31 Eric Melski <ericm@scriptics.com>
+
+ * tests/package.test:
+ * library/tclIndex:
+ * library/package.tcl: Added ::package namespace and
+ ::package::create function.
+
+ * library/init.tcl: Fixed problem with auto_load and determining
+ if commands were loaded.
+
+ * library/auto.tcl: "Fixed" issues with $ in files to be auto indexed.
+
+ * doc/Package.n: New man page for package::create function.
+
+ * doc/pkgMkIndex.n: Added additional information.
+
+ * doc/library.n: Added additional qualification regarding auto_mkindex.
+
+2000-01-28 Eric Melski <ericm@scriptics.com>
+
+ * tests/pkg/magicchar2.tcl:
+ * tests/autoMkindex.test: Test for auto loader fix (bug #2480).
+
+ * library/init.tcl: auto_load was using [info commands $name] to
+ determine if a given command was available; if the command name
+ had * or [] it, this would fail because info commands uses
+ glob-style matching. This is fixed. (Bug #2480).
+
+ * tests/pkg/spacename.tcl:
+ * tests/pkgMkIndex.test: Tests for fix for bug #2360.
+
+ * library/package.tcl: Fixed to extract only the first element of
+ the list returned by auto_qualify (bug #2360).
+
+ * tests/pkg/magicchar.tcl:
+ * tests/autoMkindex.test: Test for fix for bug #2611.
+
+ * library/auto.tcl: Fixed the regular expression that performs $
+ escaping before sourcing a file to index. It was erroneously
+ adding \ escapes even to $'s that were already escaped,
+ effectively "un-escaping" those $'s. (bug #2611).
+
+2000-01-27 Eric Melski <ericm@scriptics.com>
+
+ * tests/autoMkindex.test:
+ * library/auto.tcl: Applied patch (with slight modification) from
+ bug #2701: auto_mkIndex uses platform dependent file paths.
+ Added test for fix.
+
+2000-01-27 Jennifer Hom <jenn@scriptics.com>
+
+ * library/tcltest1.0/tcltest.tcl: Changed NormalizePath to
+ normalizePath and exported it as a public proc. This proc
+ creates an absolute path given the name of the variable containing
+ the path to modify. The path is modified in place.
+ * library/tcltest1.0/pkgIndex.tcl: Added normalizePath.
+ * tests/all.tcl: Changed code to use normalizePath.
+
+2000-01-27 Eric Melski <ericm@scriptics.com>
+
+ * tests/pkg/samename.tcl: test file for bug #1983
+
+ * tests/pkgMkIndex.test:
+ * doc/pkgMkIndex.n:
+ * library/package.tcl: Per rfe #4097, optimized creation of direct
+ load packages to bypass computing the list of commands added by
+ the new package. Also made direct loading the default, and added
+ a -lazy option.
+ Fixed bug #1983, dealing with pkg_mkIndex incorrectly handling
+ situations with two procs by the same name but in different
+ namespaces (ie, foo::baz and bar::baz).
+
+2000-01-26 Eric Melski <ericm@scriptics.com>
+
+ * generic/tclNamesp.c: Undid fix for #956, which broke backwards
+ compatibility.
+
+ * doc/variable.n:
+ * doc/trace.n:
+ * doc/namespace.n:
+ * doc/info.n: Added further information about differences between
+ "namespace which" and "info exists".
+
+ * doc/SetErrno.3: Added descriptions of ErrnoId() and ErrnoMsg()
+ functions.
+
+2000-01-25 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/tcl.m4: modified EXTRA_CFLAGS to add -DHAVE_TZSET for
+ OSF1-V* and ULTRIX-4.* when not using gcc. Also added higher min
+ stack size for OSF1-V* when building with threads. [Bug: 4063]
+
+ * generic/tclClock.c (FormatClock): inlined resultPtr, as it
+ conflicted with var creation for HAVE_TZSET #def [Bug: 4063]
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): fixed potential leak
+ when calling lsort -command with bad command [Bug: 4067]
+
+ * generic/tclFileName.c (Tcl_JoinPath): added support for special
+ QNX node id prefixes in pathnames [Bug: 4053]
+
+ * doc/ListObj.3: clarified Tcl_ListObjGetElements docs [Bug: 4080]
+
+ * doc/glob.n: clarified Mac path separator determination docs.
+
+ * win/makefile.vc: added some support for building helpfile on Windows
+
+2000-01-23 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/init.tcl (auto_execok): added 'start' to list of
+ recognized built-in commands for COMSPEC on NT. [Bug: 2858]
+
+ * unix/tclUnixPort.h: moved include of <utime.h> lower since some
+ systems (UTS) require sys/types.h to be included first [Bug: 4031]
+
+ * unix/tclUnixChan.c (CreateSocketAddress): changed comparison
+ with -1 to 0xFFFFFFFF, to ensure 32 bit comparison even on 64 bit
+ systems. [Bug: 3878]
+
+ * generic/tclFileName.c: improved guessing of path separator
+ for the Mac. (Darley)
+
+ * generic/tclInt.h:
+ * generic/tcl.decls: moved Tcl_ProcObjCmd to stubs table [Bug: 3827]
+ and removed 'register' from stub definition of
+ Tcl_AppendUnicodeToObj [Bug: 4038]
+
+2000-01-21 Eric Melski <ericm@scriptics.com>
+
+ * unix/mkLinks:
+ * doc/GetHostName.3: Man page for Tcl_GetHostName (bug #1817).
+
+ * doc/lreplace.n: Corrected man page with respect to treatment of
+ empty lists, and "prettied up" the page. (bug #1705).
+
+2000-01-20 Eric Melski <ericm@scriptics.com>
+
+ * tests/namespace.test: Added test for undefined variables with
+ namespace which (bug #956).
+
+ * generic/tclNamesp.c: Added check for undefined variables in
+ NamespaceWhichCmd (bug #956).
+
+ * tests/var.test: Added tests for corrected variable behavior
+ (bug #981).
+
+ * doc/upvar.n: Expanded explanation of upvar behavior with respect to
+ variable traces. (bugs 3917 1433 2110).
+
+ * generic/tclVar.c: Changed behavior of variable command when name
+ refers to an element in an array (ie, "variable foo(x)") to always
+ return an error, regardless of existance of that element in the
+ array (now behavior is consistant with docs too) (bug #981).
+
+2000-01-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclCmdIL.c (InfoBodyCmd): made [info body] return a
+ string if the body has been bytecompiled.
+ * generic/tclBasic.c (Tcl_EvalObjEx): added pedantic check for
+ originating proc body of bytecompiled code, #def'd out as the
+ change for [info body] should make it unnecessary
+
+ * unix/tclUnixNotfy.c (Tcl_InitNotifier): added cast for tsdPtr
+
+ * tests/set.test: added test for complex array elem name compiling
+ * generic/tclCompCmds.c (TclCompileSetCmd): Fixed parsing of array
+ elements during compiling, and slightly optimised same [Bug: 3889]
+
+ * doc/tclvars.n: added definitions for tcl_(non)wordchars
+
+ * doc/vwait.n: added notes about requirement for vwait var being
+ globally scoped [Bug: 3329]
+
+ * library/word.tcl: changed tcl_(non)wordchars settings to use
+ new unicode regexp char class escapes instead of char sequences
+
+2000-01-14 Eric Melski <ericm@scriptics.com>
+
+ * tests/var.test: Added a test for the array multiple delete
+ protection in Tcl_UnsetVar2.
+
+ * generic/tclVar.c: Added protection in Tcl_UnsetVar2 against
+ attempts to multiply delete arrays when unsetting them (bug
+ #3453). This could happen if there was an unset trace on an array
+ element and the trace proc made a global or upvar link to the
+ array, and then the array was unset at the global level. See the
+ bug reference for more information.
+
+ * unix/tclUnixTime.c: New clock format format.
+
+ * compat/strftime.c: New clock format format.
+
+ * generic/tclGetDate.y: New clock scan format.
+
+2000-01-13 Jeff Hobbs <hobbs@scriptics.com>
+
+ * changes: updated changes file to reflect 8.3b2 mods
+
+ * README:
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.m4:
+ * win/README.binary:
+ * win/configure.in: updated to patchlevel 8.3b2
+
+ * generic/regexec.c: added var initialization to prevent compiler
+ warning
+
+2000-01-13 Eric Melski <ericm@scriptics.com>
+
+ * tests/cmdIL.test: Added tests for lsort -dictionary with
+ characters that occur between Z and a in ASCII.
+
+ * generic/tclCmdIL.c: Modified DictionaryCompare function (used by
+ lsort -dictionary) to do upper/lower case equivalency before doing
+ character comparisons, instead of after. This fixes bug #1357, in
+ which lsort -dictionary [list ` AA c CC] and lsort -dictionary
+ [list AA c ` CC] gave different (and both wrong) results.
+
+2000-01-12 Eric Melski <ericm@scriptics.com>
+
+ * tests/clock.test: Added tests for "next <day-of-week>" and
+ "<day-of-week>"
+ Added tests for "monday 1 week ago", etc, from RFE #3671.
+
+ * doc/tests/clock.test: Added numerous tests for clock scan.
+
+ * doc/generic/tclGetDate.y: Fixed some shift/reduce conflicts in
+ clock grammar.
+
+ * doc/doc/clock.n: Added documentation for new supported clock
+ scan formats and additional explanation of daylight savings time
+ correction algorithm.
+
+2000-01-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/file.n:
+ * tests/unixFCmd.test:
+ * unix/tclUnixFCmd.c: added support for symbolic permissions
+ setting in SetPermissionsAttribute (file attr $file -perm ...)
+ [Bug: 3970]
+
+ * generic/tclClock.c: fixed support for 64bit handling of clock
+ values [Bug: 1806]
+
+ * generic/tclThreadTest.c: upped a buffer size to hold double
+
+ * tests/info.test:
+ * generic/tclCmdIL.c: fixed 'info procs ::namesp::*' behavior (Dejong)
+
+ * generic/tclNamesp.c: made imported commands also import their
+ compile proc [Bug: 2100]
+
+ * tests/expr.test:
+ * unix/Makefile.in:
+ * unix/configure.in:
+ * unix/tcl.m4: recognize strtod bug on Tru64 v5.0 [Bug: 3378]
+ and added tests to prevent unnecessary chmod +x in sources while
+ installing, as well as more intelligent setsockopt/gethostbyname
+ checks [Bug: 3366, 3389]
+
+ * unix/tclUnixThrd.c: added compile time support (through use of
+ the TCL_THREAD_STACK_MIN define) for increasing the default stack
+ size for a thread. [Bug: 3797, 1966]
+
+2000-01-11 Eric Melski <ericm@scriptics.com>
+
+ * generic/tclGetDate.y: Added comments for the Convert function.
+ Added a fix for daylight savings time handling for relative time
+ spans of days, weeks or fortnights. (bug 3441, 3868).
+
+ * generic/tclDate.c: Fixed compiler warning issues.
+
+2000-01-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ * compat/waitpid.c: use pid_t type instead of int [Bug: 3999]
+
+ * tests/utf.test: fixed test that allowed \8 as octal value
+ * generic/tclUtf.c: changed Tcl_UtfBackslash to not allow
+ non-octal digits (8,9) in \ooo substs. [Bug: 3975]
+
+ * generic/tcl.h: noted need to change win/tcl.m4 and
+ tools/tclSplash.bmp for minor version changes
+
+ * library/http2.1/http.tcl: trim value for $state(meta) key
+
+ * unix/tclUnixFile.c: fixed signature style on functions
+
+ * unix/Makefile.in: made sure tcl.m4 would be installed with dist
+
+ * unix/tcl.m4: added ELF support for NetBSD [Bug: 3959]
+
+2000-01-10 Eric Melski <ericm@scriptics.com>
+
+ * generic/tclGetDate.y: Added rules for ISO 8601 formats (BUG #847):
+ CCYY-MM-DD
+ CCYYMMDD
+ YY-MM-DD
+ YYMMDD
+ CCYYMMDDTHHMMSS
+ CCYYMMDD HHMMSS
+ CCYYMMDDTHH:MM:SS
+ Fixed "clock scan <number>" to scan the number as an hour for the
+ current day, rather than a minute after 00:00 for the current day
+ (bug #2732).
+
+
+2000-01-07 Eric Melski <ericm@scriptics.com>
+
+ * generic/tclClock.c: Changed switch in Tcl_ClockObjCmd to use
+ enumerated values instead of constants. (ie, COMMAND_SCAN instead
+ of 3).
+
+1999-12-22 Jeff Hobbs <hobbs@scriptics.com>
+
+ * changes: updated changes file
+ * tools/tclSplash.bmp: updated to show 8.3
+
+1999-12-21 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * generic/tcl.h:
+ * mac/README:
+ * unix/configure.in:
+ * tools/tcl.wse.in:
+ * win/README.binary:
+ * win/configure.in: updated to patch level 8.3b1
+
+ * unix/Makefile.in: added -srcdir=... for 'make html'
+
+ * doc/Hash.3: fixed reference to ckfree [Bug: 3912]
+ * doc/RegExp.3: fixed calling params for Tcl_RegExecFromObj
+ * doc/open.n: fixed minor formatting errors
+ * doc/string.n: fixed minor formatting errors
+
+ * doc/lsort.n: added -unique docs
+ * tests/cmdIL.test:
+ * generic/tclCmdIL.c: added -unique option to lsort
+
+ * generic/tclThreadTest.c: changed thread ids to longs [Bug: 3902]
+
+ * mac/tclMacOSA.c: fixed applescript for I18N [Bug: 3644]
+
+ * win/mkd.bat:
+ * win/rmd.bat: removed necessity of tag.txt [Bug: 3874]
+
+ * win/tclWinThrd.c: changed CreateThread to _beginthreadex and
+ ExitThread to _endthreadex
+
+1999-12-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/glob.n:
+ * tests/fileName.test:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclEncoding.c:
+ * generic/tclFileName.c:
+ * mac/tclMacFile.c:
+ * unix/tclUnixFile.c:
+ * win/tclWinFile.c: enhanced the glob command with the new options
+ -types -path -directory and -join. Deprecated TclpMatchFiles with
+ TclpMatchFilesTypes, extended TclGlob and TclDoGlob and added
+ GlobTypeData structure. [Bug: 2363]
+
+1999-12-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/var.test:
+ * generic/tclCompile.c: fixed problem where setting to {} array
+ would intermittently not work. (Fontaine) [Bug: 3339]
+
+ * generic/tclCmdMZ.c:
+ * generic/tclExecute.c: optimized INST_TRY_CVT_TO_NUMERIC to
+ recognize boolean objects. (Spjuth) [Bug: 2815]
+
+ * tests/info.test:
+ * tests/parseOld.test:
+ * generic/tclCmdAH.c:
+ * generic/tclProc.c: changed Tcl_UplevelObjCmd (uplevel) and
+ Tcl_EvalObjCmd (eval) to use TCL_EVAL_DIRECT in the single arg
+ case as well, to take advantage of potential pure list input
+ optimization. This means that it won't get byte compiled though,
+ which should be acceptable.
+ * generic/tclBasic.c: made Tcl_EvalObjEx pure list object aware in
+ the TCL_EVAL_DIRECT case for efficiency.
+ * generic/tclUtil.c: made Tcl_ConcatObj pure list object aware,
+ and return a list object in that case [Bug: 2098 2257]
+
+ * generic/tclMain.c: changed Tcl_Main to not constantly reuse the
+ commandPtr object (interactive case) as it could be shared. (Fellows)
+
+ * unix/configure.in:
+ * unix/tcl.m4:
+ * unix/tclUnixPipe.c: removed checking for compatible vfork
+ function and use of the vfork function. Modern VM systems rarely
+ suffer any performance degradation when fork is used, and it
+ solves multiple problems with vfork. Users that still want vfork
+ can add -Dfork=vfork to the compile flags. [Bug: 942 2228 1312]
+
+1999-12-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/aclocal.m4: made it just include tcl.m4
+
+ * doc/exec.n:
+ * doc/open.n:
+ * win/tclWin32Dll.c:
+ * win/tclWinChan.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinInit.c:
+ * win/tclWinPipe.c:
+ * win/tclWinSock.c: removed all code that supported Win32s. It
+ was no longer officially supported, and likely didn't work anyway.
+ * win/makefile.vc: removed 16 bit stuff, cleaned up.
+
+ * win/tcl16.rc:
+ * win/tclWin16.c:
+ * win/winDumpExts.c: these files have been removed from the
+ source tree (no longer necessary to build)
+
+1999-12-07 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/io.test: removed 'knownBug' tests that were for
+ unsupported0, which is now fcopy (that already has tests)
+
+ * mac/tclMacPort.h: added utime.h include
+
+ * generic/tclDate.c:
+ * unix/Makefile.in: fixed make gendate to swap const with CONST
+ so it uses the Tcl defined CONST type [Bug: 3521]
+
+ * generic/tclIO.c: removed panic that could occur in FlushChannel
+ when a "blocking" channel would receive EAGAIN, instead treating
+ it the same as non-blocking. [Bug: 3773]
+
+ * generic/tclUtil.c: fixed Tcl_ScanCountedElement to not step
+ beyond the end of the counted string [Bug: 3336]
+
+1999-12-03 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/load.n: added note about NT's buggy handling of './' with
+ LoadLibrary
+
+ * library/http2.1/http.tcl: fixed error handling in http::Event
+ [Bug: 3752]
+
+ * tests/env.test: removed knownBug limitation from working test
+ * tests/all.tcl: ensured that ::tcltest::testsDirectory would be
+ set to an absolute path
+
+ * tests/expr-old.test:
+ * tests/parseExpr.test:
+ * tests/string.test:
+ * generic/tclGet.c:
+ * generic/tclInt.h:
+ * generic/tclObj.c:
+ * generic/tclParseExpr.c:
+ * generic/tclUtil.c:
+ * generic/tclExecute.c: added TclCheckBadOctal routine to enhance
+ error message checking for when users use invalid octal numbers
+ (like 08), as well as replumbed the Expr*Funcs with a new
+ VerifyExprObjType to simplify type handling. [Bug: 2467]
+
+ * tests/expr.test:
+ * generic/tclCompile.c: fixed 'bad code length' error for
+ 'expr + {[incr]}' case, with new test case [Bug: 3736]
+ and seg fault on 'expr + {[error]}' (different cause) that
+ was caused by a correct optimization that didn't correctly
+ track how it was modifying the source string in the opt.
+ The optimization was removed, which means that:
+ expr 1 + {[string length abc]}
+ will be not be compiled inline as before, but this should be
+ written:
+ expr {1 + [string length abc]}
+ which will be compiled inline for speed. This prevents
+ expr 1 + {[mindless error]}
+ from seg faulting, and only affects optimizations for
+ degenerate cases [Bug: 3737]
+
+1999-12-01 Scott Redman <redman@scriptics.com>
+
+ * generic/tcl.decls :
+ * generic/tclMain.c :
+ * unix/tclAppInit.c:
+ * win/tclAppInit.c: Added two new internal functions,
+ TclSetStartupScriptFileName() and TclGetStartupScriptFileName()
+ and added hooks into the main() code for supporting TclPro and
+ other "big" shells more easily without requiring a copy of the
+ main() code.
+
+ * generic/tclEncoding.c:
+ * generic/tclEvent.c: Moved encoding-related startup code from
+ tclEvent.c into the more appropriate tclEncoding.c.
+
+1999-11-30 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclIO.c: fix from Kupries for Tcl_UnstackChannel that
+ correctly handles resetting translation and encoding.
+
+ * generic/tclLoad.c: #def'd out the unloading of DLLs at finalize
+ time for Unix in TclFinalizeLoad. [Bug: 2560 3373] Should be
+ parametrized to allow for user to specify unload or not.
+
+ * win/tclWinTime.c: fixed handling of %Z on NT for time zones
+ that don't have DST.
+
+1999-11-29 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/dde1.1/pkgIndex.tcl:
+ * library/reg1.0/pkgIndex.tcl: added supported for debugged
+ versions of the libraries
+
+ * unix/tclUnixPipe.c: fixed PipeBlockModeProc to properly set
+ isNonBlocking flag on pipe. [Bug: 1356 710]
+ removed spurious fcntl call from PipeBlockModeProc
+
+ * tests/scan.test:
+ * generic/tclScan.c: fixed scan where %[..] didn't match anything
+ and added test case [Bug: 3700]
+
+1999-11-24 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/open.n:
+ * win/tclWinSerial.c: adopted patch from Schroedter to handle
+ fconfigure $sock -lasterror on Windows. [RFE: 3368]
+
+ * generic/tclCmdIL.c: made SORTMODE_INTEGER work with Longs
+ [Bug: 3652]
+
+1999-11-23 Scott Stanton <stanton@scriptics.com>
+
+ * library/tcltest1.0/tcltest.tcl: Fixed bug where tcltest output
+ went to stdout instead of the specified output file in some
+ cases.
+
+1999-11-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclProc.c: backed out change from 1999-11-18 as it
+ could affect return string from upvar as well.
+
+ * tools/tcl.wse.in: added tcltest1.0 library to distribution list
+
+ * doc/http.n:
+ * library/http2.1/http.tcl:
+ * library/http2.1/pkgIndex.tcl: updated http package to 2.2
- * Makefile.in: temporarily disable second subdirectory
+1999-11-18 Jeff Hobbs <hobbs@scriptics.com>
-1999-10-19 DJ Delorie <dj@cygnus.com>
+ * unix/tcl.m4: added defined for _THREAD_SAFE in --enable-threads
+ case; added check for pthread_mutex_init in libc; in AIX case,
+ with --enable-threads ${CC}_r is used; fixed flags when using gcc
+ on SCO
- * Makefile.in: support two subdirectories
- * configure[.in]: for Cygwin, build both win and unix variants
- * generic/tclEnv.c: include windows.h for cygwin
- * generic/tclPort.h: If building the unix variant for cygwin,
- pretend we're a unix machine instead of a windows machine.
- * unix/Makefile.in: don't list -lc; it breaks on cygwin.
- * unix/tclUnixFCmd.c: don't support fifos on cygwin
+ * generic/tclProc.c: corrected error reporting for default case
+ at the global level for uplevel command.
-1999-08-05 DJ Delorie <dj@cygnus.com>
+ * generic/tclIOSock.c: changed int to size_t type for len
+ in TclSockMinimumBuffers.
- * win/tclWinInit.c (TclPlatformInit): add tcl_pkgPath hack
+ * generic/tclCkalloc.c: fixed Tcl_DbCkfree to return a value
+ on NULL input. [Bug: 3400]
-1999-05-18 Fred Fish <fnf@cygnus.com>
+ * generic/tclStringObj.c: fixed support for passing in negative
+ length to Tcl_SetUnicodeObj, et al handling routines. [Bug: 3380]
- * generic/tclPosixStr.c (Tcl_ErrnoId): Avoid duplicate case when
- ENOTSUP and EOPNOTSUPP are defined to the same thing.
- (Tcl_ErrnoMsg): Ditto.
+ * doc/scan.n:
+ * tests/scan.test:
+ * generic/tclScan.c: finished support for inline scan by
+ supporting XPG identifiers.
-Fri Feb 26 17:40:55 1999 Geoffrey Noer <noer@cygnus.com>
+ * doc/http.n:
+ * library/http2.1/http.tcl: added register and unregister
+ commands to http:: package (better support for tls/SSL),
+ as well as -type argument to http::geturl. [RFE: 2617]
- * win/configure.in: change "cygwin32*" to "cygwin*"
- * win/configure: Regenerated.
- * configure.in: Change "cygwin32*" to "cygwin*"
- * configure: Regenerate.
+ * generic/tclBasic.c: removed extra decr of numLevels in
+ Tcl_EvalObjEx that could cause seg fault. (mjansen@wendt.de)
+
+ * generic/tclEvent.c: fixed possible lack of MutexUnlock in
+ Tcl_DeleteExitHandler [Bug: 3545]
+
+ * unix/tcl.m4: Added better pthreads library check and inclusion
+ of _THREAD_SAFE in --enable-threads case
+ Added support for gcc config on SCO
+
+ * doc/glob.n: added note about ..../ glob behavior on Win9*
+ * doc/tcltest.n: fixed minor example errors [Bug: 3551]
+
+1999-11-17 Brent Welch <welch@scriptics.com>
+ * library/http2.1/http.tcl: Correctly fixed the -timeout
+ problem mentioned in the 10-29 change. Also added error
+ handling for failed writes on the socket during the protocol.
+
+1999-11-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/open.n: corrected docs for 'a' open mode.
+
+ * generic/tclIOUtil.c: changed Tcl_Alloc to ckalloc
+
+ * generic/tclInt.h:
+ * generic/tclObj.c: rolled back changes from 1999-10-29
+ Purify noted new leaks with that code
+
+ * generic/tclParse.c: added code in Tcl_ParseBraces to test for
+ possible unbalanced open brace in a comment
+
+ * library/init.tcl: removed the installed binary directory from
+ the auto_path variable
+
+ * tools/tcl.wse.in: updated to 8.3a1, fixed install of twind.tcl
+ and koi8-r.enc files
+
+ * unix/tcl.m4: added recognition of pthreads library for AIX
+
+1999-10-29 Brent Welch <welch@scriptics.com>
+ * generic/tclInt.h: Modified the TclNewObj and TclDecrRefCount
+ in two ways. First, in the case of TCL_THREADS, we do not use
+ the special Tcl_Obj allocator because that is a source of
+ lock contention. Second, general code cleanup to eliminate
+ duplicated code. In particular, TclDecrRefCount now uses
+ TclFreeObj instead of duplicating that code, so it is now
+ identical to Tcl_DecrRefCount.
+
+ * generic/tclObj.c: Changed Tcl_NewObj so it uses the
+ TclNewObj macro instead of duplicating the code. Adjusted
+ TclFreeObj so it understands the TCL_THREADS case described
+ above.
+
+ * library/http2.1/http.tcl: Fixed a bug in the handling of
+ the state(status) variable when the -timeout flag is specified.
+ Previously it was possible to leave the status undefined
+ instead of empty, which caused errors in http::status
+
+1999-10-28 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/aclocal.m4: made it just include tcl.m4
+
+ * library/tcltest1.0/tcltest.tcl: updated makeFile to return
+ full pathname of file created
+
+ * generic/tclStringObj.c: fixed Tcl_AppendStringsToObjVA so it only
+ iterates once over the va_list (avoiding a memcpy of it,
+ which is not portable).
+
+ * generic/tclEnv.c: fixed possible ABR error in environ array
+
+ * tests/scan.test:
+ * generic/tclScan.c: added support for use of inline scan,
+ XPG3 currently not included
+
+ * tests/incr.test:
+ * tests/set.test:
+ * generic/tclCompCmds.c: fixed improper bytecode handling of
+ 'eval {set array($unknownvar) 5}' (also for incr) [Bug: 3184]
+
+ * win/tclWinTest.c: added testvolumetype command, as atime is
+ completely ignored for Windows FAT file systems
+ * win/tclWinPort.h: added sys/utime.h to includes
+ * unix/tclUnixPort.h: added utime.h to includes
+ * doc/file.n:
+ * tests/cmdAH.test:
+ * generic/tclCmdAH.c: added time arguments to atime and mtime
+ file command methods (support 'touch' functionality)
+
+1999-10-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/tclUnixNotfy.c: fixed event/io threading problems by
+ making triggerPipe non-blocking [Bug: 2792]
+
+ * library/tcltest1.0/tcltest.tcl:
+ * generic/tclThreadTest.c: fixed mem leaks in threads
+
+ * generic/tclResult.c: fixed Tcl_AppendResultVA so it only
+ iterates once over the va_list (avoiding a memcpy of it,
+ which is not portable).
+
+ * generic/regc_color.c: fixed mem leak and assertion, from HS
+
+ * generic/tclCompile.c: removed savedChar trick that appeared to
+ be causing a segv when the literal table was released
+
+ * tests/string.test:
+ * generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj
+ when indexing into one (test case string-5.16) [Bug: 2871]
+
+ * library/http2.1/http.tcl: protected gets with catch [Bug: 2665]
+
+1999-10-19 Jennifer Hom <jenn@scriptics.com>
+
+ * tests/tcltest.test:
+ * doc/tcltest.n:
+ * library/tcltest1.0/tcltest.tcl: Removed the extra return at the
+ end of the tcltest.tcl file, added version information about tcl.
+
+ Applied patches sent in by Andreas Kupries to add helper procs for
+ debug output, add 3 new flags (-testsdir, -load, -loadfile), and
+ internally refactors common code for dealing with paths into
+ separate procedures. [Bug: 2838, 2842]
+
+ Merged code from core-8-2-1 branch that changes the checks for the
+ value of tcl_interactive to also incorporate a check for the
+ existence of the variable.
+
+ * tests/autoMkindex.test:
+ * tests/pkgMkIndex.test: Explicitly cd to
+ ::tcltest::testsDirectory at the beginning of the test run
+
+ * tests/basic.test: Use version information defined in tcltest
+ instead of hardcoded version number
+
+ * tests/socket.test: package require tcltest before attempting to
+ use variable defined in tcltest namespace
+
+ * tests/unixInit.test:
+ * tests/unixNotfy.test: Added explicit exits needed to avoid
+ problems when the tests area run in wish.
+
+1999-10-12 Jim Ingham <jingham@scriptics.com>
+
+ * mac/tclMacLoad.c: Stupid bug - we converted the filename to
+ external, but used the unconverted version.
+ * mac/tclMacFCmd.c: Fix a merge error in the bug fix for [Bug: 2869]
+
+1999-10-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/regc_color.c:
+ * generic/regc_cvec.c:
+ * generic/regc_lex.c:
+ * generic/regc_locale.c:
+ * generic/regcomp.c:
+ * generic/regcustom.h:
+ * generic/regerrs.h:
+ * generic/regex.h:
+ * generic/regexec.c:
+ * generic/regguts.h:
+ * generic/tclRegexp.c:
+ * generic/tclTest.c:
+ * tests/reg.test: updated to Henry Spencer's new regexp engine
+ (mid-Sept 99). Should greatly reduce stack space reqs.
+
+ * library/tcltest1.0/pkgIndex.tcl: fixed procs in pkgIndex.tcl file
+
+ * generic/tclEnv.c: fixed mem leak with putenv and DStrings
+ * doc/Encoding.3: corrected docs
+ * tests/basic.test: updated test cases for 8.3
+ * tests/encoding.test: fixed test case that change system
+ encoding to a double-byte one (this causes a bogus mem read
+ error for purify)
+ * unix/Makefile.in: purify has to use -best-effort to instrument
+ * unix/tclAppInit.c: identified potential mem leak when compiling
+ tcltest (not critical)
+ * unix/tclUnixPipe.c: fixed mem leak in TclpCreateProcess when
+ doing alloc between vfork and execvp.
+ * unix/tclUnixTest.c: fixed mem leak in findexecutable test command
+
+1999-10-05 Jeff Hobbs <hobbs@scriptics.com>
+
+ * {win,mac,unix,tools,}/README:
+ * win/README.binary:
+ * win/makefile.vc:
+ * {win,unix}/configure.in:
+ * generic/tcl.h:
+ * library/init.tcl: updated to 8.3a1 from 8.2.0.
+
+ * library/http2.1/http.tcl: fixed possible use of global c var.
+
+ * win/tclWinReg.c: fixed registry command to properly 'get'
+ HKEY_PERFORMANCE_DATA root key data. Needs more work.
+
+ * generic/tclNamesp.c:
+ * generic/tclVar.c:
+ * generic/tclCmdIL.c: fixed comment typos
+
+ * mac/tclMacFCmd.c: fixed filename stuff to support UTF-8 [Bug: 2869]
+
+ * win/tclWinSerial.c: changed SerialSetOptionProc to return
+ TCL_OK by default. (patch from Rolf Schroedter)
+
+1999-09-21 Jennifer Hom <jenn@scriptics.com>
+
+ * library/tcltest1.0/tcltest.tcl: Applied patches sent in by
+ Andreas Kupries to fix typos in comments and ::tcltest::grep,
+ fix hook redefinition problems, and change "string compare" to
+ "string equal." [Bug: 2836, 2837, 2839, 2840]
+
+1999-09-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/env.test:
+ * unix/Makefile.in: added support for AIX LIBPATH env var [Bug: 2793]
+ removed second definition of INCLUDE_INSTALL_DIR (the one that
+ referenced @includedir@) [Bug: 2805]
+ * unix/dltest/Makefile.in: added -lc to LIBS [Bug: 2794]
+
+1999-09-16 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/timer.test: changed after delay in timer test 6.29 from
+ 1 to 10. [Bug: 2796]
+
+ * tests/pkg.test:
+ * generic/tclPkg.c: fixed package version check to disallow 1.2..3
+ [Bug: 2539]
+
+ * unix/Makefile.in: fixed gendate target - this never worked
+ since RCS was intro'd.
+ * generic/tclGetDate.y: updated to reflect previous changes
+ to tclDate.c (leap year calc) and added CEST and UCT time zone
+ recognition. Fixed 4 missing UCHAR() casts. [Bug: 2717, 954,
+ 1245, 1249]
+
+ * generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really
+ dump to stderr and close it [Bug: 725] and changed Tcl_Ckrealloc
+ and Tcl_Ckfree to not bomb when NULL was passed in [Bug: 1719]
+ and changed Tcl_Alloc, et al to not panic when a alloc request
+ for zero came through and NULL was returned (valid on AIX, Tru64)
+ [Bug: 2795, etc]
+
+ * tests/clock.test:
+ * doc/clock.n:
+ * generic/tclClock.c: added -milliseconds switch to clock clicks
+ to guarantee that the return value of clicks is in the millisecs
+ granularity [Bug: 2682, 1332]
+
+1999-09-15 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclIOCmd.c: fixed potential core dump in conjunction
+ with stacked channels with result obj manipulation in
+ Tcl_ReadChars [Bug: 2623]
+
+ * tests/format.test:
+ * generic/tclCmdAH.c: fixed translation of %0#s in format [Bug: 2605]
+
+ * doc/msgcat.n: fixed \\ bug in example [Bug: 2548]
+
+ * unix/tcl.m4:
+ * unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition
+ [Bug: 2070] and fix for IRIX SHLIB_LB_LIBS. [Bug: 2610]
+
+ * doc/array.n:
+ * tests/var.test:
+ * tests/set.test:
+ * generic/tclVar.c: added an array unset operation, with docs
+ and tests. Variation of [Bug: 1775]. Added fix in TclArraySet
+ to check when trying to set in a non-existent namespace. [Bug: 2613]
+
+1999-09-14 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/linsert.test:
+ * doc/linsert.n:
+ * generic/tclCmdIL.c: fixed end-int interpretation of linsert
+ to correctly calculate value for end, added test and docs [Bug: 2693]
+
+ * doc/regexp.n:
+ * doc/regsub.n:
+ * tests/regexp.test:
+ * generic/tclCmdMZ.c: add -start switch to regexp and regsub
+ with docs and tests
+
+ * doc/switch.n: added proper use of comments to example.
+ * generic/tclCmdMZ.c: changed switch to complain when an error
+ occurs that seems to be due to a misplaced comment.
+
+ * generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions
+ in regsub [Bug: 2723]
+
+ * generic/tclCmdMZ.c: changed [string equal] to return an Int
+ type object (was a Boolean)
+
+1999-09-01 Jennifer Hom <jenn@scriptics.com>
+
+ * library/tcltest1.0/tcltest.tcl: Process command-line arguments
+ only ::tcltest doesn't have a child namespace (requires that
+ command-line args are processed in that namespace)
+
+1999-09-01 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclParseExpr.c: changed '"' to '\"' to make FreeBSD
+ happy [Bug: 2625]
+ * generic/tclProc.c: moved static buf to better location and
+ changed static msg that would overflow in ProcessProcResultCode
+ [Bug: 2483] and added Tcl_DStringFree to Tcl_ProcObjCmd.
+ Also reworked size of static buffers.
+ * tests/stringObj.test: added test 9.11
+ * generic/tclStringObj.c: changed Tcl_AppendObjToObj to
+ properly handle the 1-byte dest and mixed src case where
+ both had had Unicode string len checks made on them. [Bug: 2678]
+ * unix/aclocal.m4:
+ * unix/tcl.m4: adjusted fix from 8-21 to add -bnoentry to the
+ AIX-* case and readjusted the range
+
+1999-08-31 Jennifer Hom <jenn@scriptics.com>
+
+ * library/tcltest1.0/tcltest.tcl:
+ * doc/tcltest.n:
+ * tests/README: Modified testConstraints variable so that it isn't
+ unset every time ::tcltest::initConstraints is called and cleaned up
+ documentation in the README file and the man page.
+
+1999-08-27 Jennifer Hom <jenn@scriptics.com>
+
+ * tests/env.test:
+ * tests/exec.test:
+ * tests/io.test:
+ * tests/event.test:
+ * tests/tcltest.test: Added 'exit' calls to scripts that the tests
+ themselves write, and removed accidental checkin of knownBugThreaded
+ constraints for Solaris and Linux.
+
+ * library/tcltest1.0/tcltest.tcl: Modified tcltest so that
+ variables are only initialized to their default values if they did
+ not previously exist.
+
+1999-08-26 Jennifer Hom <jenn@scriptics.com>
+
+ * tests/tcltest.test:
+ * library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a
+ variable named ::tcltest::parameters based on whatever's being
+ sent in as the argument to the -args flag.
+
+1999-08-23 Jennifer Hom <jenn@scriptics.com>
+
+ * tests/tcltest.test: Added additional tests for -tmpdir, marked
+ all tests that use exec as unixOrPc.
+
+ * tests/encoding.test:
+ * tests/interp.test:
+ * tests/macFCmd.test:
+ * tests/parseOld.test:
+ * tests/regexp.test: Applied patches from Jim Ingham to add
+ encoding to a Mac only interp test, change an error message in
+ macFCmd.tet, put a comment in parseOld.test, fix tests using the
+ testencoding path command, and put unixOrPc constraints on tests
+ that use exec.
+
+1999-08-21 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/aclocal.m4: Changed AIX-4.[2-9] check to AIX-4.[1-9]
+ [Bug: 1909]
+
+1999-08-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclPosixStr.c: fixed typo [Bug: 2592]
+
+ * doc/*: fixed various nroff bugs in man pages [Bug: 2503 2588]
+
+1999-08-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/README.binary: fixed version info and some typos [Bug: 2561]
+
+ * doc/interp.n: updated list of commands available in a safe
+ interpreter [Bug: 2526]
+
+ * generic/tclIO.c: changed Tcl_GetChannelNames* to use style guide
+ headers (pleases HP cc)
+
+1999-08-18 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/Eval.3: fixed doc on input args [Bug: 2114]
+
+ * doc/OpenFileChnl.3:
+ * doc/file.n:
+ * tests/cmdAH.test:
+ * tclIO.c:
+ * tclCmdAH.c: added "file channels ?pattern?" tcl command, with
+ associated Tcl_GetChannelNames and Tcl_GetChannelNamesEx public
+ C APIs (added to tcl.decls as well), with docs and tests.
+
+ * tests/expr.test:
+ * generic/tclCompile.c: add TCL_TOKEN_VARIABLE to the part types
+ that cause differed compilation for exprs, to correct the expr
+ double-evaluation problem for vars. Added test cases.
+ Related to [Bug: 732]
+
+ * unix/Makefile.in: changed the dependency structure so that
+ install-* is dependent on * (ie - install-binaries is dependent
+ on binaries).
+
+ * library/auto.tcl:
+ * library/init.tcl:
+ * library/ldAout.tcl:
+ * library/package.tcl:
+ * library/safe.tcl:
+ * library/word.tcl:
+ * library/http2.1/http.tcl:
+ * library/msgcat1.0/msgcat.tcl: updated libraries to better
+ Tcl style guide (no more string comparisons with == or !=, spacing
+ changes).
+
+1999-08-05 Jim Ingham <jingham@cygnus.com>
+
+ * mac/tclMacProjects.sea.hqx: Rearrange the projects so that the build
+ directory is separate from the sources. Much more convenient!
+
+1999-08-13 Scott Redman <redman@scriptics.com>
+
+ * /: 8.2.0 tagged for final release
+
+1999-08-12 Scott Stanton <stanton@scriptics.com>
+
+ * win/Makefile.in: Added COMPILE_DEBUG_FLAGS macro to make it
+ easier to turn on compiler tracing.
+
+ * tests/parse.test:
+ * generic/tclParse.c: Fixed bug in Tcl_EvalEx where the termOffset
+ was not being updated in cases where the evaluation returned a non
+ TCL_OK error code. [Bug: 2535]
+
+1999-08-12 Scott Redman <redman@scriptics.com>
+
+ * win/tclWinSerial.c: Applied patch from Petteri Kettunen to
+ remove compiler warning.
+
+1999-08-10 Scott Redman <redman@scriptics.com>
+
+ * generic/tclAlloc.c:
+ * generic/tclCmdIL.c:
+ * generic/tclIO.c:
+ * generic/tclThread.c:
+ * win/tclWinThrd.c:
+ * unix/tclUnixThrd.c: Fixed Brent's changes so that they work on
+ Windows (and he fixed the bug in the Unix thread implementation).
+
+1999-08-09 Brent Welch <welch@scriptics.com>
+
+ * generic/tcl.decls:
+ * generic/tclAlloc.c:
+ * generic/tclCkalloc.c:
+ * generic/tclCmdIL.c:
+ * generic/tclDecls.h:
+ * generic/tclIO.c:
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclVar.c:
+ * mac/tclMacThrd.c:
+ * unix/tclUnixThrd.c:
+ * win/tclWinThrd.c: Added use of Tcl_GetAllocMutex to tclAlloc.c
+ and tclCkalloc.c so they can be linked against alternate thread
+ packages. Added Tcl_GetChannelNames to tclIO.c. Added
+ TclVarTraceExists hook so "info exists" triggers read traces
+ exactly like it did in Tcl 7.6. Stubs table changes to reflect new
+ internal and external APIs.
+
+1999-08-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/string.test: added largest_int proc to adapt for >32 bit
+ machines and int overflow testing.
+ * tests/tcltest.test: fixed minor error in 8.2 result (from dgp)
+
+ * doc/Object.3: clarified Tcl_DecrRefCount docs [Bug: 1952]
+ * doc/array.n: clarified array pattern docs [Bug: 1330]
+ * doc/clock.n: fixed clock docs [Bug: 693]
+ * doc/lindex.n: clarified to account for new end-int behavior.
+ * doc/string.n: fixed formatting errors [Bug: 2188 2189]
+ * doc/tclvars.n: fixed doc error [Bug: 2042]
+ * library/init.tcl: fixed path handling in auto_execok (it could
+ miss including the normal path on some Windows machines) [Bug: 1276]
+
+1999-08-05 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/tclvars.n: Made it clear that tcl_pkgPath was not set
+ for Windows (already mentioned in init.tcl) [Bug: 2455]
+ * generic/tclLiteral.c: fixed reference to bytes that might
+ not be null terminated (using objPtr->bytes, which is) [Bug: 2496]
+ * library/http2.1/http.tcl: Made use of "i" in init section use
+ local var and start at 0 (was 1). [Bug: 2502]
+
+1999-08-04 Scott Stanton <stanton@scriptics.com>
+
+ * tests/reg.test: Added test for REG_EXPECT bug fixed by Henry's
+ patch.
+
+ * generic/regc_nfa.c:
+ * generic/regcomp.c:
+ * generic/rege_dfa.c:
+ * generic/regexec.c:
+ * generic/regguts.h: Applied patches supplied by Henry Spencer to
+ greatly enhance the performance of certain classes of regular
+ expressions. [Bug: 2440, 2447]
+
+1999-08-03 Scott Redman <redman@scriptics.com>
+
+ * win/tclWinInt.h: Remove function declarations in header that was
+ moved to tclInt.decls file in previous changes.
+
+1999-08-02 Scott Redman <redman@scriptics.com>
+
+ * unix/configure.in:
+ * win/configure.in: Change beta level to b2.
+
+ * generic/tcl.h:
+ * generic/tcl.decls:
+ * generic/tclDecls.h:
+ * generic/tclInt.h:
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclRegexp.h:
+ * generic/tclStubInit.c: Move some exported public and internal
+ functions to the stub tables. Removed functions that are in the
+ stub tables (from this and previous changes) from the original
+ header files.
+
+1999-08-01 Scott Redman <redman@scriptics.com>
+
+ * win/tclWinSock.c: Added comment block to SocketThread()
+ function. Added code to avoid calling TerminateThread(), but
+ instead to send a message to the socket event window to tell it to
+ terminate its thread.
+
+1999-07-30 Jennifer Hom <jenn@scriptics.com>
+
+ * tests/tcltest.test:
+ * library/tcltest1.0/tcltest.tcl: Exit with non-zero status if
+ there were problems with the way the test suite was started
+ (e.g. wrong # arguments).
+
+1999-07-30 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclInt.decls: added declaractions necessary for the
+ Tcl test code to work wth stubs [Bug: 2445]
+
+1999-07-30 <redman@scriptics.com>
+
+ * win/tclWinPipe.c:
+ * win/Makefile.in: Fixing launching of 16-bit apps on Win9x from
+ wish. The command line was primed with tclpip82.dll, but it was
+ ignored. Fixed that, then fixed the gmake makefile to build
+ tclpip82.dll as an executable.
+
+ * win/tclWinSock.c: Applied small patch to get thread-specific
+ data after initializing the socket driver.
+
+ * unix/tclUnixThrd.c: Applied patch to fix threads on Irix 6.5.
+ Patch from James Dennett. [Bug: 2450]
+
+ * tests/info.test: Enable test for tclParse.c change (info
+ complete).
+
+1999-07-30 <hobbs@scriptics.com>
+
+ * tclIO.c: added fix for Kupries' trf patch [Bug: 2386]
+
+ * tclParse.c: fixed bug in info complete regarding nested square
+ brackets [Bug: 2382, 2466]
+
+1999-07-29 <redman@scriptics.com>
+
+ * win/tclWinChan.c: Allow tcl to open CON and NUL, even for std
+ channels. Checking for bad/unusable std channels was moved to Tk
+ since its only purpose was to check whether to use the Tk Console
+ Window for the std channels. [Bug: 2393 2392 2209 2458]
+
+ * unix/mkLinks.tcl: Applied patch to avoid linking pack.n to
+ pack-old.n. Patch from Don Porter. [Bug: 2469]
+
+ * doc/Encoding.n: Applied patch to fix typo in .SH NAME line.
+ Patch from Don Porter. [Bug: 2451]
+
+ * win/tclWinSock.c: Free Win32 Event handles when destroying
+ the socket helper thread.
+
+1999-07-28 <jenn@scriptics.com>
+
+ * tests/tcltest.test:
+ * library/tcltest1.0/tcltest.tcl: Fixed the condition under which
+ ::tcltest::PrintError had an infinite loop problem and added a
+ test case for it. Added an optional argument to
+ ::tcltest::getMatchingFiles telling it where to search for test
+ files.
+
+1999-07-27 <redman@scriptics.com>
+
+ * tools/tclSplash.bmp: Updated Windows installer bitmap
+ to ready Tcl/Tk Version 8.2.
+
+1999-07-26 <redman@scriptics.com>
+
+ * tests/tcltest.test: Need to close the new core file, there
+ seems to be a hang in threaded WinNT if the file isn't closed.
+ Open issue, need to fix that hang.
+
+ * tests/httpold.test: Add time delay in response from Http server
+ so that test cases can properly detect timeout conditions with
+ threads enabled on multi-CPU WinNT.
+
+ * tests/winFCmd.test: Test case winFcmd-1.33 was looking for
+ c:\windows, which may not exist. Instead, create a new directory
+ on c:\ and use it for the test.
+
+ * win/tclWinConsole.c:
+ * win/tclWinPipe.c:
+ * win/tclWinSock.c: Fix terminating helper threads by holding any
+ mutexes from the primary thread while waiting for the helper
+ thread to terminate. Without these changes, the test suite hangs
+ on WinNT with 2 CPUs and threads enabled. Open issue, seems to be
+ a sporadic hang on dual CPU systems still (very rare).
+
+1999-07-26 Jennifer Hom <jenn@scriptics.com>
+
+ * tests/tcltest.test:
+ * library/tcltest1.0/tcltest.tcl:
+ * doc/tcltest.n: Cleaned up code in ::tcltest::PrintError, revised
+ documentation, and added tests for the tcltest package.
+
+1999-07-23 <redman@scriptics.com>
+
+ * tests/info.test:
+ * generic/tclParse.c: Removed patch for info command, breaks test
+ cases on Unix. Patch was bad and needs to be redone
+ properly. [Bug: 2382]
+
+1999-07-22 <redman@scriptics.com>
+
+ * Changed version to 8.2b2.
+
+ * win/tclWinSock.c: Fixed hang with threads enabled, fixed
+ semaphores with threads disabled.
+
+ * win/safe.test: Fixed safe-6.3 with threads enabled.
+
+ * win/Makefile.in: Fixed calling of tcltest to fix safe.test
+ failures due to path TCL_LIBRARY path.
+
+ * win/tclWinPort.h: Block out include of sys/*.h in order to
+ build extensions with MetroWerks compiler for Win32. [Bug: 2385]
+
+ * generic/tclCmdMZ.c:
+ * generic/tclIO.c: Fix ANSI-style prototypes based on patch from
+ Ulrich Ring. [Bug: 2391]
+
+ * unix/Makefile.in: Need to make install-sh executable before
+ calling (with chmod +x). [Bug: 2413]
+
+ * tests/var.test:
+ * generic/tclVar.c: Fixed bug that caused a seg. fault when using
+ "array set a(b) {}", which is a bad array name anyway. Now the
+ "array set" command will return an error in this case. Added test
+ case and fixed existing test. [Bug: 2427]
+
+1999-07-21 <redman@scriptics.com>
+
+ * tests/info.test:
+ * generic/tclParse.c: Applied patch to fix "info complete"
+ for the string {[a [b]}. Patch from Peter Spjuth. [Bug: 2382]
+
+ * doc/Utf.3:
+ * generic/tcl.decls:
+ * generic/tclDecls.h:
+ * generic/tclUtf.c: Changed function declarations in
+ non-platform-specific public APIs to use "unsigned long" instead of
+ "size_t", which may not be defined on certain compilers (rather
+ than include sys/types.h, which may not exist).
+
+ * unix/Makefile.in: Added the Windows configure script to the
+ distribution file list, already shipping configure.in and the .m4
+ files, but needed the configure script itself.
+
+ * win/makefile.vc: Changed version number of DDE package in VC++
+ makefile to use 1.1 instead of 1.0.
+
+ * doc/open.n: Added documentation of \\.\comX notation for opening
+ serial ports on Windows (alternative to comX:).
+
+ * tests/ioCmd.test:
+ * doc/open.n:
+ * win/tclWinSerial.c: Applied patch from Rolf Schroedter to add
+ -pollinterval option to fconfigure to modify the maxblocktime used
+ in the fileevent polling. Added documentation and fixed the test
+ case as well.
+
+ * win/tclWinSock.c: Modified 8.1.0 version of the Win32 socket
+ driver to move the handling of the socket event window in a
+ separate thread. It also turned out that Win95 & Win98 were, in
+ some cases, getting multiple FD_ACCEPTs but only handling one.
+ Added a count for the FD_ACCEPT to take care of this. Tested on
+ NT4 SP3, NT4 SP4, Win95, and Win98.
+ [Bug: 2178 2256 2259 2329 2323 2355]
+
+1999-07-21 <jpeek@scriptics.com>
+
+ * README: Small tweaks to clean up typos and wording.
+
+1999-07-20 Melissa Hirschl <hershey@matisse.scriptics.com>
+
+ * generic/tclInitScript.h:
+ * unix/tclUnixInit.c: merged code with 8.0.5. We now use an
+ intermediate global tcl var "tclDefaultLibrary" to keep the
+ "tcl_library" var from being set by the default value in the
+ Makefile. Also fixed a bug in which caused the value of
+ TCL_LIBRARY env var to be ignored.
+ * unix/tclWinInit.c: just updated some comments.
+
+1999-07-19 Melissa Hirschl <hershey@matisse.scriptics.com>
+
+ * library/http2.1/http.tcl: updated -useragent text to say version
+ 2.1.
+
+1999-07-16 <redman@scriptics.com>
+
+ * generic/tcl.decls:
+ * generic/tclDecls.h:
+ * generic/tclStubInit.c: Add Tcl_SetNotifier to stub table.
+ [Bug: 2364]
+
+ * unix/aclocal.m4:
+ * unix/tcl.m4: Add check for Alpha/Linux to correct the IEEE
+ floating flag to the compiler, should be -mieee. Patch from Don
+ Porter.
+
+ * tools/tcl.hpj.in: Change version number of .cnt file referenced
+ in .HPJ file.
+
+1999-07-15 <redman@scriptics.com>
+
+ * tools/tcl.wse.in: Fixed naming of target files for Windows.
+
+1999-07-14 <jpeek@scriptics.com>
+
+ * doc/re_syntax.n: Deleted sentence as suggested by Scott S.
+
+1999-07-12 <jpeek@scriptics.com>
+
+ * doc/re_syntax.n: Removed two notes to myself (oops), cleaned
+ up wording, fixed changebars, made two examples easier to read.
+
+1999-07-11 <redman@scriptics.com>
+
+ * win/makefile.vc: Since the makefile.vc should continue to work
+ while we're working out bugs/issues in the new TEA-style
+ autoconf/configure/gmake build mechanism for Windows, the version
+ numbers of the Tcl libraries need to remain in sync. Modified the
+ version numbers in the makefile to reflect the change to 8.2b1.
+
+1999-07-09 <redman@scriptics.com>
+
+ * win/configure.in: Eval DLLSUFFIX, LIBSUFFIX, and EXESUFFIX in
+ the configure script so that substitutions get expanded before
+ being placed in the Makefile. The "d" portion for debug libraries
+ and DLLs was not being set properly.
+
+1999-07-08 <stanton@scriptics.com>
+
+ * tests/string.test:
+ * generic/tclCmdMZ.c: Fixed bug in string range bounds checking
+ code.
+
+1999-07-08 Jennifer Hom <jenn@scriptics.com>
+
+ * doc/tcltest.n:
+ * library/tcltest1.0/tcltest.tcl: Removed -asidefromdir and
+ -relateddir flags, removed unused ::tcltest::dotests proc, cleaned
+ up implementation of core file checking, and fixed the code that
+ checks for 1-letter flag abbreviations.
+
+1999-07-08 <stanton@scriptics.com>
+
+ * win/Makefile.in: Added tcltest target so runtest works
+ properly. Added missing names to the clean/distclean targets.
+
+ * tests/reg.test:
+ * generic/rege_dfa.c: Applied fix supplied by Henry Spencer for
+ bug in DFA state caching under lookahead conditions. [Bug: 2318]
+
+1999-07-07 <stanton@scriptics.com>
+
+ * doc/fconfigure.n: Clarified default buffering behavior for the
+ standard channels. [Bug: 2335]
+
+1999-07-06 <redman@scriptics.com>
+
+ * win/tclWinSerial.c: New implementation of serial port driver
+ from Rolf Shroedter (Rolf.Schroedter@dlr.de) that allows more than
+ one byte to be read from the port. Implemented using polling
+ instead of threads, there is a max. 10ms latency between checking the
+ port for file events. [Bug: 1980 2217]
+
+1999-07-06 <welch@scriptics.com>
+
+ * library/http2.0/http.tcl: Fixed the -timeout option so it
+ handles timeouts that occur during connection attempts to
+ hosts that are down (the only case that really matters!)
+
+1999-07-03 <welch@scriptics.com>
+
+ * doc/ChnlStack.3:
+ * generic/tcl.decls:
+ * generic/tclIO.c: Added a new variant of the "Trf patch"
+ from Andreas Kupres that adds new C APIs Tcl_StackChannel,
+ Tcl_UnstackChannel, and Tcl_GetStackedChannel.
+
+1999-07-03 <welch@scriptics.com>
+
+ * generic/tclNotify.c:
+ * unix/tclUnixNotfy.c:
+ * unix/tclXtTest.c:
+ * unix/tclXtNotify.c:
+ * win/tclWinNotify.c:
+ * mac/tclMacNotify.c: Added Tcl_SetNotifier and the associated
+ hook points in the notifiers to be able to replace the notifier
+ calls at runtime The Xt notifier and test program use this hook.
+
+1999-07-03 <welch@scriptics.com>
+
+ * generic/tclParse.c: Changed parsing of variable names to
+ allow empty array names. Now "$(foo)" is a variable reference!
+ Previous you had to use something like $::(foo), which is slower.
+ This change is requested by Jean-Luc Fontaine for his STOOOP
+ package.
+
+1999-07-01 <redman@scriptics.com>
+
+ * generic/tclCmdAH.c:
+ * generic/tclFCmd.c: Call TclStat instead of TclpStat in order to
+ allow Tcl_Stat hooks to work properly.
+
+1999-06-29 Jennifer Hom <jenn@scriptics.com>
+
+ * library/tcltest1.0/pkgIndex.tcl:
+ * library/tcltest1.0/tcltest.tcl:
+ * doc/tcltest.n:
+ * tests/all.tcl: Added -preservecore, -limitconstraints, -help,
+ -file, -notfile, -relateddir and -asidefromdir flags to the
+ tcltest package along with exported proc
+ ::tcltest::getMatchingFiles. The documentation was modified to
+ match and all.tcl was modified to use the new functionality
+ instead of implementing -file itself.
+
+1999-06-28 <redman@scriptics.com>
+
+ * generic/tclIndexObj.c:
+ * doc/GetIndex.3:
+ * tests/binary.test:
+ * tests/winDde.test: Applied patch from Peter Hardie (with
+ changes) to fix problem with Tcl_GetIndexFromObj() when the key
+ being passed is the empty string. It used to match "" and return
+ TCL_OK, but it should have returned TCL_ERROR instead. Added test
+ case to "binary" and "dde" commands to check the behavior. Added
+ documentation note as well.
+
+1999-06-26 <redman@scriptics.com>
+
+ * win/tclWinDde.c: Applied patch from Peter Hardie to add poke
+ command to dde. Also rev'd version of dde package to 1.1.
+ [Bug: 1738]
+
+1999-06-25 Jennifer Hom <jenn@scriptics.com>
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * library/tcltest1.0/pkgIndex.tcl:
+ * library/tcltest1.0/tcltest.tcl:
+ * library/tcltest1.0: Added initial implementation of the Tcl test
+ harness package. This package was based on the defs.tcl file that
+ was part of the tests directory. Reversed the way that tests were
+ evaluated to fix a problem with false passes.
+
+ * doc/tcltest.n: Added documentation for the tcltest package.
+
+ * tests/README:
+ * tests/defs.tcl:
+ * tests/all.tcl: Modified all test files (tests/*.test) and
+ all.tcl to use the new tcltest package and removed references to
+ the defs.tcl file. Modified the README file to point to the man
+ page for tcltest.
+
+1999-06-25 <stanton@scriptics.com>
+
+ * tests/reg.test:
+ * generic/regexec.c: Fixed bugs in non-greedy quantifiers.
+
+1999-06-23 <jpeek@scriptics.com>
+
+ * doc/re_syntax.n:
+ * doc/switch.n:
+ * doc/lsearch.n:
+ * doc/RegExp.3:
+ * doc/regexp.n:
+ * doc/regsub.n: Moved information about syntax of 8.1 regular
+ expressions from regexp(n) manpage into new re_syntax(n) page.
+ Added pointers from other manpages to new re_syntax(n) page.
+
+1999-06-23 <stanton@scriptics.com>
+
+ * unix/Makefile.in: Changed install-doc to install-man.
+
+ * tools/uniParse.tcl:
+ * tools/uniClass.tcl:
+ * tools/README:
+ * tests/string.test:
+ * generic/regc_locale.c:
+ * generic/tclUniData.c:
+ * generic/tclUtf.c:
+ * doc/string.n: Updated Unicode character tables to reflect latest
+ Unicode 2.1 data. Also rationalized "regexp" and "string is"
+ definitions of character classes.
+
+1999-06-21 <stanton@scriptics.com>
+
+ * unix/tclUnixThrd.c (TclpThreadCreate): Fixed memory leak where
+ thread attributes were not being released. [Bug: 2254]
+
+1999-06-17 <stanton@scriptics.com>
+
+ * tests/regexp.test:
+ * generic/tclCmdMZ.c:
+ * generic/tclCmdIL.c: Changed to use new regexp interfaces. Added
+ -expanded, -line, -linestop, and -lineanchor switches to regsub.
+
+ * doc/RegExp.3: Documented the new regexp interfaces and
+ the compile/execute flags.
+
+ * generic/tclTest.c:
+ * generic/tclRegexp.h:
+ * generic/tclRegexp.c:
+ * generic/tcl.h:
+ * generic/tcl.decls: Renamed Tcl_RegExpMatchObj to
+ Tcl_RegExpExecObj and added a new Tcl_RegExpMatchObj that is
+ equivalent to Tcl_RegExpMatch. Added public macros for the regexp
+ compile/execute flags. Changed to store either an object pointer
+ or a string pointer in the TclRegexp structure. Changed to avoid
+ adding a reference to the object or copying the string.
+
+ * generic/regcomp.c: lint
+
+ * tests/reg.test:
+ * generic/regex.h:
+ * generic/regc_lex.c: Added REG_BOSONLY flag to allow Expect to
+ iterate through a string an only find matches that start at the
+ current position within the string.
+
+1999-06-16 <wart@scriptics.com>
+
+ * unix/configure.in:
+ * unix/Makefile.in:
+ * unix/tcl.m4:
+ * unix/aclocal.m4: Numerous build changes to make Tcl conform to the
+ proposed TEA spec
+
+1999-06-16 Melissa Hirschl <hershey@matisse.scriptics.com>
+
+ * generic/tclVar.c (Tcl_VariableObjCmd): fixed premature increment
+ in loop that was causing out-of-bounds reads on array "varName".
+
+1999-06-16 <stanton@scriptics.com>
+
+ * tests/execute.test:
+ * generic/tclExecute.c (TclExecuteByteCode): Fixed crash caused by
+ a bug in INST_LOAD_SCALAR1 where the scalar index was read as
+ a signed 1 byte value instead of unsigned. [Bug: 2243]
+
+1999-06-14 Melissa Hirschl <hershey@matisse.scriptics.com>
+
+ * doc/StringObj.3
+ * test/stringObj.test
+ * unix/Makefile.in
+ * win/Makefile.in
+ * win/makefile.vc
+ * generic/tclStringObj.c:
+ Merged String and Unicode object types. Added new functions to
+ the puplic API: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj,
+ Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange,
+ Tcl_AppendUnicodeToObj.
+
+1999-06-09 <stanton@scriptics.com>
+
+ * generic/tclUnicodeObj.c: Lots of cleanup and simplification.
+ Fixed several memory bugs. Added TclAppendUnicodeToObj.
+
+ * generic/tclInt.h: Added declarations for various Unicode string
+ functions.
+
+ * generic/tclRegexp.c:
+ * generic/tclCmdMZ.c: Changed to use new Unicode string interfaces
+ for better performance.
+
+ * generic/tclRegexp.h:
+ * generic/tclRegexp.c:
+ * generic/tcl.h:
+ * generic/tcl.decls: Added Tcl_RegExpMatchObj and
+ Tcl_RegExpGetInfo calls to access lower level regexp API. These
+ features are needed by Expect. This is a preliminary
+ implementation pending final review and cleanup.
+
+ * generic/tclCmdMZ.c:
+ * tests/string.test: Fixed bug where string map failed on null
+ strings.
+
+ * generic/regexec.c:
+ * unix/tclUnixNotfy.c: lint
+
+ * tools/genStubs.tcl: Changed to always write output in LF mode.
+
+1999-06-08 <stanton@scriptics.com>
+
+ * win/tclWinSock.c: Rolled back to the 8.1.0 implementation
+ because of serious problems with the new driver. Basically no
+ incoming socket connections would be reported to a server port.
+ The 8.1.1 code needs to be redesigned and fixed correctly.
+
+1999-06-07 Melissa Hirschl <hershey@matisse.scriptics.com>
+
+ * tests/string.test:
+ * generic/tclVar.c (Tcl_SetVar2Ex):
+ * generic/tclStringObj.c (Tcl_AppendObjToObj):
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): optimized the string
+ index, string length, string range, and append command in cases
+ where the object's internal rep is a bytearray. Objects with
+ other internal reps are converted to have the new unicode internal
+ rep.
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/Makefile.vc:
+ * tests/unicode.test:
+ * generic/tclInt.h:
+ * generic/tclObj.c:
+ * generic/tclUnicodeObj.c: added a new object type to store the
+ unicode representation of a string.
+
+ * generic/tclTestObj.c: added the objtype option to the testobj
+ command. This option returns the name of the type of internal rep
+ an object has.
+
+1999-06-04 <stanton@scriptics.com>
+
+ * win/configure.in:
+ * win/Makefile.in: Windows build now handles static/dynamic
+ debug/nodebug builds and supports the standard targets using
+ Cygwin user tools plus GNU make and autoconf.
+
+1999-06-03 <stanton@scriptics.com>
+
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd):
+ * tests/string.test: Fixed bug where string equal/compare -nocase
+ reported wrong result on null strings. [Bug: 2138]
+
+1999-06-02 <stanton@scriptics.com>
+
+ * generic/tclUtf.c (Tcl_UtfNcasecmp): Fixed incorrect computation
+ of relative ordering. [Bug: 2135]
+
+1999-06-01 <stanton@scriptics.com>
+
+ * unix/configure.in: Fixed various small configure.in patches
+ submitted by Jan Nijtmans. [Bug: 2121]
+
+ * tests/reg.test:
+ * generic/regc_color.c:
+ * generic/regc_cvec.c:
+ * generic/regc_lex.c:
+ * generic/regc_locale.c:
+ * generic/regc_nfa.c:
+ * generic/regcomp.c:
+ * generic/regcustom.h:
+ * generic/rege_dfa.c:
+ * generic/regerror.c:
+ * generic/regerrs.h:
+ * generic/regex.h:
+ * generic/regexec.c:
+ * generic/regfree.c:
+ * generic/regfronts.c:
+ * generic/regguts.h:
+ * generic/tclCmdMZ.c:
+ * generic/tclRegexp.c:
+ * generic/tclRegexp.h:
+ * generic/tclTest.c: Applied Henry Spencer's latest regexp patches
+ that fix an infinite loop bug and add support for testing whether
+ a string could match with additional input. [Bug: 2117]
+
+1999-05-28 <stanton@scriptics.com>
+
+ * generic/tclObj.c: Changed to eliminate use of isupper/tolower in
+ favor of the Unicode versions.
+
+ * win/Makefile.in:
+ * win/configure.in: Added preliminary TEA implementation.
+
+ * win/tclWinDde.c: Fixed bug where dde calls were being passed an
+ invalid dde handle because Initialize had not been called.
+ [Bug: 2124]
+
+1999-05-26 <redman@scriptic.com>
+
+ * generic/tclThreadTest.c: Fixed race condition in testthread
+ code that showed up in the WinNT test suite intermittently.
+
+ * win/tclWinSock.c: Fixed a hang in the WinNT socket driver, wake
+ up the socket thread every 100ms to check for events on the
+ sockets that did not wake up the thread (race condition).
+
+1999-05-24 <stanton@scriptics.com>
+
+ * tools/genStubs.tcl: Changed to allow a list of platforms instead
+ of just one at a time.
+
+ * generic/tcl.decls:
+ * generic/tclCmdMZ.c:
+ * generic/tclDecls.h:
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclPort.h:
+ * generic/tclStubInit.c:
+ * generic/tclStubLib.c: Various header file related changes and other
+ lint to try to get the Mac builds working.
+
+1999-05-21 <redman@scriptics.com>
+
+ * win/tclWinPipe.c: Fix bug when launching command.com on
+ Win95/98. Need to wait for the procInfo.hProcess of the process that
+ was created, not the hProcess of the current process. [Bug: 2105]
+
+1999-05-20 <redman@scriptics.com>
+
+ * library/init.tcl: Add the directory where the executable is, and
+ the ../lib directory relative to that, to the auto_path variable.
+
+1999-05-19 <stanton@scriptics.com>
+
+ Merged in various changes submitted by Jeff Hobbs:
+
+ * generic/tcl.decls:
+ * generic/tclUtf.c: Added Tcl_UniCharIs* functions for control,
+ graph, print, and punct classes.
+
+ * generic/tclUtil.c:
+ * doc/StrMatch.3: Added Tcl_StringCaseMatch() implementation to
+ support case-insensitive globbing.
+
+ * doc/string.n:
+ * unix/mkLinks:
+ * tests/string.test:
+ * generic/tclCmdMZ.c: Added additional character class tests,
+ added -nocase switch to "string match", changed string first/last
+ to use offsets.
+
+1999-05-19 <redman@scriptics.com>
+
+ * generic/tcl.h: Add extern "C" block around entire header file for
+ C++ compilers to fix linkage issues. Submitted by Don Porter and
+ Paul Duffin.
+
+ * generic/tclRegexp.c: Fix bug when the regexp cache is empty
+ and an empty pattern is used in regexp ( such as {} or "" ).
+
+1999-05-18 <stanton@scriptics.com>
+
+ * win/tclWinChan.c: Modified initialization code to avoid
+ inherenting closed or invalid channels. If the standard input is
+ anything other than a console, file, serial port, or pipe, then we
+ fall back to the standard Tk window console.
+
+1999-05-14 <stanton@scriptics.com>
+
+ * generic/tclCmdAH.c (Tcl_ForObjCmd): Fixed crash caused by
+ failure to reset the result before evaluating the test
+ expression.
+
+1999-05-14 <surles@scriptics.com>
+
+ * generic/tclBasic.c (Tcl_CreateInterp): Added introspection
+ variable for threaded interps. If the interp was compiled with
+ threads enabled, the tcl_platform(threaded) variable will exist.
+
+1999-05-14 <redman@scriptics.com>
+
+ * generic/tclDate.c: Applied patch to fix 100-year and 400-year
+ boundaries in leap year code, from Isaac Hollander. [Bug: 2066]
+
+1999-05-13 <stanton@scriptics.com>
+
+ * unix/Makefile.in:
+ * unix/tclAppInit.c: Minor cleanup related to Xt notifier.
+
+ * unix/tclUnixInit.c (TclpSetInitialEncodings): Tcl now looks for
+ an encoding subfield in the LANG/LC_ALL variables in cases where
+ the locale is not found in the locale table. Ensure that
+ setlocale() is called at least once so X11 will initialize
+ properly. Also, forces the LC_NUMERIC locale to be "C" so numeric
+ processing in scripts is not affected by the current locale
+ setting. [Bug: 1989]
+
+ * generic/tclRegexp.c: Increased per-thread regexp cache to 30
+ slots. This seems to be about the right number for larger
+ applications like exmh. [Bug: 1063]
+
+1999-05-12 <stanton@scriptics.com>
+
+ * doc/tclsh.1: Updated references to rc script names to accurately
+ reflect the platform differences on Windows.
+
+ * tests/regexp.test:
+ * generic/tclInt.h:
+ * generic/tclBasic.c:
+ * generic/tclRegexp.h:
+ * generic/tclRegexp.c: Replaced the per-interpreter regexp cache
+ with a per-thread cache. Changed the Regexp object to take
+ advantage of this extra cache. Added a reference count to the
+ TclRegexp type so regexps can be shared by multiple objects.
+ Removed the per-interp regexp cache from the interpreter. Now
+ regexps can be used with no need for an interpreter. [Bug: 1063]
+
+ * win/tclWinInit.c (TclpSetVariables): Avoid calling GetUserName
+ if the value can be determined from the USERNAME environment
+ variable. GetUserName is very slow.
+
+1999-05-07 <stanton@scriptics.com>
+
+ * win/winDumpExts.c:
+ * win/makefile.vc: Removed incorrect patch. [Bug: 1998]
+
+ * generic/tcl.decls: Replaced const with CONST.
+
+ * generic/tclResult.c (Tcl_AppendResultVA):
+ * generic/tclStringObj.c (Tcl_AppendStringsToObjVA): Fixed to copy
+ arglist using memcpy instead of assignment so it works properly on
+ OS/390. [Bug: 1997]
+
+ * generic/tclLoadNone.c: Updated to use current interfaces, added
+ TclpUnloadFile. [Bug: 2003]
+
+ * win/winDumpExts.c:
+ * win/makefile.vc: Changed to emit library name in defs
+ file. [Bug: 1998]
+
+ * unix/configure.in: Added fix for OS/390. [Bug: 1976]
+
+1999-05-06 <stanton@scriptics.com>
+
+ * tests/string.test:
+ * generic/tclCmdMZ.c:
+ * doc/string.n: Fixed bug in string equal/compare code when using
+ -length option. Cleaned up docs a bit more.
+
+ * tests/http.test: Unset "data" array before running tests to
+ avoid failures due to previous tests.
+
+ * doc/string.n:
+ * tests/cmdIL.test:
+ * tests/cmdMZ.test:
+ * tests/error.test:
+ * tests/ioCmd.test:
+ * tests/lindex.test:
+ * tests/linsert.test:
+ * tests/lrange.test:
+ * tests/lreplace.test:
+ * tests/string.test:
+ * tests/cmdIL.test:
+ * generic/tclUtil.c:
+ * generic/tclCmdMZ.c: Replaced "string icompare/iequal" with
+ -nocase and -length switches to "string compare/equal". Added a
+ -nocase option to "string map". Changed index syntax to allow
+ integer or end?-integer? instead of a full expression. This is
+ much simpler with safeTcl scripts since it avoids double
+ substitution issues.
+
+ * doc/Utf.3:
+ * generic/tclStubInit.c:
+ * generic/tclDecls.h:
+ * generic/tclUtf.c:
+ * generic/tcl.decls: Added Tcl_UtfNcmp and Tcl_UtfNcasecmp.
+
+1999-05-05 <stanton@scriptics.com>
+
+ * win/makefile.vc: Added encoding directory to install-libraries
+ target.
+
+1999-05-03 <stanton@scriptics.com>
+
+ * doc/string.n:
+ * tests/cmdMZ.test:
+ * tests/string.test:
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): Changed "string length"
+ to avoid regenerating the string rep of a ByteArray object.
+
+ * tests/cmdIL.test:
+ * tests/cmdMZ.test:
+ * tests/error.test:
+ * tests/lindex.test:
+ * tests/linsert.test:
+ * tests/lrange.test:
+ * tests/lreplace.test:
+ * tests/string.test:
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd):
+ * generic/tclUtil.c (TclGetIntForIndex): Applied Jeff Hobbs's
+ string patch which includes the following changes [Bug: 1845]:
+
+ - string compare now takes optional length arg (for strncmp
+ behavior)
+
+ - added string equal (just a few lines of code blended
+ in with string compare)
+
+ - added string icompare/iequal for case-insensitive comparisons
+
+ - string index's index can now be ?end[+-]?expression
+ I made this change in the private TclGetIntForIndex,
+ which means that the list commands also benefit, as
+ well as string range, et al.
+
+ - added [string repeat string count]
+ Repeats given string number of times
+
+ - added string replace, string equiv to lreplace
+ (quasi opposite of string range):
+ string replace first last ?string?
+ Example of use, replacing end of string with ...
+ should the string be more than 16 chars long:
+ string replace $string 16 end "..."
+ This just returns the string len < 16, so it
+ will only affect the long strings.
+
+ - added optional first and last args to string to*
+ This allows you to just affect certain regions of
+ a string with the command (like just capping the
+ first letter). I found the original totitle to
+ be too draconian to be useful.
+
+ - added [string map charMap string]
+ where charMap is a {from to from to} list that equates to
+ what one might get from [array get]. Each and
+ can be multiple chars (or none at all). For Tcl/CGI users,
+ this is a MAJOR speed booster.
+
+ * generic/tclParse.c (Tcl_ParseCommand): Changed to avoid
+ modifying eval'ed strings that are already null terminated.
+ [Bug: 1793]
+
+ * tests/binary.test:
+ * generic/tclBinary.c (DupByteArrayInternalRep): Fixed bug where
+ type was not being set in duplicated object. [Bug: 1975, 2047]
+
+1999-04-30 <stanton@scriptics.com>
+
+ * Changed version to 8.1.1.
+
+1999-04-30 <stanton@scriptics.com>
+
+ * Merged changes from 8.1.0 branch:
+
+ * generic/tclParse.c: Fixed memory leak in CommandComplete.
+
+ * generic/tclPlatDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclIntDecls.h:
+ * generic/tclDecls.h:
+ * tools/genStubs.tcl: Added 'extern "C" {}' block around the stub
+ table pointer declaration so the stub library can be used from
+ C++. [Bug: 1934]
+
+ * Lots of documentation and other release engineering fixes.
+
+1999-04-28 <stanton@scriptics.com>
+
+ * mac/tclMacResource.c:
+ * generic/tclListObj.c:
+ * generic/tclObj.c:
+ * generic/tclStringObj.c: Changed to avoid freeing the string
+ representation before freeing the internal rep. This helps with
+ debugging since the string rep will still be valid when the free
+ proc is invoked.
+
+1999-04-27 <stanton@scriptics.com>
+
+ * generic/tclLiteral.c (TclHideLiteral): Fixed so hidden literals
+ get duplicated to avoid accidental sharing in the global object
+ table.
+
+1999-04-23 <stanton@scriptics.com>
+
+ * generic/tclStubInit.c:
+ * tools/genStubs.tcl: Changed to avoid the need for forward
+ declarations in stub initializers.
+
+1999-04-23 <stanton@scriptics.com>
+
+ * library/encoding/koi8-r.enc:
+ * tools/encoding/koi8-r.txt: Added support for the koi8-r Cyrillic
+ encoding. [Bug: 1771]
+
+1999-04-22 <stanton@scriptics.com>
+
+ * win/tclWinFCmd.c:
+ * win/tclWin32Dll.c: Changed uses of "try" to "__try", since that
+ is the actual keyword. This eliminates the need for some -D flags
+ from the makefile.
+
+ * generic/tclPort.h: Added include of tcl.h since it defines
+ various Windows macros that are needed before deciding which
+ platform porting file to use.
+
+ * generic/tclEvent.c: lint
+
+ * win/tclWinInit.c (TclpInitPlatform): Added call to TclWinInit
+ when building a static library since DllMain will not be invoked.
+ This could break old code that explicitly called TclWinInit, but
+ should be simpler in the long run.
+
+1999-04-22 Scott Stanton <stanton@scriptics.com>
+
+ * generic/tclInt.h:
+ * generic/tclInt.decls:
+ * generic/tclCompile.c: Added TclSetByteCodeFromAny that takes a
+ hook procedure to invoke after compilation but before the byte
+ codes are emitted. This makes it possible to do postprocessing on
+ the compiled byte codes before the ByteCode is generated.
+
+ * generic/tclLiteral.c: Added TclHideLiteral and TclAddLiteralObj
+ to make it possible to create local unshared literal objects.
+
+ * win/tclWinInit.c:
+ * unix/tclUnixInit.c: Changed initial search path to match that
+ found used by tcl_findLibrary.
+
+1999-04-22 <redman@scriptics.com>
+
+ * win/tclWinPort.h:
+ * win/tclWinSock.c: Added code to use WinSock 2.0 API on NT to
+ avoid creating a window to handle sockets. API not available on
+ Win95 and needs to be fixed on Win98, until then continue to use
+ the older (window-based) scheme on those two OSes.
+
+1999-04-15 <stanton@scriptics.com>
+
+ * Merged 8.1 back into the main trunk
+
+1999-04-13 <stanton@scriptics.com>
+
+ * library/encoding/gb2312.enc:
+ * library/encoding/euc-cn.enc:
+ * tools/encoding/gb2312.txt:
+ * tools/encoding/cp950.txt:
+ * tools/encoding/Makefile: Restored the double byte definition of
+ GB2312 and added the EUC-CN encoding. EUC-CN is a variant of
+ GB2312 that shifts the characters into bytes with the high bit set
+ and includes ASCII as a subset. [Bug: 632]
+
+1999-04-13 <redman@scriptics.com>
+
+ * win/tclWinSock.c: Apply patch to allow write access to a socket
+ if FD_WRITE is sent but FD_CONNECT is not. Some strange problem
+ with either Win32 or a socket driver. [Bug: 1664 1776]
+
+1999-04-09 <redman@scriptics.com>
+
+ * unix/tclUnixNotfy.c: Fixed notifier deadlock situation when the
+ pipe used to talk back notifier thread is filled with data. When
+ calling the write() function to feed data down that pipe, unlock
+ the notifierMutex to allow the notifier to wake up again. Found
+ as a result of the focus.test for Tk hanging. [Bug: 1700]
+
+1999-04-06 <stanton@scriptics.com>
+
+ * tests/unixNotfy.test: Fixed hang in tests when built with thread
+ support.
+
+ * tests/httpold.test: Fixed broken test that didn't wait long
+ enough for events to arrive.
+
+ * tests/unixInit.test: Fixed race condition in test.
+
+ * tests/unixInit.test:
+ * tests/fileName.test: Minor test nits.
+
+ * unix/tclUnixInit.c (TclpSetInitialEncodings): Fixed bad initial
+ encoding string.
+
+1999-04-06 <surles@scriptics.com>
+
+ * generic/tclVar.c:
+ * generic/tclEnv.c: Moved the "array set" C level code into a
+ common routine (TclArraySet). The TclSetupEnv routine now uses
+ this API to create an env array w/ no elements.
+
+ * generic/tclEnv.c:
+ * generic/tclWinInit.h:
+ * generic/tclUnixInit.h:
+ * generic/tclInt.h: Made the Env module I18N compliant. Changed the
+ FindVariable routine to TclpFindVariable, that now does a case
+ insensitive string comparison on Windows, and not on UNIX. [Bug:
+ 1299, 1500]
+
+1999-04-05 <stanton@scriptics.com>
+
+ * tests/io.test: Minor test cleanup.
+
+ * generic/tclEncoding.c (Tcl_CreateEncoding): Minor lint to make
+ it easier to compile on Digital-unix. [Bug: 1659]
+
+ * unix/configure.in:
+ * unix/tclUnixPort.h: Applied patch for OS/390 to handle lack of
+ sys/param.h. [Bug: 1725]
+
+ * unix/configure.in: Fixed BSD/OS 4.* configuration to support
+ shared libraries properly. [Bug: 1730]
+
+1999-04-05 <redman@scriptics.com>
+
+ * win/tclWinDde.c: decrease timeout value for DDE calls to 30k
+ [Bug: 1639]
+
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclDecls.h:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclUtil.c: Added more functions to the Tcl stubs table,
+ including all Tcl_ functions not already in it (except Cmd
+ functions) and Tcl_GetCwd() and Tcl_Chdir() (new functions).
+
+ * tests/safe.test:
+ * doc/safe.n:
+ * generic/tclBasic.c:
+ * library/safe.tcl: The encoding command is not safe as-is, so
+ create a safe alias to mask out the "encoding system <name>" but
+ allow all other uses including "encoding system". Added test cases
+ and updated the man page for Safe Tcl.
+
+1999-04-05 <stanton@scriptics.com>
+
+ * tests/winTime.test:
+ * win/tclWinTime.c: Fixed crash in clock command that occurred
+ when manipulating negative time values in timezones east of
+ GMT. [Bug: 1142, 1458]
+
+ * tests/platform.test:
+ * tests/fileName.test: Fixed broken tests.
+
+ * generic/tclFileName.c: Moved global regexps into thread local
+ storage.
+
+ * tests/socket.test: Changed so tests don't reuse sockets,
+ since Windows is slow to release sockets.
+
+ * win/tclWinConsole.c:
+ * win/tclWinPipe.c:
+ * win/tclWinSerial.c: Fixed race condition where background
+ threads were terminated while they still held a lock in the
+ notifier.
+
+1999-04-02 <stanton@scriptics.com>
+
+ * tests/http.test: Fixed bad test initialization code.
+
+ * generic/tclThreadTest.c (ThreadExitProc): Fixed bug where static
+ memory was being returned instead of a dynamically allocated
+ result in error cases.
+
+1999-04-02 <redman@scriptics.com>
+
+ * doc/dde.n:
+ * tools/tcl.wse.in:
+ * win/makefile.vc:
+ * win/pkgIndex.tcl:
+ * win/tclWinDde.c: Add new DDE package, code removed from Tk now
+ separated into its own package. Changed DDE-based send code into
+ "dde eval" command. Can be loaded into tclsh (not just wish).
+ Windows only.
+
+1999-04-02 <stanton@scriptics.com>
+
+ * tests/expr.test:
+ * tests/for-old.test:
+ * tests/for.test:
+ * tests/foreach.test:
+ * tests/format.test:
+ * tests/httpold.test:
+ * tests/if.test:
+ * tests/init.test:
+ * tests/interp.test:
+ * tests/while.test: Added some tests for known bugs (marked with
+ knownBug constraint), and cleaned up a few bad tests.
+
+ * generic/regc_locale.c:
+ * generic/regcustom.h:
+ * generic/tcl.decls:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclInt.h:
+ * generic/tclRegexp.c:
+ * generic/tclScan.c:
+ * generic/tclTest.c:
+ * generic/tclUtf.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinFile.c: Made various Unicode utility functions
+ public. The following functions were made public and added to the
+ stubs table:
+ Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString,
+ Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharIsAlnum,
+ Tcl_UniCharIsAlpha, Tcl_UniCharIsDigit, Tcl_UniCharIsLower,
+ Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar
+
+1999-04-01 <stanton@scriptics.com>
+
+ * tests/registry.test:
+ * win/tclWinReg.c: Internationalized the registry code. It now
+ uses Unicode interfaces on NT. [Bug: 1197]
+
+ * tests/parse.test:
+ * generic/tclParse.c: Fixed crash due to multiple frees in parser
+ during error cleanup when parsing commands with more tokens than
+ will fit in the static area of the parse structure. [Bug: 1681]
+
+ * generic/tclInt.h: Removed duplicate declarations.
+
+ * generic/tclInt.decls:
+ * generic/tcl.decls: Added Tcl_WinUtfToTChar and Tcl_WinTCharToUtf
+ to the tclPlat table.
+
+1999-04-01 <redman@scriptics.com>
+
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclDecls.h:
+ * generic/StubInit.c:
+ * tools/genStubs.tcl:
+ * unix/Makefile.in:
+ * win/makefile.vc: Applied patch from Jan Nijtmans to fix Ultrix
+ multiple symbol definition problem. Now, even Tcl includes a copy
+ of the Tcl stub library. Also fixed TCL_MEM_DEBUG mode (for Tk).
+
+1999-03-31 <redman@scriptics.com>
+
+ * win/tclWinConsole.c: WinNT has a bug when reading a single
+ character from the console. Rewrote the code for the console to
+ read an entire line at a time using the reader thread.
+
+1999-03-30 <stanton@scriptics.com>
+
+ * unix/Makefile.in: Removed trailing backslash that broke the
+ "depend" target.
+
+ * unix/tclUnixInit.c (TclpSetInitialEncodings): Changed to avoid
+ calling setlocale(). We now look directly at env(LANG) and
+ env(LC_CTYPE) instead. [Bug: 1636]
+
+ * generic/tclFileName.c:
+ * generic/tclDecls.h:
+ * generic/tcl.decls: Removed CONST from Tcl_JoinPath and
+ Tcl_TranslateFileName because it changes the signature of
+ Tcl_JoinPath in an incompatible manner.
+
+ * generic/tclInt.h:
+ * generic/tclLoad.c (TclFinalizeLoad):
+ * generic/tclEvent.c (Tcl_Finalize): Defer unloading of loadable
+ modules until all exit handlers have been invoked.
+ [Bug: 998, 1273, 1573, 1593]
+
+1999-03-29 <stanton@scriptics.com>
+
+ * generic/tclFileName.c:
+ * generic/tclDecls.h:
+ * generic/tcl.decls: Added CONST to Tcl_JoinPath and
+ Tcl_TranslateFileName.
+
+1999-03-29 <redman@scriptics.com>
+
+ * tools/genStubs.tcl:
+ * unix/configure.in:
+ * unix/Makefile.in:
+ * win/makefile.vc:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclDecls.h:
+ * generic/tclIntDecls.h:
+ * generic/tclPlatDecls.h:
+ * generic/tclIntPlatDecls.h: Removed the stub functions and
+ changed the stub macros to just use the name without params. Pass
+ &tclStubs into the interp (don't use tclStubsPtr because of
+ collisions with the stubs on Solaris).
+
+1999-03-27 <redman@scriptics.com>
+
+ * win/makefile.bc: Removed makefile for Borland compiler, no
+ longer supported.
+
+1999-03-26 <redman@scriptics.com>
+
+ * win/tclWinSerial.c:
+ * win/tclWinConsole.c:
+ * win/tclWinPipe.c: Don't close the Win32 handle for a channel if
+ it's a stdio handle (GetStdHandle()) during shutdown of a thread
+ to prevent it from destroying the stdio of other threads.
+
+1999-03-26 <suresh@scriptics.com>
+
+ * unix/configure.in
+ --nameble-shared is now the default and build Tcl as a shared
+ library; specify --disable-shared to build a static Tcl library
+ and shell.
+
+1999-03-25 <stanton@scriptics.com>
+
+ * tests/interp.test:
+ * generic/tclInterp.c (AliasObjCmd): Changed so aliases are
+ invoked at current scope in the target interpreter instead of at
+ the global scope. This was an incompatibility introduced in 8.1
+ that is being removed. [Bug: 1153, 1556]
+
+ * library/encoding/big5.enc:
+ * library/encoding/gb2312.enc:
+ * tools/encoding/big5.enc:
+ * tools/encoding/gb2312.enc: Added ASCII to big5 and gb2312
+ encodings. [Bug: 632]
+
+ * generic/tclPkg.c (Tcl_PkgRequireEx): Fixed broken clientData
+ initialization in package code.
+
+ * unix/Makefile.in (dist): Added tcl.decls and tclInt.decls to
+ source distribution. [Bug: 1571]
+
+ * doc/Thread.3: Updated documentation of Tcl_MutexLock to indicate
+ that the recursive locking behavior is undefined. On Windows, it
+ does not block, on Unix it deadlocks. [Bug: 1275]
+
+1999-03-24 <stanton@scriptics.com>
+
+ * tests/execute.test:
+ * generic/tclExecute.c (TclExecuteByteCode): Fixed expression code
+ that incorrectly returned floating point values for integers if
+ the internal rep happened to be a double. Now we check to see if
+ the object has a string rep that looks like an integer before
+ using the double internal rep. [Bug: 1516]
+
+1999-03-24 <redman@scriptics.com>
+
+ * generic/tclAlloc.c:
+ * generic/tclEncoding.c:
+ * generic/tclProc.c:
+ * unix/tclUnixTime.c:
+ * win/tclWinSerial.c: Fixed compilation warnings/errors for VC++
+ 5.0 and 6.0 and HP-UX native compiler without -Aa or -Ae.
+ [Bug: 1323 1518 1324 1583 1585 1586]
+
+ * win/tclWinSock.c: Make sockets thread-safe on Windows. The
+ current implementation uses windows to handle events on the
+ socket, one for each thread (thread local storage). Previously,
+ there was only one window shared between threads, which didn't
+ work. [Bug: 1326]
+
+1999-03-23 <stanton@scriptics.com>
+
+ * tools/tcl.wse: Fixed file association to look in the right place
+ for the wish icon. [Bug: 1544]
+
+ * tests/winNotify.test:
+ * tests/ioCmd.test:
+ * tests/event.test: Changed to use new style conditionals.
+
+ * tests/encoding.test: Fixed nonportable test.
+
+ * unix/dltest/configure.in:
+ * unix/dltest/Makefile.in: Added missing DBGX macros. [Bug: 1564]
+
+ * tests/winNotify.test:
+ * mac/tclMacNotify.c:
+ * win/tclWinNotify.c:
+ * unix/tclUnixNotfy.c:
+ * generic/tclNotify.c: Added a new Tcl_ServiceModeHook interface
+ that is invoked whenever the service mode changes. This is needed
+ to allow the Windows notifier to create a communication window the
+ first time Tcl is about to enter an external modal event loop
+ instead of at startup time. This will avoid the various problems
+ that people have been seeing where the system hangs when tclsh
+ is running outside of the event loop. [Bug: 783]
+
+ * generic/tclInt.h:
+ * generic/tcl.decls: Renamed TclpAlertNotifier back to
+ Tcl_AlertNotifier since it is part of the public notifier driver
+ API.
+
+1999-03-23 <redman@scriptics.com>
+
+ * win/tclWinSerial.c: Fixed problem with fileevent on the serial
+ port and nonblocking mode. Gets no longer hangs, fileevents fire
+ whenever there is any character data on the port.
+
+ * tests/winConsole.test:
+ * win/tclWinConsole.c: Fixed problem with fileevents and gets from
+ a console stdin. Previously, fileevents were firing before an
+ entire line was available for reading, which meant that when you
+ did a gets or read, it blocked (even in nonblocking mode). Now, it
+ should work the same as Unix: fileevents fire when an entire line
+ is ready, and gets and read do not block in non-blocking mode.
+ Added an interactive test case to check for this.
+
+1999-03-22 <stanton@scriptics.com>
+
+ * tests/reg.test:
+ * generic/regc_color.c: Applied regexp bug fix from Henry Spencer.
+
+1999-03-19 <redman@scriptics.com>
+
+ * generic/tclCmdIL.c: Fixed the initialization of an array so that
+ the Sun 5.0 C compiler wouldn't complain.
+
+ * unix/configure.in: Added support for --enable-64bit. For now,
+ this is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun
+ compiler (not gcc).
+
+1999-03-18 <stanton@scriptics.com>
+
+ * win/tclWinChan.c (TclpOpenFileChannel, Tcl_MakeFileChannel):
+ Changed to only test for console or comm handles when the type is
+ FILE_TYPE_CHAR to avoid useless tests on simple files. Also
+ reordered tests so consoles are tested first as this is more
+ common.
+
+ * win/makefile.vc: Regularized usage of mkd and rmd and rm.
+
+ * library/encoding/shiftjis.enc:
+ * tools/encoding/shiftjis.txt: Missing/incorrect characters in
+ shift-jis table. [Bug: 1008, 1526]
+
+ * generic/tclInt.decls:
+ * generic/tcl.decls: Eliminated use of "string" and "list" from
+ argument lists to avoid conflicts with C++ STL. [Bug: 1181]
+
+ * win/tclWinFile.c (TclpMatchFiles): Changed to ignore the
+ FS_CASE_IS_PRESERVED bit and always return exactly what we get
+ from the system.
+
+1999-03-17 <stanton@GASPODE>
+
+ * win/README.binary:
+ * win/README:
+ * unix/configure.in:
+ * generic/tcl.h:
+ * README: Updated version to 8.1b3.
+
+1999-03-14 <stanton@GASPODE>
+
+ * win/tclWinConsole.c:
+ * win/tclWinPipe.c:
+ * win/tclWinSerial.c: Changed so channel drivers wait for the
+ reader/writer threads to exit before returning during a close
+ operation. This ensures that the main thread is the last thread
+ to exit, so the process return value is set properly.
+
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclIntPlatStubs.c:
+ * generic/tclIntStubs.c:
+ * generic/tclPlatDecls.h:
+ * generic/tclPlatStubs.c:
+ * generic/tclStubInit.c:
+ * generic/tclStubs.c: Fixed bad eol characters.
+
+ * generic/tclInt.decls: Changed "const" to "CONST" in
+ declarations for better portability.
+
+ * generic/tcl.decls: Renamed panic and panicVA to Tcl_Panic and
+ Tcl_PanicVA in the stub files.
+
+ * generic/tclInterp.c (Tcl_MakeSafe): Remove tcl_platform(user)
+ from safe interps.
+
+1999-03-11 <stanton@GASPODE>
+
+ * unix/Makefile.in:
+ * unix/configure.in: Include compat files in the stub library in
+ addition to the main library. Compat files are now built for
+ dynamic use in all cases.
+
+ * generic/tcl.h: Changed magic number so it doesn't match the plus
+ patch, at Jan's request.
+
+ * unix/tclConfig.sh.in:
+ * unix/dltest/Makefile.in:
+ * unix/dltest/configure.in:
+ * unix/dltest/pkga.c:
+ * unix/dltest/pkgb.c:
+ * unix/dltest/pkgc.c:
+ * unix/dltest/pkgd.c:
+ * unix/dltest/pkge.c:
+ * unix/dltest/pkgf.c: Changed package tests to build against the
+ stubs library.
+
+1999-03-10 <stanton@GASPODE>
+
+ * generic/tcl.h:
+ * generic/tcl.decls: Changed Tcl_ReleaseType from an enum to
+ macros so it can be used in .rc files.
+ Added Tcl_GetString.
+
+ * mac/tclMacNotify.c:
+ * generic/tclNotify.c:
+ * generic/tclInt.h:
+ * win/tclWinNotify.c:
+ * generic/tcl.h: Renamed Tcl_AlertNotifier to TclpAlertNotifier.
+
+ * generic/tclInt.decls: Added TclWinAddProcess to make it possible
+ for expect to use Tcl_WaitForPid(). This patch is from Gordon
+ Chaffee.
+
+ * mac/tclMacPort.h:
+ * win/tclWinInit.c:
+ * unix/tclUnixPort.h:
+ * generic/tclAsync.c: Added TclpAsyncMark to fix bug in async
+ handling on Windows where async events don't wake up the event
+ loop. This patch comes from Gordon Chaffee.
+
+ * generic/tcl.decls: Fixed declarations of reserved slots.
+
+1999-03-10 <redman@scriptic.com>
+
+ * generic/tclCompile.h: Ensure that the ByteCode struct is binary
+ compatible with the version in 8.0.6.
+
+ * generic/tcl.h:
+ * generic/tclBasic.c: Add Tcl_GetVersion() function to the public
+ C API to allow programs to check the version number of the Tcl
+ library at runtime. Also added an enum to clarify the release
+ level (alpha, beta, final).
+
+1999-03-09 <stanton@GASPODE>
+
+ * Integrated changes from Tcl 8.0 including:
+ stubs mechanism
+ configure patches from Jan Nijtmans
+ rename of panic to Tcl_Panic
+
+1999-03-08 <lfb@scriptics.com>
+
+ * win/tclWin32Dll.c: Removed Dll instance from thread-local
+ storage.
+
+1999-03-08 <stanton@GASPODE>
+
+ * generic/tcl.h: Moved Tcl_Mutex, etc. macros above the inclusion
+ of tclDecls.h to avoid macro conflicts.
+
+ * generic/tclInt.h:
+ * generic/regc_color.c:
+ * generic/regcomp.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdAH.c:
+ * generic/tclIOCmd.c:
+ * generic/tclParse.c:
+ * generic/tclStringObj.c:
+ * unix/tclUnixNotfy.c: Cleaned up various compiler warnings,
+ eliminated UCHAR bugs.
+
+ * unix/tclUnixNotfy.c:
+ * unix/tclUnixThrd.c:
+ * generic/tclThreadTest.c:
+ * mac/tclMacThrd.c: Changed TclpCondition*() to Tcl_Condition*().
+
+ * INTEGRATED PATCHES FROM 8.0.6:
+
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclDecls.h:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclIntPlatStubs.c:
+ * generic/tclIntStubs.c:
+ * generic/tclPlatDecls.h:
+ * generic/tclPlatStubs.c:
+ * generic/tclStubInit.c:
+ * generic/tclStubLib.c:
+ * generic/tclStubs.c:
+ * tools/genStubs.tcl:
+ * unix/configure.in:
+ * unix/Makefile.in:
+ * unix/tclConfig.sh.in:
+ * win/makefile.vc:
+ * win/tclWinPort.h: Added Tcl stubs implementation. There are
+ now two new macros USE_TCL_STUBS and USE_TCL_STUB_PROCS that
+ enable use of stubs and disable stub macros respectively. All of
+ the public and private function declarations from tcl.h and
+ tclInt.h have moved into the *.decls files and the *Stubs.c and
+ *Decls.h files are generated using the genStubs.tcl script.
+
+ * unix/Makefile.in:
+ * unix/configure.in:
+ * unix/ldAix: Enhanced AIX shared library support.
+
+ * win/tclWinSock.c: Removed a bunch of extraneous PASCAL FAR
+ attributes from internal functions.
+
+ * win/tclWinReg.c: Changed registry package to use stubs mechanism
+ so it no longer depends on the specific version of Tcl.
+
+ * doc/AddErrInfo.3:
+ * doc/Eval.3:
+ * doc/PkgRequire.3:
+ * doc/SetResult.3:
+ * doc/StringObj.3:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclPanic.c:
+ * generic/tclStringObj.c:
+ * generic/tclUtil.c:
+ * unix/mkLinks: Added va_list versions of all VARARGS
+ functions so they can be invoked from the stub functions.
+
+ * doc/package.n:
+ * doc/PkgRequire.3:
+ * generic/tclPkg.c: Added Tcl_PkgProvideEx, Tcl_RequireEx,
+ Tcl_PresentEx, and Tcl_PkgPresent. Added "package present"
+ command.
+
+ * generic/tclFileName.c:
+ * mac/tclMacFile.c:
+ * mac/tclMacShLib.exp:
+ * unix/tclUnixFile.c:
+ * win/tclWinFile.c: Changed so TclGetUserHome is defined on
+ all platforms, even though it is currently a noop on mac and
+ windows, and renamed it to TclpGetUserHome.
+
+ * generic/tclPanic.c:
+ * generic/panic.c: Renamed panic to Tcl_Panic.
+
+1999-02-25 <redman@scriptics.com>
+
+ * win/makefile.vc: Added tclWinConsole.c and tclWinSerial.c
+
+ * win/tclWinConsole.c: New code to properly deal with fileevents
+ and nonblocking mode on consoles.
+
+ * win/tclWinSerial.c: New code to properly deal with fileevents
+ and nonblocking mode on serial ports.
+
+ * win/tclWinPipe.c:
+ * win/tclWinPort.h: Exported functions to allow creation of pipe
+ channels from tclWinChan.c
+
+ * win/tclWinChan.c: Check the type of a channel, including for the
+ standard (stdin/stdout/stderr), and use the correct channel type
+ to create the channel (file, serial, console, or pipe).
+
+1999-02-11 <stanton@GASPODE>
+
+ * README:
+ * generic/tcl.h:
+ * win/README.binary:
+ * win/README:
+ * unix/configure.in:
+ * mac/README: Updated version numbers to 8.1b2.
+
+1999-02-10 <stanton@GASPODE>
+
+ * library/auto.tcl: Fixed auto_mkindex so it handles .tbc files.
+ Did some general cleanup to handle bad eval statements that didn't
+ use "list".
+
+ * unix/mkLinks:
+ * doc/SetVar.3:
+ * generic/tcl.h:
+ * generic/tclVar.c: Restored Tcl_ObjGetVar2 and Tcl_ObjSetVar2
+ from 8.0. Renamed Tcl_Get/SetObjVar2 to Tcl_GetVar2Ex and
+ Tcl_SetVar2Ex.
+
+1999-02-10 <stanton@GASPODE>
+
+ INTEGRATED PATCHES FROM 8.0.5b2:
+
+ * test/winPipe.test: Changed to remove echoArgs.tcl temporary file
+ when done.
+
+ * tests/cmdAH.test:
+ * generic/tclFileName.c (TclGetExtension): Changed behavior so the
+ split happens at the last period in the name instead of the first
+ period of the last run of periods. So, "foo..o" is split into
+ "foo." and ".o" now. [Bug: 1126]
+
+ * win/makefile.vc: Added better support for paths with spaces in
+ the name. Added .lib and support .dlls to the install-binaries
+ target. Added generate of a pkgIndex.tcl script to the
+ install-libraries target.
+
+ * win/tclAppInit.c:
+ * unix/tclAppInit.c:
+ * mac/tclMacAppInit.c:
+ * generic/tclTest.c: Changed some EXTERN declarations to extern
+ since they are not defining exported interfaces. This avoids
+ generating useless declspec() attributes and makes the windows
+ makefile simpler.
+
+ * generic/tcl.h: Moved Tcl_AppInit declaration to end and cleared
+ out TCL_STORAGE_CLASS so it is not declared with a declspec().
+
+ * tests/interp.test:
+ * generic/tclInterp.c (DeleteAlias): Changed to use
+ Tcl_DeleteCommandFromToken so we handle renames properly. This
+ avoids senseless panic. [Bug: 736]
+
+ * unix/tclUnixChan.c:
+ * win/tclWinSock.c:
+ * doc/socket.n: Applied Gordon Chaffee's patch to handle failures
+ during asynchronous socket connection operations. This adds a new
+ "-error" fconfgure option to socket channels. [Bug: 893]
+
+ * generic/tclProc.c:
+ * generic/tclNamesp.c:
+ * generic/tclInt.h:
+ * generic/tclCmdIL.c:
+ * generic/tclBasic.c:
+ * generic/tclVar.c: Applied patch from Viktor Dukhovni to
+ rationalize TCL_LEAVE_ERR_MSG behavior when creating variables.
+
+ * generic/tclVar.c: Fixed bug in namespace tail computation.
+ Fixed bug where upvar could resurrect a namespace variable whose
+ namespace had been deleted.
+
+ * generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another
+ bogus optimization in expression compilation.
+
+ * unix/configure.in: Added branch for BSD/OS-4* to shared library
+ case statement. [Bug: 975]
+ Fixed to correctly handle IRIX 6.5 n32 library support. [Bug: 1117]
+
+ * win/winDumpExts.c: Patched to be pickier about stripping
+ @'s. [Bug: 920]
+
+ * library/http2.0/http.tcl: Added catch around eof test in
+ CopyDone since the user may have already called http::reset.
+ [Bug: 1108]
+
+ * unix/configure.in: Changed Linux and IRIX to set SHLIB_LIBS to
+ LIBS so shared libraries are linked with the system
+ libraries. [Bug: 1018]
+
+ * generic/tclCompile.c (CompileExprWord): Fixed exception stack
+ overflow bug caused by missing statement. [Bug: 928]
+
+ * generic/tclIOCmd.c:
+ * generic/tclBasic.c: Objectified the "open" command. [Bug: 1113]
+
+ * generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): When using
+ egcs, ENOTSUP and EOPNOTSUPP are the same, so now we handle that
+ case. [Bug: 1137]
+
+ * library/init.tcl: Various small changes requested by Jan Nijtmans.
+ - If the variable $tcl_library contains the empty string, this
+ empty string will be put in $auto_path. This is not useful at all,
+ it only slows down later package processing.
+ - If the variable tcl_pkgPath is not set, the "unset __dir"
+ fails. Thich makes init.tcl totally unusable. Better put a "catch"
+ around it.
+ - In the function tcl_findLibraries, the "string match" function
+ only works correctly if $tcl_patchLevel is in one of the forms
+ "?.?a?", "?.?b?" or "?.?.?". Could a "regexp" be used instead,
+ then it allows anything to be appended to the patchLevel
+ string. And it is more efficient.
+ - The tclPkgSetup function assumes that if $type != "load" then
+ the type must be "source". This needn't be true. Some users want
+ to add their own setup types.
+ [RFE: 1138] [Bug: 978]
+
+ * win/tclWinReg.c:
+ * doc/registry.n: Added support for HKEY_PERFORMANCE_DATA and
+ HKEY_DYN_DATA keys. [Bug: 1109]
+
+ * win/tclWinInit.c (TclPlatformInit): Added code to ensure
+ tcl_pkgPath is set to "" when no registry entry is found. [Bug: 978]
+
+1999-02-01 <stanton@GASPODE>
+
+ * generic/tclBasic.c:
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclExecute.c:
+ * generic/tclHistory.c:
+ * generic/tclIO.c:
+ * generic/tclIOUtil.c:
+ * generic/tclInterp.c:
+ * generic/tclMain.c:
+ * generic/tclNamesp.c:
+ * generic/tclParse.c:
+ * generic/tclProc.c:
+ * generic/tclTest.c:
+ * generic/tclTimer.c:
+ * generic/tcl.h: Made eval interfaces compatible with 8.0 by
+ renaming Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to
+ Tcl_EvalEx and restoring Tcl_EvalObj and Tcl_GlobalEvalObj
+ interfaces so they match Tcl 8.0.
+
+1999-01-28 <stanton@GASPODE>
+
+ * Merged Tcl 8.0.5b1 changes.
+
+ * generic/tclUtil.c (Tcl_DStringSetLength): Changed so the buffer
+ overallocates in a manner similar to Tcl_DStringAppend. This
+ should improve performance for TclUniCharToUtfDString.
+
+1998-12-11 === Tcl 8.1b1 Release ===
+
+1998-12-10 <stanton@GASPODE>
+
+2000-03-21 Syd Polk <spolk@cygnus.com>
+
+ * configure.in: Check for cygwin, not cygwin32.
+ * configure: Regenerate.
+
+ * generic/tclInitScript.h: Added newline at end of file to make
+ current gcc happy.
+
+1999-12-06 Mo DeJong <mdejong@cygnus.com>
+
+ * win/Makefile.in: added cl flags needed for VC++ 6.0
+
+1999-06-21 Syd Polk <spolk@cygnus.com>
+
+ * generic/tclIO.c: Bug fixes from Scriptics to get exit status
+ correct on pipe channels.
+
+1999-04-22 Syd Polk <spolk@cygnus.com>
+
+ * unix/Makefile.in: Don't install tcl.h for install-libaries.
+
+1999-02-16 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: TCL_SRC_DIR needs to have forward slashes
+ for the MS build.
+ * win/configure: Regenerate.
+ * win/tclWinInit.c: Stupid Visual C++ compiler has limit on
+ number of characters in string constant.
1999-02-11 Syd Polk <spolk@cygnus.com>
- * unix/configure.in: Forgot to AC_SUBST TCL_LIB_FULL_PATH
- * unix/configure: Regenerated.
+ * generic/tclInitScript.h: The tclInit proc that Jim Ingham wrote
+ blew MS's string buffer away, so I hacked the original in for the
+ Microsoft build, which only SN is using anyway. Yuck.
-1999-02-10 Syd Polk <spolk@cygnus.com>
+1999-02-08 Syd Polk <spolk@cygnus.com>
- * unix/configure.in unix/tclConfig.sh.in: Export TCL_LIB_FULL_PATH
- for dependencies.
+ * unix/configure.in: Fixed problem with test in --enable-symbols.
* unix/configure: Regenerated.
+ * library/auto.tcl: Fixed a problem with the regsub inside of
+ auto_mkindex since the regsub semantics changed.
-1999-01-27 James Ingham <jingham@cygnus.com>
+1999-02-04 James Ingham <jingham@cygnus.com>
- * generic/tclInitScript.h: Added two missing \n\'s to initScript
- *generic/tclCmdIL.c: Fixed #ifdef that was giving gcc warning.
+ * generic/tclInitScript.h: Change the tclInit proc to find the Tcl
+ library in both build & install trees.
+ * library/auto.tcl (tcl_findLibrary): Change tcl_findLibrary to
+ search around the executible for the tclConfig.sh, and then use
+ this to find the source tree. This works in many more cases than
+ the Scriptics version.
-1999-01-20 James Ingham <jingham@cygnus.com>
+ * configure.in: If no value is given for --enable-symbols, use the
+ value from AC_PROG_CC, this adds -g for gcc.
- * library/init.tcl (auto_mkindex_parser::mkindex): Clean out the parser
- interpreter completely between each file, rather than
- trying to remove imports by hand. The latter method loses with
- IncrTcl, since that imports the class command by hand, and if you
- ever do "namespace import itcl::*" in your code, this will get
- undone.
+1999-01-19 Ben Elliston <bje@cygnus.com>
-Tue Nov 24 18:27:40 1998 Jim Ingham jingham@cygnus.com
+ * tools/encoding/shiftjis.txt: Map tilde in ShiftJIS to tilde in
+ Unicode.
- * Import of Tcl8.0.4 from Scriptics.
+ * library/encoding/shiftjis.enc: Regenerate.
-Thu Sep 17 17:03:18 1998 Martin M. Hunt <hunt@cygnus.com>
+1998-12-21 Syd Polk <spolk@cygnus.com>
- * configure: Rebuilt
- * unix/configure: Rebuilt
+ * generic/tclCompExpr.c: Remove another instance of string
+ blasting.
-Tue Aug 25 18:13:30 1998 Jim Ingham <jingham@cygnus.com>
+ * generic/tclLiteral.c (TclDeleteLiteralTable): Make code
+ that detects infinite loops exit gracefully in production
+ build and panic in development build.
- * init.tcl (tcl_findLibrary): Added an argument determining
- whether to source a packages init file into the TclPro
- debugger or not.
+1998-12-21 Khamis Abuelkomboz <khamis@cygnus.com>
-Thu Aug 20 14:32:59 1998 Jim Ingham jingham@cygnus.com
+ * generic/tclLiteral.c (TclDeleteLiteralTable): added a daemon to catch
+ a hanging bug by deleteing a literal.
- * Import of Tcl 8.0.3 from Scriptics, with our modifications.
- I also changed the Sciptics startup code so it can find our
- libraries whether in the build tree or the install tree.
+1998-12-19 Syd Polk <spolk@cygnus.com>
-1998-07-03 Ben Elliston <bje@cygnus.com>
+ * generic/tclCompile.c (tclCompileScript): Localize modifying
+ the compiled string to the call which needs it. This prevents
+ the string getting hashed incorrectly later.
- Patches from Ian Roxborough <irox@cygnus.com>.
- * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Additional test when
- compiling with Microsoft Visual C++.
+ * generic/tclAlloc.c: Latest patch from Scriptics.
- * win/configure.in: Add AC_OBJEXT macro invocation.
+1998-12-16 Syd Polk <spolk@cygnus.com>
- * win/configure: Regenerate.
+ * tools/encoding/shiftjis.txt: Unicode character 0xFF5E
+ was missing from the shiftjis table.
+ * library/encoding/shiftjis.enc: Regnerated.
+
+1998-12-16 Ben Elliston <bje@sanguine.cygnus.com>
+
+ * generic/tclBasic.c (builtInCmds): Add `encoding'. Patch from
+ Scriptics.
+
+ * generic/tclCmdAH.c (Tcl_EncodingObjCmd): New function. Patch
+ from Scriptics.
+
+ * generic/tclEncoding.c: Changed at the same time as the rest of
+ these files, so it might be important. Patch from Scriptics.
+
+ * doc/encoding.n: New file. From Scriptics.
+
+1998-12-03 Syd Polk <spolk@cygnus.com>
+
+ * generic/tclIO.c: Integrated more complete fix to
+ channel problem from Scott Stanton at Scriptics.
- * win/Makefile.in: Don't assume object files end in `.o'.
+1998-12-02 Syd Polk <spolk@cygnus.com>
- * win/tclWinPort.h (PASCAL): Define when compiling with Microsoft
- Visual C++.
+ * generic/tclIO.c: Fixed problem when writing out to a
+ channel set to -crlf translations.
- * win/tclWinSock.c (PASCAL): Likewise.
+1998-12-02 Ian Roxborough <irox@cygnus.com>
+
+ * win/tclWinChan.c: Merged in WishCon0.1 Changes to
+ support pipe IO at console level of a WishShell.
+
+1998-11-24 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: Under MSVC, use the Tcl dumpexts method
+ to generate exports.
+ * win/tclWinPort.h tclWinSock.c: Do not #define PASCAL away.
+ It is needed in calls to DLLs.
+
+1998-11-18 Syd Polk <spolk@cygnus.com>
+
+ * generic/tclAlloc.c: Made sure that blocks are allocated on
+ eight-byte boundaries.
+ * unix/tclUnixPort.h: Added a CYGNUS LOCAL comment.
+
+1998-11-09 Ben Elliston <bje@cygnus.com>
+
+ * generic/tclVar.c (TclGetIndexedScalar): Fix a general problem
+ with compiled local variables that are upvar'ed. Contributed by
+ Scott Stanton <stanton@scriptics.com>.
+
+1998-11-04 Ian Roxborough <irox@cygnus.com>
-Tue Jun 30 18:56:27 1998 Jim Ingham <jingham@cygnus.com>
+ * win/tclWinPort.h: #endif in the wrong place and missing ')'.
+
+1998-11-06 Syd Polk <spolk@cygnus.com>
+
+ * win/tclWinPort.h: Updated from Scriptics. Tcl_Realloc no longer
+ fails with blocks that are more than 64K.
+
+1998-11-04 Ian Roxborough <irox@cygnus.com>
+
+ * generic/panic.c (panic): Removed a #define _DEBUG,
+ under MSVC if you want an exception Breakpoint instead
+ of a panic dialog, CFLAGS must contain -D_DEBUG.
+
+1998-11-03 Ian Roxborough <irox@cygnus.com>
+
+ * generic/panic.c (panic): If compiling with Microsoft, have this
+ generate an exception Breakpoint.
+
+1998-11-03 Syd Polk <spolk@cygnus.com>
+
+ * generic/panic.c: If compiling with Microsoft, have this generate
+ a core dump so that we can actually see where it is happening when
+ we have co stdout/stderr.
+
+1998-10-29 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: Removed check for caddr_t. This configure.in
+ is not really ready for autoheader and the other garbage.
+ * win/configure: Regenerated.
+ * generic/tclAlloc.c: Put declaration of caddr_t inside of
+ #ifdef _MSC_VER. It appears that this is the only compiler that
+ is missing this typedef.
+
+1998-10-29 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: The directory for encodings is called 'encoding',
+ not 'encodings'.
+
+1998-10-29 Syd Polk <spolk@cygnus.com>
+
+ * unix/configure.in: Fix merge problem with socket libraries. Run
+ autoconf test for caddr_t.
+ * unix/configure: Regenerate.
+ * win/configure.in Run autoconf test for caddr_t.
+ * win/configure: Regnerate.
+ * generic/tclAlloc.c: Remove declaration of caddr_t. Should be
+ provided by configure now.
- * generic/tclListObj.c (Tcl_SetListObj, SetListFromAny) Import a
- change to the list code from tcl8.1 which prevents a crash
- when you do Tcl_SetListObj(obj, 0, NULL) on an object which
- has been created with Tcl_NewObj, but never written into.
+1998-10-28 Syd Polk <spolk@cygnus.com>
-Thu Jun 18 10:25:00 1998 Syd Polk <spolk@cygnus.com>
+ * unix/Makefile.in: Install encodings from make install.
+ * win/Makefile.in: Install encodings from make install.
+
+1998-10-28 Ben Elliston <bje@cygnus.com>
+
+ * win/configure.in (TCL_BUILD_INCLUDES): Remove. Do not subst.
+ * win/configure: Regenerate.
+
+1998-10-26 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: Fix references to old opt0.1 library.
+
+1998-10-20 Syd Polk <spolk@cygnus.com>
+
+ * unix/Makefile.in: Fix references to old opt0.1 library.
+
+1998-10-19 Ben Elliston <bje@cygnus.com>
+
+ * unix/configure.in: Compute a value for @TCL_BUILD_INCLUDES@.
+
+ * unix/configure: Regenerate.
+
+ * unix/tclConfig.sh.in (TCL_BUILD_INCLUDES): Set.
- * The import from Tcl 8.1a2 created all of the files that wer
- in the Tcl 8.1a2 distribution but not in devo. Since they
- are on their own branch, I removed them from devo.
+ * win/configure.in: Compute a value for @TCL_BUILD_INCLUDES@.
-Fri Jun 12 11:42:30 1998 Ian Lance Taylor <ian@cygnus.com>
+ * win/configure: Regenerate.
- * win/install-sh: Remove.
+1998-10-14 Syd Polk <spolk@cygnus.com>
-Fri Jun 12 11:42:10 1998 Mumit Khan <khan@xraylith.wisc.edu>
+ * win/configure.in Makefile.in: More fixes for the tcl8.l build
+ * win/configure: Regenerated
- * configure.in (*-*-mingw32*): Support.
- * win/Makefile.in (TCL_ALLOC_OBJ, DLL_LDLIBS, DLL_LDFLAGS): New
- variables.
- (TCLOBJS): Use TCL_ALLOC_OBJ.
- ($(TMPDIR)/tclcyg.def): Ignore errors.
- ($(TMPDIR)/tclplugin.def): Likewise.
- ($(TCLDLL),$(TCLPLUGINDLL,$(TCLREGDLL)): Cleanup DLL build flags
- and use TCL_ALLOC_OBJ, DLL_LDLIBS and DLL_LDFLAGS.
- * win/configure.in: Call AC_CANONICAL_HOST.
- (TCL_ALLOC_OBJ, DLL_LDLIBS, DLL_LDFLAGS): Define and substitute.
- (TCL_PATCH_LEVEL): Bump to p2.
- * win/tclWinPort.h (environ, hypot, exception): Define for Mingw32.
- (EDEADLOCK): Undefine for Mingw32.
- * win/configure: Rebuild.
+1998-10-14 Syd Polk <spolk@cygnus.com>
+
+ * generic/tclCmdIL.c (SortCompare}: Support as much of the old
+ comparison semantics as possible. It is now possible to do
+ lsort -command {foo bar} {1 3 45}.
+ * tests/cmdIL.test (cmdIL-3.16}: Restore test.
-Fri May 29 17:11:01 1998 Ian Lance Taylor <ian@cygnus.com>
+1998-10-08 Syd Polk <spolk@cygnus.com>
- * win/Makefile.in (install-minimal): Don't create
- INCLUDE_INSTALL_DIR.
+ * generic/tclCmdIL.c (SortCompare): Make the comparison callback
+ object based for performance.
+ * tests/cmdIL.test (cmdIL-3.16): Test relied on incorrect behavior
+ of old string based comparison callback, which was a bug. Corrected
+ test.
+ * unix/configure.in: Minor fixes for gcc
+ * unix/configure: Regenerated
+ * unix/dltest/configure.in: GCC needs -f writeable-strings
+ * unix/dltest/Makefile.in: Fixed invalid TCL_CFLAGS reference
+ * unix/dltest/configure: Regenerated.
-Sun May 24 11:18:28 1998 Khamis Abuelkomboz <khamis@mxbig.multix.de>
+1998-10-01 Ben Elliston <bje@cygnus.com>
- * generic/tclCmdIL.c (Tcl_LsearchObjCmd): using strnicmp for MSVC,
- strncasecmp otherwise.
+ * generic/tclCmdIL.c (InfoEncodingsCmd): New function. Implement a
+ Tcl ``info encodings'' command.
+ (Tcl_InfoObjCmd): Detect ``encodings'' subcommand.
-Fri May 22 16:56:53 1998 Khamis Abuelkomboz <khamis@mxbig.multix.de>
+ * doc/info.n: Update documentation.
+
+1998-09-29 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: Still some hard-coded references to 8.0.
+ Fix problems with try and except
+ * win/configure.in: Likewise
+ * win/configure: Regenerated
+ * win/tclWin32Dll.c: try and except not supported under gcc.
- * generic/tclCmdIL.c (NOCASE): let lsearch accept "-nocase"
- (DICTIONARY): likewise, a synonym for "nocase".
- So you can call lsearch with a "-nocase" or "-dictionary" flag to
- use strcasecmp to find an item.
+1998-09-28 Syd Polk <spolk@cygnus.com>
+
+ * generic/tclClock.c: timezone needs to be declared somewhere
+ * win/Makefile.in: Fixed OBJEXT problems
+ * win/tclWinFile.c win/tclWinInit.c: Fixed merge problems
+ * win/tclWinPipe.c: Removed Cygnus thread stuff to use the tcl 8.1
+ thread stuff instead.
+
+1998-09-28 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: Merged from 4.2 branch
+ * win/configure: Regenerated
+ * win/Makefile.in: Updated for tcl8.1.
+
+Wed Aut 19 17:48:00 PDT 1998 Syd Polk <spolk@cygnus.com>
+
+ * 8.1 integration continues.
Thu Apr 30 18:10:15 1998 Geoffrey Noer <noer@cygnus.com>
@@ -869,3 +5257,4 @@ Sun Nov 8 21:56:26 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
* New file for GNU/Cygnus distribution of TCL.
+
diff --git a/tcl/Makefile.in b/tcl/Makefile.in
index bbe52909b5b..983d674c32a 100644
--- a/tcl/Makefile.in
+++ b/tcl/Makefile.in
@@ -3,7 +3,6 @@
# Tom Tromey <tromey@cygnus.com>
CONFIGDIR=@CONFIGDIR@
-CONFIGDIR2=@CONFIGDIR2@
VPATH = @srcdir@
SHELL = @SHELL@
@@ -11,17 +10,12 @@ SRC_DIR = @srcdir@
@SET_MAKE@
-all:
- @cd $(CONFIGDIR) && $(MAKE) $@
- @test x"$(CONFIGDIR2)" = x"" || (cd "$(CONFIGDIR2)" && $(MAKE) $@)
-
-install test install-binaries install-libraries install-minimal:
+all install test install-binaries install-libraries install-minimal:
@cd $(CONFIGDIR) && $(MAKE) $@
mostlyclean-recursive clean-recursive distclean-recursive \
maintainer-clean-recursive:
@cd $(CONFIGDIR) && $(MAKE) `echo $@ | sed 's/-recursive//'`
- @test x"$(CONFIGDIR2)" = x"" || (cd "$(CONFIGDIR2)" && $(MAKE) `echo $@ | sed 's/-recursive//'`)
configure:
cd $(SRC_DIR) && autoconf
@@ -70,3 +64,4 @@ Makefile: Makefile.in config.status
config.status: configure
$(SHELL) config.status --recheck
+
diff --git a/tcl/README b/tcl/README
index c2ba9689946..55ae9576f02 100644
--- a/tcl/README
+++ b/tcl/README
@@ -1,52 +1,73 @@
-Tcl
+README: Tcl
+ This is the Tcl 8.3.2 source distribution.
+ You can get any release of Tcl from:
+ http://dev.scriptics.com/registration/<version>.tml
+ Tcl/Tk is also available through NetCVS:
+ http://dev.scriptics.com/software/tcltk/netcvs.html
RCS: @(#) $Id$
+Contents
+--------
+ 1. Introduction
+ 2. Documentation
+ 3. Compiling and installing Tcl
+ 4. Development tools
+ 5. Tcl newsgroup
+ 6. Tcl contributed archive
+ 7. Tcl Resource Center
+ 8. Mailing lists
+ 9. Support and Training
+ 10. Thank You
+
1. Introduction
---------------
+Tcl provides a powerful platform for creating integration
+applications that tie together diverse applications, protocols,
+devices, and frameworks. When paired with the Tk toolkit, Tcl
+provides the fastest and most powerful way to create GUI applications
+that run on PCs, Unix, and the Macintosh. Tcl can also be used for a
+variety of web-related tasks and for creating powerful command
+languages for applications.
+
+Tcl is maintained, enhanced, and distributed freely as a
+service to the Tcl community by Scriptics Corporation.
+The official home for Tcl/Tk is on the Scriptics Web site:
-This directory and its descendants contain the sources and documentation
-for Tcl, an embeddable scripting language. The information here
-corresponds to release 8.0.4, which is the fourth patch update for Tcl
-8.0. This patch provides compatibility with [incr Tcl] 3.0.
-Tcl 8.0 is a major new release that replaces the core of the
-interpreter with an on-the-fly bytecode compiler to improve execution
-speed. It also includes several other new features such as namespaces
-and binary I/O, plus many bug fixes. The compiler introduces a few
-incompatibilities that may affect existing Tcl scripts; the
-incompatibilities are relatively obscure but may require modifications
-to some old scripts before they can run with this version. The compiler
-introduces many new C-level APIs, but the old APIs are still supported.
-See below for more details. This patch release fixes various bugs in
-Tcl 8.0, plus it adds a few minor features to support the TclPro 1.0
-tool set and [incr Tcl] 3.0. Please check the changes file for details.
+ http://dev.scriptics.com
+
+Tcl is a freely available open source package. You can do virtually
+anything you like with it, such as modifying it, redistributing it,
+and selling it either in whole or in part. See the file
+"license.terms" for complete information.
2. Documentation
-----------------
+---------------
-The best way to get started with Tcl is to read one of the introductory
-books on Tcl:
+Extensive documentation is available at our website.
+The home page for this release, including new features, is
+ http://dev.scriptics.com/software/tcltk/8.3.html
- Practical Programming in Tcl and Tk, 2nd Edition, by Brent Welch,
- Prentice-Hall, 1997, ISBN 0-13-616830-2
+Detailed release notes can be found at
+ http://dev.scriptics.com/software/tcltk/relnotes/tcl8.3.2.txt
- Tcl and the Tk Toolkit, by John Ousterhout,
- Addison-Wesley, 1994, ISBN 0-201-63337-X
+Information about Tcl itself can be found at
+ http://dev.scriptics.com/scripting/
- Exploring Expect, by Don Libes,
- O'Reilly and Associates, 1995, ISBN 1-56592-090-2
+There are many Tcl books on the market. Most are listed at
+ http://dev.scriptics.com/resource/doc/books/
-Other books are listed at
-http://www.scriptics.com/resource/doc/books/
-http://www.tclconsortium.org/resources/books.html
+2a. Unix Documentation
+----------------------
-The "doc" subdirectory in this release contains a complete set of reference
-manual entries for Tcl. Files with extension ".1" are for programs (for
-example, tclsh.1); files with extension ".3" are for C library procedures;
-and files with extension ".n" describe Tcl commands. The file "doc/Tcl.n"
-gives a quick summary of the Tcl language syntax. To print any of the man
-pages, cd to the "doc" directory and invoke your favorite variant of
-troff using the normal -man macros, for example
+The "doc" subdirectory in this release contains a complete set of
+reference manual entries for Tcl. Files with extension ".1" are for
+programs (for example, tclsh.1); files with extension ".3" are for C
+library procedures; and files with extension ".n" describe Tcl
+commands. The file "doc/Tcl.n" gives a quick summary of the Tcl
+language syntax. To print any of the man pages on Unix, cd to the
+"doc" directory and invoke your favorite variant of troff using the
+normal -man macros, for example
ditroff -man Tcl.n
@@ -56,218 +77,44 @@ using the normal "man" mechanisms, such as
man Tcl
-There is also an official home for Tcl and Tk on the Web:
- http://www.scriptics.com
-These Web pages include information about the latest releases, products
-related to Tcl and Tk, reports on bug fixes and porting issues, HTML
-versions of the manual pages, and pointers to many other Tcl/Tk Web
-pages at other sites. Check them out!
+2b. Windows Documentation
+-------------------------
+
+The "doc" subdirectory in this release contains a complete set of
+Windows help files for Tcl. Once you install this Tcl release, a
+shortcut to the Windows help Tcl documentation will appear in the
+"Start" menu:
+
+ Start | Programs | Tcl | Tcl Help
3. Compiling and installing Tcl
-------------------------------
-This release contains everything you should need to compile and run
-Tcl under UNIX, Macintoshes, and PCs (either Windows NT, Windows 95,
-or Win 3.1 with Win32s).
-
-Before trying to compile Tcl you should do the following things:
-
- (a) Check for a binary release. Pre-compiled binary releases are
- available now for PCs, Macintoshes, and several flavors of UNIX.
- Binary releases are much easier to install than source releases.
- To find out whether a binary release is available for your
- platform, check the Scriptics Tcl Resource Center
- (http://www.scriptics.com/resource). Also, check in
- the FTP directory from which you retrieved the base
- distribution.
-
- (b) Make sure you have the most recent patch release. Look in the
- FTP directory from which you retrieved this distribution to see
- if it has been updated with patches. Patch releases fix bugs
- without changing any features, so you should normally use the
- latest patch release for the version of Tcl that you want.
- Patch releases are available in two forms. A file like
- tcl8.0.4.tar.Z is a complete release for patch level 4 of Tcl
- version 8.0. If there is a file with a higher patch level than
- this release, just fetch the file with the highest patch level
- and use it.
-
- Patches are also available in the form of patch files that just
- contain the changes from one patch level to another. These
- files will have names like tcl8.0p1.patch, tcl8.0p2.patch, etc. They
- may also have .gz or .Z extensions to indicate compression. To
- use one of these files, you apply it to an existing release with
- the "patch" program. Patches must be applied in order:
- tcl8.0p1.patch must be applied to an unpatched Tcl 8.0 release
- to produce a Tcl 8.0p1 release; tcl8.0p2.patch can then be
- applied to Tcl8.0p1 to produce Tcl 8.0p2, and so on. To apply an
- uncompressed patch file such as tcl8.0p1.patch, invoke a shell
- command like the following from the directory containing this
- file (some versions of patch require "-p0"):
- patch -p < tcl8.0p1.patch
- If the patch file has a .gz extension, invoke a command like the
- following:
- gunzip -c tcl8.0p1.patch.gz | patch -p
- If the patch file has a .Z extension, it was compressed with
- compress. To apply it, invoke a command like the following:
- zcat tcl8.0p1.patch.Z | patch -p
- If you're applying a patch to a release that has already been
- compiled, then before applying the patch you should cd to the
- "unix" subdirectory and type "make distclean" to restore the
- directory to a pristine state.
-
-Once you've done this, change to the "unix" subdirectory if you're
-compiling under UNIX, "win" if you're compiling under Windows, or
-"mac" if you're compiling on a Macintosh. Then follow the instructions
-in the README file in that directory for compiling Tcl, installing it,
-and running the test suite.
-
-4. Summary of changes in Tcl 8.0
---------------------------------
-
-Here are the most significant changes in Tcl 8.0. In addition to these
-changes, there are several smaller changes and bug fixes. See the file
-"changes" for a complete list of all changes.
-
- 1. Bytecode compiler. The core of the Tcl interpreter has been
- replaced with an on-the-fly compiler that translates Tcl scripts to
- byte codes; a new interpreter then executes the byte codes. In
- earlier versions of Tcl, strings were used as a universal
- representation; in Tcl 8.0 strings are replaced with Tcl_Obj
- structures ("objects") that can hold both a string value and an
- internal form such as a binary integer or compiled bytecodes. The
- new objects make it possible to store information in efficient
- internal forms and avoid the constant translations to and from
- strings that occurred with the old interpreter. We have not yet
- converted all of Tcl to take full advantage of the compiler and
- objects and have not converted any of Tk yet, but even so you
- should see speedups of 2-3x on many programs and you may see
- speedups as much as 10-20x in some cases (such as code that
- manipulates long lists). Future releases should achieve even
- greater speedups. The compiler introduces only a few minor changes
- at the level of Tcl scripts, but it introduces many new C APIs for
- managing objects. See, for example, the manual entries doc/*Obj*.3.
-
- 2. Namespaces. There is a new namespace mechanism based on the
- namespace implementation by Michael McLennan of Lucent Technologies.
- This includes new "namespace" and "variable" commands. There are
- many new C APIs associated with namespaces, but they will not be
- exported until Tcl 8.1. Note: the syntax of the namespace command
- has been changed slightly since the b1 release. See the changes
- file for details.
-
- 3. Binary I/O. The new object system in Tcl 8.0 supports binary
- strings (internally, strings are counted in addition to being null
- terminated). There is a new "binary" command for inserting and
- extracting data to/from binary strings. Commands such as "puts",
- "gets", and "read" commands now operate correctly on binary data.
- There is a new variable tcl_platform(byteOrder) to identify the
- native byte order for the current host.
-
- 4. Random numbers. The "expr" command now contains a random number
- generator, which can be accessed via the "rand()" and "srand()" math
- functions.
-
- 5. Safe-Tcl enhancements. There is a new "hidden command"
- mechanism, implemented with the Tcl commands "interp hide", "interp
- expose", "interp invokehidden", and "interp hidden" and the C APIs
- Tcl_HideCommand and Tcl_ExposeCommand. There is now support for
- safe packages and extension loading, including new library
- procedures such as safe::interpCreate (see the manual entry safe.n
- for details).
-
- 6. There is a new package "registry" available under Windows for
- accessing the Windows registry.
-
- 7. There is a new command "file attributes" for getting and setting
- things like permissions and owner. There is also a new command
- "file nativename" for getting back the platform-specific name for a
- particular file.
-
- 8. There is a new "fcopy" command to copy data between channels.
- This replaces and improves upon the not-so-secret unsupported old
- command "unsupported0".
-
- 9. There is a new package "http" for doing GET, POST, and HEAD
- requests via the HTTP/1.0 protocol. See the manual entry http.n
- for details.
-
- 10. There are new library procedures for finding word breaks in
- strings. See the manual entry library.n for details.
-
- 11. There are new C APIs Tcl_Finalize (for cleaning up before
- unloading the Tcl DLL) and Tcl_Ungets for pushing bytes back into a
- channel's input buffer.
-
- 12. Tcl now supports serial I/O devices on Windows and Unix, with a
- new fconfigure -mode option. The Windows driver does not yet
- support event-driven I/O.
-
- 13. The lsort command has new options -dictionary and -index. The
- -index option allows for very rapid sorting based on an element
- of a list.
-
- 14. The event notifier has been completely rewritten (again). It
- should now allow Tcl to use an external event loop (like Motif's)
- when it is embedded in other applications. No script-level
- interfaces have changed, but many of the C APIs have.
-
-Tcl 8.0 introduces the following incompatibilities that may affect Tcl
-scripts that worked under Tcl 7.6 and earlier releases:
-
- 1. Variable and command names may not include the character sequence
- "::" anymore: this sequence is now used as a namespace separator.
-
- 2. The semantics of some Tcl commands have been changed slightly to
- maximize performance under the compiler. These incompatibilities
- are documented on the Web so that we can keep the list up-to-date.
- See the URL http://www.sunlabs.com/research/tcl/compiler.html.
-
- 3. 2-digit years are now parsed differently by the "clock" command
- to handle year 2000 issues better (years 00-38 are treated as
- 2000-2038 instead of 1900-1938).
-
- 4. The old Macintosh commands "cp", "mkdir", "mv", "rm", and "rmdir"
- are no longer supported; all of these features are now available on
- all platforms via the "file" command.
-
- 5. The variable tcl_precision is now shared between interpreters
- and defaults to 12 digits instead of 6; safe interpreters cannot
- modify tcl_precision. The new object system in Tcl 8.0 causes
- floating-to-string conversions (and the associated rounding) to
- occur much less often than in Tcl 7.6, which can sometimes cause
- behavioral changes.
-
- 6. The C APIs associated with the notifier have changed substantially.
-
- 7. The procedures Tcl_CreateModalTimeout and Tcl_DeleteModalTimeout
- have been removed.
-
- 8. Tcl_CreateFileHandler and Tcl_DeleteFileHandler now take Unix
- fd's and are only supported on the Unix platform
-
- 9. The C APIs for creating channel drivers have changed as part of
- the new notifier implementation. The Tcl_File interfaces have been
- removed. Tcl_GetChannelFile has been replaced with
- Tcl_GetChannelHandle. Tcl_MakeFileChannel now takes a platform-
- specific file handle. Tcl_DriverGetOptionProc procedures now take
- an additional interp argument.
+There are brief notes in the unix/README, win/README, and mac/README
+about compiling on these different platforms. There is additional
+information about building Tcl from sources at
+ http://dev.scriptics.com/support/howto/compile.html
-5. Tcl newsgroup
------------------
-There is a network news group "comp.lang.tcl" intended for the exchange
-of information about Tcl, Tk, and related applications. Feel free to use
-the newsgroup both for general information questions and for bug reports.
-We read the newsgroup and will attempt to fix bugs and problems reported
-to it.
+4. TclPro Development tools
+--------------------
+
+A high quality set of commercial development tools is now available to
+accelerate your Tcl application development. Scriptics' TclPro
+product provides a debugger, static code checker, packaging utility,
+and bytecode compiler. Visit the Scriptics Web site at:
+
+ http://dev.scriptics.com/tclpro
+
+for more information on TclPro and for a free evaluation download.
+
+5. Tcl newsgroup
+----------------
-When using comp.lang.tcl, please be sure that your e-mail return address
-is correctly set in your postings. This allows people to respond directly
-to you, rather than the entire newsgroup, for answers that are not of
-general interest. A bad e-mail return address may prevent you from
-getting answers to your questions. You may have to reconfigure your news
-reading software to ensure that it is supplying valid e-mail addresses.
+There is a network news group "comp.lang.tcl" intended for the
+exchange of information about Tcl, Tk, and related applications. The
+newsgroup is a great place to ask general information questions. For
+bug reports, please see the "Support and bug fixes" section below.
6. Tcl contributed archive
--------------------------
@@ -275,126 +122,86 @@ reading software to ensure that it is supplying valid e-mail addresses.
Many people have created exciting packages and applications based on Tcl
and/or Tk and made them freely available to the Tcl community. An archive
of these contributions is kept on the machine ftp.neosoft.com. You
-can access the archive using anonymous FTP; the Tcl contributed archive is
+can access the archive using anonymous FTP; the Tcl contributed archive is
in the directory "/pub/tcl". The archive also contains several FAQ
("frequently asked questions") documents that provide solutions to problems
that are commonly encountered by TCL newcomers.
7. Tcl Resource Center
----------------------
-Visit http://www.scritics.com/resource/ to see an annotated index of
+
+Visit http://dev.scriptics.com/resource/ to see an annotated index of
many Tcl resources available on the World Wide Web. This includes
-papers, books, and FAQs, as well as extensions, applications, binary
-releases, and patches. You can contribute patches by sending them
-to <patches@scriptics.com>. You can also recommend more URLs for the
-resource center using the forms labeled "Add a Resource".
+papers, books, and FAQs, as well as development tools, extensions,
+applications, binary releases, and patches. You can also recommend
+additional URLs for the resource center using the forms labeled "Add a
+Resource".
8. Mailing lists
----------------
A couple of Mailing List have been set up to discuss Macintosh or
-Windows related Tcl issues. In order to use these Mailing Lists you
-must have access to the internet. To subscribe send a message to:
+Windows related Tcl issues. To subscribe send a message to:
wintcl-request@tclconsortium.org
mactcl-request@tclconsortium.org
In the body of the message (the subject will be ignored) put:
- subscribe mactcl Joe Blow
+ subscribe mactcl Joe Smith
-Replacing Joe Blow with your real name, of course. (Use wintcl
-instead of mactcl if your interested in the Windows list.) If you
+Replace Joe Smith with your real name, of course. (Use wintcl
+instead of mactcl if you're interested in the Windows list.) If you
would just like to receive more information about the list without
subscribing put the line:
information mactcl
-in the body instead (or wintcl).
+(or wintcl) in the body instead.
-9. Support and bug fixes
+9. Support and Training
------------------------
-We're very interested in receiving bug reports and suggestions for
-improvements. We prefer that you send this information to the
-comp.lang.tcl newsgroup rather than to any of us at Scriptics. We'll see
-anything on comp.lang.tcl, and in addition someone else who reads
-comp.lang.tcl may be able to offer a solution. The normal turn-around
-time for bugs is 3-6 weeks. Enhancements may take longer and may not
+Scriptics is very interested in receiving bug reports, patches, and
+suggestions for improvements. We prefer that you send this
+information to us via the bug form on the Scriptics Web site, rather
+than emailing us directly. The bug form is at:
+
+ http://dev.scriptics.com/ticket/
+
+The bug form was designed to give uniform structure to bug reports as
+well as to solicit enough information to minimize followup questions.
+The bug form also includes an option to automatically post your report
+on comp.lang.tcl. We strongly recommend that you select this option
+because someone else who reads comp.lang.tcl may be able to offer a
+solution.
+
+We will log and follow-up on each bug, although we cannot promise a
+specific turn-around time. Enhancements may take longer and may not
happen at all unless there is widespread support for them (we're
-trying to slow the rate at which Tcl turns into a kitchen sink). It's
-very difficult to make incompatible changes to Tcl at this point, due
-to the size of the installed base.
-
-When reporting bugs, please provide a short tclsh script that we can
-use to reproduce the bug. Make sure that the script runs with a
-bare-bones tclsh and doesn't depend on any extensions or other
-programs, particularly those that exist only at your site. Also,
-please include three additional pieces of information with the
-script:
- (a) how do we use the script to make the problem happen (e.g.
- what things do we click on, in what order)?
- (b) what happens when you do these things (presumably this is
- undesirable)?
- (c) what did you expect to happen instead?
+trying to slow the rate at which Tcl/Tk turns into a kitchen sink).
+It's very difficult to make incompatible changes to Tcl/Tk at this
+point, due to the size of the installed base.
The Tcl community is too large for us to provide much individual
-support for users. If you need help we suggest that you post questions
-to comp.lang.tcl. We read the newsgroup and will attempt to answer
-esoteric questions for which no-one else is likely to know the answer.
-In addition, Tcl support and training are available commercially from
-Scriptics (info@scriptics.com), NeoSoft (info@neosoft.com),
-Computerized Processes Unlimited (gwl@cpu.com),
-and Data Kinetics (education@dkl.com).
-
-10. Tcl version numbers
-----------------------
+support for users. If you need help we suggest that you post
+questions to comp.lang.tcl. We read the newsgroup and will attempt to
+answer esoteric questions for which no-one else is likely to know the
+answer. In addition, Tcl/Tk support and training are available
+commercially from Scriptics at:
+
+ http://dev.scriptics.com/training
+
+Also see the following Web site for links to other organizations that
+offer Tcl/Tk training:
+
+ http://www.scriptics.com/resource/community/commercial/training
+
+10. Thank You
+-------------
+
+We'd like to express our thanks to the Tcl community for all the
+helpful suggestions, bug reports, and patches we have received.
+Tcl/Tk has improved vastly and will continue to do so with your help.
+
-You can test the current version of Tcl by examining the
-tcl_version and tcl_patchLevel variables. The tcl_patchLevel
-variable follows the naming rules outlined below (e.g., 8.0.4).
-The tcl_version just has the major.minor numbers in it (e.g., 8.0)
-
-Each Tcl release is identified by two numbers separated by a dot, e.g.
-6.7 or 7.0. If a new release contains changes that are likely to break
-existing C code or Tcl scripts then the major release number increments
-and the minor number resets to zero: 6.0, 7.0, etc. If a new release
-contains only bug fixes and compatible changes, then the minor number
-increments without changing the major number, e.g. 7.1, 7.2, etc. If
-you have C code or Tcl scripts that work with release X.Y, then they
-should also work with any release X.Z as long as Z > Y.
-
-Alpha and beta releases have an additional suffix of the form a2 or b1.
-For example, Tcl 7.0b1 is the first beta release of Tcl version 7.0,
-Tcl 7.0b2 is the second beta release, and so on. A beta release is an
-initial version of a new release, used to fix bugs and bad features before
-declaring the release stable. An alpha release is like a beta release,
-except it's likely to need even more work before it's "ready for prime
-time". New releases are normally preceded by one or more alpha and beta
-releases. We hope that lots of people will try out the alpha and beta
-releases and report problems. We'll make new alpha/beta releases to fix
-the problems, until eventually there is a beta release that appears to
-be stable. Once this occurs we'll make the final release.
-
-We can't promise to maintain compatibility among alpha and beta releases.
-For example, release 7.1b2 may not be backward compatible with 7.1b1, even
-though the final 7.1 release will be backward compatible with 7.0. This
-allows us to change new features as we find problems during beta testing.
-We'll try to minimize incompatibilities between beta releases, but if
-a major problem turns up then we'll fix it even if it introduces an
-incompatibility. Once the official release is made then there won't
-be any more incompatibilities until the next release with a new major
-version number.
-
-(Note: This compatibility is true for Tcl scripts, but historically the Tcl
-C APIs have changed enough between releases that you may need to work a bit to
-upgrade extensions.)
-
-Patch releases have a suffix such as p1 or p2. These releases contain
-bug fixes only. A patch release (e.g Tcl 7.6p2) should be completely
-compatible with the base release from which it is derived (e.g. Tcl
-7.6), and you should normally use the highest available patch release.
-
-As of 8.0.3, the patch releases use a second . instead of 'p'. So, the
-8.0 release went to 8.0p1, 8.0p2, 8.0.3, and 8.0.4. The alphas and betas
-will still use the 'a' and 'b' letters in their tcl_patchLevel.
diff --git a/tcl/changes b/tcl/changes
index 0c52f738e43..29e46fd66c6 100644
--- a/tcl/changes
+++ b/tcl/changes
@@ -1,6 +1,6 @@
Recent user-visible changes to Tcl:
-SCCS: @(#) changes 1.338 97/11/25 08:30:52
+RCS: @(#) $Id$
1. No more [command1] [command2] construct for grouping multiple
commands on a single command line.
@@ -1337,7 +1337,7 @@ to platform, which messes up Tcl tests. Tcl_ErrnoMsg uses the standard
POSIX messages for all the common signals, and calls strerror for
signals it doesn't understand.
------------------ Released patch 7.5p2, 9/15/95 -----------------------
+----------------- Released patch 7.4p2, 9/15/95 -----------------------
----------------- Released 7.5a1, 9/15/95 -----------------------
@@ -2547,7 +2547,7 @@ changes are to expressions and lists.
incorrect programs that took advantage of behavior of the old
implementation that was not documented in the man pages.
Other changes to Tcl scripts are discussed in the web page at
-http://www.sunlabs.com/research/tcl/compiler.html. (BL)
+http://www.scriptics.com/doc/compiler.html. (BL)
*** POTENTIAL INCOMPATIBILITY ***
10/21/96 (new feature) In earlier versions of Tcl, strings were used as a
@@ -3115,7 +3115,7 @@ activity. A refcount bug triggered a panic in Tcl_ListObjAppendElement. (BW)
7/8/97 (bug fix) Relaxed the pattern matching on http_get so you do not
need a trailing path component. You can now get away with just
-http_get sunscript.sun.com (BW)
+http_get www.scriptics.com (BW)
7/9/97 (bug fix) Creating anonymous interpreters no longer smashes existing
commands with names similar to the generated name. Previously creating an
@@ -3451,7 +3451,7 @@ Universal Headers V.3.0, so that Tcl will compile with CW Pro 2.
-gmt flag set. Thanks to Jan Nijtmans for reporting the problem. (RJ)
----------------- Released 8.0p2, 11/25/97 -----------------------
-
+
12/3/97 (bug fix/optimization) Removed uneeded and potentially dangerous
instances of double evaluations if "if" and "expr" statements from
the library files. It is recommended that unless you need a double
@@ -3605,3 +3605,1310 @@ the import links move to the new name, and if you delete a command then
the import links get lost. These semantics have not changed.) (MC)
-------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/10/98 ------
+
+9/3/98 (bug fix) Tcl_Realloc was failing under Windows because the
+GlobalReAlloc API was not correctly re-allocating blocks that were
+32k+. The fix was to use newer Win32 APIs (HeapAlloc, HeapFree, and
+HeapReAlloc.) (BS)
+
+10/5/98 (bug fix) Fixed bug in pkg_mkIndex that caused some files that do
+a "package require" of packages in the Tcl libraries to give a warning like
+ warning: "xx.tcl" provides more than one package ({xx 2.0} {yy 0.3})
+and generate a broken pkgIndex.tcl file. (EMS)
+
+10/5/98 (bug fix) Pkg_mkIndex was not doing a case-insensitive comparison
+of extensions to determine whether to load or source a file. Thus, under
+Windows, MYDLLNAME.DLL was sourced, and mydllname.dll loaded. (EMS)
+
+10/5/98 (new feature) Created a new Tcl_Obj type, "procbody". This object's
+internal representation holds a pointer to a Proc structure. Extended
+TclCreateProc to take both strings and "procbody". (EMS)
+
+10/13/98 (bug fix) The "info complete" command can now handle strings
+with NULLs embedded. Thanks to colin@field.medicine.adelaide.edu.au
+for providing this fix. (RJ)
+
+10/13/98 (bug fix) The "lsort -dictionary" command did not properly
+handle some numbers starting with 0. Thanks to Richard Hipp
+<drh@acm.org> for submitting the fix to Scriptics. (RJ)
+
+10/13/98 (bug fix) The function Tcl_SetListObj was creating an invalid
+Tcl_Obj if the list had zero elements (despite what the comments said
+it would do). Thanks to Sebastian Wangnick for reporting the
+problem. (RJ)
+
+10/20/98 (new feature) Added tcl_platform(debug) element to the
+tcl_platform array on Windows platform. The existence of the debug
+element of the tcl_platform array indicates that the particular Tcl
+shell has been compiled with debug information. Using
+"info exists tcl_platform(debug)" a Tcl script can direct the
+interpreter to load debug versions of DLLs with the load
+command. (SKS)
+
+10/20/98 (feature change) The Makefile and configure scripts have been
+changed for IRIX to build n32 binaries instead of the old 32 abi
+format. If you have extensions built with the o32 abi's you will need
+to update them to n32 for them to work with Tcl. (RJ)
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/23/98 (bug fix) tcl_findLibrary had a stray ] in one of the
+pathnames it searched for the initialization script. tclInitScript.h
+was incorrectly adding the parent of tcl_library to tcl_pkgPath. This
+logic was moved into init.tcl, and the initialization of auto_path was
+documented. Thanks to Donald Porter and Tom Silva for related
+patches. (BW)
+
+10/29/98 (bug fix) Fixed Tcl_NotifyChannel to use Tcl_Preserve instead
+of Tcl_RegisterChannel so that 1) unregistered channels do not get
+closed after their first fileevent, and 2) errors that occur during
+close in a fileevent script are actually reflected by the close
+command. (BW)
+
+10/30/98 (bug fix) Overhaul of pkg_mkIndex to deal with transitive
+package requires and packages split among scripts and binary files.
+Also fixed ommision of global for errorInfo in tcl_findLibrary. (BW)
+
+11/08/98 (bug fix) Fixed the resource command to always detect
+the case where a file is opened a second time with the same
+permissions. IM claims that this will always cause the same
+FileRef to be returned, but in MacOS 8.1+, this is no longer the case,
+so we have to test for this explicitly. (JI)
+
+11/10/98 (feature change) When compiling with Metrowerk's MSL, use the
+exit function from MSL rather than ExitToShell. This allows MSL to
+clean up its temporary files. Thanks to Vince Darley for this
+improvement. (JI)
+
+----------------- Released 8.0.4, 11/19/98 -------------------------
+
+11/20/98 (bug fix) Handle possible NULL return in TclGetStdFiles. (RJ)
+
+11/20/98 (bug fix) The dltests would not build on SGI. They reported
+that you could not mix n32 with 032 binaries. The configure script
+has been modified to get the EXTRA_CFLAGS from the tcl configure
+script. [Bug id: 840] (RJ)
+
+12/3/98 (bug fix) Windows NT creates sockets so they are inheritable
+by default. Fixed socket code so it turns off this bit right after
+creation so sockets aren't kept open by exec'ed processes. [Bug: 892]
+Thanks to Kevin Kenny for this fix. (SS)
+
+1/11/98 (bug fix) On HP, "info sharedlibextension" was returning
+empty string on static apps. It now always returns ".sl". (RJ)
+
+1/28/99 (configure change) Now support -pipe option on gcc. (RJ)
+
+2/2/99 (bug fix) Fixed initialization problem on Windows where no
+searching for init.tcl would be performed if the registry keys were
+missing. (stanton)
+
+2/2/99 (bug fix) Added support for HKEY_PERFORMANCE_DATA and
+HKEY_DYN_DATA keys in the "registry" command. (stanton)
+
+2/2/99 (bug fix) ENOTSUP and EOPNOTSUPP clashed on some Linux
+variants. (stanton)
+
+2/2/99 (enhancement) The "open" command has been changed to use the
+object interfaces. (stanton)
+
+2/2/99 (bug fix) In some cases Tcl would crash due to an overflow of
+the exception stack resulting from a missing byte code in some
+expressions. (stanton)
+
+2/2/99 (bug fix) Changed configure so Linux and IRIX shared libraries
+are linked with the system libraries. (stanton)
+
+2/2/99 (bug fix) Added support for BSDI 4.x (BSD/OS-4*) to the
+configure script. (stanton)
+
+2/2/99 (bug fix) Fixed bug where upvar could resurrect a namespace
+variable after the namespace had been deleted. (stanton)
+
+2/2/99 (bug fix) In some cases when creating variables, the
+interpreter result was being modified even if the TCL_LEAVE_ERR_MSG
+flag was set. (stanton)
+
+2/2/99 (bug fix & new feature) Changed the socket drivers to properly
+handle failures during an async socket connection. Added a new
+fconfigure option "-error" to retrieve the failure message. See the
+socket.n manual entry for details. (stanton)
+
+2/2/99 (bug fix) Deleting a renamed interp alias could result in a
+panic. (stanton)
+
+2/2/99 (feature change/bug fix) Changed the behavior of "file
+extension" so that it splits at the last period. Now the extension of
+a file like "foo..o" is ".o" instead of "..o" as in previous versions.
+*** POTENTIAL INCOMPATIBILITY ***
+
+----------------- Released 8.0.5, 3/9/99 -------------------------
+
+======== Changes for 8.0 go above this line ========
+======== Changes for 8.1 go below this line ========
+
+6/18/97 (new feature) Tcl now supports international character sets:
+ - All C APIs now accept UTF-8 strings instead of iso8859-1 strings,
+ wherever you see "char *", unless explicitly noted otherwise.
+ - All Tcl strings represented in UTF-8, which is a convenient
+ multi-byte encoding of Unicode. Variable names, procedure names,
+ and all other values in Tcl may include arbitrary Unicode characters.
+ For example, the Tcl command "string length" returns how many
+ Unicode characters are in the argument string.
+ - For Java compatibility, embedded null bytes in C strings are
+ represented as \xC080 in UTF-8 strings, but the null byte at the end
+ of a UTF-8 string remains \0. Thus Tcl strings once again do not
+ contain null bytes, except for termination bytes.
+ - For Java compatibility, "\uXXXX" is used in Tcl to enter a Unicode
+ character. "\u0000" through "\uffff" are acceptable Unicode
+ characters.
+ - "\xXX" is used to enter a small Unicode character (between 0 and 255)
+ in Tcl.
+ - Tcl automatically translates between UTF-8 and the normal encoding for
+ the platform during interactions with the system.
+ - The fconfigure command now supports a -encoding option for specifying
+ the encoding of an open file or socket. Tcl will automatically
+ translate between the specified encoding and UTF-8 during I/O.
+ See the directory library/encoding to find out what encodings are
+ supported (eventually there will be an "encoding" command that
+ makes this information more accessible).
+ - There are several new C APIs that support UTF-8 and various encodings.
+ See Utf.3 for procedures that translate between Unicode and UTF-8
+ and manipulate UTF-8 strings. See Encoding.3 for procedures that
+ create new encodings and translate between encodings. See
+ ToUpper.3 for procedures that perform case conversions on UTF-8
+ strings.
+
+9/18/97 (enhancement) Literal objects are now shared by the ByteCode
+structures created when compiled different scripts. This saves up to 45%
+of the total memory needed for all literals. (BL)
+
+9/24/97 (bug fixes) Fixed Tcl_ParseCommand parsing of backslash-newline
+sequences at start of command words. Suppressed Tcl_EvalDirect error logging
+if non-TCL_OK result wasn't an error. (BL)
+
+10/17/97 (feature enhancement) "~username" now refers to the users' home
+directory on Windows (previously always returned failure). (CCS)
+
+10/20/97 (implementation change) The Tcl parser has been completely rewritten
+to make it more modular. It can now be used to parse a script without actually
+executing it. The APIs for the new parser are not correctly exported, but
+they will eventually be exported and augmented with Tcl commands so that
+Tcl scripts can parse other Tcl scripts. (JO)
+
+10/21/97 (API change) Added "flags" argument to Tcl_EvalObj, removed
+Tcl_GlobalEvalObj procedure. Added new procedures Tcl_Eval2 and
+Tcl_EvalObjv. (JO)
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/22/97 (API change) Renamed Tcl_ObjSetVar2 and Tcl_ObjGetVar2 to
+Tcl_SetObjVar2 and Tcl_GetObjVar2 (for consistency with other C APIs)
+and changed the name arguments to be strings instead of objects. (JO)
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/27/97 (enhancement) Bytecode compiler rewritten to use the new Tcl
+parser. (BL)
+
+11/3/97 (New routines) Added Tcl_AppendObjToObj, which appends the
+string rep of one Tcl_Obj to another. Added Tcl_GetIndexFromObjStruct,
+which is similar to Tcl_GetIndexFromObj, except that you can give an
+offset between strings. This allows Tcl_GetIndexFromObjStruct to be
+called with a table of records which have strings in them. (SRP)
+
+12/4/97 (enhancement) New Tcl expression parser added. Added new procedure
+Tcl_ParseExpr and new token types TCL_TOKEN_SUB_EXPR and
+TCL_TOKEN_OPERATOR. Expression compiler is reimplemented to use this
+parser. (BL)
+
+12/9/97 (bug fix) Tcl_EvalObj() increments/decrements the refcount of the
+script object to prevent the object from deleting itself while in the
+middle of being evaluated. (CCS)
+
+12/9/97 (bug fix) Memory leak in Tcl_GetsObjCmd(). (CCS)
+
+12/11/97 (bug fix) Environment array leaked memory when compiled with
+Visual C++. (SS)
+
+12/11/97 (bug fix) File events and non-blocking I/O did not work on
+pipes under Windows. Changed to use threads to achieve non-blocking
+behavior. (SS)
+
+12/18/97 (bug fixes) Fixed segfault in "namespace import"; importing a
+procedure that causes a cycle now returns an error. Modified "info procs",
+"info args", "info body", and "info default" to return information about
+imported procedures as well as procedures defined in a namespace. (BL)
+
+12/19/97 (enhancement) Added new Tcl_GetString() procedure that can be used
+in place of Tcl_GetStringFromObj() if the string representation's length
+isn't needed. (BL)
+
+12/18/97 (bug fix) In the opt argument parsing package: if the description
+had only flags, the "too many arguments" case was not detected. The default
+value was not used for the special "args" ending argument. (DL)
+
+1/7/98 (clean up) Moved everything not absolutly necessary out of init.tcl
+procs now in auto.tcl and package.tcl can be autoloaded if needed. (DL)
+
+1/7/98 (enhancement) tcltest made at install time will search for it's
+init.tcl where it is, even when using virtual path compilation. (DL)
+
+1/8/98 (os bug workaround) when needed, using a replacement for memcmp so
+string compare "char with high bit set" "char w/o high bit set" returns
+the expected value on all platforms. (DL)
+
+1/8/98 (unix portability/configure) building from .../unix/targetName/
+subdirectories and simply using "../configure" should now work fine. (DL)
+
+1/14/98 (enhancement) Added new regular expression package that
+supports AREs, EREs, and BREs. The new package includes new escape
+characters, meta-syntax, and character classes inside brackets.
+Regexps involving backslashes may behave differently. (MH)
+*** POTENTIAL INCOMPATIBILITY ***
+
+1/16/98 (os workaround) Under windows, "file volume" was causing chatter
+and/or several seconds of hanging when querying empty floppy drives.
+Changed implementation to call an empirically-derived function that doesn't
+cause this. (CCS)
+
+1/16/98 (enhancement) Converted regular expressions to a Tcl_Obj type so
+their compiled form gets cached automatically. Reduced NSUBEXP from 100
+to 20. (BW)
+
+1/16/98 (documentation) Change unclear documentation and comments for
+functions like Tcl_TranslateFileName() and Tcl_ExternalToUtfDString(). Now
+it explicitly says they take an uninitialized or free DString. A DString
+that is "empty" or "not holding anything" could have been interpreted as one
+currently with a zero length, but with a large dynamically allocated buffer.
+(CCS)
+
+----------------- Released 8.1a1, 1/22/98 -----------------------
+
+1/28/98 (new feature) Added a "-direct" optional flag to pkg_mkIndex
+to generate direct loading package indexes (such those you need
+if you use namespaces and plan on using namespace import just after
+package require). pkg_mkIndex still has limitations regarding
+package dependencies but errors are now ignored and with -direct, correct
+package indexes can be generated even if there are dependencies as long
+as the "package provide" are done early enough in the files. (DL)
+
+1/28/98 (enhancement) Performance tuning of regexp and regsub. (CCS)
+
+1/28/98 (bug fix) regexp and regsub with "-indices" returned the byte-offsets
+of the characters in the UTF-8 representation, not the character offsets
+themselves. (CCS)
+
+1/28/98 (bug fix) "clock format 0 -format %Z -gmt 1" would return the local
+timezone string instead of "GMT" on Solaris and Windows.
+
+1/28/98 (bug fix) Restore tty settings when closing serial device on Unix.
+This is good behavior when closing real serial devices, essential when
+closing the pseudo-device /dev/tty because the user's terminal settings
+would be left useless, in raw mode, when tcl quit. (CCS)
+
+1/28/98 (bug fix) Tcl_OpenCommandChannel() was modifying the contents of the
+argv array passed to it, causing problems for any caller that wanted to
+continue to use the argv array after calling Tcl_OpenCommandChannel(). (CCS)
+
+2/1/98 (bug fix) More bugs with %Z in format string argument to strftime():
+1. Borland always returned empty string.
+2. MSVC always returned the timezone string for the current time, not the
+ timezone string for the specified time.
+3. With MSVC, "clock format 0 -format %Z -gmt 1" would return "GMT" the first
+ time it was called, but would return the current timezone string on all
+ subsequent calls. (CCS)
+
+2/1/98 (bug fix) "file stat" was broken on Windows.
+1. "file stat" of a root directory (local or network) or a relative path that
+ resolved to a root directory (c:. when in pwd was c:/) was returning error.
+2. "file stat" on a regular file (S_IFREG), the st_mode was sign extended to
+ a negative int if the platform-dependant type "mode_t" was declared as a
+ short instead of an unsigned short.
+3. "file stat" of a network directory, the st_dev was incorrectly reported
+ as the id of the last accessed local drive rather than the id of the
+ network drive. (CCS)
+
+2/1/98 (bug fix) "file attributes" of a relative path that resolved to a
+root directory was returning error. (CCS)
+
+2/1/98 (bug fix) Change error message when "file attribute" could not
+determine the attributes for a file. Previously it would return different
+error messages on Unix vs. Windows vs. Mac. (CCS)
+
+2/4/98 (bug fixes) Fixed several instances of bugs where the parser/compiler
+would reach outside the range of allocated memory. Improved the array
+lookup algorithm in set compilation. (DL)
+
+2/5/98 (change) The TCL_PARSE_PART1 flag for Set/Get(Obj)Var2 C APIs is now
+deprecated and ignored. The part1 is always parsed when the part2 argument
+is NULL. This is to avoid a pattern of errors for extension writers converting
+from string based Tcl_SetVar() to new Tcl_SetObjVar2() and who could easily
+forget to provide the flag and thus get code working for normal variables
+but not for array elements. The performance hit is minimal. A side effect
+of that change is that is is no longer possible to create scalar variables
+that can't be accessed by tcl scripts because of their invalid name
+(ending with parenthesis). Likewise it is also parsed and checked to
+ensure that you don't create array elements of array whose name is a valid
+array element because they would not be accessible from scripts anyway.
+Note: There is still duplicate array elements parsing code. (DL)
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/11/98 (bug fix) Sharing objects between interps, such as by "interp
+eval" or "send" could cause a crash later when dereferencing an interp
+that had been deleted, given code such as:
+ set a {set x y}
+ interp create foo
+ interp eval foo $a
+ interp delete foo
+ unset a
+Interp "foo" was gone, but "a" had a internal rep consisting of bytecodes
+containing a dangling pointer to "foo". Unsetting "a" would attempt to
+return resources back to "foo", causing a crash as random memory was
+accessed. The lesson is that that if an object's internal rep depends on
+an interp (or any other data structure) it must preserve that data in
+some fashion. (CCS)
+
+2/11/98 (enhancement) The "interp" command was returning inconsistent error
+messages when the specified slave interp could not be found. (CCS)
+
+2/11/98 (bug fix) Result codes like TCL_BREAK and TCL_CONTINUE were not
+propagating through the master/slave interp boundaries, such as "interp
+eval" and "interp alias". TCL_OK, TCL_ERROR, and non-standard codes like
+teh integer 57 work. There is still a question as to whether TCL_RETURN
+can/should propagate. (CCS)
+
+2/11/98 (bug fix) TclCompileScript() was derefering memory 1 byte before
+start of the string to compile, looking for ']'. (CCS,DL)
+
+2/11/98 (bug fix) Tcl_Eval2() was derefering memory 1 byte before start
+of the string to eval, looking for ']'. (CCS,DL)
+
+2/11/98 (bug fix) Compiling "set a(b" was running off end of string. (CCS,DL)
+
+2/11/98 (bug fix) Windows initialization code was dereferencing
+uninitialized memory if TCL_LIBRARY environment didn't exist. (CCS)
+
+2/11/98 (bug fix) Windows "registry" command was dereferencing
+uninitialized memory when constructing the $errorCode for a failed
+registry call. (CCS)
+
+2/11/98 (enhancement) Eliminate the TCL_USE_TIMEZONE_VAR definition from
+configure.in, because it was the same information as the already existing
+HAVE_TM_ZONE definition. The lack of HAVE_TM_ZONE is used to work around a
+Solaris and Windows bug where "clock format [clock sec] -format %Z -gmt 1"
+produces the local timezone string instead of "GMT". (CCS)
+
+2/11/98 (bug fix) Memleaks and dereferencing of uninitialized memory in
+regexp if an error occurred while compiling a regular expression. (CCS).
+
+2/18/98 (new feature) Added mutexes and thread local storage in order
+to make Tcl thread safe. For testing purposes, there is a testthread
+command that creates a new thread and an interpreter inside it. See
+thread.test for examples, but this script-level interface is not fixed.
+Each thread has its own notifier instance to manage its own events,
+and threads can post messages to each other's message queue.
+This uses pthreads on UNIX, and native thread support on other platforms.
+You enable this by configuring with --enable-threads. Note that at
+this time *Tk* is still not thread safe. Special thanks to
+Richard Hipp: his earlier implementation inspired this work. (BW, SS, JI)
+
+2/18/98 (hidden feature change) The way the env() array is shared among
+interpreters changed. Updates to env used to trigger write traces in
+other interpreters. This undocumented feature is no longer implemented.
+Instead, variable tracing is used to keep the C-level environ array in sync
+with the Tcl-level env array. This required adding TCL_TRACE_ARRAY support
+to Tcl_TraceVar2 so that array names works properly. (BW)
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/18/98 (enhancement) Conditional compilation for unix systems (e.g.,
+IRIX, SCO) that use f_bsize instead of st_blksize to determine disk block
+size. (CCS)
+
+2/23/98 (bug fix) Fixed the emulation of polling selects in the threaded
+version of the Unix notifier. The bug was showing up on a multiprocessor
+as starvation of the notifier thread. (BW)
+
+----------------- Released 8.1a2, Feb 23 1998 -----------------------
+
+9/22/98 (bug fix) Changed the value of TCL_TRACE_ARRAY so it no longer
+conflicts with the deprecated TCL_PARSE_PART1 flag. This should
+improve portability of C code. (stanton)
+
+10/6/98 (bug fix) The compile procedure for "if" incorrectly attempted
+to match against the literal string "if", resulting in a stack
+overflow when "::if" was compiled. It also would incorrectly accept
+"if" instead of "elsif" in later clauses. (stanton)
+
+10/15/98 (new feature) Added a "totitle" subcommand to the "string"
+command to convert strings to capitalize the first character of a string
+and lowercase all of the other characters. (stanton)
+
+10/15/98 (bug fix) Changed regexp and string commands to properly
+handle case folding according to the Unicode character
+tables. (stanton)
+
+10/21/98 (new feature) Added an "encoding" command to facilitate
+translations of strings between different character encodings. See
+the encoding.n manual entry for more details. (stanton)
+
+11/3/98 (bug fix) The regular expression character classification
+syntax now includes Unicode characters in the supported
+classes. (stanton)
+
+11/6/98 (bug fix) Variable traces were causing crashes when upvar
+variables went out of scope. [Bug: 796] (stanton)
+
+11/9/98 (bug fix) "format" now correctly handles multibyte characters
+in %s format strings. (stanton)
+
+11/10/98 (new feature) "regexp" now accepts three new switches
+("-line", "-lineanchor", and "-linestop") that control how regular
+expressions treat line breaks. See the regexp manual entry for more
+details. (stanton)
+
+11/17/98 (bug fix) "scan" now correctly handles Unicode
+characters. (stanton)
+
+11/17/98 (new feature) "scan" now supports XPG3 position specifiers
+and the "%n" conversion character. See the "scan" manual entry for
+more details. (stanton)
+
+11/17/98 (bug fix) The Tcl memory allocator now returns 8-byte aligned
+chunks of memory which improves performance on Windows and avoids
+crashes on other platforms. [Bug: 834] (stanton)
+
+11/23/98 (bug fix) Applied various regular expression performance bug
+fixes supplied by Henry Spencer. (stanton)
+
+11/30/98 (bug fix) Fixed various thread related race conditions. [Bug:
+880 & 607] (stanton)
+
+11/30/98 (bug fix) Fixed a number of memory overflow and leak
+bugs. [Bug: 584] (stanton)
+
+12/1/98 (new feaure) Added support for Korean encodings. (stanton)
+
+12/1/98 (feature change) Changed the Tcl_EvalObjv interface to remove
+the string and length arguments.
+*** POTENTIAL INCOMPATIBILITY with previous alpha releases ***
+
+12/2/98 (bug fix) Fixed various bugs related to line feed
+translation. [Bug: 887] (stanton)
+
+12/4/98 (new feature) Added a message catalog facility to help with
+localizing Tcl scripts. Thanks to Mark Harrison for contributing the
+initial implementation of the "msgcat" package. (stanton)
+
+12/7/98 (bug fix) The memory allocator was failing to update the
+block list for large memory blocks that were reallocated into a
+different address. [Bug: 933] (stanton)
+
+----------------- Released 8.1b1, Dec 10 1998 -----------------------
+
+12/22/98 (performance improvement) Improved the -command option of the
+lsort command to better use the object system for improved
+performance (about 5x speed up). Thanks to Syd Polk for suppling the
+patch. [RFE: 726] (rjohnson)
+
+2/10/99 (bug fix) Restored the Tcl_ObjSetVar2/Tcl_ObjGetVar2
+interfaces from 8.0 and renamed the Tcl_GetObjVar2/Tcl_SetObjVar2
+interfaces to Tcl_GetVar2Ex and Tcl_SetVar2Ex. This should provide
+better compatibility with 8.0. (stanton)
+*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases ***
+
+2/10/99 (bug fix) Made the eval interfaces compatible with 8.0 by
+renaming Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to
+Tcl_EvalEx and restoring Tcl_EvalObj and Tcl_GlobalEvalObj interfaces
+so they match Tcl 8.0. (stanton)
+*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases ***
+
+2/25/99 (bug fix/new feature) On Windows, the channel drivers for
+consoles and serial ports now completely support file events. (redman)
+
+3/5/99 (bug fix) Integrated patches to fix various configure problems
+that affected HP-UX-11, 64-bit IRIX, Linux, and Solaris. (stanton)
+
+3/9/99 (bug fix) Integrated various AIX related patches to improve
+support for shared libraries. (stanton)
+
+3/9/99 (new feature) Added tcl_platform(user) to provide a portable
+way to get the name of the current user. (welch)
+
+3/9/99 (new feature) Integrated the stub library mechanism contributed
+by Jan Nijtmans, Paul Duffin, and Jean-Claude Wippler. This feature
+should make it possible to write extensions that support multiple
+versions of Tcl simultaneously. It also makes it possible to
+dynamically load extensions into statically linked interpreters. This
+patch includes the following changes:
+ - Added a Tcl_InitStubs() interface
+ - Added Tcl_PkgProvideEx, Tcl_PkgRequireEx, Tcl_PkgPresentEx,
+ and Tcl_PkgPresent.
+ - Added va_list versions of all VARARGS functions so they can be
+ invoked from wrapper functions.
+See the manual for more information. (stanton)
+
+
+3/10/99 (feature change) Replaced Tcl_AlertNotifier with
+Tcl_ThreadAlert since the Tcl_AlertNotifier function relied on passing
+internal data structures. (stanton)
+*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases ***
+
+3/10/99 (new feature) Added a Tcl_GetVersion API to make it easier to
+check the Tcl version and patch level from C. (redman)
+
+3/14/99 (feature change) Tried to unify the TclpInitLibrary path
+routines to look in similar places from Windows to UNIX. The new
+library search path is: TCL_LIBRARY, TCL_LIBRARY/../tcl8.1, relative
+to DLL (Windows Only) relative to installed executable, relative to
+develop executable, and relative to compiled-in in location (UNIX
+Only.) This fix included:
+ - Defining a TclpFindExecutable
+ - Moving Tcl_FindExecutable to a common area in tclEncoding.c
+ - Modifying the TclpInitLibraryPath routines.
+(surles)
+
+3/14/99 (feature change) Added hooks for TclPro Wrapper to initialize
+the location of the encoding files and libraries. This fix included:
+ - Adding the TclSetPerInitScript routine.
+ - Modifying the Tcl_Init routines to evaluate the non-NULL
+ pre-init script.
+ - Adding the Tcl_SetdefaultEncodingDir and Tcl_GetDefaultEncodingDir
+ routines.
+ - Modifying the TclpInitLibrary routines to append the default
+ encoding dir.
+(surles)
+
+3/14/99 (feature change) Test suite now uses "test" namespace to
+define the test procedure and other auxiliary procedures as well as
+global variables.
+ - Global array testConfige is now called ::test::testConfig.
+ - Global variable VERBOSE is now called ::test::verbose, and
+ ::test::verbose no longer works with numerical values. We've
+ switched to a bitwise character string. You can set
+ ::test::verbose by using the -verbose option on the Tcl command
+ line.
+ - Global variable TESTS is now called ::test::matchingTests, and
+ can be set on the Tcl command line via the -match option.
+ - There is now a ::test::skipTests variable (works similarly to
+ ::test::matchTests) that can be set on the Tcl command line via
+ the -match option.
+ - The test suite can now be run in any working directory. When
+ you run "make test", the working directory is nolonger switched
+ to ../tests.
+(hirschl)
+*** POTENTIAL INCOMPATIBILITY ***
+
+--------------- Released 8.1b2, March 16, 1999 ----------------------
+
+3/18/99 (bug fix) Fixed missing/incorrect characters in shift-jis table
+(stanton)
+
+3/18/99 (feature change) The glob command ignores the
+FS_CASE_IS_PRESERVED bit on file systesm and always returns
+exactly what it gets from the system. (stanton)
+*** POTENTIAL INCOMPATIBILITY ***
+
+3/19/99 (new feature) Added support for --enable-64bit. For now,
+this is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun
+compiler. (redman)
+
+3/23/99 (bug fix) Fixed fileevents and gets on Windows consoles and
+serial devices so that non-blocking channels do not block on partial
+input lines. (redman)
+
+3/23/99 (bug fix) Added a new Tcl_ServiceModeHook interface.
+This is used on Windows to avoid the various problems that people
+have been seeing where the system hangs when tclsh is running
+outside of the event loop. As part of this, renamed
+TclpAlertNotifier back to Tcl_AlertNotifier since it is public.
+(stanton)
+
+3/23/99 (feature change) Test suite now uses "tcltest" namespace to
+define the test procedure and other auxiliary procedures as well as
+global variables. The previously chosen "test" namespace was thought
+to be too generic and likely to create conflits.
+(hirschl)
+*** POTENTIAL INCOMPATIBILITY ***
+
+3/24/99 (bug fix) Make sockets thread safe on Windows.
+(redman)
+
+3/24/99 (bug fix) Fix cases where expr would incorrect return
+a floating point value instead of an integer. (stanton)
+
+3/25/99 (bug fix) Added ASCII to big5 and gb2312 encodings.
+(stanton)
+
+3/25/99 (feature change) Changed so aliases are invoked at current
+scope in the target interpreter instead of at the global scope. This
+was an incompatibility introduced in 8.1 that is being removed.
+(stanton)
+*** POTENTIAL INCOMPATIBILITY with previous beta releases ***
+
+3/26/99 (feature change) --enable-shared is now the default and build
+Tcl as a shared library; specify --disable-shared to build a static Tcl
+library and shell.
+*** POTENTIAL INCOMPATIBILITY ***
+
+3/29/99 (bug fix) Removed the stub functions and changed the stub
+macros to just use the name without params. Pass &tclStubs into the
+interp (don't use tclStubsPtr because of collisions with the stubs on
+Solaris). (redman)
+
+3/30/99 (bug fix) Loadable modules are now unloaded at the last
+possible moment during Tcl_Finalize to fix various exit-time crashes.
+(welch)
+
+3/30/99 (bug fix) Tcl no longer calls setlocale(). It looks at
+env(LANG) and env(LC_TYPE) instead. (stanton)
+
+4/1/99 (bug fix) Fixed the Ultrix multiple symbol definition problem.
+Now, even Tcl includes a copy of the Tcl stub library. (redman)
+
+4/1/99 (bug fix) Internationalized the registry package.
+
+4/1/99 (bug fix) Changed the implemenation of Tcl_ConditionWait and
+Tcl_ConditionNotify on Windows. The new algorithm eliminates a race
+condition and was suggested by Jim Davidson. (welch)
+
+4/2/99 (new apis) Made various Unicode utility functions public.
+Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString, Tcl_UniCharLen,
+Tcl_UniCharNcmp, Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha,
+Tcl_UniCharIsDigit, Tcl_UniCharIsLower, Tcl_UniCharIsSpace,
+Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar, Tcl_WinUtfToTChar,
+Tcl_WinTCharToUtf (stanton)
+
+4/2/99 (feature change) Add new DDE package and removed the Tk
+send command from the Windows version. Changed DDE-based send
+code into "dde eval" command. The DDE package can be loaded
+into tclsh, not just wish. Windows only. (redman)
+
+4/5/99 (bug fix) Changed safe-tcl so that the encoding command
+is an alias that masks out the "encoding system" subcommand.
+(redman)
+
+4/5/99 (bug fix) Configure patches to improve support for
+OS/390 and BSD/OS 4.*. (stanton)
+
+4/5/99 (bug fix) Fixed crash in the clock command that occurred
+with negative time values in timezones east of GMT. (stanton)
+
+4/6/99 (bug fix) Moved the "array set" C level code into a common
+routine (TclArraySet). The TclSetupEnv routine now uses this API to
+create an env array w/ no elements. This fixes the bug caused when
+every environ varaible is removed, and the Tcl env variable is
+synched. If no environ vars existed, the Tcl env var would never be
+created. (surles)
+
+4/6/99 (bug fix) Made the Env module I18N compliant. (surles)
+
+4/6/99 (bug fix) Changed the FindVariable routine to TclpFindVariable,
+that now does a case insensitive string comparison on Windows, and not
+on UNIX. (surles)
+
+--------------- Released 8.1b3, April 6, 1999 ----------------------
+
+4/9/99 (bug fix) Fixed notifier deadlock situation when the pipe used
+to talk back notifier thread is filled with data. Found as a result of the
+focus.test for Tk hanging. (redman)
+
+4/13/99 (bug fix) Fixed bug where socket -async combined with
+fileevent for writing did not work under Windows NT. (redman)
+
+4/13/99 (encoding fix) Restored the double byte definition of GB2312
+and added the EUC-CN encoding. EUC-CN is a variant of GB2312 that
+shifts the characters into bytes with the high bit set and includes
+ASCII as a subset. (stanton)
+
+4/27/99 (bug fix) Added 'extern "C" {}' block around the stub table
+pointer declaration so the stub library can be used from C++. (stanton)
+
+--------------- Released 8.1 final, April 29, 1999 ----------------------
+
+4/22/99 (bug fix) Changed Windows NT socket implementation to avoid
+creating a communication window. This avoids the problem where the
+system hangs waiting for tclsh to respond to a system-wide synchronous
+broadcast (e.g. if you change system colors). (redman)
+
+4/22/99 (bug fix) Added call to TclWinInit from TclpInitPlatform when
+building a static library since DllMain will not be invoked. This
+could break old code that explicitly called TclWinInit, but should be
+simpler in the long run. (stanton)
+*** POTENTIAL INCOMPATIBILITY ***
+
+4/23/99 (bug fix) Added support for the koi8-r Cyrillic
+encoding. [Bug: 1771] (stanton)
+
+4/28/99 (bug fix) Changed internal Tcl_Obj usage to avoid freeing the
+internal representation after the string representation has been
+freed. This makes it easier to debug extensions. (stanton)
+
+4/30/99 (bug fix) Fixed a memory leak in CommandComplete. (stanton)
+
+5/3/99 (bug fix) Fixed a bug where the Tcl_ObjType was not being set
+in a duplicated Tcl_Obj. [Bug: 1975, 2047] (stanton)
+
+5/3/99 (bug fix) Changed Tcl_ParseCommand to avoid modifying eval'ed
+strings that are already null terminated. [Bug: 1793] (stanton)
+
+5/3/99 (new feature) Applied Jeff Hobbs's string patch which includes
+the following changes:
+ - added new subcommands: equal, repeat, map, is, replace
+ - added -length option to "string compare|equal"
+ - added -nocase option to "string compare|equal|match"
+ - string and list indices can be an integer or end?-integer?.
+ - added optional first and last index args to string toupper, et al.
+See the string.n manual entry for more details about the new string
+features. [Bug: 1845] (stanton)
+
+5/6/99 (new feature) Added Tcl_UtfNcmp and Tcl_UtfNcasecmp to make Utf
+string comparision easier. (stanton)
+
+5/7/99 (bug fix) Improved OS/390 support. [Bug: 1976, 1997] (stanton)
+
+5/12/99 (bug fix) Changed Windows initialization code to avoid using
+GetUserName system call in favor of the env(USERNAME) variable. This
+provides a significant startup speed improvement. (stanton)
+
+5/12/99 (bug fix) Replaced the per-interpreter regexp cache with a
+per-thread cache. Changed the Regexp object to take advantage of this
+extra cache. Added a reference count to the TclRegexp type so regexps
+can be shared by multiple objects. Removed the per-interp regexp cache
+from the interpreter. Now regexps can be used with no need for an
+interpreter. This set of changes should provide significant speed
+improvements for many Tcl scripts. [Bug: 1063] (stanton)
+
+5/14/99 (bug fix) Durining initialization on Unix, Tcl now extracts the
+encoding subfield from the LANG/LC_ALL environment variables in cases
+where the locale is not found in the built-in locale table. It also
+attempts to initialize the locale subsystem so X11 is happy. [Bug: 1989]
+(stanton)
+
+5/14/99 (bug fix) Applied the patch to fix 100-year and 400-year
+boundaries in leap year code, from Isaac Hollander. [Bug: 2066] (redman)
+
+5/14/99 (bug fix) Fixed a crash caused by a failure to reset the result
+before evaluating the test expression in an uncompiled for
+statement. (stanton)
+
+5/18/99 (bug fix) Modified initialization code on Windows to avoid
+inherenting closed or invalid channels. If the standard input is
+anything other than a console, file, serial port, or pipe, then we fall
+back to the standard Tk window console. (stanton)
+
+5/19/99 (bug fix) Added an extern "C" block around the entire tcl.h
+header file to avoid C++ linkage issues. (redman)
+
+5/19/99 (new feature) Applied Jeff Hobb's patch to add
+Tcl_StringCaseMatch to support case insensitive glob style matching and
+Tcl_UniCharIs* character classification functions. (stanton)
+
+5/20/99 (bug fix) Added the directory containing the executuble and the
+../lib directory relative to that to the auto_path variable. (redman)
+
+--------------- Released 8.1.1, May 25, 1999 ----------------------
+
+5/21/99 (bug fix) Fixed launching command.com on Win95/98, no longer
+hangs. [Bug: 2105] (redman)
+
+5/28/99 (bug fix) Fixed bug where dde calls were being passed an
+invalid dde handle. [Bug: 2124] (stanton)
+
+6/1/99 (bug fix) Small configure.in patches. [Bug: 2121] (stanton)
+
+6/1/99 (bug fix) Applied latest regular expression patches to fix an
+infinite loop bug and add support for testing whether a string could
+match with additional input. [Bug: 2117] (stanton)
+
+6/2/99 (bug fix) Fixed incorrect computation of relative ordering in
+Utf case-insensitive comparison. [Bug: 2135] (stanton)
+
+6/3/99 (bug fix) Fxied bug where string equal/compare -nocase
+reported wrong result on null strings. [Bug: 2138] (stanton)
+
+6/4/99 (new feature) Windows build now uses Cygwin tools plus GNU
+make and autoconf to build static/dynamic and debug/nodebug. (stanton)
+
+6/7/99 (new feature) Optimized string index, length, range, and
+append commands. Added a new Unicode object type. (hershey)
+
+6/8/99 (bug fix) Rolled back Windows socket driver to 8.1.0
+version. (stanton)
+
+6/9/99 (new feature) Added Tcl_RegExpMatchObj and Tcl_RegExpGetInfo
+to public Tcl API, these functions are needed by Expect. Changed
+tools/genStubs.tcl to always write output in LF mode. (stanton)
+
+6/14/99 (new feature) Merged string and Unicode object types. Added
+new public Tcl API functions: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj,
+Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange,
+Tcl_AppendUnicodeToObj. (hershey)
+
+6/16/99 (new feature) Changed to conform to TEA specification, added
+tcl.m4 and aclocal.m4 macro libraries for configure. (wart)
+
+6/17/99 (new feature) Added new regexp interfaces: -expanded, -line,
+-linestop, and -lineanchor switches. Renamed Tcl_RegExpMatchObj to
+Tcl_RegExpExecObj and added new Tcl_RegExpMatchObj that is equivalent
+to Tcl_RegExpMatch. Added public macros for regexp flags. Added
+REG_BOSONLY flag to allow Expect to iterate through a string and only
+find matches that start at the current position within the
+string. (stanton)
+
+6/21/99 (bug fix) Fixed memory leak in TclpThreadCreate where thread
+attributes were not being released. [Bug: 2254] (stanton)
+
+6/23/99 (new feature) Updated Unicode character tables to reflect
+Unicode 2.1 data. (stanton)
+
+6/25/99 (new feature) Fixed bugs in non-greedy quantifiers for regular
+expression code. (stanton)
+
+6/25/99 (new feature) Added initial implementation of new Tcl test
+harness package. Modified test files to use new tcltest package.
+(jenn)
+
+6/26/99 (new feature) Applied patch from Peter Hardie to add poke
+command to dde and changed the dde package version number to
+1.1. (redman)
+
+6/28/99 (bug fix) Applied patch from Peter Hardie to fix problem in
+Tcl_GetIndexFromObj() when the key being passed is the empty string.
+[Bug: 1738] (redman)
+
+6/29/99 (new feature) Added options to tcltest package: -preservecore,
+-limitconstraints, -help, -file, -notfile, and flags. (jenn)
+
+7/3/99 (new feature) Changed parsing of variable names to allow empty
+array names. Now "$(foo)" is a variable reference. Previously you
+had to use something line $::(foo), which is slower. This change was
+requested by Jean-Luc Fontaine for his STOOOP package. (welch)
+
+7/3/99 (new feature) Added Tcl_SetNotifier (public API) and
+associated hook points in the notifiers to be able to replace the
+notifier calls at runtime. The Xt notifier and test program use this
+hook. (welch)
+
+7/3/99 (new feature) Added a new variant of the "Trf core patch" from
+Andreas Kupries that adds new C APIs Tcl_StackChannel,
+Tcl_UnstackChannel, and Tcl_GetStackedChannel. This allows the Trf
+extension to work without applying patches to the Tcl core. (welch)
+
+7/6/99 (new feature) Added -timeout option to http.tcl to handle
+timeouts that occur during connection attempts to hosts that are
+down. (welch)
+
+7/6/99 (bug fix) Applied new implementation of the Windows serial
+port driver from Rolf Schroedter that fixes reading only one byte from
+the port at a time. Uses polling every 10ms to implement
+fileevents. [Bug: 1980 2217] (redman)
+
+7/8/99 (bug fix) Applied fix for bug in DFA state caching under
+lookahead conditions (regular expressions). [Bug: 2318] (stanton)
+
+7/8/99 (bug fix) Fixed bug in string range bounds checking
+code. (stanton)
+
+--------------- Released 8.2b1, July 14, 1999 ----------------------
+
+7/16/99 (bug fix) Added Tcl_SetNotifier to stub table. [Bug: 2364]
+Added check for Alpha/Linux to correct the IEEE floating point flag,
+patch from Don Porter. (redman)
+
+7/20/99 (bug fix) Merged 8.0.5 code to handle tcl_library properly,
+also fixed a bug that caused TCL_LIBRARY to be ignored. (hershey)
+
+7/21/99 (bug fix) Implemented modified socket driver for Windows that
+uses a thread to manage the socket event window. Code works the same
+on all supported versions of Windows and was based on original 8.1.0
+code. [Bug: 2178 2256 2259 2329 2323 2355] (redman)
+
+7/21/99 (new feature) Applied patch from Rolf Schroedter to add
+-pollinterval option to fconfigure for Windows serial ports. Allows
+the maxblocktime to be modified to control how often serial ports are
+checked for fileevents. Also added documentation for \\.\comX
+notation for opening serial ports on Windows. (redman)
+
+7/21/99 (bug fix) Changed APIs in stub tables to use "unsigned long"
+instead of the platform-specific "size_t", primarily after SunOS 4
+users could no longer compile. (redman)
+
+7/22/99 (bug fix) Fixed crashing during "array set a(b) {}".
+[Bug: 2427] (redman)
+
+7/22/99 (bug fix) The install-sh script must be given execute
+permissions prior to running. [Bug: 2413] (redman)
+
+7/22/99 (bug fix) Applied patch from Ulrich Ring to remove ANSI-style
+prototypes in the code. [Bug: 2391] (redman)
+
+7/22/99 (bug fix) Added #if blocks around #includes of sys/*.h header
+files, to allow an extension author on Windows to use the MetroWerks
+compiler. [Bug: 2385] (redman)
+
+7/22/99 (bug fix) Fixed running the safe.test test suite, one change
+to the Windows Makefile.in to fix paths and another in safe.test to
+check for the tcl_platform(threaded) variable properly. (redman)
+
+7/22/99 (bug fix) Fixed hanging in new Win32 socket driver with
+threads enabled. (redman)
+
+7/26/99 (bug fix) Fixed terminating of helper threads by holding any
+mutexes from the primary thread while waiting for the helper thread to
+terminate. Fixes dual-CPU WinNT hangs, only one rare sporadic hang
+that still exists with dual-CPU WinNT. Also fixed test cases so that
+they would not depend as much on timing for dual-CPU WinNT. (redman)
+
+7/27/99 (bug fix) Some test suite cleanup. (jenn)
+
+7/29/99 (bug fix) Applied patch to fix typo in .SH NAME line in
+doc/Encoding.n [Bug: 2451]. Applied patch to avoid linking pack.n to
+pack-old.n [Bug: 2469]. Patches from Don Porter. (redman)
+
+7/29/99 (bug fix) Allow tcl to open CON and NUL, even for redirection
+of std channels. [Bug: 2393 2392 2209 2458] (redman)
+
+7/30/99 (bug fix) Applied fixed Trf patch from Andreas Kupries.
+[Bug: 2386] (hobbs)
+
+7/30/99 (bug fix) Fixed bug in info complete. [Bug: 2383 2466] (hobbs)
+
+7/30/99 (bug fix) Applied patch to fix threading on Irix 6.5, patch
+provided by James Dennett. [Bug: 2450] (redman)
+
+7/30/99 (bug fix) Fixed launching of 16bit applications on Win9x from
+wish. The command line was being primed with tclpip82.dll, but it was
+ignored later.
+
+7/30/99 (bug fix) Added functions to stub table, patch provided by Jan
+Nijtmans. [Bug: 2445] (hobbs)
+
+8/1/99 (bug fix) Changed Windows socket driver to terminate threads
+by sending a message to the window rather than calling
+TerminateThread(), which seems to leak about 4k from the helper
+thread's stack space. (redman)
+
+--------------- Released 8.2b2, August 5, 1999 ----------------------
+
+8/4/99 (bug fix) Applied patches supplied by Henry Spencer to greatly
+enhance performance of certain classes of regular expressions.
+[Bug: 2440 2447] (stanton)
+
+8/5/99 (doc change) Made it clear that tcl_pkgPath was not set for
+Windows. [Bug: 2455] (hobbs)
+
+8/5/99 (bug fix) Fixed reference to bytes that might not be null
+terminated in tclLiteral.c. [Bug: 2496] (hobbs)
+
+8/5/99 (bug fix) Fixed typo in http.tcl. [Bug: 2502] (hobbs)
+
+8/9/99 (bug fix) Fixed test suite to handle larger integers
+(64bit). Patch from Don Porter. (hobbs)
+
+8/9/99 (documentation fix) Clarified Tcl_DecrRefCount docs
+[Bug: 1952]. Clarified array pattern docs [Bug: 1330]. Fixed clock docs
+[Bug: 693]. Fixed formatting errors [Bug: 2188 2189]. Fixed doc error
+in tclvars.n [Bug: 2042]. (hobbs)
+
+8/9/99 (bug fix) Fixed path handling in auto_execok [Bug: 1276] (hobbs)
+
+8/9/99 (internal api change) Removed the TclpMutexLock and TclpMutexUnlock
+APIs and added a new exported api, Tcl_GetAllocMutex. These APIs are all for
+the mutex used in the simple memory allocators. By making this change
+we are able to substitute different implementations of the thread-related
+APIs without having to recompile the Tcl core. (welch)
+
+8/9/99 (new C API) Tcl_GetChannelNames returns a list of open channel
+names in the interpreter result. Still no Tcl-level version of this,
+but server-like applications can use this to clean up files without
+deleting interpreters. (welch)
+
+8/9/99 (bug fix) Traces were not firing on "info exists", which used to
+happen in Tcl 7.6 and earlier. An "info exists" now fires a read trace,
+if defined. This makes it possible to fully implement variables that
+are defined via traces. (welch)
+
+8/10/99 (bug fix) Fixed Brent's changes so that they work on
+Windows. (redman)
+
+--------------- Released 8.2b3, August 11, 1999 ----------------------
+
+8/12/99 (Mac) Rearrange projects in tclMacProjects.sea.hqx so that the
+build directory is separate from the sources. (Jim Ingham)
+
+8/12/99 (bug fix) Fixed bug in Tcl_EvalEx where the termOffset was not
+being updated in cases where the evaluation returned a non TCL_OK
+error code. [Bug: 2535] (stanton)
+
+--------------- Released 8.2.0, August 17, 1999 ----------------------
+
+9/21/99 (config fixes) fixed several AIX configuration issues. gcc and
+threading may still cause problems on AIX. (hobbs)
+
+9/21/99 (bug fix) fixed expr double-eval problem. [Bug: 732] (hobbs)
+
+9/21/99 (bug fix) fixed static buffer overflow problem. [Bug: 2483] (hobbs)
+
+9/21/99 (bug fix) fixed end-int linsert interpretation. [Bug: 2693] (hobbs)
+
+9/21/99 (bug fix) fixed bug when setting array in non-existent
+namespace. [Bug: 2613] (hobbs)
+
+--- Released 8.2.1, October 04, 1999 --- See ChangeLog for details ---
+
+10/30/99 (feature enhancement) new regexp engine from Henry Spencer
+was patched in - should greatly reduce stack space usage. (spencer)
+
+10/30/99 (bug fix) fixed Purify reported memory leaks in findexecutable
+test command, TclpCreateProcess on Unix, in handling of C environ array,
+and in testthread code. No more known (reported) mem leaks for Tcl
+built using gcc on Solaris 2.5.1. Also none reported for Tcl on NT
+(using Purify 6.0). (hobbs)
+
+10/30/99 (bug fix) fixed improper bytecode handling of
+'eval {set array($unknownvar) 5}' (also for incr) (hobbs)
+
+10/30/99 (bug fix) fixed event/io threading problems by making
+triggerPipe non-blocking (nick kisserbeth)
+
+10/30/99 (bug fix) fixed Tcl_AppendStringsToObjVA and Tcl_AppendResultVA
+to only iterates once over the va_list (avoiding non-portable memcpy).
+(joe english, hobbs)
+
+10/30/99 (bug fix) removed savedChar trick in tclCompile.c that appeared
+to be causing a segv when the literal table was released.
+[Bug: 2459, 2515] (David Whitehouse)
+
+10/30/99 (bug fix) fixed [string index] to return ByteArrayObj
+when indexing into one (test case string-5.16) [Bug: 2871] (hobbs)
+
+10/30/99 (bug fix) fixes for mac UTF filename handling (ingham)
+
+--- Released 8.2.2, November 04, 1999 --- See ChangeLog for details ---
+
+11/19/99 (feature enhancement) bug fixes for http package as well as
+patch required by TLS (SSL) extension that adds http::(un)register
+and -type to http::geturl. Up'd http pkg version to 2.2.
+
+11/19/99 (bug fix) removed extra decr of numLevels in Tcl_EvalObjEx
+that could cause seg fault (mjansen@wendt.de)
+
+11/19/99 (bug fixes) numerous minor big fixes, including correcting the
+installation of the koi8-r encoding and tcltest1.0 on Windows.
+
+11/30/99 (bug fix) fixes scan where %[..] didn't match anything
+
+11/30/99 (bug fix) fixed setting of isNonBlocking flag in PipeBlockModeProc
+so you can now close a non-blocking channel without waiting.
+
+11/30/99 (bug work-around) prevented the unloading of DLLs for Unix in
+TclFinalizeLoad. This stops the seg fault on exit that some users would
+see (ie with oratcl) when using DLLs that do nasty things like register
+atexit handlers.
+
+12/07/99 (bug fix) fixes for 'expr + {[incr]}' and 'expr + {[error]}'
+cases (different causes).
+
+--- Released 8.2.3, December 16, 1999 --- See ChangeLog for details ---
+
+1999-09-14 (feature enhancement) added -start switch to regexp and regsub.
+
+1999-09-15 (feature enhancement) add 'array unset' command.
+
+1999-09-15 (feature enhancement) rewrote runtime libraries to use new
+string functions
+
+1999-08-18 (feature enhancement) added 'file channels' command, along with
+Tcl_GetChannelNames(Ex) public C APIs.
+
+1999-10-19 (feature enhancement) enhanced tcltest package
+
+1999-09-16 (feature enhancement) added -milliseconds switch to 'clock clicks'
+
+1999-10-28 (feature enhancement) added support for inline 'scan'
+
+1999-10-28 (feature enhancement) added support for touch functionality by
+extendeding 'file atime' and 'file mtime' to take an optional time argument
+
+1999-11-24 (feature enhancement) added 'fconfigure $sock -lasterror'
+command to Windows to query the last error received on a serial socket.
+
+1999-11-30 (bug fix) fixed handling of %Z on NT for timezones that don't
+have DST
+
+1999-12-03 (feature enhancement) improved error message in bad octal cases
+and improper use of comments. (hobbs)
+
+1999-12-07 (bug fix) fixed Tcl_ScanCountedElement to not step
+beyond the end of the counted string
+
+1999-12-09 (feature enhancement) removed all references to 16 bit
+compatibility code for Windows (hobbs)
+
+1999-12-10 (bug fix) removed check for vfork - Tcl now uses only fork in
+exec. (hobbs)
+
+1999-12-10 (optimization) changed Tcl_ConcatObj to return a list
+object when it receives all pure list objects as input (used by 'concat'),
+added optimizations in Tcl_EvalObjEx for pure list case, and optimized
+INST_TRY_CVT_TO_NUMERIC in TclExecuteByteCode for boolean objects.
+(oakley, hobbs)
+
+1999-12-12 (feature enhancement) enhanced glob command with -type, -path,
+-directory and -join switches. (darley, hobbs)
+
+1999-12-21 (bug fix) changed CreateThread to _beginthreadex and
+ExitThread to _endthreadex to prevent 4K mem leak (gravereaux)
+
+1999-12-21 (bug fix) fixed applescript for I18N
+
+1999-12-21 (feature enhancement) added -unique option to lsort (hobbs)
+
+1999-12-21 (bug fix) changed thread ids to longs (for 64bit systems)
+
+--- Released 8.3b1, December 22, 1999 --- See ChangeLog for details ---
+
+2000-01-10 (feature enhancement) clock scan now supports the common
+ISO 8601 date/time formats. See docs for details. (melski)
+
+2000-01-10 (bug fix) prevented \ooo substitution from accepting
+non-octal digits [Bug: 3975] (hobbs)
+
+2000-01-11 (bug fix) fixed improper handling of DST by clock when
+using relative times (like "1 month" or "tomorrow"). (melski)
+
+2000-01-12 (bug fix) improved build support for Tru64 v5, NetBSD
+and Reliant Unix (hobbs)
+
+2000-01-12 (bug fix) made imported commands also import their
+compile procedure (duffin)
+
+2000-01-12 (bug fix) fixed 'info procs ::namesp::*' behavior to return
+procs in a namespace (dejong)
+
+2000-01-12 (feature enhancement) added support for setting permissions
+symbolicly (like chmod) in [file attributes $file -permissions ...] (schoebel)
+
+2000-01-13 (bug fix) fixed lsort -dictionary problem when sorting
+characters between 'Z' and 'a' (flawed upper/lower comparison logic) (melski)
+
+--- Released 8.3b2, January 13, 2000 --- See ChangeLog for details ---
+
+2000-01-14 (feature enhancement) clock format %Q added, clock scan updated
+
+2000-01-20 (bug fix) corrected complex array elem compiling (Spjuth)
+
+2000-01-20 (bug fix) made [info body] always return a string type arg,
+to prevent possible misuse of bytecodes in the wrong context (hobbs)
+
+2000-01-20 (bug fixes) several fixes to variable handling to prevent
+possible crashes, and further definition of correct behavior (melski)
+
+2000-01-25 (bug fixes) improved QNX, Ultrix and OSF1 (Tru64) config and
+compatibility (edge, furukawa)
+
+2000-01-25 (bug fix) fixed mem leak when calling lsort with a bad -command
+argument (hobbs)
+
+2000-01-27 (feature enhancement) package mechanism overhaul: changed
+behavior of pkg_mkIndex to do -direct by default, added -lazy option.
+Fixed pkg_mkIndex to handle odd proc names and auto_mkIndex to use platform
+independent file paths. Other fixes for odd package quirks. Added
+::pkg namespace and ::pkg::create helper function. (melski)
+
+2000-02-01 (bug fix) fixed problem where http POST would send one extra
+newline (vasiljevic)
+
+2000-02-02 (feature enhancement) added docs for new regexp -inline and
+-all switches. (hobbs)
+
+2000-02-08 (bug fix) corrected handling of "next monthname" in clock scan
+(melski)
+
+2000-02-09 (bug fix) restored Mac source to build readiness and prevented
+mac panic from an error when closing an async socket (steffen, ingham)
+
+2000-02-10 (feature enhancement) improved error reporting for failed
+loads on Windows (dejong, hobbs)
+
+--- Released 8.3.0, February 10, 2000 --- See ChangeLog for details ---
+
+2000-03 (bug fixes, feature enhancement) overhaul of http package for
+proper handling of async callbacks (new options), version is now at 2.3
+(tamhankar, welch)
+
+2000-03 (speed improvements) speedup in Windows filename handling (newman)
+and ==/!= empty string in exprs. (hobbs)
+
+2000-03-27 (bug fix) added uniq'ing test to namespace export list to
+prevent unnecessary mem growth (hobbs)
+
+2000-03-29 (bug fix) fixed mem leak when repeatedly sourcing the same
+bytecompiled (tbc) code repeatedly across different interpreters (hobbs)
+
+2000-03-29 (config enhancement) improved build support for gcc/mingw on
+Windows (nijtmans, hobbs) and added RPM target (melski)
+
+2000-03-31 (bug fix) corrected data encoding problem when using
+"exec << $data" construct (melski)
+
+2000-04 (feature enhancement) overhaul of threading mechanism to better
+support tcl level thread command (new APIs Tcl_ConditionFinalize,
+Tcl_MutexFinalize, Tcl_CreateThread, etc, all docs in Thread.3).
+(kupries, graveraux)
+This enables the tcl level thread extension. (welch)
+
+2000-04-10 (bug fix) fixed infinite loop case in regexp -all (melski)
+
+2000-04-13 (config enhancement) added support for --enable-64bit-vis
+Sparc target. (hobbs)
+
+2000-04-18 (bug fix) moved tclLibraryPath to thread-local storage to fix
+possible race condition on MP machines (hobbs)
+
+2000-04-18 (config enhancement) added MacOS X build target and
+tclLoadDyld.c dl type. (sanchez)
+
+2000-04-23 (bug fix) several Mac socket fixes (ingham)
+
+2000-04-24 (bug fix) fixed hang in threaded Unix case when backgrounded
+exec process was running (dejong)
+
+--- Released 8.3.1, April 26, 2000 --- See ChangeLog for details ---
+
+2000-05-29 (bug fix) corrected resource cleanup in http error cases.
+Improved handling of error cases in http. (tamhankar)
+
+2000-07 (feature rewrite) complete rewrite of the Tcl IO channel subsystem
+to correct problems (hangs, core dumps) with the initial stacked channel
+implementation. The new system has many more tests for robustness and
+scalability. There are new C APIs (see Tcl_CreateChannel), but only
+stacked channel drivers are affected (ie: TLS, Trf, iogt). The iogt
+extension has been added to the core test code to test the system.
+(hobbs, kupries)
+ **** POTENTIAL INCOMPATABILITY ****
+
+2000-07 (build improvements) cleanup of the makefiles and configure scripts
+to correct support for building under gcc for Windows. (dejong)
+
+2000-08-07 (bug fix) corrected sizeof error in Tcl_GetIndexFromObjStruct.
+(perkins)
+
+2000-08-07 (bug fix) correct off-by-one error in HistIndex, which was
+causing [history redo] to start its search at the wrong event index. (melski)
+
+2000-08-07 (bug fix) corrected setlocale calls for XIM support and locale
+issues in startup. (takahashi)
+
+2000-08-07 (bug fix) correct code to handle locale specific return values
+from strftime, if any. (wagner)
+
+2000-08-07 (bug fix) tweaked grammar to properly handle the "ago" keyword
+when it follows multiple relative unit specifiers, as in
+"2 days 2 hours ago". (melski)
+
+2000-08-07 (doc fixes) numerous doc fixes to correct SEE ALSO and NAME
+sections. (english)
+
+2000-08-07 (bug fix) new man pages memory.n, TCL_MEM_DEBUG.3, Init.3 and
+DumpActiveMemory.3. (melski)
+
+--- Released 8.3.2, August 9, 2000 --- See ChangeLog for details ---
diff --git a/tcl/compat/README b/tcl/compat/README
index 5bbf04179aa..28d50a36541 100644
--- a/tcl/compat/README
+++ b/tcl/compat/README
@@ -6,3 +6,4 @@ they are known to be incorrect. When the whole world becomes POSIX-
compliant this directory should be unnecessary.
RCS: @(#) $Id$
+
diff --git a/tcl/compat/getcwd.c b/tcl/compat/getcwd.c
new file mode 100644
index 00000000000..e4340c155e9
--- /dev/null
+++ b/tcl/compat/getcwd.c
@@ -0,0 +1,47 @@
+/*
+ * getcwd.c --
+ *
+ * This file provides an implementation of the getcwd procedure
+ * that uses getwd, for systems with getwd but without getcwd.
+ *
+ * Copyright (c) 1993 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.
+ *
+ * SCCS: @(#) getcwd.c 1.5 96/02/15 12:08:20
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+extern char *getwd _ANSI_ARGS_((char *pathname));
+
+char *
+getcwd(buf, size)
+ char *buf; /* Where to put path for current directory. */
+ size_t size; /* Number of bytes at buf. */
+{
+ char realBuffer[MAXPATHLEN+1];
+ int length;
+
+ if (getwd(realBuffer) == NULL) {
+ /*
+ * There's not much we can do besides guess at an errno to
+ * use for the result (the error message in realBuffer isn't
+ * much use...).
+ */
+
+ errno = EACCES;
+ return NULL;
+ }
+ length = strlen(realBuffer);
+ if (length >= size) {
+ errno = ERANGE;
+ return NULL;
+ }
+ strcpy(buf, realBuffer);
+ return buf;
+}
+
diff --git a/tcl/compat/stdlib.h b/tcl/compat/stdlib.h
index 0dabdaf8392..45f39551de6 100644
--- a/tcl/compat/stdlib.h
+++ b/tcl/compat/stdlib.h
@@ -9,7 +9,7 @@
* declare all the procedures needed here (such as strtod).
*
* Copyright (c) 1991 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/tcl/compat/strftime.c b/tcl/compat/strftime.c
index 65b687b23c8..38ba41457cd 100644
--- a/tcl/compat/strftime.c
+++ b/tcl/compat/strftime.c
@@ -55,6 +55,7 @@ static char *rcsid = "$Id$";
#include "tclPort.h"
#define TM_YEAR_BASE 1900
+#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
typedef struct {
const char *abday[7];
@@ -105,12 +106,22 @@ static size_t _fmt _ANSI_ARGS_((const char *format,
const struct tm *t));
size_t
-TclStrftime(s, maxsize, format, t)
+TclpStrftime(s, maxsize, format, t)
char *s;
size_t maxsize;
const char *format;
const struct tm *t;
{
+ if (format[0] == '%' && format[1] == 'Q') {
+ /* Format as a stardate */
+ sprintf(s, "Stardate %2d%03d.%01d",
+ (((t->tm_year + TM_YEAR_BASE) + 377) - 2323),
+ (((t->tm_yday + 1) * 1000) /
+ (365 + IsLeapYear((t->tm_year + TM_YEAR_BASE)))),
+ (((t->tm_hour * 60) + t->tm_min)/144));
+ return(strlen(s));
+ }
+
tzset();
pt = s;
@@ -315,7 +326,7 @@ _fmt(format, t)
continue;
#ifndef MAC_TCL
case 'Z': {
- char *name = TclpGetTZName();
+ char *name = TclpGetTZName(t->tm_isdst);
if (name && !_add(name)) {
return 0;
}
diff --git a/tcl/compat/string.h b/tcl/compat/string.h
index c9894783b8d..8b998f552b0 100644
--- a/tcl/compat/string.h
+++ b/tcl/compat/string.h
@@ -32,8 +32,12 @@ extern char * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n));
extern int memcmp _ANSI_ARGS_((CONST VOID *s1, CONST VOID *s2,
size_t n));
extern char * memcpy _ANSI_ARGS_((VOID *t, CONST VOID *f, size_t n));
+#ifdef NO_MEMMOVE
+#define memmove(d, s, n) bcopy ((s), (d), (n))
+#else
extern char * memmove _ANSI_ARGS_((VOID *t, CONST VOID *f,
size_t n));
+#endif
extern char * memset _ANSI_ARGS_((VOID *s, int c, size_t n));
extern int strcasecmp _ANSI_ARGS_((CONST char *s1,
diff --git a/tcl/compat/waitpid.c b/tcl/compat/waitpid.c
index e9adb632b06..e30c8882013 100644
--- a/tcl/compat/waitpid.c
+++ b/tcl/compat/waitpid.c
@@ -18,6 +18,10 @@
#include "tclInt.h"
#include "tclPort.h"
+#ifndef pid_t
+#define pid_t int
+#endif
+
/*
* A linked list of the following structures is used to keep track
* of processes for which we received notification from the kernel,
@@ -28,7 +32,7 @@
*/
typedef struct WaitInfo {
- int pid; /* Pid of process that exited. */
+ pid_t pid; /* Pid of process that exited. */
WAIT_STATUS_TYPE status; /* Status returned when child exited
* or suspended. */
struct WaitInfo *nextPtr; /* Next in list of exited processes. */
@@ -64,9 +68,9 @@ static WaitInfo *deadList = NULL; /* First in list of all dead
# undef waitpid
#endif
-int
+pid_t
waitpid(pid, statusPtr, options)
- int pid; /* The pid to wait on. Must be -1 or
+ pid_t pid; /* The pid to wait on. Must be -1 or
* greater than zero. */
int *statusPtr; /* Where to store wait status for the
* process. */
@@ -74,7 +78,7 @@ waitpid(pid, statusPtr, options)
* WUNTRACED. */
{
register WaitInfo *waitPtr, *prevPtr;
- int result;
+ pid_t result;
WAIT_STATUS_TYPE status;
if ((pid < -1) || (pid == 0)) {
diff --git a/tcl/configure b/tcl/configure
index c7b3e661c15..e60aab80775 100755
--- a/tcl/configure
+++ b/tcl/configure
@@ -28,6 +28,7 @@ program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
+sitefile=
srcdir=
target=NONE
verbose=
@@ -142,6 +143,7 @@ Configuration:
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
+ --site-file=FILE use FILE as the site file
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
@@ -312,6 +314,11 @@ EOF
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
+ -site-file | --site-file | --site-fil | --site-fi | --site-f)
+ ac_prev=sitefile ;;
+ -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
+ sitefile="$ac_optarg" ;;
+
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
@@ -477,12 +484,16 @@ fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+if test -z "$sitefile"; then
+ if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
fi
+else
+ CONFIG_SITE="$sitefile"
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
@@ -548,7 +559,7 @@ else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
fi
echo $ac_n "checking host system type""... $ac_c" 1>&6
-echo "configure:552: checking host system type" >&5
+echo "configure:563: checking host system type" >&5
host_alias=$host
case "$host_alias" in
@@ -570,13 +581,7 @@ echo "$ac_t""$host" 1>&6
case "${host}" in
-*-*-cygwin*)
- CONFIGDIR="win"
-
- CONFIGDIR2="cygwin"
-
- ;;
-*-*-mingw32*)
+*cygwin* | *mingw32* | *windows32*)
CONFIGDIR="win"
;;
@@ -606,7 +611,7 @@ ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
esac
echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
-echo "configure:610: checking whether ${MAKE-make} sets \${MAKE}" >&5
+echo "configure:615: checking whether ${MAKE-make} sets \${MAKE}" >&5
set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -632,7 +637,7 @@ else
SET_MAKE="MAKE=${MAKE-make}"
fi
-subdirs="$CONFIGDIR $CONFIGDIR2"
+subdirs="$CONFIGDIR"
trap '' 1 2 15
cat > confcache <<\EOF
@@ -784,7 +789,6 @@ s%@host_cpu@%$host_cpu%g
s%@host_vendor@%$host_vendor%g
s%@host_os@%$host_os%g
s%@CONFIGDIR@%$CONFIGDIR%g
-s%@CONFIGDIR2@%$CONFIGDIR2%g
s%@SET_MAKE@%$SET_MAKE%g
s%@subdirs@%$subdirs%g
@@ -919,7 +923,7 @@ if test "$no_recursion" != yes; then
esac
done
- for ac_config_dir in $CONFIGDIR $CONFIGDIR2; do
+ for ac_config_dir in $CONFIGDIR; do
# Do not complain, so a configure script can configure whichever
# parts of a large source tree are present.
diff --git a/tcl/configure.in b/tcl/configure.in
index 4286ff547fd..322de8e3dfd 100644
--- a/tcl/configure.in
+++ b/tcl/configure.in
@@ -11,13 +11,7 @@ AC_INIT(generic/tcl.h)
AC_CANONICAL_HOST
case "${host}" in
-*-*-cygwin*)
- CONFIGDIR="win"
- AC_SUBST(CONFIGDIR)
- CONFIGDIR2="cygwin"
- AC_SUBST(CONFIGDIR2)
- ;;
-*-*-mingw32*)
+*cygwin* | *mingw32* | *windows32*)
CONFIGDIR="win"
AC_SUBST(CONFIGDIR)
;;
@@ -29,5 +23,5 @@ case "${host}" in
esac
AC_PROG_MAKE_SET
-AC_CONFIG_SUBDIRS($CONFIGDIR $CONFIGDIR2)
+AC_CONFIG_SUBDIRS($CONFIGDIR)
AC_OUTPUT(Makefile)
diff --git a/tcl/cygtcl.m4 b/tcl/cygtcl.m4
new file mode 100644
index 00000000000..b74c2be7aca
--- /dev/null
+++ b/tcl/cygtcl.m4
@@ -0,0 +1,310 @@
+# CYGNUS LOCAL
+#
+# This entire file is Cygnus local, it contains a set of cross
+# platform autoconf macros to be used by Tcl extensions.
+
+# FIXME: There seems to be a problem with variable
+# names that still need an expansion (like $foo_FILE)
+# since another eval might be needed in these macros.
+
+#--------------------------------------------------------------------
+# TCL_TOOL_PATH
+#
+# Return a file path that the build system tool will understand.
+# This path might be different than the path used in the
+# Makefiles.
+#
+# Arguments:
+#
+# VAR
+# PATH
+#
+# Results:
+#
+#
+# Example:
+#
+# TCL_TOOL_PATH(TCL_CC_PATH, /usr/local/compiler)
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_PATH, [
+ val=$2
+
+ if test "$val" = "" ; then
+ AC_MSG_ERROR([Empty value for variable $1])
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ AC_MSG_ERROR([CYGPATH variable is not defined.])
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ $1=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ $1="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ $1=$val
+ ;;
+ esac
+])
+
+# FIXME: It would simplify things if no SUFFIX had to be passed
+# into these LONGNAME macros. Using the TCL_SHARED_LIB_SUFFIX
+# and TCL_UNSHARED_LIB_SUFFIX from tclConfig.sh might do the trick!
+
+#--------------------------------------------------------------------
+# TCL_TOOL_STATIC_LIB_LONGNAME
+#
+# Return static library name in the "long format" understood by
+# the build tools. This might involve prepending a suffix
+# and appending version information to the library name.
+#
+# Arguments:
+#
+# VAR
+# LIBNAME
+# SUFFIX
+#
+# Depends on:
+# TCL_DBGX
+# TCL_VENDOR_PREFIX
+#
+# Example:
+#
+# TCL_TOOL_STATIC_LIB_LONGNAME(TCL_LIB, tcl, $TCL_UNSHARED_LIB_SUFFIX)
+#
+# Results:
+#
+# TCL_LIB=libtcl83.a
+#
+# or
+#
+# TCL_LIB=tcl83.lib
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_STATIC_LIB_LONGNAME, [
+ libname=$2
+ suffix=$3
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ $1=$long_libname
+])
+
+#--------------------------------------------------------------------
+# TCL_TOOL_SHARED_LIB_LONGNAME
+#
+# Return the shared library name in the "long format" understood by
+# the build tools. This might involve prepending a suffix
+# and appending version information to the shared library name.
+#
+# Arguments:
+#
+# VAR
+# LIBNAME
+# SUFFIX
+#
+# Depends on:
+# TCL_DBGX
+# TCL_VENDOR_PREFIX
+#
+# Example:
+#
+# TCL_TOOL_SHARED_LIB_LONGNAME(TCL_SHLIB, tcl, $TCL_SHARED_LIB_SUFFIX)
+#
+# Results:
+# The above example could result in the following.
+#
+# TCL_SHLIB=libtcl83.so
+#
+# or
+#
+# TCL_SHLIB=tcl83.dll
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_SHARED_LIB_LONGNAME, [
+ libname=$2
+ suffix=$3
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ $1=$long_libname
+])
+
+#--------------------------------------------------------------------
+# TCL_TOOL_LIB_SHORTNAME
+#
+# Return the library name in the "short format" understood by
+# the build tools. This might involve prepending a suffix
+# and appending version information to the library name.
+# The VC++ compiler does not support short library names
+# so we just use the static import lib name in that case.
+#
+# Arguments:
+#
+# VAR
+# LIBNAME
+# VERSION
+#
+# Depends on:
+# TCL_LIB_VERSIONS_OK
+# TCL_DBGX
+# SHARED_BUILD
+#
+#
+# Example:
+#
+# TCL_TOOL_LIB_SHORTNAME(TCL_LIB, tcl, 8.3)
+#
+# Results:
+# The above example could result in the following.
+#
+# TCL_LIB=-ltcl83
+#
+# or
+#
+# TCL_LIB=tcl83.lib
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_LIB_SHORTNAME, [
+ libname=$2
+ version=$3
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ AC_MSG_ERROR([The TCL_LIB_SUFFIX variable is not defined])
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ $1=$short_libname
+])
+
+#--------------------------------------------------------------------
+# TCL_TOOL_LIB_SPEC
+#
+# Return the "lib spec format" understood by the build tools.
+#
+# Arguments:
+#
+# VAR
+# DIR
+# LIBARG
+#
+# Depends on:
+#
+#
+# Example:
+#
+# TCL_TOOL_LIB_SPEC(SPEC, /usr/lib, -ltcl)
+#
+# Results:
+# The above example could result in the following.
+#
+# SPEC="-L/usr/lib -ltcl83"
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_LIB_SPEC, [
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ TCL_TOOL_PATH($1, "$2/$3")
+ else
+ TCL_TOOL_PATH(dirname, $2)
+ $1="-L${dirname} $3"
+ fi
+ ;;
+ *)
+ $1="-L$2 $3"
+ ;;
+ esac
+])
+
+#--------------------------------------------------------------------
+# TCL_TOOL_LIB_PATH
+#
+# Return the "lib path format" understood by the build tools.
+# Typically, this is the fully qualified path name of the library.
+#
+# Arguments:
+#
+# VAR
+# DIR
+# LIBARG
+#
+# Depends on:
+#
+#
+# Example:
+#
+# TCL_TOOL_LIB_PATH(TMP_PATH, /usr/lib, libtcl83.a)
+#
+# Results:
+# The above example could result in the following.
+#
+# TMP_PATH="/usr/lib/libtcl83.a"
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_LIB_PATH, [
+ TCL_TOOL_PATH($1, "$2/$3")
+])
diff --git a/tcl/doc/Access.3 b/tcl/doc/Access.3
new file mode 100644
index 00000000000..ae68cb9e6a7
--- /dev/null
+++ b/tcl/doc/Access.3
@@ -0,0 +1,71 @@
+'\"
+'\" Copyright (c) 1998-1999 Scriptics Corportation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Access, Tcl_Stat \- check file permissions and other attributes
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_Access\fR(\fIpath\fR, \fImode\fR)
+.sp
+int
+\fBTcl_Stat\fR(\fIpath\fR, \fIstatPtr\fR)
+.SH ARGUMENTS
+.AS stat *statPtr in
+.AP char *path in
+Native name of the file to check the attributes of.
+.AP int mode in
+Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK,
+W_OK and X_OK request checking whether the file exists and has read,
+write and execute permissions, respectively. F_OK just requests
+checking for the existence of the file.
+.AP stat *statPtr out
+The structure that contains the result.
+.BE
+
+.SH DESCRIPTION
+.PP
+There are two reasons for calling \fBTcl_Access\fR and \fBTcl_Stat\fR
+rather than calling system level functions \fBaccess\fR and \fBstat\fR
+directly. First, the Windows implementation of both functions fixes
+some bugs in the system level calls. Second, both \fBTcl_Access\fR
+and \fBTcl_Stat\fR (as well as \fBTcl_OpenFileChannelProc\fR) hook
+into a linked list of functions. This allows the possibity to reroute
+file access to alternative media or access methods.
+.PP
+\fBTcl_Access\fR checks whether the process would be allowed to read,
+write or test for existence of the file (or other file system object)
+whose name is pathname. If pathname is a symbolic link on Unix,
+then permissions of the file referred by this symbolic link are
+tested.
+.PP
+On success (all requested permissions granted), zero is returned. On
+error (at least one bit in mode asked for a permission that is denied,
+or some other error occurred), -1 is returned.
+.PP
+\fBTcl_Stat\fR fills the stat structure \fIstatPtr\fR with information
+about the specified file. You do not need any access rights to the
+file to get this information but you need search rights to all
+directories named in the path leading to the file. The stat structure
+includes info regarding device, inode (always 0 on Windows),
+priviledge mode, nlink (always 1 on Windows), user id (always 0 on
+Windows), group id (always 0 on Windows), rdev (same as device on
+Windows), size, last access time, last modification time, and creation
+time.
+.PP
+If \fIpath\fR exists, \fBTcl_Stat\fR returns 0 and the stat structure
+is filled with data. Otherwise, -1 is returned, and no stat info is
+given.
+
+.SH KEYWORDS
+stat access
diff --git a/tcl/doc/AddErrInfo.3 b/tcl/doc/AddErrInfo.3
index 993b5dc62a9..58635d8b25c 100644
--- a/tcl/doc/AddErrInfo.3
+++ b/tcl/doc/AddErrInfo.3
@@ -8,10 +8,10 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_AddErrorInfo 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_AddErrorInfo 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_AddObjErrorInfo, Tcl_AddErrorInfo, Tcl_SetErrorCode, Tcl_PosixError \- record information about errors
+Tcl_AddObjErrorInfo, Tcl_AddErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_PosixError, Tcl_LogCommandInfo \- record information about errors
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -24,8 +24,13 @@ Tcl_AddObjErrorInfo, Tcl_AddErrorInfo, Tcl_SetErrorCode, Tcl_PosixError \- recor
.sp
\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR)
.sp
+\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR)
+.sp
char *
\fBTcl_PosixError\fR(\fIinterp\fR)
+.sp
+void
+\fBTcl_LogCommandInfo\fR(\fIinterp, script, command, commandLength\fR)
.SH ARGUMENTS
.AS Tcl_Interp *message
.AP Tcl_Interp *interp in
@@ -47,6 +52,15 @@ This variable \fBerrorCode\fR will be set to this value.
.AP char *element in
String to record as one element of \fBerrorCode\fR variable.
Last \fIelement\fR argument must be NULL.
+.AP va_list argList in
+An argument list which must have been initialised using
+\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
+.AP char *script in
+Pointer to first character in script containing command (must be <= command)
+.AP char *command in
+Pointer to first character in command that generated the error
+.AP int commandLength in
+Number of bytes in command; -1 means use all bytes up to first NULL byte
.BE
.SH DESCRIPTION
@@ -68,8 +82,8 @@ formats for \fBerrorCode\fR.
.PP
The \fBerrorInfo\fR variable is gradually built up as an
error unwinds through the nested operations.
-Each time an error code is returned to \fBTcl_EvalObj\fR
-(or \fBTcl_Eval\fR, which calls \fBTcl_EvalObj\fR)
+Each time an error code is returned to \fBTcl_EvalObjEx\fR
+(or \fBTcl_Eval\fR, which calls \fBTcl_EvalObjEx\fR)
it calls the procedure \fBTcl_AddObjErrorInfo\fR to add
additional text to \fBerrorInfo\fR describing the
command that was being executed when the error occurred.
@@ -79,7 +93,7 @@ of the activity in progress when the error occurred.
.PP
It is sometimes useful to add additional information to
\fBerrorInfo\fR beyond what can be supplied automatically
-by \fBTcl_EvalObj\fR.
+by \fBTcl_EvalObjEx\fR.
\fBTcl_AddObjErrorInfo\fR may be used for this purpose:
its \fImessage\fR and \fIlength\fR arguments describe an additional
string to be appended to \fBerrorInfo\fR.
@@ -89,7 +103,7 @@ line number on which the error occurred;
for Tcl procedures, the procedure name and line number
within the procedure are recorded, and so on.
The best time to call \fBTcl_AddObjErrorInfo\fR is just after
-\fBTcl_EvalObj\fR has returned \fBTCL_ERROR\fR.
+\fBTcl_EvalObjEx\fR has returned \fBTCL_ERROR\fR.
In calling \fBTcl_AddObjErrorInfo\fR, you may find it useful to
use the \fBerrorLine\fR field of the interpreter (see the
\fBTcl_Interp\fR manual entry for details).
@@ -118,6 +132,9 @@ The procedure \fBTcl_SetErrorCode\fR is also used to set the
record instead of an object. Otherwise, it is similar to
\fBTcl_SetObjErrorCode\fR in behavior.
.PP
+\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that
+instead of taking a variable number of arguments it takes an argument list.
+.PP
\fBTcl_PosixError\fR
sets the \fBerrorCode\fR variable after an error in a POSIX kernel call.
It reads the value of the \fBerrno\fR C variable and calls
@@ -136,6 +153,14 @@ It may be convenient to include this string as part of the
error message returned to the application in
the interpreter's result.
.PP
+\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 occured to the \fBerrorInfo\fR variable, and
+the line number stored internally in the interpreter is set. On the
+first call to \fBTcl_LogCommandInfo\fR or \fBTcl_AddObjErrorInfo\fR
+since an error occurred, the old information in \fBerrorInfo\fR is
+deleted.
+.PP
It is important to call the procedures described here rather than
setting \fBerrorInfo\fR or \fBerrorCode\fR directly with
\fBTcl_ObjSetVar2\fR.
diff --git a/tcl/doc/AppInit.3 b/tcl/doc/AppInit.3
index 66295a760fb..031e4df41af 100644
--- a/tcl/doc/AppInit.3
+++ b/tcl/doc/AppInit.3
@@ -51,7 +51,7 @@ Invoke a startup script to initialize the application.
.LP
\fBTcl_AppInit\fR returns TCL_OK or TCL_ERROR.
If it returns TCL_ERROR then it must leave an error message in
-\fIinterp->result\fR; otherwise the result is ignored.
+for the interpreter's result; otherwise the result is ignored.
.PP
In addition to \fBTcl_AppInit\fR, your application should also contain
a procedure \fBmain\fR that calls \fBTcl_Main\fR as follows:
diff --git a/tcl/doc/AssocData.3 b/tcl/doc/AssocData.3
index 8636597f04e..9acc9eb0f86 100644
--- a/tcl/doc/AssocData.3
+++ b/tcl/doc/AssocData.3
@@ -84,6 +84,6 @@ specified key exists in the given interpreter \fBTcl_GetAssocData\fR
returns \fBNULL\fR.
.PP
\fBTcl_DeleteAssocData\fR deletes an association with a specified key in
-the given interpreter. It does not call the deletion procedure.
+the given interpreter. Then it calls the deletion procedure.
.SH KEYWORDS
association, data, deletion procedure, interpreter, key
diff --git a/tcl/doc/Async.3 b/tcl/doc/Async.3
index 0d6658677fe..702e474293e 100644
--- a/tcl/doc/Async.3
+++ b/tcl/doc/Async.3
@@ -11,7 +11,7 @@
.TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete \- handle asynchronous events
+Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete, Tcl_AsyncReady \- handle asynchronous events
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -90,8 +90,8 @@ execution in an interpreter, then \fIinterp\fR will identify
the interpreter in which the command was evaluated and
\fIcode\fR will be the completion code returned by that
command.
-The command's result will be present in \fIinterp->result\fR.
-When \fIproc\fR returns, whatever it leaves in \fIinterp->result\fR
+The command's result will be present in the interpreter's result.
+When \fIproc\fR returns, whatever it leaves in the interpreter's result
will be returned as the result of the command and the integer
value returned by \fIproc\fR will be used as the new completion
code for the command.
@@ -127,7 +127,7 @@ not be invoked.
If multiple handlers become active at the same time, the
handlers are invoked in the order they were created (oldest
handler first).
-The \fIcode\fR and \fIinterp->result\fR for later handlers
+The \fIcode\fR and the interpreter's result for later handlers
reflect the values returned by earlier handlers, so that
the most recently created handler has last say about
the interpreter's result and completion code.
@@ -139,17 +139,17 @@ this over and over until there are no longer any ready handlers.
.SH WARNING
.PP
It is almost always a bad idea for an asynchronous event
-handler to modify \fIinterp->result\fR or return a code different
+handler to modify the interpreter's result or return a code different
from its \fIcode\fR argument.
This sort of behavior can disrupt the execution of scripts in
subtle ways and result in bugs that are extremely difficult
to track down.
If an asynchronous event handler needs to evaluate Tcl scripts
-then it should first save \fIinterp->result\fR plus the values
+then it should first save the interpreter's result plus the values
of the variables \fBerrorInfo\fR and \fBerrorCode\fR (this can
be done, for example, by storing them in dynamic strings).
When the asynchronous handler is finished it should restore
-\fIinterp->result\fR, \fBerrorInfo\fR, and \fBerrorCode\fR,
+the interpreter's result, \fBerrorInfo\fR, and \fBerrorCode\fR,
and return the \fIcode\fR argument.
.SH KEYWORDS
diff --git a/tcl/doc/BackgdErr.3 b/tcl/doc/BackgdErr.3
index 3fa59f8ef61..5716a9e4d81 100644
--- a/tcl/doc/BackgdErr.3
+++ b/tcl/doc/BackgdErr.3
@@ -33,7 +33,7 @@ obvious way for that code to report the error to the user.
In these cases the code calls \fBTcl_BackgroundError\fR with an
\fIinterp\fR argument identifying the interpreter in which the
error occurred. At the time \fBTcl_BackgroundError\fR is invoked,
-\fIinterp->result\fR is expected to contain an error message.
+the interpreter's result is expected to contain an error message.
\fBTcl_BackgroundError\fR will invoke the \fBbgerror\fR
Tcl command to report the error in an application-specific fashion.
If no \fBbgerror\fR command exists, or if it returns with an error condition,
diff --git a/tcl/doc/Backslash.3 b/tcl/doc/Backslash.3
index ceeddea3323..071bf97702d 100644
--- a/tcl/doc/Backslash.3
+++ b/tcl/doc/Backslash.3
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_Backslash 3 "" Tcl "Tcl Library Procedures"
+.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_Backslash \- parse a backslash sequence
@@ -30,16 +30,24 @@ the backslash character.
.SH DESCRIPTION
.PP
-This is a utility procedure used by several of the Tcl
-commands. It parses a backslash sequence and returns
-the single character corresponding to the sequence.
-\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number
-of characters in the backslash sequence.
+.VS 8.1
+The use of \fBTcl_Backslash\fR is deprecated in favor of
+\fBTcl_UtfBackslash\fR.
.PP
-See the Tcl manual entry for information on the valid
-backslash sequences.
-All of the sequences described in the Tcl
-manual entry are supported by \fBTcl_Backslash\fR.
+This is a utility procedure provided for backwards compatibilty with
+non-internationalized Tcl extensions. It parses a backslash sequence and
+returns the low byte of the Unicode character corresponding to the sequence.
+.VE
+\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of
+characters in the backslash sequence.
+.PP
+See the Tcl manual entry for information on the valid backslash sequences.
+All of the sequences described in the Tcl manual entry are supported by
+\fBTcl_Backslash\fR.
+.VS 8.1 br
+.SH "SEE ALSO"
+Tcl(n), Tcl_UtfBackslash(3)
+.VE
.SH KEYWORDS
backslash, parse
diff --git a/tcl/doc/ByteArrObj.3 b/tcl/doc/ByteArrObj.3
new file mode 100644
index 00000000000..ae3261b993d
--- /dev/null
+++ b/tcl/doc/ByteArrObj.3
@@ -0,0 +1,91 @@
+'\"
+'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl objects as a arrays of bytes
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_NewByteArrayObj\fR(\fIbytes, length\fR)
+.sp
+void
+\fBTcl_SetByteArrayObj\fR(\fIobjPtr, bytes, length\fR)
+.sp
+unsigned char *
+\fBTcl_GetByteArrayFromObj\fR(\fIobjPtr, lengthPtr\fR)
+.sp
+unsigned char *
+\fBTcl_SetByteArrayLength\fR(\fIobjPtr, length\fR)
+.SH ARGUMENTS
+.AS "unsigned char" *lengthPtr in/out
+.AP "unsigned char" *bytes in
+The array of bytes used to initialize or set a byte-array object.
+.AP int length in
+The length of the array of bytes. It must be >= 0.
+.AP Tcl_Obj *objPtr in/out
+For \fBTcl_SetByteArrayObj\fR, this points to the object to be converted to
+byte-array type. For \fBTcl_GetByteArrayFromObj\fR and
+\fBTcl_SetByteArrayLength\fR, this points to the object from which to get
+the byte-array value; if \fIobjPtr\fR does not already point to a byte-array
+object, it will be converted to one.
+.AP int *lengthPtr out
+If non-NULL, filled with the length of the array of bytes in the object.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are used to create, modify, and read Tcl byte-array objects
+from C code. Byte-array objects are typically used to hold the
+results of binary IO operations or data structures created with the
+\fBbinary\fR command. In Tcl, an array of bytes is not equivalent to a
+string. Conceptually, a string is an array of Unicode characters, while a
+byte-array is an array of 8-bit quantities with no implicit meaning.
+Accesser functions are provided to get the string representation of a
+byte-array or to convert an arbitrary object to a byte-array. Obtaining the
+string representation of a byte-array object (by calling
+\fBTcl_GetStringFromObj\fR) produces a properly formed UTF-8 sequence with a
+one-to-one mapping between the bytes in the internal representation and the
+UTF-8 characters in the string representation.
+.PP
+\fBTcl_NewByteArrayObj\fR and \fBTcl_SetByteArrayObj\fR will
+create a new object of byte-array type or modify an existing object to have a
+byte-array type. Both of these procedures set the object's type to be
+byte-array and set the object's internal representation to a copy of the
+array of bytes given by \fIbytes\fR. \fBTcl_NewByteArrayObj\fR returns a
+pointer to a newly allocated object with a reference count of zero.
+\fBTcl_SetByteArrayObj\fR invalidates any old string representation and, if
+the object is not already a byte-array object, frees any old internal
+representation.
+.PP
+\fBTcl_GetByteArrayFromObj\fR converts a Tcl object to byte-array type and
+returns a pointer to the object's new internal representation as an array of
+bytes. The length of this array is stored in \fIlengthPtr\fR if
+\fIlengthPtr\fR is non-NULL. The storage for the array of bytes is owned by
+the object and should not be freed. The contents of the array may be
+modified by the caller only if the object is not shared and the caller
+invalidates the string representation.
+.PP
+\fBTcl_SetByteArrayLength\fR converts the Tcl object to byte-array type
+and changes the length of the object's internal representation as an
+array of bytes. If \fIlength\fR is greater than the space currently
+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 object's new array of bytes.
+
+.SH "SEE ALSO"
+Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount
+
+.SH KEYWORDS
+object, byte array, utf, unicode, internationalization
diff --git a/tcl/doc/ChnlStack.3 b/tcl/doc/ChnlStack.3
new file mode 100644
index 00000000000..a99e2848e69
--- /dev/null
+++ b/tcl/doc/ChnlStack.3
@@ -0,0 +1,90 @@
+'\"
+'\" Copyright (c) 1999-2000 Ajuba Solutions.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+.so man.macros
+.TH Tcl_StackChannel 3 8.3 Tcl "Tcl Library Procedures"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_StackChannel, Tcl_UnstackChannel, Tcl_GetStackedChannel \- stack an I/O channel on top of another, and undo it
+.SH SYNOPSIS
+.nf
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Channel
+\fBTcl_StackChannel\fR(\fIinterp, typePtr, clientData, mask, channel\fR)
+.sp
+int
+\fBTcl_UnstackChannel\fR(\fIinterp, channel\fR)
+.sp
+Tcl_Channel
+\fBTcl_GetStackedChannel\fR(\fIchannel\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_ChannelType
+.AP Tcl_Interp *interp in
+Interpreter for error reporting - can be NULL.
+.AP Tcl_ChannelType *typePtr in
+The new channel I/O procedures to use for \fIchannel\fP.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to channel I/O procedures.
+.AP int mask in
+Conditions under which \fIchannel\fR will be used: OR-ed combination of
+\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR.
+This can be a subset of the operations currently allowed on \fIchannel\fP.
+.AP Tcl_Channel channel in
+An existing Tcl channel such as returned by \fBTcl_CreateChannel\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These functions are for use by extensions that add processing layers to Tcl
+I/O channels. Examples include compression and encryption modules. These
+functions transparently stack and unstack a new channel on top of an
+existing one. Any number of channels can be stacked together.
+.PP
+The implementation of the Tcl channel code was rewritten in 8.3.2 to
+correct some problems with the previous implementation with regard to
+stacked channels. Anyone using stacked channels or creating stacked
+channel drivers should update to the new \fBTCL_CHANNEL_VERSION_2\fR
+\fBTcl_ChannelType\fR structure. See \fBTcl_CreateChannel\fR for details.
+.PP
+\fBTcl_StackChannel\fR stacks a new \fIchannel\fP on an existing channel
+with the same name that was registered for \fIchannel\fP by
+\fBTcl_RegisterChannel\fP.
+.PP
+\fBTcl_StackChannel\fR works by creating a new channel structure and
+placing itself on top of the channel stack. EOL translation, encoding and
+buffering options are shared between all channels in the stack. The hidden
+channel does no buffering, newline translations, or character set encoding.
+Instead, the buffering, newline translations, and encoding functions all
+remain at the top of the channel stack. A pointer to the new top channel
+structure is returned. If an error occurs when stacking the channel, NULL
+is returned instead.
+.PP
+The \fImask\fP parameter specifies the operations that are allowed on the
+new channel. These can be a subset of the operations allowed on the
+original channel. For example, a read-write channel may become read-only
+after the \fBTcl_StackChannel\fR call.
+.PP
+Closing a channel closes the channels stacked below it. The close of
+stacked channels is executed in a way that allows buffered data to be
+properly flushed.
+.PP
+\fBTcl_UnstackChannel\fP reverses the process. The old channel is
+associated with the channel name, and the processing module added by
+\fBTcl_StackChannel\fR is destroyed. If there is no old channel, then
+\fBTcl_UnstackChannel\fP is equivalent to \fBTcl_Close\fP. If an error
+occurs unstacking the channel, \fBTCL_ERROR\fR is returned, otherwise
+\fBTCL_OK\fR is returned.
+
+.SH "SEE ALSO"
+Notifier(3), Tcl_CreateChannel(3), Tcl_OpenFileChannel(3), vwait(n).
+
+.SH KEYWORDS
+channel, compression
diff --git a/tcl/doc/CrtChannel.3 b/tcl/doc/CrtChannel.3
index 17e9079bb64..0030b7f61d4 100644
--- a/tcl/doc/CrtChannel.3
+++ b/tcl/doc/CrtChannel.3
@@ -1,16 +1,17 @@
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
+'\" Copyright (c) 1997-2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" RCS: @(#) $Id$
.so man.macros
-.TH Tcl_CreateChannel 3 8.0 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateChannel 3 8.3 Tcl "Tcl Library Procedures"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetDefaultTranslation, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption \- procedures for creating and manipulating channels
+Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, \- procedures for creating and manipulating channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -26,27 +27,62 @@ Tcl_ChannelType *
.sp
char *
\fBTcl_GetChannelName\fR(\fIchannel\fR)
-.VS
.sp
int
\fBTcl_GetChannelHandle\fR(\fIchannel, direction, handlePtr\fR)
-.VE
-.sp
-int
-\fBTcl_GetChannelFlags\fR(\fIchannel\fR)
-.sp
-\fBTcl_SetDefaultTranslation\fR(\fIchannel, transMode\fR)
.sp
int
\fBTcl_GetChannelBufferSize\fR(\fIchannel\fR)
.sp
\fBTcl_SetChannelBufferSize\fR(\fIchannel, size\fR)
.sp
-.VS
\fBTcl_NotifyChannel\fR(\fIchannel, mask\fR)
.sp
int
\fBTcl_BadChannelOption\fR(\fIinterp, optionName, optionList\fR)
+.VS 8.3.2
+.sp
+char *
+\fBTcl_ChannelName\fR(\fItypePtr\fR)
+.sp
+Tcl_ChannelTypeVersion
+\fBTcl_ChannelVersion\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverBlockModeProc *
+\fBTcl_ChannelBlockModeProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverCloseProc *
+\fBTcl_ChannelCloseProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverClose2Proc *
+\fBTcl_ChannelClose2Proc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverInputProc *
+\fBTcl_ChannelInputProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverOutputProc *
+\fBTcl_ChannelOutputProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverSeekProc *
+\fBTcl_ChannelSeekProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverSetOptionProc *
+\fBTcl_ChannelSetOptionProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverGetOptionProc *
+\fBTcl_ChannelGetOptionProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverWatchProc *
+\fBTcl_ChannelWatchProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverGetHandleProc *
+\fBTcl_ChannelGetHandleProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverFlushProc *
+\fBTcl_ChannelFlushProc\fR(\fItypePtr\fR)
+.sp
+Tcl_DriverHandlerProc *
+\fBTcl_ChannelHandlerProc\fR(\fItypePtr\fR)
.VE
.sp
.SH ARGUMENTS
@@ -66,20 +102,17 @@ OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
whether a channel is readable and writable.
.AP Tcl_Channel channel in
The channel to operate on.
-.VS
.AP int direction in
\fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR
means the output handle is wanted.
.AP ClientData *handlePtr out
Points to the location where the desired OS-specific handle should be
stored.
-.VE
.AP Tcl_EolTranslation transMode in
The translation mode; one of the constants \fBTCL_TRANSLATE_AUTO\fR,
\fBTCL_TRANSLATE_CR\fR, \fBTCL_TRANSLATE_LF\fR and \fBTCL_TRANSLATE_CRLF\fR.
.AP int size in
The size, in bytes, of buffers to allocate in this channel.
-.VS
.AP int mask in
An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR that indicates events that have occurred on
@@ -92,7 +125,6 @@ Name of the invalid option.
Specific options list (space separated words, without "-")
to append to the standard generic options list.
Can be NULL for generic options error message only.
-.VE
.BE
@@ -156,7 +188,6 @@ the same as the \fItypePtr\fR argument in the call to
with the channel, or NULL if the \fIchannelName\fR argument to
\fBTcl_CreateChannel\fR was NULL.
.PP
-.VS
\fBTcl_GetChannelHandle\fR places the OS-specific device handle
associated with \fIchannel\fR for the given \fIdirection\fR in the
location specified by \fIhandlePtr\fR and returns \fBTCL_OK\fR. If
@@ -164,19 +195,12 @@ the channel does not have a device handle for the specified direction,
then \fBTCL_ERROR\fR is returned instead. Different channel drivers
will return different types of handle. Refer to the manual entries
for each driver to determine what type of handle is returned.
-.VE
.PP
\fBTcl_GetChannelMode\fR returns an OR-ed combination of \fBTCL_READABLE\fR
and \fBTCL_WRITABLE\fR, indicating whether the channel is open for input
and output.
.PP
-\fBTcl_SetDefaultTranslation\fR sets the default end of line translation
-mode. This mode will be installed as the translation mode for the channel
-if an attempt is made to output on the channel while it is still in
-\fBTCL_TRANSLATE_AUTO\fR mode. For a description of end of line translation
-modes, see the manual entry for \fBfconfigure\fR.
-.PP
-\fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers
+ \fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers
allocated to store input or output in \fIchan\fR. If the value was not set
by a previous call to \fBTcl_SetChannelBufferSize\fR, described below, then
the default value of 4096 is returned.
@@ -188,31 +212,29 @@ allowing buffers of ten bytes to one million bytes. If \fIsize\fR is
outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to
4096.
.PP
-.VS
\fBTcl_NotifyChannel\fR is called by a channel driver to indicate to
the generic layer that the events specified by \fImask\fR have
occurred on the channel. Channel drivers are responsible for invoking
this function whenever the channel handlers need to be called for the
channel. See \fBWATCHPROC\fR below for more details.
-.VE
.PP
-.VS
\fBTcl_BadChannelOption\fR is called from driver specific set or get option
procs to generate a complete error message.
-.VE
.SH TCL_CHANNELTYPE
.PP
A channel driver provides a \fBTcl_ChannelType\fR structure that contains
pointers to functions that implement the various operations on a channel;
-these operations are invoked as needed by the generic layer. The
-\fBTcl_ChannelType\fR structure contains the following fields:
+these operations are invoked as needed by the generic layer. The structure
+was versioned starting in Tcl 8.3.2/8.4 to correct a problem with stacked
+channel drivers. See the \fBOLD_CHANNEL\fR section below for details about
+the old structure.
.PP
-.VS
+The \fBTcl_ChannelType\fR structure contains the following fields:
.CS
typedef struct Tcl_ChannelType {
char *\fItypeName\fR;
- Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
+ Tcl_ChannelTypeVersion \fIversion\fR;
Tcl_DriverCloseProc *\fIcloseProc\fR;
Tcl_DriverInputProc *\fIinputProc\fR;
Tcl_DriverOutputProc *\fIoutputProc\fR;
@@ -221,22 +243,63 @@ typedef struct Tcl_ChannelType {
Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
Tcl_DriverWatchProc *\fIwatchProc\fR;
Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
+ Tcl_DriverClose2Proc *\fIclose2Proc\fR;
+ Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
+ Tcl_DriverFlushProc *\fIflushProc\fR;
+ Tcl_DriverHandlerProc *\fIhandlerProc\fR;
} Tcl_ChannelType;
.CE
-.VE
.PP
The driver must provide implementations for all functions except
-\fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR, and
-\fIgetOptionProc\fR, which may be specified as NULL to indicate that the
-channel does not support seeking. Other functions that can not be
-implemented for this type of device should return \fBEINVAL\fR when invoked
-to indicate that they are not implemented.
+\fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR,
+\fIgetOptionProc\fR, and \fIclose2Proc\fR, which may be specified as
+NULL. Other functions that can not be implemented for this type of
+device should return \fBEINVAL\fR when invoked to indicate that they
+are not implemented, except in the case of \fIflushProc\fR and
+\fIhandlerProc\fR, which should specified as NULL if not otherwise defined.
+.PP
+.VS 8.3.2
+The user should only use the above structure for \fBTcl_ChannelType\fR
+instantiation. When referencing fields in a \fBTcl_ChannelType\fR
+structure, the following functions should be used to obtain the values:
+\fBTcl_ChannelName\fR, \fBTcl_ChannelVersion\fR,
+\fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelCloseProc\fR,
+\fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR,
+\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
+\fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR,
+\fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR,
+\fBTcl_ChannelFlushProc\fR, or \fBTcl_ChannelHandlerProc\fR.
+.PP
+The change to the structures was made in such a way that standard channel
+types are binary compatible. However, channel types that use stacked
+channels (ie: TLS, Trf) have new versions to correspond to the above change
+since the previous code for stacked channels had problems.
+.VE
.SH TYPENAME
.PP
The \fItypeName\fR field contains a null-terminated string that
identifies the type of the device implemented by this driver, e.g.
\fBfile\fR or \fBsocket\fR.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelName\fR, which returns
+a pointer to the string.
+.VE
+
+.VS 8.3.2
+.SH VERSION
+.PP
+The \fIversion\fR field should be set to \fBTCL_CHANNEL_VERSION_2\fR.
+If it is not set to this value \fBTCL_CHANNEL_VERSION_2\fR, then this
+\fBTcl_ChannelType\fR is assumed to have the older structure. See
+\fBOLD_CHANNEL\fR for more details. While Tcl will recognize and
+function with either structure, stacked channels must be of the newer
+style to function correctly.
+.PP
+This value can be retried with \fBTcl_ChannelVersion\fR, which returns
+either \fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
+.VE
.SH BLOCKMODEPROC
.PP
@@ -263,8 +326,13 @@ nonblocking mode and to implement the blocking or nonblocking behavior.
For some device types, the blocking and nonblocking behavior can be
implemented by the underlying operating system; for other device types, the
behavior must be emulated in the channel driver.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelBlockModeProc\fR, which returns
+a pointer to the function.
+.VE
-.SH CLOSEPROC
+.SH "CLOSEPROC AND CLOSE2PROC"
.PP
The \fIcloseProc\fR field contains the address of a function called by the
generic layer to clean up driver-related information when the channel is
@@ -285,7 +353,40 @@ and no further driver operations will be invoked on this instance after
calling the \fIcloseProc\fR. If the close operation is successful, the
procedure should return zero; otherwise it should return a nonzero POSIX
error code. In addition, if an error occurs and \fIinterp\fR is not NULL,
-the procedure should store an error message in \fIinterp->result\fR.
+the procedure should store an error message in the interpreter's result.
+.PP
+Alternatively, channels that support closing the read and write sides
+independently may set \fIcloseProc\fR to \fBTCL_CLOSE2PROC\fR and set
+\fIclose2Proc\fR to the address of a function that matches the
+following prototype:
+.PP
+.CS
+typedef int Tcl_DriverClose2Proc(
+ ClientData \fIinstanceData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ int \fIflags\fR);
+.CE
+.PP
+The \fIclose2Proc\fR will be called with \fIflags\fR set to an OR'ed
+combination of \fBTCL_CLOSE_READ\fR or \fBTCL_CLOSE_WRITE\fR to
+indicate that the driver should close the read and/or write side of
+the channel. The channel driver may be invoked to perform
+additional operations on the channel after \fIclose2Proc\fR is
+called to close one or both sides of the channel. If \fIflags\fR is
+\fB0\fR (zero), the driver should close the channel in the manner
+described above for \fIcloseProc\fR. No further operations will be
+invoked on this instance after \fIclose2Proc\fR is called with all
+flags cleared. In all cases, the \fIclose2Proc\fR function should
+return zero if the close operation was successful; otherwise it should
+return a nonzero POSIX error code. In addition, if an error occurs and
+\fIinterp\fR is not NULL, the procedure should store an error message
+in the interpreter's result.
+.PP
+.VS 8.3.2
+These value can be retried with \fBTcl_ChannelCloseProc\fR or
+\fBTcl_ChannelClose2Proc\fR, which returns a pointer to the respective
+function.
+.VE
.SH INPUTPROC
.PP
@@ -328,6 +429,11 @@ whatsoever and the channel is in blocking mode, the function should block
for the shortest possible time until at least one byte of data can be read
from the device; then, it should return as much data as it can read without
blocking.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelInputProc\fR, which returns
+a pointer to the function.
+.VE
.SH OUTPUTPROC
.PP
@@ -364,6 +470,11 @@ error, some data may have been written to the device.
If the channel is nonblocking and the output device is unable to absorb any
data whatsoever, the function should return -1 with an \fBEAGAIN\fR error
without writing any data.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelOutputProc\fR, which returns
+a pointer to the function.
+.VE
.SH SEEKPROC
.PP
@@ -382,7 +493,7 @@ typedef int Tcl_DriverSeekProc(
.PP
The \fIinstanceData\fR argument is the same as the value given to
\fBTcl_CreateChannel\fR when this channel was created. \fIOffset\fR and
-\fIseekMode\fR have the same meaning as for the \fBTcl_SeekChannel\fR
+\fIseekMode\fR have the same meaning as for the \fBTcl_Seek\fR
procedure (described in the manual entry for \fBTcl_OpenFileChannel\fR).
.PP
The \fIerrorCodePtr\fR argument points to an integer variable provided by
@@ -393,6 +504,11 @@ does not implement seeking.
.PP
The return value is the new access point or -1 in case of error. If an
error occurred, the function should not move the access point.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelSeekProc\fR, which returns
+a pointer to the function.
+.VE
.SH SETOPTIONPROC
.PP
@@ -423,17 +539,20 @@ options.
.PP
If the option value is successfully modified to the new value, the function
returns \fBTCL_OK\fR.
-.VS
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized.
-.VE
If \fIoptionValue\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
\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelSetOptionProc\fR, which returns
+a pointer to the function.
+.VE
.SH GETOPTIONPROC
.PP
@@ -444,9 +563,7 @@ channel. \fIgetOptionProc\fR must match the following prototype:
.CS
typedef int Tcl_DriverGetOptionProc(
ClientData \fIinstanceData\fR,
-.VS
Tcl_Interp *\fIinterp\fR,
-.VE
char *\fIoptionName\fR,
Tcl_DString *\fIdsPtr\fR);
.CE
@@ -457,7 +574,6 @@ value, as a string, in the Tcl dynamic string \fIdsPtr\fR.
If \fIoptionName\fR is NULL, the function stores in \fIdsPtr\fR an
alternating list of all supported options and their current values.
On success, the function returns \fBTCL_OK\fR.
-.VS
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized. If a system call error occurs,
@@ -465,7 +581,6 @@ the function should leave an error message in the
\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
-.VE
.PP
Some options are handled by the generic code and this function is never
called to retrieve their value, e.g. \fB-blockmode\fR. Other options are
@@ -473,9 +588,13 @@ specific to each channel type and the \fIgetOptionProc\fR procedure of the
channel driver will get called to implement them. The \fIgetOptionProc\fR
field can be NULL, which indicates that this channel type supports no type
specific options.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelGetOptionProc\fR, which returns
+a pointer to the function.
+.VE
.SH WATCHPROC
-.VS
.PP
The \fIwatchProc\fR field contains the address of a function called
by the generic layer to initialize the event notification mechanism to
@@ -487,7 +606,6 @@ typedef void Tcl_DriverWatchProc(
ClientData \fIinstanceData\fR,
int \fImask\fR);
.CE
-.VE
.PP
The \fIinstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created. The \fImask\fR
@@ -495,7 +613,6 @@ argument is an OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR; it indicates events the caller is interested in
noticing on this channel.
.PP
-.VS
The function should initialize device type specific mechanisms to
notice when an event of interest is present on the channel. When one
or more of the designated events occurs on the channel, the channel
@@ -506,6 +623,11 @@ Tcl_NotifyChannel too frequently. Fairness can be insured by using
the Tcl event queue to allow the channel event to be scheduled in sequence
with other events. See the description of \fBTcl_QueueEvent\fR for
details on how to queue an event.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelWatchProc\fR, which returns
+a pointer to the function.
+.VE
.SH GETHANDLEPROC
.PP
@@ -520,7 +642,7 @@ typedef int Tcl_DriverGetHandleProc(
ClientData *\fIhandlePtr\fR);
.CE
.PP
-\fIInstanceData is the same as the value passed to
+\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created. The \fIdirection\fR
argument is either \fBTCL_READABLE\fR to retrieve the handle used
for input, or \fBTCL_WRITABLE\fR to retrieve the handle used for
@@ -533,9 +655,50 @@ stored in the location referred to by \fIhandlePtr\fR, and
\fBTCL_OK\fR should be returned. If the channel is not open for the
specified direction, or if the channel implementation does not use
device handles, the function should return \fBTCL_ERROR\fR.
+.PP
+.VS 8.3.2
+This value can be retried with \fBTcl_ChannelGetHandleProc\fR, which returns
+a pointer to the function.
+.VE
+
+.VS 8.3.2
+.SH FLUSHPROC
+.PP
+The \fIflushProc\fR field is currently reserved for future use.
+It should be set to NULL.
+\fIFlushProc\fR should match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverFlushProc(
+ ClientData \fIinstanceData\fR);
+.CE
+.PP
+This value can be retried with \fBTcl_ChannelFlushProc\fR, which returns
+a pointer to the function.
+
+.SH HANDLERPROC
+.PP
+The \fIhandlerProc\fR field contains the address of a function called by
+the generic layer to notify the channel that an event occured. It should
+be defined for stacked channel drivers that wish to be notified of events
+that occur on the underlying (stacked) channel.
+\fIHandlerProc\fR should match the following prototype:
+.PP
+.CS
+typedef int Tcl_DriverHandlerProc(
+ ClientData \fIinstanceData\fR,
+ int \fIinterestMask\fR);
+.CE
+.PP
+\fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR
+when this channel was created. The \fIinterestMask\fR is an OR-ed
+combination of \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR; it indicates what
+type of event occured on this channel.
+.PP
+This value can be retried with \fBTcl_ChannelHandlerProc\fR, which returns
+a pointer to the function.
.VE
-.VS
.SH TCL_BADCHANNELOPTION
.PP
This procedure generates a "bad option" error message in an
@@ -558,14 +721,40 @@ so you get for instance:
-peername, or -sockname
when called with optionList="peername sockname"
.CE
-"blah" is the optionName argument and "<specific options>"
+``blah'' is the optionName argument and ``<specific options>''
is a space separated list of specific option words.
The function takes good care of inserting minus signs before
-each option, commas after, and an "or" before the last option.
-.VE
+each option, commas after, and an ``or'' before the last option.
+
+.SH OLD_CHANNEL
+
+The original (8.3.1 and below) \fBTcl_ChannelType\fR structure contains
+the following fields:
+.PP
+.CS
+typedef struct Tcl_ChannelType {
+ char *\fItypeName\fR;
+ Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
+ Tcl_DriverCloseProc *\fIcloseProc\fR;
+ Tcl_DriverInputProc *\fIinputProc\fR;
+ Tcl_DriverOutputProc *\fIoutputProc\fR;
+ Tcl_DriverSeekProc *\fIseekProc\fR;
+ Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
+ Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
+ Tcl_DriverWatchProc *\fIwatchProc\fR;
+ Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
+ Tcl_DriverClose2Proc *\fIclose2Proc\fR;
+} Tcl_ChannelType;
+.CE
+.PP
+It is still possible to create channel with the above structure. The
+internal channel code will determine the version. It is imperative to use
+the new \fBTcl_ChannelType\fR structure if you are creating a stacked
+channel driver, due to problems with the earlier stacked channel
+implementation (in 8.2.0 to 8.3.1).
.SH "SEE ALSO"
-Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3), Tcl_QueueEvent(3)
+Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3), Tcl_QueueEvent(3), Tcl_StackChannel(3)
.SH KEYWORDS
blocking, channel driver, channel registration, channel type, nonblocking
diff --git a/tcl/doc/CrtInterp.3 b/tcl/doc/CrtInterp.3
index bc7e9cca53a..4347736413d 100644
--- a/tcl/doc/CrtInterp.3
+++ b/tcl/doc/CrtInterp.3
@@ -36,7 +36,7 @@ a token for it. The token is required in calls to most other Tcl
procedures, such as \fBTcl_CreateCommand\fR, \fBTcl_Eval\fR, and
\fBTcl_DeleteInterp\fR.
Clients are only allowed to access a few of the fields of
-Tcl_Interp structures; see the Tcl_Interp
+Tcl_Interp structures; see the \fBTcl_Interp\fR
and \fBTcl_CreateCommand\fR man pages for details.
The new interpreter is initialized with no defined variables and only
the built-in Tcl commands. To bind in additional commands, call
@@ -49,10 +49,10 @@ resources associated with it, including variables, procedures, and
application-specific command bindings, will be deleted. After
\fBTcl_DeleteInterp\fR returns any attempt to use \fBTcl_Eval\fR on the
interpreter will fail and return \fBTCL_ERROR\fR. After the call to
-\fBTcl_DeleteInterp\fR it is safe to examine \fIinterp->result\fR, query or
-set the values of variables, define, undefine or retrieve procedures, and
-examine the runtime evaluation stack. See below, in the section
-\fBINTERPRETERS AND MEMORY MANAGEMENT\fR for details.
+\fBTcl_DeleteInterp\fR it is safe to examine the interpreter's result,
+query or set the values of variables, define, undefine or retrieve
+procedures, and examine the runtime evaluation stack. See below, in the
+section \fBINTERPRETERS AND MEMORY MANAGEMENT\fR for details.
.PP
\fBTcl_InterpDeleted\fR returns nonzero if \fBTcl_DeleteInterp\fR was
called with \fIinterp\fR as its argument; this indicates that the
@@ -124,8 +124,8 @@ All uses of interpreters in Tcl and Tk have already been protected.
Extension writers should ensure that their code also properly protects any
additional interpreters used, as described above.
-.SH KEYWORDS
-command, create, delete, interpreter
-
.SH "SEE ALSO"
Tcl_Preserve(3), Tcl_Release(3)
+
+.SH KEYWORDS
+command, create, delete, interpreter
diff --git a/tcl/doc/CrtMathFnc.3 b/tcl/doc/CrtMathFnc.3
index b35b883cf58..253c10cafc8 100644
--- a/tcl/doc/CrtMathFnc.3
+++ b/tcl/doc/CrtMathFnc.3
@@ -87,7 +87,7 @@ It should set also \fIresultPtr->type\fR to either TCL_INT or TCL_DOUBLE
to indicate which value was set.
Under normal circumstances \fIproc\fR should return TCL_OK.
If an error occurs while executing the function, \fIproc\fR should
-return TCL_ERROR and leave an error message in \fIinterp->result\fR.
+return TCL_ERROR and leave an error message in the interpreter's result.
.SH KEYWORDS
expression, mathematical function
diff --git a/tcl/doc/CrtObjCmd.3 b/tcl/doc/CrtObjCmd.3
index 74ec90bf6c0..2b97779c7f7 100644
--- a/tcl/doc/CrtObjCmd.3
+++ b/tcl/doc/CrtObjCmd.3
@@ -59,11 +59,13 @@ Tcl command.
\fBTcl_CreateObjCommand\fR defines a new command in \fIinterp\fR
and associates it with procedure \fIproc\fR
such that whenever \fIname\fR is
-invoked as a Tcl command (e.g., via a call to \fBTcl_EvalObj\fR)
+invoked as a Tcl command (e.g., via a call to \fBTcl_EvalObjEx\fR)
the Tcl interpreter will call \fIproc\fR to process the command.
.PP
-\fBTcl_CreateObjCommand\fR will delete any command \fIname\fR
-already associated with the interpreter.
+\fBTcl_CreateObjCommand\fR deletes any existing command
+\fIname\fR already associated with the interpreter
+(however see below for an exception where the existing command
+is not deleted).
It returns a token that may be used to refer
to the command in subsequent calls to \fBTcl_GetCommandName\fR.
If \fIname\fR contains any \fB::\fR namespace qualifiers,
@@ -101,7 +103,7 @@ cause memory to be lost and the runtime stack to be corrupted. The
compilers to report any such attempted assignment as an error. However,
it is acceptable to modify the internal representation of any individual
object argument. For instance, the user may call
-\fBTcl_GetIntFromObject\fR on \fIobjv\fR[\fB2\fR] to obtain the integer
+\fBTcl_GetIntFromObj\fR on \fIobjv\fR[\fB2\fR] to obtain the integer
representation of that object; that call may change the type of the object
that \fIobjv\fR[\fB2\fR] points at, but will not change where
\fIobjv\fR[\fB2\fR] points.
@@ -118,7 +120,7 @@ In the case of a \fBTCL_OK\fR return code this gives the result
of the command,
and in the case of \fBTCL_ERROR\fR this gives an error message.
Before invoking a command procedure,
-\fBTcl_EvalObj\fR sets interpreter's result to
+\fBTcl_EvalObjEx\fR sets interpreter's result to
point to an object representing an empty string, so simple
commands can return an empty result by doing nothing at all.
.PP
@@ -128,6 +130,17 @@ not modify them.
Call \fBTcl_SetObjResult\fR if you want
to return something from the \fIobjv\fR array.
.PP
+Ordinarily, \fBTcl_CreateObjCommand\fR deletes any existing command
+\fIname\fR already associated with the interpreter.
+However, if the existing command was created by a previous call to
+\fBTcl_CreateCommand\fR,
+\fBTcl_CreateObjCommand\fR does not delete the command
+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
+\fBTcl_GetCommandInfo\fR calls. This is done for backwards compatibility.
+.PP
\fIDeleteProc\fR will be invoked when (if) \fIname\fR is deleted.
This can occur through a call to \fBTcl_DeleteCommand\fR,
\fBTcl_DeleteCommandFromToken\fR, or \fBTcl_DeleteInterp\fR,
@@ -239,7 +252,6 @@ The string returned by \fBTcl_GetCommandName\fR is in dynamic memory
owned by Tcl and is only guaranteed to retain its value as long as the
command isn't deleted or renamed; callers should copy the string if
they need to keep it for a long time.
-.PP
.SH "SEE ALSO"
Tcl_CreateCommand, Tcl_ResetResult, Tcl_SetObjResult
diff --git a/tcl/doc/CrtSlave.3 b/tcl/doc/CrtSlave.3
index 3c99cff1cf3..88767a12a87 100644
--- a/tcl/doc/CrtSlave.3
+++ b/tcl/doc/CrtSlave.3
@@ -170,7 +170,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_CreateAliasObj\fR except
+\fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAlias\fR except
that it takes a vector of objects to pass as additional arguments instead
of a vector of strings.
.VE
diff --git a/tcl/doc/DString.3 b/tcl/doc/DString.3
index 00b76bde315..ae73fe83ef7 100644
--- a/tcl/doc/DString.3
+++ b/tcl/doc/DString.3
@@ -36,6 +36,8 @@ char *
.sp
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
+\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR)
+.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
@@ -124,13 +126,17 @@ caller to fill in the new space.
even if the string is truncated to zero length, so \fBTcl_DStringFree\fR
will still need to be called.
.PP
+\fBTcl_DStringTrunc\fR changes the length of a dynamic string.
+This procedure is now deprecated. \fBTcl_DStringSetLength\fR should
+be used instead.
+.PP
\fBTcl_DStringFree\fR should be called when you're finished using
the string. It frees up any memory that was allocated for the string
and reinitializes the string's value to an empty string.
.PP
\fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of
the dynamic string given by \fIdsPtr\fR. It does this by moving
-a pointer from \fIdsPtr\fR to \fIinterp->result\fR.
+a pointer from \fIdsPtr\fR to the interpreter's result.
This saves the cost of allocating new memory and copying the string.
\fBTcl_DStringResult\fR also reinitializes the dynamic string to
an empty string.
diff --git a/tcl/doc/DumpActiveMemory.3 b/tcl/doc/DumpActiveMemory.3
new file mode 100644
index 00000000000..285c0f3fffb
--- /dev/null
+++ b/tcl/doc/DumpActiveMemory.3
@@ -0,0 +1,68 @@
+'\"
+'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
+'\" Copyright (c) 2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_DumpActiveMemory\fR(\fIfileName\fR)
+.sp
+void
+\fBTcl_InitMemory\fR(\fIinterp\fR)
+.sp
+void
+\fBTcl_ValidateAllMemory\fR(\fIfileName, line\fR)
+
+.SH ARGUMENTS
+.AP Tcl_Interp *interp in
+Tcl interpreter in which to add commands.
+.AP char *fileName in
+For \fBTcl_DumpActiveMemory\fR, name of the file to which memory
+information will be written. For \fBTcl_ValidateAllMemory\fR, name of
+the file from which the call is being made (normally \fB__FILE__\fR).
+.AP int line in
+Line number at which the call to \fBTcl_ValidateAllMemory\fR is made
+(normally \fB__LINE__\fR).
+.BE
+
+.SH DESCRIPTION
+These functions provide access to Tcl memory debugging information.
+They are only available when Tcl has been compiled with
+\fBTCL_MEM_DEBUG\fR defined at compile-time.
+.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
+(excluding guard zone), size, source file where \fBckalloc\fR was
+called to allocate the block and line number in that file. It is
+especially useful to call \fBTcl_DumpActiveMemory\fR after the Tcl
+interpreter has been deleted.
+.PP
+\fBTcl_InitMemory\fR adds the Tcl \fBmemory\fR command to the
+interpreter given by \fIinterp\fR. It is called by \fBTcl_Main\fR
+when Tcl has been compiled with \fBTCL_MEM_DEBUG\fR defined.
+.PP
+\fBTcl_ValidateAllMemory\fR forces a validation of the guard zones of
+all currently allocated blocks of memory. Normally validation of a
+block occurs when its freed, unless full validation is enabled, in
+which case validation of all blocks occurs when \fBckalloc\fR and
+\fBckfree\fR are called. This function forces the validation to occur
+at any point.
+
+.SH "SEE ALSO"
+TCL_MEM_DEBUG, memory
+
+.SH KEYWORDS
+memory, debug
+
+
diff --git a/tcl/doc/Encoding.3 b/tcl/doc/Encoding.3
new file mode 100644
index 00000000000..146007f5782
--- /dev/null
+++ b/tcl/doc/Encoding.3
@@ -0,0 +1,522 @@
+'\"
+'\" Copyright (c) 1997-1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Encoding
+\fBTcl_GetEncoding\fR(\fIinterp, name\fR)
+.sp
+void
+\fBTcl_FreeEncoding\fR(\fIencoding\fR)
+.sp
+char *
+\fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
+.sp
+int
+\fBTcl_ExternalToUtf\fR(\fIinterp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
+ dstCharsPtr\fR)
+.sp
+char *
+\fBTcl_UtfToExternalDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
+.sp
+int
+\fBTcl_UtfToExternal\fR(\fIinterp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
+ dstCharsPtr\fR)
+.sp
+char *
+\fBTcl_WinTCharToUtf\fR(\fItsrc, srcLen, dstPtr\fR)
+.sp
+TCHAR *
+\fBTcl_WinUtfToTChar\fR(\fIsrc, srcLen, dstPtr\fR)
+.sp
+char *
+\fBTcl_GetEncodingName\fR(\fIencoding\fR)
+.sp
+int
+\fBTcl_SetSystemEncoding\fR(\fIinterp, name\fR)
+.sp
+void
+\fBTcl_GetEncodingNames\fR(\fIinterp\fR)
+.sp
+Tcl_Encoding
+\fBTcl_CreateEncoding\fR(\fItypePtr\fR)
+.sp
+char *
+\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR)
+.sp
+void
+\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR)
+
+
+.SH ARGUMENTS
+.AS Tcl_EncodingState *dstWrotePtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting, or NULL if no error reporting is
+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
+NULL, the current system encoding is used.
+.AP "CONST char" *src in
+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.
+.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
+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.
+TCL_ENCODING_START 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
+perform any initialization that needs to occur before the first byte is
+converted. TCL_ENCODING_END signifies that the source buffer is the last
+block in a (potentially multi-block) input stream, telling the conversion
+routine to perform any finalization that needs to occur after the last
+byte is converted and then to reset to an initial state.
+TCL_ENCODING_STOPONERROR signifies that the conversion routine should
+return immediately upon reading a source character that doesn't exist in
+the target encoding; otherwise a default fallback character will
+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
+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
+is ignored and the source buffer is assumed to contain the complete string to
+convert.
+.AP char *dst out
+Buffer in which the converted result will be stored. No more than
+\fIdstLen\fR bytes will be stored in \fIdst\fR.
+.AP int dstLen in
+The maximum length of the output buffer \fIdst\fR in bytes.
+.AP int *srcReadPtr out
+Filled with the number of bytes from \fIsrc\fR that were actually
+converted. This may be less than the original source length if there was
+a problem converting some source characters. May be NULL.
+.AP int *dstWrotePtr out
+Filled with the number of bytes that were actually stored in the output
+buffer as a result of the conversion. May be NULL.
+.AP int *dstCharsPtr out
+Filled with the number of characters that correspond to the number of bytes
+stored in the output buffer. May be NULL.
+.AP Tcl_EncodingType *typePtr in
+Structure that defines a new type of encoding.
+.AP char *path in
+A path to the location of the encoding file.
+.BE
+.SH INTRODUCTION
+.PP
+These routines convert between Tcl's internal character representation,
+UTF-8, and character representations used by various operating systems or
+file systems, such as Unicode, ASCII, or Shift-JIS. When operating on
+strings, such as such as obtaining the names of files or displaying
+characters using international fonts, the strings must be translated into
+one or possibly multiple formats that the various system calls can use. For
+instance, on a Japanese Unix workstation, a user might obtain a filename
+represented in the EUC-JP file encoding and then translate the characters to
+the jisx0208 font encoding in order to display the filename in a Tk widget.
+The purpose of the encoding package is to help bridge the translation gap.
+UTF-8 provides an intermediate staging ground for all the various
+encodings. In the example above, text would be translated into UTF-8 from
+whatever file encoding the operating system is using. Then it would be
+translated from UTF-8 into whatever font encoding the display routines
+require.
+.PP
+Some basic encodings are compiled into Tcl. Others can be defined by the
+user or dynamically loaded from encoding files in a
+platform-independent manner.
+.SH DESCRIPTION
+.PP
+\fBTcl_GetEncoding\fR finds an encoding given its \fIname\fR. The name may
+refer to a builtin Tcl encoding, a user-defined encoding registered by
+calling \fBTcl_CreateEncoding\fR, or a dynamically-loadable encoding
+file. The return value is a token that represents the encoding and can be
+used in subsequent calls to procedures such as \fBTcl_GetEncodingName\fR,
+\fBTcl_FreeEncoding\fR, and \fBTcl_UtfToExternal\fR. If the name did not
+refer to any known or loadable encoding, NULL is returned and an error
+message is returned in \fIinterp\fR.
+.PP
+The encoding package maintains a database of all encodings currently in use.
+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.
+.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.
+.PP
+\fBTcl_ExternalToUtfDString\fR converts a source buffer \fIsrc\fR from the
+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
+represented in the target encoding, a default fallback character will be
+used. The return value is a pointer to the value stored in the DString.
+.PP
+\fBTcl_ExternalToUtf\fR converts a source buffer \fIsrc\fR from the specified
+\fIencoding\fR into UTF-8. Up to \fIsrcLen\fR bytes are converted from the
+source buffer and up to \fIdstLen\fR converted bytes are stored in \fIdst\fR.
+In all cases, \fI*srcReadPtr\fR is filled with the number of bytes that were
+successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR is filled with
+the corresponding number of bytes that were stored in \fIdst\fR. The return
+value is one of the following:
+.RS
+.IP \fBTCL_OK\fR 29
+All bytes of \fIsrc\fR were converted.
+.IP \fBTCL_CONVERT_NOSPACE\fR 29
+The destination buffer was not large enough for all of the converted data; as
+many characters as could fit were converted though.
+.IP \fBTCL_CONVERT_MULTIBYTE\fR 29
+The last fews bytes in the source buffer were the beginning of a multibyte
+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.
+.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 TCL_ENCODING_STOPONERROR was specified.
+.RE
+.LP
+\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
+information stored in \fIdstPtr\fR. When converting, if any of the
+characters in the source buffer cannot be represented in the target
+encoding, a default fallback character will be used. The return value is
+a pointer to the value stored in the DString.
+.PP
+\fBTcl_UtfToExternal\fR converts a source buffer \fIsrc\fR from UTF-8 into
+the specified \fIencoding\fR. Up to \fIsrcLen\fR bytes are converted from
+the source buffer and up to \fIdstLen\fR converted bytes are stored in
+\fIdst\fR. In all cases, \fI*srcReadPtr\fR is filled with the number of
+bytes that were successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR
+is filled with the corresponding number of bytes that were stored in
+\fIdst\fR. The return values are the same as the return values for
+\fBTcl_ExternalToUtf\fR.
+.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 Macintosh and Unix operating systems),
+all strings exchanged between Tcl and the operating system are "char"
+based. On Windows NT, some strings exchanged between Tcl and the
+operating system are "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 "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 "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 psuedo-code):
+.CS
+if (running NT) {
+ encoding <- Tcl_GetEncoding("unicode");
+ nativeBuffer <- Tcl_UtfToExternal(encoding, utfBuffer);
+ Tcl_FreeEncoding(encoding);
+} else {
+ nativeBuffer <- Tcl_UtfToExternal(NULL, utfBuffer);
+.CE
+\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.
+.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
+\fBTcl_GetEncodingName\fR is only guaranteed to persist until the
+\fIencoding\fR is deleted. The caller must not modify this string.
+.PP
+\fBTcl_SetSystemEncoding\fR sets the default encoding that should be used
+whenever the user passes a NULL value for the \fIencoding\fR argument to
+any of the other encoding functions. If \fIname\fR is NULL, the system
+encoding is reset to the default system encoding, \fBbinary\fR. If the
+name did not refer to any known or loadable encoding, TCL_ERROR is
+returned and an error message is left in \fIinterp\fR. Otherwise, this
+procedure increments the reference count of the new system encoding,
+decrements the reference count of the old system encoding, and returns
+TCL_OK.
+.PP
+\fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list
+consisting of the names of all the encodings that are currently defined
+or can be dynamically loaded, searching the encoding path specified by
+\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the
+dynamically-loadable encoding files contain valid data, but merely that they
+exist.
+.PP
+\fBTcl_CreateEncoding\fR defines a new encoding and registers the C
+procedures that are called back to convert between the encoding and
+UTF-8. Encodings created by \fBTcl_CreateEncoding\fR are thereafter
+visible in the database used by \fBTcl_GetEncoding\fR. Just as with the
+\fBTcl_GetEncoding\fR procedure, the return value is a token that
+represents the encoding and can be used in subsequent calls to other
+encoding functions. \fBTcl_CreateEncoding\fR returns an encoding with a
+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.
+.PP
+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
+.CS
+typedef struct Tcl_EncodingType {
+ CONST char *\fIencodingName\fR;
+ Tcl_EncodingConvertProc *\fItoUtfProc\fR;
+ Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
+ Tcl_EncodingFreeProc *\fIfreeProc\fR;
+ ClientData \fIclientData\fR;
+ int \fInullSize\fR;
+} Tcl_EncodingType;
+.CE
+.PP
+The \fIencodingName\fR provides a string name for the encoding, by
+which it can be referred in other procedures such as
+\fBTcl_GetEncoding\fR. The \fItoUtfProc\fR refers to a callback
+procedure to invoke to convert text from this encoding into UTF-8.
+The \fIfromUtfProc\fR refers to a callback procedure to invoke to
+convert text from UTF-8 into this encoding. The \fIfreeProc\fR refers
+to a callback procedure to invoke when this encoding is deleted. The
+\fIfreeProc\fR field may be NULL. The \fIclientData\fR contains an
+arbitrary one-word value passed to \fItoUtfProc\fR, \fIfromUtfProc\fR,
+and \fIfreeProc\fR whenever they are called. Typically, this is a
+pointer to a data structure containing encoding-specific information
+that can be used by the callback procedures. For instance, two very
+similar encodings such as \fBascii\fR and \fBmacRoman\fR may use the
+same callback procedure, but use different values of \fIclientData\fR
+to control its behavior. The \fInullSize\fR specifies the number of
+zero bytes that signify end-of-string in this encoding. It must be
+\fB1\fR (for single-byte or multi-byte encodings like ASCII or
+Shift-JIS) or \fB2\fR (for double-byte encodings like Unicode).
+Constant-sized encodings with 3 or more bytes per character (such as
+CNS11643) are not accepted.
+.PP
+The callback procedures \fItoUtfProc\fR and \fIfromUtfProc\fR should match the
+type \fBTcl_EncodingConvertProc\fR:
+.PP
+.CS
+typedef int Tcl_EncodingConvertProc(
+ ClientData \fIclientData\fR,
+ CONST char *\fIsrc\fR,
+ int \fIsrcLen\fR,
+ int \fIflags\fR,
+ Tcl_Encoding *\fIstatePtr\fR,
+ char *\fIdst\fR,
+ int \fIdstLen\fR,
+ int *\fIsrcReadPtr\fR,
+ int *\fIdstWrotePtr\fR,
+ int *\fIdstCharsPtr\fR);
+.CE
+.PP
+The \fItoUtfProc\fR and \fIfromUtfProc\fR procedures are called by the
+\fBTcl_ExternalToUtf\fR or \fBTcl_UtfToExternal\fR family of functions to
+perform the actual conversion. The \fIclientData\fR parameter to these
+procedures is the same as the \fIclientData\fR field specified to
+\fBTcl_CreateEncoding\fR when the encoding was created. The remaining
+arguments to the callback procedures are the same as the arguments,
+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,
+\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
+\fBTcl_EncodingFreeProc\fR:
+.CS
+typedef void Tcl_EncodingFreeProc(
+ ClientData \fIclientData\fR);
+.CE
+.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.
+.PP
+
+\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR
+access and set the directory to use when locating the default encoding
+files. If this value is not NULL, the \fBTclpInitLibraryPath\fR routine
+appends the path to the head of the search path, and uses this path as
+the first place to look into when trying to locate the encoding file.
+
+.SH "ENCODING FILES"
+Space would prohibit precompiling into Tcl every possible encoding
+algorithm, so many encodings are stored on disk as dynamically-loadable
+encoding files. This behavior also allows the user to create additional
+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.
+.PP
+Each dynamically-loadable encoding is represented as a text file. The
+initial line of the file, beginning with a ``#'' symbol, is a comment
+that provides a human-readable description of the file. The next line
+identifies the type of encoding file. It can be one of the following
+letters:
+.IP "[1] \fBS\fR"
+A single-byte encoding, where one character is always one byte long in the
+encoding. An example is \fBiso8859-1\fR, used by many European languages.
+.IP "[2] \fBD\fR"
+A double-byte encoding, where one character is always two bytes long in the
+encoding. An example is \fBbig5\fR, used for Chinese text.
+.IP "[3] \fBM\fR"
+A multi-byte encoding, where one character may be either one or two bytes long.
+Certain bytes are a lead bytes, indicating that another byte must follow
+and that together the two bytes represent one character. Other bytes are not
+lead bytes and represent themselves. An example is \fBshiftjis\fR, used by
+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.
+.PP
+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
+format as this example taken from the \fBshiftjis\fR encoding (this is not
+the complete file):
+.CS
+# Encoding file: shiftjis, multi-byte
+M
+003F 0 40
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D203E007F
+0080000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+81
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+300030013002FF0CFF0E30FBFF1AFF1BFF1FFF01309B309C00B4FF4000A8FF3E
+FFE3FF3F30FD30FE309D309E30034EDD30053006300730FC20152010FF0F005C
+301C2016FF5C2026202520182019201C201DFF08FF0930143015FF3BFF3DFF5B
+FF5D30083009300A300B300C300D300E300F30103011FF0B221200B100D70000
+00F7FF1D2260FF1CFF1E22662267221E22342642264000B0203220332103FFE5
+FF0400A200A3FF05FF03FF06FF0AFF2000A72606260525CB25CF25CE25C725C6
+25A125A025B325B225BD25BC203B301221922190219121933013000000000000
+000000000000000000000000000000002208220B2286228722822283222A2229
+000000000000000000000000000000002227222800AC21D221D4220022030000
+0000000000000000000000000000000000000000222022A52312220222072261
+2252226A226B221A223D221D2235222B222C0000000000000000000000000000
+212B2030266F266D266A2020202100B6000000000000000025EF000000000000
+.CE
+.PP
+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.
+.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
+the page number. Following it are 256 double-byte numbers, arranged as 16
+rows of 16 numbers. Given a character in the encoding, the high byte of
+that character is used to select which page, and the low byte of that
+character is used as an index to select one of the double-byte numbers in
+that page \- the value obtained being the corresponding Unicode character.
+By examination of the example above, one can see that the characters 0x7E
+and 0x8163 in \fBshiftjis\fR map to 203E and 2026 in Unicode, respectively.
+.PP
+Following the first page will be all the other pages, each in the same
+format as the first: one number identifying the page followed by 256
+double-byte Unicode characters. If a character in the encoding maps to the
+Unicode character 0000, it means that the character doesn't actually exist.
+If all characters on a page would map to 0000, that page can be omitted.
+.PP
+Case [4] is the escape-sequence encoding file. The lines in an this type of
+file are in the same format as this example taken from the \fBiso2022-jp\fR
+encoding:
+.CS
+.ta 1.5i
+# Encoding file: iso2022-jp, escape-driven
+E
+init {}
+final {}
+iso8859-1 \\x1b(B
+jis0201 \\x1b(J
+jis0208 \\x1b$@
+jis0208 \\x1b$B
+jis0212 \\x1b$(D
+gb2312 \\x1b$A
+ksc5601 \\x1b$(C
+.CE
+.PP
+In the file, the first column represents an option and the second column
+is the associated value. \fBinit\fR is a string to emit or expect before
+the first character is converted, while \fBfinal\fR is a string to emit
+or expect after the last character. All other options are names of
+table-based encodings; the associated value is the escape-sequence that
+marks that encoding. Tcl syntax is used for the values; in the above
+example, for instance, ``\fB{}\fR'' represents the empty string and
+``\fB\\x1b\fR'' represents character 27.
+.PP
+When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not
+been loaded, it attempts to load an encoding file called \fIname\fB.enc\fR
+from the \fBencoding\fR subdirectory of each directory specified in the
+library path \fB$tcl_libPath\fR. If the encoding file exists, but is
+malformed, an error message will be left in \fIinterp\fR.
+.SH KEYWORDS
+utf, encoding, convert
+
+
+
diff --git a/tcl/doc/Eval.3 b/tcl/doc/Eval.3
index 6a374bb9fdc..080d0ae7be6 100644
--- a/tcl/doc/Eval.3
+++ b/tcl/doc/Eval.3
@@ -8,85 +8,170 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_Eval 3 7.0 Tcl "Tcl Library Procedures"
+.TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_Eval, Tcl_VarEval, Tcl_EvalFile, Tcl_GlobalEval \- execute Tcl commands
+Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
+.VS
int
-\fBTcl_Eval\fR(\fIinterp, cmd\fR)
+\fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR)
.sp
int
-\fBTcl_VarEval\fR(\fIinterp, string, string, ... \fB(char *) NULL\fR)
+\fBTcl_EvalFile\fR(\fIinterp, fileName\fR)
.sp
int
-\fBTcl_EvalFile\fR(\fIinterp, fileName\fR)
+\fBTcl_EvalObjv\fR(\fIinterp, objc, objv, flags\fR)
+.sp
+int
+\fBTcl_Eval\fR(\fIinterp, script\fR)
+.sp
+int
+\fBTcl_EvalEx\fR(\fIinterp, script, numBytes, flags\fR)
.sp
int
-\fBTcl_GlobalEval\fR(\fIinterp, cmd\fR)
+\fBTcl_GlobalEval\fR(\fIinterp, script\fR)
+.sp
+int
+\fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr, flags\fR)
+.sp
+int
+\fBTcl_VarEval\fR(\fIinterp, string, string, ... \fB(char *) NULL\fR)
+.sp
+int
+\fBTcl_VarEvalVA\fR(\fIinterp, argList\fR)
.SH ARGUMENTS
.AS Tcl_Interp **termPtr;
.AP Tcl_Interp *interp in
-Interpreter in which to execute the command.
-A string result will be stored in \fIinterp->result\fR.
-.AP char *cmd in
-Command (or sequence of commands) to execute. Must be in writable
-memory (\fBTcl_Eval\fR makes temporary modifications to the command).
-.AP char *string in
-String forming part of Tcl command.
+Interpreter in which to execute the script. The interpreter's result is
+modified to hold the result or error message from the script.
+.AP Tcl_Obj *objPtr in
+A Tcl object containing the script to execute.
+.AP int flags in
+ORed combination of flag bits that specify additional options.
+\fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported.
.AP char *fileName in
-Name of file containing Tcl command string.
+Name of a file containing a Tcl script.
+.AP int objc in
+The number of objects in the array pointed to by \fIobjPtr\fR;
+this is also the number of words in the command.
+.AP Tcl_Obj **objv in
+Points to an array of pointers to objects; each object holds the
+value of a single word in the command to execute.
+.AP int numBytes in
+The number of bytes in \fIscript\fR, not including any
+null terminating character. If \-1, then all characters up to the
+first null byte are used.
+.AP char *script in
+Points to first byte of script to execute. This script must be in
+writable memory: temporary modifications are made to it during
+parsing.
+.AP char *string in
+String forming part of a Tcl script.
+.AP va_list argList in
+An argument list which must have been initialised using
+\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
.BE
.SH DESCRIPTION
.PP
-All four of these procedures execute Tcl commands.
-\fBTcl_Eval\fR is the core procedure and is used by all the others.
-It executes the commands in the script held by \fIcmd\fR
-until either an error occurs or it reaches the end of the script.
+The procedures described here are invoked to execute Tcl scripts in
+various forms.
+\fBTcl_EvalObjEx\fR is the core procedure and is used by many of the others.
+It executes the commands in the script stored in \fIobjPtr\fR
+until either an error occurs or the end of the script is reached.
+If this is the first time \fIobjPtr\fR has been executed,
+its commands are compiled into bytecode instructions
+which are then executed. The
+bytecodes are saved in \fIobjPtr\fR so that the compilation step
+can be skipped if the object is evaluated again in the future.
+.PP
+The return value from \fBTcl_EvalObjEx\fR (and all the other procedures
+described here) 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.
+In addition, a result value or error message is left in \fIinterp\fR's
+result; it can be retrieved using \fBTcl_GetObjResult\fR.
+.PP
+\fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates
+its contents as a Tcl script. It returns the same information as
+\fBTcl_EvalObjEx\fR.
+If the file couldn't be read then a Tcl error is returned to describe
+why the file couldn't be read.
+.PP
+\fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a
+script. The \fIobjc\fR and \fIobjv\fR arguments contain the values
+of the words for the Tcl command, one word in each object in
+\fIobjv\fR. \fBTcl_EvalObjv\fR evaluates the command and returns
+a completion code and result just like \fBTcl_EvalObjEx\fR.
+.PP
+\fBTcl_Eval\fR is similar to \fBTcl_EvalObjEx\fR except that the script to
+be executed is supplied as a string instead of an object and no compilation
+occurs. 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_EvalObjEx\fR. Note: for backward compatibility with versions before
+Tcl 8.0, \fBTcl_Eval\fR copies the object result in \fIinterp\fR to
+\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
+This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
+doesn't do the copy.
.PP
-Note that \fBTcl_Eval\fR and \fBTcl_GlobalEval\fR
-have been largely replaced by the
-object-based procedures \fBTcl_EvalObj\fR and \fBTcl_GlobalEvalObj\fR.
-Those object-based procedures evaluate a script held in a Tcl object
-instead of a string.
-The object argument can retain the bytecode instructions for the script
-and so avoid reparsing the script each time it is executed.
-\fBTcl_Eval\fR is implemented using \fBTcl_EvalObj\fR
-but is slower because it must reparse the script each time
-since there is no object to retain the bytecode instructions.
+\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
+additional arguments \fInumBytes\fR and \fIflags\fR. For the
+efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred
+over \fBTcl_Eval\fR.
.PP
-The return value from \fBTcl_Eval\fR is one of the Tcl return codes
-\fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or
-\fBTCL_CONTINUE\fR, and \fIinterp->result\fR will point to
-a string with additional information (a result value or error message).
-If an error occurs during compilation, this return information
-describes the error.
-Otherwise, this return information corresponds to the last command
-executed from \fIcmd\fR.
+\fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures
+that are now deprecated. They are similar to \fBTcl_EvalEx\fR and
+\fBTcl_EvalObjEx\fR except that the script is evaluated in the global
+namespace and its variable context consists of global variables only
+(it ignores any Tcl procedures that are active). These functions are
+equivalent to using the \fBTCL_EVAL_GLOBAL\fR flag (see below).
.PP
\fBTcl_VarEval\fR takes any number of string arguments
of any length, concatenates them into a single string,
then calls \fBTcl_Eval\fR to execute that string as a Tcl command.
It returns the result of the command and also modifies
-\fIinterp->result\fR in the usual fashion for Tcl commands.
+\fIinterp->result\fR in the same way as \fBTcl_Eval\fR.
The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
-of arguments.
+of arguments. \fBTcl_VarEval\fR is now deprecated.
.PP
-\fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates
-its contents as a Tcl command by calling \fBTcl_Eval\fR. It returns
-a standard Tcl result that reflects the result of evaluating the file.
-If the file couldn't be read then a Tcl error is returned to describe
-why the file couldn't be read.
+\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that
+instead of taking a variable number of arguments it takes an argument
+list. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated.
+
+.SH "FLAG BITS"
+Any ORed combination of the following values may be used for the
+\fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR:
+.TP 23
+\fBTCL_EVAL_DIRECT\fR
+This flag is only used by \fBTcl_EvalObjEx\fR; it is ignored by
+other procedures. If this flag bit is set, the script is not
+compiled to bytecodes; instead it is executed directly
+as is done by \fBTcl_EvalEx\fR. The
+\fBTCL_EVAL_DIRECT\fR flag is useful in situations where the
+contents of an object are going to change immediately, so the
+bytecodes won't be reused in a future execution. In this case,
+it's faster to execute the script directly.
+.TP 23
+\fBTCL_EVAL_GLOBAL\fR
+If this flag is set, the script is processed at global level. This
+means that it is evaluated in the global namespace and its variable
+context consists of global variables only (it ignores any Tcl
+procedures at are active).
+
+.SH "MISCELLANEOUS DETAILS"
.PP
During the processing of a Tcl command it is legal to make nested
calls to evaluate other commands (this is how procedures and
some control structures are implemented).
If a code other than \fBTCL_OK\fR is returned
-from a nested \fBTcl_Eval\fR invocation,
+from a nested \fBTcl_EvalObjEx\fR invocation,
then the caller should normally return immediately,
passing that same return code back to its caller,
and so on until the top-level application is reached.
@@ -94,21 +179,19 @@ A few commands, like \fBfor\fR, will check for certain
return codes, like \fBTCL_BREAK\fR and \fBTCL_CONTINUE\fR, and process them
specially without returning.
.PP
-\fBTcl_Eval\fR keeps track of how many nested \fBTcl_Eval\fR
+\fBTcl_EvalObjEx\fR keeps track of how many nested \fBTcl_EvalObjEx\fR
invocations are in progress for \fIinterp\fR.
If a code of \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR is
-about to be returned from the topmost \fBTcl_Eval\fR
+about to be returned from the topmost \fBTcl_EvalObjEx\fR
invocation for \fIinterp\fR,
it converts the return code to \fBTCL_ERROR\fR
-and sets \fIinterp->result\fR
-to point to an error message indicating that
+and sets \fIinterp\fR's result to an error message indicating that
the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was
invoked in an inappropriate place.
This means that top-level applications should never see a return code
-from \fBTcl_Eval\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.
-
-.SH "SEE ALSO"
-Tcl_EvalObj, Tcl_GlobalEvalObj
+from \fBTcl_EvalObjEx\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.
+.VE
.SH KEYWORDS
-command, execute, file, global, object, object result, variable
+execute, file, global, object, result, script
+
diff --git a/tcl/doc/Exit.3 b/tcl/doc/Exit.3
index 34cf336347b..3cb74c9f6a8 100644
--- a/tcl/doc/Exit.3
+++ b/tcl/doc/Exit.3
@@ -7,10 +7,10 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_Exit 3 7.7 Tcl "Tcl Library Procedures"
+.TH Tcl_Exit 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler \- end the application (and invoke exit handlers)
+Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler, Tcl_ExitThread, Tcl_FinalizeThread, Tcl_CreateThreadExitHandler, Tcl_DeleteThreadExitHandler \- end the application or thread (and invoke exit handlers)
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -22,10 +22,19 @@ Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler \- end the
\fBTcl_CreateExitHandler\fR(\fIproc, clientData\fR)
.sp
\fBTcl_DeleteExitHandler\fR(\fIproc, clientData\fR)
+.sp
+\fBTcl_ExitThread\fR(\fIstatus\fR)
+.sp
+\fBTcl_FinalizeThread\fR()
+.sp
+\fBTcl_CreateThreadExitHandler\fR(\fIproc, clientData\fR)
+.sp
+\fBTcl_DeleteThreadExitHandler\fR(\fIproc, clientData\fR)
.SH ARGUMENTS
.AS Tcl_ExitProc clientData
.AP int status in
-Provides information about why application exited. Exact meaning may
+Provides information about why the application or thread exited.
+Exact meaning may
be platform-specific. 0 usually means a normal exit, any nonzero value
usually means that an error occurred.
.AP Tcl_ExitProc *proc in
@@ -51,7 +60,6 @@ otherwise causes the application to terminate without calling
\fBTcl_Exit\fR internally invokes the \fBexit\fR system call, thus it never
returns control to its caller.
.PP
-.VS
\fBTcl_Finalize\fR is similar to \fBTcl_Exit\fR except that it does not
exit from the current process.
It is useful for cleaning up when a process is finished using \fBTcl\fR but
@@ -64,10 +72,20 @@ However, to ensure portability, your code should always invoke
\fBTcl_Finalize\fR when \fBTcl\fR is being unloaded, to ensure that the
code will work on all platforms. \fBTcl_Finalize\fR can be safely called
more than once.
+.PP
+.VS
+\fBTcl_ExitThread\fR is used to terminate the current thread and invoke
+per-thread exit handlers. This finalization is done by
+\fBTcl_FinalizeThread\fR, which you can call if you just want to clean
+up per-thread state and invoke the thread exit handlers.
+\fBTcl_Finalize\fR calls \fBTcl_FinalizeThread\fR for the current
+thread automatically.
.VE
.PP
\fBTcl_CreateExitHandler\fR arranges for \fIproc\fR to be invoked
by \fBTcl_Finalize\fR and \fBTcl_Exit\fR.
+\fBTcl_CreateThreadExitHandler\fR arranges for \fIproc\fR to be invoked
+by \fBTcl_FinalizeThread\fR and \fBTcl_ExitThread\fR.
This provides a hook for cleanup operations such as flushing buffers
and freeing global memory.
\fIProc\fR should match the type \fBTcl_ExitProc\fR:
@@ -76,16 +94,18 @@ typedef void Tcl_ExitProc(ClientData \fIclientData\fR);
.CE
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
-\fBTcl_CreateExitHandler\fR when the callback
+\fBTcl_CreateExitHandler\fR or \fBTcl_CreateThreadExitHandler\fR when
+the callback
was created. Typically, \fIclientData\fR points to a data
structure containing application-specific information about
what to do in \fIproc\fR.
.PP
-\fBTcl_DeleteExitHandler\fR may be called to delete a
+\fBTcl_DeleteExitHandler\fR and \fBTcl_DeleteThreadExitHandler\fR may be
+called to delete a
previously-created exit handler. It removes the handler
indicated by \fIproc\fR and \fIclientData\fR so that no call
to \fIproc\fR will be made. If no such handler exists then
-\fBTcl_DeleteExitHandler\fR does nothing.
+\fBTcl_DeleteExitHandler\fR or \fBTcl_DeleteThreadExitHandler\fR does nothing.
.PP
.VS
.PP
@@ -98,6 +118,15 @@ 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.
.VE
+.VS
+.PP
+\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
+handlers will vanish into the bitbucket.
+.VE
.SH KEYWORDS
-callback, cleanup, dynamic loading, end application, exit, unloading
+callback, cleanup, dynamic loading, end application, exit, unloading, thread
+
diff --git a/tcl/doc/ExprLong.3 b/tcl/doc/ExprLong.3
index 903017488c2..8b4603736aa 100644
--- a/tcl/doc/ExprLong.3
+++ b/tcl/doc/ExprLong.3
@@ -63,15 +63,13 @@ that is more efficient to execute.
The \fIinterp\fR argument refers to an interpreter used to
evaluate the expression (e.g. for variables and nested Tcl
commands) and to return error information.
-\fIinterp->result\fR is assumed to be initialized
-in the standard fashion when they are invoked.
.PP
For all of these procedures the return value is a standard
Tcl result: \fBTCL_OK\fR means the expression was successfully
evaluated, and \fBTCL_ERROR\fR means that an error occurred while
evaluating the expression.
If \fBTCL_ERROR\fR is returned then
-\fIinterp->result\fR will hold a message describing the error.
+the interpreter's result will hold a message describing the error.
If an error occurs while executing a Tcl command embedded in
the expression then that error will be returned.
.PP
@@ -99,7 +97,7 @@ it must be one of the values accepted by \fBTcl_GetBoolean\fR
such as ``yes'' or ``no'', or else an error occurs.
.PP
\fBTcl_ExprString\fR returns the value of the expression as a
-string stored in \fIinterp->result\fR.
+string stored in the interpreter's result.
If the expression's actual value is an integer
then \fBTcl_ExprString\fR converts it to a string using \fBsprintf\fR
with a ``%d'' converter.
@@ -112,3 +110,4 @@ Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj
.SH KEYWORDS
boolean, double, evaluate, expression, integer, object, string
+
diff --git a/tcl/doc/FindExec.3 b/tcl/doc/FindExec.3
index a79c6f33b72..33f123b2aa2 100644
--- a/tcl/doc/FindExec.3
+++ b/tcl/doc/FindExec.3
@@ -7,7 +7,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_FindExecutable 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application
@@ -15,7 +15,7 @@ Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of th
.nf
\fB#include <tcl.h>\fR
.sp
-char *
+void
\fBTcl_FindExecutable\fR(\fIargv0\fR)
.sp
CONST char *
@@ -54,3 +54,4 @@ computed or unknown.
.SH KEYWORDS
binary, executable file
+
diff --git a/tcl/doc/GetCwd.3 b/tcl/doc/GetCwd.3
new file mode 100644
index 00000000000..eb8278f5269
--- /dev/null
+++ b/tcl/doc/GetCwd.3
@@ -0,0 +1,54 @@
+'\"
+'\" Copyright (c) 1998-1999 Scriptics Corportation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_GetCwd 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetCwd, Tcl_Chdir \- manipulate the current working directory
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_GetCwd\fR(\fIinterp\fR, \fIbufferPtr\fR)
+.sp
+int
+\fBTcl_Chdir\fR(\fIpath\fR)
+.SH ARGUMENTS
+.AS Tcl_DString *bufferPtr
+.AP Tcl_Interp *interp in
+Interpreter in which to report an error, if any.
+.AP Tcl_DString *bufferPtr in/out
+This dynamic string is used to store the current working directory.
+At the time of the call it should be uninitialized or free. The
+caller must eventually call \fBTcl_DStringFree\fR to free up
+anything stored here.
+.AP char *path in
+File path in UTF\-8 format.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures may be used to manipulate the current working
+directory for the application. They provide C\-level access to
+the same functionality as the Tcl \fBpwd\fR command.
+.PP
+\fBTcl_GetCwd\fR returns a pointer to a string specifying the current
+directory, or NULL if the current directory could not be determined.
+If NULL is returned, an error message is left in the interp's result.
+Storage for the result string is allocated in bufferPtr; the caller
+must call \fBTcl_DStringFree()\fR when the result is no longer needed.
+The format of the path is UTF\-8.
+.PP
+\fBTcl_Chdir\fR changes the applications current working directory to
+the value specified in \fIpath\fR. The format of the passed in string
+must be UTF\-8. The function returns -1 on error or 0 on success.
+
+.SH KEYWORDS
+pwd
diff --git a/tcl/doc/GetHostName.3 b/tcl/doc/GetHostName.3
new file mode 100644
index 00000000000..576c867196c
--- /dev/null
+++ b/tcl/doc/GetHostName.3
@@ -0,0 +1,29 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetHostName \- get the name of the local host
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_GetHostName\fR()
+
+.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
+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.
+.PP
+.SH KEYWORDS
+hostname
+
diff --git a/tcl/doc/GetIndex.3 b/tcl/doc/GetIndex.3
index 53ac14baf47..b138cda6dc3 100644
--- a/tcl/doc/GetIndex.3
+++ b/tcl/doc/GetIndex.3
@@ -7,16 +7,23 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_GetIndexFromObj 3 8.0 Tcl "Tcl Library Procedures"
+.TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_GetIndexFromObj \- lookup string in table of keywords
+Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct \- lookup string in table of keywords
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
-\fBTcl_GetIndexFromObj\fR(\fIinterp, objPtr, tablePtr, msg, flags, indexPtr\fR)
+\fBTcl_GetIndexFromObj\fR(\fIinterp, objPtr, tablePtr, msg, flags,
+indexPtr\fR)
+.VS
+.sp
+int
+\fBTcl_GetIndexFromObjStruct\fR(\fIinterp, objPtr, tablePtr, offset,
+msg, flags, indexPtr\fR)
+.VE
.SH ARGUMENTS
.AS Tcl_Interp **tablePtr
.AP Tcl_Interp *interp in
@@ -29,6 +36,11 @@ table entry.
.AP char **tablePtr in
An array of null-terminated strings. The end of the array is marked
by a NULL string pointer.
+.VS
+.AP int offset in
+The offset to add to tablePtr to get to the next string in the
+list. The end of the array is marked by a NULL string pointer.
+.VE
.AP char *msg in
Null-terminated string describing what is being looked up, such as
\fBoption\fR. This string is included in error messages.
@@ -68,10 +80,24 @@ is invoked again with the same \fIobjPtr\fR and \fItablePtr\fR
arguments (e.g. during a reinvocation of a Tcl command), it returns
the matching index immediately without having to redo the lookup
operation. Note: \fBTcl_GetIndexFromObj\fR assumes that the entries
-in \fItablePtr\fR are static: they must not change between invocations.
+in \fItablePtr\fR are static: they must not change between
+invocations. If the value of \fIobjPtr\fR is the empty string,
+\fBTcl_GetIndexFromObj\fR will treat it as a non-matching value
+and return TCL_ERROR.
+.VS
+.PP
+\fBTcl_GetIndexFromObjStruct\fR works just like
+\fBTcl_GetIndexFromObj\fR, except that instead of treating
+\fItablePtr\fR as an array of string pointers, it treats it as the
+first in a series of string ptrs that are spaced apart by \fIoffset\fR
+bytes. This is particularly useful when processing things like
+\fBTk_ConfigurationSpec\fR, whose string keys are in the same place in
+each of several array elements.
+.VE
.SH "SEE ALSO"
Tcl_WrongNumArgs
.SH KEYWORDS
index, object, table lookup
+
diff --git a/tcl/doc/GetInt.3 b/tcl/doc/GetInt.3
index cceca7c080d..221ba070657 100644
--- a/tcl/doc/GetInt.3
+++ b/tcl/doc/GetInt.3
@@ -49,7 +49,7 @@ the converted value at the location indicated by the procedure's
third argument. If all goes well, each of the procedures returns
TCL_OK. If \fIstring\fR doesn't have the proper syntax for the
desired type then TCL_ERROR is returned, an error message is left
-in \fIinterp->result\fR, and nothing is stored at *\fIintPtr\fR
+in the interpreter's result, and nothing is stored at *\fIintPtr\fR
or *\fIdoublePtr\fR or *\fIboolPtr\fR.
.PP
\fBTcl_GetInt\fR expects \fIstring\fR to consist of a collection
@@ -79,3 +79,4 @@ are also acceptable.
.SH KEYWORDS
boolean, conversion, double, floating-point, integer
+
diff --git a/tcl/doc/GetOpnFl.3 b/tcl/doc/GetOpnFl.3
index d8366d06aa0..8d9e0d7b17f 100644
--- a/tcl/doc/GetOpnFl.3
+++ b/tcl/doc/GetOpnFl.3
@@ -49,7 +49,7 @@ and writing.
If an error occurs in \fBTcl_GetOpenFile\fR (e.g. \fIstring\fR didn't
make any sense or \fIcheckUsage\fR was set and the file wasn't opened
for the access specified by \fIwrite\fR) then TCL_ERROR is returned
-and \fIinterp->result\fR will contain an error message.
+and the interpreter's result will contain an error message.
In the current implementation \fIcheckUsage\fR is ignored and consistency
checks are always performed.
.VS
@@ -59,3 +59,4 @@ Note that this interface is only supported on the Unix platform.
.SH KEYWORDS
channel, file handle, permissions, pipeline, read, write
+
diff --git a/tcl/doc/GetVersion.3 b/tcl/doc/GetVersion.3
new file mode 100644
index 00000000000..5abec5b6aae
--- /dev/null
+++ b/tcl/doc/GetVersion.3
@@ -0,0 +1,49 @@
+'\"
+'\" Copyright (c) 1999 Scriptics Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_GetVersion 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetVersion \- get the version of the library at runtime
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_GetVersion\fR(\fImajor, minor, patchLevel, type\fR)
+.SH ARGUMENTS
+.AP int *major out
+Major version number of the Tcl library.
+.AP int *minor out
+Minor version number of the Tcl library.
+.AP int *patchLevel out
+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
+\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
+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
+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
+If may pass a 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.
+
+.SH KEYWORDS
+version, patchlevel, major, minor, alpha, beta, release
+
diff --git a/tcl/doc/Hash.3 b/tcl/doc/Hash.3
index 13de0b9fcc2..e3fb971989d 100644
--- a/tcl/doc/Hash.3
+++ b/tcl/doc/Hash.3
@@ -193,7 +193,7 @@ overall information about a hash table, such as the number of
entries it contains, the number of buckets in its hash array,
and the utilization of the buckets.
It is the caller's responsibility to free the result string
-by passing it to \fBfree\fR.
+by passing it to \fBckfree\fR.
.PP
The header file \fBtcl.h\fR defines the actual data structures
used to implement hash tables.
diff --git a/tcl/doc/Init.3 b/tcl/doc/Init.3
new file mode 100644
index 00000000000..587a79614a1
--- /dev/null
+++ b/tcl/doc/Init.3
@@ -0,0 +1,37 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Init \- find and source initialization script
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_Init\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AP Tcl_Interp *interp in
+Interpreter to initialize.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_Init\fR is a helper procedure that finds and \fBsource\fR's the
+\fBinit.tcl\fR script, which should exist somewhere on the Tcl library
+path. On Macintosh systems, it additionally checks for an \fBInit\fR
+resource and sources the contents of that resource if \fBinit.tcl\fR
+cannot be found.
+.PP
+\fBTcl_Init\fR is typically called from \fBTcl_AppInit\fR procedures.
+
+.SH "SEE ALSO"
+Tcl_AppInit, Tcl_Main
+
+.SH KEYWORDS
+application, initialization, interpreter
diff --git a/tcl/doc/InitStubs.3 b/tcl/doc/InitStubs.3
new file mode 100644
index 00000000000..aa12b8e6589
--- /dev/null
+++ b/tcl/doc/InitStubs.3
@@ -0,0 +1,91 @@
+'\"
+'\" Copyright (c) 1999 Scriptics Corportation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_InitStubs 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_InitStubs \- initialize the Tcl stubs mechanism
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_InitStubs\fR(\fIinterp, version, exact\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp in
+.AP Tcl_Interp *interp in
+Tcl interpreter handle.
+.AP char *version in
+A version string consisting of one or more decimal numbers
+separated by dots.
+.AP int exact in
+Non-zero means that only the particular version specified by
+\fIversion\fR is acceptable.
+Zero means that versions newer than \fIversion\fR are also
+acceptable as long as they have the same major version number
+as \fIversion\fR.
+.BE
+.SH INTRODUCTION
+.PP
+The Tcl stubs mechanism defines a way to dynamically bind
+extensions to a particular Tcl implementation at run time.
+This provides two significant benefits to Tcl users:
+.IP 1) 5
+Extensions that use the stubs mechanism can be loaded into
+multiple versions of Tcl without being recompiled or
+relinked.
+.IP 2) 5
+Extensions that use the stubs mechanism can be dynamically
+loaded into statically-linked Tcl applications.
+.PP
+The stubs mechanism accomplishes this by exporting function tables
+that define an interface to the Tcl API. The extension then accesses
+the Tcl API through offsets into the function table, so there are no
+direct references to any of the Tcl library's symbols. This
+redirection is transparent to the extension, so an extension writer
+can continue to use all public Tcl functions as documented.
+.PP
+The stubs mechanism requires no changes to applications incorporating
+Tcl interpreters. Only developers creating C-based Tcl extensions
+need to take steps to use the stubs mechanism with their extensions.
+.PP
+Enabling the stubs mechanism for an extension requires the following
+steps:
+.IP 1) 5
+Call \fBTcl_InitStubs\fR in the extension before calling any other
+Tcl functions.
+.IP 2) 5
+Define the USE_TCL_STUBS symbol. Typically, you would include the
+-DUSE_TCL_STUBS flag when compiling the extension.
+.IP 3) 5
+Link the extension with the Tcl stubs library instead of the standard
+Tcl library. On Unix platforms, the library name is
+\fIlibtclstub8.1.a\fR; on Windows platforms, the library name is
+\fItclstub81.lib\fR.
+.PP
+If the extension also requires the Tk API, it must also call
+\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
+with the Tk stubs libraries. See the \fBTk_InitStubs\fR page for
+more information.
+.SH DESCRIPTION
+\fBTcl_InitStubs\fR attempts to initialize the stub table pointers
+and ensure that the correct version of Tcl is loaded. In addition
+to an interpreter handle, it accepts as arguments a version number
+and a Boolean flag indicating whether the extension requires
+an exact version match or not. If \fIexact\fR is 0, then the
+extension is indicating that newer versions of Tcl are acceptable
+as long as they have the same major version number as \fIversion\fR;
+non-zero means that only the specified \fIversion\fR is acceptable.
+\fBTcl_InitStubs\fR returns a string containing the actual version
+of Tcl satisfying the request, or NULL if the Tcl version is not
+acceptable, does not support stubs, or any other error condition occurred.
+.SH "SEE ALSO"
+\fBTk_InitStubs\fR
+.SH KEYWORDS
+stubs
diff --git a/tcl/doc/Interp.3 b/tcl/doc/Interp.3
index d608f7f5943..b3d5f7b7330 100644
--- a/tcl/doc/Interp.3
+++ b/tcl/doc/Interp.3
@@ -107,7 +107,8 @@ returning an error) will generally assume that the result
has been initialized when the procedure is called.
If such a procedure is to be called after the result has been
changed, then \fBTcl_ResetResult\fR should be called first to
-reset the result to its initialized state.
+reset the result to its initialized state. The direct use of
+\fIinterp->result\fR is strongly deprecated (see \fBTcl_SetResult\fR).
.PP
The \fIerrorLine\fR
field is valid only after \fBTcl_Eval\fR returns
@@ -123,3 +124,4 @@ occurred.
.SH KEYWORDS
free, initialized, interpreter, malloc, result
+
diff --git a/tcl/doc/LinkVar.3 b/tcl/doc/LinkVar.3
index b5c25dc5c53..abc031ab639 100644
--- a/tcl/doc/LinkVar.3
+++ b/tcl/doc/LinkVar.3
@@ -48,7 +48,7 @@ be returned, and whenever the Tcl variable is written the C
variable will be updated to have the same value.
\fBTcl_LinkVar\fR normally returns TCL_OK; if an error occurs
while setting up the link (e.g. because \fIvarName\fR is the
-name of array) then TCL_ERROR is returned and \fIinterp->result\fR
+name of array) then TCL_ERROR is returned and the interpreter's result
contains an error message.
.PP
The \fItype\fR argument specifies the type of the C variable,
@@ -113,3 +113,4 @@ variable are invoked.
.SH KEYWORDS
boolean, integer, link, read-only, real, string, traces, variable
+
diff --git a/tcl/doc/ListObj.3 b/tcl/doc/ListObj.3
index 7ae02ae82a5..9fec124243c 100644
--- a/tcl/doc/ListObj.3
+++ b/tcl/doc/ListObj.3
@@ -74,9 +74,7 @@ and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
the number of Tcl objects to insert into \fIobjPtr\fR.
.VS
-.TP
-Tcl_Obj *CONST \fIobjv\fR[] (in)
-.
+.AP Tcl_Obj "*CONST\ objv[]" in
An array of pointers to objects.
\fBTcl_NewListObj\fR will insert these objects into a new list object
and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
@@ -151,16 +149,16 @@ of the elements in \fIobjc\fR since the list object now refers to them.
The new list object returned by \fBTcl_NewListObj\fR
has reference count zero.
.PP
-\fBTcl_ListObjGetElements\fR returns a count and
-a pointer to an array of the elements in a list object.
-It returns the count by storing it in the address \fIobjcPtr\fR.
-Similarly, it returns the array pointer by storing it
-in the address \fIobjvPtr\fR.
-If \fIlistPtr\fR is not already a list object,
-\fBTcl_ListObjGetElements\fR will attempt to convert it to one;
-if the conversion fails, it returns \fBTCL_ERROR\fR
-and leaves an error message in the interpreter's result object
-if \fIinterp\fR is not NULL.
+\fBTcl_ListObjGetElements\fR returns a count and a pointer to an array of
+the elements in a list object. It returns the count by storing it in the
+address \fIobjcPtr\fR. Similarly, it returns the array pointer by storing
+it in the address \fIobjvPtr\fR.
+The memory pointed to is managed by Tcl and should not be freed by the
+caller.
+If \fIlistPtr\fR is not already a list object, \fBTcl_ListObjGetElements\fR
+will attempt to convert it to one; if the conversion fails, it returns
+\fBTCL_ERROR\fR and leaves an error message in the interpreter's result
+object if \fIinterp\fR is not NULL.
Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer.
.PP
\fBTcl_ListObjLength\fR returns the number of elements in the list object
diff --git a/tcl/doc/Notifier.3 b/tcl/doc/Notifier.3
index 29b94e03a93..58a29db5903 100644
--- a/tcl/doc/Notifier.3
+++ b/tcl/doc/Notifier.3
@@ -1,4 +1,5 @@
'\"
+'\" Copyright (c) 1998-1999 Scriptics Corporation
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
@@ -7,30 +8,52 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Notifier 3 8.0 Tcl "Tcl Library Procedures"
+.TH Notifier 3 8.1 Tcl "Tcl Library Procedures"
.BS
-.VS
.SH NAME
-Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_DeleteEvents, Tcl_WaitForEvent, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode \- the event queue and notifier interfaces
-
+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 \- the event queue and notifier interfaces
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
-\fBTcl_CreateEventSource\fR(\fIsetupProc, checkProc, clientData\fB)\fR
+void
+\fBTcl_CreateEventSource\fR(\fIsetupProc, checkProc, clientData\fR)
.sp
-\fBTcl_DeleteEventSource\fR(\fIsetupProc, checkProc, clientData\fB)\fR
+void
+\fBTcl_DeleteEventSource\fR(\fIsetupProc, checkProc, clientData\fR)
.sp
-\fBTcl_SetMaxBlockTime\fR(\fItimePtr\fB)\fR
+void
+\fBTcl_SetMaxBlockTime\fR(\fItimePtr\fR)
.sp
+void
\fBTcl_QueueEvent\fR(\fIevPtr, position\fR)
-.VS
+.VS 8.1
+.sp
+void
+\fBTcl_ThreadQueueEvent\fR(\fIthreadId, evPtr, position\fR)
+.sp
+void
+\fBTcl_ThreadAlert\fR(\fIthreadId, clientData\fR)
.sp
+Tcl_ThreadId
+\fBTcl_GetCurrentThread\fR()
+.sp
+void
\fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR)
.sp
+ClientData
+\fBTcl_InitNotifier\fR()
+.sp
+void
+\fBTcl_FinalizeNotifier\fR(\fIclientData\fR)
+.sp
int
\fBTcl_WaitForEvent\fR(\fItimePtr\fR)
.sp
+void
+\fBTcl_AlertNotifier\fR(\fIclientData\fR)
+.sp
+void
\fBTcl_SetTimer\fR(\fItimePtr\fR)
.sp
int
@@ -48,7 +71,6 @@ int
.SH ARGUMENTS
.AS Tcl_EventDeleteProc milliseconds
-.AS Tcl_EventSetupProc *setupProc
.AP Tcl_EventSetupProc *setupProc in
Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR.
.AP Tcl_EventCheckProc *checkProc in
@@ -70,12 +92,14 @@ have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR.
.AP Tcl_QueuePosition position in
Where to add the new event in the queue: \fBTCL_QUEUE_TAIL\fR,
\fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR.
+.AP Tcl_ThreadId threadId in
+A unique identifier for a thread.
+.AP Tcl_EventDeleteProc *deleteProc in
+Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.
.AP int flags in
What types of events to service. These flags are the same as those
passed to \fBTcl_DoOneEvent\fR.
-.AP Tcl_EventDeleteProc *deleteProc in
-Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.
-.VS
+.VS 8.1
.AP int mode in
Inidicates whether events should be serviced by \fBTcl_ServiceAll\fR.
Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
@@ -84,13 +108,11 @@ Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
.SH INTRODUCTION
.PP
-.VS
The interfaces described here are used to customize the Tcl event
loop. The two most common customizations are to add new sources of
events and to merge Tcl's event loop with some other event loop, such
as one provided by an application in which Tcl is embedded. Each of
these tasks is described in a separate section below.
-.VE
.PP
The procedures in this manual entry are the building blocks out of which
the Tcl event notifier is constructed. The event notifier is the lowest
@@ -108,18 +130,24 @@ higher-level software that they have occurred. The procedures
and \fBTcl_SetMaxBlockTime\fR, \fBTcl_QueueEvent\fR, and
\fBTcl_DeleteEvents\fR are used primarily by event sources.
.IP [2]
-The event queue: there is a single queue for the whole application,
+The event queue: for non-threaded applications,
+there is a single queue for the whole application,
containing events that have been detected but not yet serviced. Event
sources place events onto the queue so that they may be processed in
order at appropriate times during the event loop. The event queue
guarantees a fair discipline of event handling, so that no event
source can starve the others. It also allows events to be saved for
servicing at a future time.
-.VS
+.VS 8.1
+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
\fBTcl_DeleteEvents\fR is used to remove events from the queue without
-processing them.
+processing them. In a threaded application, \fBTcl_QueueEvent\fR adds
+an event to the current thread's queue, and \fBTcl_ThreadQueueEvent\fR
+adds an event to a queue in a specific thread.
.IP [3]
The event loop: in order to detect and process events, the application
enters a loop that waits for events to occur, places them on the event
@@ -133,7 +161,9 @@ to be retargeted either for a new platform or to use an external event
loop (such as the Motif event loop, when Tcl is embedded in a Motif
application). The procedures \fBTcl_WaitForEvent\fR and
\fBTcl_SetTimer\fR are normally implemented by Tcl, but may be
-replaced with new versions to retarget the notifier (the \fBTcl_Sleep\fR,
+replaced with new versions to retarget the notifier (the
+\fBTcl_InitNotifier\fR, \fBTcl_AlertNotifier\fR,
+\fBTcl_FinalizeNotifier\fR, \fBTcl_Sleep\fR,
\fBTcl_CreateFileHandler\fR, and \fBTcl_DeleteFileHandler\fR must
also be replaced; see CREATING A NEW NOTIFIER below for details).
The procedures \fBTcl_ServiceAll\fR, \fBTcl_ServiceEvent\fR,
@@ -152,7 +182,7 @@ things:
.IP [1]
Check the event queue to see if it contains any events that can
be serviced. If so, service the first possible event, remove it
-.VS
+.VS 8.1
from the queue, and return. It does this by calling
\fBTcl_ServiceEvent\fR and passing in the \fIflags\fR argument.
.VE
@@ -160,7 +190,7 @@ from the queue, and return. It does this by calling
Prepare to block for an event. To do this, \fBTcl_DoOneEvent\fR
invokes a \fIsetup procedure\fR in each event source.
The event source will perform event-source specific initialization and
-.VS
+.VS 8.1
possibly call \fBTcl_SetMaxBlockTime\fR to limit how long
.VE
\fBTcl_WaitForEvent\fR will block if no new events occur.
@@ -228,7 +258,7 @@ request notification with a Windows event. For timer-driven event
sources such as timer events or any polled event, the event source
can call \fBTcl_SetMaxBlockTime\fR to force the application to wake
up after a specified time even if no events have occurred.
-.VS
+.VS 8.1
If no event source calls \fBTcl_SetMaxBlockTime\fR
then \fBTcl_WaitForEvent\fR will wait as long as necessary for an
event to occur; otherwise, it will only wait as long as the shortest
@@ -252,7 +282,7 @@ typedef struct Tcl_Time {
.CE
The \fIusec\fR field should be less than 1000000.
.PP
-.VS
+.VS 8.1
Information provided to \fBTcl_SetMaxBlockTime\fR
is only used for the next call to \fBTcl_WaitForEvent\fR; it is
discarded after \fBTcl_WaitForEvent\fR returns.
@@ -261,7 +291,7 @@ The next time an event wait is done each of the event sources'
setup procedures will be called again, and they can specify new
information for that event wait.
.PP
-.VS
+.VS 8.1
If the application uses an external event loop rather than
\fBTcl_DoOneEvent\fR, the event sources may need to call
\fBTcl_SetMaxBlockTime\fR at other times. For example, if a new event
@@ -307,10 +337,10 @@ must be a structure of type \fBTcl_Event\fR, and the address of this
structure is used when communicating between the event source and the
rest of the notifier. A \fBTcl_Event\fR has the following definition:
.CS
-typedef struct Tcl_Event {
+typedef struct {
Tcl_EventProc *\fIproc\fR;
struct Tcl_Event *\fInextPtr\fR;
-};
+} Tcl_Event;
.CE
The event source must fill in the \fIproc\fR field of
the event before calling \fBTcl_QueueEvent\fR.
@@ -335,7 +365,7 @@ events at the front of the queue, such as a series of
Enter and Leave events synthesized during a grab or ungrab operation
in Tk.
.PP
-.VS
+.VS 8.1
When it is time to handle an event from the queue (steps 1 and 4
above) \fBTcl_ServiceEvent\fR will invoke the \fIproc\fR specified
.VE
@@ -350,7 +380,7 @@ The first argument to \fIproc\fR is a pointer to the event, which will
be the same as the first argument to the \fBTcl_QueueEvent\fR call that
added the event to the queue.
The second argument to \fIproc\fR is the \fIflags\fR argument for the
-.VS
+.VS 8.1
current call to \fBTcl_ServiceEvent\fR; this is used by the event source
.VE
to return immediately if its events are not relevant.
@@ -361,7 +391,7 @@ Once the event source has finished handling the event it returns 1
to indicate that the event can be removed from the queue.
If for some reason the event source decides that the event cannot
be handled at this time, it may return 0 to indicate that the event
-.VS
+.VS 8.1
should be deferred for processing later; in this case \fBTcl_ServiceEvent\fR
.VE
will go on to the next event in the queue and attempt to service it.
@@ -374,7 +404,7 @@ Another example of deferring events happens in Tk if
\fBTk_RestrictEvents\fR has been invoked to defer certain kinds
of window events.
.PP
-.VS
+.VS 8.1
When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the
event from the event queue and free its storage.
Note that the storage for an event must be allocated by
@@ -382,6 +412,21 @@ the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR)
before calling \fBTcl_QueueEvent\fR, but it
will be freed by \fBTcl_ServiceEvent\fR, not by the event source.
.PP
+Threaded applications work in a
+similar manner, except that there is a separate event queue for
+each thread containing a Tcl interpreter.
+Calling \fBTcl_QueueEvent\fR in a multithreaded application adds
+an event to the current thread's queue.
+To add an event to another thread's queue, use \fBTcl_ThreadQueueEvent\fR.
+\fBTcl_ThreadQueueEvent\fR accepts as an argument a Tcl_ThreadId argument,
+which uniquely identifies a thread in a Tcl application. To obtain the
+Tcl_ThreadID for the current thread, use the \fBTcl_GetCurrentThread\fR
+procedure. (A thread would then need to pass this identifier to other
+threads for those threads to be able to add events to its queue.)
+After adding an event to another thread's queue, you then typically
+need to call \fBTcl_ThreadAlert\fR to "wake up" that thread's notifier to
+alert it to the new event.
+.PP
\fBTcl_DeleteEvents\fR can be used to explicitly remove one or more
events from the event queue. \fBTcl_DeleteEvents\fR calls \fIproc\fR
for each event in the queue, deleting those for with the procedure
@@ -396,23 +441,35 @@ The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_DeleteEvents\fR; it is typically used to point to
private information managed by the event source. The \fIevPtr\fR will
point to the next event in the queue.
+.PP
+\fBTcl_DeleteEventSource\fR deletes an event source. The \fIsetupProc\fR,
+\fIcheckProc\fR, and \fIclientData\fR arguments must exactly match those
+provided to the \fBTcl_CreateEventSource\fR for the event source to be deleted.
+If no such source exists, \fBTcl_DeleteEventSource\fR has no effect.
.VE
.SH "CREATING A NEW NOTIFIER"
.PP
The notifier consists of all the procedures described in this manual
entry, plus \fBTcl_DoOneEvent\fR and \fBTcl_Sleep\fR, which are
-.VS
+.VS 8.1
available on all platforms, and \fBTcl_CreateFileHandler\fR and
\fBTcl_DeleteFileHandler\fR, which are Unix-specific. Most of these
procedures are generic, in that they are the same for all notifiers.
-However, five of the procedures are notifier-dependent:
+However, eight of the procedures are notifier-dependent:
+\fBTcl_InitNotifier\fR, \fBTcl_AlertNotifier\fR, \fBTcl_FinalizeNotifier\fR,
\fBTcl_SetTimer\fR, \fBTcl_Sleep\fR, \fBTcl_WaitForEvent\fR,
\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR. To
support a new platform or to integrate Tcl with an
application-specific event loop, you must write new versions of these
procedures.
.PP
+\fBTcl_InitNotifier\fR initializes the notifier state and returns
+a handle to the notifier state. Tcl calls this
+procedure when intializing a Tcl interpreter. Similarly,
+\fBTcl_FinalizeNotifier\fR shuts down the notifier, and is
+called by \fBTcl_Finalize\fR when shutting down a Tcl interpreter.
+.PP
\fBTcl_WaitForEvent\fR is the lowest-level procedure in the notifier;
it is responsible for waiting for an ``interesting'' event to occur or
for a given time to elapse. Before \fBTcl_WaitForEvent\fR is invoked,
@@ -448,6 +505,11 @@ under Unix it happens when \fBTcl_WaitForEvent\fR would have waited
forever because there were no active event sources and the timeout was
infinite.
.PP
+\fBTcl_AlertNotifier\fR is used in multithreaded applications to allow
+any thread to "wake up" the notifier to alert it to new events on its
+queue. \fBTcl_AlertNotifier\fR requires as an argument the notifier
+handle returned by \fBTcl_InitNotifier\fR.
+.PP
If the notifier will be used with an external event loop, then it must
also support the \fBTcl_SetTimer\fR interface. \fBTcl_SetTimer\fR is
invoked by \fBTcl_SetMaxBlockTime\fR whenever the maximum blocking
@@ -462,10 +524,11 @@ notifier will only be used from \fBTcl_DoOneEvent\fR, then
On Unix systems, the file event source also needs support from the
notifier. The file event source consists of the
\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR
-procedures, which are described elsewhere.
+procedures, which are described in the \fBTcl_CreateFileHandler\fR
+manual page.
.PP
The \fBTcl_Sleep\fR and \fBTcl_DoOneEvent\fR interfaces are described
-elsewhere.
+in their respective manual pages.
.PP
The easiest way to create a new notifier is to look at the code
for an existing notifier, such as the files \fBunix/tclUnixNotfy.c\fR
@@ -532,6 +595,9 @@ mode, which should be restored when the recursive loop exits.
\fBTcl_GetServiceMode\fR returns the current value of the service
mode.
.VE
-
+.SH "SEE ALSO"
+\fBTcl_CreateFileHandler\fR, \fBTcl_DeleteFileHandler\fR, \fBTcl_Sleep\fR,
+\fBTcl_DoOneEvent\fR, \fBThread(3)\fR
.SH KEYWORDS
-event, notifier, event queue, event sources, file events, timer, idle, service mode
+event, notifier, event queue, event sources, file events, timer, idle, service mode, threads
+
diff --git a/tcl/doc/Object.3 b/tcl/doc/Object.3
index ca828188e03..6b62eccd935 100644
--- a/tcl/doc/Object.3
+++ b/tcl/doc/Object.3
@@ -10,7 +10,7 @@
.TH Tcl_Obj 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared \- manipulate Tcl objects
+Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl objects
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -85,7 +85,7 @@ Because of this representation invalidation and regeneration,
it is dangerous for extension writers to access
\fBTcl_Obj\fR fields directly.
It is better to access Tcl_Obj information using
-procedures like \fBTcl_GetStringFromObj\fR.
+procedures like \fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR.
.PP
Objects are allocated on the heap
and are referenced using a pointer to their \fBTcl_Obj\fR structure.
@@ -138,7 +138,7 @@ The byte array must always have a null after the last byte,
at offset \fIlength\fR;
this allows string representations that do not contain nulls
to be treated as conventional null-terminated C strings.
-C programs use \fBTcl_GetStringFromObj\fR to get
+C programs use \fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR to get
an object's string representation.
If \fIbytes\fR is NULL,
the string representation is invalid.
@@ -177,7 +177,8 @@ An object typically starts out containing only a string representation:
it is untyped and has a NULL \fItypePtr\fR.
An object containing an empty string or a copy of a specified string
is created using \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR respectively.
-An object's string value is gotten with \fBTcl_GetStringFromObj\fR
+An object's string value is gotten with
+\fBTcl_GetStringFromObj\fR or \fBTcl_GetString\fR
and changed with \fBTcl_SetStringObj\fR.
If the object is later passed to a procedure like \fBTcl_GetIntFromObj\fR
that requires a specific internal representation,
@@ -187,7 +188,7 @@ An object's two representations are duals of each other:
changes made to one are reflected in the other.
For example, \fBTcl_ListObjReplace\fR will modify an object's
internal representation and the next call to \fBTcl_GetStringFromObj\fR
-will reflect that change.
+or \fBTcl_GetString\fR will reflect that change.
.PP
Representations are recomputed lazily for efficiency.
A change to one representation made by a procedure
@@ -208,7 +209,7 @@ free any storage associated with the old string representation.
Objects usually remain one type over their life,
but occasionally an object must be converted from one type to another.
For example, a C program might build up a string in an object
-with repeated calls to \fBTcl_StringObjAppend\fR,
+with repeated calls to \fBTcl_AppendToObj\fR,
and then call \fBTcl_ListObjIndex\fR to extract a list element from
the object.
The same object holding the same string value
@@ -292,7 +293,7 @@ reference to it from the formal parameter.
When the called procedure returns,
the interpreter calls \fBTcl_DecrRefCount\fR to decrement
each argument's reference count.
-When an object's reference count drops to zero,
+When an object's reference count drops less than or equal to zero,
\fBTcl_DecrRefCount\fR reclaims its storage.
Most command procedures do not have to be concerned about
reference counting since they use an object's value immediately
@@ -334,3 +335,4 @@ Tcl_ConvertToType, Tcl_GetIntFromObj, Tcl_ListObjAppendElement, Tcl_ListObjIndex
.SH KEYWORDS
internal representation, object, object creation, object type, reference counting, string representation, type conversion
+
diff --git a/tcl/doc/OpenFileChnl.3 b/tcl/doc/OpenFileChnl.3
index 3a73c173586..b0728185ea1 100644
--- a/tcl/doc/OpenFileChnl.3
+++ b/tcl/doc/OpenFileChnl.3
@@ -6,11 +6,11 @@
'\"
'\" RCS: @(#) $Id$
.so man.macros
-.TH Tcl_OpenFileChannel 3 8.0 Tcl "Tcl Library Procedures"
+.TH Tcl_OpenFileChannel 3 8.3 Tcl "Tcl Library Procedures"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_Close, Tcl_Read, Tcl_Gets, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_GetChannelOption, Tcl_SetChannelOption \- buffered I/O facilities using channels
+Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_Ungets \- buffered I/O facilities using channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -22,7 +22,7 @@ Tcl_Channel
.sp
Tcl_Channel
\fBTcl_OpenCommandChannel\fR(\fIinterp, argc, argv, flags\fR)
-.VS
+.VS 8.0
.sp
Tcl_Channel
\fBTcl_MakeFileChannel\fR(\fIhandle, readOrWrite\fR)
@@ -30,6 +30,14 @@ Tcl_Channel
.sp
Tcl_Channel
\fBTcl_GetChannel\fR(\fIinterp, channelName, modePtr\fR)
+.VS 8.3
+.sp
+int
+\fBTcl_GetChannelNames\fR(\fIinterp\fR)
+.sp
+int
+\fBTcl_GetChannelNamesEx\fR(\fIinterp, pattern\fR)
+.VE
.sp
void
\fBTcl_RegisterChannel\fR(\fIinterp, channel\fR)
@@ -40,35 +48,37 @@ int
int
\fBTcl_Close\fR(\fIinterp, channel\fR)
.sp
+.VS 8.1
int
-\fBTcl_Read\fR(\fIchannel, buf, toRead\fR)
+\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
-\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
+\fBTcl_Read\fR(\fIchannel, byteBuf, bytesToRead\fR)
.sp
int
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
.sp
int
-\fBTcl_Write\fR(\fIchannel, buf, toWrite\fR)
+\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
.sp
int
-\fBTcl_Flush\fR(\fIchannel\fR)
+\fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR)
.sp
int
-\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
+\fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR)
.sp
int
-\fBTcl_Tell\fR(\fIchannel\fR)
+\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
.sp
int
-\fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR)
+\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
+.VE
.sp
int
-\fBTcl_SetChannelOption\fR(\fIinterp, channel, optionName, newValue\fR)
+\fBTcl_Eof\fR(\fIchannel\fR)
.sp
int
-\fBTcl_Eof\fR(\fIchannel\fR)
+\fBTcl_Flush\fR(\fIchannel\fR)
.sp
int
\fBTcl_InputBlocked\fR(\fIchannel\fR)
@@ -76,6 +86,18 @@ int
int
\fBTcl_InputBuffered\fR(\fIchannel\fR)
.sp
+int
+\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
+.sp
+int
+\fBTcl_Tell\fR(\fIchannel\fR)
+.sp
+int
+\fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR)
+.sp
+int
+\fBTcl_SetChannelOption\fR(\fIinterp, channel, optionName, newValue\fR)
+.sp
.SH ARGUMENTS
.AS Tcl_ChannelType newClientProcPtr in
.AP Tcl_Interp *interp in
@@ -83,37 +105,36 @@ Used for error reporting and to look up a channel registered in it.
.AP char *fileName in
The name of a local or network file.
.AP 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.
-For \fBTcl_OpenCommandChannel\fR, may be NULL.
+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. For
+\fBTcl_OpenCommandChannel\fR, may be NULL.
.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.
+POSIX-style permission flags such as 0644. If a new file is created, these
+permissions will be set on the created file.
.AP int argc in
The number of elements in \fIargv\fR.
.AP char **argv in
-Arguments for constructing a command pipeline.
-These values have the same meaning as the non-switch arguments
-to the Tcl \fBexec\fR command.
+Arguments for constructing a command pipeline. These values have the same
+meaning as the non-switch arguments to the Tcl \fBexec\fR command.
.AP int flags in
Specifies the disposition of the stdio handles in pipeline: OR-ed
-combination of \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, \fBTCL_STDERR\fR,
-and \fBTCL_ENFORCE_MODE\fR. If \fBTCL_STDIN\fR is set, stdin for
-the first child in the pipe is the pipe channel, otherwise it is the same
-as the standard input of the invoking process; likewise for
-\fBTCL_STDOUT\fR and \fBTCL_STDERR\fR. If \fBTCL_ENFORCE_MODE\fR is not set,
-then the pipe can redirect stdio handles to override the stdio handles for
-which \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set.
-If it is set, then such redirections cause an error.
-.VS
+combination of \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, \fBTCL_STDERR\fR, and
+\fBTCL_ENFORCE_MODE\fR. If \fBTCL_STDIN\fR is set, stdin for the first child
+in the pipe is the pipe channel, otherwise it is the same as the standard
+input of the invoking process; likewise for \fBTCL_STDOUT\fR and
+\fBTCL_STDERR\fR. If \fBTCL_ENFORCE_MODE\fR is not set, then the pipe can
+redirect stdio handles to override the stdio handles for which
+\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set. If it
+is set, then such redirections cause an error.
+.VS 8.0
.AP ClientData handle in
Operating system specific handle for I/O to a file. For Unix this is a
file descriptor, for Windows it is a HANDLE.
.AP int readOrWrite in
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
what operations are valid on \fIhandle\fR.
+.AP char *channelName in
+The name of the channel.
.VE
.AP int *modePtr out
Points at an integer variable that will receive an OR-ed combination of
@@ -122,26 +143,40 @@ open for reading and writing.
.AP Tcl_Channel channel in
A Tcl channel for input or output. Must have been the return value
from a procedure such as \fBTcl_OpenFileChannel\fR.
-.AP char *buf in
-An array of bytes in which to store channel input, or from which
-to read channel output.
-.AP int len in
-The length of the input or output.
-.AP int atEnd in
-If nonzero, store the input at the end of the input queue, otherwise store
-it at the head of the input queue.
-.AP int toRead in
-The number of bytes to read from the channel.
-.AP Tcl_DString *lineRead in
-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 appended to any data already in the dynamic string.
-.AP Tcl_Obj *linePtrObj in
+.VS 8.1 br
+.AP Tcl_Obj *readObjPtr in/out
+A pointer to a Tcl Object 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
+channel.
+.AP int appendFlag in
+If non-zero, data read from the channel will be appended to the object.
+Otherwise, the data will replace the existing contents of the object.
+.AP char *readBuf out
+A buffer in which to store the bytes read from the channel.
+.AP int bytesToRead in
+The number of bytes to read from the channel. The buffer \fIreadBuf\fR must
+be large enough to hold this many bytes.
+.AP Tcl_Obj *lineObjPtr in/out
A pointer to a Tcl object in which to store the line read from the
channel. The line read will be appended to the current value of the
object.
-.AP int toWrite in
-The number of bytes to read from \fIbuf\fR and output to the channel.
+.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
+appended to any data already in the dynamic string.
+.AP Tcl_Obj *writeObjPtr in
+A pointer to a Tcl Object whose contents will be output to the channel.
+.AP "CONST char" *charBuf in
+A buffer containing the characters to output to the channel.
+.AP char *byteBuf in
+A buffer containing the bytes to output to the channel.
+.AP int bytesToWrite in
+The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and
+output to the channel.
+.VE
.AP int offset in
How far to move the access point in the channel at which the next input or
output operation will be applied, measured in bytes from the position
@@ -158,6 +193,17 @@ Where to store the value of an option or a list of all options and their
values. Must have been initialized by the caller.
.AP char *newValue in
New value for the option given by \fIoptionName\fR.
+.VS 8.3
+.AP char *pattern in
+The pattern to match on, passed to Tcl_StringMatch, or NULL.
+.AP char *input in
+The input to add to a channel buffer.
+.AP int inputLen in
+Length of the input
+.AP int addToEnd in
+Flag indicating whether the input should be added to the end or
+beginning of the channel buffer.
+.VE
.BE
.SH DESCRIPTION
@@ -169,7 +215,7 @@ types.
The channel mechanism is extensible to new channel types, by
providing a low level channel driver for the new type; the channel driver
interface is described in the manual entry for \fBTcl_CreateChannel\fR. The
-channel mechanism provides a buffering scheme modelled after
+channel mechanism provides a buffering scheme modeled after
Unix's standard I/O, and it also allows for nonblocking I/O on
channels.
.PP
@@ -182,7 +228,7 @@ channels, see the manual entry for \fBTcl_CreateChannel\fR.
.PP
\fBTcl_OpenFileChannel\fR opens a file specified by \fIfileName\fR and
returns a channel handle that can be used to perform input and output on
-the file. This API is modelled after the \fBfopen\fR procedure of
+the file. This API is modeled after the \fBfopen\fR procedure of
the Unix standard I/O library.
The syntax and meaning of all arguments is similar to those
given in the Tcl \fBopen\fR command when opening a file.
@@ -190,7 +236,7 @@ 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->result\fR after any error.
+leaves an error message in \fIinterp\fR's result after any error.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR, described below.
@@ -228,7 +274,7 @@ If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR
returns NULL and records a POSIX error code that can be retrieved with
\fBTcl_GetErrno\fR.
In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in
-\fIinterp->result\fR if \fIinterp\fR is not NULL.
+the interpreter's result if \fIinterp\fR is not NULL.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR, described below.
@@ -255,6 +301,14 @@ the procedure returns NULL. If the \fImode\fR argument is not NULL, it
points at an integer variable that will receive an OR-ed combination of
\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR describing whether the channel is
open for reading and writing.
+.PP
+\fBTcl_GetChannelNames\fR and \fBTcl_GetChannelNamesEx\fR write the
+names of the registered channels to the interpreter's result as a
+list object. \fBTcl_GetChannelNamesEx\fR will filter these names
+according to the \fIpattern\fR. If \fIpattern\fR is NULL, then it
+will not do any filtering. The return value is \fBTCL_OK\fR if no
+errors occured writing to the result, otherwise it is \fBTCL_ERROR\fR,
+and the error message is left in the interpreter's result.
.SH TCL_REGISTERCHANNEL
.PP
@@ -306,97 +360,151 @@ If an error occurs, \fBTcl_Close\fR returns \fBTCL_ERROR\fR and records a
POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
If the channel is being closed synchronously and an error occurs during
closing of the channel and \fIinterp\fR is not NULL, an error message is
-left in \fIinterp->result\fR.
+left in the interpreter's result.
.PP
Note: it is not safe to call \fBTcl_Close\fR on a channel that has been
registered using \fBTcl_RegisterChannel\fR; see the documentation for
-\fBTcl_RegisterChannel\fR, above, for details. If the channel has ever been
-given as the \fBchan\fR argument in a call to \fBTcl_RegisterChannel\fR,
-you should instead use \fBTcl_UnregisterChannel\fR, which will internally
-call \fBTcl_Close\fR when all calls to \fBTcl_RegisterChannel\fR have been
-matched by corresponding calls to \fBTcl_UnregisterChannel\fR.
+\fBTcl_RegisterChannel\fR, above, for details. If the channel has ever
+been given as the \fBchan\fR argument in a call to
+\fBTcl_RegisterChannel\fR, you should instead use
+\fBTcl_UnregisterChannel\fR, which will internally call \fBTcl_Close\fR
+when all calls to \fBTcl_RegisterChannel\fR have been matched by
+corresponding calls to \fBTcl_UnregisterChannel\fR.
-.SH TCL_READ
-.PP
-\fBTcl_Read\fR consumes up to \fItoRead\fR bytes of data from
-\fIchannel\fR and stores it at \fIbuf\fR.
-The return value of \fBTcl_Read\fR is the number of characters written
-at \fIbuf\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.
-If an error occurs, the return value is -1 and \fBTcl_Read\fR records
-a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
-.PP
-The return value may be smaller than the value of \fItoRead\fR, indicating
-that less data than requested was available, also called a \fIshort
-read\fR.
-In blocking mode, this can only happen on an end-of-file.
-In nonblocking mode, a short read can also occur if there is not
-enough input currently available: \fBTcl_Read\fR returns a short
-count rather than waiting for more data.
-.PP
-If the channel is in blocking mode, a return value of zero indicates an end
-of file condition. If the channel is in nonblocking mode, a return value of
-zero indicates either that no input is currently available or an end of
-file condition. Use \fBTcl_Eof\fR and \fBTcl_InputBlocked\fR
-to tell which of these conditions actually occurred.
-.PP
-\fBTcl_Read\fR translates platform-specific end-of-line representations
-into the canonical \fB\en\fR internal representation according to the
-current end-of-line recognition mode. End-of-line recognition and the
-various platform-specific modes are described in the manual entry for the
-Tcl \fBfconfigure\fR command.
+.VS 8.1 br
+.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
+\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 \fIobjPtr\fR. If an error occurs while reading, the
+return value is \-1 and \fBTcl_ReadChars\fR records a POSIX error code that
+can be retrieved with \fBTcl_GetErrno\fR.
+.PP
+The return value may be smaller than the value to read, indicating that less
+data than requested was available. This is called a \fIshort read\fR. In
+blocking mode, this can only happen on an end-of-file. In nonblocking mode,
+a short read can also occur if there is not enough input currently
+available: \fBTcl_ReadChars\fR returns a short count rather than waiting
+for more data.
+.PP
+If the channel is in blocking mode, a return value of zero indicates an
+end-of-file condition. If the channel is in nonblocking mode, a return
+value of zero indicates either that no input is currently available or an
+end-of-file condition. Use \fBTcl_Eof\fR and \fBTcl_InputBlocked\fR to tell
+which of these conditions actually occurred.
+.PP
+\fBTcl_ReadChars\fR translates the various end-of-line representations into
+the canonical \fB\en\fR internal representation according to the current
+end-of-line recognition mode. End-of-line recognition and the various
+platform-specific modes are described in the manual entry for the Tcl
+\fBfconfigure\fR command.
+.PP
+As a performance optimization, when reading from a channel with the encoding
+\fBbinary\fR, the bytes are not converted to UTF-8 as they are read.
+Instead, they are stored in \fIreadObjPtr\fR's internal representation as a
+byte-array object. The string representation of this object will only be
+constructed if it is needed (e.g., because of a call to
+\fBTcl_GetStringFromObj\fR). In this way, byte-oriented data can be read
+from a channel, manipulated by calling \fBTcl_GetByteArrayFromObj\fR and
+related functions, and then written to a channel without the expense of ever
+converting to or from UTF-8.
+.PP
+\fBTcl_Read\fR is similar to \fBTcl_ReadChars\fR, except that it doesn't do
+encoding conversions, regardless of the channel's encoding. It is deprecated
+and exists for backwards compatibility with non-internationalized Tcl
+extensions. It consumes bytes from \fIchannel\fR and stores them in
+\fIbuf\fR, performing end-of-line translations on the way. The return value
+of \fBTcl_Read\fR is the number of bytes, up to \fItoRead\fR, written in
+\fIbuf\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.
-.SH TCL_GETS AND TCL_GETSOBJ
-.PP
-\fBTcl_Gets\fR reads a line of input from a channel and appends all of
-the characters of the line except for the terminating end-of-line character(s)
-to the dynamic string given by \fIdsPtr\fR.
-The end-of-line character(s) are read and discarded.
+.SH "TCL_GETSOBJ AND TCL_GETS"
+.PP
+\fBTcl_GetsObj\fR consumes bytes from \fIchannel\fR, converting the bytes to
+UTF-8 based on the channel's encoding, until a full line of input has been
+seen. If the channel's encoding is \fBbinary\fR, each byte read from the
+channel is treated as an individual Unicode character. All of the
+characters of the line except for the terminating end-of-line character(s)
+are appended to \fIlineObjPtr\fR's string representation. The end-of-line
+character(s) are read and discarded.
+.PP
+If a line was successfully read, the return value is greater than or equal
+to zero and indicates the number of bytes stored in \fIlineObjPtr\fR. If an
+error occurs, \fBTcl_GetsObj\fR returns \-1 and records a POSIX error code
+that can be retrieved with \fBTcl_GetErrno\fR. \fBTcl_GetsObj\fR also
+returns \-1 if the end of the file is reached; the \fBTcl_Eof\fR procedure
+can be used to distinguish an error from an end-of-file condition.
+.PP
+If the channel is in nonblocking mode, the return value can also be \-1 if
+no data was available or the data that was available did not contain an
+end-of-line character. When \-1 is returned, the \fBTcl_InputBlocked\fR
+procedure may be invoked to determine if the channel is blocked because
+of input unavailability.
+.PP
+\fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting
+characters are appended to the appended to the dynamic string given by
+\fIdsPtr\fR rather than a Tcl object.
+
+.SH "TCL_UNGETS"
+.PP
+\fBTcl_Ungets\fR is used to add data to the input queue of a channel,
+at either the head or tail of the queue. \fIInput\fR is a pointer to
+the data that is to be added. \fIInputLen\fR gives the length of the
+input to add. \fIAddAtEnd\fR, in non-zero, indicates that the data is
+to be added at the end of queue; otherwise it will be added at the
+head of the queue. If \fIchannel\fR has a "sticky" EOF set, no data will be
+added to the input queue. \fBTcl_Ungets\fR returns \fIinputLen\fR or
+-1 if an error occurs.
+
+.SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE"
.PP
-If a line was successfully read, the return value is greater than or
-equal to zero, and it indicates the number of characters stored
-in the dynamic string.
-If an error occurs, \fBTcl_Gets\fR returns -1 and records a POSIX error
-code that can be retrieved with \fBTcl_GetErrno\fR.
-\fBTcl_Gets\fR also returns -1 if the end of the file is reached;
-the \fBTcl_Eof\fR procedure can be used to distinguish an error
-from an end-of-file condition.
-.PP
-If the channel is in nonblocking mode, the return value can also
-be -1 if no data was available or the data that was available
-did not contain an end-of-line character.
-When -1 is returned, the \fBTcl_InputBlocked\fR procedure may be
-invoked to determine if the channel is blocked because of input
-unavailability.
-.PP
-\fBTcl_GetsObj\fR is the same as \fBTcl_Gets\fR except the resulting
-characters are appended to a Tcl object \fBlineObjPtr\fR rather than a
-dynamic string.
-.SH TCL_WRITE
-.PP
-\fBTcl_Write\fR accepts \fItoWrite\fR bytes of data at \fIbuf\fR for output
-on \fIchannel\fR. This data may not appear on the output device
-immediately. If the data should appear immediately, call \fBTcl_Flush\fR
-after the call to \fBTcl_Write\fR, or set the \fB-buffering\fR option on
-the channel to \fBnone\fR. If you wish the data to appear as soon as an end
-of line is accepted for output, set the \fB\-buffering\fR option on the
-channel to \fBline\fR mode.
-.PP
-The \fItoWrite\fR argument specifies how many bytes of data are provided in
-the \fIbuf\fR argument. If it is negative, \fBTcl_Write\fR expects the data
+\fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at
+\fIcharBuf\fR. The UTF-8 characters in the buffer are converted to the
+channel's encoding and queued for output to \fIchannel\fR. If
+\fIbytesToWrite\fR is negative, \fBTcl_WriteChars\fR expects \fIcharBuf\fR
to be NULL terminated and it outputs everything up to the NULL.
.PP
-The return value of \fBTcl_Write\fR is a count of how many
-characters were accepted for output to the channel. This is either equal to
-\fItoWrite\fR or -1 to indicate that an error occurred.
-If an error occurs, \fBTcl_Write\fR also records a POSIX error code
-that may be retrieved with \fBTcl_GetErrno\fR.
+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
+\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.
+.PP
+The return value of \fBTcl_WriteChars\fR is a count of how many bytes were
+accepted for output to the channel. This is either greater than zero to
+indicate success or \-1 to indicate that an error occurred. If an error
+occurs, \fBTcl_WriteChars\fR records a POSIX error code that may be
+retrieved with \fBTcl_GetErrno\fR.
.PP
Newline characters in the output data are translated to platform-specific
-end-of-line sequences according to the \fB\-translation\fR option for
-the channel.
+end-of-line sequences according to the \fB\-translation\fR option for the
+channel. This is done even if the channel has no encoding.
+.PP
+\fBTcl_WriteObj\fR is similar to \fBTcl_WriteChars\fR except it
+accepts a Tcl object 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.
+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
+byte-array object are written to the channel. The byte-array representation
+of the object will be constructed if it is needed. In this way,
+byte-oriented data can be read from a channel, manipulated by calling
+\fBTcl_GetByteArrayFromObj\fR and related functions, and then written to a
+channel without the expense of ever converting to or from UTF-8.
+.PP
+\fBTcl_Write\fR is similar to \fBTcl_WriteChars\fR except that it doesn't do
+encoding conversions, regardless of the channel's encoding. It is
+deprecated and exists for backwards compatibility with non-internationalized
+Tcl extensions. It accepts \fIbytesToWrite\fR bytes of data at
+\fIbyteBuf\fR and queues them for output to \fIchannel\fR. If
+\fIbytesToWrite\fR is negative, \fBTcl_Write\fR expects \fIbyteBuf\fR to be
+NULL terminated and it outputs everything up to the NULL.
+.VE
.SH TCL_FLUSH
.PP
@@ -419,14 +527,14 @@ data will be read or written. Buffered output is flushed to the channel and
buffered input is discarded, prior to the seek operation.
.PP
\fBTcl_Seek\fR normally returns the new access point.
-If an error occurs, \fBTcl_Seek\fR returns -1 and records a POSIX error
+If an error occurs, \fBTcl_Seek\fR returns \-1 and records a POSIX error
code that can be retrieved with \fBTcl_GetErrno\fR.
After an error, the access point may or may not have been moved.
.SH TCL_TELL
.PP
\fBTcl_Tell\fR returns the current access point for a channel. The returned
-value is -1 if the channel does not support seeking.
+value is \-1 if the channel does not support seeking.
.SH TCL_GETCHANNELOPTION
.PP
@@ -457,7 +565,7 @@ error code.
set.
The procedure normally returns \fBTCL_OK\fR. If an error occurs,
it returns \fBTCL_ERROR\fR; in addition, if \fIinterp\fR is non-NULL,
-\fBTcl_SetChannelOption\fR leaves an error message in \fIinterp->result\fR.
+\fBTcl_SetChannelOption\fR leaves an error message in the interpreter's result.
.SH TCL_EOF
.PP
@@ -477,7 +585,7 @@ The call always returns zero if the channel is in blocking mode.
buffered in the internal buffers for a channel. If the channel is not open
for reading, this function always returns zero.
-.VS
+.VS 8.0
.SH "PLATFORM ISSUES"
.PP
The handles returned from \fBTcl_GetChannelHandle\fR depend on the
@@ -497,3 +605,4 @@ DString(3), fconfigure(n), filename(n), fopen(2), Tcl_CreateChannel(3)
.SH KEYWORDS
access point, blocking, buffered I/O, channel, channel driver, end of file,
flush, input, nonblocking, output, read, seek, write
+
diff --git a/tcl/doc/OpenTcp.3 b/tcl/doc/OpenTcp.3
index 7d3c997f27f..a16e0de95b2 100644
--- a/tcl/doc/OpenTcp.3
+++ b/tcl/doc/OpenTcp.3
@@ -28,7 +28,7 @@ Tcl_Channel
.AS Tcl_ChannelType newClientProcPtr in
.AP Tcl_Interp *interp in
Tcl interpreter to use for error reporting. If non-NULL and an
-error occurs, an error message is left in \fIinterp->result\fR.
+error occurs, an error message is left in the interpreter's result.
.AP int port in
A port number to connect to as a client or to listen on as a server.
.AP char *host in
@@ -91,7 +91,7 @@ If an error occurs in opening the socket, \fBTcl_OpenTcpClient\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, an error message
-is left in \fIinterp->result\fR.
+is left in the interpreter's result.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR.
@@ -143,8 +143,8 @@ connection it can close \fIchannel\fR.
representing the server socket.
If an error occurs, \fBTcl_OpenTcpServer\fR returns NULL and
records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
-In addition, if \fIinterp->result\fR is non-NULL, an error message
-is left in \fIinterp->result\fR.
+In addition, if the interpreter is non-NULL, an error message
+is left in the interpreter's result.
.PP
The channel returned by \fBTcl_OpenTcpServer\fR cannot be used for
either input or output.
@@ -177,3 +177,4 @@ Tcl_OpenFileChannel(3), Tcl_RegisterChannel(3), vwait(n)
.SH KEYWORDS
client, server, TCP
+
diff --git a/tcl/doc/ParseCmd.3 b/tcl/doc/ParseCmd.3
new file mode 100644
index 00000000000..a9c0fb2e634
--- /dev/null
+++ b/tcl/doc/ParseCmd.3
@@ -0,0 +1,439 @@
+'\"
+'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens \- parse Tcl scripts and expressions
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_ParseCommand\fR(\fIinterp, string, numBytes, nested, parsePtr\fR)
+.sp
+int
+\fBTcl_ParseExpr\fR(\fIinterp, string, numBytes, parsePtr\fR)
+.sp
+int
+\fBTcl_ParseBraces\fR(\fIinterp, string, numBytes, parsePtr, append, termPtr\fR)
+.sp
+int
+\fBTcl_ParseQuotedString\fR(\fIinterp, string, numBytes, parsePtr, append, termPtr\fR)
+.sp
+int
+\fBTcl_ParseVarName\fR(\fIinterp, string, numBytes, parsePtr, append\fR)
+.sp
+char *
+\fBTcl_ParseVar\fR(\fIinterp, string, termPtr\fR)
+.sp
+\fBTcl_FreeParse\fR(\fIusedParsePtr\fR)
+.sp
+Tcl_Obj *
+\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *usedParsePtr
+.AP Tcl_Interp *interp out
+For procedures other than \fBTcl_FreeParse\fR and \fBTcl_EvalTokens\fR,
+used only for error reporting;
+if NULL, then no error messages are left after errors.
+For \fBTcl_EvalTokens\fR, determines the context for evaluating the
+script and also is used for error reporting; must not be NULL.
+.AP char *string in
+Pointer to first character in string to parse.
+.AP int numBytes in
+Number of bytes in \fIstring\fR, not including any terminating null
+character. If less than 0 then the script consists of all characters
+in \fIstring\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.
+.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
+\fI*parsePtr\fR is uninitialized; any information in it is ignored.
+This argument is normally 0.
+.AP Tcl_Parse *parsePtr out
+Points to structure to fill in with information about the parsed
+command, expression, variable name, etc.
+Any previous information in this structure
+is ignored, unless \fIappend\fR is non-zero in a call to
+\fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR,
+or \fBTcl_ParseVarName\fR.
+.AP char **termPtr out
+If not NULL, points to a location where
+\fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and
+\fBTcl_ParseVar\fR will store a pointer to the character
+just after the terminating character (the close-brace, the last
+character of the variable name, or the close-quote (respectively))
+if the parse was successful.
+.AP Tcl_Parse *usedParsePtr in
+Points to structure that was filled in by a previous call to
+\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseVarName\fR, etc.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures parse Tcl commands or portions of Tcl commands such as
+expressions or references to variables.
+Each procedure takes a pointer to a script (or portion thereof)
+and fills in the structure pointed to by \fIparsePtr\fR
+with a collection of tokens describing the information that was parsed.
+The procedures normally return \fBTCL_OK\fR.
+However, if an error occurs then they return \fBTCL_ERROR\fR,
+leave an error message in \fIinterp's\fR result
+(if \fIinterp\fR is not NULL),
+and leave nothing in \fIparsePtr\fR.
+.PP
+\fBTcl_ParseCommand\fR is a procedure that parses Tcl
+scripts. Given a pointer to a script, it
+parses the first command from the script. If the command was parsed
+successfully, \fBTcl_ParseCommand\fR returns \fBTCL_OK\fR and fills in the
+structure pointed to by \fIparsePtr\fR with information about the
+structure of the command (see below for details).
+If an error occurred in parsing the command then
+\fBTCL_ERROR\fR is returned, an error message is left in \fIinterp\fR's
+result, and no information is left at \fI*parsePtr\fR.
+.PP
+\fBTcl_ParseExpr\fR parses Tcl expressions.
+Given a pointer to a script containing an expression,
+\fBTcl_ParseCommand\fR parses the expression.
+If the expression was parsed successfully,
+\fBTcl_ParseExpr\fR returns \fBTCL_OK\fR and fills in the
+structure pointed to by \fIparsePtr\fR with information about the
+structure of the expression (see below for details).
+If an error occurred in parsing the command then
+\fBTCL_ERROR\fR is returned, an error message is left in \fIinterp\fR's
+result, and no information is left at \fI*parsePtr\fR.
+.PP
+\fBTcl_ParseBraces\fR parses a string or command argument
+enclosed in braces such as
+\fB{hello}\fR or \fB{string \\t with \\t tabs}\fR
+from the beginning of its argument \fIstring\fR.
+The first character of \fIstring\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
+with information about the structure of the string
+(see below for details),
+and stores a pointer to the character just after the terminating \fB}\fR
+in the location given by \fI*termPtr\fR.
+If an error occurrs while parsing the string
+then \fBTCL_ERROR\fR is returned,
+an error message is left in \fIinterp\fR's result,
+and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
+.PP
+\fBTcl_ParseQuotedString\fR parses a double-quoted string such as
+\fB"sum is [expr $a+$b]"\fR
+from the beginning of the argument \fIstring\fR.
+The first character of \fIstring\fR must be \fB"\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
+with information about the structure of the string
+(see below for details),
+and stores a pointer to the character just after the terminating \fB"\fR
+in the location given by \fI*termPtr\fR.
+If an error occurrs while parsing the string
+then \fBTCL_ERROR\fR is returned,
+an error message is left in \fIinterp\fR's result,
+and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
+.PP
+\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
+\fIstring\fR argument.
+The first character of \fIstring\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
+(see below for details). If an error
+occurrs while parsing the command then \fBTCL_ERROR\fR is returned, an
+error message is left in \fIinterp\fR's result (if \fIinterp\fR isn't
+NULL), and no information is left at \fI*parsePtr\fR.
+.PP
+\fBTcl_ParseVar\fR parse a Tcl variable reference such as \fB$abc\fR
+or \fB$x([expr $index + 1])\fR from the beginning of its \fIstring\fR
+argument. The first character of \fIstring\fR must be \fB$\fR. If
+the variable name is parsed successfully, \fBTcl_ParseVar\fR returns a
+pointer to the string value of the variable. If an error occurs while
+parsing, then NULL is returned and an error message is left in
+\fIinterp\fR's result.
+.PP
+The information left at \fI*parsePtr\fR
+by \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
+\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR
+may include dynamically allocated memory.
+If these five parsing procedures return \fBTCL_OK\fR
+then the caller must invoke \fBTcl_FreeParse\fR to release
+the storage at \fI*parsePtr\fR.
+These procedures ignore any existing information in
+\fI*parsePtr\fR (unless \fIappend\fR is non-zero),
+so if repeated calls are being made to any of them
+then \fBTcl_FreeParse\fR must be invoked once after each call.
+.PP
+\fBTcl_EvalTokens\fR evaluates a sequence of parse tokens from 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_EvalTokens\fR performs the
+substitutions requested by the tokens, concatenates the
+resulting values, and returns the result in a new Tcl_Obj. The
+reference count of the object returned as result has been
+incremented, so the caller must
+invoke \fBTcl_DecrRefCount\fR when it is finished with the object.
+If an error occurs while evaluating the tokens (such as a reference to
+a non-existent variable) then the return value is NULL and an error
+message is left in \fIinterp\fR's result.
+
+.SH "TCL_PARSE STRUCTURE"
+.PP
+\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
+\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR
+return parse information in two data structures, Tcl_Parse and Tcl_Token:
+.CS
+typedef struct Tcl_Parse {
+ char *\fIcommentStart\fR;
+ int \fIcommentSize\fR;
+ char *\fIcommandStart\fR;
+ int \fIcommandSize\fR;
+ int \fInumWords\fR;
+ Tcl_Token *\fItokenPtr\fR;
+ int \fInumTokens\fR;
+ ...
+} Tcl_Parse;
+
+typedef struct Tcl_Token {
+ int \fItype\fR;
+ char *\fIstart\fR;
+ int \fIsize\fR;
+ int \fInumComponents\fR;
+} Tcl_Token;
+.CE
+.PP
+The first five fields of a Tcl_Parse structure
+are filled in only by \fBTcl_ParseCommand\fR.
+These fields are not used by the other parsing procedures.
+.PP
+\fBTcl_ParseCommand\fR fills in a Tcl_Parse structure
+with information that describes one Tcl command and any comments that
+precede the command.
+If there are comments,
+the \fIcommentStart\fR field points to the \fB#\fR character that begins
+the first comment and \fIcommentSize\fR indicates the number of bytes
+in all of the comments preceding the command, including the newline
+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
+\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
+terminates the command. The \fInumWords\fR field gives the
+total number of words in the command.
+.PP
+All parsing procedures set the remaining fields,
+\fItokenPtr\fR and \fInumTokens\fR.
+The \fItokenPtr\fR field points to the first in an array of Tcl_Token
+structures that describe the components of the entity being parsed.
+The \fInumTokens\fR field gives the total number of tokens
+present in the array.
+Each token contains four fields.
+The \fItype\fR field selects one of several token types
+that are described below. The \fIstart\fR field
+points to the first character in the token and the \fIsize\fR field
+gives the total number of characters in the token. Some token types,
+such as \fBTCL_TOKEN_WORD\fR and \fBTCL_TOKEN_VARIABLE\fR, consist of
+several component tokens, which immediately follow the parent token;
+the \fInumComponents\fR field describes how many of these there are.
+The \fItype\fR field has one of the following values:
+.TP 20
+\fBTCL_TOKEN_WORD\fR
+This token ordinarily describes one word of a command
+but it may also describe a quoted or braced string in an expression.
+The token describes a component of the script that is
+the result of concatenating together a sequence of subcomponents,
+each described by a separate subtoken.
+The token starts with the first non-blank
+character of the component (which may be a double-quote or open brace)
+and includes all characters in the component up to but not including the
+space, semicolon, close bracket, close quote, or close brace that
+terminates the component. The \fInumComponents\fR field counts the total
+number of sub-tokens that make up the word, including sub-tokens
+of \fBTCL_TOKEN_VARIABLE\fR and \fBTCL_TOKEN_BS\fR tokens.
+.TP
+\fBTCL_TOKEN_SIMPLE_WORD\fR
+This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that
+the word is guaranteed to consist of a single \fBTCL_TOKEN_TEXT\fR
+sub-token. The \fInumComponents\fR field is always 1.
+.TP
+\fBTCL_TOKEN_TEXT\fR
+The token describes a range of literal text that is part of a word.
+The \fInumComponents\fR field is always 0.
+.TP
+\fBTCL_TOKEN_BS\fR
+The token describes a backslash sequence such as \fB\en\fR or \fB\e0xa3\fR.
+The \fInumComponents\fR field is always 0.
+.TP
+\fBTCL_TOKEN_COMMAND\fR
+The token describes a command whose result result must be substituted into
+the word. The token includes the square brackets that surround the
+command. The \fInumComponents\fR field is always 0 (the nested command
+is not parsed; call \fBTcl_ParseCommand\fR recursively if you want to
+see its tokens).
+.TP
+\fBTCL_TOKEN_VARIABLE\fR
+The token describes a variable substitution, including the
+\fB$\fR, variable name, and array index (if there is one) up through the
+close parenthesis that terminates the index. This token is followed
+by one or more additional tokens that describe the variable name and
+array index. If \fInumComponents\fR is 1 then the variable is a
+scalar and the next token is a \fBTCL_TOKEN_TEXT\fR token that gives the
+variable name. If \fInumComponents\fR is greater than 1 then the
+variable is an array: the first sub-token is a \fBTCL_TOKEN_TEXT\fR
+token giving the array name and the remaining sub-tokens are
+\fBTCL_TOKEN_TEXT\fR, \fBTCL_TOKEN_BS\fR, \fBTCL_TOKEN_COMMAND\fR, and
+\fBTCL_TOKEN_VARIABLE\fR tokens that must be concatenated to produce the
+array index. The \fInumComponents\fR field includes nested sub-tokens
+that are part of \fBTCL_TOKEN_VARIABLE\fR tokens in the array index.
+.TP
+\fBTCL_TOKEN_SUB_EXPR\fR
+The token describes one subexpression of an expression
+(or an entire expression).
+A subexpression may consist of a value
+such as an integer literal, variable substitution,
+or parenthesized subexpression;
+it may also consist of an operator and its operands.
+The token starts with the first non-blank character of the subexpression
+up to but not including the space, brace, close-paren, or bracket
+that terminates the subexpression.
+This token is followed by one or more additional tokens
+that describe the subexpression.
+If the first sub-token after the \fBTCL_TOKEN_SUB_EXPR\fR token
+is a \fBTCL_TOKEN_OPERATOR\fR token,
+the subexpression consists of an operator and its token operands.
+If the operator has no operands, the subexpression consists of
+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_VARIABLE\fR, and \fBTCL_TOKEN_SUB_EXPR\fR.
+The \fInumComponents\fR field
+counts the total number of sub-tokens that make up the subexpression;
+this includes the sub-tokens for any nested \fBTCL_TOKEN_SUB_EXPR\fR tokens.
+.TP
+\fBTCL_TOKEN_OPERATOR\fR
+The token describes one operator of an expression
+such as \fB&&\fR or \fBhypot\fR.
+An \fBTCL_TOKEN_OPERATOR\fR token is always preceeded by a
+\fBTCL_TOKEN_SUB_EXPR\fR token
+that describes the operator and its operands;
+the \fBTCL_TOKEN_SUB_EXPR\fR token's \fInumComponents\fR field
+can be used to determine the number of operands.
+A binary operator such as \fB*\fR
+is followed by two \fBTCL_TOKEN_SUB_EXPR\fR tokens
+that describe its operands.
+A unary operator like \fB-\fR
+is followed by a single \fBTCL_TOKEN_SUB_EXPR\fR token
+for its operand.
+If the operator is a math function such as \fBlog10\fR,
+the \fBTCL_TOKEN_OPERATOR\fR token will give its name and
+the following \fBTCL_TOKEN_SUB_EXPR\fR tokens will describe
+its operands;
+if there are no operands (as with \fBrand\fR),
+no \fBTCL_TOKEN_SUB_EXPR\fR tokens follow.
+There is one trinary operator, \fB?\fR,
+that appears in if-then-else subexpressions
+such as \fIx\fB?\fIy\fB:\fIz\fR;
+in this case, the \fB?\fR \fBTCL_TOKEN_OPERATOR\fR token
+is followed by three \fBTCL_TOKEN_SUB_EXPR\fR tokens for the operands
+\fIx\fR, \fIy\fR, and \fIz\fR.
+The \fInumComponents\fR field for a \fBTCL_TOKEN_OPERATOR\fR token
+is always 0.
+.PP
+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. 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
+token for the second word, followed by sub-tokens for that
+word, and so on until all \fInumWords\fR have been accounted
+for.
+.PP
+After \fBTcl_ParseExpr\fR returns, the first token pointed to by
+the \fItokenPtr\fR field of the
+Tcl_Parse structure always has type \fBTCL_TOKEN_SUB_EXPR\fR.
+It is followed by the sub-tokens that must be evaluated
+to produce the value of the expression.
+Only the token information in the Tcl_Parse structure
+is modified: the \fIcommentStart\fR, \fIcommentSize\fR,
+\fIcommandStart\fR, and \fIcommandSize\fR fields are not modified
+by \fBTcl_ParseExpr\fR.
+.PP
+After \fBTcl_ParseBraces\fR returns,
+the array of tokens pointed to by the \fItokenPtr\fR field of the
+Tcl_Parse structure will contain a single \fBTCL_TOKEN_TEXT\fR token
+if the braced string does not contain any backslash-newlines.
+If the string does contain backslash-newlines,
+the array of tokens will contain one or more
+\fBTCL_TOKEN_TEXT\fR or \fBTCL_TOKEN_BS\fR sub-tokens
+that must be concatenated to produce the value of the string.
+If the braced string was just \fB{}\fR
+(that is, the string was empty),
+the single \fBTCL_TOKEN_TEXT\fR token will have a \fIsize\fR field
+containing zero;
+this ensures that at least one token appears
+to describe the braced string.
+Only the token information in the Tcl_Parse structure
+is modified: the \fIcommentStart\fR, \fIcommentSize\fR,
+\fIcommandStart\fR, and \fIcommandSize\fR fields are not modified
+by \fBTcl_ParseBraces\fR.
+.PP
+After \fBTcl_ParseQuotedString\fR returns,
+the array of tokens pointed to by the \fItokenPtr\fR field of the
+Tcl_Parse structure depends on the contents of the quoted string.
+It will consist of one or more \fBTCL_TOKEN_TEXT\fR, \fBTCL_TOKEN_BS\fR,
+\fBTCL_TOKEN_COMMAND\fR, and \fBTCL_TOKEN_VARIABLE\fR sub-tokens.
+The array always contains at least one token;
+for example, if the argument \fIstring\fR is empty,
+the array returned consists of a single \fBTCL_TOKEN_TEXT\fR token
+with a zero \fIsize\fR field.
+Only the token information in the Tcl_Parse structure
+is modified: the \fIcommentStart\fR, \fIcommentSize\fR,
+\fIcommandStart\fR, and \fIcommandSize\fR fields are not modified.
+.PP
+After \fBTcl_ParseVarName\fR returns, the first token pointed to by
+the \fItokenPtr\fR field of the
+Tcl_Parse structure always has type \fBTCL_TOKEN_VARIABLE\fR. It
+is followed by the sub-tokens that make up the variable name as
+described above. The total length of the variable name is
+contained in the \fIsize\fR field of the first token.
+As in \fBTcl_ParseExpr\fR,
+only the token information in the Tcl_Parse structure
+is modified by \fBTcl_ParseVarName\fR:
+the \fIcommentStart\fR, \fIcommentSize\fR,
+\fIcommandStart\fR, and \fIcommandSize\fR fields are not modified.
+.PP
+All of the character pointers in the
+Tcl_Parse and Tcl_Token structures refer
+to characters in the \fIstring\fR argument passed to
+\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
+\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR.
+.PP
+There are additional fields in the Tcl_Parse structure after the
+\fInumTokens\fR field, but these are for the private use of
+\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
+\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR; they should not be
+referenced by code outside of these procedures.
+
+.SH KEYWORDS
+backslash substitution, braces, command, expression, parse, token, variable substitution
+
diff --git a/tcl/doc/PkgRequire.3 b/tcl/doc/PkgRequire.3
index 30ef5bea84e..e797c51f1dd 100644
--- a/tcl/doc/PkgRequire.3
+++ b/tcl/doc/PkgRequire.3
@@ -10,7 +10,7 @@
.TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_PkgRequire, Tcl_PkgProvide \- package version control
+Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx \- package version control
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -18,10 +18,22 @@ Tcl_PkgRequire, Tcl_PkgProvide \- package version control
char *
\fBTcl_PkgRequire\fR(\fIinterp, name, version, exact\fR)
.sp
+char *
+\fBTcl_PkgRequireEx\fR(\fIinterp, name, version, exact, clientDataPtr\fR)
+.sp
+char *
+\fBTcl_PkgPresent\fR(\fIinterp, name, version, exact\fR)
+.sp
+char *
+\fBTcl_PkgPresentEx\fR(\fIinterp, name, version, exact, clientDataPtr\fR)
+.sp
int
\fBTcl_PkgProvide\fR(\fIinterp, name, version\fR)
+.sp
+int
+\fBTcl_PkgProvideEx\fR(\fIinterp, name, version, clientData\fR)
.SH ARGUMENTS
-.AS Tcl_FreeProc clientData
+.AS Tcl_FreeProc clientDataPtr
.AP Tcl_Interp *interp in
Interpreter where package is needed or available.
.AP char *name in
@@ -35,25 +47,42 @@ Non-zero means that only the particular version specified by
Zero means that newer versions than \fIversion\fR are also
acceptable as long as they have the same major version number
as \fIversion\fR.
+.AP ClientData clientData in
+Arbitrary value to be associated with the package.
+.AP ClientData *clientDataPtr out
+Pointer to place to store the value associated with the matching
+package. It is only changed if the pointer is not NULL and the
+function completed successfully.
.BE
.SH DESCRIPTION
.PP
These procedures provide C-level interfaces to Tcl's package and
version management facilities.
+.PP
\fBTcl_PkgRequire\fR is equivalent to the \fBpackage require\fR
+command, \fBTcl_PkgPresent\fR is equivalent to the \fBpackage present\fR
command, and \fBTcl_PkgProvide\fR is equivalent to the
\fBpackage provide\fR command.
+.PP
See the documentation for the Tcl commands for details on what these
procedures do.
-If \fBTcl_PkgRequire\fR completes successfully it returns 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 it returns NULL and leaves an error message in
-\fIinterp->result\fR.
+.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
+message in the interpreter's result.
+.PP
\fBTcl_PkgProvide\fR returns TCL_OK if it completes successfully;
if an error occurs it returns TCL_ERROR and leaves an error message
-in \fIinterp->result\fR.
+in the interpreter's result.
+.PP
+\fBTcl_PkgProvideEx\fR, \fBTcl_PkgPresentEx\fR and \fBTcl_PkgRequireEx\fR
+allow the setting and retrieving of the client data associated with
+the package. In all other respects they are equivalent to the matching
+functions.
.SH KEYWORDS
-package, provide, require, version
+package, present, provide, require, version
+
diff --git a/tcl/doc/RecEvalObj.3 b/tcl/doc/RecEvalObj.3
index 4697a886817..d3b301da4a0 100644
--- a/tcl/doc/RecEvalObj.3
+++ b/tcl/doc/RecEvalObj.3
@@ -33,15 +33,15 @@ the command at global level instead of the current stack level.
.SH DESCRIPTION
.PP
\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
-on the history list and then execute it using \fBTcl_EvalObj\fR
+on the history list and then execute it using \fBTcl_EvalObjEx\fR
(or \fBTcl_GlobalEvalObj\fR if the TCL_EVAL_GLOBAL bit is set
in \fIflags\fR).
-It returns a completion code such as TCL_OK just like \fBTcl_EvalObj\fR,
+It returns a completion code such as TCL_OK just like \fBTcl_EvalObjEx\fR,
as well as a result object containing additional information
(a result value or error message)
that can be retrieved using \fBTcl_GetObjResult\fR.
If you don't want the command recorded on the history list then
-you should invoke \fBTcl_EvalObj\fR instead of \fBTcl_RecordAndEvalObj\fR.
+you should invoke \fBTcl_EvalObjEx\fR instead of \fBTcl_RecordAndEvalObj\fR.
Normally \fBTcl_RecordAndEvalObj\fR is only called with top-level
commands typed by the user, since the purpose of history is to
allow the user to re-issue recently-invoked commands.
@@ -49,7 +49,8 @@ If the \fIflags\fR argument contains the TCL_NO_EVAL bit then
the command is recorded without being evaluated.
.SH "SEE ALSO"
-Tcl_EvalObj, Tcl_GetObjResult
+Tcl_EvalObjEx, Tcl_GetObjResult
.SH KEYWORDS
command, event, execute, history, interpreter, object, record
+
diff --git a/tcl/doc/RecordEval.3 b/tcl/doc/RecordEval.3
index 9cbba275f7c..6a52832542b 100644
--- a/tcl/doc/RecordEval.3
+++ b/tcl/doc/RecordEval.3
@@ -36,7 +36,7 @@ the command at global level instead of the current stack level.
on the history list and then execute it using \fBTcl_Eval\fR
(or \fBTcl_GlobalEval\fR if the TCL_EVAL_GLOBAL bit is set in \fIflags\fR).
It returns a completion code such as TCL_OK just like \fBTcl_Eval\fR
-and it leaves information in \fIinterp->result\fR.
+and it leaves information in the interpreter's result.
If you don't want the command recorded on the history list then
you should invoke \fBTcl_Eval\fR instead of \fBTcl_RecordAndEval\fR.
Normally \fBTcl_RecordAndEval\fR is only called with top-level
@@ -55,3 +55,4 @@ Tcl_RecordAndEvalObj
.SH KEYWORDS
command, event, execute, history, interpreter, record
+
diff --git a/tcl/doc/RegExp.3 b/tcl/doc/RegExp.3
index 4aabc933a55..a9774546249 100644
--- a/tcl/doc/RegExp.3
+++ b/tcl/doc/RegExp.3
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1998-1999 Scriptics Corportation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,15 +9,18 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_RegExpMatch 3 7.4 Tcl "Tcl Library Procedures"
+.TH Tcl_RegExpMatch 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange \- Pattern matching with regular expressions
+Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange, Tcl_GetRegExpFromObj, Tcl_RegExpMatchObj, Tcl_RegExpExecObj, Tcl_RegExpGetInfo \- Pattern matching with regular expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
+\fBTcl_RegExpMatchObj\fR(\fIinterp\fR, \fIstrObj\fR, \fIpatObj\fR)
+.sp
+int
\fBTcl_RegExpMatch\fR(\fIinterp\fR, \fIstring\fR, \fIpattern\fR)
.sp
Tcl_RegExp
@@ -26,17 +30,38 @@ int
\fBTcl_RegExpExec\fR(\fIinterp\fR, \fIregexp\fR, \fIstring\fR, \fIstart\fR)
.sp
\fBTcl_RegExpRange\fR(\fIregexp\fR, \fIindex\fR, \fIstartPtr\fR, \fIendPtr\fR)
+.VS 8.1
+.sp
+Tcl_RegExp
+\fBTcl_GetRegExpFromObj\fR(\fIinterp\fR, \fIpatObj\fR, \fIcflags\fR)
+.sp
+int
+\fBTcl_RegExpExecObj\fR(\fIinterp\fR, \fIregexp\fR, \fIobjPtr\fR, \fIoffset\fR, \fInmatches\fR, \fIeflags\fR)
+.sp
+\fBTcl_RegExpGetInfo\fR(\fIregexp\fR, \fIinfoPtr\fR)
+.VE 8.1
+
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
-Tcl interpreter to use for error reporting.
+Tcl interpreter to use for error reporting. The interpreter may be
+NULL if no error reporting is desired.
+.VS 8.1
+.AP Tcl_Obj *strObj in/out
+Refers to the object from which to get the string to search. The
+internal representation of the object may be converted to a form that
+can be efficiently searched.
+.AP Tcl_Obj *patObj in/out
+Refers to the object from which to get a regular expression. The
+compiled regular expression is cached in the object.
+.VE 8.1
.AP char *string in
String to check for a match with a regular expression.
.AP char *pattern in
String in the form of a regular expression pattern.
.AP Tcl_RegExp regexp in
Compiled regular expression. Must have been returned previously
-by \fBTcl_RegExpCompile\fR.
+by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
.AP char *start in
If \fIstring\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
@@ -52,19 +77,50 @@ NULL if there is no such range.
.AP char **endPtr out
The address of the character just after the last one in the range
is stored here, or NULL if there is no such range.
+.VS 8.1
+.AP int cflags in
+OR-ed combination of compilation flags. See below for more information.
+.AP Tcl_Obj *objPtr in/out
+An object which contains the string to check for a match with a
+regular expression.
+.AP int offset in
+The character offset into the string where matching should begin.
+The value of the offset has no impact on \fB^\fR matches. This
+behavior is controlled by \fIeflags\fR.
+.AP int nmatches in
+The number of matching subexpressions that should be remembered for
+later use. If this value is 0, then no subexpression match
+information will be computed. If the value is -1, then
+all of the matching subexpressions will be remembered. Any other
+value will be taken as the maximum number of subexpressions to
+remember.
+.AP int eflags in
+OR-ed combination of the values TCL_REG_NOTBOL and TCL_REG_NOTEOL.
+See below for more information.
+.AP Tcl_RegExpInfo *infoPtr out
+The address of the location where information about a previous match
+should be stored by \fBTcl_RegExpGetInfo\fR.
+.VE 8.1
.BE
.SH DESCRIPTION
.PP
\fBTcl_RegExpMatch\fR determines whether its \fIpattern\fR argument
matches \fIregexp\fR, where \fIregexp\fR is interpreted
-as a regular expression using the same rules as for the
-\fBregexp\fR Tcl command.
+as a regular expression using the rules in the \fBre_syntax\fR
+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
is not a valid regular expression) then \fBTcl_RegExpMatch\fR
-returns \-1 and leaves an error message in \fIinterp->result\fR.
+returns \-1 and leaves an error message in the interpreter result.
+.VS 8.1.2
+\fBTcl_RegExpMatchObj\fR is similar to \fBTcl_RegExpMatch\fR except it
+operates on the Tcl objects \fIstrObj\fR and \fIpatObj\fR instead of
+UTF strings.
+\fBTcl_RegExpMatchObj\fR is generally more efficient than
+\fBTcl_RegExpMatch\fR, so it is the preferred interface.
+.VE 8.1.2
.PP
\fBTcl_RegExpCompile\fR, \fBTcl_RegExpExec\fR, and \fBTcl_RegExpRange\fR
provide lower-level access to the regular expression pattern matcher.
@@ -74,7 +130,7 @@ The return value is a token for this compiled form, which can be
used in subsequent calls to \fBTcl_RegExpExec\fR or \fBTcl_RegExpRange\fR.
If an error occurs while compiling the regular expression then
\fBTcl_RegExpCompile\fR returns NULL and leaves an error message
-in \fIinterp->result\fR.
+in the interpreter result.
Note: the return value from \fBTcl_RegExpCompile\fR is only valid
up to the next call to \fBTcl_RegExpCompile\fR; it is not safe to
retain these values for long periods of time.
@@ -84,7 +140,7 @@ It returns 1 if \fIstring\fR contains a range of characters that
match \fIregexp\fR, 0 if no match is found, and
\-1 if an error occurs.
In the case of an error, \fBTcl_RegExpExec\fR leaves an error
-message in \fIinterp->result\fR.
+message in the interpreter result.
When searching a string for multiple matches of a pattern,
it is important to distinguish between the start of the original
string and the start of the current search.
@@ -111,6 +167,181 @@ information is returned about the range of characters that matched the
\fIindex\fR'th parenthesized subexpression within the pattern.
If there is no range corresponding to \fIindex\fR then NULL
is stored in \fI*firstPtr\fR and \fI*lastPtr\fR.
-
+.PP
+.VS 8.1
+\fBTcl_GetRegExpFromObj\fR, \fBTcl_RegExpExecObj\fR, and
+\fBTcl_RegExpGetInfo\fR are object interfaces that provide the most
+direct control of Henry Spencer's regular expression library. For
+users that need to modify compilation and execution options directly,
+it is recommended that you use these interfaces instead of calling the
+internal regexp functions. These interfaces handle the details of UTF
+to Unicode translations as well as providing improved performance
+through caching in the pattern and string objects.
+.PP
+\fBTcl_GetRegExpFromObj\fR attepts to return a compiled regular
+expression from the \fIpatObj\fR. If the object does not already
+contain a compiled regular expression it will attempt to create one
+from the string in the object and assign it to the internal
+representation of the \fIpatObj\fR. The return value of this function
+is of type \fBTcl_RegExp\fR. The return value is a token for this
+compiled form, which can be used in subsequent calls to
+\fBTcl_RegExpExecObj\fR or \fBTcl_RegExpGetInfo\fR. If an error
+occurs while compiling the regular expression then
+\fBTcl_GetRegExpFromObj\fR returns NULL and leaves an error message in
+the interpreter result. The regular expression token can be used as
+long as the internal representation of \fIpatObj\fR refers to the
+compiled form. The \fIeflags\fR argument is a bitwise OR of
+zero or more of the following flags that control the compilation of
+\fIpatObj\fR:
+.RS 2
+.TP
+\fBTCL_REG_ADVANCED\fR
+Compile advanced regular expressions (`AREs'). This mode corresponds to
+the normal regular expression syntax accepted by the Tcl regexp and
+regsub commands.
+.TP
+\fBTCL_REG_EXTENDED\fR
+Compile extended regular expressions (`EREs'). This mode corresponds
+to the regular expression syntax recognized by Tcl 8.0 and earlier
+versions.
+.TP
+\fBTCL_REG_BASIC\fR
+Compile basic regular expressions (`BREs'). This mode corresponds
+to the regular expression syntax recognized by common Unix utilities
+like \fBsed\fR and \fBgrep\fR. This is the default if no flags are
+specified.
+.TP
+\fBTCL_REG_EXPANDED\fR
+Compile the regular expression (basic, extended, or advanced) using an
+expanded syntax that allows comments and whitespace. This mode causes
+non-backslashed non-bracket-expression white
+space and #-to-end-of-line comments to be ignored.
+.TP
+\fBTCL_REG_QUOTE\fR
+Compile a literal string, with all characters treated as ordinary characters.
+.TP
+\fBTCL_REG_NOCASE\fR
+Compile for matching that ignores upper/lower case distinctions.
+.TP
+\fBTCL_REG_NEWLINE\fR
+Compile for newline-sensitive matching. By default, newline is a
+completely ordinary character with no special meaning in either
+regular expressions or strings. With this flag, `[^' bracket
+expressions and `.' never match newline, `^' matches an empty string
+after any newline in addition to its normal function, and `$' matches
+an empty string before any newline in addition to its normal function.
+\fBREG_NEWLINE\fR is the bitwise OR of \fBREG_NLSTOP\fR and
+\fBREG_NLANCH\fR.
+.TP
+\fBTCL_REG_NLSTOP\fR
+Compile for partial newline-sensitive matching,
+with the behavior of
+`[^' bracket expressions and `.' affected,
+but not the behavior of `^' and `$'. In this mode, `[^' bracket
+expressions and `.' never match newline.
+.TP
+\fBTCL_REG_NLANCH\fR
+Compile for inverse partial newline-sensitive matching,
+with the behavior of
+of `^' and `$' (the ``anchors'') affected, but not the behavior of
+`[^' bracket expressions and `.'. In this mode `^' matches an empty string
+after any newline in addition to its normal function, and `$' matches
+an empty string before any newline in addition to its normal function.
+.TP
+\fBTCL_REG_NOSUB\fR
+Compile for matching that reports only success or failure,
+not what was matched. This reduces compile overhead and may improve
+performance. Subsequent calls to \fBTcl_RegExpGetInfo\fR or
+\fBTcl_RegExpRange\fR will not report any match information.
+.TP
+\fBTCL_REG_CANMATCH\fR
+Compile for matching that reports the potential to complete a partial
+match given more text (see below).
+.RE
+.PP
+Only one of
+\fBTCL_REG_EXTENDED\fR,
+\fBTCL_REG_ADVANCED\fR,
+\fBTCL_REG_BASIC\fR, and
+\fBTCL_REG_QUOTE\fR may be specified.
+.PP
+\fBTcl_RegExpExecObj\fR executes the regular expression pattern
+matcher. It returns 1 if \fIobjPtr\fR contains a range of characters
+that match \fIregexp\fR, 0 if no match is found, and \-1 if an error
+occurs. In the case of an error, \fBTcl_RegExpExecObj\fR leaves an
+error message in the interpreter result. The \fInmatches\fR value
+indicates to the matcher how many subexpressions are of interest. If
+\fInmatches\fR is 0, then no subexpression match information is
+recorded, which may allow the matcher to make various optimizations.
+If the value is -1, then all of the subexpressions in the pattern are
+remembered. If the value is a positive integer, then only that number
+of subexpressions will be remembered. Matching begins at the
+specified Unicode character index given by \fIoffset\fR. Unlike
+\fBTcl_RegExpExec\fR, the behavior of anchors is not affected by the
+offset value. Instead the behavior of the anchors is explicitly
+controlled by the \fIeflags\fR argument, which is a bitwise OR of
+zero or more of the following flags:
+.RS 2
+.TP
+\fBTCL_REG_NOTBOL\fR
+The starting character will not be treated as the beginning of a
+line or the beginning of the string, so `^' will not match there.
+Note that this flag has no effect on how `\fB\eA\fR' matches.
+.TP
+\fBTCL_REG_NOTEOL\fR
+The last character in the string will not be treated as the end of a
+line or the end of the string, so '$' will not match there.
+Note that this flag has no effect on how `\fB\eZ\fR' matches.
+.RE
+.PP
+\fBTcl_RegExpGetInfo\fR retrieves information about the last match
+performed with a given regular expression \fIregexp\fR. The
+\fIinfoPtr\fR argument contains a pointer to a structure that is
+defined as follows:
+.PP
+.CS
+typedef struct Tcl_RegExpInfo {
+ int \fInsubs\fR;
+ Tcl_RegExpIndices *\fImatches\fR;
+ long \fIextendStart\fR;
+} Tcl_RegExpInfo;
+.CE
+.PP
+The \fInsubs\fR field contains a count of the number of parenthesized
+subexpressions within the regular expression. If the \fBTCL_REG_NOSUB\fR
+was used, then this value will be zero. The \fImatches\fR field
+points to an array of \fInsubs\fR values that indicate the bounds of each
+subexpression matched. The first element in the array refers to the
+range matched by the entire regular expression, and subsequent elements
+refer to the parenthesized subexpressions in the order that they
+appear in the pattern. Each element is a structure that is defined as
+follows:
+.PP
+.CS
+typedef struct Tcl_RegExpIndices {
+ long \fIstart\fR;
+ long \fIend\fR;
+} Tcl_RegExpIndices;
+.CE
+.PP
+The \fIstart\fR and \fIend\fR values are Unicode character indices
+relative to the offset location within \fIobjPtr\fR where matching began.
+The \fIstart\fR index identifies the first character of the matched
+subexpression. The \fIend\fR index identifies the first character
+after the matched subexpression. If the subexpression matched the
+empty string, then \fIstart\fR and \fIend\fR will be equal. If the
+subexpression did not participate in the match, then \fIstart\fR and
+\fIend\fR will be set to -1.
+.PP
+The \fIextendStart\fR field in \fBTcl_RegExpInfo\fR is only set if the
+\fBTCL_REG_CANMATCH\fR flag was used. It indicates the first
+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.
+.VE 8.1
+.SH "SEE ALSO"
+re_syntax(n)
.SH KEYWORDS
-match, pattern, regular expression, string, subexpression
+match, pattern, regular expression, string, subexpression, Tcl_RegExpIndices, Tcl_RegExpInfo
+
diff --git a/tcl/doc/SaveResult.3 b/tcl/doc/SaveResult.3
new file mode 100644
index 00000000000..ba6e257f175
--- /dev/null
+++ b/tcl/doc/SaveResult.3
@@ -0,0 +1,65 @@
+'\"
+'\" Copyright (c) 1997 by Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's result
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_SaveResult(\fIinterp, statePtr\fB)\fR
+.sp
+\fBTcl_RestoreResult(\fIinterp, statePtr\fB)\fR
+.sp
+\fBTcl_DiscardResult(\fIstatePtr\fB)\fR
+.SH ARGUMENTS
+.AS Tcl_SavedResult statePtr
+.AP Tcl_Interp *interp in
+Interpreter for which state should be saved.
+.AP Tcl_SavedResult *statePtr in
+Pointer to location where interpreter result should be saved or restored.
+.BE
+
+.SH DESCRIPTION
+.PP
+These routines allows a C procedure to take a snapshot of the current
+interpreter result so that it can be restored after a call
+to \fBTcl_Eval\fR or some other routine that modifies the interpreter
+result. These routines are passed a pointer to a structure that is
+used to store enough information to restore the interpreter result
+state. This structure can be allocated on the stack of the calling
+procedure. These routines do not save the state of any error
+information in the interpreter (e.g. the \fBerrorCode\fR or
+\fBerrorInfo\fR variables).
+.PP
+\fBTcl_SaveResult\fR moves the string and object results
+of \fIinterp\fR into the location specified by \fIstatePtr\fR.
+\fBTcl_SaveResult\fR clears the result for \fIinterp\fR and
+leaves the result in its normal empty initialized state.
+.PP
+\fBTcl_RestoreResult\fR moves the string and object results from
+\fIstatePtr\fR back into \fIinterp\fR. Any result or error that was
+already in the interpreter will be cleared. The \fIstatePtr\fR is left
+in an uninitialized state and cannot be used until another call to
+\fBTcl_SaveResult\fR.
+.PP
+\fBTcl_DiscardResult\fR releases the saved interpreter state
+stored at \fBstatePtr\fR. The state structure is left in an
+uninitialized state and cannot be used until another call to
+\fBTcl_SaveResult\fR.
+.PP
+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.
+
+.SH KEYWORDS
+result, state, interp
diff --git a/tcl/doc/SetErrno.3 b/tcl/doc/SetErrno.3
index 2385c484036..a764ed558ec 100644
--- a/tcl/doc/SetErrno.3
+++ b/tcl/doc/SetErrno.3
@@ -6,10 +6,10 @@
'\"
'\" RCS: @(#) $Id$
.so man.macros
-.TH Tcl_SetErrno 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_SetErrno 3 8.3 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_SetErrno, Tcl_GetErrno \- manipulate errno to store and retrieve error codes
+Tcl_SetErrno, Tcl_GetErrno, Tcl_ErrnoId, Tcl_ErrnoMsg \- manipulate errno to store and retrieve error codes
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -20,6 +20,12 @@ void
int
\fBTcl_GetErrno\fR()
.sp
+char *
+\fBTcl_ErrnoId\fR()
+.sp
+char *
+\fBTcl_ErrnoMsg\fR()
+.sp
.SH ARGUMENTS
.AS Tcl_Interp *errorCode in
.AP int errorCode in
@@ -43,6 +49,13 @@ via \fBerrno\fR should call \fBTcl_SetErrno\fR rather than setting
\fBTcl_GetErrno\fR returns the current value of \fBerrno\fR.
Procedures wishing to access \fBerrno\fR should call this procedure
instead of accessing \fBerrno\fR directly.
+.PP
+\fBTcl_ErrnoId\fR and \fBTcl_ErrnoMsg\fR return a string
+representation of the current \fBerrno\fR value. \fBTcl_ErrnoId\fR
+returns a machine-readable textual identifier such as
+"EACCES". \fBTcl_ErrnoMsg\fR returns a human-readable string such as
+"permission denied". The strings returned by these functions are
+statically allocated and the caller must not free or modify them.
.SH KEYWORDS
errno, error code, global variables
diff --git a/tcl/doc/SetRecLmt.3 b/tcl/doc/SetRecLmt.3
index 33ab852f35c..164782378eb 100644
--- a/tcl/doc/SetRecLmt.3
+++ b/tcl/doc/SetRecLmt.3
@@ -41,7 +41,7 @@ allowable nesting depth for an interpreter.
The \fIdepth\fR argument specifies a new limit for \fIinterp\fR,
and \fBTcl_SetRecursionLimit\fR returns the old limit.
To read out the old limit without modifying it, invoke
-\fBTcl_SetRecursionDepth\fR with \fIdepth\fR equal to 0.
+\fBTcl_SetRecursionLimit\fR with \fIdepth\fR equal to 0.
.PP
The \fBTcl_SetRecursionLimit\fR only sets the size of the Tcl
call stack: it cannot by itself prevent stack overflows on the
diff --git a/tcl/doc/SetResult.3 b/tcl/doc/SetResult.3
index 918843c1224..6a571ceee3d 100644
--- a/tcl/doc/SetResult.3
+++ b/tcl/doc/SetResult.3
@@ -8,10 +8,10 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_SetResult 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult \- manipulate Tcl result
+Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_FreeResult \- manipulate Tcl result
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -28,6 +28,8 @@ char *
.sp
\fBTcl_AppendResult\fR(\fIinterp, string, string, ... , \fB(char *) NULL\fR)
.sp
+\fBTcl_AppendResultVA\fR(\fIinterp, argList\fR)
+.sp
\fBTcl_AppendElement\fR(\fIinterp, string\fR)
.sp
\fBTcl_ResetResult\fR(\fIinterp\fR)
@@ -46,6 +48,9 @@ appended to the existing result.
Address of procedure to call to release storage at
\fIstring\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or
\fBTCL_VOLATILE\fR.
+.AP va_list argList in
+An argument list which must have been initialised using
+\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
.BE
.SH DESCRIPTION
@@ -112,7 +117,7 @@ and the result is left as a empty string.
\fBTcl_AddErrorInfo\fR, \fBTcl_AddObjErrorInfo\fR,
and \fBTcl_SetErrorCode\fR.
-.SH OLD STRING PROCEDURES
+.SH "OLD STRING PROCEDURES"
.PP
Use of the following procedures is deprecated
since they manipulate the Tcl result as a string.
@@ -137,6 +142,9 @@ to a string, if necessary, before appending the argument strings.
Any number of \fIstring\fR arguments may be passed in a single
call; the last argument in the list must be a NULL pointer.
.PP
+\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that
+instead of taking a variable number of arguments it takes an argument list.
+.PP
\fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in
that it allows results to be built up in pieces.
However, \fBTcl_AppendElement\fR takes only a single \fIstring\fR
@@ -162,7 +170,7 @@ change \fIinterp->result\fR or clear error state.
\fBTcl_FreeResult\fR is most commonly used when a procedure
is about to replace one result value with another.
-.SH DIRECT ACCESS TO INTERP->RESULT IS DEPRECATED
+.SH "DIRECT ACCESS TO INTERP->RESULT IS DEPRECATED"
.PP
It used to be legal for programs to
directly read and write \fIinterp->result\fR
@@ -173,7 +181,7 @@ Programs should always read the result
using the procedures \fBTcl_GetObjResult\fR or \fBTcl_GetStringResult\fR,
and write the result using \fBTcl_SetObjResult\fR or \fBTcl_SetResult\fR.
-.SH THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT
+.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
the Tcl system is to manage the storage for the \fIstring\fR argument.
@@ -215,3 +223,4 @@ Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp
.SH KEYWORDS
append, command, element, list, object, result, return value, interpreter
+
diff --git a/tcl/doc/SetVar.3 b/tcl/doc/SetVar.3
index 7de2f44651d..ce2b4ed7a62 100644
--- a/tcl/doc/SetVar.3
+++ b/tcl/doc/SetVar.3
@@ -8,90 +8,155 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_SetVar 3 7.4 Tcl "Tcl Library Procedures"
+.TH Tcl_SetVar 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_SetVar, Tcl_SetVar2, Tcl_GetVar, Tcl_GetVar2, Tcl_UnsetVar, Tcl_UnsetVar2 \- manipulate Tcl variables
+Tcl_SetVar2Ex, Tcl_SetVar, Tcl_SetVar2, Tcl_ObjSetVar2, Tcl_GetVar2Ex, Tcl_GetVar, Tcl_GetVar2, Tcl_ObjGetVar2, Tcl_UnsetVar, Tcl_UnsetVar2 \- manipulate Tcl variables
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
+.VS 8.1
+Tcl_Obj *
+\fBTcl_SetVar2Ex\fR(\fIinterp, name1, name2, newValuePtr, flags\fR)
+.VE
+.sp
char *
\fBTcl_SetVar\fR(\fIinterp, varName, newValue, flags\fR)
.sp
char *
\fBTcl_SetVar2\fR(\fIinterp, name1, name2, newValue, flags\fR)
.sp
+Tcl_Obj *
+\fBTcl_ObjSetVar2\fR(\fIinterp, part1Ptr, part2Ptr, newValuePtr, flags\fR)
+.sp
+.VS 8.1
+Tcl_Obj *
+\fBTcl_GetVar2Ex\fR(\fIinterp, name1, name2, flags\fR)
+.VE
+.sp
char *
\fBTcl_GetVar\fR(\fIinterp, varName, flags\fR)
.sp
char *
\fBTcl_GetVar2\fR(\fIinterp, name1, name2, flags\fR)
.sp
+Tcl_Obj *
+\fBTcl_ObjGetVar2\fR(\fIinterp, part1Ptr, part2Ptr, flags\fR)
+.sp
int
\fBTcl_UnsetVar\fR(\fIinterp, varName, flags\fR)
.sp
int
\fBTcl_UnsetVar2\fR(\fIinterp, name1, name2, flags\fR)
.SH ARGUMENTS
-.AS Tcl_Interp *newValue
+.AS Tcl_Interp *newValuePtr
.AP Tcl_Interp *interp in
Interpreter containing variable.
+.AP char *name1 in
+Contains the name of an array variable (if \fIname2\fR is non-NULL)
+or (if \fIname2\fR is NULL) either the name of a scalar variable
+or a complete name including both variable name and index.
+May include \fB::\fR namespace qualifiers
+to specify a variable in a particular namespace.
+.AP char *name2 in
+If non-NULL, gives name of element within array; in this
+case \fIname1\fR must refer to an array variable.
+.AP Tcl_Obj *newValuePtr in
+.VS 8.1
+Points to a Tcl object containing the new value for the variable.
+.VE
+.AP int flags in
+OR-ed combination of bits providing additional information. See below
+for valid values.
.AP char *varName in
Name of variable.
-May include a series of \fB::\fR namespace qualifiers
+May include \fB::\fR namespace qualifiers
to specify a variable in a particular namespace.
May refer to a scalar variable or an element of
-an array variable.
-If the name references an element of an array, then it
+an array.
+If the name references an element of an array, then the name
must be in writable memory: Tcl will make temporary modifications
to it while looking up the name.
.AP char *newValue in
-New value for variable.
-.AP int flags in
-OR-ed combination of bits providing additional information for
-operation. See below for valid values.
-.AP char *name1 in
-Name of scalar variable, or name of array variable if \fIname2\fR
-is non-NULL.
-May include a series of \fB::\fR namespace qualifiers
+New value for variable, specified as a NULL-terminated string.
+A copy of this value is stored in the variable.
+.AP Tcl_Obj *part1Ptr in
+Points to a Tcl object containing the variable's name.
+The name may include a series of \fB::\fR namespace qualifiers
to specify a variable in a particular namespace.
-.AP char *name2 in
-If non-NULL, gives name of element within array and \fIname1\fR
-must refer to an array variable.
+May refer to a scalar variable or an element of an array variable.
+.AP Tcl_Obj *part2Ptr in
+If non-NULL, points to an object containing the name of an element
+within an array and \fIpart1Ptr\fR must refer to an array variable.
.BE
.SH DESCRIPTION
.PP
-These procedures may be used to create, modify, read, and delete
+These procedures are used to create, modify, read, and delete
Tcl variables from C code.
.PP
-Note that \fBTcl_GetVar\fR and \fBTcl_SetVar\fR
-have been largely replaced by the
-object-based procedures \fBTcl_ObjGetVar2\fR and \fBTcl_ObjSetVar2\fR.
-Those object-based procedures read, modify, and create
-a variable whose name is held in a Tcl object instead of a string.
-They also return a pointer to the object
-which is the variable's value instead of returning a string.
-Operations on objects can be faster since objects
-hold an internal representation that can be manipulated more efficiently.
-.PP
-\fBTcl_SetVar\fR and \fBTcl_SetVar2\fR
+.VS 8.1
+\fBTcl_SetVar2Ex\fR, \fBTcl_SetVar\fR, \fBTcl_SetVar2\fR, and
+\fBTcl_ObjSetVar2\fR
will create a new variable or modify an existing one.
-Both of these procedures set the given variable to the value
-given by \fInewValue\fR, and they return a pointer to a
-copy of the variable's new value, which is stored in Tcl's
+These procedures set the given variable to the value
+given by \fInewValuePtr\fR or \fInewValue\fR and return a
+pointer to the variable's new value, which is stored in Tcl's
variable structure.
-Tcl keeps a private copy of the variable's value, so the caller
-may change \fInewValue\fR after these procedures return without
-affecting the value of the variable.
+\fBTcl_SetVar2Ex\fR and \fBTcl_ObjSetVar2\fR take the new value as a
+Tcl_Obj and return
+a pointer to a Tcl_Obj. \fBTcl_SetVar\fR and \fBTcl_SetVar2\fR
+take the new value as a string and return a string; they are
+usually less efficient than \fBTcl_ObjSetVar2\fR. Note that the
+return value may be different than the \fInewValuePtr\fR or
+.VE
+\fInewValue\fR argument, due to modifications made by write traces.
If an error occurs in setting the variable (e.g. an array
-variable is referenced without giving an index into the array),
-they return NULL.
+variable is referenced without giving an index into the array)
+NULL is returned and an error message is left in \fIinterp\fR's
+result if the \fBTCL_LEAVE_ERR_MSG\fR \fIflag\fR bit is set.
+.PP
+.VS 8.1
+\fBTcl_GetVar2Ex\fR, \fBTcl_GetVar\fR, \fBTcl_GetVar2\fR, and
+\fBTcl_ObjGetVar2\fR
+return the current value of a variable.
+The arguments to these procedures are treated in the same way
+as the arguments to the procedures described above.
+Under normal circumstances, the return value is a pointer
+to the variable's value. For \fBTcl_GetVar2Ex\fR and
+\fBTcl_ObjGetVar2\fR the value is
+returned as a pointer to a Tcl_Obj. For \fBTcl_GetVar\fR and
+\fBTcl_GetVar2\fR the value is returned as a string; this is
+usually less efficient, so \fBTcl_GetVar2Ex\fR or \fBTcl_ObjGetVar2\fR
+are preferred.
+.VE
+If an error occurs while reading the variable (e.g. the variable
+doesn't exist or an array element is specified for a scalar
+variable), then NULL is returned and an error message is left
+in \fIinterp\fR's result if the \fBTCL_LEAVE_ERR_MSG\fR \fIflag\fR
+bit is set.
.PP
-The name of the variable may be specified to
-\fBTcl_SetVar\fR and \fBTcl_SetVar2\fR in either of two ways.
-If \fBTcl_SetVar\fR is called, the variable name is given as
+\fBTcl_UnsetVar\fR and \fBTcl_UnsetVar2\fR may be used to remove
+a variable, so that future attempts to read the variable will return
+an error.
+The arguments to these procedures are treated in the same way
+as the arguments to the procedures above.
+If the variable is successfully removed then TCL_OK is returned.
+If the variable cannot be removed because it doesn't exist then
+TCL_ERROR is returned and an error message is left
+in \fIinterp\fR's result if the \fBTCL_LEAVE_ERR_MSG\fR \fIflag\fR
+bit is set.
+If an array element is specified, the given element is removed
+but the array remains.
+If an array name is specified without an index, then the entire
+array is removed.
+.PP
+The name of a variable may be specified to these procedures in
+four ways:
+.IP [1]
+If \fBTcl_SetVar\fR, \fBTcl_GetVar\fR, or \fBTcl_UnsetVar\fR
+is invoked, the variable name is given as
a single string, \fIvarName\fR.
If \fIvarName\fR contains an open parenthesis and ends with a
close parenthesis, then the value between the parentheses is
@@ -100,22 +165,31 @@ the characters before the first open
parenthesis are treated as the name of an array variable.
If \fIvarName\fR doesn't have parentheses as described above, then
the entire string is treated as the name of a scalar variable.
-If \fBTcl_SetVar2\fR is called, then the array name and index
-have been separated by the caller into two separate strings,
-\fIname1\fR and \fIname2\fR respectively; if \fIname2\fR is
-zero it means that a scalar variable is being referenced.
+.IP [2]
+If the \fIname1\fR and \fIname2\fR arguments are provided and
+\fIname2\fR is non-NULL, then an array element is specified and
+the array name and index have
+already been separated by the caller: \fIname1\fR contains the
+name and \fIname2\fR contains the index.
+.VS 8.1
+An error is generated
+if \fIname1\fR contains an open parenthesis and ends with a
+close parenthesis (array element) and \fIname2\fR is non-NULL.
+.IP [3]
+If \fIname2\fR is NULL, \fIname1\fR is treated just like
+\fIvarName\fR in case [1] above (it can be either a scalar or an array
+element variable name).
+.VE
.PP
The \fIflags\fR argument may be used to specify any of several
options to the procedures.
It consists of an OR-ed combination of the following bits.
-Note that the flag bit TCL_PARSE_PART1 is only meaningful
-for the procedures Tcl_SetVar2 and Tcl_GetVar2.
.TP
\fBTCL_GLOBAL_ONLY\fR
-Under normal circumstances the procedures look up variables as follows:
+Under normal circumstances the procedures look up variables as follows.
If a procedure call is active in \fIinterp\fR,
-a variable is looked up at the current level of procedure call.
-Otherwise, a variable is looked up first in the current namespace,
+the variable is looked up at the current level of procedure call.
+Otherwise, the variable is looked up first in the current namespace,
then in the global namespace.
However, if this bit is set in \fIflags\fR then the variable
is looked up only in the global namespace
@@ -124,14 +198,10 @@ If both \fBTCL_GLOBAL_ONLY\fR and \fBTCL_NAMESPACE_ONLY\fR are given,
\fBTCL_GLOBAL_ONLY\fR is ignored.
.TP
\fBTCL_NAMESPACE_ONLY\fR
-Under normal circumstances the procedures look up variables as follows:
-If a procedure call is active in \fIinterp\fR,
-a variable is looked up at the current level of procedure call.
-Otherwise, a variable is looked up first in the current namespace,
-then in the global namespace.
-However, if this bit is set in \fIflags\fR then the variable
-is looked up only in the current namespace
-even if there is a procedure call active.
+If this bit is set in \fIflags\fR then the variable
+is looked up only in the current namespace; if a procedure is active
+its variables are ignored, and the global namespace is also ignored unless
+it is the current namespace.
.TP
\fBTCL_LEAVE_ERR_MSG\fR
If an error is returned and this bit is set in \fIflags\fR, then
@@ -142,9 +212,10 @@ If this flag bit isn't set then no error message is left
and the interpreter's result will not be modified.
.TP
\fBTCL_APPEND_VALUE\fR
-If this bit is set then \fInewValue\fR is appended to the current
-value, instead of replacing it.
-If the variable is currently undefined, then this bit is ignored.
+If this bit is set then \fInewValuePtr\fR or \fInewValue\fR is
+appended to the current value instead of replacing it.
+If the variable is currently undefined, then the bit is ignored.
+This bit is only used by the \fBTcl_Set*\fR procedures.
.TP
\fBTCL_LIST_ELEMENT\fR
If this bit is set, then \fInewValue\fR is converted to a valid
@@ -153,18 +224,6 @@ A separator space is appended before the new list element unless
the list element is going to be the first element in a list or
sublist (i.e. the variable's current value is empty, or contains
the single character ``{'', or ends in `` }'').
-.TP
-\fBTCL_PARSE_PART1\fR
-If this bit is set when calling \fITcl_SetVar2\fR and \fITcl_GetVar2\fR,
-\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
-treated as an element name (which can have any string value) and
-the characters before the first open
-parenthesis are treated as the name of an array variable.
-If the flag TCL_PARSE_PART1 is given,
-\fIname2\fR should be NULL since the array and element names
-are taken from \fIname1\fR.
.PP
\fBTcl_GetVar\fR and \fBTcl_GetVar2\fR
return the current value of a variable.
@@ -178,8 +237,6 @@ or \fBTcl_SetVar2\fR).
and TCL_LEAVE_ERR_MSG, both of
which have
the same meaning as for \fBTcl_SetVar\fR.
-In addition, \fBTcl_GetVar2\fR uses the bit TCL_PARSE_PART1,
-which has the same meaning as for \fBTcl_SetVar2\fR.
If an error occurs in reading the variable (e.g. the variable
doesn't exist or an array element is specified for a scalar
variable), then NULL is returned.
@@ -198,7 +255,7 @@ If an array name is specified without an index, then the entire
array is removed.
.SH "SEE ALSO"
-Tcl_GetObjResult, Tcl_GetStringResult, Tcl_ObjGetVar2, Tcl_ObjSetVar2, Tcl_TraceVar
+Tcl_GetObjResult, Tcl_GetStringResult, Tcl_TraceVar
.SH KEYWORDS
-array, interpreter, object, scalar, set, unset, variable
+array, get variable, interpreter, object, scalar, set, unset, variable
diff --git a/tcl/doc/SourceRCFile.3 b/tcl/doc/SourceRCFile.3
new file mode 100644
index 00000000000..8991763fafb
--- /dev/null
+++ b/tcl/doc/SourceRCFile.3
@@ -0,0 +1,38 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+'\"
+.so man.macros
+.TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SourceRCFile \- source the Tcl rc file
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+void
+\fBTcl_SourceRCFile\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AP Tcl_Interp *interp in
+Tcl interpreter to source rc file into.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_SourceRCFile\fR is used to source the Tcl rc file at startup.
+It is typically invoked by Tcl_Main or Tk_Main. The name of the file
+sourced is obtained from the global variable \fBtcl_rcFileName\fR in
+the interpreter given by \fIinterp\fR. If this variable is not
+defined, or if the file it indicates cannot be found, no action is
+taken.
+.PP
+On the Macintosh, after sourcing the rc file, this function will
+additionally source the TEXT resource indicated by the global variable
+\fBtcl_rcRsrcName\fR in \fIinterp\fR.
+
+.SH KEYWORDS
+application-specific initialization, main program, rc file
diff --git a/tcl/doc/SplitList.3 b/tcl/doc/SplitList.3
index 8db202d2117..0dd0c023ab0 100644
--- a/tcl/doc/SplitList.3
+++ b/tcl/doc/SplitList.3
@@ -8,10 +8,10 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_SplitList 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_SplitList 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_SplitList, Tcl_Merge, Tcl_ScanElement, Tcl_ConvertElement \- manipulate Tcl lists
+Tcl_SplitList, Tcl_Merge, Tcl_ScanElement, Tcl_ConvertElement, Tcl_ScanCountedElement, Tcl_ConvertCountedElement \- manipulate Tcl lists
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -24,26 +24,20 @@ char *
.sp
int
\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
-.VS
.sp
int
\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
-.VE
.sp
int
\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
-.VS
.sp
int
\fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR)
-.VE
.SH ARGUMENTS
.AS Tcl_Interp ***argvPtr
.AP Tcl_Interp *interp out
-.VS
Interpreter to use for error reporting. If NULL, then no error message
is left.
-.VE
.AP char *list in
Pointer to a string with proper list structure.
.AP int *argcPtr out
@@ -63,10 +57,8 @@ String that is to become an element of a list.
.AP int *flagsPtr in
Pointer to word to fill in with information about \fIsrc\fR.
The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR.
-.VS
.AP int length in
Number of bytes in string \fIsrc\fR.
-.VE
.AP char *dst in
Place to copy converted list element. Must contain enough characters
to hold converted string.
@@ -99,19 +91,15 @@ code = Tcl_SplitList(interp, string, &argc, &argv);
.CE
Then you should eventually free the storage with a call like the
following:
-.VS
.CS
Tcl_Free((char *) argv);
.CE
-.VE
.PP
\fBTcl_SplitList\fR normally returns \fBTCL_OK\fR, which means the list was
successfully parsed.
If there was a syntax error in \fIlist\fR, then \fBTCL_ERROR\fR is returned
-and \fIinterp->result\fR will point to an error message describing the
-.VS
+and the interpreter's result will point to an error message describing the
problem (if \fIinterp\fR was not NULL).
-.VE
If \fBTCL_ERROR\fR is returned then no memory is allocated and \fI*argvPtr\fR
is not modified.
.PP
@@ -126,11 +114,9 @@ it will be parsed into \fIargc\fR words whose values will
be the same as the \fIargv\fR strings passed to \fBTcl_Merge\fR.
\fBTcl_Merge\fR will modify the list elements with braces and/or
backslashes in order to produce proper Tcl list structure.
-.VS
The result string is dynamically allocated
using \fBTcl_Alloc\fR; the caller must eventually release the space
using \fBTcl_Free\fR.
-.VE
.PP
If the result of \fBTcl_Merge\fR is passed to \fBTcl_SplitList\fR,
the elements returned by \fBTcl_SplitList\fR will be identical to
@@ -180,12 +166,11 @@ used to generate a portion of an argument for a Tcl command.
In this case, surrounding \fIsrc\fR with curly braces would cause
the command not to be parsed correctly.
.PP
-.VS
\fBTcl_ScanCountedElement\fR and \fBTcl_ConvertCountedElement\fR are
the same as \fBTcl_ScanElement\fR and \fBTcl_ConvertElement\fR, except
the length of string \fIsrc\fR is specified by the \fIlength\fR
argument, and the string may contain embedded nulls.
-.VE
.SH KEYWORDS
backslash, convert, element, list, merge, split, strings
+
diff --git a/tcl/doc/StaticPkg.3 b/tcl/doc/StaticPkg.3
index f5295d215bb..d19d2f15642 100644
--- a/tcl/doc/StaticPkg.3
+++ b/tcl/doc/StaticPkg.3
@@ -57,14 +57,14 @@ following prototype:
.CS
typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR);
.CE
-The \fIinterp\fR argument identifies the interpreter in which the
-package is to be loaded. The initialization procedure must return
-\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
-successfully; in the event of an error it should set \fIinterp->result\fR
-to point to an error message.
-The result or error from the initialization procedure will be returned
-as the result of the \fBload\fR command that caused the
+The \fIinterp\fR argument identifies the interpreter in which the package
+is to be loaded. The initialization procedure must return \fBTCL_OK\fR or
+\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in
+the event of an error it should set the interpreter's result to point to an
+error message. The result or error from the initialization procedure will
+be returned as the result of the \fBload\fR command that caused the
initialization procedure to be invoked.
.SH KEYWORDS
initialization procedure, package, static linking
+
diff --git a/tcl/doc/StrMatch.3 b/tcl/doc/StrMatch.3
index ea17d0b17f1..f291d96823c 100644
--- a/tcl/doc/StrMatch.3
+++ b/tcl/doc/StrMatch.3
@@ -8,22 +8,31 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_StringMatch 3 "" Tcl "Tcl Library Procedures"
+.TH Tcl_StringMatch 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_StringMatch \- test whether a string matches a pattern
+Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_StringMatch\fR(\fIstring\fR, \fIpattern\fR)
+.VS 8.1
+.sp
+\fBTcl_StringCaseMatch\fR(\fIstring, pattern, nocase\fR)
+.VE 8.1
.SH ARGUMENTS
.AP char *string in
String to test.
.AP char *pattern in
Pattern to match against string. May contain special
characters from the set *?\e[].
+.VS 8.1
+.AP int nocase in
+Specifies whether the match should be done case-sensitive (0) or
+case-insensitive (1).
+.VE 8.1
.BE
.SH DESCRIPTION
@@ -34,6 +43,13 @@ a given pattern. If it does, then \fBTcl_StringMatch\fR returns
used for matching is the same algorithm used in the ``string match''
Tcl command and is similar to the algorithm used by the C-shell
for file name matching; see the Tcl manual entry for details.
+.VS 8.1
+.PP
+In \fBTcl_StringCaseMatch\fR, the algorithm is the same, but you have
+the option to make the matching case-insensitive. If you choose this
+(by passing \fBnocase\fR as 1), then the string and pattern are
+essentially matched in the lower case.
+.VE 8.1
.SH KEYWORDS
match, pattern, string
diff --git a/tcl/doc/StringObj.3 b/tcl/doc/StringObj.3
index e3766ca5284..1d366b6135a 100644
--- a/tcl/doc/StringObj.3
+++ b/tcl/doc/StringObj.3
@@ -7,32 +7,74 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_StringObj 3 8.0 Tcl "Tcl Library Procedures"
+.TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewStringObj, Tcl_SetStringObj, Tcl_GetStringFromObj, Tcl_AppendToObj, Tcl_AppendStringsToObj, Tcl_SetObjLength, TclConcatObj \- manipulate Tcl objects as strings
+Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendObjToObj, Tcl_SetObjLength, Tcl_ConcatObj \- manipulate Tcl objects as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewStringObj\fR(\fIbytes, length\fR)
+.VS 8.1.2
.sp
+Tcl_Obj *
+\fBTcl_NewUnicodeObj\fR(\fIunicode, numChars\fR)
+.VE
+.sp
+void
\fBTcl_SetStringObj\fR(\fIobjPtr, bytes, length\fR)
+.VS 8.1.2
+.sp
+void
+\fBTcl_SetUnicodeObj\fR(\fIobjPtr, unicode, numChars\fR)
+.VE
.sp
char *
\fBTcl_GetStringFromObj\fR(\fIobjPtr, lengthPtr\fR)
.sp
+char *
+\fBTcl_GetString\fR(\fIobjPtr\fR)
+.VS 8.1.2
+.sp
+Tcl_UniChar *
+\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
+.sp
+Tcl_UniChar
+\fBTcl_GetUniChar\fR(\fIobjPtr, index\fR)
+.sp
+int
+\fBTcl_GetCharLength\fR(\fIobjPtr\fR)
+.sp
+Tcl_Obj *
+\fBTcl_GetRange\fR(\fIobjPtr, first, last\fR)
+.VE
+.sp
+void
\fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR)
+.VS 8.1.2
+.sp
+void
+\fBTcl_AppendUnicodeToObj\fR(\fIobjPtr, unicode, numChars\fR)
+.VE
.sp
+void
+\fBTcl_AppendObjToObj\fR(\fIobjPtr, appendObjPtr\fR)
+.sp
+void
\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR)
.sp
+void
+\fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR)
+.sp
+void
\fBTcl_SetObjLength\fR(\fIobjPtr, newLength\fR)
.sp
Tcl_Obj *
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.SH ARGUMENTS
-.AS Tcl_Interp *lengthPtr out
+.AS Tcl_Interp *appendObjPtr in/out
.AP char *bytes in
Points to the first byte of an array of bytes
used to set or append to a string object.
@@ -42,13 +84,37 @@ unless \fIlength\fR is negative.
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string object.
If negative, all bytes up to the first null are used.
+.AP Tcl_UniChar *unicode in
+Points to the first byte of an array of Unicode characters
+used to set or append to a string object.
+This byte array may contain embedded null characters
+unless \fInumChars\fR is negative.
+.VS 8.1.2
+.AP int numChars in
+The number of Unicode characters to copy from \fIunicode\fR when
+initializing, setting, or appending to a string object.
+If negative, all characters up to the first null character are used.
+.AP int index in
+The index of the Unicode character to return.
+.AP int first in
+The index of the first Unicode character in the Unicode range to be
+returned as a new object.
+.AP int last in
+The index of the last Unicode character in the Unicode range to be
+returned as a new object.
+.VE
.AP Tcl_Obj *objPtr in/out
Points to an object to manipulate.
+.AP Tcl_Obj *appendObjPtr in
+The object to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP int *lengthPtr out
If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
the the length of an object's string representation.
.AP char *string in
Null-terminated string value to append to \fIobjPtr\fR.
+.AP va_list argList in
+An argument list which must have been initialised using
+\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
.AP int newLength in
New length for the string value of \fIobjPtr\fR, not including the
final NULL character.
@@ -66,31 +132,75 @@ of the object to store additional information to make the string
manipulations more efficient. In particular, they make a series of
append operations efficient by allocating extra storage space for the
string so that it doesn't have to be copied for each append.
+.VS 8.1.2
+Also, indexing and length computations are optimized because the
+Unicode string representation is calculated and cached as needed.
+.VE
.PP
+.VS 8.1.2
\fBTcl_NewStringObj\fR and \fBTcl_SetStringObj\fR create a new object
-or modify an existing object to hold a copy of
-the string given by \fIbytes\fR and \fIlength\fR.
-\fBTcl_NewStringObj\fR returns a pointer to a newly created object
-with reference count zero.
-Both procedures set the object to hold a copy of the specified string.
-\fBTcl_SetStringObj\fR frees any old string representation
-as well as any old internal representation of the object.
+or modify an existing object to hold a copy of the string given by
+\fIbytes\fR and \fIlength\fR. \fBTcl_NewUnicodeObj\fR and
+\fBTcl_SetUnicodeObj\fR create a new object or modify an existing
+object to hold a copy of the Unicode string given by \fIunicode\fR and
+\fInumChars\fR. \fBTcl_NewStringObj\fR and \fBTcl_NewUnicodeObj\fR
+return a pointer to a newly created object with reference count zero.
+All four procedures set the object to hold a copy of the specified
+string. \fBTcl_SetStringObj\fR and \fBTcl_SetUnicodeObj\fR free any
+old string representation as well as any old internal representation
+of the object.
+.VE
+.PP
+\fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR return an object's
+string representation. This is given by the returned byte pointer and
+(for \fBTcl_GetStringFromObj\fR) length, which is stored in
+\fIlengthPtr\fR if it is non-NULL. If the object's UTF string
+representation is invalid (its byte pointer is NULL), the string
+representation is regenerated from the object's internal
+representation. The storage referenced by the returned byte pointer
+is owned by the object manager and should not be modified by the
+caller. The procedure \fBTcl_GetString\fR is used in the common case
+where the caller does not need the length of the string
+representation.
.PP
-\fBTcl_GetStringFromObj\fR returns an object's string representation.
-This is given by the returned byte pointer
-and length, which is stored in \fIlengthPtr\fR if it is non-NULL.
-If the object's string representation is invalid
-(its byte pointer is NULL),
-the string representation is regenerated from the
-object's internal representation.
-The storage referenced by the returned byte pointer
-is owned by the object manager and should not be modified by the caller.
+.VS 8.1.2
+\fBTcl_GetUnicode\fR returns an object's value as a Unicode string.
+\fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the
+object's Unicode representation.
+.PP
+\fBTcl_GetRange\fR returns a newly created object comprised of the
+characters between \fIfirst\fR and \fIlast\fR (inclusive) in the
+object's Unicode representation. If the object's Unicode
+representation is invalid, the Unicode representation is regenerated
+from the object's string representation.
+.PP
+\fBTcl_GetCharLength\fR returns the number of characters (as opposed
+to bytes) in the string object.
.PP
\fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and
-\fIlength\fR to the object specified by \fIobjPtr\fR. It does this
-in a way that handles repeated calls relatively efficiently (it
-overallocates the string space to avoid repeated reallocations
-and copies of object's string value).
+\fIlength\fR to the string representation of the object specified by
+\fIobjPtr\fR. If the object has an invalid string representation,
+then an attempt is made to convert \fIbytes\fR is to the Unicode
+format. If the conversion is successful, then the converted form of
+\fIbytes\fR is appended to the object's Unicode representation.
+Otherwise, the object's Unicode representation is invalidated and
+converted to the UTF format, and \fIbytes\fR is appended to the
+object's new string representation.
+.PP
+\fBTcl_AppendUnicodeToObj\fR appends the Unicode string given by
+\fIunicode\fR and \fInumChars\fR to the object specified by
+\fIobjPtr\fR. If the object has an invalid Unicode representation,
+then \fIunicode\fR is converted to the UTF format and appended to the
+object's string representation. Appends are optimized to handle
+repeated appends relatively efficiently (it overallocates the string
+or Unicode space to avoid repeated reallocations and copies of
+object's string value).
+.PP
+\fBTcl_AppendObjToObj\fR is similar to \fBTcl_AppendToObj\fR, but it
+appends the string or Unicode value (whichever exists and is best
+suited to be appended to \fIobjPtr\fR) of \fIappendObjPtr\fR to
+\fIobjPtr\fR.
+.VE
.PP
\fBTcl_AppendStringsToObj\fR is similar to \fBTcl_AppendToObj\fR
except that it can be passed more than one value to append and
@@ -99,6 +209,10 @@ values may contain internal null characters). Any number of
\fIstring\fR arguments may be provided, but the last argument
must be a NULL pointer to indicate the end of the list.
.PP
+\fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR
+except that instead of taking a variable number of arguments it takes an
+argument list.
+.PP
The \fBTcl_SetObjLength\fR procedure changes the length of the
string value of its \fIobjPtr\fR argument. If the \fInewLength\fR
argument is greater than the space allocated for the object's
@@ -129,4 +243,4 @@ Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount
.SH KEYWORDS
append, internal representation, object, object type, string object,
-string type, string representation, concat, concatenate
+string type, string representation, concat, concatenate, unicode
diff --git a/tcl/doc/TCL_MEM_DEBUG.3 b/tcl/doc/TCL_MEM_DEBUG.3
new file mode 100644
index 00000000000..1950d149a15
--- /dev/null
+++ b/tcl/doc/TCL_MEM_DEBUG.3
@@ -0,0 +1,81 @@
+'\"
+'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
+'\" Copyright (c) 2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging.
+
+.SH DESCRIPTION
+When Tcl is compiled with \fBTCL_MEM_DEBUG\fR defined, a powerful set
+of memory debugging aids are included in the compiled binary. This
+includes C and Tcl functions which can aid with debugging
+memory leaks, memory allocation overruns, and other memory related
+errors.
+
+.SH ENABLING MEMORY DEBUGGING
+.PP
+To enable memory debugging, Tcl should be recompiled from scratch with
+\fBTCL_MEM_DEBUG\fR defined. This will also compile in a non-stub
+version of \fBTcl_InitMemory\fR to add the \fBmemory\fR command to Tcl.
+.PP
+\fBTCL_MEM_DEBUG\fR must be either left defined for all modules or undefined
+for all modules that are going to be linked together. If they are not, link
+errors will occur, with either \fBTclDbCkfree\fR and \fBTcl_DbCkalloc\fR or
+\fBTcl_Ckalloc\fR and \fBTcl_Ckfree\fR being undefined.
+.PP
+Once memory debugging support has been compiled into Tcl, the C
+functions \fBTcl_ValidateAllMemory\fR, and \fBTcl_DumpActiveMemory\fR,
+and the Tcl \fBmemory\fR command can be used to validate and examine
+memory usage.
+
+.SH GUARD ZONES
+.PP
+When memory debugging is enabled, whenever a call to \fBckalloc\fR is
+made, slightly more memory than requested is allocated so the memory debugging
+code can keep track of the allocated memory, and eight-byte ``guard
+zones'' are placed in front of and behind the space that will be
+returned to the caller. (The size of the guard zone is defined by the
+C #define \fBGUARD_SIZE\fR in \fIbaseline/src/ckalloc.c\fR -- it can
+be extended if you suspect large overwrite problems, at some cost in
+performance.) A known pattern is written into the guard zones and, on
+a call to \fBckfree\fR, the guard zones of the space being freed are
+checked to see if either zone has been modified in any way. If one
+has been, the guard bytes and their new contents are identified, and a
+``low guard failed'' or ``high guard failed'' message is issued. The
+``guard failed'' message includes the address of the memory packet and
+the file name and line number of the code that called \fBckfree\fR.
+This allows you to detect the common sorts of one-off problems, where
+not enough space was allocated to contain the data written, for
+example.
+
+.SH DEBUGGING DIFFICULT MEMORY CORRUPTION PROBLEMS
+.PP
+Normally, Tcl compiled with memory debugging enabled will make it easy
+to isolate a corruption problem. Turning on memory validation with
+the memory command can help isolate difficult problems. If you
+suspect (or know) that corruption is occurring before the Tcl
+interpreter comes up far enough for you to issue commands, you can set
+\fBMEM_VALIDATE\fR define, recompile tclCkalloc.c and rebuild Tcl.
+This will enable memory validation from the first call to
+\fBckalloc\fR, again, at a large performance impact.
+.PP
+If you are desperate and validating memory on every call to
+\fBckalloc\fR and \fBckfree\fR isn't enough, you can explicitly call
+\fBTcl_ValidateAllMemory\fR directly at any point. It takes a \fIchar
+*\fR and an \fIint\fR which are normally the filename and line number
+of the caller, but they can actually be anything you want. Remember
+to remove the calls after you find the problem.
+
+.SH "SEE ALSO"
+memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
+
+.SH KEYWORDS
+memory, debug
+
+
diff --git a/tcl/doc/Tcl.n b/tcl/doc/Tcl.n
index 47f2faa3012..5462083de37 100644
--- a/tcl/doc/Tcl.n
+++ b/tcl/doc/Tcl.n
@@ -6,9 +6,9 @@
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" RCS: @(#) $Id$
-'
+'\"
.so man.macros
-.TH Tcl n "" Tcl "Tcl Built-In Commands"
+.TH Tcl n "8.1" Tcl "Tcl Built-In Commands"
.BS
.SH NAME
Tcl \- Summary of Tcl language syntax.
@@ -111,47 +111,61 @@ special processing.
The following table lists the backslash sequences that are
handled specially, along with the value that replaces each sequence.
.RS
-.TP 6
+.TP 7
\e\fBa\fR
Audible alert (bell) (0x7).
-.TP 6
+.TP 7
\e\fBb\fR
Backspace (0x8).
-.TP 6
+.TP 7
\e\fBf\fR
Form feed (0xc).
-.TP 6
+.TP 7
\e\fBn\fR
Newline (0xa).
-.TP 6
+.TP 7
\e\fBr\fR
Carriage-return (0xd).
-.TP 6
+.TP 7
\e\fBt\fR
Tab (0x9).
-.TP 6
+.TP 7
\e\fBv\fR
Vertical tab (0xb).
-.TP 6
+.TP 7
\e\fB<newline>\fIwhiteSpace\fR
-A single space character replaces the backslash, newline, and all
-spaces and tabs after the newline.
-This backslash sequence is unique in that it is replaced in a separate
-pre-pass before the command is actually parsed.
-This means that it will be replaced even when it occurs between
-braces, and the resulting space will be treated as a word separator
-if it isn't in braces or quotes.
-.TP 6
+.
+A single space character replaces the backslash, newline, and all spaces
+and tabs after the newline. This backslash sequence is unique in that it
+is replaced in a separate pre-pass before the command is actually parsed.
+This means that it will be replaced even when it occurs between braces,
+and the resulting space will be treated as a word separator if it isn't
+in braces or quotes.
+.TP 7
\e\e
Backslash (``\e'').
-.TP 6
-\e\fIooo\fR
-The digits \fIooo\fR (one, two, or three of them) give the octal value of
-the character.
-.TP 6
-\e\fBx\fIhh\fR
-The hexadecimal digits \fIhh\fR give the hexadecimal value of
-the character. Any number of digits may be present.
+.VS 8.1 br
+.TP 7
+\e\fIooo\fR
+.
+The digits \fIooo\fR (one, two, or three of them) give an eight-bit octal
+value for the Unicode character that will be inserted. The upper bits of the
+Unicode character will be 0.
+.TP 7
+\e\fBx\fIhh\fR
+.
+The hexadecimal digits \fIhh\fR give an eight-bit hexadecimal value for the
+Unicode character that will be inserted. Any number of hexadecimal digits
+may be present; however, all but the last two are ignored (the result is
+always a one-byte quantity). The upper bits of the Unicode character will
+be 0.
+.TP 7
+\e\fBu\fIhhhh\fR
+.
+The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
+sixteen-bit hexadecimal value for the Unicode character that will be
+inserted.
+.VE
.LP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
diff --git a/tcl/doc/TclInitStubs.3 b/tcl/doc/TclInitStubs.3
new file mode 100644
index 00000000000..aa12b8e6589
--- /dev/null
+++ b/tcl/doc/TclInitStubs.3
@@ -0,0 +1,91 @@
+'\"
+'\" Copyright (c) 1999 Scriptics Corportation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_InitStubs 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_InitStubs \- initialize the Tcl stubs mechanism
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+char *
+\fBTcl_InitStubs\fR(\fIinterp, version, exact\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp in
+.AP Tcl_Interp *interp in
+Tcl interpreter handle.
+.AP char *version in
+A version string consisting of one or more decimal numbers
+separated by dots.
+.AP int exact in
+Non-zero means that only the particular version specified by
+\fIversion\fR is acceptable.
+Zero means that versions newer than \fIversion\fR are also
+acceptable as long as they have the same major version number
+as \fIversion\fR.
+.BE
+.SH INTRODUCTION
+.PP
+The Tcl stubs mechanism defines a way to dynamically bind
+extensions to a particular Tcl implementation at run time.
+This provides two significant benefits to Tcl users:
+.IP 1) 5
+Extensions that use the stubs mechanism can be loaded into
+multiple versions of Tcl without being recompiled or
+relinked.
+.IP 2) 5
+Extensions that use the stubs mechanism can be dynamically
+loaded into statically-linked Tcl applications.
+.PP
+The stubs mechanism accomplishes this by exporting function tables
+that define an interface to the Tcl API. The extension then accesses
+the Tcl API through offsets into the function table, so there are no
+direct references to any of the Tcl library's symbols. This
+redirection is transparent to the extension, so an extension writer
+can continue to use all public Tcl functions as documented.
+.PP
+The stubs mechanism requires no changes to applications incorporating
+Tcl interpreters. Only developers creating C-based Tcl extensions
+need to take steps to use the stubs mechanism with their extensions.
+.PP
+Enabling the stubs mechanism for an extension requires the following
+steps:
+.IP 1) 5
+Call \fBTcl_InitStubs\fR in the extension before calling any other
+Tcl functions.
+.IP 2) 5
+Define the USE_TCL_STUBS symbol. Typically, you would include the
+-DUSE_TCL_STUBS flag when compiling the extension.
+.IP 3) 5
+Link the extension with the Tcl stubs library instead of the standard
+Tcl library. On Unix platforms, the library name is
+\fIlibtclstub8.1.a\fR; on Windows platforms, the library name is
+\fItclstub81.lib\fR.
+.PP
+If the extension also requires the Tk API, it must also call
+\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
+with the Tk stubs libraries. See the \fBTk_InitStubs\fR page for
+more information.
+.SH DESCRIPTION
+\fBTcl_InitStubs\fR attempts to initialize the stub table pointers
+and ensure that the correct version of Tcl is loaded. In addition
+to an interpreter handle, it accepts as arguments a version number
+and a Boolean flag indicating whether the extension requires
+an exact version match or not. If \fIexact\fR is 0, then the
+extension is indicating that newer versions of Tcl are acceptable
+as long as they have the same major version number as \fIversion\fR;
+non-zero means that only the specified \fIversion\fR is acceptable.
+\fBTcl_InitStubs\fR returns a string containing the actual version
+of Tcl satisfying the request, or NULL if the Tcl version is not
+acceptable, does not support stubs, or any other error condition occurred.
+.SH "SEE ALSO"
+\fBTk_InitStubs\fR
+.SH KEYWORDS
+stubs
diff --git a/tcl/doc/Thread.3 b/tcl/doc/Thread.3
new file mode 100644
index 00000000000..d2e2972b553
--- /dev/null
+++ b/tcl/doc/Thread.3
@@ -0,0 +1,195 @@
+'\"
+'\" Copyright (c) 1999 Scriptics Corporation
+'\" Copyright (c) 1998 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Threads 3 "8.1" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread \- Tcl thread support.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+void
+\fBTcl_ConditionNotify\fR(\fIcondPtr\fR)
+.sp
+void
+\fBTcl_ConditionWait\fR(\fIcondPtr, mutexPtr, timePtr\fR)
+.sp
+void
+\fBTcl_ConditionFinalize\fR(\fIcondPtr\fR)
+.sp
+Void *
+\fBTcl_GetThreadData\fR(\fIkeyPtr, size\fR)
+.sp
+void
+\fBTcl_MutexLock\fR(\fImutexPtr\fR)
+.sp
+void
+\fBTcl_MutexUnlock\fR(\fImutexPtr\fR)
+.sp
+void
+\fBTcl_MutexFinalize\fR(\fImutexPtr\fR)
+.sp
+int
+\fBTcl_CreateThread\fR(\fIidPtr, threadProc, clientData, stackSize, flags\fR)
+.SH ARGUMENTS
+.AS Tcl_ThreadDataKey *keyPtr
+.AP Tcl_Condition *condPtr in
+A condition variable, which must be associated with a mutex lock.
+.AP Tcl_Condition *mutexPtr in
+A mutex lock.
+.AP Tcl_Time *timePtr in
+A time limit on the condition wait. NULL to wait forever.
+Note that a polling value of 0 seconds doesn't make much sense.
+.AP Tcl_ThreadDataKey *keyPtr in
+This identifies a block of thread local storage. The key should be
+static and process-wide, yet each thread will end up associating
+a different block of storage with this key.
+.AP int *size in
+The size of the thread local storage block. This amount of data
+is allocated and initialized to zero the first time each thread
+calls \fBTcl_GetThreadData\fR.
+.AP Tcl_ThreadId *idPtr out
+The refered storage will contain the id of the newly created thread as
+returned by the operating system.
+.AP Tcl_ThreadId id in
+Id of the thread waited upon.
+.AP Tcl_ThreadCreateProc threadProc in
+This procedure will act as the \fBmain()\fR of the newly created
+thread. The specified \fIclientData\fR will be its sole argument.
+.AP ClientData clientData in
+Arbitrary information. Passed as sole argument to the \fIthreadProc\fR.
+.AP int stackSize in
+The size of the stack given to the new thread.
+.AP int flags in
+Bitmask containing flags allowing the caller to modify behaviour of
+the new thread.
+.AP int *result out
+The refered storage is used to place the exit code of the thread
+waited upon into it.
+.BE
+.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.
+.PP
+An important contstraint of the Tcl threads implementation is that
+\fIonly the thread that created a Tcl interpreter can use that
+interpreter\fR. In other words, multiple threads can not access
+the same Tcl interpreter. (However, as was the case in previous
+releases, a single thread can safely create and use multiple
+interpreters.)
+.PP
+.VS 8.3.1
+Tcl does provide \fBTcl_CreateThread\fR for creating threads. The
+caller can determine the size of the stack given to the new thread and
+modify the behaviour through the supplied \fIflags\fR. The value
+\fBTCL_THREAD_STACK_DEFAULT\fR for the \fIstackSize\fR indicates that
+the default size as specified by the operating system is to be used
+for the new thread. As for the flags, currently are only the values
+\fBTCL_THREAD_NOFLAGS\fR and \fBTCL_THREAD_JOINABLE\fR defined. The
+first of them invokes the default behaviour with no
+specialities. Using the second value marks the new thread as
+\fIjoinable\fR. This means that another thread can wait for the such
+marked thread to exit and join it.
+.PP
+Restrictions: On some unix systems the pthread-library does not
+contain the functionality to specify the stacksize of a thread. The
+specified value for the stacksize is ignored on these systems. Both
+Windows and Macintosh currently do not support joinable threads. This
+flag value is therefore ignored on these platforms.
+.VE
+.PP
+Tcl does provide \fBTcl_ExitThread\fR and \fBTcl_FinalizeThread\fR
+for terminating threads and invoking optional per-thread exit
+handlers. See the \fBTcl_Exit\fR page for more information on these
+procedures.
+.PP
+Tcl provides \fBTcl_ThreadQueueEvent\fR and \fBTcl_ThreadAlert\fR
+for handling event queueing in multithreaded applications. See
+the \fBNotifier\fR manual page for more information on these procedures.
+.PP
+In this release, the Tcl language itself provides no support for
+creating multithreaded scripts (for example, scripts that could spawn
+a Tcl interpreter in a separate thread). If you need to add this
+feature at this time, see the \fItclThreadTest.c\fR
+file in the Tcl source distribution for an experimental implementation
+of a Tcl "Thread" package implementing thread creation and management
+commands at the script level.
+
+.SH DESCRIPTION
+A mutex is a lock that is used to serialize all threads through a piece
+of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
+If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
+block until \fBTcl_MutexUnlock\fR is called.
+.VS
+A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.
+The result of locking a mutex twice from the same thread is undefined.
+On some platforms it will result in a deadlock.
+.VE
+The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
+procedures are defined as empty macros if not compiling with threads enabled.
+.PP
+A condition variable is used as a signaling mechanism:
+a thread can lock a mutex and then wait on a condition variable
+with \fBTcl_ConditionWait\fR. This atomically releases the mutex lock
+and blocks the waiting thread until another thread calls
+\fBTcl_ConditionNotify\fR. The caller of \fBTcl_ConditionNotify\fR should
+have the associated mutex held by previously calling \fBTcl_MutexLock\fR,
+but this is not enforced. Notifying the
+condition variable unblocks all threads waiting on the condition variable,
+but they do not proceed until the mutex is released with \fBTcl_MutexUnlock\fR.
+The implementation of \fBTcl_ConditionWait\fR automatically locks
+the mutex before returning.
+.PP
+The caller of \fBTcl_ConditionWait\fR should be prepared for spurious
+notifications by calling \fBTcl_ConditionWait\fR within a while loop
+that tests some invariant.
+.PP
+.VS
+A condition variable can be destroyed after its use by calling
+\fBTcl_ConditionFinalize\fR.
+.PP
+The \fBTcl_ConditionNotify\fR, \fBTcl_ConditionWait\fR and
+\fBTcl_ConditionFinalize\fR procedures are defined as empty macros if
+not compiling with threads enabled.
+.VE
+.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
+allocated and initialized to all zeros the first time each thread asks for it.
+The storage is automatically deallocated by \fBTcl_FinalizeThread\fR.
+.SH INITIALIZATION
+.PP
+All of these synchronization objects are self initializing.
+They are implemented as opaque pointers that should be NULL
+upon first use.
+The mutexes and condition variables are
+.VS
+either cleaned up by process exit handlers (if living that long) or
+explicitly by calls to \fBTcl_MutexFinalize\fR or
+\fBTcl_ConditionFinalize\fR.
+.VE
+Thread local storage is reclaimed during \fBTcl_FinalizeThread\fR.
+.SH "CREATING THREADS"
+The API to create threads is not finalized at this time.
+There are private facilities to create threads that contain a new
+Tcl interpreter, and to send scripts among threads.
+Dive into tclThreadTest.c and tclThread.c for examples.
+.SH "SEE ALSO"
+Tcl_GetCurrentThread, Tcl_ThreadQueueEvent, Tcl_ThreadAlert,
+Tcl_ExitThread, Tcl_FinalizeThread,
+Tcl_CreateThreadExitHandler, Tcl_DeleteThreadExitHandler
+.SH KEYWORDS
+thread, mutex, condition variable, thread local storage
+
diff --git a/tcl/doc/ToUpper.3 b/tcl/doc/ToUpper.3
new file mode 100644
index 00000000000..285c8917fc0
--- /dev/null
+++ b/tcl/doc/ToUpper.3
@@ -0,0 +1,90 @@
+'\"
+'\" Copyright (c) 1997 by Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures"
+.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.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_UniChar
+\fBTcl_UniCharToUpper\fR(\fIch\fR)
+.sp
+Tcl_UniChar
+\fBTcl_UniCharToLower\fR(\fIch\fR)
+.sp
+Tcl_UniChar
+\fBTcl_UniCharToTitle\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UtfToUpper\fR(\fIstr\fR)
+.sp
+int
+\fBTcl_UtfToLower\fR(\fIstr\fR)
+.sp
+int
+\fBTcl_UtfToTitle\fR(\fIstr\fR)
+.SH ARGUMENTS
+.AS char *str in/out
+.AP int ch in
+The Tcl_UniChar to be converted.
+.AP char *str in/out
+Pointer to UTF-8 string to be converted in place.
+.BE
+
+.SH DESCRIPTION
+.PP
+The first three routines convert the case of individual Unicode characters:
+.PP
+If \fIch\fR represents a lower-case character,
+\fBTcl_UniCharToUpper\fR returns the corresponding upper-case
+character. If no upper-case character is defined, it returns the
+character unchanged.
+.PP
+If \fIch\fR represents an upper-case character,
+\fBTcl_UniCharToLower\fR returns the corresponding lower-case
+character. If no lower-case character is defined, it returns the
+character unchanged.
+.PP
+If \fIch\fR represents a lower-case character,
+\fBTcl_UniCharToTitle\fR returns the corresponding title-case
+character. If no title-case character is defined, it returns the
+corresponding upper-case character. If no upper-case character is
+defined, it returns the character unchanged. Title-case is defined
+for a small number of characters that have a different appearance when
+they are at the beginning of a capitalized word.
+.PP
+The next three routines convert the case of UTF-8 strings in place in
+memory:
+.PP
+\fBTcl_UtfToUpper\fR changes every UTF-8 character in \fIstr\fR to
+upper-case. Because changing the case of a character may change its
+size, the byte offset of each character in the resulting string may
+differ from its original location. \fBTcl_UtfToUpper\fR writes a null
+byte at the end of the converted string. \fBTcl_UtfToUpper\fR returns
+the new length of the string in bytes. This new length is guaranteed
+to be no longer than the original string length.
+.PP
+\fBTcl_UtfToLower\fR is the same as \fBTcl_UtfToUpper\fR except it
+turns each character in the string into its lower-case equivalent.
+.PP
+\fBTcl_UtfToTitle\fR is the same as \fBTcl_UtfToUpper\fR except it
+turns the first character in the string into its title-case equivalent
+and all following characters into their lower-case equivalents.
+
+.SH BUGS
+.PP
+At this time, the case conversions are only defined for the ISO8859-1
+characters. Unicode characters above 0x00ff are not modified by these
+routines.
+
+.SH KEYWORDS
+utf, unicode, toupper, tolower, totitle, case
diff --git a/tcl/doc/TraceVar.3 b/tcl/doc/TraceVar.3
index b45e754f3c8..3048d18713c 100644
--- a/tcl/doc/TraceVar.3
+++ b/tcl/doc/TraceVar.3
@@ -44,7 +44,7 @@ must be in writable memory: Tcl will make temporary modifications
to it while looking up the name.
.AP int flags in
OR-ed combination of the values TCL_TRACE_READS, TCL_TRACE_WRITES, and
-TCL_TRACE_UNSETS, TCL_PARSE_PART1, and TCL_GLOBAL_ONLY.
+TCL_TRACE_UNSETS, TCL_TRACE_ARRAY, and TCL_GLOBAL_ONLY.
Not all flags are used by all
procedures. See below for more information.
.AP Tcl_VarTraceProc *proc in
@@ -72,7 +72,7 @@ whenever the variable is read or written or unset.
If the trace is created successfully then \fBTcl_TraceVar\fR returns
TCL_OK. If an error occurred (e.g. \fIvarName\fR specifies an element
of an array, but the actual variable isn't an array) then TCL_ERROR
-is returned and an error message is left in \fIinterp->result\fR.
+is returned and an error message is left in the interpreter's result.
.PP
The \fIflags\fR argument to \fBTcl_TraceVar\fR indicates when the
trace procedure is to be invoked and provides information
@@ -96,6 +96,12 @@ A variable may be unset either explicitly by an \fBunset\fR command,
or implicitly when a procedure returns (its local variables are
automatically unset) or when the interpreter is deleted (all
variables are automatically unset).
+.TP
+\fBTCL_TRACE_ARRAY\fR
+Invoke \fIproc\fR whenever the array command is invoked.
+This gives the trace procedure a chance to update the array before
+array names or array get is called. Note that this is called
+before an array set, but that will trigger write traces.
.PP
Whenever one of the specified operations occurs on the variable,
\fIproc\fR will be invoked.
@@ -120,7 +126,8 @@ in the normal two-part form (see the description of \fBTcl_TraceVar2\fR
below for details).
\fIFlags\fR is an OR-ed combination of bits providing several
pieces of information.
-One of the bits TCL_TRACE_READS, TCL_TRACE_WRITES, or TCL_TRACE_UNSETS
+One of the bits TCL_TRACE_READS, TCL_TRACE_WRITES, TCL_TRACE_ARRAY,
+or TCL_TRACE_UNSETS
will be set in \fIflags\fR to indicate which operation is being performed
on the variable.
The bit TCL_GLOBAL_ONLY will be set whenever the variable being
@@ -175,24 +182,26 @@ 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.
-If \fIname2\fR is NULL 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).
-As a special case, if the flag TCL_PARSE_PART1 is specified,
+.VS 8.1
+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
treated as an element name (which can have any string value) and
the characters before the first open
parenthesis are treated as the name of an array variable.
-If the flag TCL_PARSE_PART1 is given,
-\fIname2\fR should be NULL since the array and element names
-are taken from \fIname1\fR.
+If \fIname2\fR is NULL and \fIname1\fR does not refer
+to an array element
+.VE
+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).
+
.SH "ACCESSING VARIABLES DURING TRACES"
.PP
-During read and write traces, the
+During read, write, and array traces, the
trace procedure can read, write, or unset the traced
variable using \fBTcl_GetVar2\fR, \fBTcl_SetVar2\fR, and
other procedures.
@@ -245,6 +254,12 @@ access.
If it deletes the variable then the traced access will return
an empty string.
.PP
+When array tracing has been specified, the trace procedure
+will be invoked at the beginning of the array command implementation,
+before any of the operations like get, set, or names have been invoked.
+The trace procedure can modify the array elements with \fBTcl_SetVar\fR
+and \fBTcl_SetVar2\fR.
+.PP
When unset tracing has been specified, the trace procedure
will be invoked whenever the variable is destroyed.
The traces will be called after the variable has been
@@ -343,6 +358,10 @@ to clean up and free their own internal data structures.
Tcl doesn't do any error checking to prevent trace procedures
from misusing the interpreter during traces with TCL_INTERP_DESTROYED
set.
+.PP
+Array traces are not yet integrated with the Tcl "info exists" command,
+nor is there Tcl-level access to array traces.
.SH KEYWORDS
clientData, trace, variable
+
diff --git a/tcl/doc/Translate.3 b/tcl/doc/Translate.3
index 9ebf1d16404..68b1edd6317 100644
--- a/tcl/doc/Translate.3
+++ b/tcl/doc/Translate.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_TranslateFileName 3 7.5 Tcl "Tcl Library Procedures"
+.TH Tcl_TranslateFileName 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_TranslateFileName \- convert file name to native form and replace tilde with home directory
@@ -26,7 +26,7 @@ Interpreter in which to report an error, if any.
File name, which may start with a ``~''.
.AP Tcl_DString *bufferPtr in/out
If needed, this dynamic string is used to store the new file name.
-At the time of the call it should be uninitialized or empty. The
+At the time of the call it should be uninitialized or free. The
caller must eventually call \fBTcl_DStringFree\fR to free up
anything stored here.
.BE
@@ -51,12 +51,12 @@ initializes \fI*bufferPtr\fR even if it doesn't use it, so the call to
.PP
If an error occurs (e.g. because there was no user by the given
name) then NULL is returned and an error message will be left
-at \fIinterp->result\fR.
+in the interpreter's result.
When an error occurs, \fBTcl_TranslateFileName\fR
frees the dynamic string itself so that the caller need not call
\fBTcl_DStringFree\fR.
.PP
-The caller is responsible for making sure that \fIinterp->result\fR
+The caller is responsible for making sure that the interpreter's result
has its default empty value when \fBTcl_TranslateFileName\fR is invoked.
.SH "SEE ALSO"
@@ -64,3 +64,4 @@ filename
.SH KEYWORDS
file name, home directory, tilde, translate, user
+
diff --git a/tcl/doc/UpVar.3 b/tcl/doc/UpVar.3
index 1594d3b9f4b..6e60d2a7182 100644
--- a/tcl/doc/UpVar.3
+++ b/tcl/doc/UpVar.3
@@ -64,8 +64,7 @@ The destination variable name is specified in a single string; it
may not be an array element.
.PP
Both procedures return either TCL_OK or TCL_ERROR, and they
-leave an error message in \fIinterp->result\fR if an error
-occurs.
+leave an error message in the interpreter's result if an error occurs.
.PP
As with the \fBupvar\fR command, the source variable need not exist;
if it does exist, unsetting it later does not destroy the link. The
@@ -74,3 +73,4 @@ it must exist as a linked variable.
.SH KEYWORDS
linked variable, upvar, variable
+
diff --git a/tcl/doc/Utf.3 b/tcl/doc/Utf.3
new file mode 100644
index 00000000000..db954f7e6b7
--- /dev/null
+++ b/tcl/doc/Utf.3
@@ -0,0 +1,233 @@
+'\"
+'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Utf 3 "8.1" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_UniChar, 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.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+typedef ... Tcl_UniChar;
+.sp
+int
+\fBTcl_UniCharToUtf\fR(\fIch, buf\fR)
+.sp
+int
+\fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR)
+.sp
+char *
+\fBTcl_UniCharToUtfDString\fR(\fIuniStr, numChars, dstPtr\fR)
+.sp
+Tcl_UniChar *
+\fBTcl_UtfToUniCharDString\fR(\fIsrc, len, dstPtr\fR)
+.sp
+int
+\fBTcl_UniCharLen\fR(\fIuniStr\fR)
+.sp
+int
+\fBTcl_UniCharNcmp\fR(\fIuniStr, uniStr, num\fR)
+.sp
+int
+\fBTcl_UtfNcmp\fR(\fIsrc, src, num\fR)
+.sp
+int
+\fBTcl_UtfNcasecmp\fR(\fIsrc, src, num\fR)
+.sp
+int
+\fBTcl_UtfCharComplete\fR(\fIsrc, len\fR)
+.sp
+int
+\fBTcl_NumUtfChars\fR(\fIsrc, len\fR)
+.sp
+char *
+\fBTcl_UtfFindFirst\fR(\fIsrc, ch\fR)
+.sp
+char *
+\fBTcl_UtfFindLast\fR(\fIsrc, ch\fR)
+.sp
+char *
+\fBTcl_UtfNext\fR(\fIsrc\fR)
+.sp
+char *
+\fBTcl_UtfPrev\fR(\fIsrc, start\fR)
+.sp
+Tcl_UniChar
+\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
+.sp
+char *
+\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
+.sp
+int
+\fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR)
+.SH ARGUMENTS
+.AS "CONST Tcl_UniChar" numChars in/out
+.AP char *buf out
+Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most
+TCL_UTF_MAX bytes are stored in the buffer.
+.AP int ch in
+The Tcl_UniChar to be converted or examined.
+.AP Tcl_UniChar *chPtr out
+Filled with the Tcl_UniChar represented by the head of the UTF-8 string.
+.AP "CONST char" *src in
+Pointer to a UTF-8 string.
+.AP "CONST Tcl_UniChar" *uniStr in
+A NULL-terminated Unicode string.
+.AP int len in
+The length of the UTF-8 string in bytes (not UTF-8 characters). If
+negative, all bytes up to the first null byte are used.
+.AP int numChars in
+The length of the Unicode string in characters. Must be greater than or
+equal to 0.
+.AP "Tcl_DString" *dstPtr in/out
+A pointer to a previously-initialized \fBTcl_DString\fR.
+.AP "unsigned long" num in
+The number of characters to compare.
+.AP "CONST char" *start in
+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,
+including the backslash character.
+.AP char *dst out
+Buffer in which the bytes represented by the backslash sequence are stored.
+At most TCL_UTF_MAX bytes are stored in the buffer.
+.BE
+
+.SH DESCRIPTION
+.PP
+These routines convert between UTF-8 strings and Tcl_UniChars. A
+Tcl_UniChar is a Unicode character represented as an unsigned, fixed-size
+quantity. A UTF-8 character is a Unicode character represented as
+a varying-length sequence of up to TCL_UTF_MAX bytes. A multibyte UTF-8
+sequence consists of a lead byte followed by some number of trail bytes.
+.PP
+\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to
+represent one Unicode character in the UTF-8 representation.
+.PP
+\fBTcl_UniCharToUtf\fR stores the Tcl_UniChar \fIch\fR as a UTF-8 string
+in starting at \fIbuf\fR. The return value is the number of bytes stored
+in \fIbuf\fR.
+.PP
+\fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
+and stores it as a Tcl_UniChar in \fI*chPtr\fR. The return value is the
+number of bytes read from \fIsrc\fR.. The caller must ensure that the
+source buffer is long enough such that this routine does not run off the
+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.
+.PP
+\fBTcl_UniCharToUtfDString\fR converts the given Unicode string
+to UTF-8, storing the result in a previously-initialized \fBTcl_DString\fR.
+You must specify the length of the given Unicode string.
+The return value is a pointer to the UTF-8 representation of the
+Unicode string. Storage for the return value is appended to the
+end of the \fBTcl_DString\fR.
+.PP
+\fBTcl_UtfToUniCharDString\fR coverts the given UTF-8 string to Unicode,
+storing the result in the previously-initialized \fBTcl_Dstring\fR.
+you may either specify the length of the given UTF-8 string or "-1",
+in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to
+calculate the length. The return value is a pointer to the Unicode
+representation of the UTF-8 string. Storage for the return value
+is appended to the end of the \fBTcl_DString\fR. The Unicode string
+is terminated with a Unicode NULL character.
+.PP
+\fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode
+characters. It accepts a NULL-terminated Unicode string and returns
+the number of Unicode characters (not bytes) in that string.
+.PP
+\fBTcl_UniCharNcmp\fR corresponds to \fBstrncmp\fR for Unicode
+characters. It accepts two NULL-terminated Unicode strings
+and the number of characters to compare. (Both strings are
+assumed to be at least \fIlen\fR characters long.)
+\fBTcl_UniCharNcmp\fR compares the two strings character-by-character
+according to the Unicode character ordering. It returns an integer
+greater than, equal to,
+or less than 0 if the first string is greater than, equal to, or
+less than the second string respectively.
+.PP
+\fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It
+accepts two NULL-terminated UTF-8 strings and the number of characters
+to compare. (Both strings are assumed to be at least \fIlen\fR
+characters long.) \fBTcl_UtfNcmp\fR compares the two strings
+character-by-character according to the Unicode character ordering.
+It returns an integer greater than, equal to, or less than 0 if the
+first string is greater than, equal to, or less than the second string
+respectively.
+.PP
+\fBTcl_UtfNcasecmp\fR corresponds to \fBstrncasecmp\fR for UTF-8
+strings. It is similar to \fBTcl_UtfNcmp\fR except comparisons ignore
+differences in case when comparing upper, lower or title case
+characters.
+.PP
+\fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR
+of length \fIlen\fR bytes is long enough to be decoded by
+\fBTcl_UtfToUniChar\fR, or 0 otherwise. This function does not guarantee
+that the UTF-8 string is properly formed. This routine is used by
+procedures that are operating on a byte at a time and need to know if a
+full Tcl_UniChar has been seen.
+.PP
+\fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It
+returns the number of Tcl_UniChars that are represented by the UTF-8 string
+\fIsrc\fR. The length of the source string is \fIlen\fR bytes. If the
+length is negative, all bytes up to the first NULL byte are used.
+.PP
+\fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It
+returns a pointer to the first occurance 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.
+.PP
+\fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings. It
+returns a pointer to the last occurance 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.
+.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
+string. The caller must not ask for the next character after the last
+character in the string.
+.PP
+Given \fIsrc\fR, a pointer to some location in a UTF-8 string,
+\fBTcl_UtfPrev\fR returns a pointer to the previous UTF-8 character in the
+string. This function will not back up to a position before \fIstart\fR,
+the start of the UTF-8 string. If \fIsrc\fR was already at \fIstart\fR, the
+return value will be \fIstart\fR.
+.PP
+\fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the
+Pascal Ord() function. It returns the Tcl_UniChar represented at the
+specified character (not byte) \fIindex\fR in the UTF-8 string
+\fIsrc\fR. The source string must contain at least \fIindex\fR
+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
+\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
+\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
+commands. It parses a backslash sequence and stores the properly formed
+UTF-8 character represented by the backslash sequence in the output
+buffer \fIdst\fR. At most TCL_UTF_MAX bytes are stored in the buffer.
+\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number
+of bytes in the backslash sequence, including the backslash character.
+The return value is the number of bytes stored in the output buffer.
+.PP
+See the \fBTcl\fR manual entry for information on the valid backslash
+sequences. All of the sequences described in the Tcl manual entry are
+supported by \fBTcl_UtfBackslash\fR.
+
+.SH KEYWORDS
+utf, unicode, backslash
+
diff --git a/tcl/doc/WrongNumArgs.3 b/tcl/doc/WrongNumArgs.3
index d8185f03130..26b8bf8bc0e 100644
--- a/tcl/doc/WrongNumArgs.3
+++ b/tcl/doc/WrongNumArgs.3
@@ -24,8 +24,7 @@ in its result object.
.AP int objc in
Number of leading arguments from \fIobjv\fR to include in error
message.
-.TP
-Tcl_Obj *CONST \fIobjv\fR[] (in)
+.AP Tcl_Obj "*CONST\ objv[]" in
Arguments to command that had the wrong number of arguments.
.AP char *message in
Additional error information to print after leading arguments
diff --git a/tcl/doc/array.n b/tcl/doc/array.n
index bcf30918a5f..288e95b05e0 100644
--- a/tcl/doc/array.n
+++ b/tcl/doc/array.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH array n 7.4 Tcl "Tcl Built-In Commands"
+.TH array n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -58,14 +58,14 @@ array element. The order of the pairs is undefined.
If \fIpattern\fR is not specified, then all of the elements of the
array are included in the result.
If \fIpattern\fR is specified, then only those elements whose names
-match \fIpattern\fR (using the glob-style matching rules of
+match \fIpattern\fR (using the matching rules of
\fBstring match\fR) are included.
If \fIarrayName\fR isn't the name of an array variable, or if
the array contains no elements, then an empty list is returned.
.TP
\fBarray names \fIarrayName\fR ?\fIpattern\fR?
Returns a list containing the names of all of the elements in
-the array that match \fIpattern\fR (using the glob-style matching
+the array that match \fIpattern\fR (using the matching
rules of \fBstring match\fR).
If \fIpattern\fR is omitted then the command returns all of
the element names in the array.
@@ -111,6 +111,15 @@ The return value is a
search identifier that must be used in \fBarray nextelement\fR
and \fBarray donesearch\fR commands; it allows multiple
searches to be underway simultaneously for the same array.
+.VS 8.3
+.TP
+\fBarray unset \fIarrayName\fR ?\fIpattern\fR?
+Unsets all of the elements in the array that match \fIpattern\fR (using the
+matching rules of \fBstring match\fR). If \fIarrayName\fR isn't the name
+of an array variable or there are no matching elements in the array, then
+an empty string is returned. If \fIpattern\fR is omitted and is it an
+array variable, then the command unsets the entire array.
+.VE 8.3
.SH KEYWORDS
array, element names, search
diff --git a/tcl/doc/binary.n b/tcl/doc/binary.n
index e03924688a8..f21d691e4ae 100644
--- a/tcl/doc/binary.n
+++ b/tcl/doc/binary.n
@@ -119,7 +119,7 @@ remaining bits of the last byte will be zeros. For example,
.CS
\fBbinary format h3h* AB def\fR
.CE
-will return a string equivalent to \fB\\xba\\xed\\x0f\fR.
+will return a string equivalent to \fB\\xba\\x00\\xed\\x0f\fR.
.RE
.IP \fBH\fR 5
This form is the same as \fBh\fR except that the digits are stored in
@@ -128,7 +128,7 @@ high-to-low order within each byte. For example,
.CS
\fBbinary format H3H* ab DEF\fR
.CE
-will return a string equivalent to \fB\\xab\\xde\\xf0\fR.
+will return a string equivalent to \fB\\xab\\x00\\xde\\xf0\fR.
.RE
.IP \fBc\fR 5
Stores one or more 8-bit integer values in the output string. If no
@@ -142,10 +142,10 @@ error is generated. If the number of elements in the list is greater
than \fIcount\fR, then the extra elements are ignored. For example,
.RS
.CS
-\fBbinary format c3cc* {3 -3 128 1} 257 {2 5}\fR
+\fBbinary format c3cc* {3 -3 128 1} 260 {2 5}\fR
.CE
will return a string equivalent to
-\fB\\x03\\xfd\\x80\\x01\\x02\\x05\fR, whereas
+\fB\\x03\\xfd\\x80\\x04\\x02\\x05\fR, whereas
.CS
\fBbinary format c {2 5}\fR
.CE
@@ -186,7 +186,7 @@ example,
\fBbinary format i3 {3 -3 65536 1}\fR
.CE
will return a string equivalent to
-\fB\\x03\\x00\\x00\\x00\\xfd\\xff\\xff\\xff\\x00\\x00\\x10\\x00\fR.
+\fB\\x03\\x00\\x00\\x00\\xfd\\xff\\xff\\xff\\x00\\x00\\x01\\x00\fR
.RE
.IP \fBI\fR 5
This form is the same as \fBi\fR except that it stores one or more one
@@ -197,7 +197,7 @@ For example,
\fBbinary format I3 {3 -3 65536 1}\fR
.CE
will return a string equivalent to
-\fB\\x00\\x00\\x00\\x03\\xff\\xff\\xff\\xfd\\x00\\x10\\x00\\x00\fR.
+\fB\\x00\\x00\\x00\\x03\\xff\\xff\\xff\\xfd\\x00\\x01\\x00\\x00\fR
.RE
.IP \fBf\fR 5
This form is the same as \fBc\fR except that it stores one or more one
@@ -297,6 +297,22 @@ immediately with the number of variables that were set. If there are
not enough arguments for all of the fields in the format string that
consume arguments, then an error is generated.
.PP
+It is \fBimportant\fR to note that the \fBc\fR, \fBs\fR, and \fBS\fR
+(and \fBi\fR and \fBI\fR on 64bit systems) will be scanned into
+long data size values. In doing this, values that have their high
+bit set (0x80 for chars, 0x8000 for shorts, 0x80000000 for ints),
+will be sign extended. Thus the following will occur:
+.CS
+\fBset signShort [binary format s1 0x8000]\fR
+\fBbinary scan $signShort s1 val; \fI# val == 0xFFFF8000\fR
+.CE
+If you want to produce an unsigned value, then you can mask the return
+value to the desired size. For example, to produce an unsigned short
+value:
+.CS
+\fBset val [expr {$val & 0xFFFF}]; \fI# val == 0x8000\fR
+.CE
+.PP
Each type-count pair moves an imaginary cursor through the binary data,
reading bytes from the current position. The cursor is initially
at position 0 at the beginning of the data. The type may be any one of
@@ -318,7 +334,7 @@ This form is the same as \fBa\fR, except trailing blanks and nulls are stripped
the scanned value before it is stored in the variable. For example,
.RS
.CS
-\fBbinary scan "abc efghi \\000" a* var1\fR
+\fBbinary scan "abc efghi \\000" A* var1\fR
.CE
will return \fB1\fR with \fBabc efghi\fR stored in \fBvar1\fR.
.RE
@@ -338,11 +354,11 @@ will return \fB2\fR with \fB11100\fR stored in \fBvar1\fR and
\fB1110000110100000\fR stored in \fBvar2\fR.
.RE
.IP \fBB\fR 5
-This form is the same as \fBB\fR, except the bits are taken in
+This form is the same as \fBb\fR, except the bits are taken in
high-to-low order within each byte. For example,
.RS
.CS
-\fBbinary scan \\x70\\x87\\x05 b5b* var1 var2\fR
+\fBbinary scan \\x70\\x87\\x05 B5B* var1 var2\fR
.CE
will return \fB2\fR with \fB01110\fR stored in \fBvar1\fR and
\fB1000011100000101\fR stored in \fBvar2\fR.
@@ -365,7 +381,7 @@ will return \fB2\fR with \fB706\fR stored in \fBvar1\fR and
.RE
.IP \fBH\fR 5
This form is the same as \fBh\fR, except the digits are taken in
-low-to-high order within each byte. For example,
+high-to-low order within each byte. For example,
.RS
.CS
\fBbinary scan \\x07\\x86\\x05 H3H* var1 var2\fR
@@ -530,3 +546,4 @@ format, scan, tclvars
.SH KEYWORDS
binary, format, scan
+
diff --git a/tcl/doc/catch.n b/tcl/doc/catch.n
index 73f8c50e9da..c38c4a53113 100644
--- a/tcl/doc/catch.n
+++ b/tcl/doc/catch.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH catch n "" Tcl "Tcl Built-In Commands"
+.TH catch n "8.0" Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -19,22 +19,48 @@ catch \- Evaluate script and trap exceptional returns
.SH DESCRIPTION
.PP
-The \fBcatch\fR command may be used to prevent errors from aborting
-command interpretation. \fBCatch\fR calls the Tcl interpreter recursively
-to execute \fIscript\fR, and always returns a TCL_OK code, regardless of
-any errors that might occur while executing \fIscript\fR. The return
-value from \fBcatch\fR is a decimal string giving the
-code returned by the Tcl interpreter after executing \fIscript\fR.
-This will be \fB0\fR (TCL_OK) if there were no errors in \fIscript\fR;
-otherwise
-it will have a non-zero value corresponding to one of the exceptional
-return codes (see tcl.h for the definitions of code values). If the
-\fIvarName\fR argument is given, then it gives the name of a variable;
-\fBcatch\fR will set the variable to the string returned
-from \fIscript\fR (either a result or an error message).
+The \fBcatch\fR command may be used to prevent errors from aborting command
+interpretation. \fBCatch\fR calls the Tcl interpreter recursively to
+execute \fIscript\fR, and always returns without raising an error,
+regardless of any errors that might occur while executing \fIscript\fR.
+.PP
+If \fIscript\fR raises an error, \fBcatch\fR will return a non-zero integer
+value corresponding to one of the exceptional return codes (see tcl.h
+for the definitions of code values). If the \fIvarName\fR argument is
+given, then the variable it names is set to the error message from
+interpreting \fIscript\fR.
+.PP
+If \fIscript\fR does not raise an error, \fBcatch\fR will return 0
+(TCL_OK) and set the variable to the value returned from \fIscript\fR.
.PP
Note that \fBcatch\fR catches all exceptions, including those
-generated by \fBbreak\fR and \fBcontinue\fR as well as errors.
+generated by \fBbreak\fR and \fBcontinue\fR as well as errors. The
+only errors that are not caught are syntax errors found when the
+script is compiled. This is because the catch command only catches
+errors during runtime. When the catch statement is compiled, the
+script is compiled as well and any syntax errors will generate a Tcl
+error.
+
+.SH EXAMPLES
+
+The \fBcatch\fR command may be used in an \fBif\fR to branch based on
+the success of a script.
+
+.CS
+if { [catch {open $someFile w} fid] } {
+ puts stderr "Could not open $someFile for writing\\n$fid"
+ exit 1
+}
+.CE
+The \fBcatch\fR command will not catch compiled syntax errors. The
+first time proc \fBfoo\fR is called, the body will be compiled and a
+Tcl error will be generated.
+
+.CS
+proc foo {} {
+ catch {expr {1 +- }}
+}
+.CE
.SH KEYWORDS
catch, error
diff --git a/tcl/doc/clock.n b/tcl/doc/clock.n
index 2af5b6e08f1..d43f590d8a0 100644
--- a/tcl/doc/clock.n
+++ b/tcl/doc/clock.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
+'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" This documentation is derived from the time and date facilities of
'\" TclX, by Mark Diekhans and Karl Lehenbauer.
@@ -11,7 +12,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH clock n 7.4 Tcl "Tcl Built-In Commands"
+.TH clock n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -28,12 +29,16 @@ time. The \fIoption\fR argument determines what action is carried
out by the command. The legal \fIoptions\fR (which may be
abbreviated) are:
.TP
-\fBclock clicks\fR
+.VS 8.3
+\fBclock clicks\fR ?\fB\-milliseconds\fR?
Return a high-resolution time value as a system-dependent integer
value. The unit of the value is system-dependent but should be the
highest resolution clock available on the system such as a CPU cycle
-counter. This value should only be used for the relative measurement
+counter. If \fB\-milliseconds\fR is specified, then the value is
+guaranteed to be of millisecond granularity.
+This value should only be used for the relative measurement
of elapsed time.
+.VE 8.3
.TP
\fBclock format \fIclockValue\fR ?\fB\-format \fIstring\fR? ?\fB\-gmt \fIboolean\fR?
Converts an integer time value, typically returned by
@@ -74,11 +79,11 @@ AM/PM indicator.
.IP \fB%S\fR
Seconds (00 - 59).
.IP \fB%U\fR
-Week of year (01 - 52), Sunday is the first day of the week.
+Week of year (00 - 52), Sunday is the first day of the week.
.IP \fB%w\fR
Weekday number (Sunday = 0).
.IP \fB%W\fR
-Week of year (01 - 52), Monday is the first day of the week.
+Week of year (00 - 52), Monday is the first day of the week.
.IP \fB%x\fR
Locale specific date format.
.IP \fB%X\fR
@@ -129,6 +134,8 @@ specified, the current date is assumed. If the string does not contain a
time zone mnemonic, the local time zone is assumed, unless the \fB\-gmt\fR
argument is true, in which case the clock value is calculated assuming
that the specified time is relative to Greenwich Mean Time.
+\fB-gmt\fR, if specified, affects only the computed time value; it does not
+impact the interpretation of \fB-base\fR.
.sp
If the \fB\-base\fR flag is specified, the next argument should contain
an integer clock value. Only the date in this value is used, not the
@@ -148,14 +155,20 @@ a 24-hour clock.
\fIdate\fR
A specific month and day with optional year. The
acceptable formats are \fImm/dd\fR?\fI/yy\fR?, \fImonthname dd\fR
-?, \fIyy\fR?, \fIdd monthname \fR?\fIyy\fR? and \fIday, dd monthname
-yy\fR. The default year is the current year. If the year is less
+?, \fIyy\fR?, \fIdd monthname \fR?\fIyy\fR?, \fIday, dd monthname
+yy\fR, \fI?CC?yymmdd\fR, \fI?CC?yy-mm-dd\fR, \fIdd-monthname-?CC?yy\fR.
+The default year is the current year. If the year is less
.VS
than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
as 1969-1999. Not all platforms can represent the years 38-70, so
an error may result if these years are used.
.VE
.TP
+\fIISO 8601 point-in-time\fR
+An ISO 8601 point-in-time specification, such as \fICCyymmddThhmmss\fR, where
+T is the literal T, \fICCyymmdd hhmmss\fR, or
+\fICCyymmddThh:mm:ss\fR.
+.TP
\fIrelative time\fR
A specification relative to the current time. The format is \fInumber
unit\fR acceptable units are \fByear\fR, \fBfortnight\fR, \fBmonth\fR, \fBweek\fR, \fBday\fR,
@@ -176,6 +189,19 @@ used. Finally, a correction is applied so that the correct hour of
the day is produced after allowing for daylight savings time
differences and the correct date is given when going from the end
of a long month to a short month.
+.sp
+Daylight savings time correction is applied only when the relative time
+is specified in units of days or more, ie, days, weeks, fortnights, months or
+years. This means that when crossing the daylight savings time boundary,
+different results will be given for \fBclock scan "1 day"\fR and
+\fBclock scan "24 hours"\fR:
+.CS
+.ta 6c
+\fB% clock scan "1 day" -base [clock scan 1999-10-31]
+941443200
+% clock scan "24 hours" -base [clock scan 1999-10-31]
+941439600\fR
+.CE
.RE
.TP
\fBclock seconds\fR
@@ -186,3 +212,4 @@ an ``epoch''. You shouldn't assume the value of the epoch.
.SH KEYWORDS
clock, date, time
+
diff --git a/tcl/doc/dde.n b/tcl/doc/dde.n
new file mode 100644
index 00000000000..3a8015afa79
--- /dev/null
+++ b/tcl/doc/dde.n
@@ -0,0 +1,135 @@
+'\"
+'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH dde n 8.1 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+dde \- Execute a Dynamic Data Exchange command
+.SH SYNOPSIS
+.sp
+\fBpackage require dde 1.1\fR
+.sp
+\fBdde \fIservername \fR?\fItopic\fR?
+.sp
+\fBdde ?\-async?\fR \fIcommand service topic \fR?\fIdata\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command allows an application to send Dynamic Data Exchange (DDE)
+command when running under Microsoft Windows. Dynamic Data Exchange is
+a mechanism where applications can exchange raw data. Each DDE
+transaction needs a \fIservice name\fR and a \fItopic\fR. Both the
+\fIservice name\fR and \fItopic\fR are application defined; Tcl uses
+the service name \fBTclEval\fR, while the topic name is the name of the
+interpreter given by \fBdde servername\fR. Other applications have their
+own \fIservice names\fR and \fItopics\fR. For instance, Microsoft Excel
+has the service name \fBExcel\fR.
+.PP
+The only option to the \fBdde\fR command is:
+.TP
+\fB\-async\fR
+Requests asynchronous invocation. This is valid only for the
+\fBexecute\fR subcommand. Normally, the \fBdde execute\fR subcommand
+waits until the command completes, returning appropriate error
+messages. When the \fB\-async\fR option is used, the command returns
+immediately, and no error information is available.
+.SH "DDE COMMANDS"
+.PP
+The following commands are a subset of the full Dynamic Data Exchange
+set of commands.
+.TP
+\fBdde servername \fR?\fItopic\fR?
+\fBdde servername\fR registers the interpreter as a DDE server with
+the service name \fBTclEval\fR and the topic name specified by \fItopic\fR.
+If no \fItopic\fR is given, \fBdde servername\fR returns the name
+of the current topic or the empty string if it is not registered as a service.
+.TP
+\fBdde execute \fIservice topic data\fR
+\fBdde execute\fR takes the \fIdata\fR and sends it to the server
+indicated by \fIservice\fR with the topic indicated by
+\fItopic\fR. Typically, \fIservice\fR is the name of an application,
+and \fItopic\fR is a file to work on. The \fIdata\fR field is given
+to the remote application. Typically, the application treats the
+\fIdata\fR field as a script, and the script is run in the
+application. The command returns an error if the script did not
+run. If the \fB\-async\fR flag was used, the command
+returns immediately with no error.
+.TP
+\fBdde poke \fIservice topic item data\fR
+\fBdde poke\fR passes the \fIdata\fR to the server indicated by
+\fIservice\fR using the \fItopic\fR and \fIitem\fR specified. Typically,
+\fIservice\fR is the name of an application. \fItopic\fR is application
+specific but can be a command to the server or the name of a file to work
+on. The \fIitem\fR is also application specific and is often not used, but
+it must always be non-null. The \fIdata\fR field is given to the remote
+application.
+.TP
+\fBdde request \fIservice topic item\fR
+\fBdde request\fR is typically used to get the value of something; the
+value of a cell in Microsoft Excel or the text of a selection in
+Microsoft Word. \fIservice\fR is typically the name of an application,
+\fItopic\fR is typically the name of the file, and \fIitem\fR is
+application-specific. The command returns the value of \fIitem\fR as
+defined in the application.
+.TP
+\fBdde services \fIservice topic\fR
+\fBdde services\fR returns a list of service-topic pairs that
+currently exist on the machine. If \fIservice\fR and \fItopic\fR are
+both null strings ({}), then all service-topic pairs currently
+available on the system are returned. If \fIservice\fR is null and
+\fItopic\fR is not, then all services with the specified topic are
+returned. If \fIservice\fR is not null and \fItopic\fR is, all topics
+for a given service are returned. If both are not null, if that
+service-topic pair currently exists, it is returned; otherwise, null
+is returned.
+.TP
+\fBdde eval \fItopic cmd \fR?\fIarg arg ...\fR?
+\fBdde eval\fR evaluates a command and its arguments using the
+interpreter specified by \fItopic\fR. The DDE service must be the
+\fBTclEval\fR service. This command can be used to replace send on
+Windows.
+.SH "DDE AND TCL"
+A Tcl interpreter always has a service name of \fBTclEval\fR. Each
+different interpreter of all running Tcl applications must be
+given a unique
+name specified by \fBdde servername\fR. Each interp is available as a
+DDE topic only if the \fBdde servername\fR command was used to set the
+name of the topic for each interp. So a \fBdde services TclEval {}\fR
+command will return a list of service-topic pairs, where each of the
+currently running interps will be a topic.
+.PP
+When Tcl processes a \fBdde execute\fR command, the data for the
+execute is run as a script in the interp named by the topic of the
+\fBdde execute\fR command.
+.PP
+When Tcl processes a \fBdde request\fR command, it returns the value of the
+variable given in the dde command in the context of the interp named by the
+dde topic. Tcl reserves the variable \fB$TCLEVAL$EXECUTE$RESULT\fR for
+internal use, and \fBdde request\fR commands for that variable will give
+unpredictable results.
+.PP
+An external application which wishes to run a script in Tcl should have
+that script store its result in a variable, run the \fBdde execute\fR
+command, and the run \fBdde request\fR to get the value of the
+variable.
+.PP
+When using DDE, be careful to ensure that the event queue is flushed
+using either \fBupdate\fR or \fBvwait\fR. This happens by default
+when using \fBwish\fR unless a blocking command is called (such as \fBexec\fR
+without adding the \fB&\fR to place the process in the background).
+If for any reason the event queue is not flushed, DDE commands may
+hang until the event queue is flushed. This can create a deadlock
+situation.
+.SH "SEE ALSO"
+tk, winfo, send
+.SH KEYWORDS
+application, dde, name, remote execution
+
diff --git a/tcl/doc/encoding.n b/tcl/doc/encoding.n
new file mode 100644
index 00000000000..740b9dfadf3
--- /dev/null
+++ b/tcl/doc/encoding.n
@@ -0,0 +1,79 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
+.BS
+.SH NAME
+encoding \- Manipulate encodings
+.SH SYNOPSIS
+\fBencoding \fIoption\fR ?\fIarg arg ...\fR?
+.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.
+
+.SH DESCRIPTION
+.PP
+Performs one of several encoding related operations, depending on
+\fIoption\fR. The legal \fIoption\fRs are:
+.TP
+\fBencoding convertfrom ?\fIencoding\fR? \fIdata\fR
+Convert \fIdata\fR to Unicode from the specified \fIencoding\fR. The
+characters in \fIdata\fR are treated as binary data where the lower
+8-bits of each character is taken as a single byte. The resulting
+sequence of bytes is treated as a string in the specified
+\fIencoding\fR. If \fIencoding\fR is not specified, the current
+system encoding is used.
+.TP
+\fBencoding convertto ?\fIencoding\fR? \fIstring\fR
+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.
+.TP
+\fBencoding names\fR
+Returns a list containing the names of all of the encodings that are
+currently available.
+.TP
+\fBencoding system\fR ?\fIencoding\fR?
+Set the system encoding to \fIencoding\fR. If \fIencoding\fR is
+omitted then the command returns the current system encoding. The
+system encoding is used whenever Tcl passes strings to system calls.
+
+.SH EXAMPLE
+.PP
+It is common practice to write script files using a text editor that
+produces output in the euc-jp encoding, which represents the ASCII
+characters as singe bytes and Japanese characters as two bytes. This
+makes it easy to embed literal strings that correspond to non-ASCII
+characters by simply typing the strings in place in the script.
+However, because the \fBsource\fR command always reads files using the
+ISO8859-1 encoding, Tcl will treat each byte in the file 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 contain a sequence of Latin-1
+characters that correspond to the bytes of the original string. The
+\fBencoding\fR command can be used to convert this string to the
+expected Japanese Unicode characters. For example,
+.CS
+ set s [encoding convertfrom euc-jp "\\xA4\\xCF"]
+.CE
+would return the Unicode string "\\u306F", which is the Hiragana
+letter HA.
+
+.SH "SEE ALSO"
+Tcl_GetEncoding
+
+.SH KEYWORDS
+encoding
diff --git a/tcl/doc/exec.n b/tcl/doc/exec.n
index 8fc72c1195e..dc85e3754f1 100644
--- a/tcl/doc/exec.n
+++ b/tcl/doc/exec.n
@@ -202,10 +202,11 @@ instead of ``applbakery.default'').
Two or more forward or backward slashes in a row in a path refer to a
network path. For example, a simple concatenation of the root directory
\fBc:/\fR with a subdirectory \fB/windows/system\fR will yield
-\fBc://windows/system\fR (two slashes together), which refers to the
-directory \fB/system\fR on the machine \fBwindows\fR (and the \fBc:/\fR is
-ignored), and is not equivalent to \fBc:/windows/system\fR, which describes
-a directory on the current computer.
+\fBc://windows/system\fR (two slashes together), which refers to the mount
+point called \fBsystem\fR on the machine called \fBwindows\fR (and the
+\fBc:/\fR is ignored), and is not equivalent to \fBc:/windows/system\fR,
+which describes a directory on the current computer. The \fBfile join\fR
+command should be used to concatenate path components.
.TP
\fBWindows NT\fR
.
@@ -264,7 +265,7 @@ the caller must prepend ``\fBcommand.com /c\0\fR'' to the desired command.
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
+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.
.sp
@@ -282,8 +283,8 @@ 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 Windows 95 command line interpreter
+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.
.sp
Certain applications, such as \fBcommand.com\fR, should not be executed
@@ -293,55 +294,6 @@ output may fail, hang Tcl, or even hang the system if their own private
console window is not available to them.
.RE
.TP
-\fBWindows 3.X\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:
-.sp
-.RS
-.RS
-The directory from which the Tcl executable was loaded.
-.br
-The current directory.
-.br
-The Windows 3.X system directory.
-.br
-The Windows 3.X home directory.
-.br
-The directories listed in the path.
-.RE
-.sp
-In order to execute the shell builtin commands like \fBdir\fR and \fBcopy\fR,
-the caller must prepend ``\fBcommand.com /c\0\fR'' to the desired command.
-.sp
-16-bit and 32-bit DOS and Windows applications may be executed. However,
-redirection and piping of standard IO only works with 16-bit DOS
-applications. 32-bit applications always see standard input as already
-closed, and any standard output or error is discarded, no matter where in the
-pipeline the application occurs or what redirection symbols are used by the
-caller. Additionally, for 16-bit applications, standard error is always
-sent to the same place as standard output; it cannot be redirected to a
-separate location. In order to achieve pseudo-redirection for 32-bit
-applications, the 32-bit application must instead be written to take command
-line arguments that specify the files that it should read from and write to
-and open those files itself.
-.sp
-All applications, both 16-bit and 32-bit, run synchronously; each application
-runs to completion before the next one in the pipeline starts. Temporary files
-are used to simulate piping between applications. The \fBexec\fR
-command cannot be used to start an application in the background.
-.sp
-When standard input is redirected from an open file using the
-``\fB@\0\fIfileId\fR'' notation, the open file is completely read up to its
-end. This is slightly different than under Windows 95 or NT, where the child
-application consumes from the open file only as much as it wants.
-Redirecting to an open file is supported as normal.
-.RE
-.TP
\fBMacintosh\fR
The \fBexec\fR command is not implemented and does not exist under Macintosh.
.TP
diff --git a/tcl/doc/expr.n b/tcl/doc/expr.n
index 27545611cff..0827aed933d 100644
--- a/tcl/doc/expr.n
+++ b/tcl/doc/expr.n
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
+'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH expr n 8.0 Tcl "Tcl Built-In Commands"
+.TH expr n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -184,30 +184,80 @@ invoking the \fBexpr\fR command.
Tcl supports the following mathematical functions in expressions:
.DS
.ta 3c 6c 9c
-\fBacos\fR \fBcos\fR \fBhypot\fR \fBsinh\fR
-\fBasin\fR \fBcosh\fR \fBlog\fR \fBsqrt\fR
-\fBatan\fR \fBexp\fR \fBlog10\fR \fBtan\fR
-\fBatan2\fR \fBfloor\fR \fBpow\fR \fBtanh\fR
-\fBceil\fR \fBfmod\fR \fBsin\fR
+\fBabs\fR \fBcosh\fR \fBlog\fR \fBsqrt\fR
+\fBacos\fR \fBdouble\fR \fBlog10\fR \fBsrand\fR
+\fBasin\fR \fBexp\fR \fBpow\fR \fBtan\fR
+\fBatan\fR \fBfloor\fR \fBrand\fR \fBtanh\fR
+\fBatan2\fR \fBfmod\fR \fBround\fR
+\fBceil\fR \fBhypot\fR \fBsin\fR
+\fBcos\fR \fBint\fR \fBsinh\fR
.DE
-Each of these functions invokes the math library function of the same
-name; see the manual entries for the library functions for details
-on what they do. Tcl also implements the following functions for
-conversion between integers and floating-point numbers and the
-generation of random numbers:
+.PP
.TP
\fBabs(\fIarg\fB)\fR
Returns the absolute value of \fIarg\fR. \fIArg\fR may be either
integer or floating-point, and the result is returned in the same form.
.TP
+\fBacos(\fIarg\fB)\fR
+Returns the arc cosine of \fIarg\fR, in the range [0,pi]
+radians. \fIArg\fR should be in the range [-1,1].
+.TP
+\fBasin(\fIarg\fB)\fR
+Returns the arc sine of \fIarg\fR, in the range [-pi/2,pi/2] radians.
+\fIArg\fR should be in the range [-1,1].
+.TP
+\fBatan(\fIarg\fB)\fR
+Returns the arc tangent of \fIarg\fR, in the range [-pi/2,pi/2] radians.
+.TP
+\fBatan2(\fIx, y\fB)\fR
+Returns the arc tangent of \fIy\fR/\fIx\fR, in the range [-pi,pi]
+radians. \fIx\fR and \fIy\fR cannot both be 0.
+.TP
+\fBceil(\fIarg\fB)\fR
+Returns the smallest integer value not less than \fIarg\fR.
+.TP
+\fBcos(\fIarg\fB)\fR
+Returns the cosine of \fIarg\fR, measured in radians.
+.TP
+\fBcosh(\fIarg\fB)\fR
+Returns the hyperbolic cosine of \fIarg\fR. If the result would cause
+an overflow, an error is returned.
+.TP
\fBdouble(\fIarg\fB)\fR
If \fIarg\fR is a floating value, returns \fIarg\fR, otherwise converts
\fIarg\fR to floating and returns the converted value.
.TP
+\fBexp(\fIarg\fB)\fR
+Returns the exponential of \fIarg\fR, defined as e**\fIarg\fR. If the
+result would cause an overflow, an error is returned.
+.TP
+\fBfloor(\fIarg\fB)\fR
+Returns the largest integral value not greater than \fIarg\fR.
+.TP
+\fBfmod(\fIx, y\fB)\fR
+Returns the floating-point remainder of the division of \fIx\fR by
+\fIy\fR. If \fIy\fR is 0, an error is returned.
+.TP
+\fBhypot(\fIx, y\fB)\fR
+Computes the length of the hypotenuse of a right-angled triangle
+(\fIx\fR*\fIx\fR+\fIy\fR*\fIy\fR).
+.TP
\fBint(\fIarg\fB)\fR
If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
\fIarg\fR to integer by truncation and returns the converted value.
.TP
+\fBlog(\fIarg\fB)\fR
+Returns the natural logarithm of \fIarg\fR. \fIArg\fR must be a
+positive value.
+.TP
+\fBlog10(\fIarg\fB)\fR
+Returns the base 10 logarithm of \fIarg\fR. \fIArg\fR must be a
+positive value.
+.TP
+\fBpow(\fIx, y\fB)\fR
+Computes the value of \fIx\fR raised to the power \fIy\fR. If \fIx\fR
+is negative, \fIy\fR must be an integer value.
+.TP
\fBrand()\fR
Returns a floating point number from zero to just less than one or,
in mathematical terms, the range [0,1). The seed comes from the
@@ -218,10 +268,26 @@ function.
If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
\fIarg\fR to integer by rounding and returns the converted value.
.TP
+\fBsin(\fIarg\fB)\fR
+Returns the sine of \fIarg\fR, measured in radians.
+.TP
+\fBsinh(\fIarg\fB)\fR
+Returns the hyperbolic sine of \fIarg\fR. If the result would cause
+an overflow, an error is returned.
+.TP
+\fBsqrt(\fIarg\fB)\fR
+Returns the square root of \fIarg\fR. \fIArg\fR must be non-negative.
+.TP
\fBsrand(\fIarg\fB)\fR
The \fIarg\fR, which must be an integer, is used to reset the seed for
the random number generator. Returns the first random number from
that seed. Each interpreter has it's own seed.
+.TP
+\fBtan(\fIarg\fB)\fR
+Returns the tangent of \fIarg\fR, measured in radians.
+.TP
+\fBtanh(\fIarg\fB)\fR
+Returns the hyperbolic tangent of \fIarg\fR.
.PP
In addition to these predefined functions, applications may
define additional functions using \fBTcl_CreateMathFunc\fR().
@@ -282,11 +348,10 @@ the second operand is converted to the string \fB18\fR.
Because of Tcl's tendency to treat values as numbers whenever
possible, it isn't generally a good idea to use operators like \fB==\fR
when you really want string comparison and the values of the
-operands could be arbitrary; it's better in these cases to use the
-\fBstring compare\fR command instead.
+operands could be arbitrary; it's better in these cases to use
+the \fBstring\fR command instead.
.SH "PERFORMANCE CONSIDERATIONS"
-.VS
.PP
Enclose expressions in braces for the best speed and the smallest
storage requirements.
@@ -317,7 +382,7 @@ The most expensive code is required for
unbraced expressions that contain command substitutions.
These expressions must be implemented by generating new code
each time the expression is executed.
-.VE
.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison
+
diff --git a/tcl/doc/fconfigure.n b/tcl/doc/fconfigure.n
index 80301fb672a..dc84a52dd9d 100644
--- a/tcl/doc/fconfigure.n
+++ b/tcl/doc/fconfigure.n
@@ -7,7 +7,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH fconfigure n 7.5 Tcl "Tcl Built-In Commands"
+.TH fconfigure n 8.1 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -51,122 +51,144 @@ using the Tcl event loop (e.g. by calling \fBTcl_DoOneEvent\fR or
invoking the \fBvwait\fR command).
.TP
\fB\-buffering\fR \fInewValue\fR
+.
If \fInewValue\fR is \fBfull\fR then the I/O system will buffer output
until its internal buffer is full or until the \fBflush\fR command is
invoked. If \fInewValue\fR is \fBline\fR, then the I/O system will
automatically flush output for the channel whenever a newline character
is output. If \fInewValue\fR is \fBnone\fR, the I/O system will flush
-automatically after every output operation.
-The default is for \fB\-buffering\fR to be set to \fBfull\fR except for
-channels that connect to terminal-like devices; for these channels the
-initial setting is \fBline\fR.
+automatically after every output operation. The default is for
+\fB\-buffering\fR to be set to \fBfull\fR except for channels that
+connect to terminal-like devices; for these channels the initial setting
+is \fBline\fR. Additionally, \fBstdin\fR and \fBstdout\fR are
+intially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR.
.TP
\fB\-buffersize\fR \fInewSize\fR
+.
\fINewvalue\fR must be an integer; its value is used to set the size of
buffers, in bytes, subsequently allocated for this channel to store input
or output. \fINewvalue\fR must be between ten and one million, allowing
buffers of ten to one million bytes in size.
+.VS 8.1 br
+.TP
+\fB\-encoding\fR \fIname\fR
+.
+This option is used to specify the encoding of the channel, so that the data
+can be converted to and from Unicode for use in Tcl. For instance, in
+order for Tcl to read characters from a Japanese file in \fBshiftjis\fR
+and properly process and display the contents, the encoding would be set
+to \fBshiftjis\fR. Thereafter, when reading from the channel, the bytes in
+the Japanese file would be converted to Unicode as they are read.
+Writing is also supported \- as Tcl strings are written to the channel they
+will automatically be converted to the specified encoding on output.
+.RS
+.PP
+If a file contains pure binary data (for instance, a JPEG image), the
+encoding for the channel should be configured to be \fBbinary\fR. Tcl
+will then assign no interpretation to the data in the file and simply read or
+write raw bytes. The Tcl \fBbinary\fR command can be used to manipulate this
+byte-oriented data.
+.PP
+The default encoding for newly opened channels is the same platform- and
+locale-dependent system encoding used for interfacing with the operating
+system.
+.RE
+.VE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
-This option supports DOS file systems that use Control-z (\ex1a) as
-an end of file marker.
-If \fIchar\fR is not an empty string, then this character signals
-end of file when it is encountered during input.
-For output, the end of file character is output when
-the channel is closed.
-If \fIchar\fR is the empty string, then there is no special
-end of file character marker.
-For read-write channels, a two-element list specifies
-the end of file marker for input and output, respectively.
-As a convenience, when setting the end-of-file character
-for a read-write channel
-you can specify a single value that will apply to both reading and writing.
-When querying the end-of-file character of a read-write channel,
-a two-element list will always be returned.
-The default value for \fB\-eofchar\fR is the empty string in all
-cases except for files under Windows. In that case the \fB\-eofchar\fR
-is Control-z (\ex1a) for reading and the empty string for writing.
+.
+This option supports DOS file systems that use Control-z (\ex1a) as an
+end of file marker. If \fIchar\fR is not an empty string, then this
+character signals end-of-file when it is encountered during input. For
+output, the end-of-file character is output when the channel is closed.
+If \fIchar\fR is the empty string, then there is no special end of file
+character marker. For read-write channels, a two-element list specifies
+the end of file marker for input and output, respectively. As a
+convenience, when setting the end-of-file character for a read-write
+channel you can specify a single value that will apply to both reading
+and writing. When querying the end-of-file character of a read-write
+channel, a two-element list will always be returned. The default value
+for \fB\-eofchar\fR is the empty string in all cases except for files
+under Windows. In that case the \fB\-eofchar\fR is Control-z (\ex1a) for
+reading and the empty string for writing.
.TP
\fB\-translation\fR \fImode\fR
.TP
-\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 a line may be
-represented differently on different platforms, or even for
-different devices on the same platform. For example, under UNIX
-newlines are used in files, whereas carriage-return-linefeed
-sequences are normally used in network connections.
-On input (i.e., with \fBgets\fP and \fBread\fP)
-the Tcl I/O system automatically translates the external end-of-line
-representation into newline characters.
-Upon output (i.e., with \fBputs\fP),
-the I/O system translates newlines to the external
-end-of-line representation.
-The default translation mode, \fBauto\fP, handles all the common
-cases automatically, but the \fB\-translation\fR option provides
-explicit control over the end of line translations.
+\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
+a line may be represented differently on different platforms, or even for
+different devices on the same platform. For example, under UNIX newlines
+are used in files, whereas carriage-return-linefeed sequences are
+normally used in network connections. On input (i.e., with \fBgets\fP
+and \fBread\fP) the Tcl I/O system automatically translates the external
+end-of-line representation into newline characters. Upon output (i.e.,
+with \fBputs\fP), the I/O system translates newlines to the external
+end-of-line representation. The default translation mode, \fBauto\fP,
+handles all the common cases automatically, but the \fB\-translation\fR
+option provides explicit control over the end of line translations.
.RS
.PP
The value associated with \fB\-translation\fR is a single item for
-read-only and write-only channels.
-The value is a two-element list for read-write channels;
-the read translation mode is the first element of the list,
-and the write translation mode is the second element.
-As a convenience, when setting the translation mode for a read-write channel
-you can specify a single value that will apply to both reading and writing.
-When querying the translation mode of a read-write channel,
-a two-element list will always be returned.
-The following values are currently supported:
+read-only and write-only channels. The value is a two-element list for
+read-write channels; the read translation mode is the first element of
+the list, and the write translation mode is the second element. As a
+convenience, when setting the translation mode for a read-write channel
+you can specify a single value that will apply to both reading and
+writing. When querying the translation mode of a read-write channel, a
+two-element list will always be returned. The following values are
+currently supported:
.TP
\fBauto\fR
-As the input translation mode, \fBauto\fR treats any of newline (\fBlf\fP),
-carriage return (\fBcr\fP), or carriage return followed by a newline (\fBcrlf\fP)
-as the end of line representation. The end of line representation can
-even change from line-to-line, and all cases are translated to a newline.
-As the output translation mode, \fBauto\fR chooses a platform specific
-representation; for sockets on all platforms Tcl
-chooses \fBcrlf\fR, for all Unix flavors, it chooses \fBlf\fR, for the
+.
+As the input translation mode, \fBauto\fR treats any of newline
+(\fBlf\fP), carriage return (\fBcr\fP), or carriage return followed by a
+newline (\fBcrlf\fP) as the end of line representation. The end of line
+representation can even change from line-to-line, and all cases are
+translated to a newline. As the output translation mode, \fBauto\fR
+chooses a platform specific representation; for sockets on all platforms
+Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses \fBlf\fR, for the
Macintosh platform it chooses \fBcr\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.
+Windows it chooses \fBcrlf\fR. The default setting for
+\fB\-translation\fR is \fBauto\fR for both input and output.
+.VS 8.1 br
.TP
-\fBbinary\fR
+\fBbinary\fR
+.
No end-of-line translations are performed. This is nearly identical to
\fBlf\fP mode, except that in addition \fBbinary\fP mode also sets the
-end of file character to the empty string, which disables it.
-See the description of
-\fB\-eofchar\fP for more information.
+end-of-file character to the empty string (which disables it) and sets the
+encoding to \fBbinary\fR (which disables encoding filtering). See the
+description of \fB\-eofchar\fR and \fB\-encoding\fR for more information.
+.VE
.TP
\fBcr\fR
-The end of a line in the underlying file or device is represented
-by a single carriage return character.
-As the input translation mode, \fBcr\fP mode converts carriage returns
-to newline characters.
-As the output translation mode, \fBcr\fP mode
-translates newline characters to carriage returns.
-This mode is typically used on Macintosh platforms.
+.
+The end of a line in the underlying file or device is represented by a
+single carriage return character. As the input translation mode,
+\fBcr\fP mode converts carriage returns to newline characters. As the
+output translation mode, \fBcr\fP mode translates newline characters to
+carriage returns. This mode is typically used on Macintosh platforms.
.TP
\fBcrlf\fR
-The end of a line in the underlying file or device is represented
-by a carriage return character followed by a linefeed character.
-As the input translation mode, \fBcrlf\fP mode converts
-carriage-return-linefeed sequences
-to newline characters.
-As the output translation mode, \fBcrlf\fP mode
-translates newline characters to
-carriage-return-linefeed sequences.
-This mode is typically used on Windows platforms and for network
-connections.
+.
+The end of a line in the underlying file or device is represented by a
+carriage return character followed by a linefeed character. As the input
+translation mode, \fBcrlf\fP mode converts carriage-return-linefeed
+sequences to newline characters. As the output translation mode,
+\fBcrlf\fP mode translates newline characters to carriage-return-linefeed
+sequences. This mode is typically used on Windows platforms and for
+network connections.
.TP
\fBlf\fR
-The end of a line in the underlying file or device is represented
-by a single newline (linefeed) character.
-In this mode no translations occur during either input or output.
-This mode is typically used on UNIX platforms.
+.
+The end of a line in the underlying file or device is represented by a
+single newline (linefeed) character. In this mode no translations occur
+during either input or output. This mode is typically used on UNIX
+platforms.
.RE
.PP
@@ -175,4 +197,5 @@ close(n), flush(n), gets(n), puts(n), read(n), socket(n)
.SH KEYWORDS
blocking, buffering, carriage return, end of line, flushing, linemode,
-newline, nonblocking, platform, translation
+newline, nonblocking, platform, translation, encoding, filter, byte array,
+binary
diff --git a/tcl/doc/file.n b/tcl/doc/file.n
index 530b9ffacf7..886e32f9c3e 100644
--- a/tcl/doc/file.n
+++ b/tcl/doc/file.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH file n 7.6 Tcl "Tcl Built-In Commands"
+.TH file n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -26,14 +26,14 @@ 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
+\fBfile atime \fIname\fR ?\fBtime\fR?
.
-Returns a decimal string giving the time at which file \fIname\fR
-was last accessed. The time is measured in the standard POSIX
-fashion as seconds from a fixed starting time (often January 1, 1970).
-If the file doesn't exist or its access time cannot be queried then an
-error is generated.
-.VS
+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
+for the file. The time is measured in the standard POSIX fashion as
+seconds from a fixed starting time (often January 1, 1970). If the file
+doesn't exist or its access time cannot be queried or set then an error is
+generated. On Windows, FAT file systems do not support access time.
.TP
\fBfile attributes \fIname\fR
.br
@@ -47,13 +47,18 @@ flags and their values. The second form returns the value for the
specific option. The third form sets one or more of the values. The
values are as follows:
.PP
-On Unix, \fB-group\fR gets or sets the group name for the file. A group id can
-be given to the command, but it returns a group name. \fB-owner\fR
-gets or sets the user name of the owner of the file. The command
-returns the owner name, but the numerical id can be passed when
-setting the owner. \fB-permissions\fR sets or retrieves the octal code
-that chmod(1) uses. This command does not support the symbolic
-attributes for chmod(1) at this time.
+On Unix, \fB-group\fR gets or sets the group name for the file. A group id
+can be given to the command, but it returns a group name. \fB-owner\fR gets
+or sets the user name of the owner of the file. The command returns the
+owner name, but the numerical id can be passed when setting the
+owner. \fB-permissions\fR sets or retrieves the octal code that chmod(1)
+uses. This command does also has limited support for setting using the
+symbolic attributes for chmod(1), of the form [ugo]?[[+\-=][rwxst],[...]],
+where multiple symbolic attributes can be separated by commas (example:
+\fBu+s,go\-rw\fR add sticky bit for user, remove read and write
+permissions for group and other). A simplified \fBls\fR style string,
+of the form rwxrwxrwx (must be 9 characters), is also supported
+(example: \fBrwxr\-xr\-t\fR is equivalent to 01755).
.PP
On Windows, \fB-archive\fR gives the value or sets or clears the
archive attribute of the file. \fB-hidden\fR gives the value or sets
@@ -72,8 +77,16 @@ attribute of the file. Note that directories can only be locked if
File Sharing is turned on. \fB-type\fR gives or sets the Finder file
type for the file.
.RE
+.VS
+.TP
+\fBfile channels ?\fIpattern\fR?
+.
+If \fIpattern\fR isn't specified, returns a list of names of all
+registered open channels in this interpreter. If \fIpattern\fR is
+specified, only those names matching \fIpattern\fR are returned. Matching
+is determined using the same rules as for \fBstring match\fR.
.VE
-.PP
+.TP
\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR
.br
\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR ?\fIsource\fR ...? \fItargetDir\fR
@@ -188,21 +201,20 @@ no action is taken and no error is returned. Trying to overwrite an existing
file with a directory will result in an error. Arguments are processed in
the order specified, halting at the first error, if any.
.TP
-\fBfile mtime \fIname\fR
+\fBfile mtime \fIname\fR ?\fItime\fR?
.
-Returns a decimal string giving the time at which file \fIname\fR was
-last modified. The time is measured in the standard POSIX fashion as
-seconds from a fixed starting time (often January 1, 1970). If the file
-doesn't exist or its modified time cannot be queried then an error is
-generated.
-.VS
+Returns a decimal string giving the time at which file \fIname\fR was last
+modified. If \fItime\fR is specified, it is a modification time to set for
+the file (equivalent to Unix \fBtouch\fR). The time is measured in the
+standard POSIX fashion as seconds from a fixed starting time (often January
+1, 1970). If the file doesn't exist or its modified time cannot be queried
+or set then an error is generated.
.TP
\fBfile nativename \fIname\fR
.
Returns the platform-specific name of the file. This is useful if the
filename is needed to pass to a platform-specific call, such as exec
under Windows or AppleScript on the Macintosh.
-.VE
.TP
\fBfile owned \fIname\fR
.
@@ -305,13 +317,14 @@ Returns a string giving the type of file \fIname\fR, which will be one of
.TP
\fBfile volume\fR
.
-Returns the absolute paths to the volumes mounted on the system, as a proper
-Tcl list. On the Macintosh, this will be a list of the mounted drives,
-both local and network. N.B. if two drives have the same name, they will
-both appear on the volume list, but there is currently no way, from Tcl, to
-access any but the first of these drives. On UNIX, the command will always return
-"/", since all filesystems are locally mounted. On Windows, it will return
-a list of the available local drives (e.g. {a:/ c:/}).
+Returns the absolute paths to the volumes mounted on the system, as a
+proper Tcl list. On the Macintosh, this will be a list of the mounted
+drives, both local and network. N.B. if two drives have the same name,
+they will both appear on the volume list, but there is currently no way,
+from Tcl, to access any but the first of these drives. On UNIX, the
+command will always return "/", since all filesystems are locally mounted.
+On Windows, it will return a list of the available local drives
+(e.g. {a:/ c:/}).
.TP
\fBfile writable \fIname\fR
.
diff --git a/tcl/doc/filename.n b/tcl/doc/filename.n
index b0a979aa084..31001e41c61 100644
--- a/tcl/doc/filename.n
+++ b/tcl/doc/filename.n
@@ -26,7 +26,7 @@ Instead, portable scripts must use the \fBfile split\fR and \fBfile
join\fR commands to manipulate file names (see the \fBfile\fR manual
entry for more details).
-.SH PATH TYPES
+.SH "PATH TYPES"
.PP
File names are grouped into three general types based on the starting point
for the path used to specify the file: absolute, relative, and
@@ -39,7 +39,7 @@ current volume, or relative to the current directory of the specified
volume. The \fBfile pathtype\fR command can be used to determine the
type of a given path.
-.SH PATH SYNTAX
+.SH "PATH SYNTAX"
.PP
The rules for native names depend on the value reported in the Tcl
array element \fBtcl_platform(platform)\fR:
@@ -163,7 +163,7 @@ Volume-relative path to a file \fBfoo\fR in the root directory of the current
volume.
.RE
-.SH TILDE SUBSTITUTION
+.SH "TILDE SUBSTITUTION"
.PP
In addition to the file name rules described above, Tcl also supports
\fIcsh\fR-style tilde substitution. If a file name starts with a
@@ -181,7 +181,7 @@ use a tilde followed by a user name will generate an error. File
names that have a tilde without a user name will be substituted using
the \fB$HOME\fR environment variable, just like for Unix.
-.SH PORTABILITY ISSUES
+.SH "PORTABILITY ISSUES"
.PP
Not all file systems are case sensitive, so scripts should avoid code
that depends on the case of characters in a file name. In addition,
diff --git a/tcl/doc/format.n b/tcl/doc/format.n
index d8d55622a20..9d196e204b1 100644
--- a/tcl/doc/format.n
+++ b/tcl/doc/format.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH format n "" Tcl "Tcl Built-In Commands"
+.TH format n 8.1 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -154,9 +154,11 @@ Convert integer to unsigned octal string.
\fBx\fR or \fBX\fR
Convert integer to unsigned hexadecimal string, using digits
``0123456789abcdef'' for \fBx\fR and ``0123456789ABCDEF'' for \fBX\fR).
+.VS
.TP 10
\fBc\fR
-Convert integer to the 8-bit character it represents.
+Convert integer to the Unicode character it represents.
+.VE
.TP 10
\fBs\fR
No conversion; just insert string.
diff --git a/tcl/doc/glob.n b/tcl/doc/glob.n
index bfad9e4da32..458e1ff6121 100644
--- a/tcl/doc/glob.n
+++ b/tcl/doc/glob.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH glob n 7.5 Tcl "Tcl Built-In Commands"
+.TH glob n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -26,11 +26,70 @@ of the \fIpattern\fR arguments.
If the initial arguments to \fBglob\fR start with \fB\-\fR then
they are treated as switches. The following switches are
currently supported:
-.TP 15
+.VS 8.3
+.TP
+\fB\-directory\fR \fIdirectory\fR
+Search for files which match the given patterns starting in the given
+\fIdirectory\fR. This allows searching of directories whose name
+contains glob-sensitive characters without the need to quote such
+characters explicitly. This option may not be used in conjunction with
+\fB\-path\fR.
+.TP
+\fB\-join\fR
+The remaining pattern arguments are treated as a single pattern
+obtained by joining the arguments with directory separators.
+.VE 8.3
+.TP
\fB\-nocomplain\fR
Allows an empty list to be returned without error; without this
switch an error is returned if the result list would be empty.
-.TP 15
+.VS 8.3
+.TP
+\fB\-path\fR \fIpathPrefix\fR
+Search for files with the given \fIpathPrefix\fR where the rest of the name
+matches the given patterns. This allows searching for files with names
+similar to a given file even when the names contain glob-sensitive
+characters. This option may not be used in conjunction with
+\fB\-directory\fR.
+.TP
+\fB\-types\fR \fItypeList\fR
+Only list files or directories which match \fItypeList\fR, where the items
+in the list have two forms. The first form is like the \-type option of
+the Unix find command:
+\fIb\fR (block special file),
+\fIc\fR (character special file),
+\fId\fR (directory),
+\fIf\fR (plain file),
+\fIl\fR (symbolic link),
+\fIp\fR (named pipe),
+or \fIs\fR (socket), where multiple types may be specified in the list.
+\fBGlob\fR will return all files which match at least one of the types given.
+.RS
+.PP
+The second form specifies types where all the types given must match.
+These are \fIr\fR, \fIw\fR, \fIx\fR as file permissions, and
+\fIreadonly\fR, \fIhidden\fR as special permission cases. On the
+Macintosh, MacOS types and creators are also supported, where any item
+which is four characters long is assumed to be a MacOS type
+(e.g. \fBTEXT\fR). Items which are of the form \fI{macintosh type XXXX}\fR
+or \fI{macintosh creator XXXX}\fR will match types or creators
+respectively. Unrecognised types, or specifications of multiple MacOS
+types/creators will signal an error.
+.PP
+The two forms may be mixed, so \fB\-types {d f r w}\fR will find all
+regular files OR directories that have both read AND write permissions.
+The following are equivalent:
+.RS
+.CS
+\fBglob \-type d *\fR
+\fBglob */\fR
+.CE
+.RE
+except that the first case doesn't return the trailing ``/'' and
+is more platform independent.
+.RE
+.VE 8.3
+.TP
\fB\-\|\-\fR
Marks the end of switches. The argument following this one will
be treated as a \fIpattern\fR even if it starts with a \fB\-\fR.
@@ -71,14 +130,30 @@ Second, \fBglob\fR only returns the names of files that actually
exist; in csh no check for existence is made unless a pattern
contains a ?, *, or [] construct.
-.SH PORTABILITY ISSUES
+.SH "PORTABILITY ISSUES"
.PP
Unlike other Tcl commands that will accept both network and native
style names (see the \fBfilename\fR manual entry for details on how
native and network names are specified), the \fBglob\fR command only
-accepts native names. Also, for Windows UNC names, the servername and
-sharename components of the path may not contain ?, *, or []
-constructs.
+accepts native names.
+.TP
+\fBWindows\fR
+.
+For Windows UNC names, the servername and sharename components of the path
+may not contain ?, *, or [] constructs. On Windows NT, if \fIpattern\fR is
+of the form ``\fB~\fIusername\fB@\fIdomain\fR'' 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 accepts patterns
+like ``.../'' and ``..../'' for successively higher up parent directories.
+.TP
+\fBMacintosh\fR
+.
+When using the options, \fB\-dir\fR, \fB\-join\fR or \fB\-path\fR, glob
+assumes the directory separator for the entire pattern is the standard
+``:''. When not using these options, glob examines each pattern argument
+and uses ``/'' unless the pattern contains a ``:''.
+
.SH KEYWORDS
exist, file, glob, pattern
diff --git a/tcl/doc/http.n b/tcl/doc/http.n
index 18ffc89f88f..fb2de76392e 100644
--- a/tcl/doc/http.n
+++ b/tcl/doc/http.n
@@ -1,5 +1,6 @@
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
+'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -7,13 +8,13 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH "Http" n 8.0 Tcl "Tcl Built-In Commands"
+.TH "Http" n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
Http \- Client-side implementation of the HTTP/1.0 protocol.
.SH SYNOPSIS
-\fBpackage require http ?2.0?\fP
+\fBpackage require http ?2.3?\fP
.sp
\fB::http::config \fI?options?\fR
.sp
@@ -31,7 +32,17 @@ Http \- Client-side implementation of the HTTP/1.0 protocol.
.sp
\fB::http::code \fItoken\fR
.sp
+\fB::http::ncode \fItoken\fR
+.sp
\fB::http::data \fItoken\fR
+.sp
+\fB::http::error \fItoken\fR
+.sp
+\fB::http::cleanup \fItoken\fR
+.sp
+\fB::http::register \fIproto port command\fR
+.sp
+\fB::http::unregister \fIproto\fR
.BE
.SH DESCRIPTION
@@ -41,16 +52,17 @@ protocol. The package implements the GET, POST, and HEAD operations
of HTTP/1.0. It allows configuration of a proxy host to get through
firewalls. The package is compatible with the \fBSafesock\fR security
policy, so it can be used by untrusted applets to do URL fetching from
-a restricted set of hosts.
+a restricted set of hosts. This package can be extened to support
+additional HTTP transport protocols, such as HTTPS, by providing
+a custom \fBsocket\fR command, via \fBhttp::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.
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 of this array are
-described in the STATE ARRAY section.
+that contains state information about the transaction. The elements
+of this array are described in the STATE ARRAY section.
.PP
If the \fB-command\fP option is specified, then
the HTTP operation is done in the background.
@@ -98,7 +110,7 @@ non-empty.
.TP
\fB\-useragent\fP \fIstring\fP
The value of the User-Agent header in the HTTP request. The default
-is \fB"Tcl http client package 2.0."\fR
+is \fB"Tcl http client package 2.2."\fR
.RE
.TP
\fB::http::geturl\fP \fIurl\fP ?\fIoptions\fP?
@@ -107,7 +119,7 @@ The \fB\-query\fR option causes a POST operation and
the \fB\-validate\fR option causes a HEAD operation;
otherwise, a GET operation is performed. The \fB::http::geturl\fR command
returns a \fItoken\fR value that can be used to get
-information about the transaction. See the STATE ARRAY section for
+information about the transaction. See the STATE ARRAY and ERRORS section for
details. The \fB::http::geturl\fR command blocks until the operation
completes, unless the \fB\-command\fR option specifies a callback
that is invoked when the HTTP transaction completes.
@@ -120,7 +132,7 @@ At most
\fIsize\fR
bytes are read at once. After each block, a call to the
\fB\-progress\fR
-callback is made.
+callback is made (if that option is specified).
.TP
\fB\-channel\fP \fIname\fP
Copy the URL contents to channel \fIname\fR instead of saving it in
@@ -196,6 +208,28 @@ This flag causes \fB::http::geturl\fR to do a POST request that passes the
formatted query. The \fB::http::formatQuery\fR procedure can be used to
do the formatting.
.TP
+\fB\-queryblocksize\fP \fIsize\fP
+The blocksize used when posting query data to the URL.
+At most
+\fIsize\fR
+bytes are written at once. After each block, a call to the
+\fB\-queryprogress\fR
+callback is made (if that option is specified).
+.TP
+\fB\-querychannel\fP \fIchannelID\fP
+This flag causes \fB::http::geturl\fR to do a POST request that passes the
+data contained in \fIchannelID\fR to the server. The data contained in \fIchannelID\fR must be a x-url-encoding
+formatted query unless the \fB\-type\fP option below is used.
+If a Content-Length header is not specified via the \fB\-headers\fR options,
+\fB::http::geturl\fR attempts to determine the size of the post data
+in order to create that header. If it is
+unable to determine the size, it returns an error.
+.TP
+\fB\-queryprogress\fP \fIcallback\fP
+The \fIcallback\fR is made after each transfer of data to the URL
+(i.e. POST) and acts exactly like the \fB\-progress\fR option (the
+callback format is the same).
+.TP
\fB\-timeout\fP \fImilliseconds\fP
If \fImilliseconds\fR is non-zero, then \fB::http::geturl\fR sets up a timeout
to occur after the specified number of milliseconds.
@@ -204,6 +238,11 @@ the \fB-command\fP callback, if specified.
The return value of \fB::http::status\fP is \fBtimeout\fP
after a timeout has occurred.
.TP
+\fB\-type\fP \fImime-type\fP
+Use \fImime-type\fR as the \fBContent-Type\fR value, instead of the
+default value (\fBapplication/x-www-form-urlencoded\fR) during a
+POST operation.
+.TP
\fB\-validate\fP \fIboolean\fP
If \fIboolean\fR is non-zero, then \fB::http::geturl\fR does an HTTP HEAD
request. This request returns meta information about the URL, but the
@@ -226,12 +265,20 @@ any. This sets the \fBstate(status)\fP value to \fIwhy\fP, which defaults to \f
\fB::http::wait\fP \fItoken\fP
This is a convenience procedure that blocks and waits for the
transaction to complete. This only works in trusted code because it
-uses \fBvwait\fR.
+uses \fBvwait\fR. Also, it's not useful for the case where
+\fB::http::geturl\fP is called \fIwithout\fP the \fB-command\fP option
+because in this case the \fB::http::geturl\fP call doesn't return
+until the HTTP transaction is complete, and thus there's nothing to
+wait for.
.TP
\fB::http::data\fP \fItoken\fP
This is a convenience procedure that returns the \fBbody\fP element
(i.e., the URL data) of the state array.
.TP
+\fB::http::error\fP \fItoken\fP
+This is a convenience procedure that returns the \fBerror\fP element
+of the state array.
+.TP
\fB::http::status\fP \fItoken\fP
This is a convenience procedure that returns the \fBstatus\fP element of
the state array.
@@ -240,9 +287,108 @@ the state array.
This is a convenience procedure that returns the \fBhttp\fP element of the
state array.
.TP
+\fB::http::ncode\fP \fItoken\fP
+This is a convenience procedure that returns just the numeric return
+code (200, 404, etc.) from the \fBhttp\fP element of the state array.
+.TP
\fB::http::size\fP \fItoken\fP
This is a convenience procedure that returns the \fBcurrentsize\fP
-element of the state array.
+element of the state array, which represents the number of bytes
+received from the URL in the \fB::http::geturl\fP call.
+.TP
+\fB::http::cleanup\fP \fItoken\fP
+This procedure cleans up the state associated with the connection
+identified by \fItoken\fP. After this call, the procedures
+like \fB::http::data\fP cannot be used to get information
+about the operation. It is \fIstrongly\fP recommended that you call
+this function after you're done with a given HTTP request. Not doing
+so will result in memory not being freed, and if your app calls
+\fB::http::geturl\fP enough times, the memory leak could cause a
+performance hit...or worse.
+.TP
+\fB::http::register\fP \fIproto port command\fP
+This procedure allows one to provide custom HTTP transport types
+such as HTTPS, by registering a prefix, the default port, and the
+command to execute to create the Tcl \fBchannel\fR. E.g.:
+.RS
+.CS
+package require http
+package require tls
+
+http::register https 443 ::tls::socket
+
+set token [http::geturl https://my.secure.site/]
+.CE
+.RE
+.TP
+\fB::http::unregister\fP \fIproto\fP
+This procedure unregisters a protocol handler that was previously
+registered via \fBhttp::register\fR.
+
+.SH "ERRORS"
+The \fBhttp::geturl\fP procedure will raise errors in the following cases:
+invalid command line options,
+an invalid URL,
+a URL on a non-existent host,
+or a URL at a bad port on an existing host.
+These errors mean that it
+cannot even start the network transaction.
+It will also raise an error if it gets an I/O error while
+writing out the HTTP request header.
+For synchronous \fB::http::geturl\fP calls (where \fB-command\fP is
+not specified), it will raise an error if it gets an I/O error while
+reading the HTTP reply headers or data. Because \fB::http::geturl\fP
+doesn't return a token in these cases, it does all the required
+cleanup and there's no issue of your app having to call
+\fB::http::cleanup\fP.
+.PP
+For asynchronous \fB::http::geturl\fP calls, all of the above error
+situations apply, except that if there's any error while
+reading the
+HTTP reply headers or data, no exception is thrown. This is because
+after writing the HTTP headers, \fB::http::geturl\fP returns, and the
+rest of the HTTP transaction occurs in the background. The command
+callback can check if any error occurred during the read by calling
+\fB::http::status\fP to check the status and if it's \fIerror\fP,
+calling \fB::http::error\fP to get the error message.
+.PP
+Alternatively, if the main program flow reaches a point where it needs
+to know the result of the asynchronous HTTP request, it can call
+\fB::http::wait\fP and then check status and error, just as the
+callback does.
+.PP
+In any case, you must still call
+\fBhttp::cleanup\fP to delete the state array when you're done.
+.PP
+There are other possible results of the HTTP transaction
+determined by examining the status from \fBhttp::status\fP.
+These are described below.
+.TP
+ok
+If the HTTP transaction completes entirely, then status will be \fBok\fP.
+However, you should still check the \fBhttp::code\fP value to get
+the HTTP status. The \fBhttp::ncode\fP procedure provides just
+the numeric error (e.g., 200, 404 or 500) while the \fBhttp::code\fP
+procedure returns a value like "HTTP 404 File not found".
+.TP
+eof
+If the server closes the socket without replying, then no error
+is raised, but the status of the transaction will be \fBeof\fP.
+.TP
+error
+The error message will also be stored in the \fBerror\fP status
+array element, accessible via \fB::http::error\fP.
+.PP
+Another error possibility is that \fBhttp::geturl\fP is unable to
+write all the post query data to the server before the server
+responds and closes the socket.
+The error message is saved in the \fBposterror\fP status array
+element and then \fBhttp::geturl\fP attempts to complete the
+transaction.
+If it can read the server's response
+it will end up with an \fBok\fP status, otherwise it will have
+an \fBeof\fP status.
+
.SH "STATE ARRAY"
The \fB::http::geturl\fR procedure returns a \fItoken\fR that can be used to
get to the state of the HTTP transaction in the form of a Tcl array.
@@ -250,7 +396,11 @@ Use this construct to create an easy-to-use array variable:
.CS
upvar #0 $token state
.CE
-The following elements of the array are supported:
+Once the data associated with the url is no longer needed, the state
+array should be unset to free up storage.
+The \fBhttp::cleanup\fP procedure is provided for that purpose.
+The following elements of
+the array are supported:
.RS
.TP
\fBbody\fR
@@ -270,7 +420,7 @@ The HTTP status reply from the server. This value
is returned by the \fB::http::code\fP command. The format of this value is:
.RS
.CS
-\fIcode string\fP
+\fIHTTP/1.0 code string\fP
.CE
The \fIcode\fR is a three-digit number defined in the HTTP standard.
A code of 200 is OK. Codes beginning with 4 or 5 indicate errors.
@@ -304,9 +454,14 @@ The advertised size of the contents. The actual size obtained by
An alternate URL that contains the requested data.
.RE
.TP
+\fBposterror\fR
+The error, if any, that occurred while writing
+the post query data to the server.
+.TP
\fBstatus\fR
Either \fBok\fR, for successful completion, \fBreset\fR for
-user-reset, or \fBerror\fR for an error condition. During the
+user-reset, \fBtimeout\fP if a timeout occurred before the transaction
+could complete, or \fBerror\fR for an error condition. During the
transaction this value is the empty string.
.TP
\fBtotalsize\fR
@@ -358,3 +513,4 @@ safe(n), socket(n), safesock(n)
security policy, socket
+
diff --git a/tcl/doc/info.n b/tcl/doc/info.n
index e538086f077..44df52f37bf 100644
--- a/tcl/doc/info.n
+++ b/tcl/doc/info.n
@@ -72,8 +72,8 @@ into variable \fIvarname\fR.
.TP
\fBinfo exists \fIvarName\fR
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
-current context (either as a global or local variable), returns \fB0\fR
-otherwise.
+current context (either as a global or local variable) and has been
+defined by being given a value, returns \fB0\fR otherwise.
.TP
\fBinfo globals \fR?\fIpattern\fR?
If \fIpattern\fR isn't specified, returns a list of all the names
diff --git a/tcl/doc/interp.n b/tcl/doc/interp.n
index 1f603c26a8b..ee29c11e110 100644
--- a/tcl/doc/interp.n
+++ b/tcl/doc/interp.n
@@ -375,21 +375,23 @@ A safe interpreter is created with exactly the following set of
built-in commands:
.DS
.ta 1.2i 2.4i 3.6i
-\fBafter append array break
-case catch clock close
-concat continue eof error
-eval expr fblocked fileevent
-flush for foreach format
-gets global history if
-incr info interp join
-lappend lindex linsert list
-llength lower lrange lreplace
-lsearch lsort package pid
-proc puts read rename
+\fBafter append array binary
+break case catch clock
+close concat continue eof
+error eval expr fblocked
+fcopy fileevent flush for
+foreach format gets global
+history if incr info
+interp join lappend lindex
+linsert list llength lrange
+lreplace lsearch lsort namespace
+package pid proc puts
+read regexp regsub rename
return scan seek set
split string subst switch
tell trace unset update
-uplevel upvar vwait while\fR
+uplevel upvar variable vwait
+while\fR
.DE
.VS "" BR
The following commands are hidden by \fBinterp create\fR when it
diff --git a/tcl/doc/library.n b/tcl/doc/library.n
index 5b9c59d7ef5..54ef6ad50da 100644
--- a/tcl/doc/library.n
+++ b/tcl/doc/library.n
@@ -10,13 +10,15 @@
.TH library n "8.0" Tcl "Tcl Built-In Commands"
.BS
.SH NAME
-library \- standard library of Tcl procedures
+auto_execok, auto_import, auto_load, auto_mkindex, auto_mkindex_old, auto_qualify, auto_reset, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures
.SH SYNOPSIS
.nf
\fBauto_execok \fIcmd\fR
+\fBauto_import \fIpattern\fR
\fBauto_load \fIcmd\fR
\fBauto_mkindex \fIdir pattern pattern ...\fR
\fBauto_mkindex_old \fIdir pattern pattern ...\fR
+\fBauto_qualify \fIcommand namespace\fR
\fBauto_reset\fR
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
\fBparray \fIarrayName\fR
@@ -60,76 +62,74 @@ the auto-load mechanism defined below.
The following procedures are provided in the Tcl library:
.TP
\fBauto_execok \fIcmd\fR
-Determines whether there is an executable file by the name \fIcmd\fR.
-This command examines the directories in the current search path
-(given by the PATH environment variable) to see if there is an
-executable file named \fIcmd\fR in any of those directories.
-If so, it returns 1; if not it returns 0. \fBAuto_exec\fR
-remembers information about previous searches in an array
-named \fBauto_execs\fR; this avoids the path search in
-future calls for the same \fIcmd\fR. The command \fBauto_reset\fR
-may be used to force \fBauto_execok\fR to forget its cached
-information.
+Determines whether there is an executable file or shell builtin
+by the name \fIcmd\fR. If so, it returns a list of arguments to be
+passed to \fBexec\fR to execute the executable file or shell builtin
+named by \fIcmd\fR. If not, it returns an empty string. This command
+examines the directories in the current search path (given by the PATH
+environment variable) in its search for an executable file named
+\fIcmd\fR. On Windows platforms, the search is expanded with the same
+directories and file extensions as used by \fBexec\fR. \fBAuto_exec\fR
+remembers information about previous searches in an array named
+\fBauto_execs\fR; this avoids the path search in future calls for the
+same \fIcmd\fR. The command \fBauto_reset\fR may be used to force
+\fBauto_execok\fR to forget its cached information.
+.TP
+\fBauto_import \fIpattern\fR
+\fBAuto_import\fR is invoked during \fBnamespace import\fR to see if
+the imported commands specified by \fIpattern\fR reside in an
+autoloaded library. If so, the commands are loaded so that they will
+be available to the interpreter for creating the import links. If the
+commands do not reside in an autoloaded library, \fBauto_import\fR
+does nothing.
.TP
\fBauto_load \fIcmd\fR
This command attempts to load the definition for a Tcl command named
-\fIcmd\fR.
-To do this, it searches an \fIauto-load path\fR, which is a list of
-one or more directories.
-The auto-load path is given by the global variable \fB$auto_path\fR
-if it exists.
-If there is no \fB$auto_path\fR variable, then the TCLLIBPATH environment
-variable is used, if it exists.
-Otherwise the auto-load path consists of just the Tcl library directory.
-Within each directory in the auto-load path there must be a file
-\fBtclIndex\fR that describes one
-or more commands defined in that directory
-and a script to evaluate to load each of the commands.
-The \fBtclIndex\fR file should be generated with the
-\fBauto_mkindex\fR command.
-If \fIcmd\fR is found in an index file, then the appropriate
-script is evaluated to create the command.
-The \fBauto_load\fR command returns 1 if \fIcmd\fR was successfully
-created.
-The command returns 0 if there was no index entry for \fIcmd\fR
-or if the script didn't actually define \fIcmd\fR (e.g. because
-index information is out of date).
-If an error occurs while processing the script, then that error
-is returned.
-\fBAuto_load\fR only reads the index information once and saves it
-in the array \fBauto_index\fR; future calls to \fBauto_load\fR
-check for \fIcmd\fR in the array rather than re-reading the index
-files.
-The cached index information may be deleted with the command
-\fBauto_reset\fR.
-This will force the next \fBauto_load\fR command to reload the
-index database from disk.
+\fIcmd\fR. To do this, it searches an \fIauto-load path\fR, which is
+a list of one or more directories. The auto-load path is given by the
+global variable \fB$auto_path\fR if it exists. If there is no
+\fB$auto_path\fR variable, then the TCLLIBPATH environment variable is
+used, if it exists. Otherwise the auto-load path consists of just the
+Tcl library directory. Within each directory in the auto-load path
+there must be a file \fBtclIndex\fR that describes one or more
+commands defined in that directory and a script to evaluate to load
+each of the commands. The \fBtclIndex\fR file should be generated
+with the \fBauto_mkindex\fR command. If \fIcmd\fR is found in an
+index file, then the appropriate script is evaluated to create the
+command. The \fBauto_load\fR command returns 1 if \fIcmd\fR was
+successfully created. The command returns 0 if there was no index
+entry for \fIcmd\fR or if the script didn't actually define \fIcmd\fR
+(e.g. because index information is out of date). If an error occurs
+while processing the script, then that error is returned.
+\fBAuto_load\fR only reads the index information once and saves it in
+the array \fBauto_index\fR; future calls to \fBauto_load\fR check for
+\fIcmd\fR in the array rather than re-reading the index files. The
+cached index information may be deleted with the command
+\fBauto_reset\fR. This will force the next \fBauto_load\fR command to
+reload the index database from disk.
.TP
\fBauto_mkindex \fIdir pattern pattern ...\fR
-Generates an index suitable for use by \fBauto_load\fR.
-The command searches \fIdir\fR for all files whose names match
-any of the \fIpattern\fR arguments
-(matching is done with the \fBglob\fR command),
-generates an index of all the Tcl command
-procedures defined in all the matching files, and stores the
-index information in a file named \fBtclIndex\fR in \fIdir\fR.
-If no pattern is given a pattern of \fB*.tcl\fR will be assumed.
-For example, the command
+Generates an index suitable for use by \fBauto_load\fR. The command
+searches \fIdir\fR for all files whose names match any of the
+\fIpattern\fR arguments (matching is done with the \fBglob\fR
+command), generates an index of all the Tcl command procedures defined
+in all the matching files, and stores the index information in a file
+named \fBtclIndex\fR in \fIdir\fR. If no pattern is given a pattern of
+\fB*.tcl\fR will be assumed. For example, the command
.RS
.CS
\fBauto_mkindex foo *.tcl\fR
.CE
.LP
-will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR
-and generate a new index file \fBfoo/tclIndex\fR.
+will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR and
+generate a new index file \fBfoo/tclIndex\fR.
.PP
-\fBAuto_mkindex\fR parses the Tcl scripts by sourcing them
-into a slave interpreter and monitoring the proc and
-namespace commands that are executed.
-Extensions can use the (undocumented)
-auto_mkindex_parser package to register other commands that
-can contribute to the auto_load index.
-You will have to read through init.tcl to see how this works.
+\fBAuto_mkindex\fR parses the Tcl scripts by sourcing them into a
+slave interpreter and monitoring the proc and namespace commands that
+are executed. Extensions can use the (undocumented)
+auto_mkindex_parser package to register other commands that can
+contribute to the auto_load index. You will have to read through
+auto.tcl to see how this works.
.PP
\fBAuto_mkindex_old\fR parses the Tcl scripts in a relatively
unsophisticated way: if any line contains the word \fBproc\fR
@@ -137,17 +137,37 @@ 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 don't appear in this way (e.g. they
-have spaces before the \fBproc\fR) will not be indexed.
+have spaces before the \fBproc\fR) will not be indexed. If your
+script contains "dangerous" code, such as global initialization
+code or procedure names with special characters like \fB$\fR,
+\fB*\fR, \fB[\fR or \fB]\fR, you are safer using auto_mkindex_old.
.RE
.TP
\fBauto_reset\fR
Destroys all the information cached by \fBauto_execok\fR and
-\fBauto_load\fR.
-This information will be re-read from disk the next time it is
-needed.
-\fBAuto_reset\fR also deletes any procedures listed in the auto-load
-index, so that fresh copies of them will be loaded the next time
-that they're used.
+\fBauto_load\fR. This information will be re-read from disk the next
+time it is needed. \fBAuto_reset\fR also deletes any procedures
+listed in the auto-load index, so that fresh copies of them will be
+loaded the next time that they're used.
+.TP
+\fBauto_qualify \fIcommand namespace\fR
+Computes a list of fully qualified names for \fIcommand\fR. This list
+mirrors the path a standard Tcl interpreter follows for command
+lookups: first it looks for the command in the current namespace, and
+then in the global namespace. Accordingly, if \fIcommand\fR is
+relative and \fInamespace\fR is not \fB::\fR, the list returned has
+two elements: \fIcommand\fR scoped by \fInamespace\fR, as if it were
+a command in the \fInamespace\fR namespace; and \fIcommand\fR as if it
+were a command in the global namespace. Otherwise, if either
+\fIcommand\fR is absolute (it begins with \fB::\fR), or
+\fInamespace\fR is \fB::\fR, the list contains only \fIcommand\fR as
+if it were a command in the global namespace.
+.RS
+.PP
+\fBAuto_qualify\fR is used by the auto-loading facilities in Tcl, both
+for producing auto-loading indexes such as \fIpkgIndex.tcl\fR, and for
+performing the actual auto-loading of functions at runtime.
+.RE
.TP
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
This is a standard search procedure for use by extensions during
@@ -253,9 +273,9 @@ 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.
-This variable is only used when
-initializing the \fBauto_path\fR variable.
+search during auto-load operations. Directories must be specified in
+Tcl format, using "/" as the path separator, regardless of platform.
+This variable is only used when initializing the \fBauto_path\fR variable.
.TP
\fBtcl_nonwordchars\fR
.VS
@@ -276,11 +296,16 @@ comprised of any character that is not a space, tab, or newline. Under
Unix, words are comprised of numbers, letters or underscores.
.VE
.TP
-\fBunknown_active\fR
-This variable is set by \fBunknown\fR to indicate that it is active.
+\fBunknown_pending\fR
+Used by \fBunknown\fR to record the command(s) for which it is
+searching.
It is used to detect errors where \fBunknown\fR recurses on itself
infinitely.
The variable is unset before \fBunknown\fR returns.
+.SH "SEE ALSO"
+re_syntax(n)
+
.SH KEYWORDS
auto-exec, auto-load, library, unknown, word, whitespace
+
diff --git a/tcl/doc/lindex.n b/tcl/doc/lindex.n
index 0771b53dfad..ec18d168a58 100644
--- a/tcl/doc/lindex.n
+++ b/tcl/doc/lindex.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH lindex n 7.4 Tcl "Tcl Built-In Commands"
+.TH lindex n 8.2 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -29,7 +29,9 @@ If \fIindex\fR is negative or greater than or equal to the number
of elements in \fIvalue\fR, then an empty
string is returned.
If \fIindex\fR has the value \fBend\fR, it refers to the last element
-in the list.
+in the list, and \fBend\-\fIinteger\fR refers to the last element in
+the list minus the specified integer offset.
+
.SH KEYWORDS
element, index, list
diff --git a/tcl/doc/linsert.n b/tcl/doc/linsert.n
index a325e4e3f2f..a44bfbcd3b8 100644
--- a/tcl/doc/linsert.n
+++ b/tcl/doc/linsert.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH linsert n 7.4 Tcl "Tcl Built-In Commands"
+.TH linsert n 8.2 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -19,15 +19,15 @@ linsert \- Insert elements into a list
.SH DESCRIPTION
.PP
-This command produces a new list from \fIlist\fR by inserting all
-of the \fIelement\fR arguments just before the \fIindex\fRth
-element of \fIlist\fR. Each \fIelement\fR argument will become
-a separate element of the new list. If \fIindex\fR is less than
-or equal to zero, then the new elements are inserted at the
-beginning of the list. If \fIindex\fR
-has the value \fBend\fR,
-or if it is greater than or equal to the number of elements in the list,
-then the new elements are appended to the list.
+This command produces a new list from \fIlist\fR by inserting all of the
+\fIelement\fR arguments just before the \fIindex\fRth element of
+\fIlist\fR. Each \fIelement\fR argument will become a separate element of
+the new list. If \fIindex\fR is less than or equal to zero, then the new
+elements are inserted at the beginning of the list. If \fIindex\fR has the
+value \fBend\fR, or if it is greater than or equal to the number of
+elements in the list, then the new elements are appended to the list.
+\fBend\-\fIinteger\fR refers to the last element in the list minus the
+specified integer offset.
.SH KEYWORDS
element, insert, list
diff --git a/tcl/doc/load.n b/tcl/doc/load.n
index 52538c9b06b..e57e54c3aa1 100644
--- a/tcl/doc/load.n
+++ b/tcl/doc/load.n
@@ -64,7 +64,7 @@ typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR);
The \fIinterp\fR argument identifies the interpreter in which the
package is to be loaded. The initialization procedure must return
\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
-successfully; in the event of an error it should set \fIinterp->result\fR
+successfully; in the event of an error it should set the interpreter's result
to point to an error message. The result of the \fBload\fR command
will be the result returned by the initialization procedure.
.PP
@@ -106,6 +106,21 @@ different files have been \fBload\fRed with different versions of
the package, Tcl picks the file that was loaded first.
.VE
+.SH "PORTABILITY ISSUES"
+.TP
+\fBWindows\fR\0\0\0\0\0
+.
+When a load fails with "library not found" error, it is also possible
+that a dependent library was not found. To see the dependent libraries,
+type ``dumpbin -imports <dllname>'' in a DOS console to see what the
+library must import.
+When loading a DLL in the current directory, Windows will ignore ``./'' as
+a path specifier and use a search heuristic to find the DLL instead.
+To avoid this, load the DLL with
+.CS
+ load [file join [pwd] mylib.DLL]
+.CE
+
.SH BUGS
.PP
If the same file is \fBload\fRed by different \fIfileName\fRs, it will
@@ -118,3 +133,4 @@ detect the redundant loads, others may not).
.SH KEYWORDS
binary code, loading, safe interpreter, shared library
+
diff --git a/tcl/doc/lreplace.n b/tcl/doc/lreplace.n
index c34ff74d5c0..3f357e92d7c 100644
--- a/tcl/doc/lreplace.n
+++ b/tcl/doc/lreplace.n
@@ -19,25 +19,29 @@ lreplace \- Replace elements in a list with new elements
.SH DESCRIPTION
.PP
-\fBLreplace\fR returns a new list formed by replacing one or more elements of
+\fBlreplace\fR returns a new list formed by replacing one or more elements of
\fIlist\fR with the \fIelement\fR arguments.
-\fIFirst\fR gives the index in \fIlist\fR of the first element
-to be replaced (0 refers to the first element).
-If \fIfirst\fR is less than zero then it refers to the first
-element of \fIlist\fR; the element indicated by \fIfirst\fR
-must exist in the list.
-\fILast\fR gives the index in \fIlist\fR of the last element
-to be replaced.
-If \fIlast\fR is less than \fIfirst\fR then no elements are deleted;
-the new elements are simply inserted before \fIfirst\fR.
-\fIFirst\fR or \fIlast\fR may be \fBend\fR
-(or any abbreviation of it) to refer to the last element of the list.
+\fIfirst\fR and \fIlast\fR specify the first and last index of the
+range of elements to replace. 0 refers to the first element of the
+list, and \fBend\fR (or any abbreviation of it) may be used to refer
+to the last element of the list. If \fIlist\fR is empty, then
+\fIfirst\fR and \fIlast\fR are ignored.
+
+If \fIfirst\fR is less than zero, it is considered to refer to the
+first element of the list. For non-empty lists, the element indicated
+by \fIfirst\fR must exist.
+
+If \fIlast\fR is less than zero but greater than \fIfirst\fR, then any
+specified elements will be prepended to the list. If \fIlast\fR is
+less than \fIfirst\fR then no elements are deleted; the new elements
+are simply inserted before \fIfirst\fR.
+
The \fIelement\fR arguments specify zero or more new arguments to
be added to the list in place of those that were deleted.
Each \fIelement\fR argument will become a separate element of
-the list.
-If no \fIelement\fR arguments are specified, then the elements
-between \fIfirst\fR and \fIlast\fR are simply deleted.
+the list. If no \fIelement\fR arguments are specified, then the elements
+between \fIfirst\fR and \fIlast\fR are simply deleted. If \fIlist\fR
+is empty, any \fIelement\fR arguments are added to the end of the list.
.SH KEYWORDS
element, list, replace
diff --git a/tcl/doc/lsearch.n b/tcl/doc/lsearch.n
index c0646dde878..b44cc142877 100644
--- a/tcl/doc/lsearch.n
+++ b/tcl/doc/lsearch.n
@@ -37,7 +37,8 @@ element using the same rules as the \fBstring match\fR command.
.TP
\fB\-regexp\fR
\fIPattern\fR is treated as a regular expression and matched against
-each list element using the same rules as the \fBregexp\fR command.
+each list element using the rules described in the \fBre_syntax\fR
+reference page.
.PP
If \fImode\fR is omitted then it defaults to \fB\-glob\fR.
diff --git a/tcl/doc/lsort.n b/tcl/doc/lsort.n
index bd3ed1e1a46..6f609384db5 100644
--- a/tcl/doc/lsort.n
+++ b/tcl/doc/lsort.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,7 +9,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH lsort n 8.0 Tcl "Tcl Built-In Commands"
+.TH lsort n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -20,16 +21,17 @@ lsort \- Sort the elements of a list
.SH DESCRIPTION
.PP
This command sorts the elements of \fIlist\fR, returning a new
-list in sorted order. By default ASCII sorting is used with
-the result returned in increasing order.
-However, any of the
-following options may be specified before \fIlist\fR to
-control the sorting process (unique abbreviations are accepted):
+list in sorted order. The implementation of the \fBlsort\fR command
+uses the merge\-sort algorithm which is a stable sort that has O(n log
+n) performance characteristics.
+.PP
+By default ASCII sorting is used with the result returned in
+increasing order. However, any of the following options may be
+specified before \fIlist\fR to control the sorting process (unique
+abbreviations are accepted):
.TP 20
\fB\-ascii\fR
-Use string comparison with ASCII collation order. This is
-the default.
-.VS 8.0 br
+Use string comparison with ASCII collation order. This is the default.
.TP 20
\fB\-dictionary\fR
Use dictionary-style comparison. This is the same as \fB\-ascii\fR
@@ -38,14 +40,12 @@ strings contain embedded numbers, the numbers compare as integers,
not characters. For example, in \fB\-dictionary\fR mode, \fBbigBoy\fR
sorts between \fBbigbang\fR and \fBbigboy\fR, and \fBx10y\fR
sorts between \fBx9y\fR and \fBx11y\fR.
-.VE
.TP 20
\fB\-integer\fR
Convert list elements to integers and use integer comparison.
.TP 20
\fB\-real\fR
-Convert list elements to floating-point values and use floating
-comparison.
+Convert list elements to floating-point values and use floating comparison.
.TP 20
\fB\-command\0\fIcommand\fR
Use \fIcommand\fR as a comparison command.
@@ -62,7 +62,6 @@ This is the default.
.TP 20
\fB\-decreasing\fR
Sort the list in decreasing order (``largest'' items first).
-.VS 8.0 br
.TP 20
\fB\-index\0\fIindex\fR
If this option is specified, each of the elements of \fIlist\fR must
@@ -78,8 +77,16 @@ returns \fB{Second 18} {First 24} {Third 30}\fR.
This option is much more efficient than using \fB\-command\fR
to achieve the same effect.
.RE
+.VS 8.3
+.TP 20
+\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
+\fI-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.
.VE
-
.SH KEYWORDS
element, list, order, sort
diff --git a/tcl/doc/man.macros b/tcl/doc/man.macros
index 6f3016f492f..ae66ef928af 100644
--- a/tcl/doc/man.macros
+++ b/tcl/doc/man.macros
@@ -72,8 +72,8 @@
. ie !"\\$2"" .TP \\n()Cu
. el .TP 15
.\}
-.ie !"\\$3"" \{\
.ta \\n()Au \\n()Bu
+.ie !"\\$3"" \{\
\&\\$1 \\fI\\$2\\fP (\\$3)
.\".b
.\}
diff --git a/tcl/doc/memory.n b/tcl/doc/memory.n
new file mode 100644
index 00000000000..df412f34287
--- /dev/null
+++ b/tcl/doc/memory.n
@@ -0,0 +1,82 @@
+'\"
+'\" Copyright (c) 1992-1999 by Karl Lehenbauer and Mark Diekhans
+'\" Copyright (c) 2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH memory n 8.1 Tcl "Tcl Built-In Commands"
+.BS
+.SH NAME
+memory \- Control Tcl memory debugging capabilities.
+.SH SYNOPSIS
+\fBmemory \fIoption \fR?\fIarg arg ...\fR?
+
+.SH DESCRIPTION
+.PP
+The \fBmemory\fR command gives the Tcl developer control of Tcl's memory
+debugging capabilities. The memory command has several suboptions, which are
+described below. It is only available when Tcl has been compiled with
+memory debugging enabled (when \fBTCL_MEM_DEBUG\fR is defined at
+compile time).
+.TP
+\fBmemory info\fR
+Produces 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
+to \fBckfree\fR), the current bytes allocated, and the maximum number
+of packets and bytes allocated.
+.TP
+\fBmemory trace [on|off]\fR
+.br
+Turns memory tracing on or off. When memory tracing is on, every call
+to \fBckalloc\fR causes a line of trace information to be written to
+\fIstderr\fR, consisting of the word \fIckalloc\fR, followed by the
+address returned, the amount of memory allocated, and the C filename
+and line number of the code performing the allocation. For example:
+.CS
+ckalloc 40e478 98 tclProc.c 1406
+.CE
+Calls to \fBckfree\fR are traced in the same manner.
+.TP
+\fBmemory validate [on|off]\fR
+Turns memory validation on or off. When memory validation is enabled,
+on every call to \fBckalloc\fR or \fBckfree\fR, the guard zones are
+checked for every piece of memory currently in existence that was
+allocated by \fBckalloc\fR. This has a large performance impact and
+should only be used when overwrite problems are strongly suspected.
+The advantage of enabling memory validation is that a guard zone
+overwrite can be detected on the first call to \fBckalloc\fR or
+\fBckfree\fR after the overwrite occurred, rather than when the
+specific memory with the overwritten guard zone(s) is freed, which may
+occur long after the overwrite occurred.
+.TP
+\fBmemory trace_on_at_malloc\fR \fIcount\fR
+Enable memory tracing after \fIcount\fR \fBckalloc\fR's have been performed.
+For example, if you enter \fBmemory trace_on_at_malloc 100\fR,
+after the 100th call to \fBckalloc\fR, memory trace information will begin
+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
+occurred since Tcl started is printed on a guard zone failure.
+.TP
+\fBmemory break_on_malloc\fR \fIcount\fR
+After the \fBcount\fR allocations have been performed, \fBckalloc\fR's
+output a message to this effect and that it is now attempting to enter
+the C debugger. Tcl will then issue a \fISIGINT\fR signal against itself.
+If you are running Tcl under a C debugger, it should then enter the debugger
+command mode.
+.TP
+\fB memory display\fR \fIfile\fR
+Write a list of all currently allocated memory to the specified file.
+
+.SH "SEE ALSO"
+ckalloc, ckfree, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG
+
+.SH KEYWORDS
+memory, debug
+
+
diff --git a/tcl/doc/msgcat.n b/tcl/doc/msgcat.n
new file mode 100644
index 00000000000..37c2a76fcd5
--- /dev/null
+++ b/tcl/doc/msgcat.n
@@ -0,0 +1,244 @@
+'\"
+'\" Copyright (c) 1998 Mark Harrison.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) msgcat.n
+'\"
+.so man.macros
+.TH "msgcat" n 8.1 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+msgcat \- Tcl message catalog
+.SH SYNOPSIS
+\fB::msgcat::mc \fIsrc-string\fR
+.sp
+\fB::msgcat::mclocale \fR?\fInewLocale\fR?
+.sp
+\fB::msgcat::mcpreferences\fR
+.sp
+\fB::msgcat::mcload \fIdirname\fR
+.sp
+\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
+.sp
+\fB::msgcat::mcunknown \fIlocale src-string\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBmsgcat\fR package provides a set of functions
+that can be used to manage multi-lingual user interfaces.
+Text strings are defined in a ``message catalog'' 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
+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.
+
+.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
+are given, the \fBformat\fR command is used to substitute the
+additional arguments in the translation of \fIsrc-string\fR.
+
+\fB::msgcat::mc\fR will search the messages defined
+in the current namespace for a translation of \fIsrc-string\fR; if
+none is found, it will search in the parent of the current namespace,
+and so on until it reaches the global namespace. If no translation
+string exists, \fB::msgcat::mcunknown\fR is called and the string
+returned from \fB::msgcat::mcunknown\fR is returned.
+.PP
+\fB::msgcat::mc\fR is the main function used to localize an
+application. Instead of using an English string directly, an
+applicaton can pass the English string through \fB::msgcat::mc\fR and
+use the result. If an application is written for a single language in
+this fashion, then it is easy to add support for additional languages
+later simply by defining new message catalog entries.
+.TP
+\fB::msgcat::mclocale \fR?\fInewLocale\fR?
+This function sets the locale to \fInewLocale\fR. If \fInewLocale\fR
+is omitted, the current locale is returned, otherwise the current locale
+is set to \fInewLocale\fR.
+The initial locale defaults to the locale specified in
+the user's environment. See \fBLOCALE AND SUBLOCALE SPECIFICATION\fR
+below for a description of the locale string format.
+.TP
+\fB::msgcat::mcpreferences\fR
+Returns an ordered list of the locales preferred by
+the user, based on the user's language specification.
+The list is ordered from most specific to least
+preference. If the user has specified LANG=en_US_funky,
+this procedure would return {en_US_funky en_US en}.
+.TP
+\fB::msgcat::mcload \fIdirname\fR
+Searches the specified directory for files that match
+the language specifications returned by \fB::msgcat::mcpreferences\fR.
+Each file located is sourced. The file extension is ``.msg''.
+The number of message files which matched the specification
+and were loaded is returned.
+.TP
+\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
+Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR
+in the specified \fIlocale\fR. If \fItranslate-string\fR is not
+specified, \fIsrc-string\fR is used for both. The function
+returns \fItranslate-string\fR.
+.TP
+\fB::msgcat::mcunknown \fIlocale src-string\fR
+This routine is called by \fB::msgcat::mc\fR in the case when
+a translation for \fIsrc-string\fR is not defined in the
+current locale. The default action is to return
+\fIsrc-string\fR. This procedure can be redefined by the
+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 vaue
+of \fB::msgcat::mcunknown\fR is used as the return vaue for the call
+to \fB::msgcat::mc\fR.
+
+.SH "LOCALE AND SUBLOCALE SPECIFICATION"
+.PP
+The locale is specified by a locale string.
+The locale string consists of
+a language code, an optional country code, and an optional
+system-specific code, each separated by ``_''. The country and language
+codes are specified in standards ISO-639 and ISO-3166.
+For example, the locale ``en'' specifies English and
+ ``en_US'' specifes U.S. English.
+.PP
+The locale defaults to the value in \fBenv(LANG)\fR at the time the
+\fBmsgcat\fR package is loaded. If \fBenv(LANG)\fR is not defined, then the
+locale defaults to ``C''.
+.PP
+When a locale is specified by the user, a ``best match'' search is
+performed during string translation. For example, if a user specifies
+en_UK_Funky, the locales ``en_UK_Funky'', ``en_UK'', and ``en'' are
+searched in order until a matching translation string is found. If no
+translation string is available, then \fB::msgcat::unknown\fR is
+called.
+
+.SH "NAMESPACES AND MESSAGE CATALOGS"
+.PP
+Strings stored in the message catalog are stored relative
+to the namespace from which they were added. This allows
+multiple packages to use the same strings without fear
+of collisions with other packages. It also allows the
+source string to be shorter and less prone to typographical
+error.
+.PP
+For example, executing the code
+.CS
+mcset en hello "hello from ::"
+namespace eval foo {mcset en hello "hello from ::foo"}
+puts [mc hello]
+namespace eval foo {puts [mc hello]}
+.CE
+will print
+.CS
+hello from ::
+hello from ::foo
+.CE
+.PP
+When searching for a translation of a message, the
+message catalog will search first the current namespace,
+then the parent of the current namespace, and so on until
+the global namespace is reached. This allows child namespaces
+to "inherit" messages from their parent namespace.
+.PP
+For example, executing the code
+.CS
+mcset en m1 ":: message1"
+mcset en m2 ":: message2"
+mcset en m3 ":: message3"
+namespace eval ::foo {
+ mcset en m2 "::foo message2"
+ mcset en m3 "::foo message3"
+}
+namespace eval ::foo::bar {
+ mcset en m3 "::foo::bar message3"
+}
+puts "[mc m1]; [mc m2]; [mc m3]"
+namespace eval ::foo {puts "[mc m1]; [mc m2]; [mc m3]"}
+namespace eval ::foo::bar {puts "[mc m1]; [mc m2]; [mc m3]"}
+.CE
+will print
+.CS
+:: message1; :: message2; :: message3
+:: message1; ::foo message2; ::foo message3
+:: message1; ::foo message2; ::foo::bar message3
+.CE
+
+.SH "LOCATION AND FORMAT OF MESSAGE FILES"
+.PP
+Message files can be located in any directory, subject
+to the following conditions:
+.IP [1]
+All message files for a package are in the same directory.
+.IP [2]
+The message file name is a locale specifier followed
+by ``.msg''. For example:
+.CS
+es.msg -- spanish
+en_UK.msg -- UK English
+.CE
+.IP [3]
+The file contains a series of calls to mcset, setting the
+necessary translation strings for the language. For example:
+.CS
+::msgcat::mcset es "Free Beer!" "Cerveza Gracias!"
+.CE
+
+.SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES"
+.PP
+If a package is installed into a subdirectory of the
+\fBtcl_pkgPath\fR and loaded via \fBpackage require\fR, the
+following procedure is recommended.
+.IP [1]
+During package installation, create a subdirectory
+\fBmsgs\fR under your package directory.
+.IP [2]
+Copy your *.msg files into that directory.
+.IP [3]
+ Add the following command to your package
+initialization script:
+.CS
+# load language files, stored in msgs subdirectory
+::msgcat::mcload [file join [file dirname [info script]] msgs]
+.CE
+
+.SH "POSTITIONAL CODES FOR FORMAT AND SCAN COMMANDS"
+.PP
+It is possible that a message string used as an argument
+to \fBformat\fR might have positionally dependent parameters that
+might need to be repositioned. For example, it might be
+syntactically desirable to rearrange the sentence structure
+while translating.
+.CS
+format "We produced %d units in location %s" $num $city
+format "In location %s we produced %d units" $city $num
+.CE
+.PP
+This can be handled by using the positional
+parameters:
+.CS
+format "We produced %1\\$d units in location %2\\$s" $num $city
+format "In location %2\\$s we produced %1\\$d units" $num $city
+.CE
+.PP
+Similarly, positional parameters can be used with \fBscan\fR to
+extract values from internationalized strings.
+
+.SH CREDITS
+.PP
+The message catalog code was developed by Mark Harrison.
+
+.SH "SEE ALSO"
+format(n), scan(n), namespace(n), package(n)
+.SH KEYWORDS
+internationalization, i18n, localization, l10n, message, text, translation
diff --git a/tcl/doc/namespace.n b/tcl/doc/namespace.n
index 6451a3b50df..85adcdadd76 100644
--- a/tcl/doc/namespace.n
+++ b/tcl/doc/namespace.n
@@ -205,7 +205,7 @@ Returns any leading namespace qualifiers for \fIstring\fR.
Qualifiers are namespace names separated by \fB::\fRs.
For the \fIstring\fR \fB::foo::bar::x\fR,
this command returns \fB::foo::bar\fR,
-and for \fB::\fR it returns \fB``''\fR (an empty string).
+and for \fB::\fR it returns an empty string.
This command is the complement of the \fBnamespace tail\fR command.
Note that it does not check whether the
namespace names are, in fact,
@@ -216,7 +216,7 @@ Returns the simple name at the end of a qualified string.
Qualifiers are namespace names separated by \fB::\fRs.
For the \fIstring\fR \fB::foo::bar::x\fR,
this command returns \fBx\fR,
-and for \fB::\fR it returns \fB``''\fR (an empty string).
+and for \fB::\fR it returns an empty string.
This command is the complement of the \fBnamespace qualifiers\fR command.
It does not check whether the namespace names are, in fact,
the names of currently defined namespaces.
@@ -228,7 +228,10 @@ For example, if \fIname\fR does not exist in the current namespace
but does exist in the global namespace,
this command returns a fully-qualified name in the global namespace.
If the command or variable does not exist,
-this command returns an empty string.
+this command returns an empty string. If the variable has been
+created but not defined, such as with the \fBvariable\fR command
+or through a \fBtrace\fR on the variable, this command will return the
+fully-qualified name of the variable.
If no flag is given, \fIname\fR is treated as a command name.
See the section \fBNAME RESOLUTION\fR below for an explanation of
the rules regarding name resolution.
@@ -245,21 +248,21 @@ The \fBnamespace eval\fR command lets you create new namespaces.
For example,
.CS
\fBnamespace eval Counter {
- namespace export Bump
+ namespace export bump
variable num 0
- proc Bump {} {
+ proc bump {} {
variable num
incr num
}
}\fR
.CE
creates a new namespace containing the variable \fBnum\fR and
-the procedure \fBBump\fR.
+the procedure \fBbump\fR.
The commands and variables in this namespace are separate from
other commands and variables in the same program.
-If there is a command named \fBBump\fR in the global namespace,
-for example, it will be different from the command \fBBump\fR
+If there is a command named \fBbump\fR in the global namespace,
+for example, it will be different from the command \fBbump\fR
in the \fBCounter\fR namespace.
.PP
Namespace variables resemble global variables in Tcl.
@@ -276,7 +279,7 @@ as the namespace definition shown above:
.CS
\fBnamespace eval Counter {
variable num 0
- proc Bump {} {
+ proc bump {} {
variable num
return [incr num]
}
@@ -322,7 +325,7 @@ Names must be qualified by the namespace that contains them.
From the global namespace,
we might access the \fBCounter\fR procedures like this:
.CS
-\fBCounter::Bump 5
+\fBCounter::bump 5
Counter::Reset\fR
.CE
We could access the current count like this:
@@ -332,10 +335,10 @@ We could access the current count like this:
When one namespace contains another, you may need more than one
qualifier to reach its elements.
If we had a namespace \fBFoo\fR that contained the namespace \fBCounter\fR,
-you could invoke its \fBBump\fR procedure
+you could invoke its \fBbump\fR procedure
from the global namespace like this:
.CS
-\fBFoo::Counter::Bump 3\fR
+\fBFoo::Counter::bump 3\fR
.CE
.PP
You can also use qualified names when you create and rename commands.
@@ -517,36 +520,36 @@ the command is automatically removed from all namespaces that import it.
You can export commands from a namespace like this:
.CS
\fBnamespace eval Counter {
- namespace export Bump Reset
- variable num 0
- variable max 100
+ namespace export bump reset
+ variable Num 0
+ variable Max 100
- proc Bump {{by 1}} {
- variable num
- incr num $by
- check
- return $num
+ proc bump {{by 1}} {
+ variable Num
+ incr Num $by
+ Check
+ return $Num
}
- proc Reset {} {
- variable num
- set num 0
+ proc reset {} {
+ variable Num
+ set Num 0
}
- proc check {} {
- variable num
- variable max
- if {$num > $max} {
+ proc Check {} {
+ variable Num
+ variable Max
+ if {$Num > $Max} {
error "too high!"
}
}
}\fR
.CE
-The procedures \fBBump\fR and \fBReset\fR are exported,
+The procedures \fBbump\fR and \fBreset\fR are exported,
so they are included when you import from the \fBCounter\fR namespace,
like this:
.CS
\fBnamespace import Counter::*\fR
.CE
-However, the \fBcheck\fR procedure is not exported,
+However, the \fBCheck\fR procedure is not exported,
so it is ignored by the import operation.
.PP
The \fBnamespace import\fR command only imports commands
diff --git a/tcl/doc/open.n b/tcl/doc/open.n
index 39121b6c3e1..833ae11ef30 100644
--- a/tcl/doc/open.n
+++ b/tcl/doc/open.n
@@ -55,8 +55,9 @@ Open the file for reading and writing. Truncate it if it exists.
If it doesn't exist, create a new file.
.TP 15
\fBa\fR
-Open the file for writing only. The file must already exist, and the file
-is positioned so that new data is appended to the file.
+Open the file for writing only. If the file doesn't exist,
+create a new empty file.
+Set the initial access position to the end of the file.
.TP 15
\fBa+\fR
Open the file for reading and writing. If the file doesn't exist,
@@ -144,6 +145,23 @@ number of data bits, and number of stop bits for this serial port. The
``odd'', ``even'', ``mark'', or ``space''. \fIData\fR is the number of
data bits and should be an integer from 5 to 8, while \fIstop\fR is the
number of stop bits and should be the integer 1 or 2.
+.TP
+\fB\-pollinterval \fImsec\fR
+.
+This option, available only on Windows for serial ports, is used to
+set the maximum time between polling for fileevents. This affects the
+time interval between checking for events throughout the Tcl
+interpreter (the smallest value always wins). Use this option only if
+you want to poll the serial port more often than 10 msec (the default).
+.TP
+\fB\-lasterror\fR
+.
+This option is available only on Windows for serial ports, and is
+query only (will only be reported when directly requested).
+In case of a serial communication error, \fBread\fR or \fBputs\fR
+returns a general Tcl file I/O error.
+\fBfconfigure -lasterror\fR can be called to get a list
+of error details (e.g. FRAME RXOVER).
.VE
.VS
@@ -153,8 +171,13 @@ number of stop bits and should be the integer 1 or 2.
\fBWindows \fR(all versions)
.
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. An
-attempt to open a serial port that does not exist will fail.
+\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
+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
.
@@ -202,19 +225,6 @@ 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.
.TP
-\fBWindows 3.X\fR
-.
-A command pipeline can execute 16-bit or 32-bit DOS or Windows
-applications, but the call to \fBopen\fR will not return until the last
-program in the pipeline has finished executing; command pipelines run
-synchronously. If the pipeline is opened with write access (either just
-writing or both reading and writing) the first application in the
-pipeline will instead see an immediate end-of-file; any data the caller
-writes to the open pipe will instead be discarded.
-.sp
-Since Tcl cannot be run with a real console under Windows 3.X, there are
-no interactions between command pipelines and the console.
-.TP
\fBMacintosh\fR
.
Opening a serial port is not currently implemented under Macintosh.
diff --git a/tcl/doc/package.n b/tcl/doc/package.n
index 9a7b4983c2f..d0c7e61e9fe 100644
--- a/tcl/doc/package.n
+++ b/tcl/doc/package.n
@@ -14,9 +14,10 @@
package \- Facilities for package loading and version control
.SH SYNOPSIS
.nf
-\fBpackage forget \fIpackage\fR
+\fBpackage forget ?\fIpackage package ...\fR?
\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
\fBpackage names\fR
+\fBpackage present \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
\fBpackage provide \fIpackage \fR?\fIversion\fR?
\fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
\fBpackage unknown \fR?\fIcommand\fR?
@@ -42,8 +43,8 @@ primarily by system scripts that maintain the package database.
The behavior of the \fBpackage\fR command is determined by its first argument.
The following forms are permitted:
.TP
-\fBpackage forget \fIpackage\fR
-Removes all information about \fIpackage\fR from this interpreter,
+\fBpackage forget ?\fIpackage package ...\fR?
+Removes all information about each specified package from this interpreter,
including information provided by both \fBpackage ifneeded\fR and
\fBpackage provide\fR.
.TP
@@ -75,6 +76,10 @@ interpreter for which a version has been provided (via
script is available.
The order of elements in the list is arbitrary.
.TP
+\fBpackage present \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
+This command is equivalent to \fBpackage require\fR except that it
+does not try and load the package if it is not already loaded.
+.TP
\fBpackage provide \fIpackage \fR?\fIversion\fR?
This command is invoked to indicate that version \fIversion\fR
of package \fIpackage\fR is now present in the interpreter.
@@ -186,3 +191,4 @@ See the documentation for \fBpkg_mkIndex\fR for details.
.SH KEYWORDS
package, version
+
diff --git a/tcl/doc/packagens.n b/tcl/doc/packagens.n
new file mode 100644
index 00000000000..3854b675adf
--- /dev/null
+++ b/tcl/doc/packagens.n
@@ -0,0 +1,53 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH pkg::create n 8.3 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+pkg::create \- Construct an appropriate \fBpackage ifneeded\fR
+command for a given package specification
+.SH SYNOPSIS
+\fB::pkg::create \fI\-name packageName\fR \fI\-version packageVersion\fR ?\fI\-load filespec\fR? ... ?\fI\-source filespec\fR? ...
+.BE
+
+.SH DESCRIPTION
+.PP
+\fB::pkg::create\fR is a utility procedure that is part of the standard Tcl
+library. It is used to create an appropriate \fBpackage ifneeded\fR
+command for a given package specification. It can be used to construct a
+\fBpkgIndex.tcl\fR file for use with the \fBpackage\fR mechanism.
+
+.SH OPTIONS
+The parameters supported are:
+.TP
+\fB\-name\fR\0\fIpackageName\fR
+This parameter specifies the name of the package. It is required.
+.TP
+\fB\-version\fR\0\fIpackageVersion\fR
+This parameter specifies the version of the package. It is required.
+.TP
+\fB\-load\fR\0\fIfilespec\fR
+This parameter specifies a binary library that must be loaded with the
+\fBload\fR command. \fIfilespec\fR is a list with two elements. The
+first element is the name of the file to load. The second, optional
+element is a list of commands supplied by loading that file. If the
+list of procedures is empty or omitted, \fB::pkg::create\fR will
+set up the library for direct loading (see \fBpkg_mkIndex\fR). Any
+number of \fB\-load\fR parameters may be specified.
+.TP
+\fB\-source\fR\0\fIfilespec\fR
+This parameter is similar to the \fB\-load\fR parameter, except that it
+specifies a Tcl library that must be loaded with the
+\fBsource\fR command. Any number of \fB\-source\fR parameters may be
+specified.
+.PP
+At least one \fB\-load\fR or \fB\-source\fR paramter must be given.
+
+.SH KEYWORDS
+auto-load, index, package, version
+
diff --git a/tcl/doc/pkgMkIndex.n b/tcl/doc/pkgMkIndex.n
index 71683e48f4c..9980d108296 100644
--- a/tcl/doc/pkgMkIndex.n
+++ b/tcl/doc/pkgMkIndex.n
@@ -7,15 +7,15 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH pkg_mkIndex n 8.0 Tcl "Tcl Built-In Commands"
+.TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
pkg_mkIndex \- Build an index for automatic loading of packages
.SH SYNOPSIS
.nf
-.VS 8.0.3
-\fBpkg_mkIndex ?\fI-direct\fR? ?\fI-load pkgPat\fR? ?\fI-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
+.VS 8.3.0
+\fBpkg_mkIndex ?\fI\-lazy\fR? ?\fI\-load pkgPat\fR? ?\fI\-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
.VE
.fi
.BE
@@ -43,28 +43,8 @@ The \fIdir\fR argument gives the name of a directory and each
script or binary files in \fIdir\fR.
.VS 8.0.3
The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
-The optional switches are:
-.TP 15
-\fB\-direct\fR
-The generated index
-will manage to load the package immediately upon \fBpackage require\fR
-instead of delaying loading until actual use of one of the commands.
-.TP 15
-\fB\-load \fIpkgPat\fR
-The index process will pre-load any packages that exist in the
-current interpreter and match \fIpkgPat\fP into the slave interpreter used to
-generate the index. The pattern match uses string match rules.
-See COMPLEX CASES below.
-.TP 15
-\fB\-verbose\fR
-Generate output during the indexing process. Output is via
-the \fBtclLog\fP procedure, which by default prints to stderr.
-.TP 15
-\fB\-\-\fR
-End of the flags, in case \fIdir\fP begins with a dash.
.VE
-.LP
-.RS
+.br
\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
with package information about all the files given by the \fIpattern\fR
arguments.
@@ -75,10 +55,10 @@ and new commands appear (this is why it is essential to have
in the files, as described above).
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\fP option
+you may have to use the \fB\-load\fP option
or adjust the order in which \fBpkg_mkIndex\fR processes
the files. See COMPLEX CASES below.
-.RE
+
.IP [3]
Install the package as a subdirectory of one of the directories given by
the \fBtcl_pkgPath\fR variable. If \fB$tcl_pkgPath\fR contains more
@@ -92,7 +72,7 @@ the package's script and/or binary files as well as the \fBpkgIndex.tcl\fR
file. As long as the package is installed as a subdirectory of a
directory in \fB$tcl_pkgPath\fR it will automatically be found during
\fBpackage require\fR commands.
-.IP
+.br
If you install the package anywhere else, then you must ensure that
the directory containing the package is in the \fBauto_path\fR global variable
or an immediate subdirectory of one of the directories in \fBauto_path\fR.
@@ -119,6 +99,27 @@ interpreter, based on the first call to \fBpackage require\fR.
Different versions of a package may be loaded in different
interpreters.
+.SH OPTIONS
+The optional switches are:
+.TP 15
+\fB\-lazy\fR
+The generated index will manage to delay loading the package until the
+use of one of the commands provided by the package, instead of loading
+it immediately upon \fBpackage require\fR.
+.TP 15
+\fB\-load \fIpkgPat\fR
+The index process will pre-load any packages that exist in the
+current interpreter and match \fIpkgPat\fP into the slave interpreter used to
+generate the index. The pattern match uses string match rules.
+See COMPLEX CASES below.
+.TP 15
+\fB\-verbose\fR
+Generate output during the indexing process. Output is via
+the \fBtclLog\fP procedure, which by default prints to stderr.
+.TP 15
+\fB\-\-\fR
+End of the flags, in case \fIdir\fP begins with a dash.
+
.SH "PACKAGES AND THE AUTO-LOADER"
.PP
The package management facilities overlap somewhat with the auto-loader,
@@ -153,30 +154,26 @@ commands for each version of each available package; these commands
invoke \fBpackage provide\fR commands to announce the
availability of the package, and they setup auto-loader
information to load the files of the package.
-.VS 8.0.3
-Unless the \fI-direct\fR flag was provided when the \fBpkgIndex.tcl\fR
+.VS 8.3
+If the \fI\-lazy\fR flag was provided when the \fBpkgIndex.tcl\fR
was generated,
.VE
a given file of a given version of a given package isn't
actually loaded until the first time one of its commands
is invoked.
-Thus, after invoking \fBpackage require\fR you
-.VS 8.0.3
-may
-.VE
-not see
-the package's commands in the interpreter, but you will be able
+Thus, after invoking \fBpackage require\fR you may
+not see the package's commands in the interpreter, but you will be able
to invoke the commands and they will be auto-loaded.
-.VS 8.0.3
+.VS 8.3
.SH "DIRECT LOADING"
.PP
Some packages, for instance packages which use namespaces and export
commands or those which require special initialization, might select
that their package files be loaded immediately upon \fBpackage require\fR
instead of delaying the actual loading to the first use of one of the
-package's command. This mode is enabled when generating the package
-index by specifying the \fI-direct\fR argument.
+package's command. This is the default mode when generating the package
+index. It can be overridden by specifying the \fI\-lazy\fR argument.
.VE
.SH "COMPLEX CASES"
@@ -210,7 +207,7 @@ For example, suppose the BLT package requires Tk, and expresses
this with a call to \fBTcl_PkgRequire\fP in its \fBBlt_Init\fP routine.
To support this, you must run \fBpkg_mkIndex\fR in an interpreter that
has Tk loaded. You can achieve this with the
-\fB-load \fIpkgPat\fR option. If you specify this option,
+\fB\-load \fIpkgPat\fR option. If you specify this option,
\fBpkg_mkIndex\fR will load any packages listed by
\fBinfo loaded\fP and that match \fIpkgPat\fP
into the interpreter used to process files.
@@ -224,14 +221,14 @@ and then the package it provides
will be available when the second file is processed.
You may also need to load the first package into the
temporary interpreter used to create the index by using
-the \fB-load\fP flag;
+the \fB\-load\fP flag;
it won't hurt to specify package patterns that are not yet loaded.
.PP
If you have a package that is split across scripts and a binary file,
-then you should avoid the \fB-load\fP flag. The problem is that
+then you should avoid the \fB\-load\fP flag. The problem is that
if you load a package before computing the index it masks any
other files that provide part of the same package.
-If you must use \fB-load\fP,
+If you must use \fB\-load\fP,
then you must specify the scripts first; otherwise the package loaded from
the binary file may mask the package defined by the scripts.
diff --git a/tcl/doc/puts.n b/tcl/doc/puts.n
index 1c5113ab48b..88e3a42dc0d 100644
--- a/tcl/doc/puts.n
+++ b/tcl/doc/puts.n
@@ -34,8 +34,8 @@ value of the \fB\-translation\fR option for the channel (for example,
on PCs newlines are normally replaced with carriage-return-linefeed
sequences; on Macintoshes newlines are normally replaced with
carriage-returns).
-See the \fBfconfigure\fR manual entry for a discussion of end-of-line
-translations.
+See the \fBfconfigure\fR manual entry for a discussion on ways in
+which \fBfconfigure\fR will alter output.
.PP
Tcl buffers output internally, so characters written with \fBputs\fR
may not appear immediately on the output file or device; Tcl will
diff --git a/tcl/doc/re_syntax.n b/tcl/doc/re_syntax.n
new file mode 100644
index 00000000000..cb6b15ad2a0
--- /dev/null
+++ b/tcl/doc/re_syntax.n
@@ -0,0 +1,932 @@
+'\"
+'\" Copyright (c) 1998 Sun Microsystems, Inc.
+'\" Copyright (c) 1999 Scriptics Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH re_syntax n "8.1" Tcl "Tcl Built-In Commands"
+.BS
+.SH NAME
+re_syntax \- Syntax of Tcl regular expressions.
+.BE
+
+.SH DESCRIPTION
+.PP
+A \fIregular expression\fR describes strings of characters.
+It's a pattern that matches certain strings and doesn't match others.
+
+.SH "DIFFERENT FLAVORS OF REs"
+Regular expressions (``RE''s), as defined by POSIX, come in two
+flavors: \fIextended\fR REs (``EREs'') and \fIbasic\fR REs (``BREs'').
+EREs are roughly those of the traditional \fIegrep\fR, while BREs are
+roughly those of the traditional \fIed\fR. This implementation adds
+a third flavor, \fIadvanced\fR REs (``AREs''), basically EREs with
+some significant extensions.
+.PP
+This manual page primarily describes AREs. BREs mostly exist for
+backward compatibility in some old programs; they will be discussed at
+the end. POSIX EREs are almost an exact subset of AREs. Features of
+AREs that are not present in EREs will be indicated.
+
+.SH "REGULAR EXPRESSION SYNTAX"
+.PP
+Tcl regular expressions are implemented using the package written by
+Henry Spencer, based on the 1003.2 spec and some (not quite all) of
+the Perl5 extensions (thanks, Henry!). Much of the description of
+regular expressions below is copied verbatim from his manual entry.
+.PP
+An ARE is one or more \fIbranches\fR,
+separated by `\fB|\fR',
+matching anything that matches any of the branches.
+.PP
+A branch is zero or more \fIconstraints\fR or \fIquantified atoms\fR,
+concatenated.
+It matches a match for the first, followed by a match for the second, etc;
+an empty branch matches the empty string.
+.PP
+A quantified atom is an \fIatom\fR possibly followed
+by a single \fIquantifier\fR.
+Without a quantifier, it matches a match for the atom.
+The quantifiers,
+and what a so-quantified atom matches, are:
+.RS 2
+.TP 6
+\fB*\fR
+a sequence of 0 or more matches of the atom
+.TP
+\fB+\fR
+a sequence of 1 or more matches of the atom
+.TP
+\fB?\fR
+a sequence of 0 or 1 matches of the atom
+.TP
+\fB{\fIm\fB}\fR
+a sequence of exactly \fIm\fR matches of the atom
+.TP
+\fB{\fIm\fB,}\fR
+a sequence of \fIm\fR or more matches of the atom
+.TP
+\fB{\fIm\fB,\fIn\fB}\fR
+a sequence of \fIm\fR through \fIn\fR (inclusive) matches of the atom;
+\fIm\fR may not exceed \fIn\fR
+.TP
+\fB*? +? ?? {\fIm\fB}? {\fIm\fB,}? {\fIm\fB,\fIn\fB}?\fR
+\fInon-greedy\fR quantifiers,
+which match the same possibilities,
+but prefer the smallest number rather than the largest number
+of matches (see MATCHING)
+.RE
+.PP
+The forms using
+\fB{\fR and \fB}\fR
+are known as \fIbound\fRs.
+The numbers
+\fIm\fR and \fIn\fR are unsigned decimal integers
+with permissible values from 0 to 255 inclusive.
+.PP
+An atom is one of:
+.RS 2
+.TP 6
+\fB(\fIre\fB)\fR
+(where \fIre\fR is any regular expression)
+matches a match for
+\fIre\fR, with the match noted for possible reporting
+.TP
+\fB(?:\fIre\fB)\fR
+as previous,
+but does no reporting
+(a ``non-capturing'' set of parentheses)
+.TP
+\fB()\fR
+matches an empty string,
+noted for possible reporting
+.TP
+\fB(?:)\fR
+matches an empty string,
+without reporting
+.TP
+\fB[\fIchars\fB]\fR
+a \fIbracket expression\fR,
+matching any one of the \fIchars\fR (see BRACKET EXPRESSIONS for more detail)
+.TP
+ \fB.\fR
+matches any single character
+.TP
+\fB\e\fIk\fR
+(where \fIk\fR is a non-alphanumeric character)
+matches that character taken as an ordinary character,
+e.g. \e\e matches a backslash character
+.TP
+\fB\e\fIc\fR
+where \fIc\fR is alphanumeric
+(possibly followed by other characters),
+an \fIescape\fR (AREs only),
+see ESCAPES below
+.TP
+\fB{\fR
+when followed by a character other than a digit,
+matches the left-brace character `\fB{\fR';
+when followed by a digit, it is the beginning of a
+\fIbound\fR (see above)
+.TP
+\fIx\fR
+where \fIx\fR is
+a single character with no other significance, matches that character.
+.RE
+.PP
+A \fIconstraint\fR matches an empty string when specific conditions
+are met.
+A constraint may not be followed by a quantifier.
+The simple constraints are as follows; some more constraints are
+described later, under ESCAPES.
+.RS 2
+.TP 8
+\fB^\fR
+matches at the beginning of a line
+.TP
+\fB$\fR
+matches at the end of a line
+.TP
+\fB(?=\fIre\fB)\fR
+\fIpositive lookahead\fR (AREs only), matches at any point
+where a substring matching \fIre\fR begins
+.TP
+\fB(?!\fIre\fB)\fR
+\fInegative lookahead\fR (AREs only), matches at any point
+where no substring matching \fIre\fR begins
+.RE
+.PP
+The lookahead constraints may not contain back references (see later),
+and all parentheses within them are considered non-capturing.
+.PP
+An RE may not end with `\fB\e\fR'.
+
+.SH "BRACKET EXPRESSIONS"
+A \fIbracket expression\fR is a list of characters enclosed in `\fB[\|]\fR'.
+It normally matches any single character from the list (but see below).
+If the list begins with `\fB^\fR',
+it matches any single character
+(but see below) \fInot\fR from the rest of the list.
+.PP
+If two characters in the list are separated by `\fB\-\fR',
+this is shorthand
+for the full \fIrange\fR of characters between those two (inclusive) in the
+collating sequence,
+e.g.
+\fB[0\-9]\fR
+in ASCII matches any decimal digit.
+Two ranges may not share an
+endpoint, so e.g.
+\fBa\-c\-e\fR
+is illegal.
+Ranges are very collating-sequence-dependent,
+and portable programs should avoid relying on them.
+.PP
+To include a literal
+\fB]\fR
+or
+\fB\-\fR
+in the list,
+the simplest method is to
+enclose it in
+\fB[.\fR and \fB.]\fR
+to make it a collating element (see below).
+Alternatively,
+make it the first character
+(following a possible `\fB^\fR'),
+or (AREs only) precede it with `\fB\e\fR'.
+Alternatively, for `\fB\-\fR',
+make it the last character,
+or the second endpoint of a range.
+To use a literal
+\fB\-\fR
+as the first endpoint of a range,
+make it a collating element
+or (AREs only) precede it with `\fB\e\fR'.
+With the exception of these, some combinations using
+\fB[\fR
+(see next
+paragraphs), and escapes,
+all other special characters lose their
+special significance within a bracket expression.
+.PP
+Within a bracket expression, a collating element (a character,
+a multi-character sequence that collates as if it were a single character,
+or a collating-sequence name for either)
+enclosed in
+\fB[.\fR and \fB.]\fR
+stands for the
+sequence of characters of that collating element.
+The sequence is a single element of the bracket expression's list.
+A bracket expression in a locale that has
+multi-character collating elements
+can thus match more than one character.
+.VS 8.2
+So (insidiously), a bracket expression that starts with \fB^\fR
+can match multi-character collating elements even if none of them
+appear in the bracket expression!
+(\fINote:\fR Tcl currently has no multi-character collating elements.
+This information is only for illustration.)
+.PP
+For example, assume the collating sequence includes a \fBch\fR
+multi-character collating element.
+Then the RE \fB[[.ch.]]*c\fR (zero or more \fBch\fP's followed by \fBc\fP)
+matches the first five characters of `\fBchchcc\fR'.
+Also, the RE \fB[^c]b\fR matches all of `\fBchb\fR'
+(because \fB[^c]\fR matches the multi-character \fBch\fR).
+.VE 8.2
+.PP
+Within a bracket expression, a collating element enclosed in
+\fB[=\fR
+and
+\fB=]\fR
+is an equivalence class, standing for the sequences of characters
+of all collating elements equivalent to that one, including itself.
+(If there are no other equivalent collating elements,
+the treatment is as if the enclosing delimiters were `\fB[.\fR'\&
+and `\fB.]\fR'.)
+For example, if
+\fBo\fR
+and
+\fB\o'o^'\fR
+are the members of an equivalence class,
+then `\fB[[=o=]]\fR', `\fB[[=\o'o^'=]]\fR',
+and `\fB[o\o'o^']\fR'\&
+are all synonymous.
+An equivalence class may not be an endpoint
+of a range.
+.VS 8.2
+(\fINote:\fR
+Tcl currently implements only the Unicode locale.
+It doesn't define any equivalence classes.
+The examples above are just illustrations.)
+.VE 8.2
+.PP
+Within a bracket expression, the name of a \fIcharacter class\fR enclosed
+in
+\fB[:\fR
+and
+\fB:]\fR
+stands for the list of all characters
+(not all collating elements!)
+belonging to that
+class.
+Standard character classes are:
+.PP
+.RS
+.ne 5
+.nf
+.ta 3c
+\fBalpha\fR A letter.
+\fBupper\fR An upper-case letter.
+\fBlower\fR A lower-case letter.
+\fBdigit\fR A decimal digit.
+\fBxdigit\fR A hexadecimal digit.
+\fBalnum\fR An alphanumeric (letter or digit).
+\fBprint\fR An alphanumeric (same as alnum).
+\fBblank\fR A space or tab character.
+\fBspace\fR A character producing white space in displayed text.
+\fBpunct\fR A punctuation character.
+\fBgraph\fR A character with a visible representation.
+\fBcntrl\fR A control character.
+.fi
+.RE
+.PP
+A locale may provide others.
+.VS 8.2
+(Note that the current Tcl implementation has only one locale:
+the Unicode locale.)
+.VE 8.2
+A character class may not be used as an endpoint of a range.
+.PP
+There are two special cases of bracket expressions:
+the bracket expressions
+\fB[[:<:]]\fR
+and
+\fB[[:>:]]\fR
+are constraints, matching empty strings at
+the beginning and end of a word respectively.
+'\" note, discussion of escapes below references this definition of word
+A word is defined as a sequence of
+word characters
+that is neither preceded nor followed by
+word characters.
+A word character is an
+\fIalnum\fR
+character
+or an underscore
+(\fB_\fR).
+These special bracket expressions are deprecated;
+users of AREs should use constraint escapes instead (see below).
+.SH ESCAPES
+Escapes (AREs only), which begin with a
+\fB\e\fR
+followed by an alphanumeric character,
+come in several varieties:
+character entry, class shorthands, constraint escapes, and back references.
+A
+\fB\e\fR
+followed by an alphanumeric character but not constituting
+a valid escape is illegal in AREs.
+In EREs, there are no escapes:
+outside a bracket expression,
+a
+\fB\e\fR
+followed by an alphanumeric character merely stands for that
+character as an ordinary character,
+and inside a bracket expression,
+\fB\e\fR
+is an ordinary character.
+(The latter is the one actual incompatibility between EREs and AREs.)
+.PP
+Character-entry escapes (AREs only) exist to make it easier to specify
+non-printing and otherwise inconvenient characters in REs:
+.RS 2
+.TP 5
+\fB\ea\fR
+alert (bell) character, as in C
+.TP
+\fB\eb\fR
+backspace, as in C
+.TP
+\fB\eB\fR
+synonym for
+\fB\e\fR
+to help reduce backslash doubling in some
+applications where there are multiple levels of backslash processing
+.TP
+\fB\ec\fIX\fR
+(where X is any character) the character whose
+low-order 5 bits are the same as those of
+\fIX\fR,
+and whose other bits are all zero
+.TP
+\fB\ee\fR
+the character whose collating-sequence name
+is `\fBESC\fR',
+or failing that, the character with octal value 033
+.TP
+\fB\ef\fR
+formfeed, as in C
+.TP
+\fB\en\fR
+newline, as in C
+.TP
+\fB\er\fR
+carriage return, as in C
+.TP
+\fB\et\fR
+horizontal tab, as in C
+.TP
+\fB\eu\fIwxyz\fR
+(where
+\fIwxyz\fR
+is exactly four hexadecimal digits)
+the Unicode character
+\fBU+\fIwxyz\fR
+in the local byte ordering
+.TP
+\fB\eU\fIstuvwxyz\fR
+(where
+\fIstuvwxyz\fR
+is exactly eight hexadecimal digits)
+reserved for a somewhat-hypothetical Unicode extension to 32 bits
+.TP
+\fB\ev\fR
+vertical tab, as in C
+are all available.
+.TP
+\fB\ex\fIhhh\fR
+(where
+\fIhhh\fR
+is any sequence of hexadecimal digits)
+the character whose hexadecimal value is
+\fB0x\fIhhh\fR
+(a single character no matter how many hexadecimal digits are used).
+.TP
+\fB\e0\fR
+the character whose value is
+\fB0\fR
+.TP
+\fB\e\fIxy\fR
+(where
+\fIxy\fR
+is exactly two octal digits,
+and is not a
+\fIback reference\fR (see below))
+the character whose octal value is
+\fB0\fIxy\fR
+.TP
+\fB\e\fIxyz\fR
+(where
+\fIxyz\fR
+is exactly three octal digits,
+and is not a
+back reference (see below))
+the character whose octal value is
+\fB0\fIxyz\fR
+.RE
+.PP
+Hexadecimal digits are `\fB0\fR'-`\fB9\fR', `\fBa\fR'-`\fBf\fR',
+and `\fBA\fR'-`\fBF\fR'.
+Octal digits are `\fB0\fR'-`\fB7\fR'.
+.PP
+The character-entry escapes are always taken as ordinary characters.
+For example,
+\fB\e135\fR
+is
+\fB]\fR
+in ASCII,
+but
+\fB\e135\fR
+does not terminate a bracket expression.
+Beware, however, that some applications (e.g., C compilers) interpret
+such sequences themselves before the regular-expression package
+gets to see them, which may require doubling (quadrupling, etc.) the `\fB\e\fR'.
+.PP
+Class-shorthand escapes (AREs only) provide shorthands for certain commonly-used
+character classes:
+.RS 2
+.TP 10
+\fB\ed\fR
+\fB[[:digit:]]\fR
+.TP
+\fB\es\fR
+\fB[[:space:]]\fR
+.TP
+\fB\ew\fR
+\fB[[:alnum:]_]\fR
+(note underscore)
+.TP
+\fB\eD\fR
+\fB[^[:digit:]]\fR
+.TP
+\fB\eS\fR
+\fB[^[:space:]]\fR
+.TP
+\fB\eW\fR
+\fB[^[:alnum:]_]\fR
+(note underscore)
+.RE
+.PP
+Within bracket expressions, `\fB\ed\fR', `\fB\es\fR',
+and `\fB\ew\fR'\&
+lose their outer brackets,
+and `\fB\eD\fR', `\fB\eS\fR',
+and `\fB\eW\fR'\&
+are illegal.
+.VS 8.2
+(So, for example, \fB[a-c\ed]\fR is equivalent to \fB[a-c[:digit:]]\fR.
+Also, \fB[a-c\eD]\fR, which is equivalent to \fB[a-c^[:digit:]]\fR, is illegal.)
+.VE 8.2
+.PP
+A constraint escape (AREs only) is a constraint,
+matching the empty string if specific conditions are met,
+written as an escape:
+.RS 2
+.TP 6
+\fB\eA\fR
+matches only at the beginning of the string
+(see MATCHING, below, for how this differs from `\fB^\fR')
+.TP
+\fB\em\fR
+matches only at the beginning of a word
+.TP
+\fB\eM\fR
+matches only at the end of a word
+.TP
+\fB\ey\fR
+matches only at the beginning or end of a word
+.TP
+\fB\eY\fR
+matches only at a point that is not the beginning or end of a word
+.TP
+\fB\eZ\fR
+matches only at the end of the string
+(see MATCHING, below, for how this differs from `\fB$\fR')
+.TP
+\fB\e\fIm\fR
+(where
+\fIm\fR
+is a nonzero digit) a \fIback reference\fR, see below
+.TP
+\fB\e\fImnn\fR
+(where
+\fIm\fR
+is a nonzero digit, and
+\fInn\fR
+is some more digits,
+and the decimal value
+\fImnn\fR
+is not greater than the number of closing capturing parentheses seen so far)
+a \fIback reference\fR, see below
+.RE
+.PP
+A word is defined as in the specification of
+\fB[[:<:]]\fR
+and
+\fB[[:>:]]\fR
+above.
+Constraint escapes are illegal within bracket expressions.
+.PP
+A back reference (AREs only) matches the same string matched by the parenthesized
+subexpression specified by the number,
+so that (e.g.)
+\fB([bc])\e1\fR
+matches
+\fBbb\fR
+or
+\fBcc\fR
+but not `\fBbc\fR'.
+The subexpression must entirely precede the back reference in the RE.
+Subexpressions are numbered in the order of their leading parentheses.
+Non-capturing parentheses do not define subexpressions.
+.PP
+There is an inherent historical ambiguity between octal character-entry
+escapes and back references, which is resolved by heuristics,
+as hinted at above.
+A leading zero always indicates an octal escape.
+A single non-zero digit, not followed by another digit,
+is always taken as a back reference.
+A multi-digit sequence not starting with a zero is taken as a back
+reference if it comes after a suitable subexpression
+(i.e. the number is in the legal range for a back reference),
+and otherwise is taken as octal.
+.SH "METASYNTAX"
+In addition to the main syntax described above, there are some special
+forms and miscellaneous syntactic facilities available.
+.PP
+Normally the flavor of RE being used is specified by
+application-dependent means.
+However, this can be overridden by a \fIdirector\fR.
+If an RE of any flavor begins with `\fB***:\fR',
+the rest of the RE is an ARE.
+If an RE of any flavor begins with `\fB***=\fR',
+the rest of the RE is taken to be a literal string,
+with all characters considered ordinary characters.
+.PP
+An ARE may begin with \fIembedded options\fR:
+a sequence
+\fB(?\fIxyz\fB)\fR
+(where
+\fIxyz\fR
+is one or more alphabetic characters)
+specifies options affecting the rest of the RE.
+These supplement, and can override,
+any options specified by the application.
+The available option letters are:
+.RS 2
+.TP 3
+\fBb\fR
+rest of RE is a BRE
+.TP 3
+\fBc\fR
+case-sensitive matching (usual default)
+.TP 3
+\fBe\fR
+rest of RE is an ERE
+.TP 3
+\fBi\fR
+case-insensitive matching (see MATCHING, below)
+.TP 3
+\fBm\fR
+historical synonym for
+\fBn\fR
+.TP 3
+\fBn\fR
+newline-sensitive matching (see MATCHING, below)
+.TP 3
+\fBp\fR
+partial newline-sensitive matching (see MATCHING, below)
+.TP 3
+\fBq\fR
+rest of RE is a literal (``quoted'') string, all ordinary characters
+.TP 3
+\fBs\fR
+non-newline-sensitive matching (usual default)
+.TP 3
+\fBt\fR
+tight syntax (usual default; see below)
+.TP 3
+\fBw\fR
+inverse partial newline-sensitive (``weird'') matching (see MATCHING, below)
+.TP 3
+\fBx\fR
+expanded syntax (see below)
+.RE
+.PP
+Embedded options take effect at the
+\fB)\fR
+terminating the sequence.
+They are available only at the start of an ARE,
+and may not be used later within it.
+.PP
+In addition to the usual (\fItight\fR) RE syntax, in which all characters are
+significant, there is an \fIexpanded\fR syntax,
+available in all flavors of RE
+with the \fB-expanded\fR switch, or in AREs with the embedded x option.
+In the expanded syntax,
+white-space characters are ignored
+and all characters between a
+\fB#\fR
+and the following newline (or the end of the RE) are ignored,
+permitting paragraphing and commenting a complex RE.
+There are three exceptions to that basic rule:
+.RS 2
+.PP
+a white-space character or `\fB#\fR' preceded by `\fB\e\fR' is retained
+.PP
+white space or `\fB#\fR' within a bracket expression is retained
+.PP
+white space and comments are illegal within multi-character symbols
+like the ARE `\fB(?:\fR' or the BRE `\fB\e(\fR'
+.RE
+.PP
+Expanded-syntax white-space characters are blank, tab, newline, and
+.VS 8.2
+any character that belongs to the \fIspace\fR character class.
+.VE 8.2
+.PP
+Finally, in an ARE,
+outside bracket expressions, the sequence `\fB(?#\fIttt\fB)\fR'
+(where
+\fIttt\fR
+is any text not containing a `\fB)\fR')
+is a comment,
+completely ignored.
+Again, this is not allowed between the characters of
+multi-character symbols like `\fB(?:\fR'.
+Such comments are more a historical artifact than a useful facility,
+and their use is deprecated;
+use the expanded syntax instead.
+.PP
+\fINone\fR of these metasyntax extensions is available if the application
+(or an initial
+\fB***=\fR
+director)
+has specified that the user's input be treated as a literal string
+rather than as an RE.
+.SH MATCHING
+In the event that an RE could match more than one substring of a given
+string,
+the RE matches the one starting earliest in the string.
+If the RE could match more than one substring starting at that point,
+its choice is determined by its \fIpreference\fR:
+either the longest substring, or the shortest.
+.PP
+Most atoms, and all constraints, have no preference.
+A parenthesized RE has the same preference (possibly none) as the RE.
+A quantified atom with quantifier
+\fB{\fIm\fB}\fR
+or
+\fB{\fIm\fB}?\fR
+has the same preference (possibly none) as the atom itself.
+A quantified atom with other normal quantifiers (including
+\fB{\fIm\fB,\fIn\fB}\fR
+with
+\fIm\fR
+equal to
+\fIn\fR)
+prefers longest match.
+A quantified atom with other non-greedy quantifiers (including
+\fB{\fIm\fB,\fIn\fB}?\fR
+with
+\fIm\fR
+equal to
+\fIn\fR)
+prefers shortest match.
+A branch has the same preference as the first quantified atom in it
+which has a preference.
+An RE consisting of two or more branches connected by the
+\fB|\fR
+operator prefers longest match.
+.PP
+Subject to the constraints imposed by the rules for matching the whole RE,
+subexpressions also match the longest or shortest possible substrings,
+based on their preferences,
+with subexpressions starting 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 force longest and shortest preference, respectively,
+on a subexpression or a whole RE.
+.PP
+Match lengths are measured in characters, not collating elements.
+An empty string is considered longer than no match at all.
+For example,
+\fBbb*\fR
+matches the three middle characters of `\fBabbbc\fR',
+\fB(week|wee)(night|knights)\fR
+matches all ten characters of `\fBweeknights\fR',
+when
+\fB(.*).*\fR
+is matched against
+\fBabc\fR
+the parenthesized subexpression
+matches all three characters, and
+when
+\fB(a*)*\fR
+is matched against
+\fBbc\fR
+both the whole RE and the parenthesized
+subexpression match an empty string.
+.PP
+If case-independent matching is specified,
+the effect is much as if all case distinctions had vanished from the
+alphabet.
+When an alphabetic that exists in multiple cases appears as an
+ordinary character outside a bracket expression, it is effectively
+transformed into a bracket expression containing both cases,
+so that
+\fBx\fR
+becomes `\fB[xX]\fR'.
+When it appears inside a bracket expression, all case counterparts
+of it are added to the bracket expression, so that
+\fB[x]\fR
+becomes
+\fB[xX]\fR
+and
+\fB[^x]\fR
+becomes `\fB[^xX]\fR'.
+.PP
+If newline-sensitive matching is specified, \fB.\fR
+and bracket expressions using
+\fB^\fR
+will never match the newline character
+(so that matches will never cross newlines unless the RE
+explicitly arranges it)
+and
+\fB^\fR
+and
+\fB$\fR
+will match the empty string after and before a newline
+respectively, in addition to matching at beginning and end of string
+respectively.
+ARE
+\fB\eA\fR
+and
+\fB\eZ\fR
+continue to match beginning or end of string \fIonly\fR.
+.PP
+If partial newline-sensitive matching is specified,
+this affects \fB.\fR
+and bracket expressions
+as with newline-sensitive matching, but not
+\fB^\fR
+and `\fB$\fR'.
+.PP
+If inverse partial newline-sensitive matching is specified,
+this affects
+\fB^\fR
+and
+\fB$\fR
+as with
+newline-sensitive matching,
+but not \fB.\fR
+and bracket expressions.
+This isn't very useful but is provided for symmetry.
+.SH "LIMITS AND COMPATIBILITY"
+No particular limit is imposed on the length of REs.
+Programs intended to be highly portable should not employ REs longer
+than 256 bytes,
+as a POSIX-compliant implementation can refuse to accept such REs.
+.PP
+The only feature of AREs that is actually incompatible with
+POSIX EREs is that
+\fB\e\fR
+does not lose its special
+significance inside bracket expressions.
+All other ARE features use syntax which is illegal or has
+undefined or unspecified effects in POSIX EREs;
+the
+\fB***\fR
+syntax of directors likewise is outside the POSIX
+syntax for both BREs and EREs.
+.PP
+Many of the ARE extensions are borrowed from Perl, but some have
+been changed to clean them up, and a few Perl extensions are not present.
+Incompatibilities of note include `\fB\eb\fR', `\fB\eB\fR',
+the lack of special treatment for a trailing newline,
+the addition of complemented bracket expressions to the things
+affected by newline-sensitive matching,
+the restrictions on parentheses and back references in lookahead constraints,
+and the longest/shortest-match (rather than first-match) matching semantics.
+.PP
+The matching rules for REs containing both normal and non-greedy quantifiers
+have changed since early beta-test versions of this package.
+(The new rules are much simpler and cleaner,
+but don't work as hard at guessing the user's real intentions.)
+.PP
+Henry Spencer's original 1986 \fIregexp\fR package,
+still in widespread use (e.g., in pre-8.1 releases of Tcl),
+implemented an early version of today's EREs.
+There are four incompatibilities between \fIregexp\fR's near-EREs
+(`RREs' for short) and AREs.
+In roughly increasing order of significance:
+.PP
+.RS
+In AREs,
+\fB\e\fR
+followed by an alphanumeric character is either an
+escape or an error,
+while in RREs, it was just another way of writing the
+alphanumeric.
+This should not be a problem because there was no reason to write
+such a sequence in RREs.
+.PP
+\fB{\fR
+followed by a digit in an ARE is the beginning of a bound,
+while in RREs,
+\fB{\fR
+was always an ordinary character.
+Such sequences should be rare,
+and will often result in an error because following characters
+will not look like a valid bound.
+.PP
+In AREs,
+\fB\e\fR
+remains a special character within `\fB[\|]\fR',
+so a literal
+\fB\e\fR
+within
+\fB[\|]\fR
+must be written `\fB\e\e\fR'.
+\fB\e\e\fR
+also gives a literal
+\fB\e\fR
+within
+\fB[\|]\fR
+in RREs,
+but only truly paranoid programmers routinely doubled the backslash.
+.PP
+AREs report the longest/shortest match for the RE,
+rather than the first found in a specified search order.
+This may affect some RREs which were written in the expectation that
+the first match would be reported.
+(The careful crafting of RREs to optimize the search order for fast
+matching is obsolete (AREs examine all possible matches
+in parallel, and their performance is largely insensitive to their
+complexity) but cases where the search order was exploited to deliberately
+find a match which was \fInot\fR the longest/shortest will need rewriting.)
+.RE
+
+.SH "BASIC REGULAR EXPRESSIONS"
+BREs differ from EREs in several respects. `\fB|\fR', `\fB+\fR',
+and
+\fB?\fR
+are ordinary characters and there is no equivalent
+for their functionality.
+The delimiters for bounds are
+\fB\e{\fR
+and `\fB\e}\fR',
+with
+\fB{\fR
+and
+\fB}\fR
+by themselves ordinary characters.
+The parentheses for nested subexpressions are
+\fB\e(\fR
+and `\fB\e)\fR',
+with
+\fB(\fR
+and
+\fB)\fR
+by themselves ordinary characters.
+\fB^\fR
+is an ordinary character except at the beginning of the
+RE or the beginning of a parenthesized subexpression,
+\fB$\fR
+is an ordinary character except at the end of the
+RE or the end of a parenthesized subexpression,
+and
+\fB*\fR
+is an ordinary character if it appears at the beginning of the
+RE or the beginning of a parenthesized subexpression
+(after a possible leading `\fB^\fR').
+Finally,
+single-digit back references are available,
+and
+\fB\e<\fR
+and
+\fB\e>\fR
+are synonyms for
+\fB[[:<:]]\fR
+and
+\fB[[:>:]]\fR
+respectively;
+no other escapes are available.
+
+.SH "SEE ALSO"
+RegExp(3), regexp(n), regsub(n), lsearch(n), switch(n), text(n)
+
+.SH KEYWORDS
+match, regular expression, string
diff --git a/tcl/doc/read.n b/tcl/doc/read.n
index f294a8bff04..113c9c61626 100644
--- a/tcl/doc/read.n
+++ b/tcl/doc/read.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH read n 7.5 Tcl "Tcl Built-In Commands"
+.TH read n 8.1 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,7 +16,7 @@ read \- Read from a channel
.SH SYNOPSIS
\fBread \fR?\fB\-nonewline\fR? \fIchannelId\fR
.sp
-\fBread \fIchannelId numBytes\fR
+\fBread \fIchannelId numChars\fR
.BE
.SH DESCRIPTION
@@ -25,26 +25,34 @@ In the first form, the \fBread\fR command reads all of the data from
\fIchannelId\fR up to the end of the file.
If the \fB\-nonewline\fR switch is specified then the last character
of the file is discarded if it is a newline.
-In the second form, the extra argument specifies how many bytes to
-read. Exactly that many bytes will be read and returned, unless
-there are fewer than \fInumBytes\fR left in the file; in this case
-all the remaining bytes are returned.
+.VS 8.1
+In the second form, the extra argument specifies how many characters to
+read. Exactly that many characters will be read and returned, unless
+there are fewer than \fInumChars\fR left in the file; in this case
+all the remaining characters are returned. If the channel is
+configured to use a multi-byte encoding, then the number of characters
+read may not be the same as the number of bytes read.
.PP
-If \fIchannelId\fR is in nonblocking mode, the command may not read
-as many bytes as requested: once all available input has been read,
-the command will return the data that is available rather than blocking
-for more input.
+If \fIchannelId\fR is in nonblocking mode, the command may not read as
+many characters as requested: once all available input has been read,
+the command will return the data that is available rather than
+blocking for more input. If the channel is configured to use a
+multi-byte encoding, then there may actually be some bytes remaining
+in the internal buffers that do not form a complete character. These
+bytes will not be returned until a complete character is available or
+end-of-file is reached.
+.VE 8.1
The \fB\-nonewline\fR switch is ignored if the command returns
before reaching the end of the file.
.PP
\fBRead\fR translates end-of-line sequences in the input into
newline characters according to the \fB\-translation\fR option
for the channel.
-See the manual entry for \fBfconfigure\fR for details on the
-\fB\-translation\fR option.
+See the \fBfconfigure\fR manual entry for a discussion on ways in
+which \fBfconfigure\fR will alter input.
.SH "SEE ALSO"
eof(n), fblocked(n), fconfigure(n)
.SH KEYWORDS
-blocking, channel, end of line, end of file, nonblocking, read, translation
+blocking, channel, end of line, end of file, nonblocking, read, translation, encoding
diff --git a/tcl/doc/regexp.n b/tcl/doc/regexp.n
index af39c918314..6e598903ff6 100644
--- a/tcl/doc/regexp.n
+++ b/tcl/doc/regexp.n
@@ -1,6 +1,5 @@
'\"
-'\" Copyright (c) 1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,11 +7,12 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH regexp n "" Tcl "Tcl Built-In Commands"
+.TH regexp n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
regexp \- Match a regular expression against a string
+
.SH SYNOPSIS
\fBregexp \fR?\fIswitches\fR? \fIexp string \fR?\fImatchVar\fR? ?\fIsubMatchVar subMatchVar ...\fR?
.BE
@@ -20,7 +20,10 @@ regexp \- Match a regular expression against a string
.SH DESCRIPTION
.PP
Determines whether the regular expression \fIexp\fR matches part or
-all of \fIstring\fR and returns 1 if it does, 0 if it doesn't.
+all of \fIstring\fR and returns 1 if it does, 0 if it doesn't, unless
+\fB-inline\fR is specified (see below).
+(Regular expression matching is described in the \fBre_syntax\fR
+reference page.)
.LP
If additional arguments are specified after \fIstring\fR then they
are treated as the names of variables in which to return
@@ -31,27 +34,91 @@ the characters in \fIstring\fR that matched the leftmost parenthesized
subexpression within \fIexp\fR, the next \fIsubMatchVar\fR will
contain the characters that matched the next parenthesized
subexpression to the right in \fIexp\fR, and so on.
-.LP
+.PP
If the initial arguments to \fBregexp\fR start with \fB\-\fR then
they are treated as switches. The following switches are
currently supported:
-.TP 10
-\fB\-nocase\fR
-Causes upper-case characters in \fIstring\fR to be treated as
-lower case during the matching process.
-.TP 10
+.TP 15
+\fB\-about\fR
+Instead of attempting to match the regular expression, returns a list
+containing information about the regular expression. The first
+element of the list is a subexpression count. The second element is a
+list of property names that describe various attributes of the regular
+expression. This switch is primarily intended for debugging purposes.
+.TP 15
+\fB\-expanded\fR
+Enables use of the expanded regular expression syntax where
+whitespace and comments are ignored. This is the same as specifying
+the \fB(?x)\fR embedded option (see METASYNTAX, below).
+.TP 15
\fB\-indices\fR
Changes what is stored in the \fIsubMatchVar\fRs.
-Instead of storing the matching characters from \fBstring\fR,
+Instead of storing the matching characters from \fIstring\fR,
each variable
will contain a list of two decimal strings giving the indices
in \fIstring\fR of the first and last characters in the matching
range of characters.
-.TP 10
+.TP 15
+\fB\-line\fR
+Enables newline-sensitive matching. By default, newline is a
+completely ordinary character with no special meaning. With this
+flag, `[^' bracket expressions and `.' never match newline, `^'
+matches an empty string after any newline in addition to its normal
+function, and `$' matches an empty string before any newline in
+addition to its normal function. This flag is equivalent to
+specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the
+\fB(?n)\fR embedded option (see METASYNTAX, below).
+.TP 15
+\fB\-linestop\fR
+Changes the behavior of `[^' bracket expressions and `.' so that they
+stop at newlines. This is the same as specifying the \fB(?p)\fR
+embedded option (see METASYNTAX, below).
+.TP 15
+\fB\-lineanchor\fR
+Changes the behavior of `^' and `$' (the ``anchors'') so they match the
+beginning and end of a line respectively. This is the same as
+specifying the \fB(?w)\fR embedded option (see METASYNTAX, below).
+.TP 15
+\fB\-nocase\fR
+Causes upper-case characters in \fIstring\fR to be treated as
+lower case during the matching process.
+.VS 8.3
+.TP 15
+\fB\-all\fR
+Causes the regular expression to be matched as many times as possible
+in the string, returning the total number of matches found. If this
+is specified with match variables, they will continue information for
+the last match only.
+.TP 15
+\fB\-inline\fR
+Causes the command to return, as a list, the data that would otherwise
+be placed in match variables. When using \fB-inline\fR,
+match variables may not be specified. If used with \fB-all\fR, the
+list will be concatenated at each iteration, such that a flat list is
+always returned. For each match iteration, the command will append the
+overall match data, plus one element for each subexpression in the
+regular expression. Examples are:
+.CS
+ regexp -inline -- {\\w(\\w)} " inlined "
+ => {in n}
+ regexp -all -inline -- {\\w(\\w)} " inlined "
+ => {in n li i ne e}
+.CE
+.TP 15
+\fB\-start\fR \fIindex\fR
+Specifies a character index offset into the string to start
+matching the regular expression at. When using this switch, `^'
+will not match the beginning of the line, and \\A will still
+match the start of the string at \fIindex\fR. If \fB\-indices\fR
+is specified, the indices will be indexed starting from the
+absolute beginning of the input string.
+\fIindex\fR will be constrained to the bounds of the input string.
+.VE 8.3
+.TP 15
\fB\-\|\-\fR
Marks the end of switches. The argument following this one will
be treated as \fIexp\fR even if it starts with a \fB\-\fR.
-.LP
+.PP
If there are more \fIsubMatchVar\fR's than parenthesized
subexpressions within \fIexp\fR, or if a particular subexpression
in \fIexp\fR doesn't match the string (e.g. because it was in a
@@ -59,87 +126,9 @@ portion of the expression that wasn't matched), then the corresponding
\fIsubMatchVar\fR will be set to ``\fB\-1 \-1\fR'' if \fB\-indices\fR
has been specified or to an empty string otherwise.
-.SH "REGULAR EXPRESSIONS"
-.PP
-Regular expressions are implemented using Henry Spencer's package
-(thanks, Henry!),
-and much of the description of regular expressions below is copied verbatim
-from his manual entry.
-.PP
-A regular expression is zero or more \fIbranches\fR, separated by ``|''.
-It matches anything that matches one of the branches.
-.PP
-A branch is zero or more \fIpieces\fR, concatenated.
-It matches a match for the first, followed by a match for the second, etc.
-.PP
-A piece is an \fIatom\fR possibly followed by ``*'', ``+'', or ``?''.
-An atom followed by ``*'' matches a sequence of 0 or more matches of the atom.
-An atom followed by ``+'' matches a sequence of 1 or more matches of the atom.
-An atom followed by ``?'' matches a match of the atom, or the null string.
-.PP
-An atom is a regular expression in parentheses (matching a match for the
-regular expression), a \fIrange\fR (see below), ``.''
-(matching any single character), ``^'' (matching the null string at the
-beginning of the input string), ``$'' (matching the null string at the
-end of the input string), a ``\e'' followed by a single character (matching
-that character), or a single character with no other significance
-(matching that character).
-.PP
-A \fIrange\fR is a sequence of characters enclosed in ``[]''.
-It normally matches any single character from the sequence.
-If the sequence begins with ``^'',
-it matches any single character \fInot\fR from the rest of the sequence.
-If two characters in the sequence are separated by ``\-'', this is shorthand
-for the full list of ASCII characters between them
-(e.g. ``[0-9]'' matches any decimal digit).
-To include a literal ``]'' in the sequence, make it the first character
-(following a possible ``^'').
-To include a literal ``\-'', make it the first or last character.
-
-.SH "CHOOSING AMONG ALTERNATIVE MATCHES"
-.PP
-In general there may be more than one way to match a regular expression
-to an input string. For example, consider the command
-.CS
-\fBregexp (a*)b* aabaaabb x y\fR
-.CE
-Considering only the rules given so far, \fBx\fR and \fBy\fR could
-end up with the values \fBaabb\fR and \fBaa\fR, \fBaaab\fR and \fBaaa\fR,
-\fBab\fR and \fBa\fR, or any of several other combinations.
-To resolve this potential ambiguity \fBregexp\fR chooses among
-alternatives using the rule ``first then longest''.
-In other words, it considers the possible matches in order working
-from left to right across the input string and the pattern, and it
-attempts to match longer pieces of the input string before shorter
-ones. More specifically, the following rules apply in decreasing
-order of priority:
-.IP [1]
-If a regular expression could match two different parts of an input string
-then it will match the one that begins earliest.
-.IP [2]
-If a regular expression contains \fB|\fR operators then the leftmost
-matching sub-expression is chosen.
-.IP [3]
-In \fB*\fR, \fB+\fR, and \fB?\fR constructs, longer matches are chosen
-in preference to shorter ones.
-.IP [4]
-In sequences of expression components the components are considered
-from left to right.
-.LP
-In the example from above, \fB(a*)b*\fR matches \fBaab\fR: the \fB(a*)\fR
-portion of the pattern is matched first and it consumes the leading
-\fBaa\fR; then the \fBb*\fR portion of the pattern consumes the
-next \fBb\fR. Or, consider the following example:
-.CS
-\fBregexp (ab|a)(b*)c abc x y z\fR
-.CE
-After this command \fBx\fR will be \fBabc\fR, \fBy\fR will be
-\fBab\fR, and \fBz\fR will be an empty string.
-Rule 4 specifies that \fB(ab|a)\fR gets first shot at the input
-string and Rule 2 specifies that the \fBab\fR sub-expression
-is checked before the \fBa\fR sub-expression.
-Thus the \fBb\fR has already been claimed before the \fB(b*)\fR
-component is checked and \fB(b*)\fR must match an empty string.
+.SH "SEE ALSO"
+re_syntax(n)
.SH KEYWORDS
match, regular expression, string
+
diff --git a/tcl/doc/registry.n b/tcl/doc/registry.n
index f1b48b2146e..d205f606ccf 100644
--- a/tcl/doc/registry.n
+++ b/tcl/doc/registry.n
@@ -39,8 +39,11 @@ one of the following forms:
\fIHostname\fR specifies the name of any valid Windows
host that exports its registry. The \fIrootname\fR component must be
one of \fBHKEY_LOCAL_MACHINE\fR, \fBHKEY_USERS\fR,
-\fBHKEY_CLASSES_ROOT\fR, \fBHKEY_CURRENT_USER\fR, or
-\fBHKEY_CURRENT_CONFIG\fR. The \fIkeypath\fR can be one or more
+.VS
+\fBHKEY_CLASSES_ROOT\fR, \fBHKEY_CURRENT_USER\fR,
+\fBHKEY_CURRENT_CONFIG\fR, \fBHKEY_PERFORMANCE_DATA\fR, or
+\fBHKEY_DYN_DATA\fR. The \fIkeypath\fR can be one or more
+.VE
registry key names separated by backslash (\fB\e\fR) characters.
.PP
\fIOption\fR indicates what to do with the registry key name. Any
@@ -109,7 +112,6 @@ registry command:
.
The registry value contains arbitrary binary data. The data is represented
exactly in Tcl, including any embedded nulls.
-Tcl
.TP
\fBnone\fR
.
diff --git a/tcl/doc/regsub.n b/tcl/doc/regsub.n
index a6605d1bfca..0e0f60b69ed 100644
--- a/tcl/doc/regsub.n
+++ b/tcl/doc/regsub.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,7 +9,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH regsub n 7.4 Tcl "Tcl Built-In Commands"
+.TH regsub n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -23,6 +24,8 @@ This command matches the regular expression \fIexp\fR against
\fIstring\fR,
and it copies \fIstring\fR to the variable whose name is
given by \fIvarName\fR.
+(Regular expression matching is described in the \fBre_syntax\fR
+reference page.)
If there is a match, then while copying \fIstring\fR to \fIvarName\fR
the portion of \fIstring\fR that
matched \fIexp\fR is replaced with \fIsubSpec\fR.
@@ -53,11 +56,45 @@ matching range is found and substituted.
If \fB\-all\fR is specified, then ``&'' and ``\e\fIn\fR''
sequences are handled for each substitution using the information
from the corresponding match.
+.TP 15
+\fB\-expanded\fR
+Enables use of the expanded regular expression syntax where
+whitespace and comments are ignored. This is the same as specifying
+the \fB(?x)\fR embedded option (see METASYNTAX, below).
+.TP 15
+\fB\-line\fR
+Enables newline-sensitive matching. By default, newline is a
+completely ordinary character with no special meaning. With this
+flag, `[^' bracket expressions and `.' never match newline, `^'
+matches an empty string after any newline in addition to its normal
+function, and `$' matches an empty string before any newline in
+addition to its normal function. This flag is equivalent to
+specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the
+\fB(?n)\fR embedded option (see METASYNTAX, below).
+.TP 15
+\fB\-linestop\fR
+Changes the behavior of `[^' bracket expressions and `.' so that they
+stop at newlines. This is the same as specifying the \fB(?p)\fR
+embedded option (see METASYNTAX, below).
+.TP 15
+\fB\-lineanchor\fR
+Changes the behavior of `^' and `$' (the ``anchors'') so they match the
+beginning and end of a line respectively. This is the same as
+specifying the \fB(?w)\fR embedded option (see METASYNTAX, below).
.TP 10
\fB\-nocase\fR
Upper-case characters in \fIstring\fR will be converted to lower-case
before matching against \fIexp\fR; however, substitutions specified
by \fIsubSpec\fR use the original unconverted form of \fIstring\fR.
+.VS 8.3
+.TP 10
+\fB\-start\fR \fIindex\fR
+Specifies a character index offset into the string to start
+matching the regular expression at. When using this switch, `^'
+will not match the beginning of the line, and \\A will still
+match the start of the string at \fIindex\fR.
+\fIindex\fR will be constrained to the bounds of the input string.
+.VE 8.3
.TP 10
\fB\-\|\-\fR
Marks the end of switches. The argument following this one will
@@ -70,3 +107,4 @@ of regular expressions.
.SH KEYWORDS
match, pattern, regular expression, substitute
+
diff --git a/tcl/doc/resource.n b/tcl/doc/resource.n
index 3bedadad09f..3a1748bd0e8 100644
--- a/tcl/doc/resource.n
+++ b/tcl/doc/resource.n
@@ -55,7 +55,7 @@ If the \fB-file\fR option is specified then the resource will be
deleted from the file pointed to by \fIresourceRef\fR. Otherwise the
first resource with the given \fIresourceName\fR and or
\fIresourceId\fR which is found on the resource file path will be
-deleted. To inspect the file path, use the \fIresource files\fB command.
+deleted. To inspect the file path, use the \fIresource files\fR command.
.RE
.TP
\fBresource files ?\fIresourceRef\fR?
@@ -75,8 +75,8 @@ A Tcl list of either the resource name's or resource id's of the found
resources will be returned. See the RESOURCE IDS section below for
more details about what a resource id is.
.TP
-\fBresource open \fIfileName\fR ?\fIpermissions\fR?
-Open the resource for the file \fIfileName\fR. Standard file
+\fBresource open \fIfileName\fR ?\fIaccess\fR?
+Open the resource for the file \fIfileName\fR. Standard file access
permissions may also be specified (see the manual entry for \fBopen\fR
for details). A resource reference (\fIresourceRef\fR) is returned
that can be used by the other resource commands. An error can occur
@@ -145,11 +145,11 @@ always searched or returned in preference to numbers. For example,
the \fBresource list\fR command will return names if they exist or
numbers if the name is NULL.
-.SH "SEE ALSO"
-open
-
.SH "PORTABILITY ISSUES"
The resource command is only available on Macintosh.
+.SH "SEE ALSO"
+open
+
.SH KEYWORDS
open, resource
diff --git a/tcl/doc/safe.n b/tcl/doc/safe.n
index ae6847f45c2..08f32a5a810 100644
--- a/tcl/doc/safe.n
+++ b/tcl/doc/safe.n
@@ -11,9 +11,8 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Safe Base \- A mechanism for creating and manipulating safe interpreters.
+Safe\ Base \- A mechanism for creating and manipulating safe interpreters.
.SH SYNOPSIS
-.PP
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
.sp
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
@@ -50,7 +49,7 @@ hosting application to any party.
.PP
The Safe Base allows a master interpreter to create safe, restricted
interpreters that contain a set of predefined aliases for the \fBsource\fR,
-\fBload\fR, \fBfile\fR and \fBexit\fR commands and
+\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and
are able to use the auto-loading and package mechanisms.
.PP
No knowledge of the file system structure is leaked to the
@@ -246,6 +245,12 @@ the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR,
subcommands. For more details on what these subcommands do see the manual
page for the \fBfile\fR command.
.TP
+\fBencoding\fR ?\fIsubCmd args...\fR?
+The \fBenconding\fR alias provides access to a safe subset of the
+subcommands of the \fBencoding\fR command; it disallows setting of
+the system encoding, but allows all other subcommands including
+\fBsystem\fR to check the current encoding.
+.TP
\fBexit\fR
The calling interpreter is deleted and its computation is stopped, but the
Tcl process in which this interpreter exists is not terminated.
@@ -262,9 +267,9 @@ is to prevent.
.PP
The commands available in a safe interpreter, in addition to
the safe set as defined in \fBinterp\fR manual page, are mediated aliases
-for \fBsource\fR, \fBload\fR, \fBexit\fR, and a safe subset of \fBfile\fR.
-The safe interpreter can also auto-load code and it can request that
-packages be loaded.
+for \fBsource\fR, \fBload\fR, \fBexit\fR, and safe subsets of
+\fBfile\fR and \fBencoding\fR. The safe interpreter can also auto-load
+code and it can request that packages be loaded.
.PP
Because some of these commands access the local file system, there is a
potential for information leakage about its directory structure.
diff --git a/tcl/doc/scan.n b/tcl/doc/scan.n
index 6ad163d6843..55628609cdd 100644
--- a/tcl/doc/scan.n
+++ b/tcl/doc/scan.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,48 +9,71 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH scan n "" Tcl "Tcl Built-In Commands"
+.TH scan n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
scan \- Parse string using conversion specifiers in the style of sscanf
.SH SYNOPSIS
-\fBscan \fIstring format varName \fR?\fIvarName ...\fR?
+\fBscan \fIstring format \fR?\fIvarName varName ...\fR?
.BE
.SH INTRODUCTION
.PP
-This command parses fields from an input string in the same fashion
-as the ANSI C \fBsscanf\fR procedure and returns a count of the number
-of conversions performed, or -1 if the end of the input string is
-reached before any conversions have been performed.
-\fIString\fR gives the input to be parsed and \fIformat\fR indicates
-how to parse it, using \fB%\fR conversion specifiers as in \fBsscanf\fR.
-Each \fIvarName\fR gives the name of a variable; when a field is
-scanned from \fIstring\fR the result is converted back into a string
-and assigned to the corresponding variable.
+This command parses fields from an input string in the same fashion as the
+ANSI C \fBsscanf\fR procedure and returns a count of the number of
+conversions performed, or -1 if the end of the input string is reached
+before any conversions have been performed. \fIString\fR gives the input
+to be parsed and \fIformat\fR indicates how to parse it, using \fB%\fR
+conversion specifiers as in \fBsscanf\fR. Each \fIvarName\fR gives the
+name of a variable; when a field is scanned from \fIstring\fR the result is
+converted back into a string and assigned to the corresponding variable.
+.VS 8.3
+If no \fIvarName\fR variables are specified, then \fBscan\fR works in an
+inline manner, returning the data that would otherwise be stored in the
+variables as a list. In the inline case, an empty string is returned when
+the end of the input string is reached before any conversions have been
+performed.
+.VE 8.3
.SH "DETAILS ON SCANNING"
.PP
-\fBScan\fR operates by scanning \fIstring\fR and \fIformatString\fR together.
-If the next character in \fIformatString\fR is a blank or tab then it
+\fBScan\fR operates by scanning \fIstring\fR and \fIformat\fR together.
+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 isn't a \fB%\fR character then it
must match the next character of \fIstring\fR.
-When a \fB%\fR is encountered in \fIformatString\fR, it indicates
+When a \fB%\fR is encountered in \fIformat\fR, it indicates
the start of a conversion specifier.
-A conversion specifier contains three fields after the \fB%\fR:
+A conversion specifier contains up to four fields after the \fB%\fR:
a \fB*\fR, which indicates that the converted value is to be discarded
-instead of assigned to a variable; a number indicating a maximum field
-width; and a conversion character.
+.VS 8.1
+instead of assigned to a variable; a XPG3 position specifier; a number
+.VE 8.1
+indicating a maximum field width; and a conversion character.
All of these fields are optional except for the conversion character.
+The fields that are present must appear in the order given above.
.PP
-When \fBscan\fR finds a conversion specifier in \fIformatString\fR, it
-first skips any white-space characters in \fIstring\fR.
+When \fBscan\fR finds a conversion specifier in \fIformat\fR, it
+first skips any white-space characters in \fIstring\fR (unless the
+specifier is \fB[\fR or \fBc\fR).
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.
+.VS 8.1
+.PP
+If the \fB%\fR is followed by a decimal number and a \fB$\fR, as in
+``\fB%2$d\fR'', then the variable to use is not taken from the next
+sequential argument. Instead, it is taken from the argument indicated
+by the number, where 1 corresponds to the first \fIvarName\fR. If
+there are any positional specifiers in \fIformat\fR then all of the
+specifiers must be positional. Every \fIvarName\fR on the argument
+list must correspond to exactly one conversion specifier or an error
+is generated, or in the inline case, any position can be specified
+at most once and the empty positions will be filled in with empty strings.
+.VE 8.1
+.PP
The following conversion characters are supported:
.TP 10
\fBd\fR
@@ -63,6 +87,17 @@ value is stored in the variable as a decimal string.
\fBx\fR
The input field must be a hexadecimal integer. It is read in
and the value is stored in the variable as a decimal string.
+.VS 8.1
+.TP 10
+\fBu\fR
+The input field must be a decimal integer. The value is stored in the
+variable as an unsigned decimal integer string.
+.TP 10
+\fBi\fR
+The input field must be an integer. The base (i.e. decimal, octal, or
+hexadecimal) is determined in the same fashion as described in
+\fBexpr\fR. The value is stored in the variable as a decimal string.
+.VE 8.1
.TP 10
\fBc\fR
A single character is read in and its binary value is stored in
@@ -92,6 +127,13 @@ The matching string is stored in the variable.
If the first character between the brackets is a \fB]\fR then
it is treated as part of \fIchars\fR rather than the closing
bracket for the set.
+.VS 8.1
+If \fIchars\fR
+contains a sequence of the form \fIa\fB\-\fIb\fR then any
+character between \fIa\fR and \fIb\fR (inclusive) will match.
+If the first or last character between the brackets is a \fB\-\fR, then
+it is treated as part of \fIchars\fR rather than indicating a range.
+.VE 8.1
.TP 10
\fB[^\fIchars\fB]\fR
The input field consists of any number of characters not in
@@ -100,6 +142,18 @@ 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
the set.
+.VS 8.1
+If \fIchars\fR
+contains a sequence of the form \fIa\fB\-\fIb\fR then any
+character between \fIa\fR and \fIb\fR (inclusive) will be excluded
+from the set.
+If the first or last character between the brackets is a \fB\-\fR, then
+it is treated as part of \fIchars\fR rather than indicating a range.
+.TP 10
+\fBn\fR
+No input is consumed from the input string. Instead, the total number
+of chacters scanned from the input string so far is stored in the variable.
+.VE 8.1
.LP
The number of characters read from the input for a conversion is the
largest number that makes sense for that particular conversion (e.g.
@@ -115,9 +169,10 @@ then no variable is assigned and the next scan argument is not consumed.
.PP
The behavior of the \fBscan\fR command is the same as the behavior of
the ANSI C \fBsscanf\fR procedure except for the following differences:
+.VS 8.1
.IP [1]
-\fB%p\fR and \fB%n\fR conversion specifiers are not currently
-supported.
+\fB%p\fR conversion specifier is not currently supported.
+.VE 8.1
.IP [2]
For \fB%c\fR conversions a single character value is
converted to a decimal string, which is then assigned to the
@@ -129,6 +184,12 @@ values are always converted as if there were no modifier present
and real values are always converted as if the \fBl\fR modifier
were present (i.e. type \fBdouble\fR is used for the internal
representation).
+.VS 8.3
+.IP [4]
+If the end of the input string is reached before any conversions have been
+performed and no variables are given, and empty string is returned.
+.VE 8.3
.SH KEYWORDS
conversion specifier, parse, scan
+
diff --git a/tcl/doc/seek.n b/tcl/doc/seek.n
index bd87e3c75df..7c3bb818ae7 100644
--- a/tcl/doc/seek.n
+++ b/tcl/doc/seek.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH seek n 7.5 Tcl "Tcl Built-In Commands"
+.TH seek n 8.1 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -50,6 +50,12 @@ It also discards any buffered and unread input.
This command returns an empty string.
An error occurs if this command is applied to channels whose underlying
file or device does not support seeking.
+.PP
+.VS 8.1
+Note that \fIoffset\fR values are byte offsets, not character
+offsets. Both \fBseek\fR and \fBtell\fR operate in terms of bytes,
+not characters, unlike \fBread\fR.
+.VE 8.1
.SH KEYWORDS
access position, file, seek
diff --git a/tcl/doc/socket.n b/tcl/doc/socket.n
index 289512fd91a..7a7486722e5 100644
--- a/tcl/doc/socket.n
+++ b/tcl/doc/socket.n
@@ -1,12 +1,13 @@
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1998-1999 by Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" RCS: @(#) $Id$
.so man.macros
-.TH socket n 7.5 Tcl "Tcl Built-In Commands"
+.TH socket n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -100,9 +101,17 @@ event loop, for example by invoking the \fBvwait\fR command or
calling the C procedure \fBTcl_DoOneEvent\fR, then no connections
will be accepted.
-.SH CONFIGURATION OPTIONS
+.SH "CONFIGURATION OPTIONS"
The \fBfconfigure\fR command can be used to query several readonly
configuration options for socket channels:
+.VS 8.0.5
+.TP
+\fB\-error\fR
+This option gets the current error status of the given socket. This
+is useful when you need to determine if an asynchronous connect
+operation succeeded. If there was an error, the error message is
+returned. If there was no error, an empty string is returned.
+.VE 8.0.5
.TP
\fB\-sockname\fR
This option returns a list of three elements, the address, the host name
diff --git a/tcl/doc/string.n b/tcl/doc/string.n
index 2b93d4c268b..2aaec95474b 100644
--- a/tcl/doc/string.n
+++ b/tcl/doc/string.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH string n 7.6 Tcl "Tcl Built-In Commands"
+.TH string n 8.1 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -21,40 +21,197 @@ string \- Manipulate strings
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
+.VS 8.1
.TP
-\fBstring compare \fIstring1 string2\fR
+\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. In almost all cases, you should use the
+\fBstring length\fR operation. Refer to the \fBTcl_NumUtfChars\fR
+manual entry for more details on the UTF\-8 representation.
+.TP
+\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
+.VE 8.1
Perform a character-by-character comparison of strings \fIstring1\fR and
-\fIstring2\fR in the same way as the C \fBstrcmp\fR procedure. Return
+\fIstring2\fR. Returns
\-1, 0, or 1, depending on whether \fIstring1\fR is lexicographically
less than, equal to, or greater than \fIstring2\fR.
+.VS 8.1
+If \fB\-length\fR is specified, then only the first \fIlength\fR characters
+are used in the comparison. If \fB\-length\fR is negative, it is
+ignored. If \fB\-nocase\fR is specified, then the strings are
+compared in a case-insensitive manner.
+.TP
+\fBstring equal\fR ?\fB\-nocase\fR? ?\fB-length int\fR? \fIstring1 string2\fR
+Perform a character-by-character comparison of strings
+\fIstring1\fR and \fIstring2\fR. Returns 1 if \fIstring1\fR and
+\fIstring2\fR are identical, or 0 when not. If \fB\-length\fR is
+specified, then only the first \fIlength\fR characters are used in the
+comparison. If \fB\-length\fR is negative, it is ignored. If
+\fB\-nocase\fR is specified, then the strings are compared in a
+case-insensitive manner.
.TP
-\fBstring first \fIstring1 string2\fR
+\fBstring first \fIstring1 string2\fR ?\fIstartIndex\fR?
+.VE 8.1
Search \fIstring2\fR for a sequence of characters that exactly match
the characters in \fIstring1\fR. If found, return the index of the
first character in the first such match within \fIstring2\fR. If not
found, return \-1.
+.VS 8.1
+If \fIstartIndex\fR is specified (in any of the forms accepted by the
+\fBindex\fR method), then the search is constrained to start with the
+character in \fIstring2\fR specified by the index. For example,
+.RS
+.CS
+\fBstring first a 0a23456789abcdef 5\fR
+.CE
+will return \fB10\fR, but
+.CS
+\fBstring first a 0123456789abcdef 11\fR
+.CE
+will return \fB\-1\fR.
+.RE
+.VE 8.1
.TP
\fBstring index \fIstring charIndex\fR
Returns the \fIcharIndex\fR'th character of the \fIstring\fR
argument. A \fIcharIndex\fR of 0 corresponds to the first
-character of the string.
+character of the string.
+.VS 8.1
+\fIcharIndex\fR may be specified as
+follows:
+.RS
+.IP \fIinteger\fR 10
+The char specified at this integral index
+.IP \fBend\fR 10
+The last char of the string.
+.IP \fBend\-\fIinteger\fR 10
+The last char of the string minus the specified integer
+offset (e.g. \fBend\-1\fR would refer to the "c" in "abcd").
+.PP
+.VE 8.1
If \fIcharIndex\fR is less than 0 or greater than
or equal to the length of the string then an empty string is
returned.
+.VS 8.1
+.RE
+.TP
+\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
+Returns 1 if \fIstring\fR is a valid member of the specified character
+class, otherwise returns 0. If \fB\-strict\fR is specified, then an
+empty string returns 0, otherwise and empty string will return 1 on
+any class. If \fB\-failindex\fR is specified, then if the function
+returns 0, the index in the string where the class was no longer valid
+will be stored in the variable named \fIvarname\fR. The \fIvarname\fR
+will not be set if the function returns 1. The following character classes
+are recognized (the class name can be abbreviated):
+.RS
+.IP \fBalnum\fR 10
+Any Unicode alphabet or digit character.
+.IP \fBalpha\fR 10
+Any Unicode alphabet character.
+.IP \fBascii\fR 10
+Any character with a value less than \\u0080 (those that
+are in the 7\-bit ascii range).
+.IP \fBboolean\fR 10
+Any of the forms allowed to \fBTcl_GetBoolean\fR.
+.IP \fBcontrol\fR 10
+Any Unicode control character.
+.IP \fBdigit\fR 10
+Any Unicode digit character. Note that this includes characters
+outside of the [0\-9] range.
+.IP \fBdouble\fR 10
+Any of the valid forms for a double in Tcl, with optional surrounding
+whitespace. In case of under/overflow in the value, 0 is returned
+and the \fIvarname\fR will contain \-1.
+.IP \fBfalse\fR 10
+Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is false.
+.IP \fBgraph\fR 10
+Any Unicode printing character, except space.
+.IP \fBinteger\fR 10
+Any of the valid forms for an integer in Tcl, with optional surrounding
+whitespace. In case of under/overflow in the value, 0 is returned
+and the \fIvarname\fR will contain \-1.
+.IP \fBlower\fR 10
+Any Unicode lower case alphabet character.
+.IP \fBprint\fR 10
+Any Unicode printing character, including space.
+.IP \fBpunct\fR 10
+Any Unicode punctuation character.
+.IP \fBspace\fR 10
+Any Unicode space character.
+.IP \fBtrue\fR 10
+Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is true.
+.IP \fBupper\fR 10
+Any upper case alphabet character in the Unicode character set.
+.IP \fBwordchar\fR 10
+Any Unicode word character. That is any alphanumeric character,
+and any Unicode connector punctuation characters (e.g. underscore).
+.IP \fBxdigit\fR 10
+Any hexadecimal digit character ([0\-9A\-Fa\-f]).
+.PP
+In the case of \fBboolean\fR, \fBtrue\fR and \fBfalse\fR, if the
+function will return 0, then the \fIvarname\fR will always be set to 0,
+due to the varied nature of a valid boolean value.
+.RE
.TP
-\fBstring last \fIstring1 string2\fR
+\fBstring last \fIstring1 string2\fR ?\fIstartIndex\fR?
+.VE 8.1
Search \fIstring2\fR for a sequence of characters that exactly match
the characters in \fIstring1\fR. If found, return the index of the
first character in the last such match within \fIstring2\fR. If there
is no match, then return \-1.
+.VS 8.1
+If \fIstartIndex\fR is specified (in any of the forms accepted by the
+\fBindex\fR method), then only the characters in \fIstring2\fR at or before the
+specified \fIstartIndex\fR will be considered by the search. For example,
+.RS
+.CS
+\fBstring last a 0a23456789abcdef 15\fR
+.CE
+will return \fB10\fR, but
+.CS
+\fBstring last a 0a23456789abcdef 9\fR
+.CE
+will return \fB1\fR.
+.RE
+.VE 8.1
.TP
\fBstring length \fIstring\fR
-Returns a decimal string giving the number of characters in \fIstring\fR.
+Returns a decimal string giving the number of characters in
+\fIstring\fR. Note that this is not necessarily the same as the
+number of bytes used to store the string.
+.VS 8.1
+.TP
+\fBstring map\fR ?\fB\-nocase\fR? \fIcharMap string\fR
+Replaces characters in \fIstring\fR based on the key-value pairs in
+\fIcharMap\fR. \fIcharMap\fR is a list of \fIkey value key value\fR ...
+as in the form returned by \fBarray get\fR. Each instance of a
+key in the string will be replaced with its corresponding value. If
+\fB\-nocase\fR is specified, then matching is done without regard to
+case differences. Both \fIkey\fR and \fIvalue\fR may be multiple
+characters. Replacement is done in an ordered manner, so the key appearing
+first in the list will be checked first, and so on. \fIstring\fR is
+only iterated over once, so earlier key replacements will have no
+affect for later key matches. For example,
+.RS
+.CS
+\fBstring map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc\fR
+.CE
+will return the string \fB01321221\fR.
+.RE
.TP
-\fBstring match \fIpattern\fR \fIstring\fR
+\fBstring match\fR ?\fB\-nocase\fR? \fIpattern\fR \fIstring\fR
+.VE 8.1
See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0
-if it doesn't. Matching is done in a fashion similar to that
-used by the C-shell. For the two strings to match, their contents
+if it doesn't.
+.VS 8.1
+If \fB\-nocase\fR is specified, then the pattern attempts to match
+against the string in a case insensitive manner.
+.VE 8.1
+For the two strings to match, their contents
must be identical except that the following special sequences
may appear in \fIpattern\fR:
.RS
@@ -68,6 +225,13 @@ Matches any character in the set given by \fIchars\fR. If a sequence
of the form
\fIx\fB\-\fIy\fR appears in \fIchars\fR, then any character
between \fIx\fR and \fIy\fR, inclusive, will match.
+.VS 8.1
+When used with \fB\-nocase\fR, the end points of the range are converted
+to lower case first. Whereas {[A\-z]} matches '_' when matching
+case-sensitively ('_' falls between the 'Z' and 'a'), with \fB\-nocase\fR
+this is considered like {[A\-Za\-z]} (and probably what was meant in the
+first place).
+.VE 8.1
.IP \fB\e\fIx\fR 10
Matches the single character \fIx\fR. This provides a way of
avoiding the special interpretation of the characters
@@ -78,21 +242,58 @@ avoiding the special interpretation of the characters
Returns a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR. An index of 0 refers to the
-first character of the string.
-An index of \fBend\fR (or any
-abbreviation of it) refers to the last character of the string.
+.VS 8.1
+first character of the string. \fIfirst\fR and \fIlast\fR may be
+specified as for the \fBindex\fR method.
+.VE 8.1
If \fIfirst\fR is less than zero then it is treated as if it were zero, and
if \fIlast\fR is greater than or equal to the length of the string then
it is treated as if it were \fBend\fR. If \fIfirst\fR is greater than
\fIlast\fR then an empty string is returned.
+.VS 8.1
+.TP
+\fBstring repeat \fIstring count\fR
+Returns \fIstring\fR repeated \fIcount\fR number of times.
+.TP
+\fBstring replace \fIstring first last\fR ?\fInewstring\fR?
+Removes a range of consecutive characters from \fIstring\fR, starting
+with the character whose index is \fIfirst\fR and ending with the
+character whose index is \fIlast\fR. An index of 0 refers to the
+first character of the string. \fIFirst\fR and \fIlast\fR may be
+specified as for the \fBindex\fR method. If \fInewstring\fR is
+specified, then it is placed in the removed character range.
+If \fIfirst\fR is less than zero then it is treated as if it were zero, and
+if \fIlast\fR is greater than or equal to the length of the string then
+it is treated as if it were \fBend\fR. If \fIfirst\fR is greater than
+\fIlast\fR or the length of the initial string, or \fIlast\fR is less
+than 0, then the initial string is returned untouched.
+.TP
+\fBstring tolower \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
+Returns a value equal to \fIstring\fR except that all upper (or title) case
+letters have been converted to lower case. If \fIfirst\fR is specified, it
+refers to the first char index in the string to start modifying. If
+\fIlast\fR is specified, it refers to the char index in the string to stop
+at (inclusive). \fIfirst\fR and \fIlast\fR may be
+specified as for the \fBindex\fR method.
.TP
-\fBstring tolower \fIstring\fR
-Returns a value equal to \fIstring\fR except that all upper case
-letters have been converted to lower case.
+\fBstring totitle \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
+Returns a value equal to \fIstring\fR except that the first character
+in \fIstring\fR is converted to its Unicode title case variant (or upper
+case if there is no title case variant) and the rest of the string is
+converted to lower case. If \fIfirst\fR is specified, it
+refers to the first char index in the string to start modifying. If
+\fIlast\fR is specified, it refers to the char index in the string to stop
+at (inclusive). \fIfirst\fR and \fIlast\fR may be
+specified as for the \fBindex\fR method.
.TP
-\fBstring toupper \fIstring\fR
-Returns a value equal to \fIstring\fR except that all lower case
-letters have been converted to upper case.
+\fBstring toupper \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
+Returns a value equal to \fIstring\fR except that all lower (or title) case
+letters have been converted to upper case. If \fIfirst\fR is specified, it
+refers to the first char index in the string to start modifying. If
+\fIlast\fR is specified, it refers to the char index in the string to stop
+at (inclusive). \fIfirst\fR and \fIlast\fR may be specified as for the
+\fBindex\fR method.
+.VE 8.1
.TP
\fBstring trim \fIstring\fR ?\fIchars\fR?
Returns a value equal to \fIstring\fR except that any leading
@@ -114,18 +315,24 @@ trailing characters from the set given by \fIchars\fR are
removed.
If \fIchars\fR is not specified then white space is removed
(spaces, tabs, newlines, and carriage returns).
+.VS 8.1
+.TP
+\fBstring wordend \fIstring charIndex\fR
+Returns the index of the character just after the last one in the word
+containing character \fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR
+may be specified as for the \fBindex\fR method. A word is
+considered to be any contiguous range of alphanumeric (Unicode letters
+or decimal digits) or underscore (Unicode connector punctuation)
+characters, or any single character other than these.
.TP
-\fBstring wordend \fIstring index\fR
-Returns the index of the character just after the last one in the
-word containing character \fIindex\fR of \fIstring\fR.
-A word is considered to be any contiguous range of alphanumeric
-or underscore characters, or any single character other than these.
-.TP
-\fBstring wordstart \fIstring index\fR
-Returns the index of the first character in the
-word containing character \fIindex\fR of \fIstring\fR.
-A word is considered to be any contiguous range of alphanumeric
-or underscore characters, or any single character other than these.
+\fBstring wordstart \fIstring charIndex\fR
+Returns the index of the first character in the word containing
+character \fIcharIndex\fR of \fIstring\fR. \fIcharIndex\fR may be
+specified as for the \fBindex\fR method. A word is considered to be any
+contiguous range of alphanumeric (Unicode letters or decimal digits)
+or underscore (Unicode connector punctuation) characters, or any
+single character other than these.
+.VE 8.1
.SH KEYWORDS
-case conversion, compare, index, match, pattern, string, word
+case conversion, compare, index, match, pattern, string, word, equal, ctype
diff --git a/tcl/doc/switch.n b/tcl/doc/switch.n
index c0aecfa369f..f71ed5f0cd4 100644
--- a/tcl/doc/switch.n
+++ b/tcl/doc/switch.n
@@ -47,7 +47,7 @@ When matching \fIstring\fR to the patterns, use glob-style matching
\fB\-regexp\fR
When matching \fIstring\fR to the patterns, use regular
expression matching
-(i.e. the same as implemented by the \fBregexp\fR command).
+(as described in the \fBre_syntax\fR reference page).
.TP 10
\fB\-\|\-\fR
Marks the end of options. The argument following this one will
@@ -75,6 +75,10 @@ then the body after that is used, and so on).
This feature makes it possible to share a single \fIbody\fR among
several patterns.
.PP
+Beware of how you place comments in \fBswitch\fR commands. Comments
+should only be placed \fBinside\fR the execution body of one of the
+patterns, and not intermingled with the patterns.
+.PP
Below are some examples of \fBswitch\fR commands:
.CS
\fBswitch\0abc\0a\0\-\0b\0{format 1}\0abc\0{format 2}\0default\0{format 3}\fR
@@ -94,7 +98,10 @@ will return \fB1\fR, and
a
\-
b
- {format 1}
+ {
+ # Correct Comment Placement
+ format 1
+ }
a*
{format 2}
default
diff --git a/tcl/doc/tclsh.1 b/tcl/doc/tclsh.1
index a429d82e8dc..3ecfa211ab4 100644
--- a/tcl/doc/tclsh.1
+++ b/tcl/doc/tclsh.1
@@ -26,7 +26,8 @@ Tcl commands from standard input and printing command results and
error messages to standard output.
It runs until the \fBexit\fR command is invoked or until it
reaches end-of-file on its standard input.
-If there exists a file \fB.tclshrc\fR in the home directory of
+If there exists a file \fB.tclshrc\fR (or \fBtclshrc.tcl\fR on
+the Windows platforms) in the home directory of
the user, \fBtclsh\fR evaluates the file as a Tcl script
just before reading the first command from standard input.
diff --git a/tcl/doc/tcltest.n b/tcl/doc/tcltest.n
new file mode 100644
index 00000000000..1a515653541
--- /dev/null
+++ b/tcl/doc/tcltest.n
@@ -0,0 +1,759 @@
+'\"
+'\" Copyright (c) 1990-1994 The Regents of the University of California
+'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
+'\" Copyright (c) 1998-1999 Scriptics Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH "Tcltest" n 8.2 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcltest \- Test harness support code and utilities
+.SH SYNOPSIS
+\fBpackage require tcltest ?1.0?\fP
+.sp
+\fB::tcltest::test \fIname desc ?constraint? script expectedAnswer\fR
+.sp
+\fB::tcltest::cleanupTests \fI?runningMultipleTests?\fR
+.sp
+\fB::tcltest::getMatchingTestFiles\fR
+.sp
+\fB::tcltest::loadTestedCommands\fR
+.sp
+\fB::tcltest::makeFile \fIcontents name\fR
+.sp
+\fB::tcltest::removeFile \fIname\fR
+.sp
+\fB::tcltest::makeDirectory \fIname\fR
+.sp
+\fB::tcltest::removeDirectory \fIname\fR
+.sp
+\fB::tcltest::viewFile \fIname\fR
+.sp
+\fB::tcltest::normalizeMsg \fImsg\fR
+.sp
+\fB::tcltest::bytestring \fIstring\fR
+.sp
+\fB::tcltest::saveState\fR
+.sp
+\fB::tcltest::restoreState\fR
+.sp
+\fB::tcltest::threadReap\fR
+.BE
+.SH DESCRIPTION
+.PP
+The \fBtcltest\fR package provides the user with utility tools for
+writing and running tests in the Tcl test suite. It can also be used
+to create a customized test harness for an extension.
+.PP
+The Tcl test suite consists of multiple .test files, each of which
+contains multiple test cases. Each test case consists of a call to
+the test command, which specifies the name of test, a short
+description, any constraints that apply to the test case, the script
+to be run, and expected results. See the sections \fI"Tests,"\fR
+\fI"Test Constraints,"\fR and \fI"Test Files and How to Run Them"\fR
+for more details.
+.PP
+It is also possible to add to this test harness to create your own
+customized test harness implementation. For more defails, see the
+section \fI"How to Customize the Test Harness"\fR.
+.PP
+This approach to testing was designed and initially implemented by
+Mary Ann May-Pumphrey of Sun Microsystems in the early 1990's. Many
+thanks to her for donating her work back to the public Tcl release.
+.SH COMMANDS
+.TP
+\fB::tcltest::test\fP \fIname desc ?constraints? script expectedAnswer\fR
+The \fB::tcltest::test\fR command runs\fIscript\fR and compares
+its result to \fIexpectedAnswer\fR. It prints an error message if the two do
+not match. If \fB::tcltest::verbose\fR contains "p" or "s", it also prints
+out a message if the test passed or was skipped. The test will be
+skipped if it doesn't match the \fB::tcltest::match\fR variable, if it
+matches an element in \fB::tcltest::skip\fR, or if one of the elements
+of \fIconstraint\fR turns out not to be true. The
+\fB::tcltest::test\fR command has no defined return values. See the
+\fI"Writing a new test"\fR section for more details on this command.
+.TP
+\fB::tcltest::cleanupTests\fP \fI?runningMultipleTests?\fR
+This command should be called at the end of a test file. It prints
+statistics about the tests run and removes files that were created by
+\fB::tcltest::makeDirectory\fR and \fB::tcltest::makeFile\fR. Names
+of files and directories created outside of
+\fB::tcltest::makeFile\fR and \fB::tcltest::makeDirectory\fR and
+never deleted are printed to \fB::tcltest::outputChannel\fR. This command
+also restores the original shell environment, as described by the ::env
+array. \fIcalledFromAll\fR should be specified when
+\fB::tcltest::cleanupTests\fR is called from an "all.tcl" file. Tcl files
+files are generally used to run multiple tests. For more details on how to
+run multiple tests, please see the section \fI"Running test files"\fR.
+This proc has no defined return value.
+.TP
+\fB::tcltest::getMatchingTestFiles\fP
+This command is used when you want to run multiple test files. It returns
+the list of tests that should be sourced in an 'all.tcl' file. See the
+section \fI"Running test files"\fR for more information.
+.TP
+\fB::tcltest::loadTestedCommands\fP
+This command uses the script specified via the \fI-load\fR or
+\fI-loadfile\fR to load the commands checked by the test suite.
+Allowed to be empty, as the tested commands could have been compiled
+into the interpreter running the test suite.
+.TP
+\fB::tcltest::makeFile\fP \fIcontents name\fR
+Create a file that will be automatically be removed by
+\fB::tcltest::cleanupTests\fR at the end of a test file.
+This proc has no defined return value.
+.TP
+\fB::tcltest::removeFile\fP \fIname\fR
+Force the file referenced by \fIname\fR to be removed. This file name
+should be relative to \fI::tcltest::temporaryDirectory\fR. This proc has no
+defined return values.
+.TP
+\fB::tcltest::makeDirectory\fP \fIname\fR
+Create a directory named \fIname\fR that will automatically be removed
+by \fB::tcltest::cleanupTests\fR at the end of a test file. This proc
+has no defined return value.
+.TP
+\fB::tcltest::removeDirectory\fP \fIname\fR
+Force the directory referenced by \fIname\fR to be removed. This proc
+has no defined return value.
+.TP
+\fB::tcltest::viewFile\fP \fIfile\fR
+Returns the contents of \fIfile\fR.
+.TP
+\fB::tcltest::normalizeMsg\fP \fImsg\fR
+Remove extra newlines from \fImsg\fR.
+.TP
+\fB::tcltest::bytestring\fP \fIstring\fR
+Construct a string that consists of the requested sequence of bytes,
+as opposed to a string of properly formed UTF-8 characters using the
+value supplied in \fIstring\fR. This allows the tester to create
+denormalized or improperly formed strings to pass to C procedures that
+are supposed to accept strings with embedded NULL types and confirm
+that a string result has a certain pattern of bytes.
+.TP
+\fB::tcltest::saveState\fP
+\fB::tcltest::restoreState\fP
+Save and restore the procedure and global variable names.
+A test file might contain calls to \fB::tcltest::saveState\fR and
+\fB::tcltest:restoreState\fR if it creates or deletes global variables
+or procs.
+.TP
+\fB::tcltest::threadReap\fP
+\fB::tcltest::threadReap\fR only works if \fItestthread\fR is
+defined, generally by compiling tcltest. If \fItestthread\fR is
+defined, \fB::tcltest::threadReap\fR kills all threads except for the
+main thread. It gets the ID of the main thread by calling
+\fItestthread names\fR during initialization. This value is stored in
+\fI::tcltest::mainThread\fR. \fB::tcltest::threadReap\fR returns the
+number of existing threads at completion.
+.SH TESTS
+The \fBtest\fR procedure runs a test script and prints an error
+message if the script's result does not match the expected result.
+The following is the spec for the \fBtest\fR command:
+.DS
+test <name> <description> ?<constraint>? <script> <expectedAnswer>
+.DE
+The <name> argument should follow the pattern:
+.DS
+<target>-<majorNum>.<minorNum>
+.DE
+For white-box (regression) tests, the target should be the name of the
+C function or Tcl procedure being tested. For black-box tests, the
+target should be the name of the feature being tested. Related tests
+should share a major number.
+.PP
+The <description> argument is a short textual description of the test,
+to help humans understand what it tests. The name of a Tcl or C
+function being tested should be included for regression tests. If the
+test case exists to reproduce a bug, include the bug ID in the
+description.
+.PP
+The optional <constraints> argument can be list of one or more
+keywords or an expression. If the <constraints> argument consists of
+keywords, each of these keywords must be the name of an element in the array
+\fI::tcltest::testConstraints\fR. If any of these elements is false or does
+not exist, the test is skipped. If the <constraints> argument
+consists of an expression, that expression is evaluated. If the
+expression evaluates to true, then the test is run.
+.PP
+Add appropriate constraints (e.g.,
+unixOnly) to any tests that should not always be run. For example, a
+test that should only be run on Unix should look like the following:
+.PP
+.DS
+test getAttribute-1.1 {testing file permissions} {unixOnly} {
+ lindex [file attributes foo.tcl] 5
+} {00644}
+.DE
+.PP
+An example of a test that contains an expression:
+.PP
+.DS
+test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
+ catch {vwait x}
+ set f [open foo w]
+ fileevent $f writable {set x 1}
+ vwait x
+ close $f
+ list [catch {vwait x} msg] $msg
+} {1 {can't wait for variable "x": would wait forever}}
+.DE
+.PP
+See the "Test Constraints" section for a list of built-in
+constraints and information on how to add your own constraints.
+.PP
+The <script> argument contains the script to run to carry out the
+test. It must return a result that can be checked for correctness.
+If your script requires that a file be created on the fly, please use
+the ::tcltest::makeFile procedure. If your test requires that a small
+file (<50 lines) be checked in, please consider creating the file on
+the fly using the ::tcltest::makeFile procedure. Files created by the
+::tcltest::makeFile procedure will automatically be removed by the
+::tcltest::cleanupTests call at the end of each test file.
+.PP
+The <expectedAnswer> argument will be compared against the result of
+evaluating the <script> argument. If they match, the test passes,
+otherwise the test fails.
+.SH "TCLTEST NAMEPSACE VARIABLES"
+The following variables are also defined in the \fBtcltest\fR namespace and
+can be used by tests:
+.TP
+\fB::tcltest::outputChannel\fR
+output file ID - defaults to stdout and can be specified using
+-outfile on the command line.
+Any test that prints test related output should send
+that output to \fI::tcltest::outputChannel\fR rather than letting
+that output default to stdout.
+.TP
+\fB::tcltest::errorChannel\fR
+error file ID - defaults to stderr and can be specified using -errfile
+on the command line.
+Any test that prints error messages should send
+that output to \fI::tcltest::errorChannel\fR rather than printing
+directly to stderr.
+.TP
+\fB::tcltest::mainThread\fR
+main thread ID - defaults to 1. This is the only thread that is not
+killed by ::tcltest::threadReap and is set according to the return
+value of \fItestthread names\fR at initialization.
+.TP
+\fB::tcltest::originalEnv\fR
+copy of the global "env" array at the beginning of the test run. This
+array is used to restore the "env" array to its original state when
+\fI::tcltest::cleanupTests\fR is called.
+.TP
+\fB::tcltest::workingDirectory\fR
+the directory in which the test suite was launched.
+.TP
+\fB::tcltest::temporaryDirectory\fR
+the output directory - defaults to \fI::tcltest::workingDirectory\fR and can be
+specified using -tmpdir on the command line.
+.TP
+\fB::tcltest::testsDirectory\fR
+where the tests reside - defaults to \fI::tcltest::workingDirectory\fR
+if the script cannot determine where the \fItests\fR directory is
+located. It is possible to change the default by specifying
+\fI-testdir\fR on the commandline. This variable should be
+explicitly set if tests are being run from an all.tcl file.
+.TP
+\fB::tcltest::tcltest\fR
+the name of the executable used to invoke the test suite.
+.TP
+\fB::tcltest::loadScript\fR
+The script executed \fBloadTestedCommands\fR. Specified either by
+\fI-load\fR or \fI-loadfile\fR.
+.SH "TEST CONSTRAINTS"
+Constraints are used to determine whether a test should be skipped.
+Each constraint is stored as an index in the array
+\fI::tcltest::testConstraints\fR. For example, the unixOnly constraint is
+defined as the following:
+.DS
+set ::tcltest::testConstraints(unixOnly) \\
+ [string equal $tcl_platform(platform) "unix"]
+.DE
+If a test is constrained by "unixOnly", then it will only be run if
+the value of ::tcltest::testConstraints(unixOnly) is true. Several
+constraints are defined in the \fBtcltest\fR package. To add file- or
+test-specific constraints, you can set the desired index of the
+::tcltest::testsConstraints array in your own test file.
+.PP
+The following is a list of constraints defined in the \fBtcltest\fR package:
+.TP
+\fIunix\fR
+test can only be run on any UNIX platform
+.TP
+\fIpc\fR
+test can only be run on any Windows platform
+.TP
+\fInt\fR
+test can only be run on any Windows NT platform
+.TP
+\fI95\fR
+test can only be run on any Windows 95 platform
+.TP
+\fI98\fR
+test can only be run on any Windows 98 platform
+.TP
+\fImac\fR
+test can only be run on any Mac platform
+.TP
+\fIunixOrPc\fR
+test can only be run on a UNIX or PC platform
+.TP
+\fImacOrPc\fR
+test can only be run on a Mac or PC platform
+.TP
+\fImacOrUnix\fR
+test can only be run on a Mac or UNIX platform
+.TP
+\fItempNotPc\fR
+test can not be run on Windows. This flag is used to temporarily
+disable a test.
+.TP
+\fItempNotMac\fR
+test can not be run on a Mac. This flag is used
+to temporarily disable a test.
+.TP
+\fIunixCrash\fR
+test crashes if it's run on UNIX. This flag is used to temporarily
+disable a test.
+.TP
+\fIpcCrash\fR
+test crashes if it's run on Windows. This flag is used to temporarily
+disable a test.
+.TP
+\fImacCrash\fR
+test crashes if it's run on a Mac. This flag is used to temporarily
+disable a test.
+.TP
+\fIemptyTest\fR
+test is empty, and so not worth running, but it remains as a
+place-holder for a test to be written in the future. This constraint
+always causes tests to be skipped.
+.TP
+\fIknownBug\fR
+test is known to fail and the bug is not yet fixed. This constraint
+always causes tests to be skipped unless the user specifies otherwise.
+See the "Introduction" section for more details.
+.TP
+\fInonPortable\fR
+test can only be run in the master Tcl/Tk development environment.
+Some tests are inherently non-portable because they depend on things
+like word length, file system configuration, window manager, etc.
+These tests are only run in the main Tcl development directory where
+the configuration is well known. This constraint always causes tests
+to be skipped unless the user specifies otherwise.
+.TP
+\fIuserInteraction\fR
+test requires interaction from the user. This constraint always
+causes tests to be skipped unless the user specifies otherwise.
+.TP
+\fIinteractive\fR
+test can only be run in if the interpreter is in interactive mode,
+that is the global tcl_interactive variable is set to 1.
+.TP
+\fInonBlockFiles\fR
+test can only be run if platform supports setting files into
+nonblocking mode
+.TP
+\fIasyncPipeClose\fR
+test can only be run if platform supports async flush and async close
+on a pipe
+.TP
+\fIunixExecs\fR
+test can only be run if this machine has commands such as 'cat', 'echo',
+etc. available.
+.TP
+\fIhasIsoLocale\fR
+test can only be run if can switch to an ISO locale
+.TP
+\fIroot\fR
+test can only run if Unix user is root
+.TP
+\fInotRoot\fR
+test can only run if Unix user is not root
+.TP
+\fIeformat\fR
+test can only run if app has a working version of sprintf with respect
+to the "e" format of floating-point numbers.
+.TP
+\fIstdio\fR
+test can only be run if the current app can be spawned via a pipe
+.SH "RUNNING TEST FILES"
+Use the following command to run a test file that uses package
+tcltest:
+.DS
+<shell> <testFile> ?<option> ?<value>?? ...
+.DE
+Command line options include (tcltest namespace variables that
+correspond to each flag are listed at the end of each flag description
+in parenthesis):
+.RS
+.TP
+\fB-help\fR
+display usage information.
+.TP
+\fB-verbose <level>\fR
+set the level of verbosity to a substring of "bps". See the "Test
+output" section for an explanation of this option. (::tcltest::verbose)
+.TP
+\fB-match <matchList>\fR
+only run tests that match one or more of the glob patterns in
+<matchList>. (::tcltest::match)
+.TP
+\fB-skip <skipList>\fR
+do not run tests that match one or more of the glob patterns in
+<skipList>. (::tcltest::skip)
+.TP
+\fB-file <globPatternList>\fR
+only source test files that match any of the items in
+<globPatternList> relative to ::tcltest::testsDirectory.
+This option
+only makes sense if you are running tests using "all.tcl" as the
+<testFile> instead of running single test files directly.
+(::tcltest::matchFiles)
+.TP
+\fB-notfile <globPatternList>\fR
+source files except for those that match any of the items in
+<globPatternList> relative to ::tcltest::testsDirectory.
+This option
+only makes sense if you are running tests using "all.tcl" as the
+<testFile> instead of running single test files directly.
+(::tcltest::skipFiles)
+.TP
+\fB-constraints <list>\fR
+tests with any constraints in <list> will not be skipped. Note that
+elements of <list> must exactly match the existing constraints. This
+is useful if you want to make sure that tests with a particular
+constraint are run (for example, if the tester wants to run all tests
+with the knownBug constraint).
+(::tcltest::testConstraints(\fIconstraintName\fR))
+.TP
+\fB-limitconstraints <bool>\fR
+If the argument to this flag is 1, the test harness limits test runs
+to those tests that match the constraints listed by the -constraints
+flag. Use of this flag requires use of the -constraints flag. The
+default value for this flag is 0 (false). This is useful if you want
+to run \fBonly\fR those tests that match the constraints listed using
+the -constraints option. A tester might want to do this if he were
+interested in running only those tests that are constrained to be
+unixOnly and no other tests.
+(::tcltest::limitConstraints)
+.TP
+\fB-load <script>\fR
+will use the specified script to load the commands under test
+(::tcltest::loadTestedCommands). The default is the empty
+script. See -loadfile below too. (::tcltest::loadScript)
+.TP
+\fB-loadfile <scriptfile>\fR
+will use the contents of the named file to load the commands under
+test (::tcltest::loadTestedCommands). See -load above too. The default
+is the empty script. (::tcltest::loadScript)
+.TP
+\fB-tmpdir <directoryName>\fR
+put any temporary files (created with ::tcltest::makeFile and
+::tcltest::makeDirectory) into the named directory. The default
+location is ::tcltest::workingDirectory. (::tcltest::temporaryDirectory)
+.TP
+\fB-testdir <directoryName>\fR
+search the test suite to execute in the named directory. The default
+location is ::tcltest::workingDirectory. (::tcltest::testsDirectory)
+.TP
+\fB-preservecore <level>\fR
+check for core files. This flag is used to determine how much
+checking should be done for core files. The default value for
+\fIlevel\fR is 0. Levels are defined as:
+.RS
+.IP 0
+No checking - do not check for core files at the end of each test
+command, but do check for them whenever ::tcltest::cleanupTests is
+called from an all.tcl file.
+.IP 1
+Check for core files at the end of each test command and whenever
+::tcltest::cleanupTests is called from all.tcl.
+.IP 2
+Check for core files at the end of all test commands and whenever
+::tcltest::cleanupTests is called from all.tcl. Save any core files
+produced in ::tcltest::temporaryDirectory.
+.RE
+.sp
+(::tcltest::preserveCore)
+.TP
+\fB-debug <debugLevel>\fR
+print debug information to stdout. This is used to debug code in the
+test harness. The default debug level is 0. Levels are defined as:
+.RS
+.IP 0
+Do not display any debug information.
+.IP 1
+Display information regarding whether a test is skipped because it
+doesn't match any of the tests that were specified using -match or
+::tcltest::match (userSpecifiedNonMatch) or matches any of the tests
+specified by -skip or ::tcltest::skip (userSpecifiedSkip).
+.IP 2
+Display the flag array parsed by the command line processor, the
+contents of the ::env array, and all user-defined variables that exist
+in the current namespace as they are used.
+.IP 3
+Display information regarding what individual procs in the test
+harness are doing.
+.RE
+.sp
+(::tcltest::debug)
+.TP
+\fB-outfile <filename>\fR
+print output generated by the tcltest package to the named file. This
+defaults to stdout. Note that debug output always goes to stdout,
+regardless of this flag's setting. (::tcltest::outputChannel)
+.TP
+\fB-errfile <filename>\fR
+print errors generated by the tcltest package to the named file. This
+defaults to stderr. (::tcltest::errorChannel)
+.RE
+.PP
+A second way to run tets is to start up a shell, load the
+\fBtcltest\fR package, and then source an appropriate test file or use
+the test command. To use the options in interactive mode, set
+their corresponding tcltest namespace variables after loading the
+package.
+.PP
+See \fI"Test Constraints"\fR for all built-in constraint names
+that can be used in the \fB::tcltest::testConstraints\fR array.
+See \fI"Tcltest namespace variables"\fR for details on other variables
+defined in the \fBtcltest\fR namespace.
+.PP
+A final way to run tests would be to specify which test files to run
+within an \fIall.tcl\fR (or otherwise named) file. This is the
+approach used by the Tcl test suite. This file loads the tcltest
+package, sets the location of
+the test directory (::tcltest::testsDirectory), determines which test
+files to run, sources each of these files, calls
+::tcltest::cleanupTests and then exits.
+.PP
+A more elaborate \fIall.tcl\fR file might do some pre- and
+post-processing before sourcing
+each .test file, use separate interpreters for each file, or handle
+complex directory structures.
+For an example of an all.tcl file,
+please see the "Examples" section of this document.
+.SH "TEST OUTPUT"
+After all specified test files are run, the number of tests
+passed, skipped, and failed is printed to
+\fB::tcltest::outputChannel\fR. Aside from this
+statistical information, output can be controlled on a per-test basis
+by the \fB::tcltest::verbose\fR variable.
+.PP
+\fB::tcltest::verbose\fR can be set to any substring or permutation
+of "bps". In the string "bps", the 'b' stands for a test's "body",
+the 'p' stands for "passed" tests, and the 's' stands for "skipped"
+tests. The default value of \fB::tcltest::verbose\fR is "b". If 'b'
+is present, then the entire body of the test is printed for each
+failed test, otherwise only the test's name, desired output, and
+actual output, are printed for each failed test. If 'p' is present,
+then a line is printed for each passed test, otherwise no line is
+printed for passed tests. If 's' is present, then a line (containing
+the consraints that cause the test to be skipped) is printed for each
+skipped test, otherwise no line is printed for skipped tests.
+.PP
+You can set \fB::tcltest::verbose\fR either interactively (after the
+\fBtcltest\fR package has been loaded) or by using the command line
+argument \fB-verbose\fR, for example:
+.DS
+tclsh socket.test -verbose bps
+.DE
+.SH "CONTENTS OF A TEST FILE"
+Test files should begin by loading the \fBtcltest\fR package:
+.DS
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import ::tcltest::*
+}
+.DE
+Test files should end by cleaning up after themselves and calling
+\fB::tcltest::cleanupTests\fR. The \fB::tcltest::cleanupTests\fR
+procedure prints statistics about the number of tests that passed,
+skipped, and failed, and removes all files that were created using the
+\fB::tcltest::makeFile\fR and \fB::tcltest::makeDirectory\fR procedures.
+.DS
+# Remove files created by these tests
+# Change to original working directory
+# Unset global arrays
+::tcltest::cleanupTests
+return
+.DE
+When naming test files, file names should end with a .test extension.
+The names of test files that contain regression (or glass-box) tests
+should correspond to the Tcl or C code file that they are testing.
+For example, the test file for the C file "tclCmdAH.c" is "cmdAH.test".
+Test files that contain black-box tests should match the pattern "*_bb.test".
+.SH "SELECTING TESTS FOR EXECUTION WITHIN A FILE"
+.PP
+Normally, all the tests in a file are run whenever the file is
+sourced. An individual test will be skipped if one of the following
+conditions is met:
+.IP [1]
+the \fIname\fR of the tests does not match (using glob style matching)
+one or more elements in the \fB::tcltest::match\fR variable
+.IP [2]
+the \fIname\fR of the tests matches (using glob style matching) one or
+more elements in the \fB::tcltest::skip\fR variable
+.IP [3]
+the \fIconstraints\fR argument to the \fB::tcltest::test\fR call, if
+given, contains one or more false elements.
+.PP
+You can set \fB::tcltest::match\fR and/or \fB::tcltest::skip\fR
+either interactively (after the \fBtcltest\fR package has been
+sourced), or by using the command line arguments \fB-match\fR and
+\fB-skip\fR, for example:
+.PP
+.CS
+tclsh info.test -match '*-5.* *-7.*' -skip '*-7.1*'
+.CE
+.PP
+Be sure to use the proper quoting convention so that your shell does
+not perform the glob substitution on the match or skip patterns you
+specify.
+.PP
+Predefined constraints (e.g. \fIknownBug\fR and \fInonPortable\fR) can be
+overridden either interactively (after the \fBtcltest\fR package has been
+sourced) by setting the proper
+\fB::tcltest::testConstraints(\fIconstraint\fB)\fR variable
+or by using the \fB-constraints\fR command line option with the name of the
+constraint in the argument. The following example shows how to run
+tests that are constrained by the \fIknownBug\fR and \fInonPortable\fR
+restrictions:
+.PP
+.CS
+tclsh all.tcl -constraints "knownBug nonPortable"
+.CE
+.PP
+See the \fI"Constraints"\fR package for information about using
+built-in constraints and adding new ones.
+.SH "HOW TO CUSTOMIZE THE TEST HARNESS"
+To create your own custom test harness, create a .tcl file that contains your
+namespace. Within this file, require package \fBtcltest\fR. Commands
+that can be redefined to customize the test harness include:
+.TP
+\fB::tcltest::PrintUsageInfoHook\fP
+print additional usage information specific to your situation.
+.TP
+\fB::tcltest::processCmdLineArgsFlagHook\fP
+tell the test harness about additional flags that you want it to understand.
+.TP
+\fB::tcltest::processCmdLineArgsHook\fR \fIflags\fP
+process the additional flags that you told the harness about in
+::tcltest::processCmdLineArgsFlagHook.
+.TP
+\fB::tcltest::initConstraintsHook\fP
+used to add additional built-in constraints to those already defined
+by \fBtcltest\fR.
+.TP
+\fB::tcltest::cleanupTestsHook\fP
+do additional cleanup
+.PP
+.PP
+To add new flags to your customized test harness, redefine
+\fB::tcltest::processCmdLineArgsAddFlagHook\fR to define additional flags to be
+parsed and \fB::tcltest::processCmdLineArgsHook\fR to actually process them.
+For example:
+.DS
+proc ::tcltest::processCmdLineArgsAddFlagHook {} {
+ return [list -flag1 -flag2]
+}
+
+proc ::tcltest::processCmdLineArgsHook {flagArray} {
+ array set flag $flagArray
+
+ if {[info exists flag(-flag1)]} {
+ # Handle flag1
+ }
+
+ if {[info exists flag(-flag2)]} {
+ # Handle flag2
+ }
+
+ return
+}
+.DE
+You may also want to add usage information for these flags. This
+information would be displayed whenever the user specifies -help. To
+define additional usage information, define your own
+::tcltest::PrintUsageInfoHook proc. Within this proc, you should
+print out additional usage information for any flags that you've
+implemented.
+.PP
+To add new built-in
+constraints to the test harness, define your own version of
+\fB::tcltest::initConstraintsHook\fR.
+Within your proc, you can add to the \fB::tcltest::testConstraints\fR array.
+For example:
+.DS
+proc ::tcltest::initConstraintsHook {} {
+ set ::tcltest::testConstraints(win95Or98) \\
+ [expr {$::tcltest::testConstraints(95) || \\
+ $::tcltest::testConstraints(98)}]
+}
+.DE
+.PP
+Finally, if you want to add additional cleanup code to your harness
+you can define your own \fB::tcltest::cleanupTestsHook\fR. For example:
+.DS
+proc ::tcltest::cleanupTestsHook {} {
+ # Add your cleanup code here
+}
+.DE
+.SH EXAMPLES
+.IP [1]
+A simple test file (foo.test)
+.DS
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import ::tcltest::*
+}
+
+test foo-1.1 {save 1 in variable name foo} {} {
+ set foo 1
+} {1}
+
+::tcltest::cleanupTests
+return
+.DE
+.IP [2]
+A simple all.tcl
+.DS
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import ::tcltest::*
+}
+
+set ::tcltest::testSingleFile false
+set ::tcltest::testsDirectory [file dir [info script]]
+
+foreach file [::tcltest::getMatchingTestFiles] {
+ if {[catch {source $file} msg]} {
+ puts stdout $msg
+ }
+}
+
+::tclttest::cleanupTests 1
+return
+.DE
+.IP [3]
+Running a single test
+.DS
+tclsh foo.test
+.DE
+.IP [4]
+Running multiple tests
+.DS
+tclsh all.tcl -file 'foo*.test' -notfile 'foo2.test'
+.DE
+.SH KEYWORDS
+test, test harness, test suite
+
diff --git a/tcl/doc/tclvars.n b/tcl/doc/tclvars.n
index a80ac3e6f8f..8639cb3ee0d 100644
--- a/tcl/doc/tclvars.n
+++ b/tcl/doc/tclvars.n
@@ -219,20 +219,20 @@ command.
.TP
\fBtcl_pkgPath\fR
This variable holds a list of directories indicating where packages are
-normally installed. It typically contains either one or two entries;
-if it contains two entries, the first is normally a directory for
-platform-dependent packages (e.g., shared library binaries) and the
-second is normally a directory for platform-independent packages (e.g.,
-script files). Typically a package is installed as a subdirectory of one
-of the entries in \fB$tcl_pkgPath\fR. The directories in
-\fB$tcl_pkgPath\fR are included by default in the \fBauto_path\fR
+normally installed. It is not used on Windows. It typically contains
+either one or two entries; if it contains two entries, the first is
+normally a directory for platform-dependent packages (e.g., shared library
+binaries) and the second is normally a directory for platform-independent
+packages (e.g., script files). Typically a package is installed as a
+subdirectory of one of the entries in \fB$tcl_pkgPath\fR. The directories
+in \fB$tcl_pkgPath\fR are included by default in the \fBauto_path\fR
variable, so they and their immediate subdirectories are automatically
searched for packages during \fBpackage require\fR commands. Note:
-\fBtcl_pkgPath\fR it not intended to be modified by the application.
-Its value is added to \fBauto_path\fR at startup; changes to
-\fBtcl_pkgPath\fR are not reflected in \fBauto_path\fR. If you
-want Tcl to search additional directories for packages you should add
-the names of those directories to \fBauto_path\fR, not \fBtcl_pkgPath\fR.
+\fBtcl_pkgPath\fR it not intended to be modified by the application. Its
+value is added to \fBauto_path\fR at startup; changes to \fBtcl_pkgPath\fR
+are not reflected in \fBauto_path\fR. If you want Tcl to search additional
+directories for packages you should add the names of those directories to
+\fBauto_path\fR, not \fBtcl_pkgPath\fR.
.VE
.TP
\fBtcl_platform\fR
@@ -244,6 +244,11 @@ be defined, but they may have empty strings as values if Tcl couldn't
retrieve any relevant information. In addition, extensions
and applications may add additional values to the array. The
predefined elements are:
+
+
+
+
+
.RS
.VS
.TP
@@ -252,6 +257,12 @@ The native byte order of this machine: either \fBlittleEndian\fR or
\fBbigEndian\fR.
.VE
.TP
+\fBdebug\fR
+If this variable exists, then the interpreter
+was compiled with debugging symbols enabled. This varible will only
+exist on Windows so extension writers can specify which package to load
+depending on the C run-time library that is loaded.
+.TP
\fBmachine\fR
The instruction set executed by this machine, such as
\fBintel\fR, \fBPPC\fR, \fB68k\fR, or \fBsun4m\fR. On UNIX machines, this
@@ -259,16 +270,31 @@ is the value returned by \fBuname -m\fR.
.TP
\fBos\fR
The name of the operating system running on this machine,
-such as \fBWin32s\fR, \fBWindows NT\fR, \fBMacOS\fR, or \fBSunOS\fR.
+such as \fBWindows 95\fR, \fBWindows NT\fR, \fBMacOS\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 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.
.TP
\fBplatform\fR
Either \fBwindows\fR, \fBmacintosh\fR, or \fBunix\fR. This identifies the
general operating environment of the machine.
+.TP
+\fBthreaded\fR
+If this variable exists, then the interpreter
+was compiled with threads enabled.
+.TP
+\fBuser\fR
+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 and Macintosh.
.RE
.TP
\fBtcl_precision\fR
@@ -343,6 +369,22 @@ and interpreter.
It is also occasionally useful when converting
code to use Tcl8.0.
.TP
+\fBtcl_wordchars\fR
+The value of this variable is a regular expression that can be set to
+control what are considered ``word'' characters, for instances like
+selecting a word by double-clicking in text in Tk. It is platform
+dependent. On Windows, it defaults to \fB\\S\fR, meaning anything
+but a Unicode space character. Otherwise it defaults to \fB\\w\fR,
+which is any Unicode word character (number, letter, or underscore).
+.TP
+\fBtcl_nonwordchars\fR
+The value of this variable is a regular expression that can be set to
+control what are considered ``non-word'' characters, for instances like
+selecting a word by double-clicking in text in Tk. It is platform
+dependent. On Windows, it defaults to \fB\\s\fR, meaning any Unicode space
+character. Otherwise it defaults to \fB\\W\fR, which is anything but a
+Unicode word character (number, letter, or underscore).
+.TP
\fBtcl_version\fR
When an interpreter is created Tcl initializes this variable to
hold the version number for this version of Tcl in the form \fIx.y\fR.
diff --git a/tcl/doc/tell.n b/tcl/doc/tell.n
index f46cf9b06e6..0fac7df2c17 100644
--- a/tcl/doc/tell.n
+++ b/tcl/doc/tell.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH tell n 7.5 Tcl "Tcl Built-In Commands"
+.TH tell n 8.1 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -19,8 +19,12 @@ tell \- Return current access position for an open channel
.SH DESCRIPTION
.PP
-Returns a decimal string giving the current access position in
-\fIchannelId\fR.
+.VS 8.1
+Returns an integer string giving the current access position in
+\fIchannelId\fR. This value returned is a byte offset that can be passed to
+\fBseek\fR in order to set the channel to a particular position. Note
+that this value is in terms of bytes, not characters like \fBread\fR.
+.VE 8.1
The value returned is -1 for channels that do not support
seeking.
diff --git a/tcl/doc/trace.n b/tcl/doc/trace.n
index ff3911dc032..5ead91597f1 100644
--- a/tcl/doc/trace.n
+++ b/tcl/doc/trace.n
@@ -30,7 +30,9 @@ refer to a normal variable, an element of an array, or to an array
as a whole (i.e. \fIname\fR may be just the name of an array, with no
parenthesized index). If \fIname\fR refers to a whole array, then
\fIcommand\fR is invoked whenever any element of the array is
-manipulated.
+manipulated. If the variable does not exist, it will be created but
+will not be given a value, so it will be visible to \fBnamespace which\fR
+queries, but not to \fBinfo exists\fR queries.
.RS
.PP
\fIOps\fR indicates which operations are of interest, and consists of
diff --git a/tcl/doc/update.n b/tcl/doc/update.n
index 27484e4d6d8..3c8560b8911 100644
--- a/tcl/doc/update.n
+++ b/tcl/doc/update.n
@@ -20,7 +20,7 @@ update \- Process pending events and idle callbacks
.SH DESCRIPTION
.PP
This command is used to bring the application ``up to date''
-by entering the event loop repeated until all pending events
+by entering the event loop repeatedly until all pending events
(including idle callbacks) have been processed.
.PP
If the \fBidletasks\fR keyword is specified as an argument to the
@@ -46,3 +46,4 @@ during the next call to \fBupdate\fR.
.SH KEYWORDS
event, flush, handler, idle, update
+
diff --git a/tcl/doc/upvar.n b/tcl/doc/upvar.n
index 35c1daa9d44..e9876481ee4 100644
--- a/tcl/doc/upvar.n
+++ b/tcl/doc/upvar.n
@@ -76,8 +76,28 @@ by exiting the procedure in which it is defined. However, it is
possible to retarget an upvar variable by executing another \fBupvar\fR
command.
-.SH BUGS
+.SH Traces and upvar
.PP
+Upvar interacts with traces in a straightforward but possibly
+unexpected manner. If a variable trace is defined on \fIotherVar\fR, that
+trace will be triggered by actions involving \fImyVar\fR. However,
+the trace procedure will be passed the name of \fImyVar\fR, rather
+than the name of \fIotherVar\fR. Thus, the output of the following code
+will be \fBlocalVar\fR rather than \fBoriginalVar\fR:
+.CS
+\fBproc traceproc { name index op } {
+ puts $name
+}
+proc setByUpvar { name value } {
+ upvar $name localVar
+ set localVar $value
+}
+set originalVar 1
+trace variable originalVar w traceproc
+setByUpvar originalVar 2
+}\fR
+.CE
+
If \fIotherVar\fR refers to an element of an array, then variable
traces set for the entire array will not be invoked when \fImyVar\fR
is accessed (but traces on the particular element will still be
diff --git a/tcl/doc/variable.n b/tcl/doc/variable.n
index 8b7aae0d9ec..cc68fc470f5 100644
--- a/tcl/doc/variable.n
+++ b/tcl/doc/variable.n
@@ -36,7 +36,9 @@ Normally, \fIname\fR is unqualified
(does not include the names of any containing namespaces),
and the variable is created in the current namespace.
If \fIname\fR includes any namespace qualifiers,
-the variable is created in the specified namespace.
+the variable is created in the specified namespace. If the variable
+is not defined, it will be visible to the \fBnamespace which\fR
+command, but not to the \fBinfo exists\fR command.
.PP
If the \fBvariable\fR command is executed inside a Tcl procedure,
it creates local variables
diff --git a/tcl/doc/vwait.n b/tcl/doc/vwait.n
index 66a498ec59d..2fdad04fc01 100644
--- a/tcl/doc/vwait.n
+++ b/tcl/doc/vwait.n
@@ -7,7 +7,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH vwait n 7.5 Tcl "Tcl Built-In Commands"
+.TH vwait n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -23,7 +23,9 @@ the application if no events are ready. It continues processing
events until some event handler sets the value of variable
\fIvarName\fR. Once \fIvarName\fR has been set, the \fBvwait\fR
command will return as soon as the event handler that modified
-\fIvarName\fR completes.
+\fIvarName\fR completes. \fIvarName\fR must globally scoped
+(either with a call to \fBglobal\fR for the \fIvarName\fR, or with
+the full namespace path specification).
.PP
In some cases the \fBvwait\fR command may not return immediately
after \fIvarName\fR is set. This can happen if the event handler
diff --git a/tcl/generic/patchlevel.h b/tcl/generic/patchlevel.h
new file mode 100644
index 00000000000..2482cd3ed88
--- /dev/null
+++ b/tcl/generic/patchlevel.h
@@ -0,0 +1,23 @@
+/*
+ * patchlevel.h --
+ *
+ * This file does nothing except define a "patch level" for Tcl.
+ * The patch level has the form "X.YpZ" where X.Y is the base
+ * release, and Z is a serial number that is used to sequence
+ * patches for a given release. Thus 7.4p1 is the first patch
+ * to release 7.4, 7.4p2 is the patch that follows 7.4p1, and
+ * so on. The "pZ" is omitted in an original new release, and
+ * it is replaced with "bZ" for beta releases or "aZ for alpha
+ * releases. The patch level ensures that patches are applied
+ * in the correct order and only to appropriate sources.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994-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.
+ *
+ * SCCS: @(#) patchlevel.h 1.17 96/04/08 14:15:07
+ */
+
+#define TCL_PATCH_LEVEL "7.5"
diff --git a/tcl/generic/regc_color.c b/tcl/generic/regc_color.c
new file mode 100644
index 00000000000..5aed21c6308
--- /dev/null
+++ b/tcl/generic/regc_color.c
@@ -0,0 +1,778 @@
+/*
+ * colorings of characters
+ * This file is #included by regcomp.c.
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *
+ *
+ * Note that there are some incestuous relationships between this code and
+ * NFA arc maintenance, which perhaps ought to be cleaned up sometime.
+ */
+
+
+
+#define CISERR() VISERR(cm->v)
+#define CERR(e) VERR(cm->v, (e))
+
+
+
+/*
+ - initcm - set up new colormap
+ ^ static VOID initcm(struct vars *, struct colormap *);
+ */
+static VOID
+initcm(v, cm)
+struct vars *v;
+struct colormap *cm;
+{
+ int i;
+ int j;
+ union tree *t;
+ union tree *nextt;
+ struct colordesc *cd;
+
+ cm->magic = CMMAGIC;
+ cm->v = v;
+
+ cm->ncds = NINLINECDS;
+ cm->cd = cm->cdspace;
+ cm->max = 0;
+ cm->free = 0;
+
+ cd = cm->cd; /* cm->cd[WHITE] */
+ cd->sub = NOSUB;
+ cd->arcs = NULL;
+ cd->flags = 0;
+ cd->nchrs = CHR_MAX - CHR_MIN + 1;
+
+ /* upper levels of tree */
+ for (t = &cm->tree[0], j = NBYTS-1; j > 0; t = nextt, j--) {
+ nextt = t + 1;
+ for (i = BYTTAB-1; i >= 0; i--)
+ t->tptr[i] = nextt;
+ }
+ /* bottom level is solid white */
+ t = &cm->tree[NBYTS-1];
+ for (i = BYTTAB-1; i >= 0; i--)
+ t->tcolor[i] = WHITE;
+ cd->block = t;
+}
+
+/*
+ - freecm - free dynamically-allocated things in a colormap
+ ^ static VOID freecm(struct colormap *);
+ */
+static VOID
+freecm(cm)
+struct colormap *cm;
+{
+ size_t i;
+ union tree *cb;
+
+ cm->magic = 0;
+ if (NBYTS > 1)
+ cmtreefree(cm, cm->tree, 0);
+ for (i = 1; i <= cm->max; i++) /* skip WHITE */
+ if (!UNUSEDCOLOR(&cm->cd[i])) {
+ cb = cm->cd[i].block;
+ if (cb != NULL)
+ FREE(cb);
+ }
+ if (cm->cd != cm->cdspace)
+ FREE(cm->cd);
+}
+
+/*
+ - cmtreefree - free a non-terminal part of a colormap tree
+ ^ static VOID cmtreefree(struct colormap *, union tree *, int);
+ */
+static VOID
+cmtreefree(cm, tree, level)
+struct colormap *cm;
+union tree *tree;
+int level; /* level number (top == 0) of this block */
+{
+ int i;
+ union tree *t;
+ union tree *fillt = &cm->tree[level+1];
+ union tree *cb;
+
+ assert(level < NBYTS-1); /* this level has pointers */
+ for (i = BYTTAB-1; i >= 0; i--) {
+ t = tree->tptr[i];
+ assert(t != NULL);
+ if (t != fillt) {
+ if (level < NBYTS-2) { /* more pointer blocks below */
+ cmtreefree(cm, t, level+1);
+ FREE(t);
+ } else { /* color block below */
+ cb = cm->cd[t->tcolor[0]].block;
+ if (t != cb) /* not a solid block */
+ FREE(t);
+ }
+ }
+ }
+}
+
+/*
+ - setcolor - set the color of a character in a colormap
+ ^ static color setcolor(struct colormap *, pchr, pcolor);
+ */
+static color /* previous color */
+setcolor(cm, c, co)
+struct colormap *cm;
+pchr c;
+pcolor co;
+{
+ uchr uc = c;
+ int shift;
+ int level;
+ int b;
+ int bottom;
+ union tree *t;
+ union tree *newt;
+ union tree *fillt;
+ union tree *lastt;
+ union tree *cb;
+ color prev;
+
+ assert(cm->magic == CMMAGIC);
+ if (CISERR() || co == COLORLESS)
+ return COLORLESS;
+
+ t = cm->tree;
+ for (level = 0, shift = BYTBITS * (NBYTS - 1); shift > 0;
+ level++, shift -= BYTBITS) {
+ b = (uc >> shift) & BYTMASK;
+ lastt = t;
+ t = lastt->tptr[b];
+ assert(t != NULL);
+ fillt = &cm->tree[level+1];
+ bottom = (shift <= BYTBITS) ? 1 : 0;
+ cb = (bottom) ? cm->cd[t->tcolor[0]].block : fillt;
+ if (t == fillt || t == cb) { /* must allocate a new block */
+ newt = (union tree *)MALLOC((bottom) ?
+ sizeof(struct colors) : sizeof(struct ptrs));
+ if (newt == NULL) {
+ CERR(REG_ESPACE);
+ return COLORLESS;
+ }
+ if (bottom)
+ memcpy(VS(newt->tcolor), VS(t->tcolor),
+ BYTTAB*sizeof(color));
+ else
+ memcpy(VS(newt->tptr), VS(t->tptr),
+ BYTTAB*sizeof(union tree *));
+ t = newt;
+ lastt->tptr[b] = t;
+ }
+ }
+
+ b = uc & BYTMASK;
+ prev = t->tcolor[b];
+ t->tcolor[b] = (color)co;
+ return prev;
+}
+
+/*
+ - maxcolor - report largest color number in use
+ ^ static color maxcolor(struct colormap *);
+ */
+static color
+maxcolor(cm)
+struct colormap *cm;
+{
+ if (CISERR())
+ return COLORLESS;
+
+ return (color)cm->max;
+}
+
+/*
+ - newcolor - find a new color (must be subject of setcolor at once)
+ * Beware: may relocate the colordescs.
+ ^ static color newcolor(struct colormap *);
+ */
+static color /* COLORLESS for error */
+newcolor(cm)
+struct colormap *cm;
+{
+ struct colordesc *cd;
+ struct colordesc *new;
+ size_t n;
+
+ if (CISERR())
+ return COLORLESS;
+
+ if (cm->free != 0) {
+ assert(cm->free > 0);
+ assert((size_t)cm->free < cm->ncds);
+ cd = &cm->cd[cm->free];
+ assert(UNUSEDCOLOR(cd));
+ assert(cd->arcs == NULL);
+ cm->free = cd->sub;
+ } else if (cm->max < cm->ncds - 1) {
+ cm->max++;
+ cd = &cm->cd[cm->max];
+ } else {
+ /* oops, must allocate more */
+ n = cm->ncds * 2;
+ if (cm->cd == cm->cdspace) {
+ new = (struct colordesc *)MALLOC(n *
+ sizeof(struct colordesc));
+ if (new != NULL)
+ memcpy(VS(new), VS(cm->cdspace), cm->ncds *
+ sizeof(struct colordesc));
+ } else
+ new = (struct colordesc *)REALLOC(cm->cd,
+ n * sizeof(struct colordesc));
+ if (new == NULL) {
+ CERR(REG_ESPACE);
+ return COLORLESS;
+ }
+ cm->cd = new;
+ cm->ncds = n;
+ assert(cm->max < cm->ncds - 1);
+ cm->max++;
+ cd = &cm->cd[cm->max];
+ }
+
+ cd->nchrs = 0;
+ cd->sub = NOSUB;
+ cd->arcs = NULL;
+ cd->flags = 0;
+ cd->block = NULL;
+
+ return (color)(cd - cm->cd);
+}
+
+/*
+ - freecolor - free a color (must have no arcs or subcolor)
+ ^ static VOID freecolor(struct colormap *, pcolor);
+ */
+static VOID
+freecolor(cm, co)
+struct colormap *cm;
+pcolor co;
+{
+ struct colordesc *cd = &cm->cd[co];
+ color pco, nco; /* for freelist scan */
+
+ assert(co >= 0);
+ if (co == WHITE)
+ return;
+
+ assert(cd->arcs == NULL);
+ assert(cd->sub == NOSUB);
+ assert(cd->nchrs == 0);
+ cd->flags = FREECOL;
+ if (cd->block != NULL) {
+ FREE(cd->block);
+ cd->block = NULL; /* just paranoia */
+ }
+
+ if ((size_t)co == cm->max) {
+ while (cm->max > WHITE && UNUSEDCOLOR(&cm->cd[cm->max]))
+ cm->max--;
+ assert(cm->free >= 0);
+ while ((size_t)cm->free > cm->max)
+ cm->free = cm->cd[cm->free].sub;
+ if (cm->free > 0) {
+ assert(cm->free < cm->max);
+ pco = cm->free;
+ nco = cm->cd[pco].sub;
+ while (nco > 0)
+ if ((size_t)nco > cm->max) {
+ /* take this one out of freelist */
+ nco = cm->cd[nco].sub;
+ cm->cd[pco].sub = nco;
+ } else {
+ assert(nco < cm->max);
+ pco = nco;
+ nco = cm->cd[pco].sub;
+ }
+ }
+ } else {
+ cd->sub = cm->free;
+ cm->free = (color)(cd - cm->cd);
+ }
+}
+
+/*
+ - pseudocolor - allocate a false color, to be managed by other means
+ ^ static color pseudocolor(struct colormap *);
+ */
+static color
+pseudocolor(cm)
+struct colormap *cm;
+{
+ color co;
+
+ co = newcolor(cm);
+ if (CISERR())
+ return COLORLESS;
+ cm->cd[co].nchrs = 1;
+ cm->cd[co].flags = PSEUDO;
+ return co;
+}
+
+/*
+ - subcolor - allocate a new subcolor (if necessary) to this chr
+ ^ static color subcolor(struct colormap *, pchr c);
+ */
+static color
+subcolor(cm, c)
+struct colormap *cm;
+pchr c;
+{
+ color co; /* current color of c */
+ color sco; /* new subcolor */
+
+ co = GETCOLOR(cm, c);
+ sco = newsub(cm, co);
+ if (CISERR())
+ return COLORLESS;
+ assert(sco != COLORLESS);
+
+ if (co == sco) /* already in an open subcolor */
+ return co; /* rest is redundant */
+ cm->cd[co].nchrs--;
+ cm->cd[sco].nchrs++;
+ setcolor(cm, c, sco);
+ return sco;
+}
+
+/*
+ - newsub - allocate a new subcolor (if necessary) for a color
+ ^ static color newsub(struct colormap *, pcolor);
+ */
+static color
+newsub(cm, co)
+struct colormap *cm;
+pcolor co;
+{
+ color sco; /* new subcolor */
+
+ sco = cm->cd[co].sub;
+ if (sco == NOSUB) { /* color has no open subcolor */
+ if (cm->cd[co].nchrs == 1) /* optimization */
+ return co;
+ sco = newcolor(cm); /* must create subcolor */
+ if (sco == COLORLESS) {
+ assert(CISERR());
+ return COLORLESS;
+ }
+ cm->cd[co].sub = sco;
+ cm->cd[sco].sub = sco; /* open subcolor points to self */
+ }
+ assert(sco != NOSUB);
+
+ return sco;
+}
+
+/*
+ - subrange - allocate new subcolors to this range of chrs, fill in arcs
+ ^ static VOID subrange(struct vars *, pchr, pchr, struct state *,
+ ^ struct state *);
+ */
+static VOID
+subrange(v, from, to, lp, rp)
+struct vars *v;
+pchr from;
+pchr to;
+struct state *lp;
+struct state *rp;
+{
+ uchr uf;
+ int i;
+
+ assert(from <= to);
+
+ /* first, align "from" on a tree-block boundary */
+ uf = (uchr)from;
+ i = (int)( ((uf + BYTTAB-1) & (uchr)~BYTMASK) - uf );
+ for (; from <= to && i > 0; i--, from++)
+ newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
+ if (from > to) /* didn't reach a boundary */
+ return;
+
+ /* deal with whole blocks */
+ for (; to - from >= BYTTAB; from += BYTTAB)
+ subblock(v, from, lp, rp);
+
+ /* clean up any remaining partial table */
+ for (; from <= to; from++)
+ newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
+}
+
+/*
+ - subblock - allocate new subcolors for one tree block of chrs, fill in arcs
+ ^ static VOID subblock(struct vars *, pchr, struct state *, struct state *);
+ */
+static VOID
+subblock(v, start, lp, rp)
+struct vars *v;
+pchr start; /* first of BYTTAB chrs */
+struct state *lp;
+struct state *rp;
+{
+ uchr uc = start;
+ struct colormap *cm = v->cm;
+ int shift;
+ int level;
+ int i;
+ int b;
+ union tree *t;
+ union tree *cb;
+ union tree *fillt;
+ union tree *lastt;
+ int previ;
+ int ndone;
+ color co;
+ color sco;
+
+ assert((uc % BYTTAB) == 0);
+
+ /* find its color block, making new pointer blocks as needed */
+ t = cm->tree;
+ fillt = NULL;
+ for (level = 0, shift = BYTBITS * (NBYTS - 1); shift > 0;
+ level++, shift -= BYTBITS) {
+ b = (uc >> shift) & BYTMASK;
+ lastt = t;
+ t = lastt->tptr[b];
+ assert(t != NULL);
+ fillt = &cm->tree[level+1];
+ if (t == fillt && shift > BYTBITS) { /* need new ptr block */
+ t = (union tree *)MALLOC(sizeof(struct ptrs));
+ if (t == NULL) {
+ CERR(REG_ESPACE);
+ return;
+ }
+ memcpy(VS(t->tptr), VS(fillt->tptr),
+ BYTTAB*sizeof(union tree *));
+ lastt->tptr[b] = t;
+ }
+ }
+
+ /* special cases: fill block or solid block */
+ co = t->tcolor[0];
+ cb = cm->cd[co].block;
+ if (t == fillt || t == cb) {
+ /* either way, we want a subcolor solid block */
+ sco = newsub(cm, co);
+ t = cm->cd[sco].block;
+ if (t == NULL) { /* must set it up */
+ t = (union tree *)MALLOC(sizeof(struct colors));
+ if (t == NULL) {
+ CERR(REG_ESPACE);
+ return;
+ }
+ for (i = 0; i < BYTTAB; i++)
+ t->tcolor[i] = sco;
+ cm->cd[sco].block = t;
+ }
+ /* find loop must have run at least once */
+ lastt->tptr[b] = t;
+ newarc(v->nfa, PLAIN, sco, lp, rp);
+ cm->cd[co].nchrs -= BYTTAB;
+ cm->cd[sco].nchrs += BYTTAB;
+ return;
+ }
+
+ /* general case, a mixed block to be altered */
+ i = 0;
+ while (i < BYTTAB) {
+ co = t->tcolor[i];
+ sco = newsub(cm, co);
+ newarc(v->nfa, PLAIN, sco, lp, rp);
+ previ = i;
+ do {
+ t->tcolor[i++] = sco;
+ } while (i < BYTTAB && t->tcolor[i] == co);
+ ndone = i - previ;
+ cm->cd[co].nchrs -= ndone;
+ cm->cd[sco].nchrs += ndone;
+ }
+}
+
+/*
+ - okcolors - promote subcolors to full colors
+ ^ static VOID okcolors(struct nfa *, struct colormap *);
+ */
+static VOID
+okcolors(nfa, cm)
+struct nfa *nfa;
+struct colormap *cm;
+{
+ struct colordesc *cd;
+ struct colordesc *end = CDEND(cm);
+ struct colordesc *scd;
+ struct arc *a;
+ color co;
+ color sco;
+
+ for (cd = cm->cd, co = 0; cd < end; cd++, co++) {
+ sco = cd->sub;
+ if (UNUSEDCOLOR(cd) || sco == NOSUB) {
+ /* has no subcolor, no further action */
+ } else if (sco == co) {
+ /* is subcolor, let parent deal with it */
+ } else if (cd->nchrs == 0) {
+ /* parent empty, its arcs change color to subcolor */
+ cd->sub = NOSUB;
+ scd = &cm->cd[sco];
+ assert(scd->nchrs > 0);
+ assert(scd->sub == sco);
+ scd->sub = NOSUB;
+ while ((a = cd->arcs) != NULL) {
+ assert(a->co == co);
+ /* uncolorchain(cm, a); */
+ cd->arcs = a->colorchain;
+ a->co = sco;
+ /* colorchain(cm, a); */
+ a->colorchain = scd->arcs;
+ scd->arcs = a;
+ }
+ freecolor(cm, co);
+ } else {
+ /* parent's arcs must gain parallel subcolor arcs */
+ cd->sub = NOSUB;
+ scd = &cm->cd[sco];
+ assert(scd->nchrs > 0);
+ assert(scd->sub == sco);
+ scd->sub = NOSUB;
+ for (a = cd->arcs; a != NULL; a = a->colorchain) {
+ assert(a->co == co);
+ newarc(nfa, a->type, sco, a->from, a->to);
+ }
+ }
+ }
+}
+
+/*
+ - colorchain - add this arc to the color chain of its color
+ ^ static VOID colorchain(struct colormap *, struct arc *);
+ */
+static VOID
+colorchain(cm, a)
+struct colormap *cm;
+struct arc *a;
+{
+ struct colordesc *cd = &cm->cd[a->co];
+
+ a->colorchain = cd->arcs;
+ cd->arcs = a;
+}
+
+/*
+ - uncolorchain - delete this arc from the color chain of its color
+ ^ static VOID uncolorchain(struct colormap *, struct arc *);
+ */
+static VOID
+uncolorchain(cm, a)
+struct colormap *cm;
+struct arc *a;
+{
+ struct colordesc *cd = &cm->cd[a->co];
+ struct arc *aa;
+
+ aa = cd->arcs;
+ if (aa == a) /* easy case */
+ cd->arcs = a->colorchain;
+ else {
+ for (; aa != NULL && aa->colorchain != a; aa = aa->colorchain)
+ continue;
+ assert(aa != NULL);
+ aa->colorchain = a->colorchain;
+ }
+ a->colorchain = NULL; /* paranoia */
+}
+
+/*
+ - singleton - is this character in its own color?
+ ^ static int singleton(struct colormap *, pchr c);
+ */
+static int /* predicate */
+singleton(cm, c)
+struct colormap *cm;
+pchr c;
+{
+ color co; /* color of c */
+
+ co = GETCOLOR(cm, c);
+ if (cm->cd[co].nchrs == 1 && cm->cd[co].sub == NOSUB)
+ return 1;
+ return 0;
+}
+
+/*
+ - rainbow - add arcs of all full colors (but one) between specified states
+ ^ static VOID rainbow(struct nfa *, struct colormap *, int, pcolor,
+ ^ struct state *, struct state *);
+ */
+static VOID
+rainbow(nfa, cm, type, but, from, to)
+struct nfa *nfa;
+struct colormap *cm;
+int type;
+pcolor but; /* COLORLESS if no exceptions */
+struct state *from;
+struct state *to;
+{
+ struct colordesc *cd;
+ struct colordesc *end = CDEND(cm);
+ color co;
+
+ for (cd = cm->cd, co = 0; cd < end && !CISERR(); cd++, co++)
+ if (!UNUSEDCOLOR(cd) && cd->sub != co && co != but &&
+ !(cd->flags&PSEUDO))
+ newarc(nfa, type, co, from, to);
+}
+
+/*
+ - colorcomplement - add arcs of complementary colors
+ * The calling sequence ought to be reconciled with cloneouts().
+ ^ static VOID colorcomplement(struct nfa *, struct colormap *, int,
+ ^ struct state *, struct state *, struct state *);
+ */
+static VOID
+colorcomplement(nfa, cm, type, of, from, to)
+struct nfa *nfa;
+struct colormap *cm;
+int type;
+struct state *of; /* complements of this guy's PLAIN outarcs */
+struct state *from;
+struct state *to;
+{
+ struct colordesc *cd;
+ struct colordesc *end = CDEND(cm);
+ color co;
+
+ assert(of != from);
+ for (cd = cm->cd, co = 0; cd < end && !CISERR(); cd++, co++)
+ if (!UNUSEDCOLOR(cd) && !(cd->flags&PSEUDO))
+ if (findarc(of, PLAIN, co) == NULL)
+ newarc(nfa, type, co, from, to);
+}
+
+
+
+#ifdef REG_DEBUG
+/*
+ ^ #ifdef REG_DEBUG
+ */
+
+/*
+ - dumpcolors - debugging output
+ ^ static VOID dumpcolors(struct colormap *, FILE *);
+ */
+static VOID
+dumpcolors(cm, f)
+struct colormap *cm;
+FILE *f;
+{
+ struct colordesc *cd;
+ struct colordesc *end;
+ color co;
+ chr c;
+ char *has;
+
+ fprintf(f, "max %ld\n", (long)cm->max);
+ if (NBYTS > 1)
+ fillcheck(cm, cm->tree, 0, f);
+ end = CDEND(cm);
+ for (cd = cm->cd + 1, co = 1; cd < end; cd++, co++) /* skip 0 */
+ if (!UNUSEDCOLOR(cd)) {
+ assert(cd->nchrs > 0);
+ has = (cd->block != NULL) ? "#" : "";
+ if (cd->flags&PSEUDO)
+ fprintf(f, "#%2ld%s(ps): ", (long)co, has);
+ else
+ fprintf(f, "#%2ld%s(%2d): ", (long)co,
+ has, cd->nchrs);
+ /* it's hard to do this more efficiently */
+ for (c = CHR_MIN; c < CHR_MAX; c++)
+ if (GETCOLOR(cm, c) == co)
+ dumpchr(c, f);
+ assert(c == CHR_MAX);
+ if (GETCOLOR(cm, c) == co)
+ dumpchr(c, f);
+ fprintf(f, "\n");
+ }
+}
+
+/*
+ - fillcheck - check proper filling of a tree
+ ^ static VOID fillcheck(struct colormap *, union tree *, int, FILE *);
+ */
+static VOID
+fillcheck(cm, tree, level, f)
+struct colormap *cm;
+union tree *tree;
+int level; /* level number (top == 0) of this block */
+FILE *f;
+{
+ int i;
+ union tree *t;
+ union tree *fillt = &cm->tree[level+1];
+
+ assert(level < NBYTS-1); /* this level has pointers */
+ for (i = BYTTAB-1; i >= 0; i--) {
+ t = tree->tptr[i];
+ if (t == NULL)
+ fprintf(f, "NULL found in filled tree!\n");
+ else if (t == fillt)
+ {}
+ else if (level < NBYTS-2) /* more pointer blocks below */
+ fillcheck(cm, t, level+1, f);
+ }
+}
+
+/*
+ - dumpchr - print a chr
+ * Kind of char-centric but works well enough for debug use.
+ ^ static VOID dumpchr(pchr, FILE *);
+ */
+static VOID
+dumpchr(c, f)
+pchr c;
+FILE *f;
+{
+ if (c == '\\')
+ fprintf(f, "\\\\");
+ else if (c > ' ' && c <= '~')
+ putc((char)c, f);
+ else
+ fprintf(f, "\\u%04lx", (long)c);
+}
+
+/*
+ ^ #endif
+ */
+#endif /* ifdef REG_DEBUG */
diff --git a/tcl/generic/regc_cvec.c b/tcl/generic/regc_cvec.c
new file mode 100644
index 00000000000..86765ea1f73
--- /dev/null
+++ b/tcl/generic/regc_cvec.c
@@ -0,0 +1,198 @@
+/*
+ * Utility functions for handling cvecs
+ * This file is #included by regcomp.c.
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+/*
+ - newcvec - allocate a new cvec
+ ^ static struct cvec *newcvec(int, int, int);
+ */
+static struct cvec *
+newcvec(nchrs, nranges, nmcces)
+int nchrs; /* to hold this many chrs... */
+int nranges; /* ... and this many ranges... */
+int nmcces; /* ... and this many MCCEs */
+{
+ size_t n;
+ size_t nc;
+ struct cvec *cv;
+
+ nc = (size_t)nchrs + (size_t)nmcces*(MAXMCCE+1) + (size_t)nranges*2;
+ n = sizeof(struct cvec) + (size_t)(nmcces-1)*sizeof(chr *) +
+ nc*sizeof(chr);
+ cv = (struct cvec *)MALLOC(n);
+ if (cv == NULL)
+ return NULL;
+ cv->chrspace = nc;
+ cv->chrs = (chr *)&cv->mcces[nmcces]; /* chrs just after MCCE ptrs */
+ cv->mccespace = nmcces;
+ cv->ranges = cv->chrs + nchrs + nmcces*(MAXMCCE+1);
+ cv->rangespace = nranges;
+ return clearcvec(cv);
+}
+
+/*
+ - clearcvec - clear a possibly-new cvec
+ * Returns pointer as convenience.
+ ^ static struct cvec *clearcvec(struct cvec *);
+ */
+static struct cvec *
+clearcvec(cv)
+struct cvec *cv;
+{
+ int i;
+
+ assert(cv != NULL);
+ cv->nchrs = 0;
+ assert(cv->chrs == (chr *)&cv->mcces[cv->mccespace]);
+ cv->nmcces = 0;
+ cv->nmccechrs = 0;
+ cv->nranges = 0;
+ for (i = 0; i < cv->mccespace; i++)
+ cv->mcces[i] = NULL;
+
+ return cv;
+}
+
+/*
+ - addchr - add a chr to a cvec
+ ^ static VOID addchr(struct cvec *, pchr);
+ */
+static VOID
+addchr(cv, c)
+struct cvec *cv;
+pchr c;
+{
+ assert(cv->nchrs < cv->chrspace - cv->nmccechrs);
+ cv->chrs[cv->nchrs++] = (chr)c;
+}
+
+/*
+ - addrange - add a range to a cvec
+ ^ static VOID addrange(struct cvec *, pchr, pchr);
+ */
+static VOID
+addrange(cv, from, to)
+struct cvec *cv;
+pchr from;
+pchr to;
+{
+ assert(cv->nranges < cv->rangespace);
+ cv->ranges[cv->nranges*2] = (chr)from;
+ cv->ranges[cv->nranges*2 + 1] = (chr)to;
+ cv->nranges++;
+}
+
+/*
+ - addmcce - add an MCCE to a cvec
+ ^ static VOID addmcce(struct cvec *, chr *, chr *);
+ */
+static VOID
+addmcce(cv, startp, endp)
+struct cvec *cv;
+chr *startp; /* beginning of text */
+chr *endp; /* just past end of text */
+{
+ int len;
+ int i;
+ chr *s;
+ chr *d;
+
+ if (startp == NULL && endp == NULL)
+ return;
+ len = endp - startp;
+ assert(len > 0);
+ assert(cv->nchrs + len < cv->chrspace - cv->nmccechrs);
+ assert(cv->nmcces < cv->mccespace);
+ d = &cv->chrs[cv->chrspace - cv->nmccechrs - len - 1];
+ cv->mcces[cv->nmcces++] = d;
+ for (s = startp, i = len; i > 0; s++, i--)
+ *d++ = *s;
+ *d++ = 0; /* endmarker */
+ assert(d == &cv->chrs[cv->chrspace - cv->nmccechrs]);
+ cv->nmccechrs += len + 1;
+}
+
+/*
+ - haschr - does a cvec contain this chr?
+ ^ static int haschr(struct cvec *, pchr);
+ */
+static int /* predicate */
+haschr(cv, c)
+struct cvec *cv;
+pchr c;
+{
+ int i;
+ chr *p;
+
+ for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--)
+ if (*p == c)
+ return 1;
+ for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--)
+ if (*p <= c && c <= *(p+1))
+ return 1;
+ return 0;
+}
+
+/*
+ - getcvec - get a cvec, remembering it as v->cv
+ ^ static struct cvec *getcvec(struct vars *, int, int, int);
+ */
+static struct cvec *
+getcvec(v, nchrs, nranges, nmcces)
+struct vars *v;
+int nchrs; /* to hold this many chrs... */
+int nranges; /* ... and this many ranges... */
+int nmcces; /* ... and this many MCCEs */
+{
+ if (v->cv != NULL && nchrs <= v->cv->chrspace &&
+ nranges <= v->cv->rangespace &&
+ nmcces <= v->cv->mccespace)
+ return clearcvec(v->cv);
+
+ if (v->cv != NULL)
+ freecvec(v->cv);
+ v->cv = newcvec(nchrs, nranges, nmcces);
+ if (v->cv == NULL)
+ ERR(REG_ESPACE);
+
+ return v->cv;
+}
+
+/*
+ - freecvec - free a cvec
+ ^ static VOID freecvec(struct cvec *);
+ */
+static VOID
+freecvec(cv)
+struct cvec *cv;
+{
+ FREE(cv);
+}
diff --git a/tcl/generic/regc_lex.c b/tcl/generic/regc_lex.c
new file mode 100644
index 00000000000..1acc3f4cae2
--- /dev/null
+++ b/tcl/generic/regc_lex.c
@@ -0,0 +1,1061 @@
+/*
+ * lexical analyzer
+ * This file is #included by regcomp.c.
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+/* scanning macros (know about v) */
+#define ATEOS() (v->now >= v->stop)
+#define HAVE(n) (v->stop - v->now >= (n))
+#define NEXT1(c) (!ATEOS() && *v->now == CHR(c))
+#define NEXT2(a,b) (HAVE(2) && *v->now == CHR(a) && *(v->now+1) == CHR(b))
+#define NEXT3(a,b,c) (HAVE(3) && *v->now == CHR(a) && \
+ *(v->now+1) == CHR(b) && \
+ *(v->now+2) == CHR(c))
+#define SET(c) (v->nexttype = (c))
+#define SETV(c, n) (v->nexttype = (c), v->nextvalue = (n))
+#define RET(c) return (SET(c), 1)
+#define RETV(c, n) return (SETV(c, n), 1)
+#define FAILW(e) return (ERR(e), 0) /* ERR does SET(EOS) */
+#define LASTTYPE(t) (v->lasttype == (t))
+
+/* lexical contexts */
+#define L_ERE 1 /* mainline ERE/ARE */
+#define L_BRE 2 /* mainline BRE */
+#define L_Q 3 /* REG_QUOTE */
+#define L_EBND 4 /* ERE/ARE bound */
+#define L_BBND 5 /* BRE bound */
+#define L_BRACK 6 /* brackets */
+#define L_CEL 7 /* collating element */
+#define L_ECL 8 /* equivalence class */
+#define L_CCL 9 /* character class */
+#define INTOCON(c) (v->lexcon = (c))
+#define INCON(con) (v->lexcon == (con))
+
+/* construct pointer past end of chr array */
+#define ENDOF(array) ((array) + sizeof(array)/sizeof(chr))
+
+/*
+ - lexstart - set up lexical stuff, scan leading options
+ ^ static VOID lexstart(struct vars *);
+ */
+static VOID
+lexstart(v)
+struct vars *v;
+{
+ prefixes(v); /* may turn on new type bits etc. */
+ NOERR();
+
+ if (v->cflags&REG_QUOTE) {
+ assert(!(v->cflags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)));
+ INTOCON(L_Q);
+ } else if (v->cflags&REG_EXTENDED) {
+ assert(!(v->cflags&REG_QUOTE));
+ INTOCON(L_ERE);
+ } else {
+ assert(!(v->cflags&(REG_QUOTE|REG_ADVF)));
+ INTOCON(L_BRE);
+ }
+
+ v->nexttype = EMPTY; /* remember we were at the start */
+ next(v); /* set up the first token */
+}
+
+/*
+ - prefixes - implement various special prefixes
+ ^ static VOID prefixes(struct vars *);
+ */
+static VOID
+prefixes(v)
+struct vars *v;
+{
+ /* literal string doesn't get any of this stuff */
+ if (v->cflags&REG_QUOTE)
+ return;
+
+ /* initial "***" gets special things */
+ if (HAVE(4) && NEXT3('*', '*', '*'))
+ switch (*(v->now + 3)) {
+ case CHR('?'): /* "***?" error, msg shows version */
+ ERR(REG_BADPAT);
+ return; /* proceed no further */
+ break;
+ case CHR('='): /* "***=" shifts to literal string */
+ NOTE(REG_UNONPOSIX);
+ v->cflags |= REG_QUOTE;
+ v->cflags &= ~(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE);
+ v->now += 4;
+ return; /* and there can be no more prefixes */
+ break;
+ case CHR(':'): /* "***:" shifts to AREs */
+ NOTE(REG_UNONPOSIX);
+ v->cflags |= REG_ADVANCED;
+ v->now += 4;
+ break;
+ default: /* otherwise *** is just an error */
+ ERR(REG_BADRPT);
+ return;
+ break;
+ }
+
+ /* BREs and EREs don't get embedded options */
+ if ((v->cflags&REG_ADVANCED) != REG_ADVANCED)
+ return;
+
+ /* embedded options (AREs only) */
+ if (HAVE(3) && NEXT2('(', '?') && iscalpha(*(v->now + 2))) {
+ NOTE(REG_UNONPOSIX);
+ v->now += 2;
+ for (; !ATEOS() && iscalpha(*v->now); v->now++)
+ switch (*v->now) {
+ case CHR('b'): /* BREs (but why???) */
+ v->cflags &= ~(REG_ADVANCED|REG_QUOTE);
+ break;
+ case CHR('c'): /* case sensitive */
+ v->cflags &= ~REG_ICASE;
+ break;
+ case CHR('e'): /* plain EREs */
+ v->cflags |= REG_EXTENDED;
+ v->cflags &= ~(REG_ADVF|REG_QUOTE);
+ break;
+ case CHR('i'): /* case insensitive */
+ v->cflags |= REG_ICASE;
+ break;
+ case CHR('m'): /* Perloid synonym for n */
+ case CHR('n'): /* \n affects ^ $ . [^ */
+ v->cflags |= REG_NEWLINE;
+ break;
+ case CHR('p'): /* ~Perl, \n affects . [^ */
+ v->cflags |= REG_NLSTOP;
+ v->cflags &= ~REG_NLANCH;
+ break;
+ case CHR('q'): /* literal string */
+ v->cflags |= REG_QUOTE;
+ v->cflags &= ~REG_ADVANCED;
+ break;
+ case CHR('s'): /* single line, \n ordinary */
+ v->cflags &= ~REG_NEWLINE;
+ break;
+ case CHR('t'): /* tight syntax */
+ v->cflags &= ~REG_EXPANDED;
+ break;
+ case CHR('w'): /* weird, \n affects ^ $ only */
+ v->cflags &= ~REG_NLSTOP;
+ v->cflags |= REG_NLANCH;
+ break;
+ case CHR('x'): /* expanded syntax */
+ v->cflags |= REG_EXPANDED;
+ break;
+ default:
+ ERR(REG_BADOPT);
+ return;
+ }
+ if (!NEXT1(')')) {
+ ERR(REG_BADOPT);
+ return;
+ }
+ v->now++;
+ if (v->cflags&REG_QUOTE)
+ v->cflags &= ~(REG_EXPANDED|REG_NEWLINE);
+ }
+}
+
+/*
+ - lexnest - "call a subroutine", interpolating string at the lexical level
+ * Note, this is not a very general facility. There are a number of
+ * implicit assumptions about what sorts of strings can be subroutines.
+ ^ static VOID lexnest(struct vars *, chr *, chr *);
+ */
+static VOID
+lexnest(v, beginp, endp)
+struct vars *v;
+chr *beginp; /* start of interpolation */
+chr *endp; /* one past end of interpolation */
+{
+ assert(v->savenow == NULL); /* only one level of nesting */
+ v->savenow = v->now;
+ v->savestop = v->stop;
+ v->now = beginp;
+ v->stop = endp;
+}
+
+/*
+ * string constants to interpolate as expansions of things like \d
+ */
+static chr backd[] = { /* \d */
+ CHR('['), CHR('['), CHR(':'),
+ CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+ CHR(':'), CHR(']'), CHR(']')
+};
+static chr backD[] = { /* \D */
+ CHR('['), CHR('^'), CHR('['), CHR(':'),
+ CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+ CHR(':'), CHR(']'), CHR(']')
+};
+static chr brbackd[] = { /* \d within brackets */
+ CHR('['), CHR(':'),
+ CHR('d'), CHR('i'), CHR('g'), CHR('i'), CHR('t'),
+ CHR(':'), CHR(']')
+};
+static chr backs[] = { /* \s */
+ CHR('['), CHR('['), CHR(':'),
+ CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+ CHR(':'), CHR(']'), CHR(']')
+};
+static chr backS[] = { /* \S */
+ CHR('['), CHR('^'), CHR('['), CHR(':'),
+ CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+ CHR(':'), CHR(']'), CHR(']')
+};
+static chr brbacks[] = { /* \s within brackets */
+ CHR('['), CHR(':'),
+ CHR('s'), CHR('p'), CHR('a'), CHR('c'), CHR('e'),
+ CHR(':'), CHR(']')
+};
+static chr backw[] = { /* \w */
+ CHR('['), CHR('['), CHR(':'),
+ CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+ CHR(':'), CHR(']'), CHR('_'), CHR(']')
+};
+static chr backW[] = { /* \W */
+ CHR('['), CHR('^'), CHR('['), CHR(':'),
+ CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+ CHR(':'), CHR(']'), CHR('_'), CHR(']')
+};
+static chr brbackw[] = { /* \w within brackets */
+ CHR('['), CHR(':'),
+ CHR('a'), CHR('l'), CHR('n'), CHR('u'), CHR('m'),
+ CHR(':'), CHR(']'), CHR('_')
+};
+
+/*
+ - lexword - interpolate a bracket expression for word characters
+ * Possibly ought to inquire whether there is a "word" character class.
+ ^ static VOID lexword(struct vars *);
+ */
+static VOID
+lexword(v)
+struct vars *v;
+{
+ lexnest(v, backw, ENDOF(backw));
+}
+
+/*
+ - next - get next token
+ ^ static int next(struct vars *);
+ */
+static int /* 1 normal, 0 failure */
+next(v)
+struct vars *v;
+{
+ chr c;
+
+ /* errors yield an infinite sequence of failures */
+ if (ISERR())
+ return 0; /* the error has set nexttype to EOS */
+
+ /* remember flavor of last token */
+ v->lasttype = v->nexttype;
+
+ /* REG_BOSONLY */
+ if (v->nexttype == EMPTY && (v->cflags&REG_BOSONLY)) {
+ /* at start of a REG_BOSONLY RE */
+ RETV(SBEGIN, 0); /* same as \A */
+ }
+
+ /* if we're nested and we've hit end, return to outer level */
+ if (v->savenow != NULL && ATEOS()) {
+ v->now = v->savenow;
+ v->stop = v->savestop;
+ v->savenow = v->savestop = NULL;
+ }
+
+ /* skip white space etc. if appropriate (not in literal or []) */
+ if (v->cflags&REG_EXPANDED)
+ switch (v->lexcon) {
+ case L_ERE:
+ case L_BRE:
+ case L_EBND:
+ case L_BBND:
+ skip(v);
+ break;
+ }
+
+ /* handle EOS, depending on context */
+ if (ATEOS()) {
+ switch (v->lexcon) {
+ case L_ERE:
+ case L_BRE:
+ case L_Q:
+ RET(EOS);
+ break;
+ case L_EBND:
+ case L_BBND:
+ FAILW(REG_EBRACE);
+ break;
+ case L_BRACK:
+ case L_CEL:
+ case L_ECL:
+ case L_CCL:
+ FAILW(REG_EBRACK);
+ break;
+ }
+ assert(NOTREACHED);
+ }
+
+ /* okay, time to actually get a character */
+ c = *v->now++;
+
+ /* deal with the easy contexts, punt EREs to code below */
+ switch (v->lexcon) {
+ case L_BRE: /* punt BREs to separate function */
+ return brenext(v, c);
+ break;
+ case L_ERE: /* see below */
+ break;
+ case L_Q: /* literal strings are easy */
+ RETV(PLAIN, c);
+ break;
+ case L_BBND: /* bounds are fairly simple */
+ case L_EBND:
+ switch (c) {
+ case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
+ case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
+ case CHR('8'): case CHR('9'):
+ RETV(DIGIT, (chr)DIGITVAL(c));
+ break;
+ case CHR(','):
+ RET(',');
+ break;
+ case CHR('}'): /* ERE bound ends with } */
+ if (INCON(L_EBND)) {
+ INTOCON(L_ERE);
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ v->now++;
+ NOTE(REG_UNONPOSIX);
+ RETV('}', 0);
+ }
+ RETV('}', 1);
+ } else
+ FAILW(REG_BADBR);
+ break;
+ case CHR('\\'): /* BRE bound ends with \} */
+ if (INCON(L_BBND) && NEXT1('}')) {
+ v->now++;
+ INTOCON(L_BRE);
+ RET('}');
+ } else
+ FAILW(REG_BADBR);
+ break;
+ default:
+ FAILW(REG_BADBR);
+ break;
+ }
+ assert(NOTREACHED);
+ break;
+ case L_BRACK: /* brackets are not too hard */
+ switch (c) {
+ case CHR(']'):
+ if (LASTTYPE('['))
+ RETV(PLAIN, c);
+ else {
+ INTOCON((v->cflags&REG_EXTENDED) ?
+ L_ERE : L_BRE);
+ RET(']');
+ }
+ break;
+ case CHR('\\'):
+ NOTE(REG_UBBS);
+ if (!(v->cflags&REG_ADVF))
+ RETV(PLAIN, c);
+ NOTE(REG_UNONPOSIX);
+ if (ATEOS())
+ FAILW(REG_EESCAPE);
+ (DISCARD)lexescape(v);
+ switch (v->nexttype) { /* not all escapes okay here */
+ case PLAIN:
+ return 1;
+ break;
+ case CCLASS:
+ switch (v->nextvalue) {
+ case 'd':
+ lexnest(v, brbackd, ENDOF(brbackd));
+ break;
+ case 's':
+ lexnest(v, brbacks, ENDOF(brbacks));
+ break;
+ case 'w':
+ lexnest(v, brbackw, ENDOF(brbackw));
+ break;
+ default:
+ FAILW(REG_EESCAPE);
+ break;
+ }
+ /* lexnest done, back up and try again */
+ v->nexttype = v->lasttype;
+ return next(v);
+ break;
+ }
+ /* not one of the acceptable escapes */
+ FAILW(REG_EESCAPE);
+ break;
+ case CHR('-'):
+ if (LASTTYPE('[') || NEXT1(']'))
+ RETV(PLAIN, c);
+ else
+ RETV(RANGE, c);
+ break;
+ case CHR('['):
+ if (ATEOS())
+ FAILW(REG_EBRACK);
+ switch (*v->now++) {
+ case CHR('.'):
+ INTOCON(L_CEL);
+ /* might or might not be locale-specific */
+ RET(COLLEL);
+ break;
+ case CHR('='):
+ INTOCON(L_ECL);
+ NOTE(REG_ULOCALE);
+ RET(ECLASS);
+ break;
+ case CHR(':'):
+ INTOCON(L_CCL);
+ NOTE(REG_ULOCALE);
+ RET(CCLASS);
+ break;
+ default: /* oops */
+ v->now--;
+ RETV(PLAIN, c);
+ break;
+ }
+ assert(NOTREACHED);
+ break;
+ default:
+ RETV(PLAIN, c);
+ break;
+ }
+ assert(NOTREACHED);
+ break;
+ case L_CEL: /* collating elements are easy */
+ if (c == CHR('.') && NEXT1(']')) {
+ v->now++;
+ INTOCON(L_BRACK);
+ RETV(END, '.');
+ } else
+ RETV(PLAIN, c);
+ break;
+ case L_ECL: /* ditto equivalence classes */
+ if (c == CHR('=') && NEXT1(']')) {
+ v->now++;
+ INTOCON(L_BRACK);
+ RETV(END, '=');
+ } else
+ RETV(PLAIN, c);
+ break;
+ case L_CCL: /* ditto character classes */
+ if (c == CHR(':') && NEXT1(']')) {
+ v->now++;
+ INTOCON(L_BRACK);
+ RETV(END, ':');
+ } else
+ RETV(PLAIN, c);
+ break;
+ default:
+ assert(NOTREACHED);
+ break;
+ }
+
+ /* that got rid of everything except EREs and AREs */
+ assert(INCON(L_ERE));
+
+ /* deal with EREs and AREs, except for backslashes */
+ switch (c) {
+ case CHR('|'):
+ RET('|');
+ break;
+ case CHR('*'):
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ v->now++;
+ NOTE(REG_UNONPOSIX);
+ RETV('*', 0);
+ }
+ RETV('*', 1);
+ break;
+ case CHR('+'):
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ v->now++;
+ NOTE(REG_UNONPOSIX);
+ RETV('+', 0);
+ }
+ RETV('+', 1);
+ break;
+ case CHR('?'):
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ v->now++;
+ NOTE(REG_UNONPOSIX);
+ RETV('?', 0);
+ }
+ RETV('?', 1);
+ break;
+ case CHR('{'): /* bounds start or plain character */
+ if (v->cflags&REG_EXPANDED)
+ skip(v);
+ if (ATEOS() || !iscdigit(*v->now)) {
+ NOTE(REG_UBRACES);
+ NOTE(REG_UUNSPEC);
+ RETV(PLAIN, c);
+ } else {
+ NOTE(REG_UBOUNDS);
+ INTOCON(L_EBND);
+ RET('{');
+ }
+ assert(NOTREACHED);
+ break;
+ case CHR('('): /* parenthesis, or advanced extension */
+ if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+ NOTE(REG_UNONPOSIX);
+ v->now++;
+ switch (*v->now++) {
+ case CHR(':'): /* non-capturing paren */
+ RETV('(', 0);
+ break;
+ case CHR('#'): /* comment */
+ while (!ATEOS() && *v->now != CHR(')'))
+ v->now++;
+ if (!ATEOS())
+ v->now++;
+ assert(v->nexttype == v->lasttype);
+ return next(v);
+ break;
+ case CHR('='): /* positive lookahead */
+ NOTE(REG_ULOOKAHEAD);
+ RETV(LACON, 1);
+ break;
+ case CHR('!'): /* negative lookahead */
+ NOTE(REG_ULOOKAHEAD);
+ RETV(LACON, 0);
+ break;
+ default:
+ FAILW(REG_BADRPT);
+ break;
+ }
+ assert(NOTREACHED);
+ }
+ if (v->cflags&REG_NOSUB)
+ RETV('(', 0); /* all parens non-capturing */
+ else
+ RETV('(', 1);
+ break;
+ case CHR(')'):
+ if (LASTTYPE('(')) {
+ NOTE(REG_UUNSPEC);
+ }
+ RETV(')', c);
+ break;
+ case CHR('['): /* easy except for [[:<:]] and [[:>:]] */
+ if (HAVE(6) && *(v->now+0) == CHR('[') &&
+ *(v->now+1) == CHR(':') &&
+ (*(v->now+2) == CHR('<') ||
+ *(v->now+2) == CHR('>')) &&
+ *(v->now+3) == CHR(':') &&
+ *(v->now+4) == CHR(']') &&
+ *(v->now+5) == CHR(']')) {
+ c = *(v->now+2);
+ v->now += 6;
+ NOTE(REG_UNONPOSIX);
+ RET((c == CHR('<')) ? '<' : '>');
+ }
+ INTOCON(L_BRACK);
+ if (NEXT1('^')) {
+ v->now++;
+ RETV('[', 0);
+ }
+ RETV('[', 1);
+ break;
+ case CHR('.'):
+ RET('.');
+ break;
+ case CHR('^'):
+ RET('^');
+ break;
+ case CHR('$'):
+ RET('$');
+ break;
+ case CHR('\\'): /* mostly punt backslashes to code below */
+ if (ATEOS())
+ FAILW(REG_EESCAPE);
+ break;
+ default: /* ordinary character */
+ RETV(PLAIN, c);
+ break;
+ }
+
+ /* ERE/ARE backslash handling; backslash already eaten */
+ assert(!ATEOS());
+ if (!(v->cflags&REG_ADVF)) { /* only AREs have non-trivial escapes */
+ if (iscalnum(*v->now)) {
+ NOTE(REG_UBSALNUM);
+ NOTE(REG_UUNSPEC);
+ }
+ RETV(PLAIN, *v->now++);
+ }
+ (DISCARD)lexescape(v);
+ if (ISERR())
+ FAILW(REG_EESCAPE);
+ if (v->nexttype == CCLASS) { /* fudge at lexical level */
+ switch (v->nextvalue) {
+ case 'd': lexnest(v, backd, ENDOF(backd)); break;
+ case 'D': lexnest(v, backD, ENDOF(backD)); break;
+ case 's': lexnest(v, backs, ENDOF(backs)); break;
+ case 'S': lexnest(v, backS, ENDOF(backS)); break;
+ case 'w': lexnest(v, backw, ENDOF(backw)); break;
+ case 'W': lexnest(v, backW, ENDOF(backW)); break;
+ default:
+ assert(NOTREACHED);
+ FAILW(REG_ASSERT);
+ break;
+ }
+ /* lexnest done, back up and try again */
+ v->nexttype = v->lasttype;
+ return next(v);
+ }
+ /* otherwise, lexescape has already done the work */
+ return !ISERR();
+}
+
+/*
+ - lexescape - parse an ARE backslash escape (backslash already eaten)
+ * Note slightly nonstandard use of the CCLASS type code.
+ ^ static int lexescape(struct vars *);
+ */
+static int /* not actually used, but convenient for RETV */
+lexescape(v)
+struct vars *v;
+{
+ chr c;
+ static chr alert[] = {
+ CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
+ };
+ static chr esc[] = {
+ CHR('E'), CHR('S'), CHR('C')
+ };
+ chr *save;
+
+ assert(v->cflags&REG_ADVF);
+
+ assert(!ATEOS());
+ c = *v->now++;
+ if (!iscalnum(c))
+ RETV(PLAIN, c);
+
+ NOTE(REG_UNONPOSIX);
+ switch (c) {
+ case CHR('a'):
+ RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\007')));
+ break;
+ case CHR('A'):
+ RETV(SBEGIN, 0);
+ break;
+ case CHR('b'):
+ RETV(PLAIN, CHR('\b'));
+ break;
+ case CHR('B'):
+ RETV(PLAIN, CHR('\\'));
+ break;
+ case CHR('c'):
+ NOTE(REG_UUNPORT);
+ if (ATEOS())
+ FAILW(REG_EESCAPE);
+ RETV(PLAIN, (chr)(*v->now++ & 037));
+ break;
+ case CHR('d'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'd');
+ break;
+ case CHR('D'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'D');
+ break;
+ case CHR('e'):
+ NOTE(REG_UUNPORT);
+ RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\033')));
+ break;
+ case CHR('f'):
+ RETV(PLAIN, CHR('\f'));
+ break;
+ case CHR('m'):
+ RET('<');
+ break;
+ case CHR('M'):
+ RET('>');
+ break;
+ case CHR('n'):
+ RETV(PLAIN, CHR('\n'));
+ break;
+ case CHR('r'):
+ RETV(PLAIN, CHR('\r'));
+ break;
+ case CHR('s'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 's');
+ break;
+ case CHR('S'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'S');
+ break;
+ case CHR('t'):
+ RETV(PLAIN, CHR('\t'));
+ break;
+ case CHR('u'):
+ c = lexdigits(v, 16, 4, 4);
+ if (ISERR())
+ FAILW(REG_EESCAPE);
+ RETV(PLAIN, c);
+ break;
+ case CHR('U'):
+ c = lexdigits(v, 16, 8, 8);
+ if (ISERR())
+ FAILW(REG_EESCAPE);
+ RETV(PLAIN, c);
+ break;
+ case CHR('v'):
+ RETV(PLAIN, CHR('\v'));
+ break;
+ case CHR('w'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'w');
+ break;
+ case CHR('W'):
+ NOTE(REG_ULOCALE);
+ RETV(CCLASS, 'W');
+ break;
+ case CHR('x'):
+ NOTE(REG_UUNPORT);
+ c = lexdigits(v, 16, 1, 255); /* REs >255 long outside spec */
+ if (ISERR())
+ FAILW(REG_EESCAPE);
+ RETV(PLAIN, c);
+ break;
+ case CHR('y'):
+ NOTE(REG_ULOCALE);
+ RETV(WBDRY, 0);
+ break;
+ case CHR('Y'):
+ NOTE(REG_ULOCALE);
+ RETV(NWBDRY, 0);
+ break;
+ case CHR('Z'):
+ RETV(SEND, 0);
+ break;
+ case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
+ case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
+ case CHR('9'):
+ save = v->now;
+ v->now--; /* put first digit back */
+ c = lexdigits(v, 10, 1, 255); /* REs >255 long outside spec */
+ if (ISERR())
+ FAILW(REG_EESCAPE);
+ /* ugly heuristic (first test is "exactly 1 digit?") */
+ if (v->now - save == 0 || (int)c <= v->nsubexp) {
+ NOTE(REG_UBACKREF);
+ RETV(BACKREF, (chr)c);
+ }
+ /* oops, doesn't look like it's a backref after all... */
+ v->now = save;
+ /* and fall through into octal number */
+ case CHR('0'):
+ NOTE(REG_UUNPORT);
+ v->now--; /* put first digit back */
+ c = lexdigits(v, 8, 1, 3);
+ if (ISERR())
+ FAILW(REG_EESCAPE);
+ RETV(PLAIN, c);
+ break;
+ default:
+ assert(iscalpha(c));
+ FAILW(REG_EESCAPE); /* unknown alphabetic escape */
+ break;
+ }
+ assert(NOTREACHED);
+}
+
+/*
+ - lexdigits - slurp up digits and return chr value
+ ^ static chr lexdigits(struct vars *, int, int, int);
+ */
+static chr /* chr value; errors signalled via ERR */
+lexdigits(v, base, minlen, maxlen)
+struct vars *v;
+int base;
+int minlen;
+int maxlen;
+{
+ uchr n; /* unsigned to avoid overflow misbehavior */
+ int len;
+ chr c;
+ int d;
+ CONST uchr ub = (uchr) base;
+
+ n = 0;
+ for (len = 0; len < maxlen && !ATEOS(); len++) {
+ c = *v->now++;
+ switch (c) {
+ case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
+ case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
+ case CHR('8'): case CHR('9'):
+ d = DIGITVAL(c);
+ break;
+ case CHR('a'): case CHR('A'): d = 10; break;
+ case CHR('b'): case CHR('B'): d = 11; break;
+ case CHR('c'): case CHR('C'): d = 12; break;
+ case CHR('d'): case CHR('D'): d = 13; break;
+ case CHR('e'): case CHR('E'): d = 14; break;
+ case CHR('f'): case CHR('F'): d = 15; break;
+ default:
+ v->now--; /* oops, not a digit at all */
+ d = -1;
+ break;
+ }
+
+ if (d >= base) { /* not a plausible digit */
+ v->now--;
+ d = -1;
+ }
+ if (d < 0)
+ break; /* NOTE BREAK OUT */
+ n = n*ub + (uchr)d;
+ }
+ if (len < minlen)
+ ERR(REG_EESCAPE);
+
+ return (chr)n;
+}
+
+/*
+ - brenext - get next BRE token
+ * This is much like EREs except for all the stupid backslashes and the
+ * context-dependency of some things.
+ ^ static int brenext(struct vars *, pchr);
+ */
+static int /* 1 normal, 0 failure */
+brenext(v, pc)
+struct vars *v;
+pchr pc;
+{
+ chr c = (chr)pc;
+
+ switch (c) {
+ case CHR('*'):
+ if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^'))
+ RETV(PLAIN, c);
+ RET('*');
+ break;
+ case CHR('['):
+ if (HAVE(6) && *(v->now+0) == CHR('[') &&
+ *(v->now+1) == CHR(':') &&
+ (*(v->now+2) == CHR('<') ||
+ *(v->now+2) == CHR('>')) &&
+ *(v->now+3) == CHR(':') &&
+ *(v->now+4) == CHR(']') &&
+ *(v->now+5) == CHR(']')) {
+ c = *(v->now+2);
+ v->now += 6;
+ NOTE(REG_UNONPOSIX);
+ RET((c == CHR('<')) ? '<' : '>');
+ }
+ INTOCON(L_BRACK);
+ if (NEXT1('^')) {
+ v->now++;
+ RETV('[', 0);
+ }
+ RETV('[', 1);
+ break;
+ case CHR('.'):
+ RET('.');
+ break;
+ case CHR('^'):
+ if (LASTTYPE(EMPTY))
+ RET('^');
+ if (LASTTYPE('(')) {
+ NOTE(REG_UUNSPEC);
+ RET('^');
+ }
+ RETV(PLAIN, c);
+ break;
+ case CHR('$'):
+ if (v->cflags&REG_EXPANDED)
+ skip(v);
+ if (ATEOS())
+ RET('$');
+ if (NEXT2('\\', ')')) {
+ NOTE(REG_UUNSPEC);
+ RET('$');
+ }
+ RETV(PLAIN, c);
+ break;
+ case CHR('\\'):
+ break; /* see below */
+ default:
+ RETV(PLAIN, c);
+ break;
+ }
+
+ assert(c == CHR('\\'));
+
+ if (ATEOS())
+ FAILW(REG_EESCAPE);
+
+ c = *v->now++;
+ switch (c) {
+ case CHR('{'):
+ INTOCON(L_BBND);
+ NOTE(REG_UBOUNDS);
+ RET('{');
+ break;
+ case CHR('('):
+ RETV('(', 1);
+ break;
+ case CHR(')'):
+ RETV(')', c);
+ break;
+ case CHR('<'):
+ NOTE(REG_UNONPOSIX);
+ RET('<');
+ break;
+ case CHR('>'):
+ NOTE(REG_UNONPOSIX);
+ RET('>');
+ break;
+ case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
+ case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
+ case CHR('9'):
+ NOTE(REG_UBACKREF);
+ RETV(BACKREF, (chr)DIGITVAL(c));
+ break;
+ default:
+ if (iscalnum(c)) {
+ NOTE(REG_UBSALNUM);
+ NOTE(REG_UUNSPEC);
+ }
+ RETV(PLAIN, c);
+ break;
+ }
+
+ assert(NOTREACHED);
+}
+
+/*
+ - skip - skip white space and comments in expanded form
+ ^ static VOID skip(struct vars *);
+ */
+static VOID
+skip(v)
+struct vars *v;
+{
+ chr *start = v->now;
+
+ assert(v->cflags&REG_EXPANDED);
+
+ for (;;) {
+ while (!ATEOS() && iscspace(*v->now))
+ v->now++;
+ if (ATEOS() || *v->now != CHR('#'))
+ break; /* NOTE BREAK OUT */
+ assert(NEXT1('#'));
+ while (!ATEOS() && *v->now != CHR('\n'))
+ v->now++;
+ /* leave the newline to be picked up by the iscspace loop */
+ }
+
+ if (v->now != start)
+ NOTE(REG_UNONPOSIX);
+}
+
+/*
+ - newline - return the chr for a newline
+ * This helps confine use of CHR to this source file.
+ ^ static chr newline(NOPARMS);
+ */
+static chr
+newline()
+{
+ return CHR('\n');
+}
+
+/*
+ - 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 chr *ch(NOPARMS);
+ ^ #endif
+ */
+#ifdef REG_DEBUG
+static chr *
+ch()
+{
+ static 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.
+ ^ static chr chrnamed(struct vars *, chr *, chr *, pchr);
+ */
+static chr
+chrnamed(v, startp, endp, lastresort)
+struct vars *v;
+chr *startp; /* start of name */
+chr *endp; /* just past end of name */
+pchr lastresort; /* what to return if name lookup fails */
+{
+ celt c;
+ int errsave;
+ int e;
+ struct cvec *cv;
+
+ errsave = v->err;
+ v->err = 0;
+ c = element(v, startp, endp);
+ e = v->err;
+ v->err = errsave;
+
+ if (e != 0)
+ return (chr)lastresort;
+
+ cv = range(v, c, c, 0);
+ if (cv->nchrs == 0)
+ return (chr)lastresort;
+ return cv->chrs[0];
+}
diff --git a/tcl/generic/regc_locale.c b/tcl/generic/regc_locale.c
new file mode 100644
index 00000000000..100ba0a9415
--- /dev/null
+++ b/tcl/generic/regc_locale.c
@@ -0,0 +1,930 @@
+/*
+ * regc_locale.c --
+ *
+ * This file contains the Unicode locale specific regexp routines.
+ * This file is #included by regcomp.c.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/* ASCII character-name table */
+
+static struct cname {
+ char *name;
+ char code;
+} cnames[] = {
+ {"NUL", '\0'},
+ {"SOH", '\001'},
+ {"STX", '\002'},
+ {"ETX", '\003'},
+ {"EOT", '\004'},
+ {"ENQ", '\005'},
+ {"ACK", '\006'},
+ {"BEL", '\007'},
+ {"alert", '\007'},
+ {"BS", '\010'},
+ {"backspace", '\b'},
+ {"HT", '\011'},
+ {"tab", '\t'},
+ {"LF", '\012'},
+ {"newline", '\n'},
+ {"VT", '\013'},
+ {"vertical-tab", '\v'},
+ {"FF", '\014'},
+ {"form-feed", '\f'},
+ {"CR", '\015'},
+ {"carriage-return", '\r'},
+ {"SO", '\016'},
+ {"SI", '\017'},
+ {"DLE", '\020'},
+ {"DC1", '\021'},
+ {"DC2", '\022'},
+ {"DC3", '\023'},
+ {"DC4", '\024'},
+ {"NAK", '\025'},
+ {"SYN", '\026'},
+ {"ETB", '\027'},
+ {"CAN", '\030'},
+ {"EM", '\031'},
+ {"SUB", '\032'},
+ {"ESC", '\033'},
+ {"IS4", '\034'},
+ {"FS", '\034'},
+ {"IS3", '\035'},
+ {"GS", '\035'},
+ {"IS2", '\036'},
+ {"RS", '\036'},
+ {"IS1", '\037'},
+ {"US", '\037'},
+ {"space", ' '},
+ {"exclamation-mark", '!'},
+ {"quotation-mark", '"'},
+ {"number-sign", '#'},
+ {"dollar-sign", '$'},
+ {"percent-sign", '%'},
+ {"ampersand", '&'},
+ {"apostrophe", '\''},
+ {"left-parenthesis", '('},
+ {"right-parenthesis", ')'},
+ {"asterisk", '*'},
+ {"plus-sign", '+'},
+ {"comma", ','},
+ {"hyphen", '-'},
+ {"hyphen-minus", '-'},
+ {"period", '.'},
+ {"full-stop", '.'},
+ {"slash", '/'},
+ {"solidus", '/'},
+ {"zero", '0'},
+ {"one", '1'},
+ {"two", '2'},
+ {"three", '3'},
+ {"four", '4'},
+ {"five", '5'},
+ {"six", '6'},
+ {"seven", '7'},
+ {"eight", '8'},
+ {"nine", '9'},
+ {"colon", ':'},
+ {"semicolon", ';'},
+ {"less-than-sign", '<'},
+ {"equals-sign", '='},
+ {"greater-than-sign", '>'},
+ {"question-mark", '?'},
+ {"commercial-at", '@'},
+ {"left-square-bracket", '['},
+ {"backslash", '\\'},
+ {"reverse-solidus", '\\'},
+ {"right-square-bracket", ']'},
+ {"circumflex", '^'},
+ {"circumflex-accent", '^'},
+ {"underscore", '_'},
+ {"low-line", '_'},
+ {"grave-accent", '`'},
+ {"left-brace", '{'},
+ {"left-curly-bracket", '{'},
+ {"vertical-line", '|'},
+ {"right-brace", '}'},
+ {"right-curly-bracket", '}'},
+ {"tilde", '~'},
+ {"DEL", '\177'},
+ {NULL, 0}
+};
+
+/* Unicode character-class tables */
+
+typedef struct crange {
+ chr start;
+ chr end;
+} crange;
+
+/* Unicode: (Alphabetic) */
+
+static crange alphaRangeTable[] = {
+ {0x0041, 0x005a}, {0x0061, 0x007a}, {0x00c0, 0x00d6}, {0x00d8, 0x00f6},
+ {0x00f8, 0x01f5}, {0x01fa, 0x0217}, {0x0250, 0x02a8}, {0x02b0, 0x02b8},
+ {0x02bb, 0x02c1}, {0x02e0, 0x02e4}, {0x0388, 0x038a}, {0x038e, 0x03a1},
+ {0x03a3, 0x03ce}, {0x03d0, 0x03d6}, {0x03e2, 0x03f3}, {0x0401, 0x040c},
+ {0x040e, 0x044f}, {0x0451, 0x045c}, {0x045e, 0x0481}, {0x0490, 0x04c4},
+ {0x04d0, 0x04eb}, {0x04ee, 0x04f5}, {0x0531, 0x0556}, {0x0561, 0x0587},
+ {0x05d0, 0x05ea}, {0x05f0, 0x05f2}, {0x0621, 0x063a}, {0x0640, 0x064a},
+ {0x0671, 0x06b7}, {0x06ba, 0x06be}, {0x06c0, 0x06ce}, {0x06d0, 0x06d3},
+ {0x0905, 0x0939}, {0x0958, 0x0961}, {0x0985, 0x098c}, {0x0993, 0x09a8},
+ {0x09aa, 0x09b0}, {0x09b6, 0x09b9}, {0x09df, 0x09e1}, {0x0a05, 0x0a0a},
+ {0x0a13, 0x0a28}, {0x0a2a, 0x0a30}, {0x0a59, 0x0a5c}, {0x0a72, 0x0a74},
+ {0x0a85, 0x0a8b}, {0x0a8f, 0x0a91}, {0x0a93, 0x0aa8}, {0x0aaa, 0x0ab0},
+ {0x0ab5, 0x0ab9}, {0x0b05, 0x0b0c}, {0x0b13, 0x0b28}, {0x0b2a, 0x0b30},
+ {0x0b36, 0x0b39}, {0x0b5f, 0x0b61}, {0x0b85, 0x0b8a}, {0x0b8e, 0x0b90},
+ {0x0b92, 0x0b95}, {0x0ba8, 0x0baa}, {0x0bae, 0x0bb5}, {0x0bb7, 0x0bb9},
+ {0x0c05, 0x0c0c}, {0x0c0e, 0x0c10}, {0x0c12, 0x0c28}, {0x0c2a, 0x0c33},
+ {0x0c35, 0x0c39}, {0x0c85, 0x0c8c}, {0x0c8e, 0x0c90}, {0x0c92, 0x0ca8},
+ {0x0caa, 0x0cb3}, {0x0cb5, 0x0cb9}, {0x0d05, 0x0d0c}, {0x0d0e, 0x0d10},
+ {0x0d12, 0x0d28}, {0x0d2a, 0x0d39}, {0x0e01, 0x0e30}, {0x0e40, 0x0e46},
+ {0x0e94, 0x0e97}, {0x0e99, 0x0e9f}, {0x0ea1, 0x0ea3}, {0x0ead, 0x0eb0},
+ {0x0ec0, 0x0ec4}, {0x0f40, 0x0f47}, {0x0f49, 0x0f69}, {0x0f88, 0x0f8b},
+ {0x10a0, 0x10c5}, {0x10d0, 0x10f6}, {0x1100, 0x1159}, {0x115f, 0x11a2},
+ {0x11a8, 0x11f9}, {0x1e00, 0x1e9b}, {0x1ea0, 0x1ef9}, {0x1f00, 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}, {0x210a, 0x2113}, {0x2118, 0x211d},
+ {0x212a, 0x2131}, {0x2133, 0x2138}, {0x3031, 0x3035}, {0x3041, 0x3094},
+ {0x30a1, 0x30fa}, {0x30fc, 0x30fe}, {0x3105, 0x312c}, {0x3131, 0x318e},
+ {0x4e00, 0x9fa5}, {0xac00, 0xd7a3}, {0xf900, 0xfa2d}, {0xfb00, 0xfb06},
+ {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c},
+ {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
+ {0xfdf0, 0xfdfb}, {0xfe70, 0xfe72}, {0xfe76, 0xfefc}, {0xff21, 0xff3a},
+ {0xff41, 0xff5a}, {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
+ {0xffd2, 0xffd7}, {0xffda, 0xffdc}
+};
+
+#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))
+
+static chr alphaCharTable[] = {
+ 0x00aa, 0x00b5, 0x00ba, 0x02d0, 0x02d1, 0x037a, 0x0386, 0x038c, 0x03da,
+ 0x03dc, 0x03de, 0x03e0, 0x04c7, 0x04c8, 0x04cb, 0x04cc, 0x04f8, 0x04f9,
+ 0x0559, 0x06d5, 0x06e5, 0x06e6, 0x093d, 0x0950, 0x098f, 0x0990, 0x09b2,
+ 0x09dc, 0x09dd, 0x09f0, 0x09f1, 0x0a0f, 0x0a10, 0x0a32, 0x0a33, 0x0a35,
+ 0x0a36, 0x0a38, 0x0a39, 0x0a5e, 0x0a8d, 0x0ab2, 0x0ab3, 0x0abd, 0x0ad0,
+ 0x0ae0, 0x0b0f, 0x0b10, 0x0b32, 0x0b33, 0x0b3d, 0x0b5c, 0x0b5d, 0x0b99,
+ 0x0b9a, 0x0b9c, 0x0b9e, 0x0b9f, 0x0ba3, 0x0ba4, 0x0c60, 0x0c61, 0x0cde,
+ 0x0ce0, 0x0ce1, 0x0d60, 0x0d61, 0x0e32, 0x0e33, 0x0e81, 0x0e82, 0x0e84,
+ 0x0e87, 0x0e88, 0x0e8a, 0x0e8d, 0x0ea5, 0x0ea7, 0x0eaa, 0x0eab, 0x0eb2,
+ 0x0eb3, 0x0ebd, 0x0ec6, 0x0edc, 0x0edd, 0x0f00, 0x1f59, 0x1f5b, 0x1f5d,
+ 0x1fbe, 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x3005,
+ 0x3006, 0x309d, 0x309e, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfe74
+};
+
+#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))
+
+/* Unicode: (Decimal digit) */
+
+static crange digitRangeTable[] = {
+ {0x0030, 0x0039}, {0x0660, 0x0669}, {0x06f0, 0x06f9}, {0x0966, 0x096f},
+ {0x09e6, 0x09ef}, {0x0a66, 0x0a6f}, {0x0ae6, 0x0aef}, {0x0b66, 0x0b6f},
+ {0x0be7, 0x0bef}, {0x0c66, 0x0c6f}, {0x0ce6, 0x0cef}, {0x0d66, 0x0d6f},
+ {0x0e50, 0x0e59}, {0x0ed0, 0x0ed9}, {0x0f20, 0x0f29}, {0xff10, 0xff19}
+};
+
+#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))
+
+/* Unicode: (Punctuation) */
+
+static crange punctRangeTable[] = {
+ {0x0021, 0x0023}, {0x0025, 0x002a}, {0x002c, 0x002f}, {0x005b, 0x005d},
+ {0x055a, 0x055f}, {0x066a, 0x066d}, {0x0f04, 0x0f12}, {0x0f3a, 0x0f3d},
+ {0x2010, 0x2027}, {0x2030, 0x2043}, {0x3001, 0x3003}, {0x3008, 0x3011},
+ {0x3014, 0x301f}, {0xfe30, 0xfe44}, {0xfe49, 0xfe52}, {0xfe54, 0xfe61},
+ {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
+ {0xff61, 0xff65}
+};
+
+#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))
+
+static chr punctCharTable[] = {
+ 0x003a, 0x003b, 0x003f, 0x0040, 0x005f, 0x007b, 0x007d, 0x00a1, 0x00ab,
+ 0x00ad, 0x00b7, 0x00bb, 0x00bf, 0x037e, 0x0387, 0x0589, 0x05be, 0x05c0,
+ 0x05c3, 0x05f3, 0x05f4, 0x060c, 0x061b, 0x061f, 0x06d4, 0x0964, 0x0965,
+ 0x0970, 0x0e5a, 0x0e5b, 0x0f85, 0x10fb, 0x2045, 0x2046, 0x207d, 0x207e,
+ 0x208d, 0x208e, 0x2329, 0x232a, 0x3030, 0x30fb, 0xfd3e, 0xfd3f, 0xfe63,
+ 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b,
+ 0xff5d
+};
+
+#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))
+
+/* Unicode: (White space) */
+
+static crange spaceRangeTable[] = {
+ {0x0009, 0x000d}, {0x2000, 0x200b},
+};
+
+#define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))
+
+static chr spaceCharTable[] = {
+ 0x0020, 0x00a0, 0x2028, 0x2029, 0x3000
+};
+
+#define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr))
+
+/* Unicode: lowercase characters */
+
+static crange lowerRangeTable[] = {
+ {0x0061, 0x007a}, {0x00df, 0x00f6}, {0x00f8, 0x00ff}, {0x017e, 0x0180},
+ {0x0199, 0x019b}, {0x0250, 0x02a8}, {0x03ac, 0x03ce}, {0x03ef, 0x03f2},
+ {0x0430, 0x044f}, {0x0451, 0x045c}, {0x0561, 0x0587}, {0x10d0, 0x10f6},
+ {0x1e95, 0x1e9b}, {0x1f00, 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}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
+};
+
+#define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange))
+
+static chr lowerCharTable[] = {
+ 0x00aa, 0x00b5, 0x00ba, 0x0101, 0x0103, 0x0105, 0x0107, 0x0109, 0x010b,
+ 0x010d, 0x010f, 0x0111, 0x0113, 0x0115, 0x0117, 0x0119, 0x011b, 0x011d,
+ 0x011f, 0x0121, 0x0123, 0x0125, 0x0127, 0x0129, 0x012b, 0x012d, 0x012f,
+ 0x0131, 0x0133, 0x0135, 0x0137, 0x0138, 0x013a, 0x013c, 0x013e, 0x0140,
+ 0x0142, 0x0144, 0x0146, 0x0148, 0x0149, 0x014b, 0x014d, 0x014f, 0x0151,
+ 0x0153, 0x0155, 0x0157, 0x0159, 0x015b, 0x015d, 0x015f, 0x0161, 0x0163,
+ 0x0165, 0x0167, 0x0169, 0x016b, 0x016d, 0x016f, 0x0171, 0x0173, 0x0175,
+ 0x0177, 0x017a, 0x017c, 0x0183, 0x0185, 0x0188, 0x018c, 0x018d, 0x0192,
+ 0x0195, 0x019e, 0x01a1, 0x01a3, 0x01a5, 0x01a8, 0x01ab, 0x01ad, 0x01b0,
+ 0x01b4, 0x01b6, 0x01b9, 0x01ba, 0x01bd, 0x01c6, 0x01c9, 0x01cc, 0x01ce,
+ 0x01d0, 0x01d2, 0x01d4, 0x01d6, 0x01d8, 0x01da, 0x01dc, 0x01dd, 0x01df,
+ 0x01e1, 0x01e3, 0x01e5, 0x01e7, 0x01e9, 0x01eb, 0x01ed, 0x01ef, 0x01f0,
+ 0x01f3, 0x01f5, 0x01fb, 0x01fd, 0x01ff, 0x0201, 0x0203, 0x0205, 0x0207,
+ 0x0209, 0x020b, 0x020d, 0x020f, 0x0211, 0x0213, 0x0215, 0x0217, 0x0390,
+ 0x03d0, 0x03d1, 0x03d5, 0x03d6, 0x03e3, 0x03e5, 0x03e7, 0x03e9, 0x03eb,
+ 0x03ed, 0x045e, 0x045f, 0x0461, 0x0463, 0x0465, 0x0467, 0x0469, 0x046b,
+ 0x046d, 0x046f, 0x0471, 0x0473, 0x0475, 0x0477, 0x0479, 0x047b, 0x047d,
+ 0x047f, 0x0481, 0x0491, 0x0493, 0x0495, 0x0497, 0x0499, 0x049b, 0x049d,
+ 0x049f, 0x04a1, 0x04a3, 0x04a5, 0x04a7, 0x04a9, 0x04ab, 0x04ad, 0x04af,
+ 0x04b1, 0x04b3, 0x04b5, 0x04b7, 0x04b9, 0x04bb, 0x04bd, 0x04bf, 0x04c2,
+ 0x04c4, 0x04c8, 0x04cc, 0x04d1, 0x04d3, 0x04d5, 0x04d7, 0x04d9, 0x04db,
+ 0x04dd, 0x04df, 0x04e1, 0x04e3, 0x04e5, 0x04e7, 0x04e9, 0x04eb, 0x04ef,
+ 0x04f1, 0x04f3, 0x04f5, 0x04f9, 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, 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, 0x1fb6, 0x1fb7, 0x1fbe,
+ 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, 0x1ff7, 0x207f, 0x210a, 0x210e,
+ 0x210f, 0x2113, 0x2118, 0x212e, 0x212f, 0x2134
+};
+
+#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))
+
+/* Unicode: uppercase characters */
+
+static crange upperRangeTable[] = {
+ {0x0041, 0x005a}, {0x00c0, 0x00d6}, {0x00d8, 0x00de}, {0x0189, 0x018b},
+ {0x018e, 0x0191}, {0x0196, 0x0198}, {0x01b1, 0x01b3}, {0x0388, 0x038a},
+ {0x0391, 0x03a1}, {0x03a3, 0x03ab}, {0x03d2, 0x03d4}, {0x0401, 0x040c},
+ {0x040e, 0x042f}, {0x0531, 0x0556}, {0x10a0, 0x10c5}, {0x1f08, 0x1f0f},
+ {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
+ {0x1f68, 0x1f6f}, {0x1f88, 0x1f8f}, {0x1f98, 0x1f9f}, {0x1fa8, 0x1faf},
+ {0x1fb8, 0x1fbc}, {0x1fc8, 0x1fcc}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec},
+ {0x1ff8, 0x1ffc}, {0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d},
+ {0x212a, 0x212d}, {0xff21, 0xff3a}
+};
+
+#define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange))
+
+static chr upperCharTable[] = {
+ 0x0100, 0x0102, 0x0104, 0x0106, 0x0108, 0x010a, 0x010c, 0x010e, 0x0110,
+ 0x0112, 0x0114, 0x0116, 0x0118, 0x011a, 0x011c, 0x011e, 0x0120, 0x0122,
+ 0x0124, 0x0126, 0x0128, 0x012a, 0x012c, 0x012e, 0x0130, 0x0132, 0x0134,
+ 0x0136, 0x0139, 0x013b, 0x013d, 0x013f, 0x0141, 0x0143, 0x0145, 0x0147,
+ 0x014a, 0x014c, 0x014e, 0x0150, 0x0152, 0x0154, 0x0156, 0x0158, 0x015a,
+ 0x015c, 0x015e, 0x0160, 0x0162, 0x0164, 0x0166, 0x0168, 0x016a, 0x016c,
+ 0x016e, 0x0170, 0x0172, 0x0174, 0x0176, 0x0178, 0x0179, 0x017b, 0x017d,
+ 0x0181, 0x0182, 0x0184, 0x0186, 0x0187, 0x0193, 0x0194, 0x019c, 0x019d,
+ 0x019f, 0x01a0, 0x01a2, 0x01a4, 0x01a6, 0x01a7, 0x01a9, 0x01ac, 0x01ae,
+ 0x01af, 0x01b5, 0x01b7, 0x01b8, 0x01bc, 0x01c4, 0x01c7, 0x01ca, 0x01cd,
+ 0x01cf, 0x01d1, 0x01d3, 0x01d5, 0x01d7, 0x01d9, 0x01db, 0x01de, 0x01e0,
+ 0x01e2, 0x01e4, 0x01e6, 0x01e8, 0x01ea, 0x01ec, 0x01ee, 0x01f1, 0x01f4,
+ 0x01fa, 0x01fc, 0x01fe, 0x0200, 0x0202, 0x0204, 0x0206, 0x0208, 0x020a,
+ 0x020c, 0x020e, 0x0210, 0x0212, 0x0214, 0x0216, 0x0386, 0x038c, 0x038e,
+ 0x038f, 0x03da, 0x03dc, 0x03de, 0x03e0, 0x03e2, 0x03e4, 0x03e6, 0x03e8,
+ 0x03ea, 0x03ec, 0x03ee, 0x0460, 0x0462, 0x0464, 0x0466, 0x0468, 0x046a,
+ 0x046c, 0x046e, 0x0470, 0x0472, 0x0474, 0x0476, 0x0478, 0x047a, 0x047c,
+ 0x047e, 0x0480, 0x0490, 0x0492, 0x0494, 0x0496, 0x0498, 0x049a, 0x049c,
+ 0x049e, 0x04a0, 0x04a2, 0x04a4, 0x04a6, 0x04a8, 0x04aa, 0x04ac, 0x04ae,
+ 0x04b0, 0x04b2, 0x04b4, 0x04b6, 0x04b8, 0x04ba, 0x04bc, 0x04be, 0x04c1,
+ 0x04c3, 0x04c7, 0x04cb, 0x04d0, 0x04d2, 0x04d4, 0x04d6, 0x04d8, 0x04da,
+ 0x04dc, 0x04de, 0x04e0, 0x04e2, 0x04e4, 0x04e6, 0x04e8, 0x04ea, 0x04ee,
+ 0x04f0, 0x04f2, 0x04f4, 0x04f8, 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, 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, 0x1f59, 0x1f5b,
+ 0x1f5d, 0x1f5f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x2130,
+ 0x2131, 0x2133
+};
+
+#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))
+
+/*
+ * The graph table includes the set of characters that are Unicode
+ * print characters excluding space.
+ */
+
+static crange graphRangeTable[] = {
+ {0x0021, 0x007e}, {0x00a0, 0x011f}, {0x0121, 0x01f5}, {0x01fa, 0x0217},
+ {0x0250, 0x02a8}, {0x02b0, 0x02de}, {0x02e0, 0x02e9}, {0x0300, 0x031f},
+ {0x0321, 0x0345}, {0x0384, 0x038a}, {0x038e, 0x03a1}, {0x03a3, 0x03ce},
+ {0x03d0, 0x03d6}, {0x03e2, 0x03f3}, {0x0401, 0x040c}, {0x040e, 0x041f},
+ {0x0421, 0x044f}, {0x0451, 0x045c}, {0x045e, 0x0486}, {0x0490, 0x04c4},
+ {0x04d0, 0x04eb}, {0x04ee, 0x04f5}, {0x0531, 0x0556}, {0x0559, 0x055f},
+ {0x0561, 0x0587}, {0x0591, 0x05a1}, {0x05a3, 0x05b9}, {0x05bb, 0x05c4},
+ {0x05d0, 0x05ea}, {0x05f0, 0x05f4}, {0x0621, 0x063a}, {0x0640, 0x0652},
+ {0x0660, 0x066d}, {0x0670, 0x06b7}, {0x06ba, 0x06be}, {0x06c0, 0x06ce},
+ {0x06d0, 0x06ed}, {0x06f0, 0x06f9}, {0x0901, 0x0903}, {0x0905, 0x091f},
+ {0x0921, 0x0939}, {0x093c, 0x094d}, {0x0950, 0x0954}, {0x0958, 0x0970},
+ {0x0981, 0x0983}, {0x0985, 0x098c}, {0x0993, 0x09a8}, {0x09aa, 0x09b0},
+ {0x09b6, 0x09b9}, {0x09be, 0x09c4}, {0x09cb, 0x09cd}, {0x09df, 0x09e3},
+ {0x09e6, 0x09fa}, {0x0a05, 0x0a0a}, {0x0a13, 0x0a1f}, {0x0a21, 0x0a28},
+ {0x0a2a, 0x0a30}, {0x0a3e, 0x0a42}, {0x0a4b, 0x0a4d}, {0x0a59, 0x0a5c},
+ {0x0a66, 0x0a74}, {0x0a81, 0x0a83}, {0x0a85, 0x0a8b}, {0x0a8f, 0x0a91},
+ {0x0a93, 0x0aa8}, {0x0aaa, 0x0ab0}, {0x0ab5, 0x0ab9}, {0x0abc, 0x0ac5},
+ {0x0ac7, 0x0ac9}, {0x0acb, 0x0acd}, {0x0ae6, 0x0aef}, {0x0b01, 0x0b03},
+ {0x0b05, 0x0b0c}, {0x0b13, 0x0b1f}, {0x0b21, 0x0b28}, {0x0b2a, 0x0b30},
+ {0x0b36, 0x0b39}, {0x0b3c, 0x0b43}, {0x0b4b, 0x0b4d}, {0x0b5f, 0x0b61},
+ {0x0b66, 0x0b70}, {0x0b85, 0x0b8a}, {0x0b8e, 0x0b90}, {0x0b92, 0x0b95},
+ {0x0ba8, 0x0baa}, {0x0bae, 0x0bb5}, {0x0bb7, 0x0bb9}, {0x0bbe, 0x0bc2},
+ {0x0bc6, 0x0bc8}, {0x0bca, 0x0bcd}, {0x0be7, 0x0bf2}, {0x0c01, 0x0c03},
+ {0x0c05, 0x0c0c}, {0x0c0e, 0x0c10}, {0x0c12, 0x0c1f}, {0x0c21, 0x0c28},
+ {0x0c2a, 0x0c33}, {0x0c35, 0x0c39}, {0x0c3e, 0x0c44}, {0x0c46, 0x0c48},
+ {0x0c4a, 0x0c4d}, {0x0c66, 0x0c6f}, {0x0c85, 0x0c8c}, {0x0c8e, 0x0c90},
+ {0x0c92, 0x0ca8}, {0x0caa, 0x0cb3}, {0x0cb5, 0x0cb9}, {0x0cbe, 0x0cc4},
+ {0x0cc6, 0x0cc8}, {0x0cca, 0x0ccd}, {0x0ce6, 0x0cef}, {0x0d05, 0x0d0c},
+ {0x0d0e, 0x0d10}, {0x0d12, 0x0d1f}, {0x0d21, 0x0d28}, {0x0d2a, 0x0d39},
+ {0x0d3e, 0x0d43}, {0x0d46, 0x0d48}, {0x0d4a, 0x0d4d}, {0x0d66, 0x0d6f},
+ {0x0e01, 0x0e1f}, {0x0e21, 0x0e3a}, {0x0e3f, 0x0e5b}, {0x0e94, 0x0e97},
+ {0x0e99, 0x0e9f}, {0x0ea1, 0x0ea3}, {0x0ead, 0x0eb9}, {0x0ebb, 0x0ebd},
+ {0x0ec0, 0x0ec4}, {0x0ec8, 0x0ecd}, {0x0ed0, 0x0ed9}, {0x0f00, 0x0f1f},
+ {0x0f21, 0x0f47}, {0x0f49, 0x0f69}, {0x0f71, 0x0f8b}, {0x0f90, 0x0f95},
+ {0x0f99, 0x0fad}, {0x0fb1, 0x0fb7}, {0x10a0, 0x10c5}, {0x10d0, 0x10f6},
+ {0x1100, 0x111f}, {0x1121, 0x1159}, {0x115f, 0x11a2}, {0x11a8, 0x11f9},
+ {0x1e00, 0x1e1f}, {0x1e21, 0x1e9b}, {0x1ea0, 0x1ef9}, {0x1f00, 0x1f15},
+ {0x1f18, 0x1f1d}, {0x1f21, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
+ {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3},
+ {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe},
+ {0x2000, 0x200b}, {0x2010, 0x201f}, {0x2021, 0x2029}, {0x2030, 0x2046},
+ {0x2074, 0x208e}, {0x20a0, 0x20ac}, {0x20d0, 0x20e1}, {0x2100, 0x211f},
+ {0x2121, 0x2138}, {0x2153, 0x2182}, {0x2190, 0x21ea}, {0x2200, 0x221f},
+ {0x2221, 0x22f1}, {0x2302, 0x231f}, {0x2321, 0x237a}, {0x2400, 0x241f},
+ {0x2421, 0x2424}, {0x2440, 0x244a}, {0x2460, 0x24ea}, {0x2500, 0x251f},
+ {0x2521, 0x2595}, {0x25a0, 0x25ef}, {0x2600, 0x2613}, {0x261a, 0x261f},
+ {0x2621, 0x266f}, {0x2701, 0x2704}, {0x2706, 0x2709}, {0x270c, 0x271f},
+ {0x2721, 0x2727}, {0x2729, 0x274b}, {0x274f, 0x2752}, {0x2758, 0x275e},
+ {0x2761, 0x2767}, {0x2776, 0x2794}, {0x2798, 0x27af}, {0x27b1, 0x27be},
+ {0x3000, 0x301f}, {0x3021, 0x3037}, {0x3041, 0x3094}, {0x3099, 0x309e},
+ {0x30a1, 0x30fe}, {0x3105, 0x311f}, {0x3121, 0x312c}, {0x3131, 0x318e},
+ {0x3190, 0x319f}, {0x3200, 0x321c}, {0x3221, 0x3243}, {0x3260, 0x327b},
+ {0x327f, 0x32b0}, {0x32c0, 0x32cb}, {0x32d0, 0x32fe}, {0x3300, 0x331f},
+ {0x3321, 0x3376}, {0x337b, 0x33dd}, {0x33e0, 0x33fe}, {0x4e00, 0x4e1f},
+ {0x4e21, 0x4f1f}, {0x4f21, 0x501f}, {0x5021, 0x511f}, {0x5121, 0x521f},
+ {0x5221, 0x531f}, {0x5321, 0x541f}, {0x5421, 0x551f}, {0x5521, 0x561f},
+ {0x5621, 0x571f}, {0x5721, 0x581f}, {0x5821, 0x591f}, {0x5921, 0x5a1f},
+ {0x5a21, 0x5b1f}, {0x5b21, 0x5c1f}, {0x5c21, 0x5d1f}, {0x5d21, 0x5e1f},
+ {0x5e21, 0x5f1f}, {0x5f21, 0x601f}, {0x6021, 0x611f}, {0x6121, 0x621f},
+ {0x6221, 0x631f}, {0x6321, 0x641f}, {0x6421, 0x651f}, {0x6521, 0x661f},
+ {0x6621, 0x671f}, {0x6721, 0x681f}, {0x6821, 0x691f}, {0x6921, 0x6a1f},
+ {0x6a21, 0x6b1f}, {0x6b21, 0x6c1f}, {0x6c21, 0x6d1f}, {0x6d21, 0x6e1f},
+ {0x6e21, 0x6f1f}, {0x6f21, 0x701f}, {0x7021, 0x711f}, {0x7121, 0x721f},
+ {0x7221, 0x731f}, {0x7321, 0x741f}, {0x7421, 0x751f}, {0x7521, 0x761f},
+ {0x7621, 0x771f}, {0x7721, 0x781f}, {0x7821, 0x791f}, {0x7921, 0x7a1f},
+ {0x7a21, 0x7b1f}, {0x7b21, 0x7c1f}, {0x7c21, 0x7d1f}, {0x7d21, 0x7e1f},
+ {0x7e21, 0x7f1f}, {0x7f21, 0x801f}, {0x8021, 0x811f}, {0x8121, 0x821f},
+ {0x8221, 0x831f}, {0x8321, 0x841f}, {0x8421, 0x851f}, {0x8521, 0x861f},
+ {0x8621, 0x871f}, {0x8721, 0x881f}, {0x8821, 0x891f}, {0x8921, 0x8a1f},
+ {0x8a21, 0x8b1f}, {0x8b21, 0x8c1f}, {0x8c21, 0x8d1f}, {0x8d21, 0x8e1f},
+ {0x8e21, 0x8f1f}, {0x8f21, 0x901f}, {0x9021, 0x911f}, {0x9121, 0x921f},
+ {0x9221, 0x931f}, {0x9321, 0x941f}, {0x9421, 0x951f}, {0x9521, 0x961f},
+ {0x9621, 0x971f}, {0x9721, 0x981f}, {0x9821, 0x991f}, {0x9921, 0x9a1f},
+ {0x9a21, 0x9b1f}, {0x9b21, 0x9c1f}, {0x9c21, 0x9d1f}, {0x9d21, 0x9e1f},
+ {0x9e21, 0x9f1f}, {0x9f21, 0x9fa5}, {0xac00, 0xac1f}, {0xac21, 0xad1f},
+ {0xad21, 0xae1f}, {0xae21, 0xaf1f}, {0xaf21, 0xb01f}, {0xb021, 0xb11f},
+ {0xb121, 0xb21f}, {0xb221, 0xb31f}, {0xb321, 0xb41f}, {0xb421, 0xb51f},
+ {0xb521, 0xb61f}, {0xb621, 0xb71f}, {0xb721, 0xb81f}, {0xb821, 0xb91f},
+ {0xb921, 0xba1f}, {0xba21, 0xbb1f}, {0xbb21, 0xbc1f}, {0xbc21, 0xbd1f},
+ {0xbd21, 0xbe1f}, {0xbe21, 0xbf1f}, {0xbf21, 0xc01f}, {0xc021, 0xc11f},
+ {0xc121, 0xc21f}, {0xc221, 0xc31f}, {0xc321, 0xc41f}, {0xc421, 0xc51f},
+ {0xc521, 0xc61f}, {0xc621, 0xc71f}, {0xc721, 0xc81f}, {0xc821, 0xc91f},
+ {0xc921, 0xca1f}, {0xca21, 0xcb1f}, {0xcb21, 0xcc1f}, {0xcc21, 0xcd1f},
+ {0xcd21, 0xce1f}, {0xce21, 0xcf1f}, {0xcf21, 0xd01f}, {0xd021, 0xd11f},
+ {0xd121, 0xd21f}, {0xd221, 0xd31f}, {0xd321, 0xd41f}, {0xd421, 0xd51f},
+ {0xd521, 0xd61f}, {0xd621, 0xd71f}, {0xd721, 0xd7a3}, {0xf900, 0xf91f},
+ {0xf921, 0xfa1f}, {0xfa21, 0xfa2d}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
+ {0xfb21, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfc1f},
+ {0xfc21, 0xfd1f}, {0xfd21, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
+ {0xfdf0, 0xfdfb}, {0xfe21, 0xfe23}, {0xfe30, 0xfe44}, {0xfe49, 0xfe52},
+ {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe72}, {0xfe76, 0xfefc},
+ {0xff01, 0xff1f}, {0xff21, 0xff5e}, {0xff61, 0xffbe}, {0xffc2, 0xffc7},
+ {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6},
+ {0xffe8, 0xffee}
+};
+
+#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
+
+static chr graphCharTable[] = {
+ 0x0360, 0x0361, 0x0374, 0x0375, 0x037a, 0x037e, 0x038c, 0x03da, 0x03dc,
+ 0x03de, 0x03e0, 0x04c7, 0x04c8, 0x04cb, 0x04cc, 0x04f8, 0x04f9, 0x0589,
+ 0x060c, 0x061b, 0x061f, 0x098f, 0x0990, 0x09b2, 0x09bc, 0x09c7, 0x09c8,
+ 0x09d7, 0x09dc, 0x09dd, 0x0a02, 0x0a0f, 0x0a10, 0x0a32, 0x0a33, 0x0a35,
+ 0x0a36, 0x0a38, 0x0a39, 0x0a3c, 0x0a47, 0x0a48, 0x0a5e, 0x0a8d, 0x0ab2,
+ 0x0ab3, 0x0ad0, 0x0ae0, 0x0b0f, 0x0b10, 0x0b32, 0x0b33, 0x0b47, 0x0b48,
+ 0x0b56, 0x0b57, 0x0b5c, 0x0b5d, 0x0b82, 0x0b83, 0x0b99, 0x0b9a, 0x0b9c,
+ 0x0b9e, 0x0b9f, 0x0ba3, 0x0ba4, 0x0bd7, 0x0c55, 0x0c56, 0x0c60, 0x0c61,
+ 0x0c82, 0x0c83, 0x0cd5, 0x0cd6, 0x0cde, 0x0ce0, 0x0ce1, 0x0d02, 0x0d03,
+ 0x0d57, 0x0d60, 0x0d61, 0x0e81, 0x0e82, 0x0e84, 0x0e87, 0x0e88, 0x0e8a,
+ 0x0e8d, 0x0ea5, 0x0ea7, 0x0eaa, 0x0eab, 0x0ec6, 0x0edc, 0x0edd, 0x0f97,
+ 0x0fb9, 0x10fb, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2300, 0x274d, 0x2756,
+ 0x303f, 0xfb1e, 0xfb1f, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfe74,
+ 0xfffc, 0xfffd
+};
+
+#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr))
+
+
+#define CH NOCELT
+
+/*
+ - nmcces - how many distinct MCCEs are there?
+ ^ static int nmcces(struct vars *);
+ */
+static int
+nmcces(v)
+struct vars *v;
+{
+ return 0;
+}
+
+/*
+ - nleaders - how many chrs can be first chrs of MCCEs?
+ ^ static int nleaders(struct vars *);
+ */
+static int
+nleaders(v)
+struct vars *v;
+{
+ return 0;
+}
+
+/*
+ - allmcces - return a cvec with all the MCCEs of the locale
+ ^ static struct cvec *allmcces(struct vars *, struct cvec *);
+ */
+static struct cvec *
+allmcces(v, cv)
+struct vars *v;
+struct cvec *cv; /* this is supposed to have enough room */
+{
+ return clearcvec(cv);
+}
+
+/*
+ - element - map collating-element name to celt
+ ^ static celt element(struct vars *, chr *, chr *);
+ */
+static celt
+element(v, startp, endp)
+struct vars *v;
+chr *startp; /* points to start of name */
+chr *endp; /* points just past end of name */
+{
+ struct cname *cn;
+ size_t len;
+ Tcl_DString ds;
+ char *np;
+
+ /* generic: one-chr names stand for themselves */
+ assert(startp < endp);
+ len = endp - startp;
+ if (len == 1)
+ return *startp;
+
+ NOTE(REG_ULOCALE);
+
+ /* search table */
+ Tcl_DStringInit(&ds);
+ np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
+ for (cn = cnames; cn->name != NULL; cn++)
+ if (strlen(cn->name) == len && strncmp(cn->name, np, len) == 0)
+ break; /* NOTE BREAK OUT */
+ Tcl_DStringFree(&ds);
+ if (cn->name != NULL)
+ return CHR(cn->code);
+
+ /* couldn't find it */
+ ERR(REG_ECOLLATE);
+ return 0;
+}
+
+/*
+ - range - supply cvec for a range, including legality check
+ ^ static struct cvec *range(struct vars *, celt, celt, int);
+ */
+static struct cvec *
+range(v, a, b, cases)
+struct vars *v;
+celt a;
+celt b; /* might equal a */
+int cases; /* case-independent? */
+{
+ int nchrs;
+ struct cvec *cv;
+ celt c, lc, uc, tc;
+
+ if (a != b && !before(a, b)) {
+ ERR(REG_ERANGE);
+ return NULL;
+ }
+
+ if (!cases) { /* easy version */
+ cv = getcvec(v, 0, 1, 0);
+ NOERRN();
+ addrange(cv, a, b);
+ return cv;
+ }
+
+ /*
+ * When case-independent, it's hard to decide when cvec ranges are
+ * usable, so for now at least, we won't try. We allocate enough
+ * space for two case variants plus a little extra for the two
+ * title case variants.
+ */
+
+ nchrs = (b - a + 1)*2 + 4;
+
+ cv = getcvec(v, nchrs, 0, 0);
+ NOERRN();
+
+ for (c = a; c <= b; c++) {
+ addchr(cv, c);
+ lc = Tcl_UniCharToLower((chr)c);
+ uc = Tcl_UniCharToUpper((chr)c);
+ tc = Tcl_UniCharToTitle((chr)c);
+ if (c != lc) {
+ addchr(cv, lc);
+ }
+ if (c != uc) {
+ addchr(cv, uc);
+ }
+ if (c != tc && tc != uc) {
+ addchr(cv, tc);
+ }
+ }
+
+ return cv;
+}
+
+/*
+ - before - is celt x before celt y, for purposes of range legality?
+ ^ static int before(celt, celt);
+ */
+static int /* predicate */
+before(x, y)
+celt x;
+celt y;
+{
+ /* trivial because no MCCEs */
+ if (x < y)
+ return 1;
+ return 0;
+}
+
+/*
+ - eclass - supply cvec for an equivalence class
+ * Must include case counterparts on request.
+ ^ static struct cvec *eclass(struct vars *, celt, int);
+ */
+static struct cvec *
+eclass(v, c, cases)
+struct vars *v;
+celt c;
+int cases; /* all cases? */
+{
+ struct cvec *cv;
+
+ /* crude fake equivalence class for testing */
+ if ((v->cflags&REG_FAKE) && c == 'x') {
+ cv = getcvec(v, 4, 0, 0);
+ addchr(cv, (chr)'x');
+ addchr(cv, (chr)'y');
+ if (cases) {
+ addchr(cv, (chr)'X');
+ addchr(cv, (chr)'Y');
+ }
+ return cv;
+ }
+
+ /* otherwise, none */
+ if (cases)
+ return allcases(v, c);
+ cv = getcvec(v, 1, 0, 0);
+ assert(cv != NULL);
+ addchr(cv, (chr)c);
+ return cv;
+}
+
+/*
+ - cclass - supply cvec for a character class
+ * Must include case counterparts on request.
+ ^ static struct cvec *cclass(struct vars *, chr *, chr *, int);
+ */
+static struct cvec *
+cclass(v, startp, endp, cases)
+struct vars *v;
+chr *startp; /* where the name starts */
+chr *endp; /* just past the end of the name */
+int cases; /* case-independent? */
+{
+ size_t len;
+ struct cvec *cv = NULL;
+ Tcl_DString ds;
+ char *np, **namePtr;
+ int i, index;
+
+ /*
+ * The following arrays define the valid character class names.
+ */
+
+ static char *classNames[] = {
+ "alnum", "alpha", "ascii", "blank", "cntrl", "digit", "graph",
+ "lower", "print", "punct", "space", "upper", "xdigit", NULL
+ };
+
+ enum classes {
+ CC_ALNUM, CC_ALPHA, CC_ASCII, CC_BLANK, CC_CNTRL, CC_DIGIT, CC_GRAPH,
+ CC_LOWER, CC_PRINT, CC_PUNCT, CC_SPACE, CC_UPPER, CC_XDIGIT
+ };
+
+
+ /*
+ * Extract the class name
+ */
+
+ len = endp - startp;
+ Tcl_DStringInit(&ds);
+ np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
+
+ /*
+ * Remap lower and upper to alpha if the match is case insensitive.
+ */
+
+ if (cases && len == 5 && (strncmp("lower", np, 5) == 0
+ || strncmp("upper", np, 5) == 0)) {
+ np = "alpha";
+ }
+
+ /*
+ * Map the name to the corresponding enumerated value.
+ */
+
+ index = -1;
+ for (namePtr = classNames, i = 0; *namePtr != NULL; namePtr++, i++) {
+ if ((strlen(*namePtr) == len) && (strncmp(*namePtr, np, len) == 0)) {
+ index = i;
+ break;
+ }
+ }
+ Tcl_DStringInit(&ds);
+ if (index == -1) {
+ ERR(REG_ECTYPE);
+ return NULL;
+ }
+
+ /*
+ * Now compute the character class contents.
+ */
+
+ switch((enum classes) index) {
+ case CC_PRINT:
+ case CC_ALNUM:
+ cv = getcvec(v, NUM_ALPHA_CHAR,
+ NUM_DIGIT_RANGE + NUM_ALPHA_RANGE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_ALPHA_CHAR; i++) {
+ addchr(cv, alphaCharTable[i]);
+ }
+ for (i = 0; i < NUM_ALPHA_RANGE; i++) {
+ addrange(cv, alphaRangeTable[i].start,
+ alphaRangeTable[i].end);
+ }
+ for (i = 0; i < NUM_DIGIT_RANGE; i++) {
+ addrange(cv, digitRangeTable[i].start,
+ digitRangeTable[i].end);
+ }
+ }
+ break;
+ case CC_ALPHA:
+ cv = getcvec(v, NUM_ALPHA_CHAR, NUM_ALPHA_RANGE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_ALPHA_RANGE; i++) {
+ addrange(cv, alphaRangeTable[i].start,
+ alphaRangeTable[i].end);
+ }
+ for (i = 0; i < NUM_ALPHA_CHAR; i++) {
+ addchr(cv, alphaCharTable[i]);
+ }
+ }
+ break;
+ case CC_ASCII:
+ cv = getcvec(v, 0, 1, 0);
+ if (cv) {
+ addrange(cv, 0, 0x7f);
+ }
+ break;
+ case CC_BLANK:
+ cv = getcvec(v, 2, 0, 0);
+ addchr(cv, '\t');
+ addchr(cv, ' ');
+ break;
+ case CC_CNTRL:
+ cv = getcvec(v, 0, 2, 0);
+ addrange(cv, 0x0, 0x1f);
+ addrange(cv, 0x7f, 0x9f);
+ break;
+ case CC_DIGIT:
+ cv = getcvec(v, 0, NUM_DIGIT_RANGE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_DIGIT_RANGE; i++) {
+ addrange(cv, digitRangeTable[i].start,
+ digitRangeTable[i].end);
+ }
+ }
+ break;
+ case CC_PUNCT:
+ cv = getcvec(v, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_PUNCT_RANGE; i++) {
+ addrange(cv, punctRangeTable[i].start,
+ punctRangeTable[i].end);
+ }
+ for (i = 0; i < NUM_PUNCT_CHAR; i++) {
+ addchr(cv, punctCharTable[i]);
+ }
+ }
+ break;
+ case CC_XDIGIT:
+ cv = getcvec(v, 0, NUM_DIGIT_RANGE+2, 0);
+ if (cv) {
+ addrange(cv, '0', '9');
+ addrange(cv, 'a', 'f');
+ addrange(cv, 'A', 'F');
+ }
+ break;
+ case CC_SPACE:
+ cv = getcvec(v, NUM_SPACE_CHAR, NUM_SPACE_RANGE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_SPACE_RANGE; i++) {
+ addrange(cv, spaceRangeTable[i].start,
+ spaceRangeTable[i].end);
+ }
+ for (i = 0; i < NUM_SPACE_CHAR; i++) {
+ addchr(cv, spaceCharTable[i]);
+ }
+ }
+ break;
+ case CC_LOWER:
+ cv = getcvec(v, NUM_LOWER_CHAR, NUM_LOWER_RANGE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_LOWER_RANGE; i++) {
+ addrange(cv, lowerRangeTable[i].start,
+ lowerRangeTable[i].end);
+ }
+ for (i = 0; i < NUM_LOWER_CHAR; i++) {
+ addchr(cv, lowerCharTable[i]);
+ }
+ }
+ break;
+ case CC_UPPER:
+ cv = getcvec(v, NUM_UPPER_CHAR, NUM_UPPER_RANGE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_UPPER_RANGE; i++) {
+ addrange(cv, upperRangeTable[i].start,
+ upperRangeTable[i].end);
+ }
+ for (i = 0; i < NUM_UPPER_CHAR; i++) {
+ addchr(cv, upperCharTable[i]);
+ }
+ }
+ break;
+ case CC_GRAPH:
+ cv = getcvec(v, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_GRAPH_RANGE; i++) {
+ addrange(cv, graphRangeTable[i].start,
+ graphRangeTable[i].end);
+ }
+ for (i = 0; i < NUM_GRAPH_CHAR; i++) {
+ addchr(cv, graphCharTable[i]);
+ }
+ }
+ break;
+ }
+ if (cv == NULL) {
+ ERR(REG_ESPACE);
+ }
+ return cv;
+}
+
+/*
+ - allcases - supply cvec for all case counterparts of a chr (including itself)
+ * This is a shortcut, preferably an efficient one, for simple characters;
+ * messy cases are done via range().
+ ^ static struct cvec *allcases(struct vars *, pchr);
+ */
+static struct cvec *
+allcases(v, pc)
+struct vars *v;
+pchr pc;
+{
+ struct cvec *cv;
+ chr c = (chr)pc;
+ chr lc, uc, tc;
+
+ lc = Tcl_UniCharToLower((chr)c);
+ uc = Tcl_UniCharToUpper((chr)c);
+ tc = Tcl_UniCharToTitle((chr)c);
+
+ if (tc != uc) {
+ cv = getcvec(v, 3, 0, 0);
+ addchr(cv, tc);
+ } else {
+ cv = getcvec(v, 2, 0, 0);
+ }
+ addchr(cv, lc);
+ if (lc != uc) {
+ addchr(cv, uc);
+ }
+ return cv;
+}
+
+/*
+ - cmp - chr-substring compare
+ * Backrefs need this. It should preferably be efficient.
+ * Note that it does not need to report anything except equal/unequal.
+ * Note also that the length is exact, and the comparison should not
+ * stop at embedded NULs!
+ ^ static int cmp(CONST chr *, CONST chr *, size_t);
+ */
+static int /* 0 for equal, nonzero for unequal */
+cmp(x, y, len)
+CONST chr *x;
+CONST chr *y;
+size_t len; /* exact length of comparison */
+{
+ return memcmp(VS(x), VS(y), len*sizeof(chr));
+}
+
+/*
+ - casecmp - case-independent chr-substring compare
+ * REG_ICASE backrefs need this. It should preferably be efficient.
+ * Note that it does not need to report anything except equal/unequal.
+ * Note also that the length is exact, and the comparison should not
+ * stop at embedded NULs!
+ ^ static int casecmp(CONST chr *, CONST chr *, size_t);
+ */
+static int /* 0 for equal, nonzero for unequal */
+casecmp(x, y, len)
+CONST chr *x;
+CONST chr *y;
+size_t len; /* exact length of comparison */
+{
+ size_t i;
+ CONST chr *xp;
+ CONST chr *yp;
+
+ for (xp = x, yp = y, i = len; i > 0; i--)
+ if (Tcl_UniCharToLower(*xp++) != Tcl_UniCharToLower(*yp++))
+ return 1;
+ return 0;
+}
diff --git a/tcl/generic/regc_nfa.c b/tcl/generic/regc_nfa.c
new file mode 100644
index 00000000000..9881cd4304d
--- /dev/null
+++ b/tcl/generic/regc_nfa.c
@@ -0,0 +1,1575 @@
+/*
+ * NFA utilities.
+ * This file is #included by regcomp.c.
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *
+ *
+ * One or two things that technically ought to be in here
+ * are actually in color.c, thanks to some incestuous relationships in
+ * the color chains.
+ */
+
+#define NISERR() VISERR(nfa->v)
+#define NERR(e) VERR(nfa->v, (e))
+
+
+/*
+ - newnfa - set up an NFA
+ ^ static struct nfa *newnfa(struct vars *, struct colormap *, struct nfa *);
+ */
+static struct nfa * /* the NFA, or NULL */
+newnfa(v, cm, parent)
+struct vars *v;
+struct colormap *cm;
+struct nfa *parent; /* NULL if primary NFA */
+{
+ struct nfa *nfa;
+
+ nfa = (struct nfa *)MALLOC(sizeof(struct nfa));
+ if (nfa == NULL)
+ return NULL;
+
+ nfa->states = NULL;
+ nfa->slast = NULL;
+ nfa->free = NULL;
+ nfa->nstates = 0;
+ nfa->cm = cm;
+ nfa->v = v;
+ nfa->bos[0] = nfa->bos[1] = COLORLESS;
+ nfa->eos[0] = nfa->eos[1] = COLORLESS;
+ nfa->post = newfstate(nfa, '@'); /* number 0 */
+ nfa->pre = newfstate(nfa, '>'); /* number 1 */
+ nfa->parent = parent;
+
+ nfa->init = newstate(nfa); /* may become invalid later */
+ nfa->final = newstate(nfa);
+ if (ISERR()) {
+ freenfa(nfa);
+ return NULL;
+ }
+ rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->pre, nfa->init);
+ newarc(nfa, '^', 1, nfa->pre, nfa->init);
+ newarc(nfa, '^', 0, nfa->pre, nfa->init);
+ rainbow(nfa, nfa->cm, PLAIN, COLORLESS, nfa->final, nfa->post);
+ newarc(nfa, '$', 1, nfa->final, nfa->post);
+ newarc(nfa, '$', 0, nfa->final, nfa->post);
+
+ if (ISERR()) {
+ freenfa(nfa);
+ return NULL;
+ }
+ return nfa;
+}
+
+/*
+ - freenfa - free an entire NFA
+ ^ static VOID freenfa(struct nfa *);
+ */
+static VOID
+freenfa(nfa)
+struct nfa *nfa;
+{
+ struct state *s;
+
+ while ((s = nfa->states) != NULL) {
+ s->nins = s->nouts = 0; /* don't worry about arcs */
+ freestate(nfa, s);
+ }
+ while ((s = nfa->free) != NULL) {
+ nfa->free = s->next;
+ destroystate(nfa, s);
+ }
+
+ nfa->slast = NULL;
+ nfa->nstates = -1;
+ nfa->pre = NULL;
+ nfa->post = NULL;
+ FREE(nfa);
+}
+
+/*
+ - newstate - allocate an NFA state, with zero flag value
+ ^ static struct state *newstate(struct nfa *);
+ */
+static struct state * /* NULL on error */
+newstate(nfa)
+struct nfa *nfa;
+{
+ struct state *s;
+
+ if (nfa->free != NULL) {
+ s = nfa->free;
+ nfa->free = s->next;
+ } else {
+ s = (struct state *)MALLOC(sizeof(struct state));
+ if (s == NULL) {
+ NERR(REG_ESPACE);
+ return NULL;
+ }
+ s->oas.next = NULL;
+ s->free = NULL;
+ s->noas = 0;
+ }
+
+ assert(nfa->nstates >= 0);
+ s->no = nfa->nstates++;
+ s->flag = 0;
+ if (nfa->states == NULL)
+ nfa->states = s;
+ s->nins = 0;
+ s->ins = NULL;
+ s->nouts = 0;
+ s->outs = NULL;
+ s->tmp = NULL;
+ s->next = NULL;
+ if (nfa->slast != NULL) {
+ assert(nfa->slast->next == NULL);
+ nfa->slast->next = s;
+ }
+ s->prev = nfa->slast;
+ nfa->slast = s;
+ return s;
+}
+
+/*
+ - newfstate - allocate an NFA state with a specified flag value
+ ^ static struct state *newfstate(struct nfa *, int flag);
+ */
+static struct state * /* NULL on error */
+newfstate(nfa, flag)
+struct nfa *nfa;
+int flag;
+{
+ struct state *s;
+
+ s = newstate(nfa);
+ if (s != NULL)
+ s->flag = (char)flag;
+ return s;
+}
+
+/*
+ - dropstate - delete a state's inarcs and outarcs and free it
+ ^ static VOID dropstate(struct nfa *, struct state *);
+ */
+static VOID
+dropstate(nfa, s)
+struct nfa *nfa;
+struct state *s;
+{
+ struct arc *a;
+
+ while ((a = s->ins) != NULL)
+ freearc(nfa, a);
+ while ((a = s->outs) != NULL)
+ freearc(nfa, a);
+ freestate(nfa, s);
+}
+
+/*
+ - freestate - free a state, which has no in-arcs or out-arcs
+ ^ static VOID freestate(struct nfa *, struct state *);
+ */
+static VOID
+freestate(nfa, s)
+struct nfa *nfa;
+struct state *s;
+{
+ assert(s != NULL);
+ assert(s->nins == 0 && s->nouts == 0);
+
+ s->no = FREESTATE;
+ s->flag = 0;
+ if (s->next != NULL)
+ s->next->prev = s->prev;
+ else {
+ assert(s == nfa->slast);
+ nfa->slast = s->prev;
+ }
+ if (s->prev != NULL)
+ s->prev->next = s->next;
+ else {
+ assert(s == nfa->states);
+ nfa->states = s->next;
+ }
+ s->prev = NULL;
+ s->next = nfa->free; /* don't delete it, put it on the free list */
+ nfa->free = s;
+}
+
+/*
+ - destroystate - really get rid of an already-freed state
+ ^ static VOID destroystate(struct nfa *, struct state *);
+ */
+static VOID
+destroystate(nfa, s)
+struct nfa *nfa;
+struct state *s;
+{
+ struct arcbatch *ab;
+ struct arcbatch *abnext;
+
+ assert(s->no == FREESTATE);
+ for (ab = s->oas.next; ab != NULL; ab = abnext) {
+ abnext = ab->next;
+ FREE(ab);
+ }
+ s->ins = NULL;
+ s->outs = NULL;
+ s->next = NULL;
+ FREE(s);
+}
+
+/*
+ - newarc - set up a new arc within an NFA
+ ^ static VOID newarc(struct nfa *, int, pcolor, struct state *,
+ ^ struct state *);
+ */
+static VOID
+newarc(nfa, t, co, from, to)
+struct nfa *nfa;
+int t;
+pcolor co;
+struct state *from;
+struct state *to;
+{
+ struct arc *a;
+
+ 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;
+
+ a = allocarc(nfa, from);
+ if (NISERR())
+ return;
+ assert(a != NULL);
+
+ a->type = t;
+ a->co = (color)co;
+ a->to = to;
+ 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.
+ */
+ a->inchain = to->ins;
+ to->ins = a;
+ a->outchain = from->outs;
+ from->outs = a;
+
+ from->nouts++;
+ to->nins++;
+
+ if (COLORED(a) && nfa->parent == NULL)
+ colorchain(nfa->cm, a);
+
+ return;
+}
+
+/*
+ - allocarc - allocate a new out-arc within a state
+ ^ static struct arc *allocarc(struct nfa *, struct state *);
+ */
+static struct arc * /* NULL for failure */
+allocarc(nfa, s)
+struct nfa *nfa;
+struct state *s;
+{
+ struct arc *a;
+ struct arcbatch *new;
+ int i;
+
+ /* shortcut */
+ if (s->free == NULL && s->noas < ABSIZE) {
+ a = &s->oas.a[s->noas];
+ s->noas++;
+ return a;
+ }
+
+ /* if none at hand, get more */
+ if (s->free == NULL) {
+ new = (struct arcbatch *)MALLOC(sizeof(struct arcbatch));
+ if (new == NULL) {
+ NERR(REG_ESPACE);
+ return NULL;
+ }
+ new->next = s->oas.next;
+ s->oas.next = new;
+
+ for (i = 0; i < ABSIZE; i++) {
+ new->a[i].type = 0;
+ new->a[i].freechain = &new->a[i+1];
+ }
+ new->a[ABSIZE-1].freechain = NULL;
+ s->free = &new->a[0];
+ }
+ assert(s->free != NULL);
+
+ a = s->free;
+ s->free = a->freechain;
+ return a;
+}
+
+/*
+ - freearc - free an arc
+ ^ static VOID freearc(struct nfa *, struct arc *);
+ */
+static VOID
+freearc(nfa, victim)
+struct nfa *nfa;
+struct arc *victim;
+{
+ struct state *from = victim->from;
+ struct state *to = victim->to;
+ struct arc *a;
+
+ assert(victim->type != 0);
+
+ /* take it off color chain if necessary */
+ if (COLORED(victim) && nfa->parent == NULL)
+ uncolorchain(nfa->cm, victim);
+
+ /* take it off source's out-chain */
+ assert(from != NULL);
+ assert(from->outs != NULL);
+ a = from->outs;
+ if (a == victim) /* simple case: first in chain */
+ from->outs = victim->outchain;
+ else {
+ for (; a != NULL && a->outchain != victim; a = a->outchain)
+ continue;
+ assert(a != NULL);
+ a->outchain = victim->outchain;
+ }
+ from->nouts--;
+
+ /* take it off target's in-chain */
+ assert(to != NULL);
+ assert(to->ins != NULL);
+ a = to->ins;
+ if (a == victim) /* simple case: first in chain */
+ to->ins = victim->inchain;
+ else {
+ for (; a != NULL && a->inchain != victim; a = a->inchain)
+ continue;
+ assert(a != NULL);
+ a->inchain = victim->inchain;
+ }
+ to->nins--;
+
+ /* clean up and place on free list */
+ victim->type = 0;
+ victim->from = NULL; /* precautions... */
+ victim->to = NULL;
+ victim->inchain = NULL;
+ victim->outchain = NULL;
+ victim->freechain = from->free;
+ from->free = victim;
+}
+
+/*
+ - findarc - find arc, if any, from given source with given type and color
+ * If there is more than one such arc, the result is random.
+ ^ static struct arc *findarc(struct state *, int, pcolor);
+ */
+static struct arc *
+findarc(s, type, co)
+struct state *s;
+int type;
+pcolor co;
+{
+ struct arc *a;
+
+ for (a = s->outs; a != NULL; a = a->outchain)
+ if (a->type == type && a->co == co)
+ return a;
+ return NULL;
+}
+
+/*
+ - cparc - allocate a new arc within an NFA, copying details from old one
+ ^ static VOID cparc(struct nfa *, struct arc *, struct state *,
+ ^ struct state *);
+ */
+static VOID
+cparc(nfa, oa, from, to)
+struct nfa *nfa;
+struct arc *oa;
+struct state *from;
+struct state *to;
+{
+ newarc(nfa, oa->type, oa->co, from, to);
+}
+
+/*
+ - 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
+ * for duplicate suppression, which makes it easier to just make new
+ * ones to exploit the suppression built into newarc.
+ ^ static VOID moveins(struct nfa *, struct state *, struct state *);
+ */
+static VOID
+moveins(nfa, old, new)
+struct nfa *nfa;
+struct state *old;
+struct state *new;
+{
+ struct arc *a;
+
+ assert(old != new);
+
+ while ((a = old->ins) != NULL) {
+ cparc(nfa, a, a->from, new);
+ freearc(nfa, a);
+ }
+ assert(old->nins == 0);
+ assert(old->ins == NULL);
+}
+
+/*
+ - copyins - copy all in arcs of a state to another state
+ ^ static VOID copyins(struct nfa *, struct state *, struct state *);
+ */
+static VOID
+copyins(nfa, old, new)
+struct nfa *nfa;
+struct state *old;
+struct state *new;
+{
+ struct arc *a;
+
+ assert(old != new);
+
+ for (a = old->ins; a != NULL; a = a->inchain)
+ cparc(nfa, a, a->from, new);
+}
+
+/*
+ - moveouts - move all out arcs of a state to another state
+ ^ static VOID moveouts(struct nfa *, struct state *, struct state *);
+ */
+static VOID
+moveouts(nfa, old, new)
+struct nfa *nfa;
+struct state *old;
+struct state *new;
+{
+ struct arc *a;
+
+ assert(old != new);
+
+ while ((a = old->outs) != NULL) {
+ cparc(nfa, a, new, a->to);
+ freearc(nfa, a);
+ }
+}
+
+/*
+ - copyouts - copy all out arcs of a state to another state
+ ^ static VOID copyouts(struct nfa *, struct state *, struct state *);
+ */
+static VOID
+copyouts(nfa, old, new)
+struct nfa *nfa;
+struct state *old;
+struct state *new;
+{
+ struct arc *a;
+
+ assert(old != new);
+
+ for (a = old->outs; a != NULL; a = a->outchain)
+ cparc(nfa, a, new, a->to);
+}
+
+/*
+ - cloneouts - copy out arcs of a state to another state pair, modifying type
+ ^ static VOID cloneouts(struct nfa *, struct state *, struct state *,
+ ^ struct state *, int);
+ */
+static VOID
+cloneouts(nfa, old, from, to, type)
+struct nfa *nfa;
+struct state *old;
+struct state *from;
+struct state *to;
+int type;
+{
+ struct arc *a;
+
+ assert(old != from);
+
+ for (a = old->outs; a != NULL; a = a->outchain)
+ newarc(nfa, type, a->co, from, to);
+}
+
+/*
+ - delsub - delete a sub-NFA, updating subre pointers if necessary
+ * This uses a recursive traversal of the sub-NFA, marking already-seen
+ * states using their tmp pointer.
+ ^ static VOID delsub(struct nfa *, struct state *, struct state *);
+ */
+static VOID
+delsub(nfa, lp, rp)
+struct nfa *nfa;
+struct state *lp; /* the sub-NFA goes from here... */
+struct state *rp; /* ...to here, *not* inclusive */
+{
+ assert(lp != rp);
+
+ rp->tmp = rp; /* mark end */
+
+ deltraverse(nfa, lp, lp);
+ assert(lp->nouts == 0 && rp->nins == 0); /* did the job */
+ assert(lp->no != FREESTATE && rp->no != FREESTATE); /* no more */
+
+ rp->tmp = NULL; /* unmark end */
+ lp->tmp = NULL; /* and begin, marked by deltraverse */
+}
+
+/*
+ - deltraverse - the recursive heart of delsub
+ * This routine's basic job is to destroy all out-arcs of the state.
+ ^ static VOID deltraverse(struct nfa *, struct state *, struct state *);
+ */
+static VOID
+deltraverse(nfa, leftend, s)
+struct nfa *nfa;
+struct state *leftend;
+struct state *s;
+{
+ struct arc *a;
+ struct state *to;
+
+ if (s->nouts == 0)
+ return; /* nothing to do */
+ if (s->tmp != NULL)
+ return; /* already in progress */
+
+ s->tmp = s; /* mark as in progress */
+
+ while ((a = s->outs) != NULL) {
+ to = a->to;
+ deltraverse(nfa, leftend, to);
+ assert(to->nouts == 0 || to->tmp != NULL);
+ freearc(nfa, a);
+ if (to->nins == 0 && to->tmp == NULL) {
+ assert(to->nouts == 0);
+ freestate(nfa, to);
+ }
+ }
+
+ assert(s->no != FREESTATE); /* we're still here */
+ assert(s == leftend || s->nins != 0); /* and still reachable */
+ assert(s->nouts == 0); /* but have no outarcs */
+
+ s->tmp = NULL; /* we're done here */
+}
+
+/*
+ - dupnfa - duplicate sub-NFA
+ * Another recursive traversal, this time using tmp to point to duplicates
+ * as well as mark already-seen states. (You knew there was a reason why
+ * it's a state pointer, didn't you? :-))
+ ^ static VOID dupnfa(struct nfa *, struct state *, struct state *,
+ ^ struct state *, struct state *);
+ */
+static VOID
+dupnfa(nfa, start, stop, from, to)
+struct nfa *nfa;
+struct state *start; /* duplicate of subNFA starting here */
+struct state *stop; /* and stopping here */
+struct state *from; /* stringing duplicate from here */
+struct state *to; /* to here */
+{
+ if (start == stop) {
+ newarc(nfa, EMPTY, 0, from, to);
+ return;
+ }
+
+ stop->tmp = to;
+ duptraverse(nfa, start, from);
+ /* done, except for clearing out the tmp pointers */
+
+ stop->tmp = NULL;
+ cleartraverse(nfa, start);
+}
+
+/*
+ - duptraverse - recursive heart of dupnfa
+ ^ static VOID duptraverse(struct nfa *, struct state *, struct state *);
+ */
+static VOID
+duptraverse(nfa, s, stmp)
+struct nfa *nfa;
+struct state *s;
+struct state *stmp; /* s's duplicate, or NULL */
+{
+ struct arc *a;
+
+ if (s->tmp != NULL)
+ return; /* already done */
+
+ s->tmp = (stmp == NULL) ? newstate(nfa) : stmp;
+ if (s->tmp == NULL) {
+ assert(NISERR());
+ return;
+ }
+
+ for (a = s->outs; a != NULL && !NISERR(); a = a->outchain) {
+ duptraverse(nfa, a->to, (struct state *)NULL);
+ assert(a->to->tmp != NULL);
+ cparc(nfa, a, s->tmp, a->to->tmp);
+ }
+}
+
+/*
+ - cleartraverse - recursive cleanup for algorithms that leave tmp ptrs set
+ ^ static VOID cleartraverse(struct nfa *, struct state *);
+ */
+static VOID
+cleartraverse(nfa, s)
+struct nfa *nfa;
+struct state *s;
+{
+ struct arc *a;
+
+ if (s->tmp == NULL)
+ return;
+ s->tmp = NULL;
+
+ for (a = s->outs; a != NULL; a = a->outchain)
+ cleartraverse(nfa, a->to);
+}
+
+/*
+ - specialcolors - fill in special colors for an NFA
+ ^ static VOID specialcolors(struct nfa *);
+ */
+static VOID
+specialcolors(nfa)
+struct nfa *nfa;
+{
+ /* false colors for BOS, BOL, EOS, EOL */
+ if (nfa->parent == NULL) {
+ nfa->bos[0] = pseudocolor(nfa->cm);
+ nfa->bos[1] = pseudocolor(nfa->cm);
+ nfa->eos[0] = pseudocolor(nfa->cm);
+ nfa->eos[1] = pseudocolor(nfa->cm);
+ } else {
+ assert(nfa->parent->bos[0] != COLORLESS);
+ nfa->bos[0] = nfa->parent->bos[0];
+ assert(nfa->parent->bos[1] != COLORLESS);
+ nfa->bos[1] = nfa->parent->bos[1];
+ assert(nfa->parent->eos[0] != COLORLESS);
+ nfa->eos[0] = nfa->parent->eos[0];
+ assert(nfa->parent->eos[1] != COLORLESS);
+ nfa->eos[1] = nfa->parent->eos[1];
+ }
+}
+
+/*
+ - optimize - optimize an NFA
+ ^ static long optimize(struct nfa *, FILE *);
+ */
+static long /* re_info bits */
+optimize(nfa, f)
+struct nfa *nfa;
+FILE *f; /* for debug output; NULL none */
+{
+ int verbose = (f != NULL) ? 1 : 0;
+
+ if (verbose)
+ fprintf(f, "\ninitial cleanup:\n");
+ cleanup(nfa); /* may simplify situation */
+ if (verbose)
+ dumpnfa(nfa, f);
+ if (verbose)
+ fprintf(f, "\nempties:\n");
+ fixempties(nfa, f); /* get rid of EMPTY arcs */
+ if (verbose)
+ fprintf(f, "\nconstraints:\n");
+ 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 */
+ return analyze(nfa); /* and analysis */
+}
+
+/*
+ - pullback - pull back constraints backward to (with luck) eliminate them
+ ^ static VOID pullback(struct nfa *, FILE *);
+ */
+static VOID
+pullback(nfa, f)
+struct nfa *nfa;
+FILE *f; /* for debug output; NULL none */
+{
+ struct state *s;
+ struct state *nexts;
+ struct arc *a;
+ struct arc *nexta;
+ int progress;
+
+ /* find and pull until there are no more */
+ do {
+ progress = 0;
+ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
+ nexts = s->next;
+ for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
+ nexta = a->outchain;
+ if (a->type == '^' || a->type == BEHIND)
+ if (pull(nfa, a))
+ progress = 1;
+ assert(nexta == NULL || s->no != FREESTATE);
+ }
+ }
+ if (progress && f != NULL)
+ dumpnfa(nfa, f);
+ } while (progress && !NISERR());
+ if (NISERR())
+ return;
+
+ for (a = nfa->pre->outs; a != NULL; a = nexta) {
+ nexta = a->outchain;
+ if (a->type == '^') {
+ assert(a->co == 0 || a->co == 1);
+ newarc(nfa, PLAIN, nfa->bos[a->co], a->from, a->to);
+ freearc(nfa, a);
+ }
+ }
+}
+
+/*
+ - 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.
+ ^ static int pull(struct nfa *, struct arc *);
+ */
+static int /* 0 couldn't, 1 could */
+pull(nfa, con)
+struct nfa *nfa;
+struct arc *con;
+{
+ struct state *from = con->from;
+ struct state *to = con->to;
+ struct arc *a;
+ struct arc *nexta;
+ struct state *s;
+
+ if (from == to) { /* circular constraint is pointless */
+ freearc(nfa, con);
+ return 1;
+ }
+ if (from->flag) /* can't pull back beyond start */
+ return 0;
+ if (from->nins == 0) { /* unreachable */
+ freearc(nfa, con);
+ return 1;
+ }
+
+ /* first, clone from state if necessary to avoid other outarcs */
+ if (from->nouts > 1) {
+ s = newstate(nfa);
+ if (NISERR())
+ return 0;
+ assert(to != from); /* con is not an inarc */
+ copyins(nfa, from, s); /* duplicate inarcs */
+ cparc(nfa, con, s, to); /* move constraint arc */
+ freearc(nfa, con);
+ from = s;
+ con = from->outs;
+ }
+ assert(from->nouts == 1);
+
+ /* propagate the constraint into the from state's inarcs */
+ for (a = from->ins; a != NULL; a = nexta) {
+ nexta = a->inchain;
+ switch (combine(con, a)) {
+ case INCOMPATIBLE: /* destroy the arc */
+ freearc(nfa, a);
+ break;
+ case SATISFIED: /* no action needed */
+ break;
+ case COMPATIBLE: /* swap the two arcs, more or less */
+ s = newstate(nfa);
+ if (NISERR())
+ return 0;
+ cparc(nfa, a, s, to); /* anticipate move */
+ cparc(nfa, con, a->from, s);
+ if (NISERR())
+ return 0;
+ freearc(nfa, a);
+ break;
+ default:
+ assert(NOTREACHED);
+ break;
+ }
+ }
+
+ /* remaining inarcs, if any, incorporate the constraint */
+ moveins(nfa, from, to);
+ dropstate(nfa, from); /* will free the constraint */
+ return 1;
+}
+
+/*
+ - pushfwd - push forward constraints forward to (with luck) eliminate them
+ ^ static VOID pushfwd(struct nfa *, FILE *);
+ */
+static VOID
+pushfwd(nfa, f)
+struct nfa *nfa;
+FILE *f; /* for debug output; NULL none */
+{
+ struct state *s;
+ struct state *nexts;
+ struct arc *a;
+ struct arc *nexta;
+ int progress;
+
+ /* find and push until there are no more */
+ do {
+ progress = 0;
+ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
+ nexts = s->next;
+ for (a = s->ins; a != NULL && !NISERR(); a = nexta) {
+ nexta = a->inchain;
+ if (a->type == '$' || a->type == AHEAD)
+ if (push(nfa, a))
+ progress = 1;
+ assert(nexta == NULL || s->no != FREESTATE);
+ }
+ }
+ if (progress && f != NULL)
+ dumpnfa(nfa, f);
+ } while (progress && !NISERR());
+ if (NISERR())
+ return;
+
+ for (a = nfa->post->ins; a != NULL; a = nexta) {
+ nexta = a->inchain;
+ if (a->type == '$') {
+ assert(a->co == 0 || a->co == 1);
+ newarc(nfa, PLAIN, nfa->eos[a->co], a->from, a->to);
+ freearc(nfa, a);
+ }
+ }
+}
+
+/*
+ - 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.
+ ^ static int push(struct nfa *, struct arc *);
+ */
+static int /* 0 couldn't, 1 could */
+push(nfa, con)
+struct nfa *nfa;
+struct arc *con;
+{
+ struct state *from = con->from;
+ struct state *to = con->to;
+ struct arc *a;
+ struct arc *nexta;
+ struct state *s;
+
+ if (to == from) { /* circular constraint is pointless */
+ freearc(nfa, con);
+ return 1;
+ }
+ if (to->flag) /* can't push forward beyond end */
+ return 0;
+ if (to->nouts == 0) { /* dead end */
+ freearc(nfa, con);
+ return 1;
+ }
+
+ /* first, clone to state if necessary to avoid other inarcs */
+ if (to->nins > 1) {
+ s = newstate(nfa);
+ if (NISERR())
+ return 0;
+ copyouts(nfa, to, s); /* duplicate outarcs */
+ cparc(nfa, con, from, s); /* move constraint */
+ freearc(nfa, con);
+ to = s;
+ con = to->ins;
+ }
+ assert(to->nins == 1);
+
+ /* propagate the constraint into the to state's outarcs */
+ for (a = to->outs; a != NULL; a = nexta) {
+ nexta = a->outchain;
+ switch (combine(con, a)) {
+ case INCOMPATIBLE: /* destroy the arc */
+ freearc(nfa, a);
+ break;
+ case SATISFIED: /* no action needed */
+ break;
+ case COMPATIBLE: /* swap the two arcs, more or less */
+ s = newstate(nfa);
+ if (NISERR())
+ return 0;
+ cparc(nfa, con, s, a->to); /* anticipate move */
+ cparc(nfa, a, from, s);
+ if (NISERR())
+ return 0;
+ freearc(nfa, a);
+ break;
+ default:
+ assert(NOTREACHED);
+ break;
+ }
+ }
+
+ /* remaining outarcs, if any, incorporate the constraint */
+ moveouts(nfa, to, from);
+ dropstate(nfa, to); /* will free the constraint */
+ return 1;
+}
+
+/*
+ - combine - constraint lands on an arc, what happens?
+ ^ #def INCOMPATIBLE 1 // destroys arc
+ ^ #def SATISFIED 2 // constraint satisfied
+ ^ #def COMPATIBLE 3 // compatible but not satisfied yet
+ ^ static int combine(struct arc *, struct arc *);
+ */
+static int
+combine(con, a)
+struct arc *con;
+struct arc *a;
+{
+# define CA(ct,at) (((ct)<<CHAR_BIT) | (at))
+
+ switch (CA(con->type, a->type)) {
+ case CA('^', PLAIN): /* newlines are handled separately */
+ case CA('$', PLAIN):
+ return INCOMPATIBLE;
+ break;
+ case CA(AHEAD, PLAIN): /* color constraints meet colors */
+ case CA(BEHIND, PLAIN):
+ if (con->co == a->co)
+ return SATISFIED;
+ return INCOMPATIBLE;
+ break;
+ case CA('^', '^'): /* collision, similar constraints */
+ case CA('$', '$'):
+ case CA(AHEAD, AHEAD):
+ case CA(BEHIND, BEHIND):
+ if (con->co == a->co) /* true duplication */
+ return SATISFIED;
+ return INCOMPATIBLE;
+ break;
+ case CA('^', BEHIND): /* collision, dissimilar constraints */
+ case CA(BEHIND, '^'):
+ case CA('$', AHEAD):
+ case CA(AHEAD, '$'):
+ return INCOMPATIBLE;
+ break;
+ case CA('^', '$'): /* constraints passing each other */
+ case CA('^', AHEAD):
+ case CA(BEHIND, '$'):
+ case CA(BEHIND, AHEAD):
+ case CA('$', '^'):
+ case CA('$', BEHIND):
+ case CA(AHEAD, '^'):
+ case CA(AHEAD, BEHIND):
+ case CA('^', LACON):
+ case CA(BEHIND, LACON):
+ case CA('$', LACON):
+ case CA(AHEAD, LACON):
+ return COMPATIBLE;
+ break;
+ }
+ assert(NOTREACHED);
+ return INCOMPATIBLE; /* for benefit of blind compilers */
+}
+
+/*
+ - fixempties - get rid of EMPTY arcs
+ ^ static VOID fixempties(struct nfa *, FILE *);
+ */
+static VOID
+fixempties(nfa, f)
+struct nfa *nfa;
+FILE *f; /* for debug output; NULL none */
+{
+ struct state *s;
+ struct state *nexts;
+ struct arc *a;
+ struct arc *nexta;
+ int progress;
+
+ /* find and eliminate empties until there are no more */
+ do {
+ progress = 0;
+ for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
+ nexts = s->next;
+ for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
+ nexta = a->outchain;
+ if (a->type == EMPTY && unempty(nfa, a))
+ progress = 1;
+ assert(nexta == NULL || s->no != FREESTATE);
+ }
+ }
+ if (progress && f != NULL)
+ dumpnfa(nfa, f);
+ } while (progress && !NISERR());
+}
+
+/*
+ - unempty - optimize out an EMPTY arc, if possible
+ * Actually, as it stands this function always succeeds, but the return
+ * value is kept with an eye on possible future changes.
+ ^ static int unempty(struct nfa *, struct arc *);
+ */
+static int /* 0 couldn't, 1 could */
+unempty(nfa, a)
+struct nfa *nfa;
+struct arc *a;
+{
+ struct state *from = a->from;
+ struct state *to = a->to;
+ int usefrom; /* work on from, as opposed to to? */
+
+ assert(a->type == EMPTY);
+ assert(from != nfa->pre && to != nfa->post);
+
+ if (from == to) { /* vacuous loop */
+ freearc(nfa, a);
+ return 1;
+ }
+
+ /* decide which end to work on */
+ usefrom = 1; /* default: attack from */
+ if (from->nouts > to->nins)
+ usefrom = 0;
+ else if (from->nouts == to->nins) {
+ /* decide on secondary issue: move/copy fewest arcs */
+ if (from->nins > to->nouts)
+ usefrom = 0;
+ }
+
+ freearc(nfa, a);
+ if (usefrom) {
+ if (from->nouts == 0) {
+ /* was the state's only outarc */
+ moveins(nfa, from, to);
+ freestate(nfa, from);
+ } else
+ copyins(nfa, from, to);
+ } else {
+ if (to->nins == 0) {
+ /* was the state's only inarc */
+ moveouts(nfa, to, from);
+ freestate(nfa, to);
+ } else
+ copyouts(nfa, to, from);
+ }
+
+ return 1;
+}
+
+/*
+ - cleanup - clean up NFA after optimizations
+ ^ static VOID cleanup(struct nfa *);
+ */
+static VOID
+cleanup(nfa)
+struct nfa *nfa;
+{
+ struct state *s;
+ struct state *nexts;
+ int n;
+
+ /* clear out unreachable or dead-end states */
+ /* use pre to mark reachable, then post to mark can-reach-post */
+ markreachable(nfa, nfa->pre, (struct state *)NULL, nfa->pre);
+ markcanreach(nfa, nfa->post, nfa->pre, nfa->post);
+ for (s = nfa->states; s != NULL; s = nexts) {
+ nexts = s->next;
+ if (s->tmp != nfa->post && !s->flag)
+ dropstate(nfa, s);
+ }
+ assert(nfa->post->nins == 0 || nfa->post->tmp == nfa->post);
+ cleartraverse(nfa, nfa->pre);
+ assert(nfa->post->nins == 0 || nfa->post->tmp == NULL);
+ /* the nins==0 (final unreachable) case will be caught later */
+
+ /* renumber surviving states */
+ n = 0;
+ for (s = nfa->states; s != NULL; s = s->next)
+ s->no = n++;
+ nfa->nstates = n;
+}
+
+/*
+ - markreachable - recursive marking of reachable states
+ ^ static VOID markreachable(struct nfa *, struct state *, struct state *,
+ ^ struct state *);
+ */
+static VOID
+markreachable(nfa, s, okay, mark)
+struct nfa *nfa;
+struct state *s;
+struct state *okay; /* consider only states with this mark */
+struct state *mark; /* the value to mark with */
+{
+ struct arc *a;
+
+ if (s->tmp != okay)
+ return;
+ s->tmp = mark;
+
+ for (a = s->outs; a != NULL; a = a->outchain)
+ markreachable(nfa, a->to, okay, mark);
+}
+
+/*
+ - markcanreach - recursive marking of states which can reach here
+ ^ static VOID markcanreach(struct nfa *, struct state *, struct state *,
+ ^ struct state *);
+ */
+static VOID
+markcanreach(nfa, s, okay, mark)
+struct nfa *nfa;
+struct state *s;
+struct state *okay; /* consider only states with this mark */
+struct state *mark; /* the value to mark with */
+{
+ struct arc *a;
+
+ if (s->tmp != okay)
+ return;
+ s->tmp = mark;
+
+ for (a = s->ins; a != NULL; a = a->inchain)
+ markcanreach(nfa, a->from, okay, mark);
+}
+
+/*
+ - analyze - ascertain potentially-useful facts about an optimized NFA
+ ^ static long analyze(struct nfa *);
+ */
+static long /* re_info bits to be ORed in */
+analyze(nfa)
+struct nfa *nfa;
+{
+ struct arc *a;
+ struct arc *aa;
+
+ if (nfa->pre->outs == NULL)
+ return REG_UIMPOSSIBLE;
+ for (a = nfa->pre->outs; a != NULL; a = a->outchain)
+ for (aa = a->to->outs; aa != NULL; aa = aa->outchain)
+ if (aa->to == nfa->post)
+ return REG_UEMPTYMATCH;
+ return 0;
+}
+
+/*
+ - compact - compact an NFA
+ ^ static VOID compact(struct nfa *, struct cnfa *);
+ */
+static VOID
+compact(nfa, cnfa)
+struct nfa *nfa;
+struct cnfa *cnfa;
+{
+ struct state *s;
+ struct arc *a;
+ size_t nstates;
+ size_t narcs;
+ struct carc *ca;
+ struct carc *first;
+
+ assert (!NISERR());
+
+ nstates = 0;
+ 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 */
+ }
+
+ 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->states != NULL)
+ FREE(cnfa->states);
+ if (cnfa->arcs != NULL)
+ FREE(cnfa->arcs);
+ NERR(REG_ESPACE);
+ return;
+ }
+ cnfa->nstates = nstates;
+ cnfa->pre = nfa->pre->no;
+ cnfa->post = nfa->post->no;
+ cnfa->bos[0] = nfa->bos[0];
+ cnfa->bos[1] = nfa->bos[1];
+ cnfa->eos[0] = nfa->eos[0];
+ cnfa->eos[1] = nfa->eos[1];
+ cnfa->ncolors = maxcolor(nfa->cm) + 1;
+ cnfa->flags = 0;
+
+ ca = cnfa->arcs;
+ for (s = nfa->states; s != NULL; s = s->next) {
+ assert((size_t)s->no < nstates);
+ 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) {
+ case PLAIN:
+ ca->co = a->co;
+ ca->to = a->to->no;
+ ca++;
+ break;
+ case LACON:
+ assert(s->no != cnfa->pre);
+ ca->co = (color)(cnfa->ncolors + a->co);
+ ca->to = a->to->no;
+ ca++;
+ cnfa->flags |= HASLACONS;
+ break;
+ default:
+ assert(NOTREACHED);
+ break;
+ }
+ carcsort(first, ca-1);
+ ca->co = COLORLESS;
+ ca->to = 0;
+ ca++;
+ }
+ assert(ca == &cnfa->arcs[narcs]);
+ assert(cnfa->nstates != 0);
+
+ /* mark no-progress states */
+ for (a = nfa->pre->outs; a != NULL; a = a->outchain)
+ cnfa->states[a->to->no]->co = 1;
+ cnfa->states[nfa->pre->no]->co = 1;
+}
+
+/*
+ - 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(first, last)
+struct carc *first;
+struct carc *last;
+{
+ struct carc *p;
+ struct carc *q;
+ struct carc tmp;
+
+ if (last - first <= 1)
+ return;
+
+ 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;
+ }
+}
+
+/*
+ - freecnfa - free a compacted NFA
+ ^ static VOID freecnfa(struct cnfa *);
+ */
+static VOID
+freecnfa(cnfa)
+struct cnfa *cnfa;
+{
+ assert(cnfa->nstates != 0); /* not empty already */
+ cnfa->nstates = 0;
+ FREE(cnfa->states);
+ FREE(cnfa->arcs);
+}
+
+/*
+ - dumpnfa - dump an NFA in human-readable form
+ ^ static VOID dumpnfa(struct nfa *, FILE *);
+ */
+static VOID
+dumpnfa(nfa, f)
+struct nfa *nfa;
+FILE *f;
+{
+#ifdef REG_DEBUG
+ struct state *s;
+
+ fprintf(f, "pre %d, post %d", nfa->pre->no, nfa->post->no);
+ if (nfa->bos[0] != COLORLESS)
+ fprintf(f, ", bos [%ld]", (long)nfa->bos[0]);
+ if (nfa->bos[1] != COLORLESS)
+ fprintf(f, ", bol [%ld]", (long)nfa->bos[1]);
+ if (nfa->eos[0] != COLORLESS)
+ fprintf(f, ", eos [%ld]", (long)nfa->eos[0]);
+ if (nfa->eos[1] != COLORLESS)
+ fprintf(f, ", eol [%ld]", (long)nfa->eos[1]);
+ fprintf(f, "\n");
+ for (s = nfa->states; s != NULL; s = s->next)
+ dumpstate(s, f);
+ if (nfa->parent == NULL)
+ dumpcolors(nfa->cm, f);
+ fflush(f);
+#endif
+}
+
+#ifdef REG_DEBUG /* subordinates of dumpnfa */
+/*
+ ^ #ifdef REG_DEBUG
+ */
+
+/*
+ - dumpstate - dump an NFA state in human-readable form
+ ^ static VOID dumpstate(struct state *, FILE *);
+ */
+static VOID
+dumpstate(s, f)
+struct state *s;
+FILE *f;
+{
+ struct arc *a;
+
+ fprintf(f, "%d%s%c", s->no, (s->tmp != NULL) ? "T" : "",
+ (s->flag) ? s->flag : '.');
+ if (s->prev != NULL && s->prev->next != s)
+ fprintf(f, "\tstate chain bad\n");
+ if (s->nouts == 0)
+ fprintf(f, "\tno out arcs\n");
+ else
+ dumparcs(s, f);
+ fflush(f);
+ for (a = s->ins; a != NULL; a = a->inchain) {
+ if (a->to != s)
+ fprintf(f, "\tlink from %d to %d on %d's in-chain\n",
+ a->from->no, a->to->no, s->no);
+ }
+}
+
+/*
+ - dumparcs - dump out-arcs in human-readable form
+ ^ static VOID dumparcs(struct state *, FILE *);
+ */
+static VOID
+dumparcs(s, f)
+struct state *s;
+FILE *f;
+{
+ int pos;
+
+ 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(a, s, f, pos)
+struct arc *a;
+struct state *s;
+FILE *f;
+int pos; /* initial print position */
+{
+ if (a->outchain != NULL)
+ pos = dumprarcs(a->outchain, s, f, pos);
+ dumparc(a, s, f);
+ if (pos == 5) {
+ fprintf(f, "\n");
+ pos = 1;
+ } else
+ pos++;
+ return pos;
+}
+
+/*
+ - dumparc - dump one outarc in readable form, including prefixing tab
+ ^ static VOID dumparc(struct arc *, struct state *, FILE *);
+ */
+static VOID
+dumparc(a, s, f)
+struct arc *a;
+struct state *s;
+FILE *f;
+{
+ struct arc *aa;
+ struct arcbatch *ab;
+
+ fprintf(f, "\t");
+ switch (a->type) {
+ case PLAIN:
+ fprintf(f, "[%ld]", (long)a->co);
+ break;
+ case AHEAD:
+ fprintf(f, ">%ld>", (long)a->co);
+ break;
+ case BEHIND:
+ fprintf(f, "<%ld<", (long)a->co);
+ break;
+ case LACON:
+ fprintf(f, ":%ld:", (long)a->co);
+ break;
+ case '^':
+ case '$':
+ fprintf(f, "%c%d", a->type, (int)a->co);
+ break;
+ case EMPTY:
+ break;
+ default:
+ fprintf(f, "0x%x/0%lo", a->type, (long)a->co);
+ break;
+ }
+ if (a->from != s)
+ fprintf(f, "?%d?", a->from->no);
+ for (ab = &a->from->oas; ab != NULL; ab = ab->next) {
+ for (aa = &ab->a[0]; aa < &ab->a[ABSIZE]; aa++)
+ if (aa == a)
+ break; /* NOTE BREAK OUT */
+ if (aa < &ab->a[ABSIZE]) /* propagate break */
+ break; /* NOTE BREAK OUT */
+ }
+ if (ab == NULL)
+ fprintf(f, "?!?"); /* not in allocated space */
+ fprintf(f, "->");
+ if (a->to == NULL) {
+ fprintf(f, "NULL");
+ return;
+ }
+ fprintf(f, "%d", a->to->no);
+ for (aa = a->to->ins; aa != NULL; aa = aa->inchain)
+ if (aa == a)
+ break; /* NOTE BREAK OUT */
+ if (aa == NULL)
+ fprintf(f, "?!?"); /* missing from in-chain */
+}
+
+/*
+ ^ #endif
+ */
+#endif /* ifdef REG_DEBUG */
+
+/*
+ - dumpcnfa - dump a compacted NFA in human-readable form
+ ^ static VOID dumpcnfa(struct cnfa *, FILE *);
+ */
+static VOID
+dumpcnfa(cnfa, f)
+struct cnfa *cnfa;
+FILE *f;
+{
+#ifdef REG_DEBUG
+ int st;
+
+ fprintf(f, "pre %d, post %d", cnfa->pre, cnfa->post);
+ if (cnfa->bos[0] != COLORLESS)
+ fprintf(f, ", bos [%ld]", (long)cnfa->bos[0]);
+ if (cnfa->bos[1] != COLORLESS)
+ fprintf(f, ", bol [%ld]", (long)cnfa->bos[1]);
+ if (cnfa->eos[0] != COLORLESS)
+ fprintf(f, ", eos [%ld]", (long)cnfa->eos[0]);
+ if (cnfa->eos[1] != COLORLESS)
+ fprintf(f, ", eol [%ld]", (long)cnfa->eos[1]);
+ if (cnfa->flags&HASLACONS)
+ fprintf(f, ", haslacons");
+ fprintf(f, "\n");
+ for (st = 0; st < cnfa->nstates; st++)
+ dumpcstate(st, cnfa->states[st], cnfa, f);
+ fflush(f);
+#endif
+}
+
+#ifdef REG_DEBUG /* subordinates of dumpcnfa */
+/*
+ ^ #ifdef REG_DEBUG
+ */
+
+/*
+ - dumpcstate - dump a compacted-NFA state in human-readable form
+ ^ static VOID dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+ */
+static VOID
+dumpcstate(st, ca, cnfa, f)
+int st;
+struct carc *ca;
+struct cnfa *cnfa;
+FILE *f;
+{
+ int i;
+ int pos;
+
+ fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
+ 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);
+ else
+ fprintf(f, "\t:%ld:->%d", (long)ca[i].co-cnfa->ncolors,
+ ca[i].to);
+ if (pos == 5) {
+ fprintf(f, "\n");
+ pos = 1;
+ } else
+ pos++;
+ }
+ if (i == 1 || pos != 1)
+ fprintf(f, "\n");
+ fflush(f);
+}
+
+/*
+ ^ #endif
+ */
+#endif /* ifdef REG_DEBUG */
diff --git a/tcl/generic/regcomp.c b/tcl/generic/regcomp.c
new file mode 100644
index 00000000000..4aba629f1ec
--- /dev/null
+++ b/tcl/generic/regcomp.c
@@ -0,0 +1,2175 @@
+/*
+ * re_*comp and friends - compile REs
+ * This file #includes several others (see the bottom).
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+#include "regguts.h"
+
+/*
+ * forward declarations, up here so forward datatypes etc. are defined early
+ */
+/* =====^!^===== begin forwards =====^!^===== */
+/* automatically gathered by fwd; do not hand-edit */
+/* === regcomp.c === */
+int compile _ANSI_ARGS_((regex_t *, CONST chr *, size_t, int));
+static VOID moresubs _ANSI_ARGS_((struct vars *, int));
+static int freev _ANSI_ARGS_((struct vars *, int));
+static VOID makesearch _ANSI_ARGS_((struct vars *, struct nfa *));
+static struct subre *parse _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *));
+static struct subre *parsebranch _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *, int));
+static VOID parseqatom _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *, struct subre *));
+static VOID nonword _ANSI_ARGS_((struct vars *, int, struct state *, struct state *));
+static VOID word _ANSI_ARGS_((struct vars *, int, struct state *, struct state *));
+static int scannum _ANSI_ARGS_((struct vars *));
+static VOID repeat _ANSI_ARGS_((struct vars *, struct state *, struct state *, int, int));
+static VOID bracket _ANSI_ARGS_((struct vars *, struct state *, struct state *));
+static VOID cbracket _ANSI_ARGS_((struct vars *, struct state *, struct state *));
+static VOID brackpart _ANSI_ARGS_((struct vars *, struct state *, struct state *));
+static chr *scanplain _ANSI_ARGS_((struct vars *));
+static VOID leaders _ANSI_ARGS_((struct vars *, struct cvec *));
+static VOID onechr _ANSI_ARGS_((struct vars *, pchr, struct state *, struct state *));
+static VOID dovec _ANSI_ARGS_((struct vars *, struct cvec *, struct state *, struct state *));
+static celt nextleader _ANSI_ARGS_((struct vars *, pchr, pchr));
+static VOID wordchrs _ANSI_ARGS_((struct vars *));
+static struct subre *subre _ANSI_ARGS_((struct vars *, int, int, struct state *, struct state *));
+static VOID freesubre _ANSI_ARGS_((struct vars *, struct subre *));
+static VOID freesrnode _ANSI_ARGS_((struct vars *, struct subre *));
+static VOID optst _ANSI_ARGS_((struct vars *, struct subre *));
+static int numst _ANSI_ARGS_((struct subre *, int));
+static VOID markst _ANSI_ARGS_((struct subre *));
+static VOID cleanst _ANSI_ARGS_((struct vars *));
+static long nfatree _ANSI_ARGS_((struct vars *, struct subre *, FILE *));
+static long nfanode _ANSI_ARGS_((struct vars *, struct subre *, FILE *));
+static int newlacon _ANSI_ARGS_((struct vars *, struct state *, struct state *, int));
+static VOID freelacons _ANSI_ARGS_((struct subre *, int));
+static VOID rfree _ANSI_ARGS_((regex_t *));
+static VOID dump _ANSI_ARGS_((regex_t *, FILE *));
+static VOID dumpst _ANSI_ARGS_((struct subre *, FILE *, int));
+static VOID stdump _ANSI_ARGS_((struct subre *, FILE *, int));
+static char *stid _ANSI_ARGS_((struct subre *, char *, size_t));
+/* === regc_lex.c === */
+static VOID lexstart _ANSI_ARGS_((struct vars *));
+static VOID prefixes _ANSI_ARGS_((struct vars *));
+static VOID lexnest _ANSI_ARGS_((struct vars *, chr *, chr *));
+static VOID lexword _ANSI_ARGS_((struct vars *));
+static int next _ANSI_ARGS_((struct vars *));
+static int lexescape _ANSI_ARGS_((struct vars *));
+static chr lexdigits _ANSI_ARGS_((struct vars *, int, int, int));
+static int brenext _ANSI_ARGS_((struct vars *, pchr));
+static VOID skip _ANSI_ARGS_((struct vars *));
+static chr newline _ANSI_ARGS_((NOPARMS));
+#ifdef REG_DEBUG
+static chr *ch _ANSI_ARGS_((NOPARMS));
+#endif
+static chr chrnamed _ANSI_ARGS_((struct vars *, chr *, chr *, pchr));
+/* === regc_color.c === */
+static VOID initcm _ANSI_ARGS_((struct vars *, struct colormap *));
+static VOID freecm _ANSI_ARGS_((struct colormap *));
+static VOID cmtreefree _ANSI_ARGS_((struct colormap *, union tree *, int));
+static color setcolor _ANSI_ARGS_((struct colormap *, pchr, pcolor));
+static color maxcolor _ANSI_ARGS_((struct colormap *));
+static color newcolor _ANSI_ARGS_((struct colormap *));
+static VOID freecolor _ANSI_ARGS_((struct colormap *, pcolor));
+static color pseudocolor _ANSI_ARGS_((struct colormap *));
+static color subcolor _ANSI_ARGS_((struct colormap *, pchr c));
+static color newsub _ANSI_ARGS_((struct colormap *, pcolor));
+static VOID subrange _ANSI_ARGS_((struct vars *, pchr, pchr, struct state *, struct state *));
+static VOID subblock _ANSI_ARGS_((struct vars *, pchr, struct state *, struct state *));
+static VOID okcolors _ANSI_ARGS_((struct nfa *, struct colormap *));
+static VOID colorchain _ANSI_ARGS_((struct colormap *, struct arc *));
+static VOID uncolorchain _ANSI_ARGS_((struct colormap *, struct arc *));
+static int singleton _ANSI_ARGS_((struct colormap *, pchr c));
+static VOID rainbow _ANSI_ARGS_((struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *));
+static VOID colorcomplement _ANSI_ARGS_((struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *));
+#ifdef REG_DEBUG
+static VOID dumpcolors _ANSI_ARGS_((struct colormap *, FILE *));
+static VOID fillcheck _ANSI_ARGS_((struct colormap *, union tree *, int, FILE *));
+static VOID dumpchr _ANSI_ARGS_((pchr, FILE *));
+#endif
+/* === regc_nfa.c === */
+static struct nfa *newnfa _ANSI_ARGS_((struct vars *, struct colormap *, struct nfa *));
+static VOID freenfa _ANSI_ARGS_((struct nfa *));
+static struct state *newstate _ANSI_ARGS_((struct nfa *));
+static struct state *newfstate _ANSI_ARGS_((struct nfa *, int flag));
+static VOID dropstate _ANSI_ARGS_((struct nfa *, struct state *));
+static VOID freestate _ANSI_ARGS_((struct nfa *, struct state *));
+static VOID destroystate _ANSI_ARGS_((struct nfa *, struct state *));
+static VOID newarc _ANSI_ARGS_((struct nfa *, int, pcolor, struct state *, struct state *));
+static struct arc *allocarc _ANSI_ARGS_((struct nfa *, struct state *));
+static VOID freearc _ANSI_ARGS_((struct nfa *, struct arc *));
+static struct arc *findarc _ANSI_ARGS_((struct state *, int, pcolor));
+static VOID cparc _ANSI_ARGS_((struct nfa *, struct arc *, struct state *, struct state *));
+static VOID moveins _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
+static VOID copyins _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
+static VOID moveouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
+static VOID copyouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
+static VOID cloneouts _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *, int));
+static VOID delsub _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
+static VOID deltraverse _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
+static VOID dupnfa _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *, struct state *));
+static VOID duptraverse _ANSI_ARGS_((struct nfa *, struct state *, struct state *));
+static VOID cleartraverse _ANSI_ARGS_((struct nfa *, struct state *));
+static VOID specialcolors _ANSI_ARGS_((struct nfa *));
+static long optimize _ANSI_ARGS_((struct nfa *, FILE *));
+static VOID pullback _ANSI_ARGS_((struct nfa *, FILE *));
+static int pull _ANSI_ARGS_((struct nfa *, struct arc *));
+static VOID pushfwd _ANSI_ARGS_((struct nfa *, FILE *));
+static int push _ANSI_ARGS_((struct nfa *, struct arc *));
+#define INCOMPATIBLE 1 /* destroys arc */
+#define SATISFIED 2 /* constraint satisfied */
+#define COMPATIBLE 3 /* compatible but not satisfied yet */
+static int combine _ANSI_ARGS_((struct arc *, struct arc *));
+static VOID fixempties _ANSI_ARGS_((struct nfa *, FILE *));
+static int unempty _ANSI_ARGS_((struct nfa *, struct arc *));
+static VOID cleanup _ANSI_ARGS_((struct nfa *));
+static VOID markreachable _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *));
+static VOID markcanreach _ANSI_ARGS_((struct nfa *, struct state *, struct state *, struct state *));
+static long analyze _ANSI_ARGS_((struct nfa *));
+static VOID compact _ANSI_ARGS_((struct nfa *, struct cnfa *));
+static VOID carcsort _ANSI_ARGS_((struct carc *, struct carc *));
+static VOID freecnfa _ANSI_ARGS_((struct cnfa *));
+static VOID dumpnfa _ANSI_ARGS_((struct nfa *, FILE *));
+#ifdef REG_DEBUG
+static VOID dumpstate _ANSI_ARGS_((struct state *, FILE *));
+static VOID dumparcs _ANSI_ARGS_((struct state *, FILE *));
+static int dumprarcs _ANSI_ARGS_((struct arc *, struct state *, FILE *, int));
+static VOID dumparc _ANSI_ARGS_((struct arc *, struct state *, FILE *));
+#endif
+static VOID dumpcnfa _ANSI_ARGS_((struct cnfa *, FILE *));
+#ifdef REG_DEBUG
+static VOID dumpcstate _ANSI_ARGS_((int, struct carc *, struct cnfa *, FILE *));
+#endif
+/* === regc_cvec.c === */
+static struct cvec *newcvec _ANSI_ARGS_((int, int, int));
+static struct cvec *clearcvec _ANSI_ARGS_((struct cvec *));
+static VOID addchr _ANSI_ARGS_((struct cvec *, pchr));
+static VOID addrange _ANSI_ARGS_((struct cvec *, pchr, pchr));
+static VOID addmcce _ANSI_ARGS_((struct cvec *, chr *, chr *));
+static int haschr _ANSI_ARGS_((struct cvec *, pchr));
+static struct cvec *getcvec _ANSI_ARGS_((struct vars *, int, int, int));
+static VOID freecvec _ANSI_ARGS_((struct cvec *));
+/* === regc_locale.c === */
+static int nmcces _ANSI_ARGS_((struct vars *));
+static int nleaders _ANSI_ARGS_((struct vars *));
+static struct cvec *allmcces _ANSI_ARGS_((struct vars *, struct cvec *));
+static celt element _ANSI_ARGS_((struct vars *, chr *, chr *));
+static struct cvec *range _ANSI_ARGS_((struct vars *, celt, celt, int));
+static int before _ANSI_ARGS_((celt, celt));
+static struct cvec *eclass _ANSI_ARGS_((struct vars *, celt, int));
+static struct cvec *cclass _ANSI_ARGS_((struct vars *, chr *, chr *, int));
+static struct cvec *allcases _ANSI_ARGS_((struct vars *, pchr));
+static int cmp _ANSI_ARGS_((CONST chr *, CONST chr *, size_t));
+static int casecmp _ANSI_ARGS_((CONST chr *, CONST chr *, size_t));
+/* automatically gathered by fwd; do not hand-edit */
+/* =====^!^===== end forwards =====^!^===== */
+
+
+
+/* internal variables, bundled for easy passing around */
+struct vars {
+ regex_t *re;
+ chr *now; /* scan pointer into string */
+ chr *stop; /* end of string */
+ chr *savenow; /* saved now and stop for "subroutine call" */
+ chr *savestop;
+ int err; /* error code (0 if none) */
+ int cflags; /* copy of compile flags */
+ int lasttype; /* type of previous token */
+ int nexttype; /* type of next token */
+ chr nextvalue; /* value (if any) of next token */
+ int lexcon; /* lexical context type (see lex.c) */
+ int nsubexp; /* subexpression count */
+ struct subre **subs; /* subRE pointer vector */
+ size_t nsubs; /* length of vector */
+ struct subre *sub10[10]; /* initial vector, enough for most */
+ struct nfa *nfa; /* the NFA */
+ struct colormap *cm; /* character color map */
+ color nlcolor; /* color of newline */
+ struct state *wordchrs; /* state in nfa holding word-char outarcs */
+ 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 */
+ struct cvec *cv; /* interface cvec */
+ struct cvec *cv2; /* utility cvec */
+ struct cvec *mcces; /* collating-element information */
+# define ISCELEADER(v,c) (v->mcces != NULL && haschr(v->mcces, (c)))
+ struct state *mccepbegin; /* in nfa, start of MCCE prototypes */
+ struct state *mccepend; /* in nfa, end of MCCE prototypes */
+ struct subre *lacons; /* lookahead-constraint vector */
+ int nlacons; /* size of lacons */
+};
+
+/* parsing macros; most know that `v' is the struct vars pointer */
+#define NEXT() (next(v)) /* advance by one token */
+#define SEE(t) (v->nexttype == (t)) /* is next token this? */
+#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 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 NOTE(b) (v->re->re_info |= (b)) /* note visible condition */
+#define EMPTYARC(x, y) newarc(v->nfa, EMPTY, 0, x, y)
+
+/* token type codes, some also used as NFA arc types */
+#define EMPTY 'n' /* no token present */
+#define EOS 'e' /* end of string */
+#define PLAIN 'p' /* ordinary character */
+#define DIGIT 'd' /* digit (in bound) */
+#define BACKREF 'b' /* back reference */
+#define COLLEL 'I' /* start of [. */
+#define ECLASS 'E' /* start of [= */
+#define CCLASS 'C' /* start of [: */
+#define END 'X' /* end of [. [= [: */
+#define RANGE 'R' /* - within [] which might be range delim. */
+#define LACON 'L' /* lookahead constraint subRE */
+#define AHEAD 'a' /* color-lookahead arc */
+#define BEHIND 'r' /* color-lookbehind arc */
+#define WBDRY 'w' /* word boundary constraint */
+#define NWBDRY 'W' /* non-word-boundary constraint */
+#define SBEGIN 'A' /* beginning of string (even if not BOL) */
+#define SEND 'Z' /* end of string (even if not EOL) */
+#define PREFER 'P' /* length preference */
+
+/* is an arc colored, and hence on a color chain? */
+#define COLORED(a) ((a)->type == PLAIN || (a)->type == AHEAD || \
+ (a)->type == BEHIND)
+
+
+
+/* static function list */
+static struct fns functions = {
+ rfree, /* regfree insides */
+};
+
+
+
+/*
+ - compile - compile regular expression
+ ^ int compile(regex_t *, CONST chr *, size_t, int);
+ */
+int
+compile(re, string, len, flags)
+regex_t *re;
+CONST chr *string;
+size_t len;
+int flags;
+{
+ struct vars var;
+ struct vars *v = &var;
+ struct guts *g;
+ int i;
+ size_t j;
+ FILE *debug = (flags&REG_PROGRESS) ? stdout : (FILE *)NULL;
+# define CNOERR() { if (ISERR()) return freev(v, v->err); }
+
+ /* sanity checks */
+
+ if (re == NULL || string == NULL)
+ return REG_INVARG;
+ if ((flags&REG_QUOTE) &&
+ (flags&(REG_ADVANCED|REG_EXPANDED|REG_NEWLINE)))
+ return REG_INVARG;
+ if (!(flags&REG_EXTENDED) && (flags&REG_ADVF))
+ return REG_INVARG;
+
+ /* initial setup (after which freev() is callable) */
+ v->re = re;
+ v->now = (chr *)string;
+ v->stop = v->now + len;
+ v->savenow = v->savestop = NULL;
+ v->err = 0;
+ v->cflags = flags;
+ v->nsubexp = 0;
+ v->subs = v->sub10;
+ v->nsubs = 10;
+ for (j = 0; j < v->nsubs; j++)
+ v->subs[j] = NULL;
+ v->nfa = NULL;
+ v->cm = NULL;
+ v->nlcolor = COLORLESS;
+ v->wordchrs = NULL;
+ v->tree = NULL;
+ v->treechain = NULL;
+ v->treefree = NULL;
+ v->cv = NULL;
+ v->cv2 = NULL;
+ v->mcces = NULL;
+ v->lacons = NULL;
+ v->nlacons = 0;
+ re->re_magic = REMAGIC;
+ re->re_info = 0; /* bits get set during parse */
+ re->re_csize = sizeof(chr);
+ re->re_guts = NULL;
+ re->re_fns = VS(&functions);
+
+ /* more complex setup, malloced things */
+ re->re_guts = VS(MALLOC(sizeof(struct guts)));
+ if (re->re_guts == NULL)
+ return freev(v, REG_ESPACE);
+ g = (struct guts *)re->re_guts;
+ g->tree = NULL;
+ initcm(v, &g->cmap);
+ v->cm = &g->cmap;
+ g->lacons = NULL;
+ g->nlacons = 0;
+ ZAPCNFA(g->search);
+ v->nfa = newnfa(v, v->cm, (struct nfa *)NULL);
+ CNOERR();
+ v->cv = newcvec(100, 20, 10);
+ if (v->cv == NULL)
+ return freev(v, REG_ESPACE);
+ i = nmcces(v);
+ if (i > 0) {
+ v->mcces = newcvec(nleaders(v), 0, i);
+ CNOERR();
+ v->mcces = allmcces(v, v->mcces);
+ leaders(v, v->mcces);
+ addmcce(v->mcces, (chr *)NULL, (chr *)NULL); /* dummy */
+ }
+ CNOERR();
+
+ /* parsing */
+ lexstart(v); /* also handles prefixes */
+ if ((v->cflags&REG_NLSTOP) || (v->cflags&REG_NLANCH)) {
+ /* assign newline a unique color */
+ v->nlcolor = subcolor(v->cm, newline());
+ okcolors(v->nfa, v->cm);
+ }
+ CNOERR();
+ v->tree = parse(v, EOS, PLAIN, v->nfa->init, v->nfa->final);
+ assert(SEE(EOS)); /* even if error; ISERR() => SEE(EOS) */
+ CNOERR();
+ assert(v->tree != NULL);
+
+ /* finish setup of nfa and its subre tree */
+ specialcolors(v->nfa);
+ CNOERR();
+ if (debug != NULL) {
+ fprintf(debug, "\n\n\n========= RAW ==========\n");
+ dumpnfa(v->nfa, debug);
+ dumpst(v->tree, debug, 1);
+ }
+ optst(v, v->tree);
+ v->ntree = numst(v->tree, 1);
+ markst(v->tree);
+ cleanst(v);
+ if (debug != NULL) {
+ fprintf(debug, "\n\n\n========= TREE FIXED ==========\n");
+ dumpst(v->tree, debug, 1);
+ }
+
+ /* build compacted NFAs for tree and lacons */
+ re->re_info |= nfatree(v, v->tree, debug);
+ CNOERR();
+ assert(v->nlacons == 0 || v->lacons != NULL);
+ for (i = 1; i < v->nlacons; i++) {
+ if (debug != NULL)
+ fprintf(debug, "\n\n\n========= LA%d ==========\n", i);
+ nfanode(v, &v->lacons[i], debug);
+ }
+ CNOERR();
+ if (v->tree->flags&SHORTER)
+ NOTE(REG_USHORTEST);
+
+ /* build compacted NFAs for tree, lacons, fast search */
+ if (debug != NULL)
+ fprintf(debug, "\n\n\n========= SEARCH ==========\n");
+ /* can sacrifice main NFA now, so use it as work area */
+ (DISCARD)optimize(v->nfa, debug);
+ CNOERR();
+ makesearch(v, v->nfa);
+ CNOERR();
+ compact(v->nfa, &g->search);
+ CNOERR();
+
+ /* looks okay, package it up */
+ re->re_nsub = v->nsubexp;
+ v->re = NULL; /* freev no longer frees re */
+ g->magic = GUTSMAGIC;
+ g->cflags = v->cflags;
+ g->info = re->re_info;
+ g->nsub = re->re_nsub;
+ g->tree = v->tree;
+ v->tree = NULL;
+ g->ntree = v->ntree;
+ g->compare = (v->cflags&REG_ICASE) ? casecmp : cmp;
+ g->lacons = v->lacons;
+ v->lacons = NULL;
+ g->nlacons = v->nlacons;
+
+ if (flags&REG_DUMP)
+ dump(re, stdout);
+
+ assert(v->err == 0);
+ return freev(v, 0);
+}
+
+/*
+ - moresubs - enlarge subRE vector
+ ^ static VOID moresubs(struct vars *, int);
+ */
+static VOID
+moresubs(v, wanted)
+struct vars *v;
+int wanted; /* want enough room for this one */
+{
+ struct subre **p;
+ size_t n;
+
+ assert(wanted > 0 && (size_t)wanted >= v->nsubs);
+ n = (size_t)wanted * 3 / 2 + 1;
+ if (v->subs == v->sub10) {
+ p = (struct subre **)MALLOC(n * sizeof(struct subre *));
+ if (p != NULL)
+ memcpy(VS(p), VS(v->subs),
+ v->nsubs * sizeof(struct subre *));
+ } else
+ p = (struct subre **)REALLOC(v->subs, n*sizeof(struct subre *));
+ if (p == NULL) {
+ ERR(REG_ESPACE);
+ return;
+ }
+ v->subs = p;
+ for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++)
+ *p = NULL;
+ assert(v->nsubs == n);
+ assert((size_t)wanted < v->nsubs);
+}
+
+/*
+ - freev - free vars struct's substructures where necessary
+ * Optionally does error-number setting, and always returns error code
+ * (if any), to make error-handling code terser.
+ ^ static int freev(struct vars *, int);
+ */
+static int
+freev(v, err)
+struct vars *v;
+int err;
+{
+ if (v->re != NULL)
+ rfree(v->re);
+ if (v->subs != v->sub10)
+ FREE(v->subs);
+ if (v->nfa != NULL)
+ freenfa(v->nfa);
+ if (v->tree != NULL)
+ freesubre(v, v->tree);
+ if (v->treechain != NULL)
+ cleanst(v);
+ if (v->cv != NULL)
+ freecvec(v->cv);
+ if (v->cv2 != NULL)
+ freecvec(v->cv2);
+ if (v->mcces != NULL)
+ freecvec(v->mcces);
+ if (v->lacons != NULL)
+ freelacons(v->lacons, v->nlacons);
+ ERR(err); /* nop if err==0 */
+
+ return v->err;
+}
+
+/*
+ - makesearch - turn an NFA into a search NFA (implicit prepend of .*?)
+ * NFA must have been optimize()d already.
+ ^ static VOID makesearch(struct vars *, struct nfa *);
+ */
+static VOID
+makesearch(v, nfa)
+struct vars *v;
+struct nfa *nfa;
+{
+ struct arc *a;
+ struct arc *b;
+ struct state *pre = nfa->pre;
+ struct state *s;
+ struct state *s2;
+ struct state *slist;
+
+ /* no loops are needed if it's anchored */
+ for (a = pre->outs; a != NULL; a = a->outchain) {
+ assert(a->type == PLAIN);
+ if (a->co != nfa->bos[0] && a->co != nfa->bos[1])
+ break;
+ }
+ if (a != NULL) {
+ /* add implicit .* in front */
+ rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre);
+
+ /* and ^* and \A* too -- not always necessary, but harmless */
+ newarc(nfa, PLAIN, nfa->bos[0], pre, pre);
+ newarc(nfa, PLAIN, nfa->bos[1], pre, pre);
+ }
+
+ /*
+ * Now here's the subtle part. Because many REs have no lookback
+ * constraints, often knowing when you were in the pre state tells
+ * you little; it's the next state(s) that are informative. But
+ * some of them may have other inarcs, i.e. it may be possible to
+ * make actual progress and then return to one of them. We must
+ * de-optimize such cases, splitting each such state into progress
+ * and no-progress states.
+ */
+
+ /* first, make a list of the states */
+ slist = NULL;
+ for (a = pre->outs; a != NULL; a = a->outchain) {
+ s = a->to;
+ for (b = s->ins; b != NULL; b = b->inchain)
+ if (b->from != pre)
+ break;
+ if (b != NULL) { /* must be split */
+ s->tmp = slist;
+ slist = s;
+ }
+ }
+
+ /* do the splits */
+ for (s = slist; s != NULL; s = s2) {
+ s2 = newstate(nfa);
+ copyouts(nfa, s, s2);
+ for (a = s->ins; a != NULL; a = b) {
+ b = a->inchain;
+ if (a->from != pre) {
+ cparc(nfa, a, a->from, s2);
+ freearc(nfa, a);
+ }
+ }
+ s2 = s->tmp;
+ s->tmp = NULL; /* clean up while we're at it */
+ }
+}
+
+/*
+ - parse - parse an RE
+ * This is actually just the top level, which parses a bunch of branches
+ * tied together with '|'. They appear in the tree as the left children
+ * of a chain of '|' subres.
+ ^ static struct subre *parse(struct vars *, int, int, struct state *,
+ ^ struct state *);
+ */
+static struct subre *
+parse(v, stopper, type, init, final)
+struct vars *v;
+int stopper; /* EOS or ')' */
+int type; /* LACON (lookahead subRE) or PLAIN */
+struct state *init; /* initial state */
+struct state *final; /* final state */
+{
+ struct state *left; /* scaffolding for branch */
+ struct state *right;
+ struct subre *branches; /* top level */
+ struct subre *branch; /* current branch */
+ struct subre *t; /* temporary */
+ int firstbranch; /* is this the first branch? */
+
+ assert(stopper == ')' || stopper == EOS);
+
+ branches = subre(v, '|', LONGER, init, final);
+ NOERRN();
+ branch = branches;
+ firstbranch = 1;
+ do { /* a branch */
+ if (!firstbranch) {
+ /* need a place to hang it */
+ branch->right = subre(v, '|', LONGER, init, final);
+ NOERRN();
+ branch = branch->right;
+ }
+ firstbranch = 0;
+ left = newstate(v->nfa);
+ right = newstate(v->nfa);
+ NOERRN();
+ EMPTYARC(init, left);
+ EMPTYARC(right, final);
+ NOERRN();
+ branch->left = parsebranch(v, stopper, type, left, right, 0);
+ NOERRN();
+ branch->flags |= UP(branch->flags | branch->left->flags);
+ if ((branch->flags &~ branches->flags) != 0) /* new flags */
+ for (t = branches; t != branch; t = t->right)
+ t->flags |= branch->flags;
+ } while (EAT('|'));
+ assert(SEE(stopper) || SEE(EOS));
+
+ if (!SEE(stopper)) {
+ assert(stopper == ')' && SEE(EOS));
+ ERR(REG_EPAREN);
+ }
+
+ /* optimize out simple cases */
+ if (branch == branches) { /* only one branch */
+ assert(branch->right == NULL);
+ t = branch->left;
+ branch->left = NULL;
+ freesubre(v, branches);
+ branches = t;
+ } else if (!MESSY(branches->flags)) { /* no interesting innards */
+ freesubre(v, branches->left);
+ branches->left = NULL;
+ freesubre(v, branches->right);
+ branches->right = NULL;
+ branches->op = '=';
+ }
+
+ return branches;
+}
+
+/*
+ - parsebranch - parse one branch of an RE
+ * This mostly manages concatenation, working closely with parseqatom().
+ * Concatenated things are bundled up as much as possible, with separate
+ * ',' nodes introduced only when necessary due to substructure.
+ ^ static struct subre *parsebranch(struct vars *, int, int, struct state *,
+ ^ struct state *, int);
+ */
+static struct subre *
+parsebranch(v, stopper, type, left, right, partial)
+struct vars *v;
+int stopper; /* EOS or ')' */
+int type; /* LACON (lookahead subRE) or PLAIN */
+struct state *left; /* leftmost state */
+struct state *right; /* rightmost state */
+int partial; /* is this only part of a branch? */
+{
+ struct state *lp; /* left end of current construct */
+ int seencontent; /* is there anything in this branch yet? */
+ struct subre *t;
+
+ lp = left;
+ seencontent = 0;
+ t = subre(v, '=', 0, left, right); /* op '=' is tentative */
+ NOERRN();
+ while (!SEE('|') && !SEE(stopper) && !SEE(EOS)) {
+ if (seencontent) { /* implicit concat operator */
+ lp = newstate(v->nfa);
+ NOERRN();
+ moveins(v->nfa, right, lp);
+ }
+ seencontent = 1;
+
+ /* NB, recursion in parseqatom() may swallow rest of branch */
+ parseqatom(v, stopper, type, lp, right, t);
+ }
+
+ if (!seencontent) { /* empty branch */
+ if (!partial)
+ NOTE(REG_UUNSPEC);
+ assert(lp == left);
+ EMPTYARC(left, right);
+ }
+
+ return t;
+}
+
+/*
+ - parseqatom - parse one quantified atom or constraint of an RE
+ * The bookkeeping near the end cooperates very closely with parsebranch();
+ * in particular, it contains a recursion that can involve parsing the rest
+ * of the branch, making this function's name somewhat inaccurate.
+ ^ static VOID parseqatom(struct vars *, int, int, struct state *,
+ ^ struct state *, struct subre *);
+ */
+static VOID
+parseqatom(v, stopper, type, lp, rp, top)
+struct vars *v;
+int stopper; /* EOS or ')' */
+int type; /* LACON (lookahead subRE) or PLAIN */
+struct state *lp; /* left state to hang it on */
+struct state *rp; /* right state to hang it on */
+struct subre *top; /* subtree top */
+{
+ struct state *s; /* temporaries for new states */
+ struct state *s2;
+# define ARCV(t, val) newarc(v->nfa, t, val, lp, rp)
+ int m, n;
+ struct subre *atom; /* atom's subtree */
+ struct subre *t;
+ int cap; /* capturing parens? */
+ int pos; /* positive lookahead? */
+ int subno; /* capturing-parens or backref number */
+ int atomtype;
+ int qprefer; /* quantifier short/long preference */
+ int f;
+ struct subre **atomp; /* where the pointer to atom is */
+
+ /* initial bookkeeping */
+ atom = NULL;
+ assert(lp->nouts == 0); /* must string new code */
+ assert(rp->nins == 0); /* between lp and rp */
+ subno = 0; /* just to shut lint up */
+
+ /* an atom or constraint... */
+ atomtype = v->nexttype;
+ switch (atomtype) {
+ /* first, constraints, which end by returning */
+ case '^':
+ ARCV('^', 1);
+ if (v->cflags&REG_NLANCH)
+ ARCV(BEHIND, v->nlcolor);
+ NEXT();
+ return;
+ break;
+ case '$':
+ ARCV('$', 1);
+ if (v->cflags&REG_NLANCH)
+ ARCV(AHEAD, v->nlcolor);
+ NEXT();
+ return;
+ break;
+ case SBEGIN:
+ ARCV('^', 1); /* BOL */
+ ARCV('^', 0); /* or BOS */
+ NEXT();
+ return;
+ break;
+ case SEND:
+ ARCV('$', 1); /* EOL */
+ ARCV('$', 0); /* or EOS */
+ NEXT();
+ return;
+ break;
+ case '<':
+ wordchrs(v); /* does NEXT() */
+ s = newstate(v->nfa);
+ NOERR();
+ nonword(v, BEHIND, lp, s);
+ word(v, AHEAD, s, rp);
+ return;
+ break;
+ case '>':
+ wordchrs(v); /* does NEXT() */
+ s = newstate(v->nfa);
+ NOERR();
+ word(v, BEHIND, lp, s);
+ nonword(v, AHEAD, s, rp);
+ return;
+ break;
+ case WBDRY:
+ wordchrs(v); /* does NEXT() */
+ s = newstate(v->nfa);
+ NOERR();
+ nonword(v, BEHIND, lp, s);
+ word(v, AHEAD, s, rp);
+ s = newstate(v->nfa);
+ NOERR();
+ word(v, BEHIND, lp, s);
+ nonword(v, AHEAD, s, rp);
+ return;
+ break;
+ case NWBDRY:
+ wordchrs(v); /* does NEXT() */
+ s = newstate(v->nfa);
+ NOERR();
+ word(v, BEHIND, lp, s);
+ word(v, AHEAD, s, rp);
+ s = newstate(v->nfa);
+ NOERR();
+ nonword(v, BEHIND, lp, s);
+ nonword(v, AHEAD, s, rp);
+ return;
+ break;
+ case LACON: /* lookahead constraint */
+ pos = v->nextvalue;
+ NEXT();
+ s = newstate(v->nfa);
+ s2 = newstate(v->nfa);
+ NOERR();
+ t = parse(v, ')', LACON, s, s2);
+ freesubre(v, t); /* internal structure irrelevant */
+ assert(SEE(')') || ISERR());
+ NEXT();
+ n = newlacon(v, s, s2, pos);
+ NOERR();
+ ARCV(LACON, n);
+ return;
+ break;
+ /* then errors, to get them out of the way */
+ case '*':
+ case '+':
+ case '?':
+ case '{':
+ ERR(REG_BADRPT);
+ return;
+ break;
+ default:
+ ERR(REG_ASSERT);
+ return;
+ break;
+ /* then plain characters, and minor variants on that theme */
+ case ')': /* unbalanced paren */
+ if ((v->cflags&REG_ADVANCED) != REG_EXTENDED) {
+ ERR(REG_EPAREN);
+ return;
+ }
+ /* legal in EREs due to specification botch */
+ NOTE(REG_UPBOTCH);
+ /* fallthrough into case PLAIN */
+ case PLAIN:
+ onechr(v, v->nextvalue, lp, rp);
+ okcolors(v->nfa, v->cm);
+ NOERR();
+ NEXT();
+ break;
+ case '[':
+ if (v->nextvalue == 1)
+ bracket(v, lp, rp);
+ else
+ cbracket(v, lp, rp);
+ assert(SEE(']') || ISERR());
+ NEXT();
+ break;
+ case '.':
+ rainbow(v->nfa, v->cm, PLAIN,
+ (v->cflags&REG_NLSTOP) ? v->nlcolor : COLORLESS,
+ lp, rp);
+ NEXT();
+ break;
+ /* and finally the ugly stuff */
+ case '(': /* value flags as capturing or non */
+ cap = (type == LACON) ? 0 : v->nextvalue;
+ if (cap) {
+ v->nsubexp++;
+ subno = v->nsubexp;
+ if ((size_t)subno >= v->nsubs)
+ moresubs(v, subno);
+ assert((size_t)subno < v->nsubs);
+ } else
+ atomtype = PLAIN; /* something that's not '(' */
+ NEXT();
+ /* need new endpoints because tree will contain pointers */
+ s = newstate(v->nfa);
+ s2 = newstate(v->nfa);
+ NOERR();
+ EMPTYARC(lp, s);
+ EMPTYARC(s2, rp);
+ NOERR();
+ atom = parse(v, ')', PLAIN, s, s2);
+ assert(SEE(')') || ISERR());
+ NEXT();
+ NOERR();
+ if (cap) {
+ v->subs[subno] = atom;
+ t = subre(v, '(', atom->flags|CAP, lp, rp);
+ NOERR();
+ t->subno = subno;
+ t->left = atom;
+ atom = t;
+ }
+ /* postpone everything else pending possible {0} */
+ break;
+ case BACKREF: /* the Feature From The Black Lagoon */
+ INSIST(type != LACON, REG_ESUBREG);
+ INSIST(v->nextvalue < v->nsubs, REG_ESUBREG);
+ INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG);
+ NOERR();
+ assert(v->nextvalue > 0);
+ atom = subre(v, 'b', BACKR, lp, rp);
+ subno = v->nextvalue;
+ atom->subno = subno;
+ EMPTYARC(lp, rp); /* temporarily, so there's something */
+ NEXT();
+ break;
+ }
+
+ /* ...and an atom may be followed by a quantifier */
+ switch (v->nexttype) {
+ case '*':
+ m = 0;
+ n = INFINITY;
+ qprefer = (v->nextvalue) ? LONGER : SHORTER;
+ NEXT();
+ break;
+ case '+':
+ m = 1;
+ n = INFINITY;
+ qprefer = (v->nextvalue) ? LONGER : SHORTER;
+ NEXT();
+ break;
+ case '?':
+ m = 0;
+ n = 1;
+ qprefer = (v->nextvalue) ? LONGER : SHORTER;
+ NEXT();
+ break;
+ case '{':
+ NEXT();
+ m = scannum(v);
+ if (EAT(',')) {
+ if (SEE(DIGIT))
+ n = scannum(v);
+ else
+ n = INFINITY;
+ if (m > n) {
+ ERR(REG_BADBR);
+ return;
+ }
+ /* {m,n} exercises preference, even if it's {m,m} */
+ qprefer = (v->nextvalue) ? LONGER : SHORTER;
+ } else {
+ n = m;
+ /* {m} passes operand's preference through */
+ qprefer = 0;
+ }
+ if (!SEE('}')) { /* catches errors too */
+ ERR(REG_BADBR);
+ return;
+ }
+ NEXT();
+ break;
+ default: /* no quantifier */
+ m = n = 1;
+ qprefer = 0;
+ break;
+ }
+
+ /* annoying special case: {0} or {0,0} cancels everything */
+ if (m == 0 && n == 0) {
+ if (atom != NULL)
+ freesubre(v, atom);
+ if (atomtype == '(')
+ v->subs[subno] = NULL;
+ delsub(v->nfa, lp, rp);
+ EMPTYARC(lp, rp);
+ return;
+ }
+
+ /* if not a messy case, avoid hard part */
+ assert(!MESSY(top->flags));
+ f = top->flags | qprefer | ((atom != NULL) ? atom->flags : 0);
+ if (atomtype != '(' && atomtype != BACKREF && !MESSY(UP(f))) {
+ if (!(m == 1 && n == 1))
+ repeat(v, lp, rp, m, n);
+ if (atom != NULL)
+ freesubre(v, atom);
+ top->flags = f;
+ return;
+ }
+
+ /*
+ * hard part: something messy
+ * That is, capturing parens, back reference, short/long clash, or
+ * an atom with substructure containing one of those.
+ */
+
+ /* now we'll need a subre for the contents even if they're boring */
+ if (atom == NULL) {
+ atom = subre(v, '=', 0, lp, rp);
+ NOERR();
+ }
+
+ /*
+ * prepare a general-purpose state skeleton
+ *
+ * ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
+ * / /
+ * [lp] ----> [s2] ----bypass---------------------
+ *
+ * where bypass is an empty, and prefix is some repetitions of atom
+ */
+ s = newstate(v->nfa); /* first, new endpoints for the atom */
+ s2 = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ moveins(v->nfa, rp, s2);
+ NOERR();
+ atom->begin = s;
+ atom->end = s2;
+ s = newstate(v->nfa); /* and spots for prefix and bypass */
+ s2 = newstate(v->nfa);
+ NOERR();
+ EMPTYARC(lp, s);
+ EMPTYARC(lp, s2);
+ NOERR();
+
+ /* break remaining subRE into x{...} and what follows */
+ t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
+ t->left = atom;
+ atomp = &t->left;
+ /* here we should recurse... but we must postpone that to the end */
+
+ /* split top into prefix and remaining */
+ assert(top->op == '=' && top->left == NULL && top->right == NULL);
+ top->left = subre(v, '=', top->flags, top->begin, lp);
+ top->op = '.';
+ top->right = t;
+
+ /* if it's a backref, now is the time to replicate the subNFA */
+ if (atomtype == BACKREF) {
+ assert(atom->begin->nouts == 1); /* just the EMPTY */
+ delsub(v->nfa, atom->begin, atom->end);
+ assert(v->subs[subno] != NULL);
+ /* and here's why the recursion got postponed: it must */
+ /* wait until the skeleton is filled in, because it may */
+ /* hit a backref that wants to copy the filled-in skeleton */
+ dupnfa(v->nfa, v->subs[subno]->begin, v->subs[subno]->end,
+ atom->begin, atom->end);
+ NOERR();
+ }
+
+ /* 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 */
+ if (atomtype == BACKREF) {
+ /* special case: backrefs have internal quantifiers */
+ EMPTYARC(s, atom->begin); /* empty prefix */
+ /* just stuff everything into atom */
+ repeat(v, atom->begin, atom->end, m, n);
+ atom->min = (short)m;
+ atom->max = (short)n;
+ atom->flags |= COMBINE(qprefer, atom->flags);
+ } else if (m == 1 && n == 1) {
+ /* no/vacuous quantifier: done */
+ EMPTYARC(s, atom->begin); /* empty prefix */
+ } else {
+ /* turn x{m,n} into x{m-1,n-1}x, with capturing */
+ /* parens in only second x */
+ 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);
+ f = COMBINE(qprefer, atom->flags);
+ t = subre(v, '.', f, s, atom->end); /* prefix and atom */
+ NOERR();
+ t->left = subre(v, '=', PREF(f), s, atom->begin);
+ NOERR();
+ t->right = atom;
+ *atomp = t;
+ }
+
+ /* and finally, look after that postponed recursion */
+ t = top->right;
+ if (!(SEE('|') || SEE(stopper) || SEE(EOS)))
+ t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
+ else {
+ EMPTYARC(atom->end, rp);
+ t->right = subre(v, '=', 0, atom->end, rp);
+ }
+ assert(SEE('|') || SEE(stopper) || SEE(EOS));
+ t->flags |= COMBINE(t->flags, t->right->flags);
+ top->flags |= COMBINE(top->flags, t->flags);
+}
+
+/*
+ - nonword - generate arcs for non-word-character ahead or behind
+ ^ static VOID nonword(struct vars *, int, struct state *, struct state *);
+ */
+static VOID
+nonword(v, dir, lp, rp)
+struct vars *v;
+int dir; /* AHEAD or BEHIND */
+struct state *lp;
+struct state *rp;
+{
+ int anchor = (dir == AHEAD) ? '$' : '^';
+
+ assert(dir == AHEAD || dir == BEHIND);
+ newarc(v->nfa, anchor, 1, lp, rp);
+ newarc(v->nfa, anchor, 0, lp, rp);
+ colorcomplement(v->nfa, v->cm, dir, v->wordchrs, lp, rp);
+ /* (no need for special attention to \n) */
+}
+
+/*
+ - word - generate arcs for word character ahead or behind
+ ^ static VOID word(struct vars *, int, struct state *, struct state *);
+ */
+static VOID
+word(v, dir, lp, rp)
+struct vars *v;
+int dir; /* AHEAD or BEHIND */
+struct state *lp;
+struct state *rp;
+{
+ assert(dir == AHEAD || dir == BEHIND);
+ cloneouts(v->nfa, v->wordchrs, lp, rp, dir);
+ /* (no need for special attention to \n) */
+}
+
+/*
+ - scannum - scan a number
+ ^ static int scannum(struct vars *);
+ */
+static int /* value, <= DUPMAX */
+scannum(v)
+struct vars *v;
+{
+ int n = 0;
+
+ while (SEE(DIGIT) && n < DUPMAX) {
+ n = n*10 + v->nextvalue;
+ NEXT();
+ }
+ if (SEE(DIGIT) || n > DUPMAX) {
+ ERR(REG_BADBR);
+ return 0;
+ }
+ return n;
+}
+
+/*
+ - repeat - replicate subNFA for quantifiers
+ * 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 and right end states, however!) This used to be important for the
+ * subRE tree, although the important bits are now handled by the in-line
+ * code in parse(), and when this is called, it doesn't matter any more.
+ ^ static VOID repeat(struct vars *, struct state *, struct state *, int, int);
+ */
+static VOID
+repeat(v, lp, rp, m, n)
+struct vars *v;
+struct state *lp;
+struct state *rp;
+int m;
+int n;
+{
+# define SOME 2
+# define INF 3
+# define PAIR(x, y) ((x)*4 + (y))
+# define REDUCE(x) ( ((x) == INFINITY) ? INF : (((x) > 1) ? SOME : (x)) )
+ CONST int rm = REDUCE(m);
+ CONST int rn = REDUCE(n);
+ struct state *s;
+ struct state *s2;
+
+ switch (PAIR(rm, rn)) {
+ case PAIR(0, 0): /* empty string */
+ delsub(v->nfa, lp, rp);
+ EMPTYARC(lp, rp);
+ break;
+ case PAIR(0, 1): /* do as x| */
+ EMPTYARC(lp, rp);
+ break;
+ case PAIR(0, SOME): /* do as x{1,n}| */
+ repeat(v, lp, rp, 1, n);
+ NOERR();
+ EMPTYARC(lp, rp);
+ break;
+ case PAIR(0, INF): /* loop x around */
+ s = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ moveins(v->nfa, rp, s);
+ EMPTYARC(lp, s);
+ EMPTYARC(s, rp);
+ break;
+ case PAIR(1, 1): /* no action required */
+ break;
+ case PAIR(1, SOME): /* do as x{0,n-1}x = (x{1,n-1}|)x */
+ s = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ dupnfa(v->nfa, s, rp, lp, s);
+ NOERR();
+ repeat(v, lp, s, 1, n-1);
+ NOERR();
+ EMPTYARC(lp, s);
+ break;
+ case PAIR(1, INF): /* add loopback arc */
+ s = newstate(v->nfa);
+ s2 = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ moveins(v->nfa, rp, s2);
+ EMPTYARC(lp, s);
+ EMPTYARC(s2, rp);
+ EMPTYARC(s2, s);
+ break;
+ case PAIR(SOME, SOME): /* do as x{m-1,n-1}x */
+ s = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ dupnfa(v->nfa, s, rp, lp, s);
+ NOERR();
+ repeat(v, lp, s, m-1, n-1);
+ break;
+ case PAIR(SOME, INF): /* do as x{m-1,}x */
+ s = newstate(v->nfa);
+ NOERR();
+ moveouts(v->nfa, lp, s);
+ dupnfa(v->nfa, s, rp, lp, s);
+ NOERR();
+ repeat(v, lp, s, m-1, n);
+ break;
+ default:
+ ERR(REG_ASSERT);
+ break;
+ }
+}
+
+/*
+ - bracket - handle non-complemented bracket expression
+ * Also called from cbracket for complemented bracket expressions.
+ ^ static VOID bracket(struct vars *, struct state *, struct state *);
+ */
+static VOID
+bracket(v, lp, rp)
+struct vars *v;
+struct state *lp;
+struct state *rp;
+{
+ assert(SEE('['));
+ NEXT();
+ while (!SEE(']') && !SEE(EOS))
+ brackpart(v, lp, rp);
+ assert(SEE(']') || ISERR());
+ okcolors(v->nfa, v->cm);
+}
+
+/*
+ - cbracket - handle complemented bracket expression
+ * We do it by calling bracket() with dummy endpoints, and then complementing
+ * the result. The alternative would be to invoke rainbow(), and then delete
+ * arcs as the b.e. is seen... but that gets messy.
+ ^ static VOID cbracket(struct vars *, struct state *, struct state *);
+ */
+static VOID
+cbracket(v, lp, rp)
+struct vars *v;
+struct state *lp;
+struct state *rp;
+{
+ struct state *left = newstate(v->nfa);
+ struct state *right = newstate(v->nfa);
+ struct state *s;
+ struct arc *a; /* arc from lp */
+ struct arc *ba; /* arc from left, from bracket() */
+ struct arc *pa; /* MCCE-prototype arc */
+ color co;
+ chr *p;
+ int i;
+
+ NOERR();
+ bracket(v, left, right);
+ if (v->cflags&REG_NLSTOP)
+ newarc(v->nfa, PLAIN, v->nlcolor, left, right);
+ NOERR();
+
+ assert(lp->nouts == 0); /* all outarcs will be ours */
+
+ /* easy part of complementing */
+ colorcomplement(v->nfa, v->cm, PLAIN, left, lp, rp);
+ NOERR();
+ if (v->mcces == NULL) { /* no MCCEs -- we're done */
+ dropstate(v->nfa, left);
+ assert(right->nins == 0);
+ freestate(v->nfa, right);
+ return;
+ }
+
+ /* but complementing gets messy in the presence of MCCEs... */
+ NOTE(REG_ULOCALE);
+ for (p = v->mcces->chrs, i = v->mcces->nchrs; i > 0; p++, i--) {
+ co = GETCOLOR(v->cm, *p);
+ a = findarc(lp, PLAIN, co);
+ ba = findarc(left, PLAIN, co);
+ if (ba == NULL) {
+ assert(a != NULL);
+ freearc(v->nfa, a);
+ } else {
+ assert(a == NULL);
+ }
+ s = newstate(v->nfa);
+ NOERR();
+ newarc(v->nfa, PLAIN, co, lp, s);
+ NOERR();
+ pa = findarc(v->mccepbegin, PLAIN, co);
+ assert(pa != NULL);
+ if (ba == NULL) { /* easy case, need all of them */
+ cloneouts(v->nfa, pa->to, s, rp, PLAIN);
+ newarc(v->nfa, '$', 1, s, rp);
+ newarc(v->nfa, '$', 0, s, rp);
+ colorcomplement(v->nfa, v->cm, AHEAD, pa->to, s, rp);
+ } else { /* must be selective */
+ if (findarc(ba->to, '$', 1) == NULL) {
+ newarc(v->nfa, '$', 1, s, rp);
+ newarc(v->nfa, '$', 0, s, rp);
+ colorcomplement(v->nfa, v->cm, AHEAD, pa->to,
+ s, rp);
+ }
+ for (pa = pa->to->outs; pa != NULL; pa = pa->outchain)
+ if (findarc(ba->to, PLAIN, pa->co) == NULL)
+ newarc(v->nfa, PLAIN, pa->co, s, rp);
+ if (s->nouts == 0) /* limit of selectivity: none */
+ dropstate(v->nfa, s); /* frees arc too */
+ }
+ NOERR();
+ }
+
+ delsub(v->nfa, left, right);
+ assert(left->nouts == 0);
+ freestate(v->nfa, left);
+ assert(right->nins == 0);
+ freestate(v->nfa, right);
+}
+
+/*
+ - brackpart - handle one item (or range) within a bracket expression
+ ^ static VOID brackpart(struct vars *, struct state *, struct state *);
+ */
+static VOID
+brackpart(v, lp, rp)
+struct vars *v;
+struct state *lp;
+struct state *rp;
+{
+ celt startc;
+ celt endc;
+ struct cvec *cv;
+ chr *startp;
+ chr *endp;
+ chr c[1];
+
+ /* parse something, get rid of special cases, take shortcuts */
+ switch (v->nexttype) {
+ case RANGE: /* a-b-c or other botch */
+ ERR(REG_ERANGE);
+ return;
+ break;
+ case PLAIN:
+ c[0] = v->nextvalue;
+ NEXT();
+ /* shortcut for ordinary chr (not range, not MCCE leader) */
+ if (!SEE(RANGE) && !ISCELEADER(v, c[0])) {
+ onechr(v, c[0], lp, rp);
+ return;
+ }
+ startc = element(v, c, c+1);
+ NOERR();
+ break;
+ case COLLEL:
+ startp = v->now;
+ endp = scanplain(v);
+ INSIST(startp < endp, REG_ECOLLATE);
+ NOERR();
+ startc = element(v, startp, endp);
+ NOERR();
+ break;
+ case ECLASS:
+ startp = v->now;
+ endp = scanplain(v);
+ INSIST(startp < endp, REG_ECOLLATE);
+ NOERR();
+ startc = element(v, startp, endp);
+ NOERR();
+ cv = eclass(v, startc, (v->cflags&REG_ICASE));
+ NOERR();
+ dovec(v, cv, lp, rp);
+ return;
+ break;
+ case CCLASS:
+ startp = v->now;
+ endp = scanplain(v);
+ INSIST(startp < endp, REG_ECTYPE);
+ NOERR();
+ cv = cclass(v, startp, endp, (v->cflags&REG_ICASE));
+ NOERR();
+ dovec(v, cv, lp, rp);
+ return;
+ break;
+ default:
+ ERR(REG_ASSERT);
+ return;
+ break;
+ }
+
+ if (SEE(RANGE)) {
+ NEXT();
+ switch (v->nexttype) {
+ case PLAIN:
+ case RANGE:
+ c[0] = v->nextvalue;
+ NEXT();
+ endc = element(v, c, c+1);
+ NOERR();
+ break;
+ case COLLEL:
+ startp = v->now;
+ endp = scanplain(v);
+ INSIST(startp < endp, REG_ECOLLATE);
+ NOERR();
+ endc = element(v, startp, endp);
+ NOERR();
+ break;
+ default:
+ ERR(REG_ERANGE);
+ return;
+ break;
+ }
+ } else
+ endc = startc;
+
+ /*
+ * Ranges are unportable. Actually, standard C does
+ * guarantee that digits are contiguous, but making
+ * that an exception is just too complicated.
+ */
+ if (startc != endc)
+ NOTE(REG_UUNPORT);
+ cv = range(v, startc, endc, (v->cflags&REG_ICASE));
+ NOERR();
+ dovec(v, cv, lp, rp);
+}
+
+/*
+ - scanplain - scan PLAIN contents of [. etc.
+ * Certain bits of trickery in lex.c know that this code does not try
+ * to look past the final bracket of the [. etc.
+ ^ static chr *scanplain(struct vars *);
+ */
+static chr * /* just after end of sequence */
+scanplain(v)
+struct vars *v;
+{
+ chr *endp;
+
+ assert(SEE(COLLEL) || SEE(ECLASS) || SEE(CCLASS));
+ NEXT();
+
+ endp = v->now;
+ while (SEE(PLAIN)) {
+ endp = v->now;
+ NEXT();
+ }
+
+ assert(SEE(END) || ISERR());
+ NEXT();
+
+ return endp;
+}
+
+/*
+ - leaders - process a cvec of collating elements to also include leaders
+ * Also gives all characters involved their own colors, which is almost
+ * certainly necessary, and sets up little disconnected subNFA.
+ ^ static VOID leaders(struct vars *, struct cvec *);
+ */
+static VOID
+leaders(v, cv)
+struct vars *v;
+struct cvec *cv;
+{
+ int mcce;
+ chr *p;
+ chr leader;
+ struct state *s;
+ struct arc *a;
+
+ v->mccepbegin = newstate(v->nfa);
+ v->mccepend = newstate(v->nfa);
+ NOERR();
+
+ for (mcce = 0; mcce < cv->nmcces; mcce++) {
+ p = cv->mcces[mcce];
+ leader = *p;
+ if (!haschr(cv, leader)) {
+ addchr(cv, leader);
+ s = newstate(v->nfa);
+ newarc(v->nfa, PLAIN, subcolor(v->cm, leader),
+ v->mccepbegin, s);
+ okcolors(v->nfa, v->cm);
+ } else {
+ a = findarc(v->mccepbegin, PLAIN,
+ GETCOLOR(v->cm, leader));
+ assert(a != NULL);
+ s = a->to;
+ assert(s != v->mccepend);
+ }
+ p++;
+ assert(*p != 0 && *(p+1) == 0); /* only 2-char MCCEs for now */
+ newarc(v->nfa, PLAIN, subcolor(v->cm, *p), s, v->mccepend);
+ okcolors(v->nfa, v->cm);
+ }
+}
+
+/*
+ - onechr - fill in arcs for a plain character, and possible case complements
+ * This is mostly a shortcut for efficient handling of the common case.
+ ^ static VOID onechr(struct vars *, pchr, struct state *, struct state *);
+ */
+static VOID
+onechr(v, c, lp, rp)
+struct vars *v;
+pchr c;
+struct state *lp;
+struct state *rp;
+{
+ if (!(v->cflags&REG_ICASE)) {
+ newarc(v->nfa, PLAIN, subcolor(v->cm, c), lp, rp);
+ return;
+ }
+
+ /* rats, need general case anyway... */
+ dovec(v, allcases(v, c), lp, rp);
+}
+
+/*
+ - dovec - fill in arcs for each element of a cvec
+ * This one has to handle the messy cases, like MCCEs and MCCE leaders.
+ ^ static VOID dovec(struct vars *, struct cvec *, struct state *,
+ ^ struct state *);
+ */
+static VOID
+dovec(v, cv, lp, rp)
+struct vars *v;
+struct cvec *cv;
+struct state *lp;
+struct state *rp;
+{
+ chr ch, from, to;
+ celt ce;
+ chr *p;
+ int i;
+ color co;
+ struct cvec *leads;
+ struct arc *a;
+ struct arc *pa; /* arc in prototype */
+ struct state *s;
+ struct state *ps; /* state in prototype */
+
+ /* need a place to store leaders, if any */
+ if (nmcces(v) > 0) {
+ assert(v->mcces != NULL);
+ if (v->cv2 == NULL || v->cv2->nchrs < v->mcces->nchrs) {
+ if (v->cv2 != NULL)
+ free(v->cv2);
+ v->cv2 = newcvec(v->mcces->nchrs, 0, v->mcces->nmcces);
+ NOERR();
+ leads = v->cv2;
+ } else
+ leads = clearcvec(v->cv2);
+ } else
+ leads = NULL;
+
+ /* first, get the ordinary characters out of the way */
+ for (p = cv->chrs, i = cv->nchrs; i > 0; p++, i--) {
+ ch = *p;
+ if (!ISCELEADER(v, ch))
+ newarc(v->nfa, PLAIN, subcolor(v->cm, ch), lp, rp);
+ else {
+ assert(singleton(v->cm, ch));
+ assert(leads != NULL);
+ if (!haschr(leads, ch))
+ addchr(leads, ch);
+ }
+ }
+
+ /* and the ranges */
+ for (p = cv->ranges, i = cv->nranges; i > 0; p += 2, i--) {
+ from = *p;
+ to = *(p+1);
+ while (from <= to && (ce = nextleader(v, from, to)) != NOCELT) {
+ if (from < ce)
+ subrange(v, from, ce - 1, lp, rp);
+ assert(singleton(v->cm, ce));
+ assert(leads != NULL);
+ if (!haschr(leads, ce))
+ addchr(leads, ce);
+ from = ce + 1;
+ }
+ if (from <= to)
+ subrange(v, from, to, lp, rp);
+ }
+
+ if ((leads == NULL || leads->nchrs == 0) && cv->nmcces == 0)
+ return;
+
+ /* deal with the MCCE leaders */
+ NOTE(REG_ULOCALE);
+ for (p = leads->chrs, i = leads->nchrs; i > 0; p++, i--) {
+ co = GETCOLOR(v->cm, *p);
+ a = findarc(lp, PLAIN, co);
+ if (a != NULL)
+ s = a->to;
+ else {
+ s = newstate(v->nfa);
+ NOERR();
+ newarc(v->nfa, PLAIN, co, lp, s);
+ NOERR();
+ }
+ pa = findarc(v->mccepbegin, PLAIN, co);
+ assert(pa != NULL);
+ ps = pa->to;
+ newarc(v->nfa, '$', 1, s, rp);
+ newarc(v->nfa, '$', 0, s, rp);
+ colorcomplement(v->nfa, v->cm, AHEAD, ps, s, rp);
+ NOERR();
+ }
+
+ /* and the MCCEs */
+ for (i = 0; i < cv->nmcces; i++) {
+ p = cv->mcces[i];
+ assert(singleton(v->cm, *p));
+ if (!singleton(v->cm, *p)) {
+ ERR(REG_ASSERT);
+ return;
+ }
+ ch = *p++;
+ co = GETCOLOR(v->cm, ch);
+ a = findarc(lp, PLAIN, co);
+ if (a != NULL)
+ s = a->to;
+ else {
+ s = newstate(v->nfa);
+ NOERR();
+ newarc(v->nfa, PLAIN, co, lp, s);
+ NOERR();
+ }
+ assert(*p != 0); /* at least two chars */
+ assert(singleton(v->cm, *p));
+ ch = *p++;
+ co = GETCOLOR(v->cm, ch);
+ assert(*p == 0); /* and only two, for now */
+ newarc(v->nfa, PLAIN, co, s, rp);
+ NOERR();
+ }
+}
+
+/*
+ - nextleader - find next MCCE leader within range
+ ^ static celt nextleader(struct vars *, pchr, pchr);
+ */
+static celt /* NOCELT means none */
+nextleader(v, from, to)
+struct vars *v;
+pchr from;
+pchr to;
+{
+ int i;
+ chr *p;
+ chr ch;
+ celt it = NOCELT;
+
+ if (v->mcces == NULL)
+ return it;
+
+ for (i = v->mcces->nchrs, p = v->mcces->chrs; i > 0; i--, p++) {
+ ch = *p;
+ if (from <= ch && ch <= to)
+ if (it == NOCELT || ch < it)
+ it = ch;
+ }
+ return it;
+}
+
+/*
+ - wordchrs - set up word-chr list for word-boundary stuff, if needed
+ * The list is kept as a bunch of arcs between two dummy states; it's
+ * disposed of by the unreachable-states sweep in NFA optimization.
+ * Does NEXT(). Must not be called from any unusual lexical context.
+ * This should be reconciled with the \w etc. handling in lex.c, and
+ * should be cleaned up to reduce dependencies on input scanning.
+ ^ static VOID wordchrs(struct vars *);
+ */
+static VOID
+wordchrs(v)
+struct vars *v;
+{
+ struct state *left;
+ struct state *right;
+
+ if (v->wordchrs != NULL) {
+ NEXT(); /* for consistency */
+ return;
+ }
+
+ left = newstate(v->nfa);
+ right = newstate(v->nfa);
+ NOERR();
+ /* fine point: implemented with [::], and lexer will set REG_ULOCALE */
+ lexword(v);
+ NEXT();
+ assert(v->savenow != NULL && SEE('['));
+ bracket(v, left, right);
+ assert((v->savenow != NULL && SEE(']')) || ISERR());
+ NEXT();
+ NOERR();
+ v->wordchrs = left;
+}
+
+/*
+ - subre - allocate a subre
+ ^ static struct subre *subre(struct vars *, int, int, struct state *,
+ ^ struct state *);
+ */
+static struct subre *
+subre(v, op, flags, begin, end)
+struct vars *v;
+int op;
+int flags;
+struct state *begin;
+struct state *end;
+{
+ struct subre *ret;
+
+ ret = v->treefree;
+ if (ret != NULL)
+ v->treefree = ret->left;
+ else {
+ ret = (struct subre *)MALLOC(sizeof(struct subre));
+ if (ret == NULL) {
+ ERR(REG_ESPACE);
+ return NULL;
+ }
+ ret->chain = v->treechain;
+ v->treechain = ret;
+ }
+
+ assert(strchr("|.b(=", op) != NULL);
+
+ ret->op = op;
+ ret->flags = flags;
+ ret->retry = 0;
+ ret->subno = 0;
+ ret->min = ret->max = 1;
+ ret->left = NULL;
+ ret->right = NULL;
+ ret->begin = begin;
+ ret->end = end;
+ ZAPCNFA(ret->cnfa);
+
+ return ret;
+}
+
+/*
+ - freesubre - free a subRE subtree
+ ^ static VOID freesubre(struct vars *, struct subre *);
+ */
+static VOID
+freesubre(v, sr)
+struct vars *v; /* might be NULL */
+struct subre *sr;
+{
+ if (sr == NULL)
+ return;
+
+ if (sr->left != NULL)
+ freesubre(v, sr->left);
+ if (sr->right != NULL)
+ freesubre(v, sr->right);
+
+ freesrnode(v, sr);
+}
+
+/*
+ - freesrnode - free one node in a subRE subtree
+ ^ static VOID freesrnode(struct vars *, struct subre *);
+ */
+static VOID
+freesrnode(v, sr)
+struct vars *v; /* might be NULL */
+struct subre *sr;
+{
+ if (sr == NULL)
+ return;
+
+ if (!NULLCNFA(sr->cnfa))
+ freecnfa(&sr->cnfa);
+ sr->flags = 0;
+
+ if (v != NULL) {
+ sr->left = v->treefree;
+ v->treefree = sr;
+ } else
+ FREE(sr);
+}
+
+/*
+ - optst - optimize a subRE subtree
+ ^ static VOID optst(struct vars *, struct subre *);
+ */
+static VOID
+optst(v, t)
+struct vars *v;
+struct subre *t;
+{
+ if (t == NULL)
+ return;
+
+ /* recurse through children */
+ if (t->left != NULL)
+ optst(v, t->left);
+ if (t->right != NULL)
+ optst(v, t->right);
+}
+
+/*
+ - numst - number tree nodes (assigning retry indexes)
+ ^ static int numst(struct subre *, int);
+ */
+static int /* next number */
+numst(t, start)
+struct subre *t;
+int start; /* starting point for subtree numbers */
+{
+ int i;
+
+ assert(t != NULL);
+
+ i = start;
+ t->retry = (short)i++;
+ if (t->left != NULL)
+ i = numst(t->left, i);
+ if (t->right != NULL)
+ i = numst(t->right, i);
+ return i;
+}
+
+/*
+ - markst - mark tree nodes as INUSE
+ ^ static VOID markst(struct subre *);
+ */
+static VOID
+markst(t)
+struct subre *t;
+{
+ assert(t != NULL);
+
+ t->flags |= INUSE;
+ if (t->left != NULL)
+ markst(t->left);
+ if (t->right != NULL)
+ markst(t->right);
+}
+
+/*
+ - cleanst - free any tree nodes not marked INUSE
+ ^ static VOID cleanst(struct vars *);
+ */
+static VOID
+cleanst(v)
+struct vars *v;
+{
+ struct subre *t;
+ struct subre *next;
+
+ for (t = v->treechain; t != NULL; t = next) {
+ next = t->chain;
+ if (!(t->flags&INUSE))
+ FREE(t);
+ }
+ v->treechain = NULL;
+ v->treefree = NULL; /* just on general principles */
+}
+
+/*
+ - nfatree - turn a subRE subtree into a tree of compacted NFAs
+ ^ static long nfatree(struct vars *, struct subre *, FILE *);
+ */
+static long /* optimize results from top node */
+nfatree(v, t, f)
+struct vars *v;
+struct subre *t;
+FILE *f; /* for debug output */
+{
+ assert(t != NULL && t->begin != NULL);
+
+ if (t->left != NULL)
+ (DISCARD)nfatree(v, t->left, f);
+ if (t->right != NULL)
+ (DISCARD)nfatree(v, t->right, f);
+
+ return nfanode(v, t, f);
+}
+
+/*
+ - nfanode - do one NFA for nfatree
+ ^ static long nfanode(struct vars *, struct subre *, FILE *);
+ */
+static long /* optimize results */
+nfanode(v, t, f)
+struct vars *v;
+struct subre *t;
+FILE *f; /* for debug output */
+{
+ struct nfa *nfa;
+ long ret = 0;
+ char idbuf[50];
+
+ assert(t->begin != NULL);
+
+ if (f != NULL)
+ fprintf(f, "\n\n\n========= TREE NODE %s ==========\n",
+ stid(t, idbuf, sizeof(idbuf)));
+ nfa = newnfa(v, v->cm, v->nfa);
+ NOERRZ();
+ dupnfa(nfa, t->begin, t->end, nfa->init, nfa->final);
+ if (!ISERR()) {
+ specialcolors(nfa);
+ ret = optimize(nfa, f);
+ }
+ if (!ISERR())
+ compact(nfa, &t->cnfa);
+
+ freenfa(nfa);
+ return ret;
+}
+
+/*
+ - newlacon - allocate a lookahead-constraint subRE
+ ^ static int newlacon(struct vars *, struct state *, struct state *, int);
+ */
+static int /* lacon number */
+newlacon(v, begin, end, pos)
+struct vars *v;
+struct state *begin;
+struct state *end;
+int pos;
+{
+ int n;
+ struct subre *sub;
+
+ if (v->nlacons == 0) {
+ v->lacons = (struct subre *)MALLOC(2 * sizeof(struct subre));
+ n = 1; /* skip 0th */
+ v->nlacons = 2;
+ } else {
+ v->lacons = (struct subre *)REALLOC(v->lacons,
+ (v->nlacons+1)*sizeof(struct subre));
+ n = v->nlacons++;
+ }
+ if (v->lacons == NULL) {
+ ERR(REG_ESPACE);
+ return 0;
+ }
+ sub = &v->lacons[n];
+ sub->begin = begin;
+ sub->end = end;
+ sub->subno = pos;
+ ZAPCNFA(sub->cnfa);
+ return n;
+}
+
+/*
+ - freelacons - free lookahead-constraint subRE vector
+ ^ static VOID freelacons(struct subre *, int);
+ */
+static VOID
+freelacons(subs, n)
+struct subre *subs;
+int n;
+{
+ struct subre *sub;
+ int i;
+
+ assert(n > 0);
+ for (sub = subs + 1, i = n - 1; i > 0; sub++, i--) /* no 0th */
+ if (!NULLCNFA(sub->cnfa))
+ freecnfa(&sub->cnfa);
+ FREE(subs);
+}
+
+/*
+ - rfree - free a whole RE (insides of regfree)
+ ^ static VOID rfree(regex_t *);
+ */
+static VOID
+rfree(re)
+regex_t *re;
+{
+ struct guts *g;
+
+ if (re == NULL || re->re_magic != REMAGIC)
+ return;
+
+ re->re_magic = 0; /* invalidate RE */
+ 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((struct vars *)NULL, g->tree);
+ if (g->lacons != NULL)
+ freelacons(g->lacons, g->nlacons);
+ if (!NULLCNFA(g->search))
+ freecnfa(&g->search);
+ FREE(g);
+}
+
+/*
+ - dump - dump an RE in human-readable form
+ ^ static VOID dump(regex_t *, FILE *);
+ */
+static VOID
+dump(re, f)
+regex_t *re;
+FILE *f;
+{
+#ifdef REG_DEBUG
+ struct guts *g;
+ int i;
+
+ if (re->re_magic != REMAGIC)
+ fprintf(f, "bad magic number (0x%x not 0x%x)\n", re->re_magic,
+ REMAGIC);
+ if (re->re_guts == NULL) {
+ fprintf(f, "NULL guts!!!\n");
+ return;
+ }
+ g = (struct guts *)re->re_guts;
+ if (g->magic != GUTSMAGIC)
+ fprintf(f, "bad guts magic number (0x%x not 0x%x)\n", g->magic,
+ GUTSMAGIC);
+
+ 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);
+
+ dumpcolors(&g->cmap, f);
+ if (!NULLCNFA(g->search)) {
+ printf("\nsearch:\n");
+ dumpcnfa(&g->search, f);
+ }
+ for (i = 1; i < g->nlacons; i++) {
+ fprintf(f, "\nla%d (%s):\n", i,
+ (g->lacons[i].subno) ? "positive" : "negative");
+ dumpcnfa(&g->lacons[i].cnfa, f);
+ }
+ fprintf(f, "\n");
+ dumpst(g->tree, f, 0);
+#endif
+}
+
+/*
+ - dumpst - dump a subRE tree
+ ^ static VOID dumpst(struct subre *, FILE *, int);
+ */
+static VOID
+dumpst(t, f, nfapresent)
+struct subre *t;
+FILE *f;
+int nfapresent; /* is the original NFA still around? */
+{
+ if (t == NULL)
+ fprintf(f, "null tree\n");
+ else
+ stdump(t, f, nfapresent);
+ fflush(f);
+}
+
+/*
+ - stdump - recursive guts of dumpst
+ ^ static VOID stdump(struct subre *, FILE *, int);
+ */
+static VOID
+stdump(t, f, nfapresent)
+struct subre *t;
+FILE *f;
+int nfapresent; /* is the original NFA still around? */
+{
+ char idbuf[50];
+
+ fprintf(f, "%s. `%c'", stid(t, idbuf, sizeof(idbuf)), t->op);
+ if (t->flags&LONGER)
+ fprintf(f, " longest");
+ if (t->flags&SHORTER)
+ fprintf(f, " shortest");
+ if (t->flags&MIXED)
+ fprintf(f, " hasmixed");
+ if (t->flags&CAP)
+ fprintf(f, " hascapture");
+ if (t->flags&BACKR)
+ fprintf(f, " hasbackref");
+ if (!(t->flags&INUSE))
+ fprintf(f, " UNUSED");
+ if (t->subno != 0)
+ fprintf(f, " (#%d)", t->subno);
+ if (t->min != 1 || t->max != 1) {
+ fprintf(f, " {%d,", t->min);
+ if (t->max != INFINITY)
+ fprintf(f, "%d", t->max);
+ fprintf(f, "}");
+ }
+ if (nfapresent)
+ fprintf(f, " %ld-%ld", (long)t->begin->no, (long)t->end->no);
+ if (t->left != NULL)
+ fprintf(f, " L:%s", stid(t->left, idbuf, sizeof(idbuf)));
+ if (t->right != NULL)
+ fprintf(f, " R:%s", stid(t->right, idbuf, sizeof(idbuf)));
+ if (!NULLCNFA(t->cnfa)) {
+ fprintf(f, "\n");
+ dumpcnfa(&t->cnfa, f);
+ fprintf(f, "\n");
+ }
+ if (t->left != NULL)
+ stdump(t->left, f, nfapresent);
+ if (t->right != NULL)
+ stdump(t->right, f, nfapresent);
+}
+
+/*
+ - stid - identify a subtree node for dumping
+ ^ static char *stid(struct subre *, char *, size_t);
+ */
+static char * /* points to buf or constant string */
+stid(t, buf, bufsize)
+struct subre *t;
+char *buf;
+size_t bufsize;
+{
+ /* big enough for hex int or decimal t->retry? */
+ if (bufsize < sizeof(int)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1)
+ return "unable";
+ if (t->retry != 0)
+ sprintf(buf, "%d", t->retry);
+ else
+ sprintf(buf, "0x%x", (int)t); /* may lose bits, that's okay */
+ return buf;
+}
+
+#include "regc_lex.c"
+#include "regc_color.c"
+#include "regc_nfa.c"
+#include "regc_cvec.c"
+#include "regc_locale.c"
diff --git a/tcl/generic/regcustom.h b/tcl/generic/regcustom.h
new file mode 100644
index 00000000000..9f505de7e68
--- /dev/null
+++ b/tcl/generic/regcustom.h
@@ -0,0 +1,114 @@
+/*
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+/* headers if any */
+#include "tclInt.h"
+
+/* overrides for regguts.h definitions, if any */
+#define FUNCPTR(name, args) (*name) _ANSI_ARGS_(args)
+#define MALLOC(n) ckalloc(n)
+#define FREE(p) ckfree(VS(p))
+#define REALLOC(p,n) ckrealloc(VS(p),n)
+
+
+
+/*
+ * Do not insert extras between the "begin" and "end" lines -- this
+ * chunk is automatically extracted to be fitted into regex.h.
+ */
+/* --- begin --- */
+/* ensure certain things don't sneak in from system headers */
+#ifdef __REG_WIDE_T
+#undef __REG_WIDE_T
+#endif
+#ifdef __REG_WIDE_COMPILE
+#undef __REG_WIDE_COMPILE
+#endif
+#ifdef __REG_WIDE_EXEC
+#undef __REG_WIDE_EXEC
+#endif
+#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
+#ifdef __REG_NOCHAR
+#undef __REG_NOCHAR
+#endif
+/* 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
+#define __REG_NOFRONT /* don't want regcomp() and regexec() */
+#define __REG_NOCHAR /* or the char versions */
+#define regfree TclReFree
+#define regerror TclReError
+/* --- end --- */
+
+
+
+/* internal character type and related */
+typedef Tcl_UniChar chr; /* the type itself */
+typedef int pchr; /* what it promotes to */
+typedef unsigned uchr; /* unsigned type that will hold a chr */
+typedef int celt; /* type to hold chr, MCCE number, or NOCELT */
+#define NOCELT (-1) /* celt value which is not valid chr or MCCE */
+#define CHR(c) (UCHAR(c)) /* turn char literal into chr literal */
+#define DIGITVAL(c) ((c)-'0') /* turn chr digit into its value */
+#define CHRBITS 16 /* bits in a chr; must not use sizeof */
+#define CHR_MIN 0x0000 /* smallest and largest chr; the value */
+#define CHR_MAX 0xffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
+
+/* functions operating on chr */
+#define iscalnum(x) Tcl_UniCharIsAlnum(x)
+#define iscalpha(x) Tcl_UniCharIsAlpha(x)
+#define iscdigit(x) Tcl_UniCharIsDigit(x)
+#define iscspace(x) Tcl_UniCharIsSpace(x)
+
+/* name the external functions */
+#define compile TclReComp
+#define exec TclReExec
+
+/* enable/disable debugging code (by whether REG_DEBUG is defined or not) */
+#if 0 /* no debug unless requested by makefile */
+#define REG_DEBUG /* */
+#endif
+
+/* and pick up the standard header */
+#include "regex.h"
diff --git a/tcl/generic/rege_dfa.c b/tcl/generic/rege_dfa.c
new file mode 100644
index 00000000000..313892cc8fc
--- /dev/null
+++ b/tcl/generic/rege_dfa.c
@@ -0,0 +1,677 @@
+/*
+ * DFA routines
+ * This file is #included by regexec.c.
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+/*
+ - longest - longest-preferred matching engine
+ ^ static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *);
+ */
+static chr * /* endpoint, or NULL */
+longest(v, d, start, stop, hitstopp)
+struct vars *v; /* used only for debug and exec flags */
+struct dfa *d;
+chr *start; /* where the match should start */
+chr *stop; /* match must end at or before here */
+int *hitstopp; /* record whether hit v->stop, if non-NULL */
+{
+ chr *cp;
+ chr *realstop = (stop == v->stop) ? stop : stop + 1;
+ color co;
+ struct sset *css;
+ struct sset *ss;
+ chr *post;
+ int i;
+ struct colormap *cm = d->cm;
+
+ /* initialize */
+ css = initialize(v, d, start);
+ cp = start;
+ if (hitstopp != NULL)
+ *hitstopp = 0;
+
+ /* startup */
+ FDEBUG(("+++ startup +++\n"));
+ if (cp == v->start) {
+ co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
+ FDEBUG(("color %ld\n", (long)co));
+ } else {
+ co = GETCOLOR(cm, *(cp - 1));
+ FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
+ }
+ css = miss(v, d, css, co, cp, start);
+ if (css == NULL)
+ return NULL;
+ css->lastseen = cp;
+
+ /* main loop */
+ if (v->eflags&REG_FTRACE)
+ while (cp < realstop) {
+ FDEBUG(("+++ at c%d +++\n", css - d->ssets));
+ co = GETCOLOR(cm, *cp);
+ FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
+ ss = css->outs[co];
+ if (ss == NULL) {
+ ss = miss(v, d, css, co, cp+1, start);
+ if (ss == NULL)
+ break; /* NOTE BREAK OUT */
+ }
+ cp++;
+ ss->lastseen = cp;
+ css = ss;
+ }
+ else
+ while (cp < realstop) {
+ co = GETCOLOR(cm, *cp);
+ ss = css->outs[co];
+ if (ss == NULL) {
+ ss = miss(v, d, css, co, cp+1, start);
+ if (ss == NULL)
+ break; /* NOTE BREAK OUT */
+ }
+ cp++;
+ ss->lastseen = cp;
+ css = ss;
+ }
+
+ /* shutdown */
+ FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
+ if (cp == v->stop && stop == v->stop) {
+ if (hitstopp != NULL)
+ *hitstopp = 1;
+ co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
+ FDEBUG(("color %ld\n", (long)co));
+ ss = miss(v, d, css, co, cp, start);
+ /* special case: match ended at eol? */
+ if (ss != NULL && (ss->flags&POSTSTATE))
+ return cp;
+ else if (ss != NULL)
+ ss->lastseen = cp; /* to be tidy */
+ }
+
+ /* find last match, if any */
+ post = d->lastpost;
+ for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--)
+ if ((ss->flags&POSTSTATE) && post != ss->lastseen &&
+ (post == NULL || post < ss->lastseen))
+ post = ss->lastseen;
+ if (post != NULL) /* found one */
+ return post - 1;
+
+ return NULL;
+}
+
+/*
+ - shortest - shortest-preferred matching engine
+ ^ static chr *shortest(struct vars *, struct dfa *, chr *, chr *, chr *,
+ ^ chr **, int *);
+ */
+static chr * /* endpoint, or NULL */
+shortest(v, d, start, min, max, coldp, hitstopp)
+struct vars *v;
+struct dfa *d;
+chr *start; /* where the match should start */
+chr *min; /* match must end at or after here */
+chr *max; /* match must end at or before here */
+chr **coldp; /* store coldstart pointer here, if nonNULL */
+int *hitstopp; /* record whether hit v->stop, if non-NULL */
+{
+ chr *cp;
+ chr *realmin = (min == v->stop) ? min : min + 1;
+ chr *realmax = (max == v->stop) ? max : max + 1;
+ color co;
+ struct sset *css;
+ struct sset *ss;
+ struct colormap *cm = d->cm;
+
+ /* initialize */
+ css = initialize(v, d, start);
+ cp = start;
+ if (hitstopp != NULL)
+ *hitstopp = 0;
+
+ /* startup */
+ FDEBUG(("--- startup ---\n"));
+ if (cp == v->start) {
+ co = d->cnfa->bos[(v->eflags&REG_NOTBOL) ? 0 : 1];
+ FDEBUG(("color %ld\n", (long)co));
+ } else {
+ co = GETCOLOR(cm, *(cp - 1));
+ FDEBUG(("char %c, color %ld\n", (char)*(cp-1), (long)co));
+ }
+ css = miss(v, d, css, co, cp, start);
+ if (css == NULL)
+ return NULL;
+ css->lastseen = cp;
+ ss = css;
+
+ /* main loop */
+ if (v->eflags&REG_FTRACE)
+ while (cp < realmax) {
+ FDEBUG(("--- at c%d ---\n", css - d->ssets));
+ co = GETCOLOR(cm, *cp);
+ FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
+ ss = css->outs[co];
+ if (ss == NULL) {
+ ss = miss(v, d, css, co, cp+1, start);
+ if (ss == NULL)
+ break; /* NOTE BREAK OUT */
+ }
+ cp++;
+ ss->lastseen = cp;
+ css = ss;
+ if ((ss->flags&POSTSTATE) && cp >= realmin)
+ break; /* NOTE BREAK OUT */
+ }
+ else
+ while (cp < realmax) {
+ co = GETCOLOR(cm, *cp);
+ ss = css->outs[co];
+ if (ss == NULL) {
+ ss = miss(v, d, css, co, cp+1, start);
+ if (ss == NULL)
+ break; /* NOTE BREAK OUT */
+ }
+ cp++;
+ ss->lastseen = cp;
+ css = ss;
+ if ((ss->flags&POSTSTATE) && cp >= realmin)
+ break; /* NOTE BREAK OUT */
+ }
+
+ if (ss == NULL)
+ return NULL;
+
+ if (coldp != NULL) /* report last no-progress state set, if any */
+ *coldp = lastcold(v, d);
+
+ if ((ss->flags&POSTSTATE) && cp > min) {
+ assert(cp >= realmin);
+ cp--;
+ } else if (cp == v->stop && max == v->stop) {
+ co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
+ FDEBUG(("color %ld\n", (long)co));
+ ss = miss(v, d, css, co, cp, start);
+ /* match might have ended at eol */
+ if ((ss == NULL || !(ss->flags&POSTSTATE)) && hitstopp != NULL)
+ *hitstopp = 1;
+ }
+
+ if (ss == NULL || !(ss->flags&POSTSTATE))
+ return NULL;
+
+ return cp;
+}
+
+/*
+ - lastcold - determine last point at which no progress had been made
+ ^ static chr *lastcold(struct vars *, struct dfa *);
+ */
+static chr * /* endpoint, or NULL */
+lastcold(v, d)
+struct vars *v;
+struct dfa *d;
+{
+ struct sset *ss;
+ chr *nopr;
+ int i;
+
+ nopr = d->lastnopr;
+ if (nopr == NULL)
+ nopr = v->start;
+ for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--)
+ if ((ss->flags&NOPROGRESS) && nopr < ss->lastseen)
+ nopr = ss->lastseen;
+ return nopr;
+}
+
+/*
+ - newdfa - set up a fresh DFA
+ ^ static struct dfa *newdfa(struct vars *, struct cnfa *,
+ ^ struct colormap *, struct smalldfa *);
+ */
+static struct dfa *
+newdfa(v, cnfa, cm, small)
+struct vars *v;
+struct cnfa *cnfa;
+struct colormap *cm;
+struct smalldfa *small; /* preallocated space, may be NULL */
+{
+ struct dfa *d;
+ size_t nss = cnfa->nstates * 2;
+ int wordsper = (cnfa->nstates + UBITS - 1) / UBITS;
+ struct smalldfa *smallwas = small;
+
+ assert(cnfa != NULL && cnfa->nstates != 0);
+
+ if (nss <= FEWSTATES && cnfa->ncolors <= FEWCOLORS) {
+ assert(wordsper == 1);
+ if (small == NULL) {
+ small = (struct smalldfa *)MALLOC(
+ sizeof(struct smalldfa));
+ if (small == NULL) {
+ ERR(REG_ESPACE);
+ return NULL;
+ }
+ }
+ d = &small->dfa;
+ d->ssets = small->ssets;
+ d->statesarea = small->statesarea;
+ d->work = &d->statesarea[nss];
+ d->outsarea = small->outsarea;
+ d->incarea = small->incarea;
+ d->cptsmalloced = 0;
+ d->mallocarea = (smallwas == NULL) ? (char *)small : NULL;
+ } else {
+ d = (struct dfa *)MALLOC(sizeof(struct dfa));
+ if (d == NULL) {
+ ERR(REG_ESPACE);
+ return NULL;
+ }
+ d->ssets = (struct sset *)MALLOC(nss * sizeof(struct sset));
+ d->statesarea = (unsigned *)MALLOC((nss+WORK) * wordsper *
+ sizeof(unsigned));
+ d->work = &d->statesarea[nss * wordsper];
+ d->outsarea = (struct sset **)MALLOC(nss * cnfa->ncolors *
+ sizeof(struct sset *));
+ d->incarea = (struct arcp *)MALLOC(nss * cnfa->ncolors *
+ sizeof(struct arcp));
+ d->cptsmalloced = 1;
+ d->mallocarea = (char *)d;
+ if (d->ssets == NULL || d->statesarea == NULL ||
+ d->outsarea == NULL || d->incarea == NULL) {
+ freedfa(d);
+ ERR(REG_ESPACE);
+ return NULL;
+ }
+ }
+
+ d->nssets = (v->eflags&REG_SMALL) ? 7 : nss;
+ d->nssused = 0;
+ d->nstates = cnfa->nstates;
+ d->ncolors = cnfa->ncolors;
+ d->wordsper = wordsper;
+ d->cnfa = cnfa;
+ d->cm = cm;
+ d->lastpost = NULL;
+ d->lastnopr = NULL;
+ d->search = d->ssets;
+
+ /* initialization of sset fields is done as needed */
+
+ return d;
+}
+
+/*
+ - freedfa - free a DFA
+ ^ static VOID freedfa(struct dfa *);
+ */
+static VOID
+freedfa(d)
+struct dfa *d;
+{
+ if (d->cptsmalloced) {
+ if (d->ssets != NULL)
+ FREE(d->ssets);
+ if (d->statesarea != NULL)
+ FREE(d->statesarea);
+ if (d->outsarea != NULL)
+ FREE(d->outsarea);
+ if (d->incarea != NULL)
+ FREE(d->incarea);
+ }
+
+ if (d->mallocarea != NULL)
+ FREE(d->mallocarea);
+}
+
+/*
+ - hash - construct a hash code for a bitvector
+ * There are probably better ways, but they're more expensive.
+ ^ static unsigned hash(unsigned *, int);
+ */
+static unsigned
+hash(uv, n)
+unsigned *uv;
+int n;
+{
+ int i;
+ unsigned h;
+
+ h = 0;
+ for (i = 0; i < n; i++)
+ h ^= uv[i];
+ return h;
+}
+
+/*
+ - initialize - hand-craft a cache entry for startup, otherwise get ready
+ ^ static struct sset *initialize(struct vars *, struct dfa *, chr *);
+ */
+static struct sset *
+initialize(v, d, start)
+struct vars *v; /* used only for debug flags */
+struct dfa *d;
+chr *start;
+{
+ struct sset *ss;
+ int i;
+
+ /* is previous one still there? */
+ if (d->nssused > 0 && (d->ssets[0].flags&STARTER))
+ ss = &d->ssets[0];
+ else { /* no, must (re)build it */
+ ss = getvacant(v, d, start, start);
+ for (i = 0; i < d->wordsper; i++)
+ ss->states[i] = 0;
+ BSET(ss->states, d->cnfa->pre);
+ ss->hash = HASH(ss->states, d->wordsper);
+ assert(d->cnfa->pre != d->cnfa->post);
+ ss->flags = STARTER|LOCKED|NOPROGRESS;
+ /* lastseen dealt with below */
+ }
+
+ for (i = 0; i < d->nssused; i++)
+ d->ssets[i].lastseen = NULL;
+ ss->lastseen = start; /* maybe untrue, but harmless */
+ d->lastpost = NULL;
+ d->lastnopr = NULL;
+ return ss;
+}
+
+/*
+ - miss - handle a cache miss
+ ^ static struct sset *miss(struct vars *, struct dfa *, struct sset *,
+ ^ pcolor, chr *, chr *);
+ */
+static struct sset * /* NULL if goes to empty set */
+miss(v, d, css, co, cp, start)
+struct vars *v; /* used only for debug flags */
+struct dfa *d;
+struct sset *css;
+pcolor co;
+chr *cp; /* next chr */
+chr *start; /* where the attempt got started */
+{
+ struct cnfa *cnfa = d->cnfa;
+ int i;
+ unsigned h;
+ struct carc *ca;
+ struct sset *p;
+ int ispost;
+ int noprogress;
+ int gotstate;
+ int dolacons;
+ int sawlacons;
+
+ /* for convenience, we can be called even if it might not be a miss */
+ if (css->outs[co] != NULL) {
+ FDEBUG(("hit\n"));
+ return css->outs[co];
+ }
+ FDEBUG(("miss\n"));
+
+ /* first, what set of states would we end up in? */
+ for (i = 0; i < d->wordsper; i++)
+ d->work[i] = 0;
+ ispost = 0;
+ noprogress = 1;
+ gotstate = 0;
+ for (i = 0; i < d->nstates; i++)
+ if (ISBSET(css->states, i))
+ for (ca = cnfa->states[i]+1; 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)
+ noprogress = 0;
+ FDEBUG(("%d -> %d\n", i, ca->to));
+ }
+ dolacons = (gotstate) ? (cnfa->flags&HASLACONS) : 0;
+ sawlacons = 0;
+ while (dolacons) { /* transitive closure */
+ dolacons = 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)
+ continue; /* NOTE CONTINUE */
+ sawlacons = 1;
+ if (ISBSET(d->work, ca->to))
+ continue; /* NOTE CONTINUE */
+ if (!lacon(v, cnfa, cp, ca->co))
+ continue; /* NOTE CONTINUE */
+ BSET(d->work, ca->to);
+ dolacons = 1;
+ if (ca->to == cnfa->post)
+ ispost = 1;
+ if (!cnfa->states[ca->to]->co)
+ noprogress = 0;
+ FDEBUG(("%d :> %d\n", i, ca->to));
+ }
+ }
+ if (!gotstate)
+ return NULL;
+ h = HASH(d->work, d->wordsper);
+
+ /* next, is that in the cache? */
+ 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));
+ break; /* NOTE BREAK OUT */
+ }
+ if (i == 0) { /* nope, need a new cache entry */
+ p = getvacant(v, d, cp, start);
+ assert(p != css);
+ for (i = 0; i < d->wordsper; i++)
+ p->states[i] = d->work[i];
+ p->hash = h;
+ p->flags = (ispost) ? POSTSTATE : 0;
+ if (noprogress)
+ p->flags |= NOPROGRESS;
+ /* lastseen to be dealt with by caller */
+ }
+
+ if (!sawlacons) { /* lookahead conds. always cache miss */
+ FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
+ css->outs[co] = p;
+ css->inchain[co] = p->ins;
+ p->ins.ss = css;
+ p->ins.co = (color)co;
+ }
+ return p;
+}
+
+/*
+ - lacon - lookahead-constraint checker for miss()
+ ^ static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
+ */
+static int /* predicate: constraint satisfied? */
+lacon(v, pcnfa, cp, co)
+struct vars *v;
+struct cnfa *pcnfa; /* parent cnfa */
+chr *cp;
+pcolor co; /* "color" of the lookahead constraint */
+{
+ int n;
+ struct subre *sub;
+ struct dfa *d;
+ struct smalldfa sd;
+ chr *end;
+
+ n = co - pcnfa->ncolors;
+ assert(n < v->g->nlacons && v->g->lacons != NULL);
+ FDEBUG(("=== testing lacon %d\n", n));
+ sub = &v->g->lacons[n];
+ d = newdfa(v, &sub->cnfa, &v->g->cmap, &sd);
+ if (d == NULL) {
+ ERR(REG_ESPACE);
+ return 0;
+ }
+ end = longest(v, d, cp, v->stop, (int *)NULL);
+ freedfa(d);
+ FDEBUG(("=== lacon %d match %d\n", n, (end != NULL)));
+ return (sub->subno) ? (end != NULL) : (end == NULL);
+}
+
+/*
+ - getvacant - get a vacant state set
+ * This routine clears out the inarcs and outarcs, but does not otherwise
+ * clear the innards of the state set -- that's up to the caller.
+ ^ static struct sset *getvacant(struct vars *, struct dfa *, chr *, chr *);
+ */
+static struct sset *
+getvacant(v, d, cp, start)
+struct vars *v; /* used only for debug flags */
+struct dfa *d;
+chr *cp;
+chr *start;
+{
+ int i;
+ struct sset *ss;
+ struct sset *p;
+ struct arcp ap;
+ struct arcp lastap;
+ color co;
+
+ ss = pickss(v, d, cp, start);
+ assert(!(ss->flags&LOCKED));
+
+ /* clear out its inarcs, including self-referential ones */
+ ap = ss->ins;
+ while ((p = ap.ss) != NULL) {
+ co = ap.co;
+ FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
+ p->outs[co] = NULL;
+ ap = p->inchain[co];
+ p->inchain[co].ss = NULL; /* paranoia */
+ }
+ ss->ins.ss = NULL;
+
+ /* take it off the inarc chains of the ssets reached by its outarcs */
+ for (i = 0; i < d->ncolors; i++) {
+ p = ss->outs[i];
+ assert(p != ss); /* not self-referential */
+ if (p == NULL)
+ continue; /* NOTE CONTINUE */
+ FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
+ if (p->ins.ss == ss && p->ins.co == i)
+ p->ins = ss->inchain[i];
+ else {
+ assert(p->ins.ss != NULL);
+ for (ap = p->ins; ap.ss != NULL &&
+ !(ap.ss == ss && ap.co == i);
+ ap = ap.ss->inchain[ap.co])
+ lastap = ap;
+ assert(ap.ss != NULL);
+ lastap.ss->inchain[lastap.co] = ss->inchain[i];
+ }
+ ss->outs[i] = NULL;
+ ss->inchain[i].ss = NULL;
+ }
+
+ /* if ss was a success state, may need to remember location */
+ if ((ss->flags&POSTSTATE) && ss->lastseen != d->lastpost &&
+ (d->lastpost == NULL || d->lastpost < ss->lastseen))
+ d->lastpost = ss->lastseen;
+
+ /* likewise for a no-progress state */
+ if ((ss->flags&NOPROGRESS) && ss->lastseen != d->lastnopr &&
+ (d->lastnopr == NULL || d->lastnopr < ss->lastseen))
+ d->lastnopr = ss->lastseen;
+
+ return ss;
+}
+
+/*
+ - pickss - pick the next stateset to be used
+ ^ static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
+ */
+static struct sset *
+pickss(v, d, cp, start)
+struct vars *v; /* used only for debug flags */
+struct dfa *d;
+chr *cp;
+chr *start;
+{
+ int i;
+ struct sset *ss;
+ struct sset *end;
+ chr *ancient;
+
+ /* shortcut for cases where cache isn't full */
+ if (d->nssused < d->nssets) {
+ i = d->nssused;
+ d->nssused++;
+ ss = &d->ssets[i];
+ FDEBUG(("new c%d\n", i));
+ /* set up innards */
+ ss->states = &d->statesarea[i * d->wordsper];
+ ss->flags = 0;
+ ss->ins.ss = NULL;
+ ss->ins.co = WHITE; /* give it some value */
+ ss->outs = &d->outsarea[i * d->ncolors];
+ ss->inchain = &d->incarea[i * d->ncolors];
+ for (i = 0; i < d->ncolors; i++) {
+ ss->outs[i] = NULL;
+ ss->inchain[i].ss = NULL;
+ }
+ return ss;
+ }
+
+ /* look for oldest, or old enough anyway */
+ if (cp - start > d->nssets*2/3) /* oldest 33% are expendable */
+ ancient = cp - d->nssets*2/3;
+ else
+ ancient = start;
+ for (ss = d->search, end = &d->ssets[d->nssets]; ss < end; ss++)
+ if ((ss->lastseen == NULL || ss->lastseen < ancient) &&
+ !(ss->flags&LOCKED)) {
+ d->search = ss + 1;
+ FDEBUG(("replacing c%d\n", ss - d->ssets));
+ return ss;
+ }
+ for (ss = d->ssets, end = d->search; ss < end; ss++)
+ if ((ss->lastseen == NULL || ss->lastseen < ancient) &&
+ !(ss->flags&LOCKED)) {
+ d->search = ss + 1;
+ FDEBUG(("replacing c%d\n", ss - d->ssets));
+ return ss;
+ }
+
+ /* nobody's old enough?!? -- something's really wrong */
+ FDEBUG(("can't find victim to replace!\n"));
+ assert(NOTREACHED);
+ ERR(REG_ASSERT);
+ return d->ssets;
+}
diff --git a/tcl/generic/regerror.c b/tcl/generic/regerror.c
new file mode 100644
index 00000000000..aca13aade03
--- /dev/null
+++ b/tcl/generic/regerror.c
@@ -0,0 +1,109 @@
+/*
+ * regerror - error-code expansion
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+#include "regguts.h"
+
+/* unknown-error explanation */
+static char unk[] = "*** unknown regex error code 0x%x ***";
+
+/* struct to map among codes, code names, and explanations */
+static struct rerr {
+ int code;
+ char *name;
+ char *explain;
+} rerrs[] = {
+ /* the actual table is built from regex.h */
+# include "regerrs.h"
+ { -1, "", "oops" }, /* explanation special-cased in code */
+};
+
+/*
+ - regerror - the interface to error numbers
+ */
+/* ARGSUSED */
+size_t /* actual space needed (including NUL) */
+regerror(errcode, preg, errbuf, errbuf_size)
+int errcode; /* error code, or REG_ATOI or REG_ITOA */
+CONST regex_t *preg; /* associated regex_t (unused at present) */
+char *errbuf; /* result buffer (unless errbuf_size==0) */
+size_t errbuf_size; /* available space in errbuf, can be 0 */
+{
+ struct rerr *r;
+ char *msg;
+ char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
+ size_t len;
+ int icode;
+
+ switch (errcode) {
+ case REG_ATOI: /* convert name to number */
+ for (r = rerrs; r->code >= 0; r++)
+ if (strcmp(r->name, errbuf) == 0)
+ break;
+ sprintf(convbuf, "%d", r->code); /* -1 for unknown */
+ msg = convbuf;
+ break;
+ case REG_ITOA: /* convert number to name */
+ icode = atoi(errbuf); /* not our problem if this fails */
+ for (r = rerrs; r->code >= 0; r++)
+ if (r->code == icode)
+ break;
+ if (r->code >= 0)
+ msg = r->name;
+ else { /* unknown; tell him the number */
+ sprintf(convbuf, "REG_%u", (unsigned)icode);
+ msg = convbuf;
+ }
+ break;
+ default: /* a real, normal error code */
+ for (r = rerrs; r->code >= 0; r++)
+ if (r->code == errcode)
+ break;
+ if (r->code >= 0)
+ msg = r->explain;
+ else { /* unknown; say so */
+ sprintf(convbuf, unk, errcode);
+ msg = convbuf;
+ }
+ break;
+ }
+
+ len = strlen(msg) + 1; /* space needed, including NUL */
+ if (errbuf_size > 0) {
+ if (errbuf_size > len)
+ strcpy(errbuf, msg);
+ else { /* truncate to fit */
+ strncpy(errbuf, msg, errbuf_size-1);
+ errbuf[errbuf_size-1] = '\0';
+ }
+ }
+
+ return len;
+}
diff --git a/tcl/generic/regerrs.h b/tcl/generic/regerrs.h
new file mode 100644
index 00000000000..a3d98b68184
--- /dev/null
+++ b/tcl/generic/regerrs.h
@@ -0,0 +1,18 @@
+{ REG_OKAY, "REG_OKAY", "no errors detected" },
+{ REG_NOMATCH, "REG_NOMATCH", "failed to match" },
+{ REG_BADPAT, "REG_BADPAT", "invalid regexp (reg version 0.8)" },
+{ REG_ECOLLATE, "REG_ECOLLATE", "invalid collating element" },
+{ REG_ECTYPE, "REG_ECTYPE", "invalid character class" },
+{ REG_EESCAPE, "REG_EESCAPE", "invalid escape \\ sequence" },
+{ REG_ESUBREG, "REG_ESUBREG", "invalid backreference number" },
+{ REG_EBRACK, "REG_EBRACK", "brackets [] not balanced" },
+{ REG_EPAREN, "REG_EPAREN", "parentheses () not balanced" },
+{ REG_EBRACE, "REG_EBRACE", "braces {} not balanced" },
+{ REG_BADBR, "REG_BADBR", "invalid repetition count(s)" },
+{ REG_ERANGE, "REG_ERANGE", "invalid character range" },
+{ REG_ESPACE, "REG_ESPACE", "out of memory" },
+{ REG_BADRPT, "REG_BADRPT", "quantifier operand invalid" },
+{ REG_ASSERT, "REG_ASSERT", "\"can't happen\" -- you found a bug" },
+{ 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" },
diff --git a/tcl/generic/regex.h b/tcl/generic/regex.h
new file mode 100644
index 00000000000..8289a500ebb
--- /dev/null
+++ b/tcl/generic/regex.h
@@ -0,0 +1,341 @@
+#ifndef _REGEX_H_
+#define _REGEX_H_ /* never again */
+/*
+ * regular expressions
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *
+ *
+ * Prototypes etc. marked with "^" within comments get gathered up (and
+ * possibly edited) by the regfwd program and inserted near the bottom of
+ * this file.
+ *
+ * We offer the option of declaring one wide-character version of the
+ * RE functions as well as the char versions. To do that, define
+ * __REG_WIDE_T to the type of wide characters (unfortunately, there
+ * is no consensus that wchar_t is suitable) and __REG_WIDE_COMPILE and
+ * __REG_WIDE_EXEC to the names to be used for the compile and execute
+ * functions (suggestion: re_Xcomp and re_Xexec, where X is a letter
+ * suggestive of the wide type, e.g. re_ucomp and re_uexec for Unicode).
+ * For cranky old compilers, it may be necessary to do something like:
+ * #define __REG_WIDE_COMPILE(a,b,c,d) re_Xcomp(a,b,c,d)
+ * #define __REG_WIDE_EXEC(a,b,c,d,e,f,g) re_Xexec(a,b,c,d,e,f,g)
+ * rather than just #defining the names as parameterless macros.
+ *
+ * For some specialized purposes, it may be desirable to suppress the
+ * declarations of the "front end" functions, regcomp() and regexec(),
+ * or of the char versions of the compile and execute functions. To
+ * suppress the front-end functions, define __REG_NOFRONT. To suppress
+ * the char versions, define __REG_NOCHAR.
+ *
+ * The right place to do those defines (and some others you may want, see
+ * below) would be <sys/types.h>. If you don't have control of that file,
+ * the right place to add your own defines to this file is marked below.
+ * This is normally done automatically, by the makefile and regmkhdr, based
+ * on the contents of regcustom.h.
+ */
+
+
+
+/*
+ * voodoo for C++
+ */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+
+/*
+ * Add your own defines, if needed, here.
+ */
+
+
+
+/*
+ * Location where a chunk of regcustom.h is automatically spliced into
+ * this file (working from its prototype, regproto.h).
+ */
+/* --- begin --- */
+/* ensure certain things don't sneak in from system headers */
+#ifdef __REG_WIDE_T
+#undef __REG_WIDE_T
+#endif
+#ifdef __REG_WIDE_COMPILE
+#undef __REG_WIDE_COMPILE
+#endif
+#ifdef __REG_WIDE_EXEC
+#undef __REG_WIDE_EXEC
+#endif
+#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
+#ifdef __REG_NOCHAR
+#undef __REG_NOCHAR
+#endif
+/* 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
+#define __REG_NOFRONT /* don't want regcomp() and regexec() */
+#define __REG_NOCHAR /* or the char versions */
+#define regfree TclReFree
+#define regerror TclReError
+/* --- end --- */
+
+
+/*
+ * interface types etc.
+ */
+
+/*
+ * regoff_t has to be large enough to hold either off_t or ssize_t,
+ * and must be signed; it's only a guess that long is suitable, so we
+ * offer <sys/types.h> an override.
+ */
+#ifdef __REG_REGOFF_T
+typedef __REG_REGOFF_T regoff_t;
+#else
+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
+ */
+
+/* the biggie, a compiled RE (or rather, a front end to same) */
+typedef struct {
+ int re_magic; /* magic number */
+ size_t re_nsub; /* number of subexpressions */
+ long re_info; /* information about RE */
+# define REG_UBACKREF 000001
+# define REG_ULOOKAHEAD 000002
+# define REG_UBOUNDS 000004
+# define REG_UBRACES 000010
+# define REG_UBSALNUM 000020
+# define REG_UPBOTCH 000040
+# define REG_UBBS 000100
+# define REG_UNONPOSIX 000200
+# define REG_UUNSPEC 000400
+# define REG_UUNPORT 001000
+# define REG_ULOCALE 002000
+# define REG_UEMPTYMATCH 004000
+# define REG_UIMPOSSIBLE 010000
+# define REG_USHORTEST 020000
+ int re_csize; /* sizeof(character) */
+ char *re_endp; /* backward compatibility kludge */
+ /* the rest is opaque pointers to hidden innards */
+ char *re_guts; /* `char *' is more portable than `void *' */
+ char *re_fns;
+} regex_t;
+
+/* result reporting (may acquire more fields later) */
+typedef struct {
+ regoff_t rm_so; /* start of substring */
+ regoff_t rm_eo; /* end of substring */
+} regmatch_t;
+
+/* supplementary control and reporting */
+typedef struct {
+ regmatch_t rm_extend; /* see REG_EXPECT */
+} rm_detail_t;
+
+
+
+/*
+ * compilation
+ ^ #ifndef __REG_NOCHAR
+ ^ int re_comp(regex_t *, __REG_CONST char *, size_t, int);
+ ^ #endif
+ ^ #ifndef __REG_NOFRONT
+ ^ int regcomp(regex_t *, __REG_CONST char *, int);
+ ^ #endif
+ ^ #ifdef __REG_WIDE_T
+ ^ int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
+ ^ #endif
+ */
+#define REG_BASIC 000000 /* BREs (convenience) */
+#define REG_EXTENDED 000001 /* EREs */
+#define REG_ADVF 000002 /* advanced features in EREs */
+#define REG_ADVANCED 000003 /* AREs (which are also EREs) */
+#define REG_QUOTE 000004 /* no special characters, none */
+#define REG_NOSPEC REG_QUOTE /* historical synonym */
+#define REG_ICASE 000010 /* ignore case */
+#define REG_NOSUB 000020 /* don't care about subexpressions */
+#define REG_EXPANDED 000040 /* expanded format, white space & comments */
+#define REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */
+#define REG_NLANCH 000200 /* ^ matches after \n, $ before */
+#define REG_NEWLINE 000300 /* newlines are line terminators */
+#define REG_PEND 000400 /* ugh -- backward-compatibility hack */
+#define REG_EXPECT 001000 /* report details on partial/limited matches */
+#define REG_BOSONLY 002000 /* temporary kludge for BOS-only matches */
+#define REG_DUMP 004000 /* none of your business :-) */
+#define REG_FAKE 010000 /* none of your business :-) */
+#define REG_PROGRESS 020000 /* none of your business :-) */
+
+
+
+/*
+ * execution
+ ^ #ifndef __REG_NOCHAR
+ ^ int re_exec(regex_t *, __REG_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);
+ ^ #endif
+ ^ #ifdef __REG_WIDE_T
+ ^ int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t,
+ ^ rm_detail_t *, size_t, regmatch_t [], int);
+ ^ #endif
+ */
+#define REG_NOTBOL 0001 /* BOS is not BOL */
+#define REG_NOTEOL 0002 /* EOS is not EOL */
+#define REG_STARTEND 0004 /* backward compatibility kludge */
+#define REG_FTRACE 0010 /* none of your business */
+#define REG_MTRACE 0020 /* none of your business */
+#define REG_SMALL 0040 /* none of your business */
+
+
+
+/*
+ * misc generics (may be more functions here eventually)
+ ^ re_void regfree(regex_t *);
+ */
+
+
+
+/*
+ * error reporting
+ * Be careful if modifying the list of error codes -- the table used by
+ * regerror() is generated automatically from this file!
+ *
+ * Note that there is no wide-char variant of regerror at this time; what
+ * kind 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);
+ */
+#define REG_OKAY 0 /* no errors detected */
+#define REG_NOMATCH 1 /* failed to match */
+#define REG_BADPAT 2 /* invalid regexp */
+#define REG_ECOLLATE 3 /* invalid collating element */
+#define REG_ECTYPE 4 /* invalid character class */
+#define REG_EESCAPE 5 /* invalid escape \ sequence */
+#define REG_ESUBREG 6 /* invalid backreference number */
+#define REG_EBRACK 7 /* brackets [] not balanced */
+#define REG_EPAREN 8 /* parentheses () not balanced */
+#define REG_EBRACE 9 /* braces {} not balanced */
+#define REG_BADBR 10 /* invalid repetition count(s) */
+#define REG_ERANGE 11 /* invalid character range */
+#define REG_ESPACE 12 /* out of memory */
+#define REG_BADRPT 13 /* quantifier operand invalid */
+#define REG_ASSERT 15 /* "can't happen" -- you found a bug */
+#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 */
+/* two specials for debugging and testing */
+#define REG_ATOI 101 /* convert error-code name to number */
+#define REG_ITOA 102 /* convert error-code number to name */
+
+
+
+/*
+ * the prototypes, as possibly munched by regfwd
+ */
+/* =====^!^===== begin forwards =====^!^===== */
+/* automatically gathered by fwd; do not hand-edit */
+/* === regproto.h === */
+#ifndef __REG_NOCHAR
+int re_comp _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, int));
+#endif
+#ifndef __REG_NOFRONT
+int regcomp _ANSI_ARGS_((regex_t *, __REG_CONST char *, int));
+#endif
+#ifdef __REG_WIDE_T
+int __REG_WIDE_COMPILE _ANSI_ARGS_((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int));
+#endif
+#ifndef __REG_NOCHAR
+int re_exec _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
+#endif
+#ifndef __REG_NOFRONT
+int regexec _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, regmatch_t [], int));
+#endif
+#ifdef __REG_WIDE_T
+int __REG_WIDE_EXEC _ANSI_ARGS_((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
+#endif
+re_void regfree _ANSI_ARGS_((regex_t *));
+extern size_t regerror _ANSI_ARGS_((int, __REG_CONST regex_t *, char *, size_t));
+/* automatically gathered by fwd; do not hand-edit */
+/* =====^!^===== end forwards =====^!^===== */
+
+
+
+/*
+ * more C++ voodoo
+ */
+#ifdef __cplusplus
+}
+#endif
+
+
+
+#endif
diff --git a/tcl/generic/regexec.c b/tcl/generic/regexec.c
new file mode 100644
index 00000000000..41d49bdab53
--- /dev/null
+++ b/tcl/generic/regexec.c
@@ -0,0 +1,1038 @@
+/*
+ * re_*exec and friends - match REs
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+#include "regguts.h"
+
+
+
+/* lazy-DFA representation */
+struct arcp { /* "pointer" to an outarc */
+ struct sset *ss;
+ color co;
+};
+
+struct sset { /* state set */
+ unsigned *states; /* pointer to bitvector */
+ unsigned hash; /* hash of bitvector */
+# define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw))
+# define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \
+ memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
+ int flags;
+# define STARTER 01 /* the initial state set */
+# define POSTSTATE 02 /* includes the goal state */
+# define LOCKED 04 /* locked in cache */
+# define NOPROGRESS 010 /* zero-progress state set */
+ struct arcp ins; /* chain of inarcs pointing here */
+ chr *lastseen; /* last entered on arrival here */
+ struct sset **outs; /* outarc vector indexed by color */
+ struct arcp *inchain; /* chain-pointer vector for outarcs */
+};
+
+struct dfa {
+ int nssets; /* size of cache */
+ int nssused; /* how many entries occupied yet */
+ int nstates; /* number of states */
+ int ncolors; /* length of outarc and inchain vectors */
+ int wordsper; /* length of state-set bitvectors */
+ struct sset *ssets; /* state-set cache */
+ unsigned *statesarea; /* bitvector storage */
+ unsigned *work; /* pointer to work area within statesarea */
+ struct sset **outsarea; /* outarc-vector storage */
+ struct arcp *incarea; /* inchain storage */
+ struct cnfa *cnfa;
+ struct colormap *cm;
+ chr *lastpost; /* location of last cache-flushed success */
+ chr *lastnopr; /* location of last cache-flushed NOPROGRESS */
+ struct sset *search; /* replacement-search-pointer memory */
+ int cptsmalloced; /* were the areas individually malloced? */
+ char *mallocarea; /* self, or master malloced area, or NULL */
+};
+
+#define WORK 1 /* number of work bitvectors needed */
+
+/* setup for non-malloc allocation for small cases */
+#define FEWSTATES 20 /* must be less than UBITS */
+#define FEWCOLORS 15
+struct smalldfa {
+ struct dfa dfa;
+ struct sset ssets[FEWSTATES*2];
+ unsigned statesarea[FEWSTATES*2 + WORK];
+ struct sset *outsarea[FEWSTATES*2 * FEWCOLORS];
+ struct arcp incarea[FEWSTATES*2 * FEWCOLORS];
+};
+#define DOMALLOC ((struct smalldfa *)NULL) /* force malloc */
+
+
+
+/* internal variables, bundled for easy passing around */
+struct vars {
+ regex_t *re;
+ struct guts *g;
+ int eflags; /* copies of arguments */
+ size_t nmatch;
+ regmatch_t *pmatch;
+ rm_detail_t *details;
+ 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 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 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)
+#define LOFF(p) ((long)OFF(p))
+
+
+
+/*
+ * forward declarations
+ */
+/* =====^!^===== begin forwards =====^!^===== */
+/* automatically gathered by fwd; do not hand-edit */
+/* === regexec.c === */
+int exec _ANSI_ARGS_((regex_t *, CONST chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
+static int find _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *));
+static int cfind _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *));
+static int cfindloop _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *, struct dfa *, struct dfa *, chr **));
+static VOID zapsubs _ANSI_ARGS_((regmatch_t *, size_t));
+static VOID zapmem _ANSI_ARGS_((struct vars *, struct subre *));
+static VOID subset _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+static int dissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+static int condissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+static int altdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+static int cdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+static int ccondissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+static int crevdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+static int cbrdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+static int caltdissect _ANSI_ARGS_((struct vars *, struct subre *, chr *, chr *));
+/* === rege_dfa.c === */
+static chr *longest _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *, int *));
+static chr *shortest _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *, chr *, chr **, int *));
+static chr *lastcold _ANSI_ARGS_((struct vars *, struct dfa *));
+static struct dfa *newdfa _ANSI_ARGS_((struct vars *, struct cnfa *, struct colormap *, struct smalldfa *));
+static VOID freedfa _ANSI_ARGS_((struct dfa *));
+static unsigned hash _ANSI_ARGS_((unsigned *, int));
+static struct sset *initialize _ANSI_ARGS_((struct vars *, struct dfa *, chr *));
+static struct sset *miss _ANSI_ARGS_((struct vars *, struct dfa *, struct sset *, pcolor, chr *, chr *));
+static int lacon _ANSI_ARGS_((struct vars *, struct cnfa *, chr *, pcolor));
+static struct sset *getvacant _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *));
+static struct sset *pickss _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *));
+/* automatically gathered by fwd; do not hand-edit */
+/* =====^!^===== end forwards =====^!^===== */
+
+
+
+/*
+ - exec - match regular expression
+ ^ int exec(regex_t *, CONST chr *, size_t, rm_detail_t *,
+ ^ size_t, regmatch_t [], int);
+ */
+int
+exec(re, string, len, details, nmatch, pmatch, flags)
+regex_t *re;
+CONST chr *string;
+size_t len;
+rm_detail_t *details;
+size_t nmatch;
+regmatch_t pmatch[];
+int flags;
+{
+ struct vars var;
+ register struct vars *v = &var;
+ int st;
+ size_t n;
+ int backref;
+# define LOCALMAT 20
+ regmatch_t mat[LOCALMAT];
+# define LOCALMEM 40
+ regoff_t mem[LOCALMEM];
+
+ /* sanity checks */
+ if (re == NULL || string == NULL || re->re_magic != REMAGIC)
+ return REG_INVARG;
+ if (re->re_csize != sizeof(chr))
+ return REG_MIXED;
+
+ /* setup */
+ v->re = re;
+ v->g = (struct guts *)re->re_guts;
+ if ((v->g->cflags&REG_EXPECT) && details == NULL)
+ return REG_INVARG;
+ if (v->g->info&REG_UIMPOSSIBLE)
+ return REG_NOMATCH;
+ backref = (v->g->info&REG_UBACKREF) ? 1 : 0;
+ v->eflags = flags;
+ if (v->g->cflags&REG_NOSUB)
+ nmatch = 0; /* override client */
+ v->nmatch = nmatch;
+ if (backref) {
+ /* need work area */
+ if (v->g->nsub + 1 <= LOCALMAT)
+ v->pmatch = mat;
+ else
+ v->pmatch = (regmatch_t *)MALLOC((v->g->nsub + 1) *
+ sizeof(regmatch_t));
+ if (v->pmatch == NULL)
+ return REG_ESPACE;
+ v->nmatch = v->g->nsub + 1;
+ } else
+ v->pmatch = pmatch;
+ v->details = details;
+ 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);
+ return REG_ESPACE;
+ }
+ } else
+ v->mem = NULL;
+
+ /* do it */
+ assert(v->g->tree != NULL);
+ if (backref)
+ st = cfind(v, &v->g->tree->cnfa, &v->g->cmap);
+ else
+ st = find(v, &v->g->tree->cnfa, &v->g->cmap);
+
+ /* copy (portion of) match vector over if necessary */
+ if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
+ zapsubs(pmatch, nmatch);
+ n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
+ memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
+ }
+
+ /* clean up */
+ if (v->pmatch != pmatch && v->pmatch != mat)
+ FREE(v->pmatch);
+ if (v->mem != NULL && v->mem != mem)
+ FREE(v->mem);
+ return st;
+}
+
+/*
+ - find - find a match for the main NFA (no-complications case)
+ ^ static int find(struct vars *, struct cnfa *, struct colormap *);
+ */
+static int
+find(v, cnfa, cm)
+struct vars *v;
+struct cnfa *cnfa;
+struct colormap *cm;
+{
+ struct dfa *s;
+ struct dfa *d;
+ chr *begin;
+ chr *end = NULL;
+ chr *cold;
+ chr *open; /* open and close of range of possible starts */
+ chr *close;
+ int hitend;
+ int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;
+
+ /* first, a shot with the search RE */
+ s = newdfa(v, &v->g->search, cm, &v->dfa1);
+ assert(!(ISERR() && s != NULL));
+ NOERR();
+ MDEBUG(("\nsearch at %ld\n", LOFF(v->start)));
+ cold = NULL;
+ close = shortest(v, s, v->start, v->start, v->stop, &cold, (int *)NULL);
+ freedfa(s);
+ NOERR();
+ if (v->g->cflags&REG_EXPECT) {
+ assert(v->details != NULL);
+ if (cold != NULL)
+ v->details->rm_extend.rm_so = OFF(cold);
+ else
+ v->details->rm_extend.rm_so = OFF(v->stop);
+ v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ }
+ if (close == NULL) /* not found */
+ return REG_NOMATCH;
+ if (v->nmatch == 0) /* found, don't need exact location */
+ return REG_OKAY;
+
+ /* find starting point and match */
+ assert(cold != NULL);
+ open = cold;
+ cold = NULL;
+ MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
+ d = newdfa(v, cnfa, cm, &v->dfa1);
+ assert(!(ISERR() && d != NULL));
+ NOERR();
+ for (begin = open; begin <= close; begin++) {
+ MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
+ if (shorter)
+ end = shortest(v, d, begin, begin, v->stop,
+ (chr **)NULL, &hitend);
+ else
+ end = longest(v, d, begin, v->stop, &hitend);
+ NOERR();
+ if (hitend && cold == NULL)
+ cold = begin;
+ if (end != NULL)
+ break; /* NOTE BREAK OUT */
+ }
+ assert(end != NULL); /* search RE succeeded so loop should */
+ freedfa(d);
+
+ /* and pin down details */
+ assert(v->nmatch > 0);
+ v->pmatch[0].rm_so = OFF(begin);
+ v->pmatch[0].rm_eo = OFF(end);
+ if (v->g->cflags&REG_EXPECT) {
+ if (cold != NULL)
+ v->details->rm_extend.rm_so = OFF(cold);
+ else
+ v->details->rm_extend.rm_so = OFF(v->stop);
+ v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ }
+ if (v->nmatch == 1) /* no need for submatches */
+ return REG_OKAY;
+
+ /* submatches */
+ zapsubs(v->pmatch, v->nmatch);
+ return dissect(v, v->g->tree, begin, end);
+}
+
+/*
+ - cfind - find a match for the main NFA (with complications)
+ ^ static int cfind(struct vars *, struct cnfa *, struct colormap *);
+ */
+static int
+cfind(v, cnfa, cm)
+struct vars *v;
+struct cnfa *cnfa;
+struct colormap *cm;
+{
+ struct dfa *s;
+ struct dfa *d;
+ chr *cold;
+ int ret;
+
+ s = newdfa(v, &v->g->search, cm, &v->dfa1);
+ NOERR();
+ d = newdfa(v, cnfa, cm, &v->dfa2);
+ if (ISERR()) {
+ assert(d == NULL);
+ freedfa(s);
+ return v->err;
+ }
+
+ ret = cfindloop(v, cnfa, cm, d, s, &cold);
+
+ freedfa(d);
+ freedfa(s);
+ NOERR();
+ if (v->g->cflags&REG_EXPECT) {
+ assert(v->details != NULL);
+ if (cold != NULL)
+ v->details->rm_extend.rm_so = OFF(cold);
+ else
+ v->details->rm_extend.rm_so = OFF(v->stop);
+ v->details->rm_extend.rm_eo = OFF(v->stop); /* unknown */
+ }
+ return ret;
+}
+
+/*
+ - cfindloop - the heart of cfind
+ ^ static int cfindloop(struct vars *, struct cnfa *, struct colormap *,
+ ^ struct dfa *, struct dfa *, chr **);
+ */
+static int
+cfindloop(v, cnfa, cm, d, s, coldp)
+struct vars *v;
+struct cnfa *cnfa;
+struct colormap *cm;
+struct dfa *d;
+struct dfa *s;
+chr **coldp; /* where to put coldstart pointer */
+{
+ chr *begin;
+ chr *end;
+ chr *cold;
+ chr *open; /* open and close of range of possible starts */
+ chr *close;
+ chr *estart;
+ chr *estop;
+ int er;
+ int shorter = v->g->tree->flags&SHORTER;
+ int hitend;
+
+ assert(d != NULL && s != NULL);
+ cold = NULL;
+ close = v->start;
+ do {
+ MDEBUG(("\ncsearch at %ld\n", LOFF(close)));
+ close = shortest(v, s, close, close, v->stop, &cold, (int *)NULL);
+ if (close == NULL)
+ break; /* NOTE BREAK */
+ assert(cold != NULL);
+ open = cold;
+ cold = NULL;
+ MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close)));
+ for (begin = open; begin <= close; begin++) {
+ MDEBUG(("\ncfind trying at %ld\n", LOFF(begin)));
+ estart = begin;
+ estop = v->stop;
+ for (;;) {
+ if (shorter)
+ end = shortest(v, d, begin, estart,
+ estop, (chr **)NULL, &hitend);
+ else
+ end = longest(v, d, begin, estop,
+ &hitend);
+ if (hitend && cold == NULL)
+ cold = begin;
+ if (end == NULL)
+ break; /* NOTE BREAK OUT */
+ MDEBUG(("tentative end %ld\n", LOFF(end)));
+ zapsubs(v->pmatch, v->nmatch);
+ zapmem(v, v->g->tree);
+ er = cdissect(v, v->g->tree, begin, end);
+ if (er == REG_OKAY) {
+ if (v->nmatch > 0) {
+ v->pmatch[0].rm_so = OFF(begin);
+ v->pmatch[0].rm_eo = OFF(end);
+ }
+ *coldp = cold;
+ return REG_OKAY;
+ }
+ if (er != REG_NOMATCH) {
+ ERR(er);
+ return er;
+ }
+ if ((shorter) ? end == estop : end == begin) {
+ /* no point in trying again */
+ *coldp = cold;
+ return REG_NOMATCH;
+ }
+ /* go around and try again */
+ if (shorter)
+ estart = end + 1;
+ else
+ estop = end - 1;
+ }
+ }
+ } while (close < v->stop);
+
+ *coldp = cold;
+ return REG_NOMATCH;
+}
+
+/*
+ - zapsubs - initialize the subexpression matches to "no match"
+ ^ static VOID zapsubs(regmatch_t *, size_t);
+ */
+static VOID
+zapsubs(p, n)
+regmatch_t *p;
+size_t n;
+{
+ size_t i;
+
+ for (i = n-1; i > 0; i--) {
+ p[i].rm_so = -1;
+ p[i].rm_eo = -1;
+ }
+}
+
+/*
+ - zapmem - initialize the retry memory of a subtree to zeros
+ ^ static VOID zapmem(struct vars *, struct subre *);
+ */
+static VOID
+zapmem(v, t)
+struct vars *v;
+struct subre *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;
+ }
+
+ if (t->left != NULL)
+ zapmem(v, t->left);
+ if (t->right != NULL)
+ zapmem(v, t->right);
+}
+
+/*
+ - subset - set any subexpression relevant to a successful subre
+ ^ static VOID subset(struct vars *, struct subre *, chr *, chr *);
+ */
+static VOID
+subset(v, sub, begin, end)
+struct vars *v;
+struct subre *sub;
+chr *begin;
+chr *end;
+{
+ int n = sub->subno;
+
+ assert(n > 0);
+ if ((size_t)n >= v->nmatch)
+ return;
+
+ MDEBUG(("setting %d\n", n));
+ v->pmatch[n].rm_so = OFF(begin);
+ v->pmatch[n].rm_eo = OFF(end);
+}
+
+/*
+ - dissect - determine subexpression matches (uncomplicated case)
+ ^ static int dissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+dissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin; /* beginning of relevant substring */
+chr *end; /* end of same */
+{
+ 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 */
+ break;
+ case '|': /* alternation */
+ assert(t->left != NULL);
+ return altdissect(v, t, begin, end);
+ break;
+ case 'b': /* back ref -- shouldn't be calling us! */
+ return REG_ASSERT;
+ break;
+ case '.': /* concatenation */
+ assert(t->left != NULL && t->right != NULL);
+ return condissect(v, t, begin, end);
+ break;
+ case '(': /* capturing */
+ assert(t->left != NULL && t->right == NULL);
+ assert(t->subno > 0);
+ subset(v, t, begin, end);
+ return dissect(v, t->left, begin, end);
+ break;
+ default:
+ return REG_ASSERT;
+ break;
+ }
+}
+
+/*
+ - condissect - determine concatenation subexpression matches (uncomplicated)
+ ^ static int condissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+condissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin; /* beginning of relevant substring */
+chr *end; /* end of same */
+{
+ struct dfa *d;
+ struct dfa *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, (chr **)NULL,
+ (int *)NULL);
+ else
+ mid = longest(v, d, begin, end, (int *)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, (int *)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, (chr **)NULL,
+ (int *)NULL);
+ else
+ mid = longest(v, d, begin, mid-1, (int *)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);
+}
+
+/*
+ - altdissect - determine alternative subexpression matches (uncomplicated)
+ ^ static int altdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+altdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin; /* beginning of relevant substring */
+chr *end; /* end of same */
+{
+ struct dfa *d;
+ int i;
+
+ assert(t != NULL);
+ assert(t->op == '|');
+
+ for (i = 0; t != NULL; t = t->right, i++) {
+ 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, (int *)NULL) == end) {
+ MDEBUG(("success\n"));
+ freedfa(d);
+ return dissect(v, t->left, begin, end);
+ }
+ freedfa(d);
+ }
+ return REG_ASSERT; /* none of them matched?!? */
+}
+
+/*
+ - cdissect - 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 cdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+cdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin; /* beginning of relevant substring */
+chr *end; /* end of same */
+{
+ int er;
+
+ assert(t != NULL);
+ 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 */
+ break;
+ case '|': /* alternation */
+ assert(t->left != NULL);
+ return caltdissect(v, t, begin, end);
+ break;
+ case 'b': /* back ref -- shouldn't be calling us! */
+ assert(t->left == NULL && t->right == NULL);
+ return cbrdissect(v, t, begin, end);
+ break;
+ case '.': /* concatenation */
+ assert(t->left != NULL && t->right != NULL);
+ return ccondissect(v, t, begin, end);
+ break;
+ case '(': /* capturing */
+ assert(t->left != NULL && t->right == NULL);
+ assert(t->subno > 0);
+ er = cdissect(v, t->left, begin, end);
+ if (er == REG_OKAY)
+ subset(v, t, begin, end);
+ return er;
+ break;
+ default:
+ return REG_ASSERT;
+ break;
+ }
+}
+
+/*
+ - ccondissect - 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 ccondissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+ccondissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin; /* beginning of relevant substring */
+chr *end; /* end of same */
+{
+ struct dfa *d;
+ struct dfa *d2;
+ chr *mid;
+ int er;
+
+ assert(t->op == '.');
+ assert(t->left != NULL && t->left->cnfa.nstates > 0);
+ assert(t->right != NULL && t->right->cnfa.nstates > 0);
+
+ if (t->left->flags&SHORTER) /* reverse scan */
+ return crevdissect(v, t, begin, end);
+
+ 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));
+
+ /* pick a tentative midpoint */
+ if (v->mem[t->retry] == 0) {
+ mid = longest(v, d, begin, end, (int *)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)));
+ }
+
+ /* iterate until satisfaction or failure */
+ for (;;) {
+ /* try this midpoint on for size */
+ er = cdissect(v, t->left, begin, mid);
+ if (er == REG_OKAY &&
+ longest(v, d2, mid, end, (int *)NULL) == end &&
+ (er = cdissect(v, t->right, mid, end)) ==
+ REG_OKAY)
+ break; /* NOTE BREAK OUT */
+ if (er != REG_OKAY && er != REG_NOMATCH) {
+ freedfa(d);
+ freedfa(d2);
+ return er;
+ }
+
+ /* that midpoint didn't work, find a new one */
+ if (mid == begin) {
+ /* all possibilities exhausted */
+ MDEBUG(("%d no midpoint\n", t->retry));
+ freedfa(d);
+ freedfa(d2);
+ return REG_NOMATCH;
+ }
+ mid = longest(v, d, begin, mid-1, (int *)NULL);
+ if (mid == NULL) {
+ /* failed to find a new one */
+ MDEBUG(("%d failed midpoint\n", t->retry));
+ freedfa(d);
+ freedfa(d2);
+ return REG_NOMATCH;
+ }
+ MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
+ v->mem[t->retry] = (mid - begin) + 1;
+ zapmem(v, t->left);
+ zapmem(v, t->right);
+ }
+
+ /* satisfaction */
+ MDEBUG(("successful\n"));
+ freedfa(d);
+ freedfa(d2);
+ return REG_OKAY;
+}
+
+/*
+ - crevdissect - 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 crevdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+crevdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin; /* beginning of relevant substring */
+chr *end; /* end of same */
+{
+ struct dfa *d;
+ struct dfa *d2;
+ chr *mid;
+ int er;
+
+ 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);
+
+ /* concatenation -- need to split the substring between parts */
+ 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));
+
+ /* pick a tentative midpoint */
+ if (v->mem[t->retry] == 0) {
+ mid = shortest(v, d, begin, begin, end, (chr **)NULL, (int *)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)));
+ }
+
+ /* iterate until satisfaction or failure */
+ for (;;) {
+ /* try this midpoint on for size */
+ er = cdissect(v, t->left, begin, mid);
+ if (er == REG_OKAY &&
+ longest(v, d2, mid, end, (int *)NULL) == end &&
+ (er = cdissect(v, t->right, mid, end)) ==
+ REG_OKAY)
+ break; /* NOTE BREAK OUT */
+ if (er != REG_OKAY && er != REG_NOMATCH) {
+ freedfa(d);
+ freedfa(d2);
+ return er;
+ }
+
+ /* that midpoint didn't work, find a new one */
+ if (mid == end) {
+ /* all possibilities exhausted */
+ MDEBUG(("%d no midpoint\n", t->retry));
+ freedfa(d);
+ freedfa(d2);
+ return REG_NOMATCH;
+ }
+ mid = shortest(v, d, begin, mid+1, end, (chr **)NULL, (int *)NULL);
+ if (mid == NULL) {
+ /* failed to find a new one */
+ MDEBUG(("%d failed midpoint\n", t->retry));
+ freedfa(d);
+ freedfa(d2);
+ return REG_NOMATCH;
+ }
+ MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
+ v->mem[t->retry] = (mid - begin) + 1;
+ zapmem(v, t->left);
+ zapmem(v, t->right);
+ }
+
+ /* satisfaction */
+ MDEBUG(("successful\n"));
+ freedfa(d);
+ freedfa(d2);
+ return REG_OKAY;
+}
+
+/*
+ - cbrdissect - determine backref subexpression matches
+ ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+cbrdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin; /* beginning of relevant substring */
+chr *end; /* end of same */
+{
+ int i;
+ int n = t->subno;
+ size_t len;
+ chr *paren;
+ chr *p;
+ chr *stop;
+ int min = t->min;
+ int max = t->max;
+
+ 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));
+
+ 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;
+
+ /* no room to maneuver -- retries are pointless */
+ if (v->mem[t->retry])
+ return REG_NOMATCH;
+ v->mem[t->retry] = 1;
+
+ /* special-case zero-length string */
+ if (len == 0) {
+ if (begin == end)
+ return REG_OKAY;
+ return REG_NOMATCH;
+ }
+
+ /* and too-short string */
+ assert(end >= begin);
+ if ((size_t)(end - begin) < len)
+ return REG_NOMATCH;
+ stop = end - len;
+
+ /* count occurrences */
+ i = 0;
+ for (p = begin; p <= stop && (i < max || max == INFINITY); p += len) {
+ if ((*v->g->compare)(paren, p, len) != 0)
+ break;
+ i++;
+ }
+ MDEBUG(("cbackref found %d\n", i));
+
+ /* and sort it out */
+ if (p != end) /* didn't consume all of it */
+ return REG_NOMATCH;
+ if (min <= i && (i <= max || max == INFINITY))
+ return REG_OKAY;
+ return REG_NOMATCH; /* out of range */
+}
+
+/*
+ - caltdissect - determine alternative subexpression matches (w. complications)
+ ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
+ */
+static int /* regexec return code */
+caltdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin; /* beginning of relevant substring */
+chr *end; /* end of same */
+{
+ struct dfa *d;
+ 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 */
+
+ if (t == NULL)
+ return REG_NOMATCH;
+ assert(t->op == '|');
+ if (v->mem[t->retry] == TRIED)
+ return caltdissect(v, t->right, begin, end);
+
+ MDEBUG(("calt n%d\n", t->retry));
+ assert(t->left != NULL);
+
+ if (v->mem[t->retry] == UNTRIED) {
+ d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+ if (ISERR())
+ return v->err;
+ if (longest(v, d, begin, end, (int *)NULL) != end) {
+ freedfa(d);
+ v->mem[t->retry] = TRIED;
+ return caltdissect(v, t->right, begin, end);
+ }
+ freedfa(d);
+ MDEBUG(("calt matched\n"));
+ v->mem[t->retry] = TRYING;
+ }
+
+ er = cdissect(v, t->left, begin, end);
+ if (er != REG_NOMATCH)
+ return er;
+
+ v->mem[t->retry] = TRIED;
+ return caltdissect(v, t->right, begin, end);
+}
+
+
+
+#include "rege_dfa.c"
diff --git a/tcl/generic/regfree.c b/tcl/generic/regfree.c
new file mode 100644
index 00000000000..17a73896f55
--- /dev/null
+++ b/tcl/generic/regfree.c
@@ -0,0 +1,53 @@
+/*
+ * regfree - free an RE
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *
+ *
+ * You might think that this could be incorporated into regcomp.c, and
+ * that would be a reasonable idea... except that this is a generic
+ * function (with a generic name), applicable to all compiled REs
+ * regardless of the size of their characters, whereas the stuff in
+ * regcomp.c gets compiled once per character size.
+ */
+
+#include "regguts.h"
+
+/*
+ - regfree - free an RE (generic function, punts to RE-specific function)
+ *
+ * Ignoring invocation with NULL is a convenience.
+ */
+VOID
+regfree(re)
+regex_t *re;
+{
+ if (re == NULL)
+ return;
+ (*((struct fns *)re->re_fns)->free)(re);
+}
diff --git a/tcl/generic/regfronts.c b/tcl/generic/regfronts.c
new file mode 100644
index 00000000000..82f48e2abcf
--- /dev/null
+++ b/tcl/generic/regfronts.c
@@ -0,0 +1,83 @@
+/*
+ * regcomp and regexec - front ends to re_ routines
+ *
+ * Mostly for implementation of backward-compatibility kludges. Note
+ * that these routines exist ONLY in char versions.
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+#include "regguts.h"
+
+/*
+ - regcomp - compile regular expression
+ */
+int
+regcomp(re, str, flags)
+regex_t *re;
+CONST char *str;
+int flags;
+{
+ size_t len;
+ int f = flags;
+
+ if (f&REG_PEND) {
+ len = re->re_endp - str;
+ f &= ~REG_PEND;
+ } else
+ len = strlen(str);
+
+ return re_comp(re, str, len, f);
+}
+
+/*
+ - regexec - execute regular expression
+ */
+int
+regexec(re, str, nmatch, pmatch, flags)
+regex_t *re;
+CONST char *str;
+size_t nmatch;
+regmatch_t pmatch[];
+int flags;
+{
+ CONST char *start;
+ size_t len;
+ int f = flags;
+
+ if (f&REG_STARTEND) {
+ start = str + pmatch[0].rm_so;
+ len = pmatch[0].rm_eo - pmatch[0].rm_so;
+ f &= ~REG_STARTEND;
+ } else {
+ start = str;
+ len = strlen(str);
+ }
+
+ return re_exec(re, start, len, nmatch, pmatch, f);
+}
diff --git a/tcl/generic/regguts.h b/tcl/generic/regguts.h
new file mode 100644
index 00000000000..36e50923677
--- /dev/null
+++ b/tcl/generic/regguts.h
@@ -0,0 +1,418 @@
+/*
+ * Internal interface definitions, etc., for the reg package
+ *
+ * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+
+/*
+ * Environmental customization. It should not (I hope) be necessary to
+ * alter the file you are now reading -- regcustom.h should handle it all,
+ * given care here and elsewhere.
+ */
+#include "regcustom.h"
+
+
+
+/*
+ * Things that regcustom.h might override.
+ */
+
+/* standard header files (NULL is a reasonable indicator for them) */
+#ifndef NULL
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <limits.h>
+#include <string.h>
+#endif
+
+/* assertions */
+#ifndef assert
+# ifndef REG_DEBUG
+# define NDEBUG /* no assertions */
+# endif
+#include <assert.h>
+#endif
+
+/* voids */
+#ifndef VOID
+#define VOID void /* for function return values */
+#endif
+#ifndef DISCARD
+#define DISCARD VOID /* for throwing values away */
+#endif
+#ifndef PVOID
+#define PVOID VOID * /* generic pointer */
+#endif
+#ifndef VS
+#define VS(x) ((PVOID)(x)) /* cast something to generic ptr */
+#endif
+#ifndef NOPARMS
+#define NOPARMS VOID /* for empty parm lists */
+#endif
+
+/* const */
+#ifndef CONST
+#define CONST const /* for old compilers, might be empty */
+#endif
+
+/* function-pointer declarator */
+#ifndef FUNCPTR
+#if __STDC__ >= 1
+#define FUNCPTR(name, args) (*name)args
+#else
+#define FUNCPTR(name, args) (*name)()
+#endif
+#endif
+
+/* memory allocation */
+#ifndef MALLOC
+#define MALLOC(n) malloc(n)
+#endif
+#ifndef REALLOC
+#define REALLOC(p, n) realloc(VS(p), n)
+#endif
+#ifndef FREE
+#define FREE(p) free(VS(p))
+#endif
+
+/* want size of a char in bits, and max value in bounded quantifiers */
+#ifndef CHAR_BIT
+#include <limits.h>
+#endif
+#ifndef _POSIX2_RE_DUP_MAX
+#define _POSIX2_RE_DUP_MAX 255 /* normally from <limits.h> */
+#endif
+
+
+
+/*
+ * misc
+ */
+
+#define NOTREACHED 0
+#define xxx 1
+
+#define DUPMAX _POSIX2_RE_DUP_MAX
+#define INFINITY (DUPMAX+1)
+
+#define REMAGIC 0xfed7 /* magic number for main struct */
+
+
+
+/*
+ * debugging facilities
+ */
+#ifdef REG_DEBUG
+/* FDEBUG does finite-state tracing */
+#define FDEBUG(arglist) { if (v->eflags&REG_FTRACE) printf arglist; }
+/* MDEBUG does higher-level tracing */
+#define MDEBUG(arglist) { if (v->eflags&REG_MTRACE) printf arglist; }
+#else
+#define FDEBUG(arglist) {}
+#define MDEBUG(arglist) {}
+#endif
+
+
+
+/*
+ * bitmap manipulation
+ */
+#define UBITS (CHAR_BIT * sizeof(unsigned))
+#define BSET(uv, sn) ((uv)[(sn)/UBITS] |= (unsigned)1 << ((sn)%UBITS))
+#define ISBSET(uv, sn) ((uv)[(sn)/UBITS] & ((unsigned)1 << ((sn)%UBITS)))
+
+
+
+/*
+ * We dissect a chr into byts for colormap table indexing. Here we define
+ * a byt, which will be the same as a byte on most machines... The exact
+ * size of a byt is not critical, but about 8 bits is good, and extraction
+ * of 8-bit chunks is sometimes especially fast.
+ */
+#ifndef BYTBITS
+#define BYTBITS 8 /* bits in a byt */
+#endif
+#define BYTTAB (1<<BYTBITS) /* size of table with one entry per byt value */
+#define BYTMASK (BYTTAB-1) /* bit mask for byt */
+#define NBYTS ((CHRBITS+BYTBITS-1)/BYTBITS)
+/* the definition of GETCOLOR(), below, assumes NBYTS <= 4 */
+
+
+
+/*
+ * As soon as possible, we map chrs into equivalence classes -- "colors" --
+ * which are of much more manageable number.
+ */
+typedef short color; /* colors of characters */
+typedef int pcolor; /* what color promotes to */
+#define COLORLESS (-1) /* impossible color */
+#define WHITE 0 /* default color, parent of all others */
+
+
+
+/*
+ * A colormap is a tree -- more precisely, a DAG -- indexed at each level
+ * by a byt of the chr, to map the chr to a color efficiently. Because
+ * lower sections of the tree can be shared, it can exploit the usual
+ * sparseness of such a mapping table. The tree is always NBYTS levels
+ * deep (in the past it was shallower during construction but was "filled"
+ * to full depth at the end of that); areas that are unaltered as yet point
+ * to "fill blocks" which are entirely WHITE in color.
+ */
+
+/* the tree itself */
+struct colors {
+ color ccolor[BYTTAB];
+};
+struct ptrs {
+ union tree *pptr[BYTTAB];
+};
+union tree {
+ struct colors colors;
+ struct ptrs ptrs;
+};
+#define tcolor colors.ccolor
+#define tptr ptrs.pptr
+
+/* internal per-color structure for the color machinery */
+struct colordesc {
+ uchr nchrs; /* number of chars of this color */
+ color sub; /* open subcolor (if any); free chain ptr */
+# define NOSUB COLORLESS
+ struct arc *arcs; /* color chain */
+ int flags;
+# define FREECOL 01 /* currently free */
+# define PSEUDO 02 /* pseudocolor, no real chars */
+# define UNUSEDCOLOR(cd) ((cd)->flags&FREECOL)
+ union tree *block; /* block of solid color, if any */
+};
+
+/* the color map itself */
+struct colormap {
+ int magic;
+# define CMMAGIC 0x876
+ struct vars *v; /* for compile error reporting */
+ size_t ncds; /* number of colordescs */
+ size_t max; /* highest in use */
+ color free; /* beginning of free chain (if non-0) */
+ struct colordesc *cd;
+# define CDEND(cm) (&(cm)->cd[(cm)->max + 1])
+# define NINLINECDS ((size_t)10)
+ struct colordesc cdspace[NINLINECDS];
+ union tree tree[NBYTS]; /* tree top, plus fill blocks */
+};
+
+/* optimization magic to do fast chr->color mapping */
+#define B0(c) ((c) & BYTMASK)
+#define B1(c) (((c)>>BYTBITS) & BYTMASK)
+#define B2(c) (((c)>>(2*BYTBITS)) & BYTMASK)
+#define B3(c) (((c)>>(3*BYTBITS)) & BYTMASK)
+#if NBYTS == 1
+#define GETCOLOR(cm, c) ((cm)->tree->tcolor[B0(c)])
+#endif
+/* beware, for NBYTS>1, GETCOLOR() is unsafe -- 2nd arg used repeatedly */
+#if NBYTS == 2
+#define GETCOLOR(cm, c) ((cm)->tree->tptr[B1(c)]->tcolor[B0(c)])
+#endif
+#if NBYTS == 4
+#define GETCOLOR(cm, c) ((cm)->tree->tptr[B3(c)]->tptr[B2(c)]->tptr[B1(c)]->tcolor[B0(c)])
+#endif
+
+
+
+/*
+ * Interface definitions for locale-interface functions in locale.c.
+ * Multi-character collating elements (MCCEs) cause most of the trouble.
+ */
+struct cvec {
+ int nchrs; /* number of chrs */
+ int chrspace; /* number of chrs possible */
+ chr *chrs; /* pointer to vector of chrs */
+ int nranges; /* number of ranges (chr pairs) */
+ int rangespace; /* number of chrs possible */
+ chr *ranges; /* pointer to vector of chr pairs */
+ int nmcces; /* number of MCCEs */
+ int mccespace; /* number of MCCEs possible */
+ int nmccechrs; /* number of chrs used for MCCEs */
+ chr *mcces[1]; /* pointers to 0-terminated MCCEs */
+ /* and both batches of chrs are on the end */
+};
+
+/* caution: this value cannot be changed easily */
+#define MAXMCCE 2 /* length of longest MCCE */
+
+
+
+/*
+ * definitions for NFA internal representation
+ *
+ * Having a "from" pointer within each arc may seem redundant, but it
+ * saves a lot of hassle.
+ */
+struct state;
+
+struct arc {
+ int type;
+# define ARCFREE '\0'
+ 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 *inchain; /* *to's ins chain */
+ struct arc *colorchain; /* color's arc chain */
+};
+
+struct arcbatch { /* for bulk allocation of arcs */
+ struct arcbatch *next;
+# define ABSIZE 10
+ struct arc a[ABSIZE];
+};
+
+struct state {
+ int no;
+# define FREESTATE (-1)
+ char flag; /* marks special states */
+ int nins; /* number of inarcs */
+ struct arc *ins; /* chain of inarcs */
+ int nouts; /* number of outarcs */
+ struct arc *outs; /* chain of outarcs */
+ struct arc *free; /* chain of free arcs */
+ struct state *tmp; /* temporary for traversal algorithms */
+ struct state *next; /* chain for traversing all */
+ struct state *prev; /* back chain */
+ struct arcbatch oas; /* first arcbatch, avoid malloc in easy case */
+ int noas; /* number of arcs used in first arcbatch */
+};
+
+struct nfa {
+ struct state *pre; /* pre-initial state */
+ struct state *init; /* initial state */
+ struct state *final; /* final state */
+ struct state *post; /* post-final state */
+ int nstates; /* for numbering states */
+ struct state *states; /* state-chain header */
+ struct state *slast; /* tail of the chain */
+ struct state *free; /* free list */
+ 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 */
+ struct vars *v; /* simplifies compile error reporting */
+ struct nfa *parent; /* parent NFA, if any */
+};
+
+
+
+/*
+ * definitions for compacted NFA
+ */
+struct carc {
+ color co; /* COLORLESS is list terminator */
+ int to; /* state number */
+};
+
+struct cnfa {
+ int nstates; /* number of states */
+ int ncolors; /* number of colors */
+ int flags;
+# define HASLACONS 01 /* uses lookahead constraints */
+ int pre; /* setup state number */
+ 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 */
+ struct carc **states; /* vector of pointers to outarc lists */
+ struct carc *arcs; /* the area for the lists */
+};
+#define ZAPCNFA(cnfa) ((cnfa).nstates = 0)
+#define NULLCNFA(cnfa) ((cnfa).nstates == 0)
+
+
+
+/*
+ * subexpression tree
+ */
+struct subre {
+ char op; /* '|', '.' (concat), 'b' (backref), '(', '=' */
+ char flags;
+# define LONGER 01 /* prefers longer match */
+# define SHORTER 02 /* prefers shorter match */
+# define MIXED 04 /* mixed preference below */
+# define CAP 010 /* capturing parens below */
+# define BACKR 020 /* back reference below */
+# define INUSE 0100 /* in use in final tree */
+# define LOCAL 03 /* bits which may not propagate up */
+# define LMIX(f) ((f)<<2) /* LONGER -> MIXED */
+# define SMIX(f) ((f)<<1) /* SHORTER -> MIXED */
+# define UP(f) (((f)&~LOCAL) | (LMIX(f) & SMIX(f) & MIXED))
+# define MESSY(f) ((f)&(MIXED|CAP|BACKR))
+# define PREF(f) ((f)&LOCAL)
+# 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 */
+ int subno; /* subexpression number (for 'b' and '(') */
+ short min; /* min repetitions, for backref only */
+ short max; /* max repetitions, for backref only */
+ struct subre *left; /* left child, if any (also freelist chain) */
+ struct subre *right; /* right child, if any */
+ struct state *begin; /* outarcs from here... */
+ struct state *end; /* ...ending in inarcs here */
+ struct cnfa cnfa; /* compacted NFA, if any */
+ struct subre *chain; /* for bookkeeping and error cleanup */
+};
+
+
+
+/*
+ * table of function pointers for generic manipulation functions
+ * A regex_t's re_fns points to one of these.
+ */
+struct fns {
+ VOID FUNCPTR(free, (regex_t *));
+};
+
+
+
+/*
+ * the insides of a regex_t, hidden behind a void *
+ */
+struct guts {
+ int magic;
+# define GUTSMAGIC 0xfed9
+ int cflags; /* copy of compile flags */
+ long info; /* copy of re_info */
+ size_t nsub; /* copy of re_nsub */
+ struct subre *tree;
+ struct cnfa search; /* for fast preliminary search */
+ int ntree;
+ struct colormap cmap;
+ int FUNCPTR(compare, (CONST chr *, CONST chr *, size_t));
+ struct subre *lacons; /* lookahead-constraint vector */
+ int nlacons; /* size of lacons */
+};
diff --git a/tcl/generic/tcl.decls b/tcl/generic/tcl.decls
new file mode 100644
index 00000000000..7b9a74bdf9b
--- /dev/null
+++ b/tcl/generic/tcl.decls
@@ -0,0 +1,1489 @@
+# tcl.decls --
+#
+# 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.
+#
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+library tcl
+
+# Define the tcl interface with several sub interfaces:
+# tclPlat - platform specific public
+# tclInt - generic private
+# tclPlatInt - platform specific private
+
+interface tcl
+hooks {tclPlat tclInt tclIntPlat}
+
+# Declare each of the functions in the public Tcl interface. Note that
+# the an index should never be reused for a different function in order
+# to preserve backwards compatibility.
+
+declare 0 generic {
+ int Tcl_PkgProvideEx(Tcl_Interp *interp, char *name, char *version, \
+ ClientData clientData)
+}
+declare 1 generic {
+ char * Tcl_PkgRequireEx(Tcl_Interp *interp, char *name, char *version, \
+ int exact, ClientData *clientDataPtr)
+}
+declare 2 generic {
+ void Tcl_Panic(char *format, ...)
+}
+declare 3 generic {
+ char * Tcl_Alloc(unsigned int size)
+}
+declare 4 generic {
+ void Tcl_Free(char *ptr)
+}
+declare 5 generic {
+ char * Tcl_Realloc(char *ptr, unsigned int size)
+}
+declare 6 generic {
+ char * Tcl_DbCkalloc(unsigned int size, char *file, int line)
+}
+declare 7 generic {
+ int Tcl_DbCkfree(char *ptr, char *file, int line)
+}
+declare 8 generic {
+ char * Tcl_DbCkrealloc(char *ptr, unsigned int size, char *file, int line)
+}
+
+# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
+# but they are part of the old generic interface, so we include them here for
+# compatibility reasons.
+
+declare 9 unix {
+ void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, \
+ ClientData clientData)
+}
+declare 10 unix {
+ void Tcl_DeleteFileHandler(int fd)
+}
+
+declare 11 generic {
+ void Tcl_SetTimer(Tcl_Time *timePtr)
+}
+declare 12 generic {
+ void Tcl_Sleep(int ms)
+}
+declare 13 generic {
+ int Tcl_WaitForEvent(Tcl_Time *timePtr)
+}
+declare 14 generic {
+ int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 15 generic {
+ void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
+}
+declare 16 generic {
+ void Tcl_AppendToObj(Tcl_Obj *objPtr, char *bytes, int length)
+}
+declare 17 generic {
+ Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *CONST objv[])
+}
+declare 18 generic {
+ int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ Tcl_ObjType *typePtr)
+}
+declare 19 generic {
+ void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, char *file, int line)
+}
+declare 20 generic {
+ void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, char *file, int line)
+}
+declare 21 generic {
+ int Tcl_DbIsShared(Tcl_Obj *objPtr, char *file, int line)
+}
+declare 22 generic {
+ Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, char *file, int line)
+}
+declare 23 generic {
+ Tcl_Obj * Tcl_DbNewByteArrayObj(unsigned char *bytes, int length, \
+ char *file, int line)
+}
+declare 24 generic {
+ Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, char *file, int line)
+}
+declare 25 generic {
+ Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *CONST objv[], char *file, \
+ int line)
+}
+declare 26 generic {
+ Tcl_Obj * Tcl_DbNewLongObj(long longValue, char *file, int line)
+}
+declare 27 generic {
+ Tcl_Obj * Tcl_DbNewObj(char *file, int line)
+}
+declare 28 generic {
+ Tcl_Obj * Tcl_DbNewStringObj(CONST char *bytes, int length, \
+ char *file, int line)
+}
+declare 29 generic {
+ Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr)
+}
+declare 30 generic {
+ void TclFreeObj(Tcl_Obj *objPtr)
+}
+declare 31 generic {
+ int Tcl_GetBoolean(Tcl_Interp *interp, char *str, int *boolPtr)
+}
+declare 32 generic {
+ int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int *boolPtr)
+}
+declare 33 generic {
+ unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+}
+declare 34 generic {
+ int Tcl_GetDouble(Tcl_Interp *interp, char *str, double *doublePtr)
+}
+declare 35 generic {
+ int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ double *doublePtr)
+}
+declare 36 generic {
+ int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ char **tablePtr, char *msg, int flags, int *indexPtr)
+}
+declare 37 generic {
+ int Tcl_GetInt(Tcl_Interp *interp, char *str, int *intPtr)
+}
+declare 38 generic {
+ int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
+}
+declare 39 generic {
+ int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
+}
+declare 40 generic {
+ Tcl_ObjType * Tcl_GetObjType(char *typeName)
+}
+declare 41 generic {
+ char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+}
+declare 42 generic {
+ void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
+}
+declare 43 generic {
+ int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, \
+ Tcl_Obj *elemListPtr)
+}
+declare 44 generic {
+ int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, \
+ Tcl_Obj *objPtr)
+}
+declare 45 generic {
+ int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, \
+ int *objcPtr, Tcl_Obj ***objvPtr)
+}
+declare 46 generic {
+ int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, \
+ Tcl_Obj **objPtrPtr)
+}
+declare 47 generic {
+ int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *intPtr)
+}
+declare 48 generic {
+ int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, \
+ int count, int objc, Tcl_Obj *CONST objv[])
+}
+declare 49 generic {
+ Tcl_Obj * Tcl_NewBooleanObj(int boolValue)
+}
+declare 50 generic {
+ Tcl_Obj * Tcl_NewByteArrayObj(unsigned char *bytes, int length)
+}
+declare 51 generic {
+ Tcl_Obj * Tcl_NewDoubleObj(double doubleValue)
+}
+declare 52 generic {
+ Tcl_Obj * Tcl_NewIntObj(int intValue)
+}
+declare 53 generic {
+ Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *CONST objv[])
+}
+declare 54 generic {
+ Tcl_Obj * Tcl_NewLongObj(long longValue)
+}
+declare 55 generic {
+ Tcl_Obj * Tcl_NewObj(void)
+}
+declare 56 generic {
+ Tcl_Obj *Tcl_NewStringObj(CONST char *bytes, int length)
+}
+declare 57 generic {
+ void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
+}
+declare 58 generic {
+ unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
+}
+declare 59 generic {
+ void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, unsigned char *bytes, int length)
+}
+declare 60 generic {
+ void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
+}
+declare 61 generic {
+ void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
+}
+declare 62 generic {
+ void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[])
+}
+declare 63 generic {
+ void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
+}
+declare 64 generic {
+ void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
+}
+declare 65 generic {
+ void Tcl_SetStringObj(Tcl_Obj *objPtr, char *bytes, int length)
+}
+declare 66 generic {
+ void Tcl_AddErrorInfo(Tcl_Interp *interp, CONST char *message)
+}
+declare 67 generic {
+ void Tcl_AddObjErrorInfo(Tcl_Interp *interp, CONST char *message, \
+ int length)
+}
+declare 68 generic {
+ void Tcl_AllowExceptions(Tcl_Interp *interp)
+}
+declare 69 generic {
+ void Tcl_AppendElement(Tcl_Interp *interp, CONST char *string)
+}
+declare 70 generic {
+ void Tcl_AppendResult(Tcl_Interp *interp, ...)
+}
+declare 71 generic {
+ Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, \
+ ClientData clientData)
+}
+declare 72 generic {
+ void Tcl_AsyncDelete(Tcl_AsyncHandler async)
+}
+declare 73 generic {
+ int Tcl_AsyncInvoke(Tcl_Interp *interp, int code)
+}
+declare 74 generic {
+ void Tcl_AsyncMark(Tcl_AsyncHandler async)
+}
+declare 75 generic {
+ int Tcl_AsyncReady(void)
+}
+declare 76 generic {
+ void Tcl_BackgroundError(Tcl_Interp *interp)
+}
+declare 77 generic {
+ char Tcl_Backslash(CONST char *src, int *readPtr)
+}
+declare 78 generic {
+ int Tcl_BadChannelOption(Tcl_Interp *interp, char *optionName, \
+ char *optionList)
+}
+declare 79 generic {
+ void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, \
+ ClientData clientData)
+}
+declare 80 generic {
+ void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData)
+}
+declare 81 generic {
+ int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
+}
+declare 82 generic {
+ int Tcl_CommandComplete(char *cmd)
+}
+declare 83 generic {
+ char * Tcl_Concat(int argc, char **argv)
+}
+declare 84 generic {
+ int Tcl_ConvertElement(CONST char *src, char *dst, int flags)
+}
+declare 85 generic {
+ int Tcl_ConvertCountedElement(CONST char *src, int length, char *dst, \
+ int flags)
+}
+declare 86 generic {
+ int Tcl_CreateAlias(Tcl_Interp *slave, char *slaveCmd, \
+ Tcl_Interp *target, char *targetCmd, int argc, char **argv)
+}
+declare 87 generic {
+ int Tcl_CreateAliasObj(Tcl_Interp *slave, char *slaveCmd, \
+ Tcl_Interp *target, char *targetCmd, int objc, \
+ Tcl_Obj *CONST objv[])
+}
+declare 88 generic {
+ Tcl_Channel Tcl_CreateChannel(Tcl_ChannelType *typePtr, char *chanName, \
+ ClientData instanceData, int mask)
+}
+declare 89 generic {
+ void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, \
+ Tcl_ChannelProc *proc, ClientData clientData)
+}
+declare 90 generic {
+ void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, \
+ ClientData clientData)
+}
+declare 91 generic {
+ Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, char *cmdName, \
+ Tcl_CmdProc *proc, ClientData clientData, \
+ Tcl_CmdDeleteProc *deleteProc)
+}
+declare 92 generic {
+ void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, \
+ Tcl_EventCheckProc *checkProc, ClientData clientData)
+}
+declare 93 generic {
+ void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
+}
+declare 94 generic {
+ Tcl_Interp * Tcl_CreateInterp(void)
+}
+declare 95 generic {
+ void Tcl_CreateMathFunc(Tcl_Interp *interp, char *name, int numArgs, \
+ Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData)
+}
+declare 96 generic {
+ Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, char *cmdName, \
+ Tcl_ObjCmdProc *proc, ClientData clientData, \
+ Tcl_CmdDeleteProc *deleteProc)
+}
+declare 97 generic {
+ Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, char *slaveName, \
+ int isSafe)
+}
+declare 98 generic {
+ Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, \
+ Tcl_TimerProc *proc, ClientData clientData)
+}
+declare 99 generic {
+ Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, \
+ Tcl_CmdTraceProc *proc, ClientData clientData)
+}
+declare 100 generic {
+ void Tcl_DeleteAssocData(Tcl_Interp *interp, char *name)
+}
+declare 101 generic {
+ void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, \
+ ClientData clientData)
+}
+declare 102 generic {
+ void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, \
+ ClientData clientData)
+}
+declare 103 generic {
+ int Tcl_DeleteCommand(Tcl_Interp *interp, char *cmdName)
+}
+declare 104 generic {
+ int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command)
+}
+declare 105 generic {
+ void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData)
+}
+declare 106 generic {
+ void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, \
+ Tcl_EventCheckProc *checkProc, ClientData clientData)
+}
+declare 107 generic {
+ void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData)
+}
+declare 108 generic {
+ void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr)
+}
+declare 109 generic {
+ void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr)
+}
+declare 110 generic {
+ void Tcl_DeleteInterp(Tcl_Interp *interp)
+}
+declare 111 {unix win} {
+ void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr)
+}
+declare 112 generic {
+ void Tcl_DeleteTimerHandler(Tcl_TimerToken token)
+}
+declare 113 generic {
+ void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace)
+}
+declare 114 generic {
+ void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, \
+ Tcl_InterpDeleteProc *proc, ClientData clientData)
+}
+declare 115 generic {
+ int Tcl_DoOneEvent(int flags)
+}
+declare 116 generic {
+ void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData)
+}
+declare 117 generic {
+ char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *str, int length)
+}
+declare 118 generic {
+ char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, CONST char *string)
+}
+declare 119 generic {
+ void Tcl_DStringEndSublist(Tcl_DString *dsPtr)
+}
+declare 120 generic {
+ void Tcl_DStringFree(Tcl_DString *dsPtr)
+}
+declare 121 generic {
+ void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
+}
+declare 122 generic {
+ void Tcl_DStringInit(Tcl_DString *dsPtr)
+}
+declare 123 generic {
+ void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
+}
+declare 124 generic {
+ void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length)
+}
+declare 125 generic {
+ void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
+}
+declare 126 generic {
+ int Tcl_Eof(Tcl_Channel chan)
+}
+declare 127 generic {
+ char * Tcl_ErrnoId(void)
+}
+declare 128 generic {
+ char * Tcl_ErrnoMsg(int err)
+}
+declare 129 generic {
+ int Tcl_Eval(Tcl_Interp *interp, char *string)
+}
+declare 130 generic {
+ int Tcl_EvalFile(Tcl_Interp *interp, char *fileName)
+}
+declare 131 generic {
+ int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 132 generic {
+ void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
+}
+declare 133 generic {
+ void Tcl_Exit(int status)
+}
+declare 134 generic {
+ int Tcl_ExposeCommand(Tcl_Interp *interp, char *hiddenCmdToken, \
+ char *cmdName)
+}
+declare 135 generic {
+ int Tcl_ExprBoolean(Tcl_Interp *interp, char *str, int *ptr)
+}
+declare 136 generic {
+ int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr)
+}
+declare 137 generic {
+ int Tcl_ExprDouble(Tcl_Interp *interp, char *str, double *ptr)
+}
+declare 138 generic {
+ int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr)
+}
+declare 139 generic {
+ int Tcl_ExprLong(Tcl_Interp *interp, char *str, long *ptr)
+}
+declare 140 generic {
+ int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr)
+}
+declare 141 generic {
+ int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ Tcl_Obj **resultPtrPtr)
+}
+declare 142 generic {
+ int Tcl_ExprString(Tcl_Interp *interp, char *string)
+}
+declare 143 generic {
+ void Tcl_Finalize(void)
+}
+declare 144 generic {
+ void Tcl_FindExecutable(CONST char *argv0)
+}
+declare 145 generic {
+ Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, \
+ Tcl_HashSearch *searchPtr)
+}
+declare 146 generic {
+ int Tcl_Flush(Tcl_Channel chan)
+}
+declare 147 generic {
+ void Tcl_FreeResult(Tcl_Interp *interp)
+}
+declare 148 generic {
+ int Tcl_GetAlias(Tcl_Interp *interp, char *slaveCmd, \
+ Tcl_Interp **targetInterpPtr, char **targetCmdPtr, int *argcPtr, \
+ char ***argvPtr)
+}
+declare 149 generic {
+ int Tcl_GetAliasObj(Tcl_Interp *interp, char *slaveCmd, \
+ Tcl_Interp **targetInterpPtr, char **targetCmdPtr, int *objcPtr, \
+ Tcl_Obj ***objv)
+}
+declare 150 generic {
+ ClientData Tcl_GetAssocData(Tcl_Interp *interp, char *name, \
+ Tcl_InterpDeleteProc **procPtr)
+}
+declare 151 generic {
+ Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, char *chanName, \
+ int *modePtr)
+}
+declare 152 generic {
+ int Tcl_GetChannelBufferSize(Tcl_Channel chan)
+}
+declare 153 generic {
+ int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, \
+ ClientData *handlePtr)
+}
+declare 154 generic {
+ ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan)
+}
+declare 155 generic {
+ int Tcl_GetChannelMode(Tcl_Channel chan)
+}
+declare 156 generic {
+ char * Tcl_GetChannelName(Tcl_Channel chan)
+}
+declare 157 generic {
+ int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, \
+ char *optionName, Tcl_DString *dsPtr)
+}
+declare 158 generic {
+ Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan)
+}
+declare 159 generic {
+ int Tcl_GetCommandInfo(Tcl_Interp *interp, char *cmdName, \
+ Tcl_CmdInfo *infoPtr)
+}
+declare 160 generic {
+ char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command)
+}
+declare 161 generic {
+ int Tcl_GetErrno(void)
+}
+declare 162 generic {
+ char * Tcl_GetHostName(void)
+}
+declare 163 generic {
+ int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
+}
+declare 164 generic {
+ Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp)
+}
+declare 165 generic {
+ CONST char * Tcl_GetNameOfExecutable(void)
+}
+declare 166 generic {
+ Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp)
+}
+
+# Tcl_GetOpenFile is only available on unix, but it is a part of the old
+# generic interface, so we inlcude it here for compatibility reasons.
+
+declare 167 unix {
+ int Tcl_GetOpenFile(Tcl_Interp *interp, char *str, int forWriting, \
+ int checkUsage, ClientData *filePtr)
+}
+
+declare 168 generic {
+ Tcl_PathType Tcl_GetPathType(char *path)
+}
+declare 169 generic {
+ int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
+}
+declare 170 generic {
+ int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr)
+}
+declare 171 generic {
+ int Tcl_GetServiceMode(void)
+}
+declare 172 generic {
+ Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, char *slaveName)
+}
+declare 173 generic {
+ Tcl_Channel Tcl_GetStdChannel(int type)
+}
+declare 174 generic {
+ char * Tcl_GetStringResult(Tcl_Interp *interp)
+}
+declare 175 generic {
+ char * Tcl_GetVar(Tcl_Interp *interp, char *varName, int flags)
+}
+declare 176 generic {
+ char * Tcl_GetVar2(Tcl_Interp *interp, char *part1, char *part2, int flags)
+}
+declare 177 generic {
+ int Tcl_GlobalEval(Tcl_Interp *interp, char *command)
+}
+declare 178 generic {
+ int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 179 generic {
+ int Tcl_HideCommand(Tcl_Interp *interp, char *cmdName, \
+ char *hiddenCmdToken)
+}
+declare 180 generic {
+ int Tcl_Init(Tcl_Interp *interp)
+}
+declare 181 generic {
+ void Tcl_InitHashTable(Tcl_HashTable *tablePtr, int keyType)
+}
+declare 182 generic {
+ int Tcl_InputBlocked(Tcl_Channel chan)
+}
+declare 183 generic {
+ int Tcl_InputBuffered(Tcl_Channel chan)
+}
+declare 184 generic {
+ int Tcl_InterpDeleted(Tcl_Interp *interp)
+}
+declare 185 generic {
+ int Tcl_IsSafe(Tcl_Interp *interp)
+}
+declare 186 generic {
+ char * Tcl_JoinPath(int argc, char **argv, Tcl_DString *resultPtr)
+}
+declare 187 generic {
+ int Tcl_LinkVar(Tcl_Interp *interp, char *varName, char *addr, int type)
+}
+
+# This slot is reserved for use by the plus patch:
+# declare 188 generic {
+# Tcl_MainLoop
+# }
+
+declare 189 generic {
+ Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode)
+}
+declare 190 generic {
+ int Tcl_MakeSafe(Tcl_Interp *interp)
+}
+declare 191 generic {
+ Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
+}
+declare 192 generic {
+ char * Tcl_Merge(int argc, char **argv)
+}
+declare 193 generic {
+ Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
+}
+declare 194 generic {
+ void Tcl_NotifyChannel(Tcl_Channel channel, int mask)
+}
+declare 195 generic {
+ Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \
+ Tcl_Obj *part2Ptr, int flags)
+}
+declare 196 generic {
+ Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \
+ Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
+}
+declare 197 {unix win} {
+ Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, \
+ char **argv, int flags)
+}
+declare 198 generic {
+ Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, char *fileName, \
+ char *modeString, int permissions)
+}
+declare 199 generic {
+ Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, \
+ char *address, char *myaddr, int myport, int async)
+}
+declare 200 generic {
+ Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, char *host, \
+ Tcl_TcpAcceptProc *acceptProc, ClientData callbackData)
+}
+declare 201 generic {
+ void Tcl_Preserve(ClientData data)
+}
+declare 202 generic {
+ void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst)
+}
+declare 203 generic {
+ int Tcl_PutEnv(CONST char *string)
+}
+declare 204 generic {
+ char * Tcl_PosixError(Tcl_Interp *interp)
+}
+declare 205 generic {
+ void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
+}
+declare 206 generic {
+ int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
+}
+declare 207 {unix win} {
+ void Tcl_ReapDetachedProcs(void)
+}
+declare 208 generic {
+ int Tcl_RecordAndEval(Tcl_Interp *interp, char *cmd, int flags)
+}
+declare 209 generic {
+ int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags)
+}
+declare 210 generic {
+ void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
+}
+declare 211 generic {
+ void Tcl_RegisterObjType(Tcl_ObjType *typePtr)
+}
+declare 212 generic {
+ Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, char *string)
+}
+declare 213 generic {
+ int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, \
+ CONST char *str, CONST char *start)
+}
+declare 214 generic {
+ int Tcl_RegExpMatch(Tcl_Interp *interp, char *str, char *pattern)
+}
+declare 215 generic {
+ void Tcl_RegExpRange(Tcl_RegExp regexp, int index, char **startPtr, \
+ char **endPtr)
+}
+declare 216 generic {
+ void Tcl_Release(ClientData clientData)
+}
+declare 217 generic {
+ void Tcl_ResetResult(Tcl_Interp *interp)
+}
+declare 218 generic {
+ int Tcl_ScanElement(CONST char *str, int *flagPtr)
+}
+declare 219 generic {
+ int Tcl_ScanCountedElement(CONST char *str, int length, int *flagPtr)
+}
+declare 220 generic {
+ int Tcl_Seek(Tcl_Channel chan, int offset, int mode)
+}
+declare 221 generic {
+ int Tcl_ServiceAll(void)
+}
+declare 222 generic {
+ int Tcl_ServiceEvent(int flags)
+}
+declare 223 generic {
+ void Tcl_SetAssocData(Tcl_Interp *interp, char *name, \
+ Tcl_InterpDeleteProc *proc, ClientData clientData)
+}
+declare 224 generic {
+ void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz)
+}
+declare 225 generic {
+ int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, \
+ char *optionName, char *newValue)
+}
+declare 226 generic {
+ int Tcl_SetCommandInfo(Tcl_Interp *interp, char *cmdName, \
+ Tcl_CmdInfo *infoPtr)
+}
+declare 227 generic {
+ void Tcl_SetErrno(int err)
+}
+declare 228 generic {
+ void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
+}
+declare 229 generic {
+ void Tcl_SetMaxBlockTime(Tcl_Time *timePtr)
+}
+declare 230 generic {
+ void Tcl_SetPanicProc(Tcl_PanicProc *panicProc)
+}
+declare 231 generic {
+ int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
+}
+declare 232 generic {
+ void Tcl_SetResult(Tcl_Interp *interp, char *str, \
+ Tcl_FreeProc *freeProc)
+}
+declare 233 generic {
+ int Tcl_SetServiceMode(int mode)
+}
+declare 234 generic {
+ void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr)
+}
+declare 235 generic {
+ void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr)
+}
+declare 236 generic {
+ void Tcl_SetStdChannel(Tcl_Channel channel, int type)
+}
+declare 237 generic {
+ char * Tcl_SetVar(Tcl_Interp *interp, char *varName, char *newValue, \
+ int flags)
+}
+declare 238 generic {
+ char * Tcl_SetVar2(Tcl_Interp *interp, char *part1, char *part2, \
+ char *newValue, int flags)
+}
+declare 239 generic {
+ char * Tcl_SignalId(int sig)
+}
+declare 240 generic {
+ char * Tcl_SignalMsg(int sig)
+}
+declare 241 generic {
+ void Tcl_SourceRCFile(Tcl_Interp *interp)
+}
+declare 242 generic {
+ int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr, \
+ char ***argvPtr)
+}
+declare 243 generic {
+ void Tcl_SplitPath(CONST char *path, int *argcPtr, char ***argvPtr)
+}
+declare 244 generic {
+ void Tcl_StaticPackage(Tcl_Interp *interp, char *pkgName, \
+ Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
+}
+declare 245 generic {
+ int Tcl_StringMatch(CONST char *str, CONST char *pattern)
+}
+declare 246 generic {
+ int Tcl_Tell(Tcl_Channel chan)
+}
+declare 247 generic {
+ int Tcl_TraceVar(Tcl_Interp *interp, char *varName, int flags, \
+ Tcl_VarTraceProc *proc, ClientData clientData)
+}
+declare 248 generic {
+ int Tcl_TraceVar2(Tcl_Interp *interp, char *part1, char *part2, \
+ int flags, Tcl_VarTraceProc *proc, ClientData clientData)
+}
+declare 249 generic {
+ char * Tcl_TranslateFileName(Tcl_Interp *interp, char *name, \
+ Tcl_DString *bufferPtr)
+}
+declare 250 generic {
+ int Tcl_Ungets(Tcl_Channel chan, char *str, int len, int atHead)
+}
+declare 251 generic {
+ void Tcl_UnlinkVar(Tcl_Interp *interp, char *varName)
+}
+declare 252 generic {
+ int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
+}
+declare 253 generic {
+ int Tcl_UnsetVar(Tcl_Interp *interp, char *varName, int flags)
+}
+declare 254 generic {
+ int Tcl_UnsetVar2(Tcl_Interp *interp, char *part1, char *part2, int flags)
+}
+declare 255 generic {
+ void Tcl_UntraceVar(Tcl_Interp *interp, char *varName, int flags, \
+ Tcl_VarTraceProc *proc, ClientData clientData)
+}
+declare 256 generic {
+ void Tcl_UntraceVar2(Tcl_Interp *interp, char *part1, char *part2, \
+ int flags, Tcl_VarTraceProc *proc, ClientData clientData)
+}
+declare 257 generic {
+ void Tcl_UpdateLinkedVar(Tcl_Interp *interp, char *varName)
+}
+declare 258 generic {
+ int Tcl_UpVar(Tcl_Interp *interp, char *frameName, char *varName, \
+ char *localName, int flags)
+}
+declare 259 generic {
+ int Tcl_UpVar2(Tcl_Interp *interp, char *frameName, char *part1, \
+ char *part2, char *localName, int flags)
+}
+declare 260 generic {
+ int Tcl_VarEval(Tcl_Interp *interp, ...)
+}
+declare 261 generic {
+ ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, char *varName, \
+ int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
+}
+declare 262 generic {
+ ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, char *part1, \
+ char *part2, int flags, Tcl_VarTraceProc *procPtr, \
+ ClientData prevClientData)
+}
+declare 263 generic {
+ int Tcl_Write(Tcl_Channel chan, char *s, int slen)
+}
+declare 264 generic {
+ void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, \
+ Tcl_Obj *CONST objv[], char *message)
+}
+declare 265 generic {
+ int Tcl_DumpActiveMemory(char *fileName)
+}
+declare 266 generic {
+ void Tcl_ValidateAllMemory(char *file, int line)
+}
+declare 267 generic {
+ void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
+}
+declare 268 generic {
+ void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
+}
+declare 269 generic {
+ char * Tcl_HashStats(Tcl_HashTable *tablePtr)
+}
+declare 270 generic {
+ char * Tcl_ParseVar(Tcl_Interp *interp, char *str, char **termPtr)
+}
+declare 271 generic {
+ char * Tcl_PkgPresent(Tcl_Interp *interp, char *name, char *version, \
+ int exact)
+}
+declare 272 generic {
+ char * Tcl_PkgPresentEx(Tcl_Interp *interp, char *name, char *version, \
+ int exact, ClientData *clientDataPtr)
+}
+declare 273 generic {
+ int Tcl_PkgProvide(Tcl_Interp *interp, char *name, char *version)
+}
+declare 274 generic {
+ char * Tcl_PkgRequire(Tcl_Interp *interp, char *name, char *version, \
+ int exact)
+}
+declare 275 generic {
+ void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
+}
+declare 276 generic {
+ int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
+}
+declare 277 generic {
+ Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
+}
+declare 278 {unix win} {
+ void Tcl_PanicVA(char *format, va_list argList)
+}
+declare 279 generic {
+ void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
+}
+declare 280 generic {
+ void Tcl_InitMemory(Tcl_Interp *interp)
+}
+
+# Andreas Kupries <a.kupries@westend.com>, 03/21/1999
+# "Trf-Patch for filtering channels"
+#
+# C-Level API for (un)stacking of channels. This allows the introduction
+# of filtering channels with relatively little changes to the core.
+# This patch was created in cooperation with Jan Nijtmans j.nijtmans@chello.nl
+# and is therefore part of his plus-patches too.
+#
+# It would have been possible to place the following definitions according
+# to the alphabetical order used elsewhere in this file, but I decided
+# against that to ease the maintenance of the patch across new tcl versions
+# (patch usually has no problems to integrate the patch file for the last
+# version into the new one).
+
+declare 281 generic {
+ Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, \
+ Tcl_ChannelType *typePtr, ClientData instanceData, \
+ int mask, Tcl_Channel prevChan)
+}
+declare 282 generic {
+ int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan)
+}
+declare 283 generic {
+ Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan)
+}
+# Reserved for future use (8.0.x vs. 8.1)
+# declare 284 generic {
+# }
+# declare 285 generic {
+# }
+
+
+# Added in 8.1:
+
+declare 286 generic {
+ void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)
+}
+declare 287 generic {
+ Tcl_Encoding Tcl_CreateEncoding(Tcl_EncodingType *typePtr)
+}
+declare 288 generic {
+ void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
+}
+declare 289 generic {
+ void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
+}
+declare 290 generic {
+ void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
+}
+declare 291 generic {
+ int Tcl_EvalEx(Tcl_Interp *interp, char *script, int numBytes, int flags)
+}
+declare 292 generic {
+ int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \
+ int flags)
+}
+declare 293 generic {
+ int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
+}
+declare 294 generic {
+ void Tcl_ExitThread(int status)
+}
+declare 295 generic {
+ int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, \
+ CONST char *src, int srcLen, int flags, \
+ Tcl_EncodingState *statePtr, char *dst, int dstLen, \
+ int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
+}
+declare 296 generic {
+ char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, CONST char *src, \
+ int srcLen, Tcl_DString *dsPtr)
+}
+declare 297 generic {
+ void Tcl_FinalizeThread(void)
+}
+declare 298 generic {
+ void Tcl_FinalizeNotifier(ClientData clientData)
+}
+declare 299 generic {
+ void Tcl_FreeEncoding(Tcl_Encoding encoding)
+}
+declare 300 generic {
+ Tcl_ThreadId Tcl_GetCurrentThread(void)
+}
+declare 301 generic {
+ Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, CONST char *name)
+}
+declare 302 generic {
+ char * Tcl_GetEncodingName(Tcl_Encoding encoding)
+}
+declare 303 generic {
+ void Tcl_GetEncodingNames(Tcl_Interp *interp)
+}
+declare 304 generic {
+ int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ char **tablePtr, int offset, char *msg, int flags, int *indexPtr)
+}
+declare 305 generic {
+ VOID * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
+}
+declare 306 generic {
+ Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, char *part1, char *part2, \
+ int flags)
+}
+declare 307 generic {
+ ClientData Tcl_InitNotifier(void)
+}
+declare 308 generic {
+ void Tcl_MutexLock(Tcl_Mutex *mutexPtr)
+}
+declare 309 generic {
+ void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr)
+}
+declare 310 generic {
+ void Tcl_ConditionNotify(Tcl_Condition *condPtr)
+}
+declare 311 generic {
+ void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, \
+ Tcl_Time *timePtr)
+}
+declare 312 generic {
+ int Tcl_NumUtfChars(CONST char *src, int len)
+}
+declare 313 generic {
+ int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, \
+ int appendFlag)
+}
+declare 314 generic {
+ void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
+}
+declare 315 generic {
+ void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
+}
+declare 316 generic {
+ int Tcl_SetSystemEncoding(Tcl_Interp *interp, CONST char *name)
+}
+declare 317 generic {
+ Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, char *part1, char *part2, \
+ Tcl_Obj *newValuePtr, int flags)
+}
+declare 318 generic {
+ void Tcl_ThreadAlert(Tcl_ThreadId threadId)
+}
+declare 319 generic {
+ void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event* evPtr, \
+ Tcl_QueuePosition position)
+}
+declare 320 generic {
+ Tcl_UniChar Tcl_UniCharAtIndex(CONST char *src, int index)
+}
+declare 321 generic {
+ Tcl_UniChar Tcl_UniCharToLower(int ch)
+}
+declare 322 generic {
+ Tcl_UniChar Tcl_UniCharToTitle(int ch)
+}
+declare 323 generic {
+ Tcl_UniChar Tcl_UniCharToUpper(int ch)
+}
+declare 324 generic {
+ int Tcl_UniCharToUtf(int ch, char *buf)
+}
+declare 325 generic {
+ char * Tcl_UtfAtIndex(CONST char *src, int index)
+}
+declare 326 generic {
+ int Tcl_UtfCharComplete(CONST char *src, int len)
+}
+declare 327 generic {
+ int Tcl_UtfBackslash(CONST char *src, int *readPtr, char *dst)
+}
+declare 328 generic {
+ char * Tcl_UtfFindFirst(CONST char *src, int ch)
+}
+declare 329 generic {
+ char * Tcl_UtfFindLast(CONST char *src, int ch)
+}
+declare 330 generic {
+ char * Tcl_UtfNext(CONST char *src)
+}
+declare 331 generic {
+ char * Tcl_UtfPrev(CONST char *src, CONST char *start)
+}
+declare 332 generic {
+ int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, \
+ CONST char *src, int srcLen, int flags, \
+ Tcl_EncodingState *statePtr, char *dst, int dstLen, \
+ int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
+}
+declare 333 generic {
+ char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, CONST char *src, \
+ int srcLen, Tcl_DString *dsPtr)
+}
+declare 334 generic {
+ int Tcl_UtfToLower(char *src)
+}
+declare 335 generic {
+ int Tcl_UtfToTitle(char *src)
+}
+declare 336 generic {
+ int Tcl_UtfToUniChar(CONST char *src, Tcl_UniChar *chPtr)
+}
+declare 337 generic {
+ int Tcl_UtfToUpper(char *src)
+}
+declare 338 generic {
+ int Tcl_WriteChars(Tcl_Channel chan, CONST char *src, int srcLen)
+}
+declare 339 generic {
+ int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
+}
+declare 340 generic {
+ char * Tcl_GetString(Tcl_Obj *objPtr)
+}
+declare 341 generic {
+ char * Tcl_GetDefaultEncodingDir(void)
+}
+declare 342 generic {
+ void Tcl_SetDefaultEncodingDir(char *path)
+}
+declare 343 generic {
+ void Tcl_AlertNotifier(ClientData clientData)
+}
+declare 344 generic {
+ void Tcl_ServiceModeHook(int mode)
+}
+declare 345 generic {
+ int Tcl_UniCharIsAlnum(int ch)
+}
+declare 346 generic {
+ int Tcl_UniCharIsAlpha(int ch)
+}
+declare 347 generic {
+ int Tcl_UniCharIsDigit(int ch)
+}
+declare 348 generic {
+ int Tcl_UniCharIsLower(int ch)
+}
+declare 349 generic {
+ int Tcl_UniCharIsSpace(int ch)
+}
+declare 350 generic {
+ int Tcl_UniCharIsUpper(int ch)
+}
+declare 351 generic {
+ int Tcl_UniCharIsWordChar(int ch)
+}
+declare 352 generic {
+ int Tcl_UniCharLen(Tcl_UniChar *str)
+}
+declare 353 generic {
+ int Tcl_UniCharNcmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct,\
+ unsigned long n)
+}
+declare 354 generic {
+ char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string, int numChars, \
+ Tcl_DString *dsPtr)
+}
+declare 355 generic {
+ Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string, int length, \
+ Tcl_DString *dsPtr)
+}
+declare 356 generic {
+ Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags)
+}
+
+declare 357 generic {
+ Tcl_Obj *Tcl_EvalTokens (Tcl_Interp *interp, Tcl_Token *tokenPtr, \
+ int count)
+}
+declare 358 generic {
+ void Tcl_FreeParse (Tcl_Parse *parsePtr)
+}
+declare 359 generic {
+ void Tcl_LogCommandInfo (Tcl_Interp *interp, char *script, \
+ char *command, int length)
+}
+declare 360 generic {
+ int Tcl_ParseBraces (Tcl_Interp *interp, char *string, \
+ int numBytes, Tcl_Parse *parsePtr,int append, char **termPtr)
+}
+declare 361 generic {
+ int Tcl_ParseCommand (Tcl_Interp *interp, char *string, int numBytes, \
+ int nested, Tcl_Parse *parsePtr)
+}
+declare 362 generic {
+ int Tcl_ParseExpr(Tcl_Interp *interp, char *string, int numBytes, \
+ Tcl_Parse *parsePtr)
+}
+declare 363 generic {
+ int Tcl_ParseQuotedString(Tcl_Interp *interp, char *string, int numBytes, \
+ Tcl_Parse *parsePtr, int append, char **termPtr)
+}
+declare 364 generic {
+ int Tcl_ParseVarName (Tcl_Interp *interp, char *string, \
+ int numBytes, Tcl_Parse *parsePtr, int append)
+}
+declare 365 generic {
+ char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
+}
+declare 366 generic {
+ int Tcl_Chdir(CONST char *dirName)
+}
+declare 367 generic {
+ int Tcl_Access(CONST char *path, int mode)
+}
+declare 368 generic {
+ int Tcl_Stat(CONST char *path, struct stat *bufPtr)
+}
+declare 369 generic {
+ int Tcl_UtfNcmp(CONST char *s1, CONST char *s2, unsigned long n)
+}
+declare 370 generic {
+ int Tcl_UtfNcasecmp(CONST char *s1, CONST char *s2, unsigned long n)
+}
+declare 371 generic {
+ int Tcl_StringCaseMatch(CONST char *str, CONST char *pattern, int nocase)
+}
+declare 372 generic {
+ int Tcl_UniCharIsControl(int ch)
+}
+declare 373 generic {
+ int Tcl_UniCharIsGraph(int ch)
+}
+declare 374 generic {
+ int Tcl_UniCharIsPrint(int ch)
+}
+declare 375 generic {
+ int Tcl_UniCharIsPunct(int ch)
+}
+declare 376 generic {
+ int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, \
+ Tcl_Obj *objPtr, int offset, int nmatches, int flags)
+}
+declare 377 generic {
+ void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
+}
+declare 378 generic {
+ Tcl_Obj * Tcl_NewUnicodeObj(Tcl_UniChar *unicode, int numChars)
+}
+declare 379 generic {
+ void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, Tcl_UniChar *unicode, \
+ int numChars)
+}
+declare 380 generic {
+ int Tcl_GetCharLength (Tcl_Obj *objPtr)
+}
+declare 381 generic {
+ Tcl_UniChar Tcl_GetUniChar (Tcl_Obj *objPtr, int index)
+}
+declare 382 generic {
+ Tcl_UniChar * Tcl_GetUnicode (Tcl_Obj *objPtr)
+}
+declare 383 generic {
+ Tcl_Obj * Tcl_GetRange (Tcl_Obj *objPtr, int first, int last)
+}
+declare 384 generic {
+ void Tcl_AppendUnicodeToObj (Tcl_Obj *objPtr, \
+ Tcl_UniChar *unicode, int length)
+}
+declare 385 generic {
+ int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *stringObj, \
+ Tcl_Obj *patternObj)
+}
+declare 386 generic {
+ void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr)
+}
+declare 387 generic {
+ Tcl_Mutex * Tcl_GetAllocMutex(void)
+}
+declare 388 generic {
+ int Tcl_GetChannelNames(Tcl_Interp *interp)
+}
+declare 389 generic {
+ int Tcl_GetChannelNamesEx(Tcl_Interp *interp, char *pattern)
+}
+declare 390 generic {
+ int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, \
+ int objc, Tcl_Obj *CONST objv[])
+}
+declare 391 generic {
+ void Tcl_ConditionFinalize (Tcl_Condition *condPtr)
+}
+declare 392 generic {
+ void Tcl_MutexFinalize (Tcl_Mutex *mutex)
+}
+declare 393 generic {
+ int Tcl_CreateThread (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, \
+ ClientData clientData, int stackSize, int flags)
+}
+
+declare 394 generic {
+ int Tcl_ReadRaw (Tcl_Channel chan, char *dst, int bytesToRead)
+}
+declare 395 generic {
+ int Tcl_WriteRaw (Tcl_Channel chan, char *src, int srcLen)
+}
+declare 396 generic {
+ Tcl_Channel Tcl_GetTopChannel (Tcl_Channel chan)
+}
+declare 397 generic {
+ int Tcl_ChannelBuffered (Tcl_Channel chan)
+}
+declare 398 generic {
+ char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
+}
+declare 399 generic {
+ Tcl_ChannelTypeVersion Tcl_ChannelVersion(Tcl_ChannelType *chanTypePtr)
+}
+declare 400 generic {
+ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+declare 401 generic {
+ Tcl_DriverCloseProc * Tcl_ChannelCloseProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 402 generic {
+ Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(Tcl_ChannelType *chanTypePtr)
+}
+declare 403 generic {
+ Tcl_DriverInputProc * Tcl_ChannelInputProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 404 generic {
+ Tcl_DriverOutputProc * Tcl_ChannelOutputProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 405 generic {
+ Tcl_DriverSeekProc * Tcl_ChannelSeekProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 406 generic {
+ Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+declare 407 generic {
+ Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+declare 408 generic {
+ Tcl_DriverWatchProc * Tcl_ChannelWatchProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 409 generic {
+ Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+declare 410 generic {
+ Tcl_DriverFlushProc * Tcl_ChannelFlushProc(Tcl_ChannelType *chanTypePtr)
+}
+declare 411 generic {
+ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(Tcl_ChannelType \
+ *chanTypePtr)
+}
+
+##############################################################################
+
+# Define the platform specific public Tcl interface. These functions are
+# only available on the designated platform.
+
+interface tclPlat
+
+######################
+# Windows declarations
+
+# Added in Tcl 8.1
+
+declare 0 win {
+ TCHAR * Tcl_WinUtfToTChar(CONST char *str, int len, Tcl_DString *dsPtr)
+}
+declare 1 win {
+ char * Tcl_WinTCharToUtf(CONST TCHAR *str, int len, Tcl_DString *dsPtr)
+}
+
+##################
+# Mac declarations
+
+# This is needed by the shells to handle Macintosh events.
+
+declare 0 mac {
+ void Tcl_MacSetEventProc(Tcl_MacConvertEventPtr procPtr)
+}
+
+# These routines are useful for handling using scripts from resources
+# in the application shell
+
+declare 1 mac {
+ char * Tcl_MacConvertTextResource(Handle resource)
+}
+declare 2 mac {
+ int Tcl_MacEvalResource(Tcl_Interp *interp, char *resourceName, \
+ int resourceNumber, char *fileName)
+}
+declare 3 mac {
+ Handle Tcl_MacFindResource(Tcl_Interp *interp, long resourceType, \
+ char *resourceName, int resourceNumber, char *resFileRef, \
+ int * releaseIt)
+}
+
+# These routines support the new OSType object type (i.e. the packed 4
+# character type and creator codes).
+
+declare 4 mac {
+ int Tcl_GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ OSType *osTypePtr)
+}
+declare 5 mac {
+ void Tcl_SetOSTypeObj(Tcl_Obj *objPtr, OSType osType)
+}
+declare 6 mac {
+ Tcl_Obj * Tcl_NewOSTypeObj(OSType osType)
+}
+
+# These are not in MSL 2.1.2, so we need to export them from the
+# Tcl shared library. They are found in the compat directory
+# except the panic routine which is found in tclMacPanic.h.
+
+declare 7 mac {
+ int strncasecmp(CONST char *s1, CONST char *s2, size_t n)
+}
+declare 8 mac {
+ int strcasecmp(CONST char *s1, CONST char *s2)
+}
+
diff --git a/tcl/generic/tcl.h b/tcl/generic/tcl.h
index c0569829f8b..f4574f30d95 100644
--- a/tcl/generic/tcl.h
+++ b/tcl/generic/tcl.h
@@ -5,9 +5,9 @@
* of the Tcl interpreter.
*
* Copyright (c) 1987-1994 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1993-1996 Lucent Technologies.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -19,32 +19,50 @@
#define _TCL
/*
+ * For C++ compilers, use extern "C"
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * The following defines are used to indicate the various release levels.
+ */
+
+#define TCL_ALPHA_RELEASE 0
+#define TCL_BETA_RELEASE 1
+#define TCL_FINAL_RELEASE 2
+
+/*
* When version numbers change here, must also go into the following files
* and update the version numbers:
*
- * README
- * library/init.tcl (only if major.minor changes, not patchlevel)
- * unix/configure.in
- * win/makefile.bc (only if major.minor changes, not patchlevel)
- * win/makefile.vc (only if major.minor changes, not patchlevel)
- * win/README
- * win/README.binary
- *
- * The release level should be 0 for alpha, 1 for beta, and 2 for
- * final/patch. The release serial value is the number that follows the
- * "a", "b", or "p" in the patch level; for example, if the patch level
- * is 7.6b2, TCL_RELEASE_SERIAL is 2. It restarts at 1 whenever the
- * release level is changed, except for the final release which is 0
- * (the first patch will start at 1).
+ * library/init.tcl (only if Major.minor changes, not patchlevel) 1 LOC
+ * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch)
+ * win/configure.in (as above)
+ * win/tcl.m4 (not patchlevel)
+ * win/makefile.vc (not patchlevel) 2 LOC
+ * win/pkgIndex.tcl (not patchlevel, for tclregNN.dll)
+ * README (sections 0 and 2)
+ * mac/README (2 LOC, not patchlevel)
+ * win/README.binary (sections 0-4)
+ * win/README (not patchlevel) (sections 0 and 2)
+ * unix/README (not patchlevel) (part (h))
+ * unix/tcl.spec (2 LOC Major/Minor, 1 LOC patch)
+ * tests/basic.test (not patchlevel) (version checks)
+ * tools/tcl.hpj.in (not patchlevel, for windows installer)
+ * tools/tcl.wse.in (for windows installer)
+ * tools/tclSplash.bmp (not patchlevel)
*/
#define TCL_MAJOR_VERSION 8
-#define TCL_MINOR_VERSION 0
-#define TCL_RELEASE_LEVEL 2
-#define TCL_RELEASE_SERIAL 4
+#define TCL_MINOR_VERSION 3
+#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
+#define TCL_RELEASE_SERIAL 2
-#define TCL_VERSION "8.0"
-#define TCL_PATCH_LEVEL "8.0.4"
+#define TCL_VERSION "8.3"
+#define TCL_PATCH_LEVEL "8.3.2"
/*
* The following definitions set up the proper options for Windows
@@ -52,7 +70,8 @@
*/
#ifndef __WIN32__
-# if defined(_WIN32) || defined(WIN32)
+# if defined(_WIN32) || defined(WIN32) || \
+ defined(__CYGWIN__) || defined(__MINGW32__)
# define __WIN32__
# endif
#endif
@@ -70,6 +89,12 @@
# ifndef USE_PROTOTYPE
# define USE_PROTOTYPE 1
# endif
+
+/*
+ * Under Windows we need to call Tcl_Alloc in all cases to avoid competing
+ * C run-time library issues.
+ */
+
# ifndef USE_TCLALLOC
# define USE_TCLALLOC 1
# endif
@@ -90,6 +115,7 @@
# ifndef NO_STRERROR
# define NO_STRERROR 1
# endif
+# define INLINE
#endif
/*
@@ -120,6 +146,31 @@
# endif
#endif
+/*
+ * Special macro to define mutexes, that doesn't do anything
+ * if we are not using threads.
+ */
+
+#ifdef TCL_THREADS
+#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
+#else
+#define TCL_DECLARE_MUTEX(name)
+#endif
+
+/*
+ * Macros that eliminate the overhead of the thread synchronization
+ * functions when compiling without thread support.
+ */
+
+#ifndef TCL_THREADS
+#define Tcl_MutexLock(mutexPtr)
+#define Tcl_MutexUnlock(mutexPtr)
+#define Tcl_MutexFinalize(mutexPtr)
+#define Tcl_ConditionNotify(condPtr)
+#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+#define Tcl_ConditionFinalize(condPtr)
+#endif /* TCL_THREADS */
+
/*
* A special definition used to allow this header file to be included
* in resource files so that they can get obtain version information from
@@ -144,10 +195,14 @@
*/
#if defined(__STDC__) || defined(HAS_STDARG)
+# include <stdarg.h>
+
# define TCL_VARARGS(type, name) (type name, ...)
# define TCL_VARARGS_DEF(type, name) (type name, ...)
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#else
+# include <varargs.h>
+
# ifdef __cplusplus
# define TCL_VARARGS(type, name) (type name, ...)
# define TCL_VARARGS_DEF(type, name) (type va_alist, ...)
@@ -165,37 +220,46 @@
* The default build on windows is for a DLL, which causes the DLLIMPORT
* and DLLEXPORT macros to be nonempty. To build a static library, the
* macro STATIC_BUILD should be defined.
- * The support follows the convention that a macro called BUILD_xxxx, where
- * xxxx is the name of a library we are building, is set on the compile line
- * for sources that are to be placed in the library. See BUILD_tcl in this
- * file for an example of how the macro is to be used.
*/
-#ifdef __WIN32__
-# ifdef STATIC_BUILD
-# define DLLIMPORT
-# define DLLEXPORT
-# else
-# ifdef _MSC_VER
+#ifdef STATIC_BUILD
+# define DLLIMPORT
+# define DLLEXPORT
+#else
+# if defined(__WIN32__) && (defined(_MSC_VER) || (defined(__GNUC__) && defined(__declspec)))
# define DLLIMPORT __declspec(dllimport)
# define DLLEXPORT __declspec(dllexport)
-# else
-# define DLLIMPORT
-# define DLLEXPORT
-# endif
+# else
+# define DLLIMPORT
+# define DLLEXPORT
# endif
-#else
-# define DLLIMPORT
-# define DLLEXPORT
#endif
-#ifdef TCL_STORAGE_CLASS
-# undef TCL_STORAGE_CLASS
-#endif
+/*
+ * These macros are used to control whether functions are being declared for
+ * import or export. If a function is being declared while it is being built
+ * to be included in a shared library, then it should have the DLLEXPORT
+ * storage class. If is being declared for use by a module that is going to
+ * link against the shared library, then it should have the DLLIMPORT storage
+ * class. If the symbol is beind declared for a static build or for use from a
+ * stub library, then the storage class should be empty.
+ *
+ * The convention is that a macro called BUILD_xxxx, where xxxx is the
+ * name of a library we are building, is set on the compile line for sources
+ * that are to be placed in the library. When this macro is set, the
+ * storage class will be set to DLLEXPORT. At the end of the header file, the
+ * storage class will be reset to DLLIMPORt.
+ */
+
+#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
#else
-# define TCL_STORAGE_CLASS DLLIMPORT
+# ifdef USE_TCL_STUBS
+# define TCL_STORAGE_CLASS
+# else
+# define TCL_STORAGE_CLASS DLLIMPORT
+# endif
#endif
/*
@@ -205,6 +269,9 @@
#undef _ANSI_ARGS_
#undef CONST
+#ifndef INLINE
+# define INLINE
+#endif
#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE)
# define _USING_PROTOTYPES_ 1
@@ -215,6 +282,13 @@
# define CONST
#endif
+/*
+ * Make sure EXTERN isn't defined elsewhere
+ */
+#ifdef EXTERN
+#undef EXTERN
+#endif /* EXTERN */
+
#ifdef __cplusplus
# define EXTERN extern "C" TCL_STORAGE_CLASS
#else
@@ -301,12 +375,126 @@ typedef struct Tcl_Interp {
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_Command_ *Tcl_Command;
+typedef struct Tcl_Condition_ *Tcl_Condition;
+typedef struct Tcl_EncodingState_ *Tcl_EncodingState;
+typedef struct Tcl_Encoding_ *Tcl_Encoding;
typedef struct Tcl_Event Tcl_Event;
+typedef struct Tcl_Mutex_ *Tcl_Mutex;
typedef struct Tcl_Pid_ *Tcl_Pid;
typedef struct Tcl_RegExp_ *Tcl_RegExp;
+typedef struct Tcl_ThreadDataKey_ *Tcl_ThreadDataKey;
+typedef struct Tcl_ThreadId_ *Tcl_ThreadId;
typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
typedef struct Tcl_Trace_ *Tcl_Trace;
typedef struct Tcl_Var_ *Tcl_Var;
+typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
+
+/*
+ * Definition of the interface to procedures implementing threads.
+ * A procedure following this definition is given to each call of
+ * 'Tcl_CreateThread' and will be called as the main fuction of
+ * the new thread created by that call.
+ */
+
+#ifdef MAC_TCL
+typedef pascal void *(Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+#elif defined __WIN32__
+typedef unsigned (__stdcall Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+#else
+typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+#endif
+
+
+/*
+ * Threading function return types used for abstracting away platform
+ * differences when writing a Tcl_ThreadCreateProc. See the NewThread
+ * function in generic/tclThreadTest.c for it's usage.
+ */
+#ifdef MAC_TCL
+# define Tcl_ThreadCreateType pascal void *
+# define TCL_THREAD_CREATE_RETURN return NULL
+#elif defined __WIN32__
+# define Tcl_ThreadCreateType unsigned __stdcall
+# define TCL_THREAD_CREATE_RETURN return 0
+#else
+# define Tcl_ThreadCreateType void
+# define TCL_THREAD_CREATE_RETURN
+#endif
+
+
+
+/*
+ * Definition of values for default stacksize and the possible flags to be
+ * given to Tcl_CreateThread.
+ */
+
+#define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack */
+#define TCL_THREAD_NOFLAGS (0000) /* Standard flags, default behaviour */
+#define TCL_THREAD_JOINABLE (0001) /* Mark the thread as joinable */
+
+/*
+ * Flag values passed to Tcl_GetRegExpFromObj.
+ */
+
+#define TCL_REG_BASIC 000000 /* BREs (convenience) */
+#define TCL_REG_EXTENDED 000001 /* EREs */
+#define TCL_REG_ADVF 000002 /* advanced features in EREs */
+#define TCL_REG_ADVANCED 000003 /* AREs (which are also EREs) */
+#define TCL_REG_QUOTE 000004 /* no special characters, none */
+#define TCL_REG_NOCASE 000010 /* ignore case */
+#define TCL_REG_NOSUB 000020 /* don't care about subexpressions */
+#define TCL_REG_EXPANDED 000040 /* expanded format, white space &
+ * comments */
+#define TCL_REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */
+#define TCL_REG_NLANCH 000200 /* ^ matches after \n, $ before */
+#define TCL_REG_NEWLINE 000300 /* newlines are line terminators */
+#define TCL_REG_CANMATCH 001000 /* report details on partial/limited
+ * matches */
+
+/*
+ * The following flag is experimental and only intended for use by Expect. It
+ * will probably go away in a later release.
+ */
+
+#define TCL_REG_BOSONLY 002000 /* prepend \A to pattern so it only
+ * matches at the beginning of the
+ * string. */
+
+/*
+ * Flags values passed to Tcl_RegExpExecObj.
+ */
+
+#define TCL_REG_NOTBOL 0001 /* Beginning of string does not match ^. */
+#define TCL_REG_NOTEOL 0002 /* End of string does not match $. */
+
+/*
+ * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
+ * relative to the start of the match string, not the beginning of the
+ * entire string.
+ */
+
+typedef struct Tcl_RegExpIndices {
+ long start; /* character offset of first character in match */
+ long end; /* character offset of first character after the
+ * match. */
+} Tcl_RegExpIndices;
+
+typedef struct Tcl_RegExpInfo {
+ int nsubs; /* number of subexpressions in the
+ * compiled expression */
+ Tcl_RegExpIndices *matches; /* array of nsubs match offset
+ * pairs */
+ long extendStart; /* The offset at which a subsequent
+ * match might begin. */
+ long reserved; /* Reserved for later use. */
+} Tcl_RegExpInfo;
+
+/*
+ * Picky compilers complain if this typdef doesn't appear before the
+ * struct's reference in tclDecls.h.
+ */
+
+typedef struct stat *Tcl_Stat_;
/*
* When a TCL command returns, the interpreter contains a result from the
@@ -374,6 +562,11 @@ typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
ClientData cmdClientData, int argc, char *argv[]));
typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr,
struct Tcl_Obj *dupPtr));
+typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr,
+ char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+typedef void (Tcl_EncodingFreeProc)_ANSI_ARGS_((ClientData clientData));
typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr, int flags));
typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData,
int flags));
@@ -393,8 +586,9 @@ typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
+ Tcl_Interp *interp, int objc, struct Tcl_Obj *CONST objv[]));
typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
+typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(char *, format));
typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
Tcl_Channel chan, char *address, int port));
typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
@@ -403,6 +597,9 @@ typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *part1, char *part2, int flags));
+typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd, int mask,
+ Tcl_FileProc *proc, ClientData clientData));
+typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd));
/*
* The following structure represents a type of object, which is a
@@ -446,8 +643,8 @@ typedef struct Tcl_Obj {
* means the string rep is invalid and must
* be regenerated from the internal rep.
* Clients should use Tcl_GetStringFromObj
- * to get a pointer to the byte array as a
- * readonly value. */
+ * or Tcl_GetString to get a pointer to the
+ * byte array as a readonly value. */
int length; /* The number of bytes at *bytes, not
* including the terminating null. */
Tcl_ObjType *typePtr; /* Denotes the object's type. Always
@@ -476,9 +673,9 @@ typedef struct Tcl_Obj {
* expression that is expensive to compute or has side effects.
*/
-EXTERN void Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
-EXTERN void Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
-EXTERN int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
+void Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+void Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
#ifdef TCL_MEM_DEBUG
# define Tcl_IncrRefCount(objPtr) \
@@ -498,23 +695,15 @@ EXTERN int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
/*
* Macros and definitions that help to debug the use of Tcl objects.
- * When TCL_MEM_DEBUG is defined, the Tcl_New* declarations are
+ * When TCL_MEM_DEBUG is defined, the Tcl_New declarations are
* overridden to call debugging versions of the object creation procedures.
*/
-EXTERN Tcl_Obj * Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue));
-EXTERN Tcl_Obj * Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue));
-EXTERN Tcl_Obj * Tcl_NewIntObj _ANSI_ARGS_((int intValue));
-EXTERN Tcl_Obj * Tcl_NewListObj _ANSI_ARGS_((int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN Tcl_Obj * Tcl_NewLongObj _ANSI_ARGS_((long longValue));
-EXTERN Tcl_Obj * Tcl_NewObj _ANSI_ARGS_((void));
-EXTERN Tcl_Obj * Tcl_NewStringObj _ANSI_ARGS_((char *bytes,
- int length));
-
#ifdef TCL_MEM_DEBUG
# define Tcl_NewBooleanObj(val) \
Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
+# define Tcl_NewByteArrayObj(bytes, len) \
+ Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
# define Tcl_NewDoubleObj(val) \
Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
# define Tcl_NewIntObj(val) \
@@ -530,9 +719,26 @@ EXTERN Tcl_Obj * Tcl_NewStringObj _ANSI_ARGS_((char *bytes,
#endif /* TCL_MEM_DEBUG */
/*
+ * The following structure contains the state needed by
+ * Tcl_SaveResult. No-one outside of Tcl should access any of these
+ * fields. This structure is typically allocated on the stack.
+ */
+
+typedef struct Tcl_SavedResult {
+ char *result;
+ Tcl_FreeProc *freeProc;
+ Tcl_Obj *objResultPtr;
+ char *appendResult;
+ int appendAvl;
+ int appendUsed;
+ char resultSpace[TCL_RESULT_SIZE+1];
+} Tcl_SavedResult;
+
+
+/*
* The following definitions support Tcl's namespace facility.
* Note: the first five fields must match exactly the fields in a
- * Namespace structure (see tcl.h).
+ * Namespace structure (see tclInt.h).
*/
typedef struct Tcl_Namespace {
@@ -651,13 +857,21 @@ typedef struct Tcl_DString {
/*
* Definitions for the maximum number of digits of precision that may
* be specified in the "tcl_precision" variable, and the number of
- * characters of buffer space required by Tcl_PrintDouble.
+ * bytes of buffer space required by Tcl_PrintDouble.
*/
#define TCL_MAX_PREC 17
#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
/*
+ * Definition for a number of bytes of buffer space sufficient to hold the
+ * string representation of an integer in base 10 (assuming the existence
+ * of 64-bit integers).
+ */
+
+#define TCL_INTEGER_SPACE 24
+
+/*
* Flag that may be passed to Tcl_ConvertElement to force it not to
* output braces (careful! if you change this flag be sure to change
* the definitions at the front of tclUtil.c).
@@ -673,13 +887,14 @@ typedef struct Tcl_DString {
#define TCL_EXACT 1
/*
- * Flag values passed to Tcl_RecordAndEval.
+ * Flag values passed to Tcl_RecordAndEval and/or Tcl_EvalObj.
* WARNING: these bit choices must not conflict with the bit choices
* for evalFlag bits in tclInt.h!!
*/
#define TCL_NO_EVAL 0x10000
#define TCL_EVAL_GLOBAL 0x20000
+#define TCL_EVAL_DIRECT 0x40000
/*
* Special freeProc values that may be passed to Tcl_SetResult (see
@@ -704,7 +919,19 @@ typedef struct Tcl_DString {
#define TCL_TRACE_DESTROYED 0x80
#define TCL_INTERP_DESTROYED 0x100
#define TCL_LEAVE_ERR_MSG 0x200
-#define TCL_PARSE_PART1 0x400
+#define TCL_TRACE_ARRAY 0x800
+
+/*
+ * The TCL_PARSE_PART1 flag is deprecated and has no effect.
+ * The part1 is now always parsed whenever the part2 is NULL.
+ * (This is to avoid a common error when converting code to
+ * use the new object based APIs and forgetting to give the
+ * flag)
+ */
+#ifndef TCL_NO_DEPRECATED
+#define TCL_PARSE_PART1 0x400
+#endif
+
/*
* Types for linked variables:
@@ -717,58 +944,6 @@ typedef struct Tcl_DString {
#define TCL_LINK_READ_ONLY 0x80
/*
- * The following declarations either map ckalloc and ckfree to
- * malloc and free, or they map them to procedures with all sorts
- * of debugging hooks defined in tclCkalloc.c.
- */
-
-EXTERN char * Tcl_Alloc _ANSI_ARGS_((unsigned int size));
-EXTERN void Tcl_Free _ANSI_ARGS_((char *ptr));
-EXTERN char * Tcl_Realloc _ANSI_ARGS_((char *ptr,
- unsigned int size));
-
-#ifdef TCL_MEM_DEBUG
-
-# define Tcl_Alloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
-# define Tcl_Free(x) Tcl_DbCkfree(x, __FILE__, __LINE__)
-# define Tcl_Realloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
-# define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
-# define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__)
-# define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
-
-EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
-EXTERN void Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
- int line));
-
-#else
-
-/* CYGNUS LOCAL: Always use TCLALLOC. This means that calls to malloc
- will always be checked to make sure that malloc succeeded.
-
- NOTE: In tcl8.1a2, the definition of TclpAlloc was removed from
- unix/tclUnixPort.h. That means that in tcl8.1a2, this will wind up
- calling the special allocator in tclAlloc.c, which would be bad.
- When tcl 8.1 is imported, this needs to be checked. */
-#ifndef USE_TCLALLOC
-#define USE_TCLALLOC 1
-#endif
-/* END CYGNUS LOCAL */
-
-# if USE_TCLALLOC
-# define ckalloc(x) Tcl_Alloc(x)
-# define ckfree(x) Tcl_Free(x)
-# define ckrealloc(x,y) Tcl_Realloc(x,y)
-# else
-# define ckalloc(x) malloc(x)
-# define ckfree(x) free(x)
-# define ckrealloc(x,y) realloc(x,y)
-# endif
-# define Tcl_DumpActiveMemory(x)
-# define Tcl_ValidateAllMemory(x,y)
-
-#endif /* TCL_MEM_DEBUG */
-
-/*
* Forward declaration of Tcl_HashTable. Needed by some C++ compilers
* to prevent errors when the forward reference to Tcl_HashTable is
* encountered in the Tcl_HashEntry structure.
@@ -938,6 +1113,9 @@ typedef struct Tcl_Time {
long usec; /* Microseconds. */
} Tcl_Time;
+typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr));
+typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
+
/*
* Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler
* to indicate what sorts of events are of interest:
@@ -959,6 +1137,28 @@ typedef struct Tcl_Time {
#define TCL_ENFORCE_MODE (1<<4)
/*
+ * Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel
+ * should be closed.
+ */
+
+#define TCL_CLOSE_READ (1<<1)
+#define TCL_CLOSE_WRITE (1<<2)
+
+/*
+ * Value to use as the closeProc for a channel that supports the
+ * close2Proc interface.
+ */
+
+#define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *)1)
+
+/*
+ * Channel version tag. This was introduced in 8.3.2/8.4.
+ */
+
+#define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1)
+#define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2)
+
+/*
* Typedefs for the various operations in a channel type:
*/
@@ -966,6 +1166,8 @@ typedef int (Tcl_DriverBlockModeProc) _ANSI_ARGS_((
ClientData instanceData, int mode));
typedef int (Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
+typedef int (Tcl_DriverClose2Proc) _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, int flags));
typedef int (Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCodePtr));
typedef int (Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
@@ -983,6 +1185,40 @@ typedef void (Tcl_DriverWatchProc) _ANSI_ARGS_((
typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_((
ClientData instanceData, int direction,
ClientData *handlePtr));
+typedef int (Tcl_DriverFlushProc) _ANSI_ARGS_((
+ ClientData instanceData));
+typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_((
+ ClientData instanceData, int interestMask));
+
+/*
+ * The following declarations either map ckalloc and ckfree to
+ * malloc and free, or they map them to procedures with all sorts
+ * of debugging hooks defined in tclCkalloc.c.
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+# define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
+# define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__)
+# define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
+
+#else /* !TCL_MEM_DEBUG */
+
+/*
+ * If we are not using the debugging allocator, we should call the
+ * Tcl_Alloc, et al. routines in order to guarantee that every module
+ * is using the same memory allocator both inside and outside of the
+ * Tcl library.
+ */
+
+# define ckalloc(x) Tcl_Alloc(x)
+# define ckfree(x) Tcl_Free(x)
+# define ckrealloc(x,y) Tcl_Realloc(x,y)
+# define Tcl_InitMemory(x)
+# define Tcl_DumpActiveMemory(x)
+# define Tcl_ValidateAllMemory(x,y)
+
+#endif /* !TCL_MEM_DEBUG */
/*
* Enum for different end of line translation and recognition modes.
@@ -1001,33 +1237,50 @@ typedef enum Tcl_EolTranslation {
* One such structure exists for each type (kind) of channel.
* It collects together in one place all the functions that are
* part of the specific channel type.
+ *
+ * It is recommend that the Tcl_Channel* functions are used to access
+ * elements of this structure, instead of direct accessing.
*/
typedef struct Tcl_ChannelType {
char *typeName; /* The name of the channel type in Tcl
- * commands. This storage is owned by
- * channel type. */
- Tcl_DriverBlockModeProc *blockModeProc;
- /* Set blocking mode for the
- * raw channel. May be NULL. */
- Tcl_DriverCloseProc *closeProc; /* Procedure to call to close
- * the channel. */
+ * commands. This storage is owned by
+ * channel type. */
+ Tcl_ChannelTypeVersion version; /* Version of the channel type. */
+ Tcl_DriverCloseProc *closeProc; /* Procedure to call to close the
+ * channel, or TCL_CLOSE2PROC if the
+ * close2Proc should be used
+ * instead. */
Tcl_DriverInputProc *inputProc; /* Procedure to call for input
- * on channel. */
+ * on channel. */
Tcl_DriverOutputProc *outputProc; /* Procedure to call for output
- * on channel. */
+ * on channel. */
Tcl_DriverSeekProc *seekProc; /* Procedure to call to seek
- * on the channel. May be NULL. */
+ * on the channel. May be NULL. */
Tcl_DriverSetOptionProc *setOptionProc;
- /* Set an option on a channel. */
+ /* Set an option on a channel. */
Tcl_DriverGetOptionProc *getOptionProc;
- /* Get an option from a channel. */
+ /* Get an option from a channel. */
Tcl_DriverWatchProc *watchProc; /* Set up the notifier to watch
- * for events on this channel. */
+ * for events on this channel. */
Tcl_DriverGetHandleProc *getHandleProc;
/* Get an OS handle from the channel
- * or NULL if not supported. */
- VOID *reserved; /* reserved for future expansion */
+ * or NULL if not supported. */
+ Tcl_DriverClose2Proc *close2Proc; /* Procedure to call to close the
+ * channel if the device supports
+ * closing the read & write sides
+ * independently. */
+ Tcl_DriverBlockModeProc *blockModeProc;
+ /* Set blocking mode for the
+ * raw channel. May be NULL. */
+ /*
+ * Only valid in TCL_CHANNEL_VERSION_2 channels
+ */
+ Tcl_DriverFlushProc *flushProc; /* Procedure to call to flush a
+ * channel. May be NULL. */
+ Tcl_DriverHandlerProc *handlerProc; /* Procedure to call to handle a
+ * channel event. This will be passed
+ * up the stacked channel chain. */
} Tcl_ChannelType;
/*
@@ -1036,8 +1289,8 @@ typedef struct Tcl_ChannelType {
* as arguments to the blockModeProc procedure in the above structure.
*/
-#define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */
-#define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking
+#define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */
+#define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking
* mode. */
/*
@@ -1051,517 +1304,411 @@ typedef enum Tcl_PathType {
} Tcl_PathType;
/*
- * Exported Tcl procedures:
- */
-
-EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *message));
-EXTERN void Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *message, int length));
-EXTERN void Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcl_AppendAllObjTypes _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *objPtr));
-EXTERN void Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-EXTERN void Tcl_AppendResult _ANSI_ARGS_(
- TCL_VARARGS(Tcl_Interp *,interp));
-EXTERN void Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- char *bytes, int length));
-EXTERN void Tcl_AppendStringsToObj _ANSI_ARGS_(
- TCL_VARARGS(Tcl_Obj *,interp));
-EXTERN int Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN Tcl_AsyncHandler Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc *proc,
- ClientData clientData));
-EXTERN void Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
-EXTERN int Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int code));
-EXTERN void Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
-EXTERN int Tcl_AsyncReady _ANSI_ARGS_((void));
-EXTERN void Tcl_BackgroundError _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN char Tcl_Backslash _ANSI_ARGS_((CONST char *src,
- int *readPtr));
-EXTERN int Tcl_BadChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
- char *optionName, char *optionList));
-EXTERN void Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_InterpDeleteProc *proc,
- ClientData clientData));
-EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_((Tcl_IdleProc *idleProc,
- ClientData clientData));
+ * The following structure represents the Notifier functions that
+ * you can override with the Tcl_SetNotifier call.
+ */
+
+typedef struct Tcl_NotifierProcs {
+ Tcl_SetTimerProc *setTimerProc;
+ Tcl_WaitForEventProc *waitForEventProc;
+ Tcl_CreateFileHandlerProc *createFileHandlerProc;
+ Tcl_DeleteFileHandlerProc *deleteFileHandlerProc;
+} Tcl_NotifierProcs;
+
+/*
+ * The following structure represents a user-defined encoding. It collects
+ * together all the functions that are used by the specific encoding.
+ */
+
+typedef struct Tcl_EncodingType {
+ CONST char *encodingName; /* The name of the encoding, e.g. "euc-jp".
+ * This name is the unique key for this
+ * encoding type. */
+ Tcl_EncodingConvertProc *toUtfProc;
+ /* Procedure to convert from external
+ * encoding into UTF-8. */
+ Tcl_EncodingConvertProc *fromUtfProc;
+ /* Procedure to convert from UTF-8 into
+ * external encoding. */
+ Tcl_EncodingFreeProc *freeProc;
+ /* If non-NULL, procedure to call when this
+ * encoding is deleted. */
+ ClientData clientData; /* Arbitrary value associated with encoding
+ * type. Passed to conversion procedures. */
+ int nullSize; /* Number of zero bytes that signify
+ * end-of-string in this encoding. This
+ * number is used to determine the source
+ * string length when the srcLen argument is
+ * negative. Must be 1 or 2. */
+} Tcl_EncodingType;
+
+/*
+ * The following definitions are used as values for the conversion control
+ * flags argument when converting text from one character set to another:
+ *
+ * TCL_ENCODING_START: Signifies that the source buffer is the first
+ * block in a (potentially multi-block) input
+ * stream. Tells the conversion procedure to
+ * reset to an initial state and perform any
+ * initialization that needs to occur before the
+ * first byte is converted. If the source
+ * buffer contains the entire input stream to be
+ * converted, this flag should be set.
+ *
+ * TCL_ENCODING_END: Signifies that the source buffer is the last
+ * block in a (potentially multi-block) input
+ * stream. Tells the conversion routine to
+ * perform any finalization that needs to occur
+ * after the last byte is converted and then to
+ * reset to an initial state. If the source
+ * buffer contains the entire input stream to be
+ * converted, this flag should be set.
+ *
+ * TCL_ENCODING_STOPONERROR: If set, then the converter will return
+ * immediately upon encountering an invalid
+ * byte sequence or a source character that has
+ * no mapping in the target encoding. If clear,
+ * then the converter will skip the problem,
+ * substituting one or more "close" characters
+ * in the destination buffer and then continue
+ * to sonvert the source.
+ */
+
+#define TCL_ENCODING_START 0x01
+#define TCL_ENCODING_END 0x02
+#define TCL_ENCODING_STOPONERROR 0x04
+
+/*
+ *----------------------------------------------------------------
+ * The following data structures and declarations are for the new
+ * Tcl parser. This stuff should all move to tcl.h eventually.
+ *----------------------------------------------------------------
+ */
+
+/*
+ * For each word of a command, and for each piece of a word such as a
+ * variable reference, one of the following structures is created to
+ * describe the token.
+ */
+
+typedef struct Tcl_Token {
+ int type; /* Type of token, such as TCL_TOKEN_WORD;
+ * see below for valid types. */
+ char *start; /* First character in token. */
+ int size; /* Number of bytes in token. */
+ int numComponents; /* If this token is composed of other
+ * tokens, this field tells how many of
+ * them there are (including components of
+ * components, etc.). The component tokens
+ * immediately follow this one. */
+} Tcl_Token;
+
+/*
+ * Type values defined for Tcl_Token structures. These values are
+ * defined as mask bits so that it's easy to check for collections of
+ * types.
+ *
+ * TCL_TOKEN_WORD - The token describes one word of a command,
+ * from the first non-blank character of
+ * the word (which may be " or {) up to but
+ * not including the space, semicolon, or
+ * bracket that terminates the word.
+ * NumComponents counts the total number of
+ * sub-tokens that make up the word. This
+ * includes, for example, sub-tokens of
+ * TCL_TOKEN_VARIABLE tokens.
+ * TCL_TOKEN_SIMPLE_WORD - This token is just like TCL_TOKEN_WORD
+ * except that the word is guaranteed to
+ * consist of a single TCL_TOKEN_TEXT
+ * sub-token.
+ * TCL_TOKEN_TEXT - The token describes a range of literal
+ * text that is part of a word.
+ * NumComponents is always 0.
+ * TCL_TOKEN_BS - The token describes a backslash sequence
+ * that must be collapsed. NumComponents
+ * is always 0.
+ * TCL_TOKEN_COMMAND - The token describes a command whose result
+ * must be substituted into the word. The
+ * token includes the enclosing brackets.
+ * NumComponents is always 0.
+ * TCL_TOKEN_VARIABLE - The token describes a variable
+ * substitution, including the dollar sign,
+ * variable name, and array index (if there
+ * is one) up through the right
+ * parentheses. NumComponents tells how
+ * many additional tokens follow to
+ * represent the variable name. The first
+ * token will be a TCL_TOKEN_TEXT token
+ * that describes the variable name. If
+ * the variable is an array reference then
+ * there will be one or more additional
+ * tokens, of type TCL_TOKEN_TEXT,
+ * TCL_TOKEN_BS, TCL_TOKEN_COMMAND, and
+ * TCL_TOKEN_VARIABLE, that describe the
+ * array index; numComponents counts the
+ * total number of nested tokens that make
+ * up the variable reference, including
+ * sub-tokens of TCL_TOKEN_VARIABLE tokens.
+ * TCL_TOKEN_SUB_EXPR - The token describes one subexpression of a
+ * expression, from the first non-blank
+ * character of the subexpression up to but not
+ * including the space, brace, or bracket
+ * that terminates the subexpression.
+ * NumComponents counts the total number of
+ * following subtokens that make up the
+ * subexpression; this includes all subtokens
+ * for any nested TCL_TOKEN_SUB_EXPR tokens.
+ * For example, a numeric value used as a
+ * primitive operand is described by a
+ * TCL_TOKEN_SUB_EXPR token followed by a
+ * TCL_TOKEN_TEXT token. A binary subexpression
+ * is described by a TCL_TOKEN_SUB_EXPR token
+ * followed by the TCL_TOKEN_OPERATOR token
+ * for the operator, then TCL_TOKEN_SUB_EXPR
+ * tokens for the left then the right operands.
+ * TCL_TOKEN_OPERATOR - The token describes one expression operator.
+ * An operator might be the name of a math
+ * function such as "abs". A TCL_TOKEN_OPERATOR
+ * token is always preceeded by one
+ * TCL_TOKEN_SUB_EXPR token for the operator's
+ * subexpression, and is followed by zero or
+ * more TCL_TOKEN_SUB_EXPR tokens for the
+ * operator's operands. NumComponents is
+ * always 0.
+ */
+
+#define TCL_TOKEN_WORD 1
+#define TCL_TOKEN_SIMPLE_WORD 2
+#define TCL_TOKEN_TEXT 4
+#define TCL_TOKEN_BS 8
+#define TCL_TOKEN_COMMAND 16
+#define TCL_TOKEN_VARIABLE 32
+#define TCL_TOKEN_SUB_EXPR 64
+#define TCL_TOKEN_OPERATOR 128
+
+/*
+ * Parsing error types. On any parsing error, one of these values
+ * will be stored in the error field of the Tcl_Parse structure
+ * defined below.
+ */
+
+#define TCL_PARSE_SUCCESS 0
+#define TCL_PARSE_QUOTE_EXTRA 1
+#define TCL_PARSE_BRACE_EXTRA 2
+#define TCL_PARSE_MISSING_BRACE 3
+#define TCL_PARSE_MISSING_BRACKET 4
+#define TCL_PARSE_MISSING_PAREN 5
+#define TCL_PARSE_MISSING_QUOTE 6
+#define TCL_PARSE_MISSING_VAR_BRACE 7
+#define TCL_PARSE_SYNTAX 8
+#define TCL_PARSE_BAD_NUMBER 9
+
+/*
+ * A structure of the following type is filled in by Tcl_ParseCommand.
+ * It describes a single command parsed from an input string.
+ */
+
+#define NUM_STATIC_TOKENS 20
+
+typedef struct Tcl_Parse {
+ char *commentStart; /* Pointer to # that begins the first of
+ * one or more comments preceding the
+ * command. */
+ int commentSize; /* Number of bytes in comments (up through
+ * newline character that terminates the
+ * last comment). If there were no
+ * comments, this field is 0. */
+ char *commandStart; /* First character in first word of command. */
+ int commandSize; /* Number of bytes in command, including
+ * first character of first word, up
+ * through the terminating newline,
+ * close bracket, or semicolon. */
+ int numWords; /* Total number of words in command. May
+ * be 0. */
+ Tcl_Token *tokenPtr; /* Pointer to first token representing
+ * the words of the command. Initially
+ * points to staticTokens, but may change
+ * to point to malloc-ed space if command
+ * exceeds space in staticTokens. */
+ int numTokens; /* Total number of tokens in command. */
+ int tokensAvailable; /* Total number of tokens available at
+ * *tokenPtr. */
+ int errorType; /* One of the parsing error types defined
+ * above. */
+
+ /*
+ * The fields below are intended only for the private use of the
+ * parser. They should not be used by procedures that invoke
+ * Tcl_ParseCommand.
+ */
+
+ char *string; /* The original command string passed to
+ * Tcl_ParseCommand. */
+ char *end; /* Points to the character just after the
+ * last one in the command string. */
+ Tcl_Interp *interp; /* Interpreter to use for error reporting,
+ * or NULL. */
+ char *term; /* Points to character in string that
+ * terminated most recent token. Filled in
+ * by ParseTokens. If an error occurs,
+ * points to beginning of region where the
+ * error occurred (e.g. the open brace if
+ * the close brace is missing). */
+ int incomplete; /* This field is set to 1 by Tcl_ParseCommand
+ * if the command appears to be incomplete.
+ * This information is used by
+ * Tcl_CommandComplete. */
+ Tcl_Token staticTokens[NUM_STATIC_TOKENS];
+ /* Initial space for tokens for command.
+ * This space should be large enough to
+ * accommodate most commands; dynamic
+ * space is allocated for very large
+ * commands that don't fit here. */
+} Tcl_Parse;
+
+/*
+ * The following definitions are the error codes returned by the conversion
+ * routines:
+ *
+ * TCL_OK: All characters were converted.
+ *
+ * TCL_CONVERT_NOSPACE: The output buffer would not have been large
+ * enough for all of the converted data; as many
+ * characters as could fit were converted though.
+ *
+ * TCL_CONVERT_MULTIBYTE: The last few bytes in the source string were
+ * the beginning of a multibyte sequence, but
+ * more bytes were needed to complete this
+ * sequence. A subsequent call to the conversion
+ * routine should pass the beginning of this
+ * unconverted sequence plus additional bytes
+ * from the source stream to properly convert
+ * the formerly split-up multibyte sequence.
+ *
+ * TCL_CONVERT_SYNTAX: The source stream contained an invalid
+ * character sequence. This may occur if the
+ * input stream has been damaged or if the input
+ * encoding method was misidentified. This error
+ * is reported only if TCL_ENCODING_STOPONERROR
+ * was specified.
+ *
+ * TCL_CONVERT_UNKNOWN: The source string contained a character
+ * that could not be represented in the target
+ * encoding. This error is reported only if
+ * TCL_ENCODING_STOPONERROR was specified.
+ */
+
+#define TCL_CONVERT_MULTIBYTE -1
+#define TCL_CONVERT_SYNTAX -2
+#define TCL_CONVERT_UNKNOWN -3
+#define TCL_CONVERT_NOSPACE -4
+
+/*
+ * The maximum number of bytes that are necessary to represent a single
+ * Unicode character in UTF-8.
+ */
+
+#define TCL_UTF_MAX 3
+
+/*
+ * This represents a Unicode character.
+ */
+
+typedef unsigned short Tcl_UniChar;
+
+/*
+ * Deprecated Tcl procedures:
+ */
+
+#ifndef TCL_NO_DEPRECATED
+#define Tcl_EvalObj(interp,objPtr) Tcl_EvalObjEx((interp),(objPtr),0)
+#define Tcl_GlobalEvalObj(interp,objPtr) \
+ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
+#endif
+
+/*
+ * These function have been renamed. The old names are deprecated, but we
+ * define these macros for backwards compatibilty.
+ */
+
#define Tcl_Ckalloc Tcl_Alloc
#define Tcl_Ckfree Tcl_Free
#define Tcl_Ckrealloc Tcl_Realloc
-EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel chan));
-EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char *cmd));
-EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc, char **argv));
-EXTERN Tcl_Obj * Tcl_ConcatObj _ANSI_ARGS_((int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_((CONST char *src,
- int length, char *dst, int flags));
-EXTERN int Tcl_ConvertElement _ANSI_ARGS_((CONST char *src,
- char *dst, int flags));
-EXTERN int Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, Tcl_ObjType *typePtr));
-EXTERN int Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp *slave,
- char *slaveCmd, Tcl_Interp *target,
- char *targetCmd, int argc, char **argv));
-EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp *slave,
- char *slaveCmd, Tcl_Interp *target,
- char *targetCmd, int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN Tcl_Channel Tcl_CreateChannel _ANSI_ARGS_((
- Tcl_ChannelType *typePtr, char *chanName,
- ClientData instanceData, int mask));
-EXTERN void Tcl_CreateChannelHandler _ANSI_ARGS_((
- Tcl_Channel chan, int mask,
- Tcl_ChannelProc *proc, ClientData clientData));
-EXTERN void Tcl_CreateCloseHandler _ANSI_ARGS_((
- Tcl_Channel chan, Tcl_CloseProc *proc,
- ClientData clientData));
-EXTERN Tcl_Command Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName, Tcl_CmdProc *proc,
- ClientData clientData,
- Tcl_CmdDeleteProc *deleteProc));
-EXTERN void Tcl_CreateEventSource _ANSI_ARGS_((
- Tcl_EventSetupProc *setupProc,
- Tcl_EventCheckProc *checkProc,
- ClientData clientData));
-EXTERN void Tcl_CreateExitHandler _ANSI_ARGS_((Tcl_ExitProc *proc,
- ClientData clientData));
-EXTERN void Tcl_CreateFileHandler _ANSI_ARGS_((
- int fd, int mask, Tcl_FileProc *proc,
- ClientData clientData));
-EXTERN Tcl_Interp * Tcl_CreateInterp _ANSI_ARGS_((void));
-EXTERN void Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, int numArgs, Tcl_ValueType *argTypes,
- Tcl_MathProc *proc, ClientData clientData));
-EXTERN Tcl_Command Tcl_CreateObjCommand _ANSI_ARGS_((
- Tcl_Interp *interp, char *cmdName,
- Tcl_ObjCmdProc *proc, ClientData clientData,
- Tcl_CmdDeleteProc *deleteProc));
-EXTERN Tcl_Interp * Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
- char *slaveName, int isSafe));
-EXTERN Tcl_TimerToken Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
- Tcl_TimerProc *proc, ClientData clientData));
-EXTERN Tcl_Trace Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp *interp,
- int level, Tcl_CmdTraceProc *proc,
- ClientData clientData));
-EXTERN char * Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
- char *file, int line));
-EXTERN int Tcl_DbCkfree _ANSI_ARGS_((char *ptr,
- char *file, int line));
-EXTERN char * Tcl_DbCkrealloc _ANSI_ARGS_((char *ptr,
- unsigned int size, char *file, int line));
-EXTERN void Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
- char *file, int line));
-EXTERN void Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
- char *file, int line));
-EXTERN int Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj *objPtr,
- char *file, int line));
-EXTERN Tcl_Obj * Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue,
- char *file, int line));
-EXTERN Tcl_Obj * Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue,
- char *file, int line));
-EXTERN Tcl_Obj * Tcl_DbNewListObj _ANSI_ARGS_((int objc,
- Tcl_Obj *CONST objv[], char *file, int line));
-EXTERN Tcl_Obj * Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
- char *file, int line));
-EXTERN Tcl_Obj * Tcl_DbNewObj _ANSI_ARGS_((char *file, int line));
-EXTERN Tcl_Obj * Tcl_DbNewStringObj _ANSI_ARGS_((char *bytes,
- int length, char *file, int line));
-EXTERN void Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp *interp,
- char *name));
-EXTERN int Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName));
-EXTERN int Tcl_DeleteCommandFromToken _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Command command));
-EXTERN void Tcl_DeleteChannelHandler _ANSI_ARGS_((
- Tcl_Channel chan, Tcl_ChannelProc *proc,
- ClientData clientData));
-EXTERN void Tcl_DeleteCloseHandler _ANSI_ARGS_((
- Tcl_Channel chan, Tcl_CloseProc *proc,
- ClientData clientData));
-EXTERN void Tcl_DeleteEvents _ANSI_ARGS_((
- Tcl_EventDeleteProc *proc,
- ClientData clientData));
-EXTERN void Tcl_DeleteEventSource _ANSI_ARGS_((
- Tcl_EventSetupProc *setupProc,
- Tcl_EventCheckProc *checkProc,
- ClientData clientData));
-EXTERN void Tcl_DeleteExitHandler _ANSI_ARGS_((Tcl_ExitProc *proc,
- ClientData clientData));
-EXTERN void Tcl_DeleteFileHandler _ANSI_ARGS_((int fd));
-EXTERN void Tcl_DeleteHashEntry _ANSI_ARGS_((
- Tcl_HashEntry *entryPtr));
-EXTERN void Tcl_DeleteHashTable _ANSI_ARGS_((
- Tcl_HashTable *tablePtr));
-EXTERN void Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_DeleteTimerHandler _ANSI_ARGS_((
- Tcl_TimerToken token));
-EXTERN void Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Trace trace));
-EXTERN void Tcl_DetachPids _ANSI_ARGS_((int numPids, Tcl_Pid *pidPtr));
-EXTERN void Tcl_DontCallWhenDeleted _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
- ClientData clientData));
-EXTERN int Tcl_DoOneEvent _ANSI_ARGS_((int flags));
-EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc *proc,
- ClientData clientData));
-EXTERN char * Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString *dsPtr,
- CONST char *string, int length));
-EXTERN char * Tcl_DStringAppendElement _ANSI_ARGS_((
- Tcl_DString *dsPtr, CONST char *string));
-EXTERN void Tcl_DStringEndSublist _ANSI_ARGS_((Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringFree _ANSI_ARGS_((Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringGetResult _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringInit _ANSI_ARGS_((Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringSetLength _ANSI_ARGS_((Tcl_DString *dsPtr,
- int length));
-EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_((
- Tcl_DString *dsPtr));
-EXTERN Tcl_Obj * Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj *objPtr));
-EXTERN int Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN char * Tcl_ErrnoId _ANSI_ARGS_((void));
-EXTERN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
-EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName));
-EXTERN void Tcl_EventuallyFree _ANSI_ARGS_((ClientData clientData,
- Tcl_FreeProc *freeProc));
-EXTERN int Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-EXTERN void Tcl_Exit _ANSI_ARGS_((int status));
-EXTERN int Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *hiddenCmdToken, char *cmdName));
-EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *ptr));
-EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, int *ptr));
-EXTERN int Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, double *ptr));
-EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, double *ptr));
-EXTERN int Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, long *ptr));
-EXTERN int Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, long *ptr));
-EXTERN int Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr));
-EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-EXTERN void Tcl_Finalize _ANSI_ARGS_((void));
-EXTERN void Tcl_FindExecutable _ANSI_ARGS_((char *argv0));
-EXTERN Tcl_HashEntry * Tcl_FirstHashEntry _ANSI_ARGS_((
- Tcl_HashTable *tablePtr,
- Tcl_HashSearch *searchPtr));
-EXTERN int Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN void TclFreeObj _ANSI_ARGS_((Tcl_Obj *objPtr));
-EXTERN void Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp *interp,
- char *slaveCmd, Tcl_Interp **targetInterpPtr,
- char **targetCmdPtr, int *argcPtr,
- char ***argvPtr));
-EXTERN int Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp *interp,
- char *slaveCmd, Tcl_Interp **targetInterpPtr,
- char **targetCmdPtr, int *objcPtr,
- Tcl_Obj ***objv));
-EXTERN ClientData Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, Tcl_InterpDeleteProc **procPtr));
-EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *boolPtr));
-EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *objPtr,
- int *boolPtr));
-EXTERN Tcl_Channel Tcl_GetChannel _ANSI_ARGS_((Tcl_Interp *interp,
- char *chanName, int *modePtr));
-EXTERN int Tcl_GetChannelBufferSize _ANSI_ARGS_((
- Tcl_Channel chan));
-EXTERN int Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan,
- int direction, ClientData *handlePtr));
-EXTERN ClientData Tcl_GetChannelInstanceData _ANSI_ARGS_((
- Tcl_Channel chan));
-EXTERN int Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN char * Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN int Tcl_GetChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel chan, char *optionName,
- Tcl_DString *dsPtr));
-EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName, Tcl_CmdInfo *infoPtr));
-EXTERN char * Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Command command));
-EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, double *doublePtr));
-EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *objPtr,
- double *doublePtr));
-EXTERN int Tcl_GetErrno _ANSI_ARGS_((void));
-EXTERN char * Tcl_GetHostName _ANSI_ARGS_((void));
-EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, char **tablePtr, char *msg,
- int flags, int *indexPtr));
-EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *intPtr));
-EXTERN int Tcl_GetInterpPath _ANSI_ARGS_((Tcl_Interp *askInterp,
- Tcl_Interp *slaveInterp));
-EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, int *intPtr));
-EXTERN int Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, long *longPtr));
-EXTERN Tcl_Interp * Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN CONST char * Tcl_GetNameOfExecutable _ANSI_ARGS_((void));
-EXTERN Tcl_Obj * Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN Tcl_ObjType * Tcl_GetObjType _ANSI_ARGS_((char *typeName));
-EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int write, int checkUsage,
- ClientData *filePtr));
-EXTERN Tcl_PathType Tcl_GetPathType _ANSI_ARGS_((char *path));
-EXTERN int Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_DString *dsPtr));
-EXTERN int Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan,
- Tcl_Obj *objPtr));
-EXTERN int Tcl_GetServiceMode _ANSI_ARGS_((void));
-EXTERN Tcl_Interp * Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp *interp,
- char *slaveName));
-EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_((int type));
-EXTERN char * Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- int *lengthPtr));
-EXTERN char * Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags));
-EXTERN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags));
-EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
- char *command));
-EXTERN int Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-EXTERN char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable *tablePtr));
-EXTERN int Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName, char *hiddenCmdToken));
-EXTERN int Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_InitHashTable _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- int keyType));
-EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcl_InputBlocked _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN int Tcl_InputBuffered _ANSI_ARGS_((Tcl_Channel chan));
-EXTERN int Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_InvalidateStringRep _ANSI_ARGS_((
- Tcl_Obj *objPtr));
-EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc, char **argv,
- Tcl_DString *resultPtr));
-EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, char *addr, int type));
-EXTERN int Tcl_ListObjAppendList _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *listPtr,
- Tcl_Obj *elemListPtr));
-EXTERN int Tcl_ListObjAppendElement _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *listPtr,
- Tcl_Obj *objPtr));
-EXTERN int Tcl_ListObjGetElements _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *listPtr,
- int *objcPtr, Tcl_Obj ***objvPtr));
-EXTERN int Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *listPtr, int index,
- Tcl_Obj **objPtrPtr));
-EXTERN int Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *listPtr, int *intPtr));
-EXTERN int Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *listPtr, int first, int count,
- int objc, Tcl_Obj *CONST objv[]));
-EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
- Tcl_AppInitProc *appInitProc));
-EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
- int mode));
-EXTERN int Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN Tcl_Channel Tcl_MakeTcpClientChannel _ANSI_ARGS_((
- ClientData tcpSocket));
-EXTERN char * Tcl_Merge _ANSI_ARGS_((int argc, char **argv));
-EXTERN Tcl_HashEntry * Tcl_NextHashEntry _ANSI_ARGS_((
- Tcl_HashSearch *searchPtr));
-EXTERN void Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel,
- int mask));
-EXTERN Tcl_Obj * Tcl_ObjGetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
- int flags));
-EXTERN Tcl_Obj * Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
- Tcl_Obj *newValuePtr, int flags));
-EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_((
- Tcl_Interp *interp, int argc, char **argv,
- int flags));
-EXTERN Tcl_Channel Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName, char *modeString,
- int permissions));
-EXTERN Tcl_Channel Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp *interp,
- int port, char *address, char *myaddr,
- int myport, int async));
-EXTERN Tcl_Channel Tcl_OpenTcpServer _ANSI_ARGS_((Tcl_Interp *interp,
- int port, char *host,
- Tcl_TcpAcceptProc *acceptProc,
- ClientData callbackData));
-EXTERN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char **termPtr));
-EXTERN int Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, char *version));
-EXTERN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, char *version, int exact));
-EXTERN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_Preserve _ANSI_ARGS_((ClientData data));
-EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp *interp,
- double value, char *dst));
-EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char *string));
-EXTERN void Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event *evPtr,
- Tcl_QueuePosition position));
-EXTERN int Tcl_Read _ANSI_ARGS_((Tcl_Channel chan,
- char *bufPtr, int toRead));
-EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
-EXTERN int Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmd, int flags));
-EXTERN int Tcl_RecordAndEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *cmdPtr, int flags));
-EXTERN Tcl_RegExp Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-EXTERN int Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_RegExp regexp, char *string, char *start));
-EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *pattern));
-EXTERN void Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
- int index, char **startPtr, char **endPtr));
-EXTERN void Tcl_RegisterChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel chan));
-EXTERN void Tcl_RegisterObjType _ANSI_ARGS_((
- Tcl_ObjType *typePtr));
-EXTERN void Tcl_Release _ANSI_ARGS_((ClientData clientData));
-EXTERN void Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
#define Tcl_Return Tcl_SetResult
-EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_((CONST char *string,
- int length, int *flagPtr));
-EXTERN int Tcl_ScanElement _ANSI_ARGS_((CONST char *string,
- int *flagPtr));
-EXTERN int Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan,
- int offset, int mode));
-EXTERN int Tcl_ServiceAll _ANSI_ARGS_((void));
-EXTERN int Tcl_ServiceEvent _ANSI_ARGS_((int flags));
-EXTERN void Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, Tcl_InterpDeleteProc *proc,
- ClientData clientData));
-EXTERN void Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- int boolValue));
-EXTERN void Tcl_SetChannelBufferSize _ANSI_ARGS_((
- Tcl_Channel chan, int sz));
-EXTERN int Tcl_SetChannelOption _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Channel chan,
- char *optionName, char *newValue));
-EXTERN int Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName, Tcl_CmdInfo *infoPtr));
-EXTERN void Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- double doubleValue));
-EXTERN void Tcl_SetErrno _ANSI_ARGS_((int err));
-EXTERN void Tcl_SetErrorCode _ANSI_ARGS_(
- TCL_VARARGS(Tcl_Interp *,arg1));
-EXTERN void Tcl_SetIntObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- int intValue));
-EXTERN void Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- int objc, Tcl_Obj *CONST objv[]));
-EXTERN void Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- long longValue));
-EXTERN void Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time *timePtr));
-EXTERN void Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *errorObjPtr));
-EXTERN void Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj *objPtr,
- int length));
-EXTERN void Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *resultObjPtr));
-EXTERN void Tcl_SetPanicProc _ANSI_ARGS_((void (*proc)
- _ANSI_ARGS_(TCL_VARARGS(char *, format))));
-EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
- int depth));
-EXTERN void Tcl_SetResult _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, Tcl_FreeProc *freeProc));
-EXTERN int Tcl_SetServiceMode _ANSI_ARGS_((int mode));
-EXTERN void Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
- int type));
-EXTERN void Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- char *bytes, int length));
-EXTERN void Tcl_SetTimer _ANSI_ARGS_((Tcl_Time *timePtr));
-EXTERN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, char *newValue, int flags));
-EXTERN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, char *newValue,
- int flags));
-EXTERN char * Tcl_SignalId _ANSI_ARGS_((int sig));
-EXTERN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
-EXTERN void Tcl_Sleep _ANSI_ARGS_((int ms));
-EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcl_SplitList _ANSI_ARGS_((Tcl_Interp *interp,
- char *list, int *argcPtr, char ***argvPtr));
-EXTERN void Tcl_SplitPath _ANSI_ARGS_((char *path,
- int *argcPtr, char ***argvPtr));
-EXTERN void Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp *interp,
- char *pkgName, Tcl_PackageInitProc *initProc,
- Tcl_PackageInitProc *safeInitProc));
-EXTERN int Tcl_StringMatch _ANSI_ARGS_((char *string,
- char *pattern));
-EXTERN int Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
#define Tcl_TildeSubst Tcl_TranslateFileName
-EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags, Tcl_VarTraceProc *proc,
- ClientData clientData));
-EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags,
- Tcl_VarTraceProc *proc, ClientData clientData));
-EXTERN char * Tcl_TranslateFileName _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, Tcl_DString *bufferPtr));
-EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan, char *str,
- int len, int atHead));
-EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName));
-EXTERN int Tcl_UnregisterChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel chan));
-EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags));
-EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags));
-EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags, Tcl_VarTraceProc *proc,
- ClientData clientData));
-EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags,
- Tcl_VarTraceProc *proc, ClientData clientData));
-EXTERN void Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName));
-EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *frameName, char *varName,
- char *localName, int flags));
-EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *frameName, char *part1, char *part2,
- char *localName, int flags));
-EXTERN int Tcl_VarEval _ANSI_ARGS_(
- TCL_VARARGS(Tcl_Interp *,interp));
-EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags,
- Tcl_VarTraceProc *procPtr,
- ClientData prevClientData));
-EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags,
- Tcl_VarTraceProc *procPtr,
- ClientData prevClientData));
-EXTERN int Tcl_WaitForEvent _ANSI_ARGS_((Tcl_Time *timePtr));
-EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int *statPtr,
- int options));
-EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan,
- char *s, int slen));
-EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], char *message));
+#define panic Tcl_Panic
+#define panicVA Tcl_PanicVA
+
+/*
+ * The following constant is used to test for older versions of Tcl
+ * in the stubs tables.
+ *
+ * Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different
+ * value since the stubs tables don't match.
+ */
+
+#define TCL_STUB_MAGIC 0xFCA3BACF
+
+/*
+ * The following function is required to be defined in all stubs aware
+ * extensions. The function is actually implemented in the stub
+ * library, not the main Tcl library, although there is a trivial
+ * implementation in the main library in case an extension is statically
+ * linked into an application.
+ */
+
+EXTERN char * Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
+ char *version, int exact));
+
+#ifndef USE_TCL_STUBS
+
+/*
+ * When not using stubs, make it a macro.
+ */
+
+#define Tcl_InitStubs(interp, version, exact) \
+ Tcl_PkgRequire(interp, "Tcl", version, exact)
+
+#endif
+
+
+/*
+ * Include the public function declarations that are accessible via
+ * the stubs table.
+ */
+
+#include "tclDecls.h"
+
+/*
+ * Public functions that are not accessible via the stubs table.
+ */
+
+EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
+ Tcl_AppInitProc *appInitProc));
+
+/*
+ * Convenience declaration of Tcl_AppInit for backwards compatibility.
+ * This function is not *implemented* by the tcl library, so the storage
+ * class is neither DLLEXPORT nor DLLIMPORT
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS
+
+EXTERN int Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* RESOURCE_INCLUDED */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+/*
+ * end block for C++
+ */
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* _TCL */
+
diff --git a/tcl/generic/tclAlloc.c b/tcl/generic/tclAlloc.c
index cdb0e3df5d8..44c4e94b2c2 100644
--- a/tcl/generic/tclAlloc.c
+++ b/tcl/generic/tclAlloc.c
@@ -8,6 +8,7 @@
*
* Copyright (c) 1983 Regents of the University of California.
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
*
@@ -20,18 +21,26 @@
#include "tclInt.h"
#include "tclPort.h"
+#if USE_TCLALLOC
+
#ifdef TCL_DEBUG
# define DEBUG
/* #define MSTATS */
# define RCHECK
#endif
-#ifndef __CYGWIN32__
+/*
+ * With gcc this will already be defined. This should really
+ * make use of AC_CHECK_TYPE(caddr_t) but that can wait
+ * until we use config.h properly.
+ */
+
+#if defined(MAC_TCL) || defined(_MSC_VER) || defined(__MINGW32__)
typedef unsigned long caddr_t;
#endif
/*
- * The overhead on a block is at least 4 bytes. When free, this space
+ * The overhead on a block is at least 8 bytes. When free, this space
* contains a pointer to the next free block, and the bottom two bits must
* be zero. When in use, the first byte is set to MAGIC, and the second
* byte is the size index. The remaining bytes are for alignment.
@@ -43,6 +52,7 @@ typedef unsigned long caddr_t;
union overhead {
union overhead *ov_next; /* when free */
+ unsigned char ov_padding[8]; /* Ensure the structure is 8-byte aligned. */
struct {
unsigned char ovu_magic0; /* magic number */
unsigned char ovu_index; /* bucket # */
@@ -51,13 +61,14 @@ union overhead {
#ifdef RCHECK
unsigned short ovu_rmagic; /* range magic number */
unsigned long ovu_size; /* actual block size */
+ unsigned short ovu_unused2; /* padding to 8-byte align */
#endif
} ovu;
#define ov_magic0 ovu.ovu_magic0
#define ov_magic1 ovu.ovu_magic1
#define ov_index ovu.ovu_index
#define ov_rmagic ovu.ovu_rmagic
-#define ov_size ovu.ovu_size
+#define ov_size ovu.ovu_size
};
@@ -82,6 +93,36 @@ union overhead {
#define MAXMALLOC (1<<(NBUCKETS+2))
static union overhead *nextf[NBUCKETS];
+/*
+ * The following structure is used to keep track of all system memory
+ * currently owned by Tcl. When finalizing, all this memory will
+ * be returned to the system.
+ */
+
+struct block {
+ struct block *nextPtr; /* Linked list. */
+ struct block *prevPtr; /* Linked list for big blocks, ensures 8-byte
+ * alignment for suballocated blocks. */
+};
+
+static struct block *blockList; /* Tracks the suballocated blocks. */
+static struct block bigBlocks = { /* Big blocks aren't suballocated. */
+ &bigBlocks, &bigBlocks
+};
+
+/*
+ * The allocator is protected by a special mutex that must be
+ * explicitly initialized. Futhermore, because Tcl_Alloc may be
+ * used before anything else in Tcl, we make this module self-initializing
+ * after all with the allocInit variable.
+ */
+
+#ifdef TCL_THREADS
+static Tcl_Mutex *allocMutexPtr;
+#endif
+static int allocInit = 0;
+
+
#ifdef MSTATS
/*
@@ -106,6 +147,91 @@ static unsigned int nmalloc[NBUCKETS+1];
*/
static void MoreCore _ANSI_ARGS_((int bucket));
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclInitAlloc --
+ *
+ * Initialize the memory system.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Initialize the mutex used to serialize allocations.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclInitAlloc()
+{
+ if (!allocInit) {
+ allocInit = 1;
+#ifdef TCL_THREADS
+ allocMutexPtr = Tcl_GetAllocMutex();
+#endif
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclFinalizeAllocSubsystem --
+ *
+ * Release all resources being used by this subsystem, including
+ * aggressively freeing all memory allocated by TclpAlloc() that
+ * has not yet been released with TclpFree().
+ *
+ * After this function is called, all memory allocated with
+ * TclpAlloc() should be considered unusable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This subsystem is self-initializing, since memory can be
+ * allocated before Tcl is formally initialized. After this call,
+ * this subsystem has been reset to its initial state and is
+ * usable again.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclFinalizeAllocSubsystem()
+{
+ int i;
+ struct block *blockPtr, *nextPtr;
+
+ Tcl_MutexLock(allocMutexPtr);
+ for (blockPtr = blockList; blockPtr != NULL; blockPtr = nextPtr) {
+ nextPtr = blockPtr->nextPtr;
+ TclpSysFree(blockPtr);
+ }
+ blockList = NULL;
+
+ for (blockPtr = bigBlocks.nextPtr; blockPtr != &bigBlocks; ) {
+ nextPtr = blockPtr->nextPtr;
+ TclpSysFree(blockPtr);
+ blockPtr = nextPtr;
+ }
+ bigBlocks.nextPtr = &bigBlocks;
+ bigBlocks.prevPtr = &bigBlocks;
+
+ for (i = 0; i < NBUCKETS; i++) {
+ nextf[i] = NULL;
+#ifdef MSTATS
+ nmalloc[i] = 0;
+#endif
+ }
+#ifdef MSTATS
+ nmalloc[i] = 0;
+#endif
+ Tcl_MutexUnlock(allocMutexPtr);
+}
/*
*----------------------------------------------------------------------
@@ -124,21 +250,39 @@ static void MoreCore _ANSI_ARGS_((int bucket));
*/
char *
-TclpAlloc(
- unsigned int nbytes) /* Number of bytes to allocate. */
+TclpAlloc(nbytes)
+ unsigned int nbytes; /* Number of bytes to allocate. */
{
register union overhead *op;
register long bucket;
register unsigned amt;
+ struct block *bigBlockPtr;
+ if (!allocInit) {
+ /*
+ * We have to make the "self initializing" because Tcl_Alloc
+ * may be used before any other part of Tcl. E.g., see
+ * main() for tclsh!
+ */
+ TclInitAlloc();
+ }
+ Tcl_MutexLock(allocMutexPtr);
/*
* First the simple case: we simple allocate big blocks directly
*/
if (nbytes + OVERHEAD >= MAXMALLOC) {
- op = (union overhead *)TclpSysAlloc(nbytes+OVERHEAD, 0);
- if (op == NULL) {
+ bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
+ (sizeof(struct block) + OVERHEAD + nbytes), 0);
+ if (bigBlockPtr == NULL) {
+ Tcl_MutexUnlock(allocMutexPtr);
return NULL;
}
+ bigBlockPtr->nextPtr = bigBlocks.nextPtr;
+ bigBlocks.nextPtr = bigBlockPtr;
+ bigBlockPtr->prevPtr = &bigBlocks;
+ bigBlockPtr->nextPtr->prevPtr = bigBlockPtr;
+
+ op = (union overhead *) (bigBlockPtr + 1);
op->ov_magic0 = op->ov_magic1 = MAGIC;
op->ov_index = 0xff;
#ifdef MSTATS
@@ -153,6 +297,7 @@ TclpAlloc(
op->ov_rmagic = RMAGIC;
*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
#endif
+ Tcl_MutexUnlock(allocMutexPtr);
return (void *)(op+1);
}
/*
@@ -170,6 +315,7 @@ TclpAlloc(
while (nbytes + OVERHEAD > amt) {
amt <<= 1;
if (amt == 0) {
+ Tcl_MutexUnlock(allocMutexPtr);
return (NULL);
}
bucket++;
@@ -183,6 +329,7 @@ TclpAlloc(
if ((op = nextf[bucket]) == NULL) {
MoreCore(bucket);
if ((op = nextf[bucket]) == NULL) {
+ Tcl_MutexUnlock(allocMutexPtr);
return (NULL);
}
}
@@ -204,6 +351,7 @@ TclpAlloc(
op->ov_rmagic = RMAGIC;
*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
#endif
+ Tcl_MutexUnlock(allocMutexPtr);
return ((char *)(op + 1));
}
@@ -214,6 +362,8 @@ TclpAlloc(
*
* Allocate more memory to the indicated bucket.
*
+ * Assumes Mutex is already held.
+ *
* Results:
* None.
*
@@ -224,13 +374,14 @@ TclpAlloc(
*/
static void
-MoreCore(
- int bucket) /* What bucket to allocat to. */
+MoreCore(bucket)
+ int bucket; /* What bucket to allocat to. */
{
register union overhead *op;
register long sz; /* size of desired block */
long amt; /* amount to allocate */
int nblks; /* how many blocks we get */
+ struct block *blockPtr;
/*
* sbrk_size <= 0 only for big, FLUFFY, requests (about
@@ -243,11 +394,16 @@ MoreCore(
nblks = amt / sz;
ASSERT(nblks*sz == amt);
- op = (union overhead *)TclpSysAlloc(amt, 1);
+ blockPtr = (struct block *) TclpSysAlloc((unsigned)
+ (sizeof(struct block) + amt), 1);
/* no more room! */
- if (op == NULL) {
+ if (blockPtr == NULL) {
return;
}
+ blockPtr->nextPtr = blockList;
+ blockList = blockPtr;
+
+ op = (union overhead *) (blockPtr + 1);
/*
* Add new memory allocated to that on
@@ -278,21 +434,24 @@ MoreCore(
*/
void
-TclpFree(
- char *cp) /* Pointer to memory to free. */
+TclpFree(cp)
+ char *cp; /* Pointer to memory to free. */
{
register long size;
register union overhead *op;
+ struct block *bigBlockPtr;
if (cp == NULL) {
return;
}
+ Tcl_MutexLock(allocMutexPtr);
op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
ASSERT(op->ov_magic0 == MAGIC); /* make sure it was in use */
ASSERT(op->ov_magic1 == MAGIC);
if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
+ Tcl_MutexUnlock(allocMutexPtr);
return;
}
@@ -303,7 +462,11 @@ TclpFree(
#ifdef MSTATS
nmalloc[NBUCKETS]--;
#endif
- TclpSysFree(op);
+ bigBlockPtr = (struct block *) op - 1;
+ bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
+ bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
+ TclpSysFree(bigBlockPtr);
+ Tcl_MutexUnlock(allocMutexPtr);
return;
}
ASSERT(size < NBUCKETS);
@@ -312,6 +475,7 @@ TclpFree(
#ifdef MSTATS
nmalloc[size]--;
#endif
+ Tcl_MutexUnlock(allocMutexPtr);
}
/*
@@ -331,12 +495,13 @@ TclpFree(
*/
char *
-TclpRealloc(
- char *cp, /* Pointer to alloced block. */
- unsigned int nbytes) /* New size of memory. */
+TclpRealloc(cp, nbytes)
+ char *cp; /* Pointer to alloced block. */
+ unsigned int nbytes; /* New size of memory. */
{
int i;
union overhead *op;
+ struct block *bigBlockPtr;
int expensive;
unsigned long maxsize;
@@ -344,11 +509,14 @@ TclpRealloc(
return (TclpAlloc(nbytes));
}
+ Tcl_MutexLock(allocMutexPtr);
+
op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
ASSERT(op->ov_magic0 == MAGIC); /* make sure it was in use */
ASSERT(op->ov_magic1 == MAGIC);
if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
+ Tcl_MutexUnlock(allocMutexPtr);
return NULL;
}
@@ -361,10 +529,28 @@ TclpRealloc(
*/
if (i == 0xff) {
- op = (union overhead *) TclpSysRealloc(op, nbytes+OVERHEAD);
- if (op == NULL) {
+ struct block *prevPtr, *nextPtr;
+ bigBlockPtr = (struct block *) op - 1;
+ prevPtr = bigBlockPtr->prevPtr;
+ nextPtr = bigBlockPtr->nextPtr;
+ bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr,
+ sizeof(struct block) + OVERHEAD + nbytes);
+ if (bigBlockPtr == NULL) {
+ Tcl_MutexUnlock(allocMutexPtr);
return NULL;
}
+
+ if (prevPtr->nextPtr != bigBlockPtr) {
+ /*
+ * If the block has moved, splice the new block into the list where
+ * the old block used to be.
+ */
+
+ prevPtr->nextPtr = bigBlockPtr;
+ nextPtr->prevPtr = bigBlockPtr;
+ }
+
+ op = (union overhead *) (bigBlockPtr + 1);
#ifdef MSTATS
nmalloc[NBUCKETS]++;
#endif
@@ -376,6 +562,7 @@ TclpRealloc(
op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
#endif
+ Tcl_MutexUnlock(allocMutexPtr);
return (char *)(op+1);
}
maxsize = 1 << (i+3);
@@ -388,7 +575,9 @@ TclpRealloc(
if (expensive) {
void *newp;
-
+
+ Tcl_MutexUnlock(allocMutexPtr);
+
newp = TclpAlloc(nbytes);
if ( newp == NULL ) {
return NULL;
@@ -408,6 +597,7 @@ TclpRealloc(
op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
#endif
+ Tcl_MutexUnlock(allocMutexPtr);
return(cp);
}
@@ -431,14 +621,15 @@ TclpRealloc(
#ifdef MSTATS
void
-mstats(
- char *s) /* Where to write info. */
+mstats(s)
+ char *s; /* Where to write info. */
{
register int i, j;
register union overhead *p;
int totfree = 0,
totused = 0;
+ Tcl_MutexLock(allocMutexPtr);
fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
for (i = 0; i < NBUCKETS; i++) {
for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
@@ -454,5 +645,82 @@ mstats(
totused, totfree);
fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
MAXMALLOC, nmalloc[NBUCKETS]);
+ Tcl_MutexUnlock(allocMutexPtr);
}
#endif
+
+#else /* !USE_TCLALLOC */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpAlloc --
+ *
+ * Allocate more memory.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpAlloc(nbytes)
+ unsigned int nbytes; /* Number of bytes to allocate. */
+{
+ return (char*) malloc(nbytes);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFree --
+ *
+ * Free memory.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFree(cp)
+ char *cp; /* Pointer to memory to free. */
+{
+ free(cp);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpRealloc --
+ *
+ * Reallocate memory.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpRealloc(cp, nbytes)
+ char *cp; /* Pointer to alloced block. */
+ unsigned int nbytes; /* New size of memory. */
+{
+ return (char*) realloc(cp, nbytes);
+}
+
+#endif /* !USE_TCLALLOC */
+
diff --git a/tcl/generic/tclAsync.c b/tcl/generic/tclAsync.c
index 2159d3f8342..6ec8ca9934b 100644
--- a/tcl/generic/tclAsync.c
+++ b/tcl/generic/tclAsync.c
@@ -16,6 +16,7 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* One of the following structures exists for each asynchronous
@@ -42,6 +43,8 @@ static AsyncHandler *firstHandler; /* First handler defined for process,
* or NULL if none. */
static AsyncHandler *lastHandler; /* Last handler or NULL. */
+TCL_DECLARE_MUTEX(asyncMutex) /* Process-wide async handler lock */
+
/*
* The variable below is set to 1 whenever a handler becomes ready and
* it is cleared to zero whenever Tcl_AsyncInvoke is called. It can be
@@ -91,12 +94,14 @@ Tcl_AsyncCreate(proc, clientData)
asyncPtr->nextPtr = NULL;
asyncPtr->proc = proc;
asyncPtr->clientData = clientData;
+ Tcl_MutexLock(&asyncMutex);
if (firstHandler == NULL) {
firstHandler = asyncPtr;
} else {
lastHandler->nextPtr = asyncPtr;
}
lastHandler = asyncPtr;
+ Tcl_MutexUnlock(&asyncMutex);
return (Tcl_AsyncHandler) asyncPtr;
}
@@ -123,10 +128,13 @@ void
Tcl_AsyncMark(async)
Tcl_AsyncHandler async; /* Token for handler. */
{
+ Tcl_MutexLock(&asyncMutex);
((AsyncHandler *) async)->ready = 1;
if (!asyncActive) {
asyncReady = 1;
+ TclpAsyncMark(async);
}
+ Tcl_MutexUnlock(&asyncMutex);
}
/*
@@ -159,8 +167,10 @@ Tcl_AsyncInvoke(interp, code)
* just completed. */
{
AsyncHandler *asyncPtr;
+ Tcl_MutexLock(&asyncMutex);
if (asyncReady == 0) {
+ Tcl_MutexUnlock(&asyncMutex);
return code;
}
asyncReady = 0;
@@ -191,9 +201,12 @@ Tcl_AsyncInvoke(interp, code)
break;
}
asyncPtr->ready = 0;
+ Tcl_MutexUnlock(&asyncMutex);
code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
+ Tcl_MutexLock(&asyncMutex);
}
asyncActive = 0;
+ Tcl_MutexUnlock(&asyncMutex);
return code;
}
@@ -221,6 +234,7 @@ Tcl_AsyncDelete(async)
AsyncHandler *asyncPtr = (AsyncHandler *) async;
AsyncHandler *prevPtr;
+ Tcl_MutexLock(&asyncMutex);
if (firstHandler == asyncPtr) {
firstHandler = asyncPtr->nextPtr;
if (firstHandler == NULL) {
@@ -236,6 +250,7 @@ Tcl_AsyncDelete(async)
lastHandler = prevPtr;
}
}
+ Tcl_MutexUnlock(&asyncMutex);
ckfree((char *) asyncPtr);
}
diff --git a/tcl/generic/tclBasic.c b/tcl/generic/tclBasic.c
index 044974cb13a..8c6a19de4ef 100644
--- a/tcl/generic/tclBasic.c
+++ b/tcl/generic/tclBasic.c
@@ -7,7 +7,7 @@
*
* Copyright (c) 1987-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -26,8 +26,13 @@
*/
static void DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
-static void HiddenCmdsDeleteProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
+static void ProcessUnexpectedResult _ANSI_ARGS_((
+ Tcl_Interp *interp, int returnCode));
+static void RecordTracebackInfo _ANSI_ARGS_((
+ Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int numSrcBytes));
+
+extern TclStubs tclStubs;
/*
* The following structure defines the commands in the Tcl core.
@@ -62,7 +67,7 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"binary", (Tcl_CmdProc *) NULL, Tcl_BinaryObjCmd,
(CompileProc *) NULL, 1},
- {"break", Tcl_BreakCmd, (Tcl_ObjCmdProc *) NULL,
+ {"break", (Tcl_CmdProc *) NULL, Tcl_BreakObjCmd,
TclCompileBreakCmd, 1},
{"case", (Tcl_CmdProc *) NULL, Tcl_CaseObjCmd,
(CompileProc *) NULL, 1},
@@ -72,8 +77,10 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"concat", (Tcl_CmdProc *) NULL, Tcl_ConcatObjCmd,
(CompileProc *) NULL, 1},
- {"continue", Tcl_ContinueCmd, (Tcl_ObjCmdProc *) NULL,
+ {"continue", (Tcl_CmdProc *) NULL, Tcl_ContinueObjCmd,
TclCompileContinueCmd, 1},
+ {"encoding", (Tcl_CmdProc *) NULL, Tcl_EncodingObjCmd,
+ (CompileProc *) NULL, 0},
{"error", (Tcl_CmdProc *) NULL, Tcl_ErrorObjCmd,
(CompileProc *) NULL, 1},
{"eval", (Tcl_CmdProc *) NULL, Tcl_EvalObjCmd,
@@ -84,9 +91,9 @@ static CmdInfo builtInCmds[] = {
TclCompileExprCmd, 1},
{"fcopy", (Tcl_CmdProc *) NULL, Tcl_FcopyObjCmd,
(CompileProc *) NULL, 1},
- {"fileevent", Tcl_FileEventCmd, (Tcl_ObjCmdProc *) NULL,
+ {"fileevent", (Tcl_CmdProc *) NULL, Tcl_FileEventObjCmd,
(CompileProc *) NULL, 1},
- {"for", Tcl_ForCmd, (Tcl_ObjCmdProc *) NULL,
+ {"for", (Tcl_CmdProc *) NULL, Tcl_ForObjCmd,
TclCompileForCmd, 1},
{"foreach", (Tcl_CmdProc *) NULL, Tcl_ForeachObjCmd,
TclCompileForeachCmd, 1},
@@ -94,14 +101,12 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"global", (Tcl_CmdProc *) NULL, Tcl_GlobalObjCmd,
(CompileProc *) NULL, 1},
- {"if", Tcl_IfCmd, (Tcl_ObjCmdProc *) NULL,
+ {"if", (Tcl_CmdProc *) NULL, Tcl_IfObjCmd,
TclCompileIfCmd, 1},
- {"incr", Tcl_IncrCmd, (Tcl_ObjCmdProc *) NULL,
+ {"incr", (Tcl_CmdProc *) NULL, Tcl_IncrObjCmd,
TclCompileIncrCmd, 1},
{"info", (Tcl_CmdProc *) NULL, Tcl_InfoObjCmd,
(CompileProc *) NULL, 1},
- {"interp", (Tcl_CmdProc *) NULL, Tcl_InterpObjCmd,
- (CompileProc *) NULL, 1},
{"join", (Tcl_CmdProc *) NULL, Tcl_JoinObjCmd,
(CompileProc *) NULL, 1},
{"lappend", (Tcl_CmdProc *) NULL, Tcl_LappendObjCmd,
@@ -114,7 +119,7 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"llength", (Tcl_CmdProc *) NULL, Tcl_LlengthObjCmd,
(CompileProc *) NULL, 1},
- {"load", Tcl_LoadCmd, (Tcl_ObjCmdProc *) NULL,
+ {"load", (Tcl_CmdProc *) NULL, Tcl_LoadObjCmd,
(CompileProc *) NULL, 0},
{"lrange", (Tcl_CmdProc *) NULL, Tcl_LrangeObjCmd,
(CompileProc *) NULL, 1},
@@ -126,31 +131,31 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"namespace", (Tcl_CmdProc *) NULL, Tcl_NamespaceObjCmd,
(CompileProc *) NULL, 1},
- {"package", Tcl_PackageCmd, (Tcl_ObjCmdProc *) NULL,
+ {"package", (Tcl_CmdProc *) NULL, Tcl_PackageObjCmd,
(CompileProc *) NULL, 1},
{"proc", (Tcl_CmdProc *) NULL, Tcl_ProcObjCmd,
(CompileProc *) NULL, 1},
- {"regexp", Tcl_RegexpCmd, (Tcl_ObjCmdProc *) NULL,
+ {"regexp", (Tcl_CmdProc *) NULL, Tcl_RegexpObjCmd,
(CompileProc *) NULL, 1},
- {"regsub", Tcl_RegsubCmd, (Tcl_ObjCmdProc *) NULL,
+ {"regsub", (Tcl_CmdProc *) NULL, Tcl_RegsubObjCmd,
(CompileProc *) NULL, 1},
{"rename", (Tcl_CmdProc *) NULL, Tcl_RenameObjCmd,
(CompileProc *) NULL, 1},
{"return", (Tcl_CmdProc *) NULL, Tcl_ReturnObjCmd,
(CompileProc *) NULL, 1},
- {"scan", Tcl_ScanCmd, (Tcl_ObjCmdProc *) NULL,
+ {"scan", (Tcl_CmdProc *) NULL, Tcl_ScanObjCmd,
(CompileProc *) NULL, 1},
- {"set", Tcl_SetCmd, (Tcl_ObjCmdProc *) NULL,
+ {"set", (Tcl_CmdProc *) NULL, Tcl_SetObjCmd,
TclCompileSetCmd, 1},
{"split", (Tcl_CmdProc *) NULL, Tcl_SplitObjCmd,
(CompileProc *) NULL, 1},
{"string", (Tcl_CmdProc *) NULL, Tcl_StringObjCmd,
(CompileProc *) NULL, 1},
- {"subst", Tcl_SubstCmd, (Tcl_ObjCmdProc *) NULL,
+ {"subst", (Tcl_CmdProc *) NULL, Tcl_SubstObjCmd,
(CompileProc *) NULL, 1},
{"switch", (Tcl_CmdProc *) NULL, Tcl_SwitchObjCmd,
(CompileProc *) NULL, 1},
- {"trace", Tcl_TraceCmd, (Tcl_ObjCmdProc *) NULL,
+ {"trace", (Tcl_CmdProc *) NULL, Tcl_TraceObjCmd,
(CompileProc *) NULL, 1},
{"unset", (Tcl_CmdProc *) NULL, Tcl_UnsetObjCmd,
(CompileProc *) NULL, 1},
@@ -160,7 +165,7 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"variable", (Tcl_CmdProc *) NULL, Tcl_VariableObjCmd,
(CompileProc *) NULL, 1},
- {"while", Tcl_WhileCmd, (Tcl_ObjCmdProc *) NULL,
+ {"while", (Tcl_CmdProc *) NULL, Tcl_WhileObjCmd,
TclCompileWhileCmd, 1},
/*
@@ -178,7 +183,7 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"fblocked", (Tcl_CmdProc *) NULL, Tcl_FblockedObjCmd,
(CompileProc *) NULL, 1},
- {"fconfigure", Tcl_FconfigureCmd, (Tcl_ObjCmdProc *) NULL,
+ {"fconfigure", (Tcl_CmdProc *) NULL, Tcl_FconfigureObjCmd,
(CompileProc *) NULL, 0},
{"file", (Tcl_CmdProc *) NULL, Tcl_FileObjCmd,
(CompileProc *) NULL, 0},
@@ -186,29 +191,29 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"gets", (Tcl_CmdProc *) NULL, Tcl_GetsObjCmd,
(CompileProc *) NULL, 1},
- {"glob", Tcl_GlobCmd, (Tcl_ObjCmdProc *) NULL,
+ {"glob", (Tcl_CmdProc *) NULL, Tcl_GlobObjCmd,
(CompileProc *) NULL, 0},
- {"open", Tcl_OpenCmd, (Tcl_ObjCmdProc *) NULL,
+ {"open", (Tcl_CmdProc *) NULL, Tcl_OpenObjCmd,
(CompileProc *) NULL, 0},
{"pid", (Tcl_CmdProc *) NULL, Tcl_PidObjCmd,
(CompileProc *) NULL, 1},
{"puts", (Tcl_CmdProc *) NULL, Tcl_PutsObjCmd,
(CompileProc *) NULL, 1},
- {"pwd", Tcl_PwdCmd, (Tcl_ObjCmdProc *) NULL,
+ {"pwd", (Tcl_CmdProc *) NULL, Tcl_PwdObjCmd,
(CompileProc *) NULL, 0},
{"read", (Tcl_CmdProc *) NULL, Tcl_ReadObjCmd,
(CompileProc *) NULL, 1},
- {"seek", Tcl_SeekCmd, (Tcl_ObjCmdProc *) NULL,
+ {"seek", (Tcl_CmdProc *) NULL, Tcl_SeekObjCmd,
(CompileProc *) NULL, 1},
- {"socket", Tcl_SocketCmd, (Tcl_ObjCmdProc *) NULL,
+ {"socket", (Tcl_CmdProc *) NULL, Tcl_SocketObjCmd,
(CompileProc *) NULL, 0},
- {"tell", Tcl_TellCmd, (Tcl_ObjCmdProc *) NULL,
+ {"tell", (Tcl_CmdProc *) NULL, Tcl_TellObjCmd,
(CompileProc *) NULL, 1},
{"time", (Tcl_CmdProc *) NULL, Tcl_TimeObjCmd,
(CompileProc *) NULL, 1},
- {"update", Tcl_UpdateCmd, (Tcl_ObjCmdProc *) NULL,
+ {"update", (Tcl_CmdProc *) NULL, Tcl_UpdateObjCmd,
(CompileProc *) NULL, 1},
- {"vwait", Tcl_VwaitCmd, (Tcl_ObjCmdProc *) NULL,
+ {"vwait", (Tcl_CmdProc *) NULL, Tcl_VwaitObjCmd,
(CompileProc *) NULL, 1},
#ifdef MAC_TCL
@@ -216,14 +221,14 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 0},
{"echo", Tcl_EchoCmd, (Tcl_ObjCmdProc *) NULL,
(CompileProc *) NULL, 0},
- {"ls", Tcl_LsCmd, (Tcl_ObjCmdProc *) NULL,
+ {"ls", (Tcl_CmdProc *) NULL, Tcl_LsObjCmd,
(CompileProc *) NULL, 0},
{"resource", (Tcl_CmdProc *) NULL, Tcl_ResourceObjCmd,
(CompileProc *) NULL, 1},
{"source", (Tcl_CmdProc *) NULL, Tcl_MacSourceObjCmd,
(CompileProc *) NULL, 0},
#else
- {"exec", Tcl_ExecCmd, (Tcl_ObjCmdProc *) NULL,
+ {"exec", (Tcl_CmdProc *) NULL, Tcl_ExecObjCmd,
(CompileProc *) NULL, 0},
{"source", (Tcl_CmdProc *) NULL, Tcl_SourceObjCmd,
(CompileProc *) NULL, 0},
@@ -233,6 +238,7 @@ static CmdInfo builtInCmds[] = {
{NULL, (Tcl_CmdProc *) NULL, (Tcl_ObjCmdProc *) NULL,
(CompileProc *) NULL, 0}
};
+
/*
*----------------------------------------------------------------------
@@ -256,14 +262,23 @@ static CmdInfo builtInCmds[] = {
Tcl_Interp *
Tcl_CreateInterp()
{
- register Interp *iPtr;
- register Command *cmdPtr;
- register CmdInfo *cmdInfoPtr;
+ Interp *iPtr;
+ Tcl_Interp *interp;
+ Command *cmdPtr;
+ BuiltinFunc *builtinFuncPtr;
+ MathFunc *mathFuncPtr;
+ Tcl_HashEntry *hPtr;
+ CmdInfo *cmdInfoPtr;
+ int i;
union {
char c[sizeof(short)];
short s;
} order;
- int i;
+#ifdef TCL_COMPILE_STATS
+ ByteCodeStats *statsPtr;
+#endif /* TCL_COMPILE_STATS */
+
+ TclInitSubsystems(NULL);
/*
* Panic if someone updated the CallFrame structure without
@@ -281,15 +296,20 @@ Tcl_CreateInterp()
* Tcl object type table and other object management code.
*/
- TclInitNamespaces();
-
iPtr = (Interp *) ckalloc(sizeof(Interp));
- iPtr->result = iPtr->resultSpace;
- iPtr->freeProc = 0;
- iPtr->objResultPtr = Tcl_NewObj(); /* an empty object */
+ interp = (Tcl_Interp *) iPtr;
+
+ iPtr->result = iPtr->resultSpace;
+ iPtr->freeProc = NULL;
+ iPtr->errorLine = 0;
+ iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
- iPtr->errorLine = 0;
+ iPtr->handle = TclHandleCreate(iPtr);
+ iPtr->globalNsPtr = NULL;
+ iPtr->hiddenCmdTablePtr = NULL;
+ iPtr->interpInfo = NULL;
Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
+
iPtr->numLevels = 0;
iPtr->maxNestingDepth = 1000;
iPtr->framePtr = NULL;
@@ -298,18 +318,16 @@ Tcl_CreateInterp()
iPtr->returnCode = TCL_OK;
iPtr->errorInfo = NULL;
iPtr->errorCode = NULL;
+
iPtr->appendResult = NULL;
iPtr->appendAvl = 0;
iPtr->appendUsed = 0;
- for (i = 0; i < NUM_REGEXPS; i++) {
- iPtr->patterns[i] = NULL;
- iPtr->patLengths[i] = -1;
- iPtr->regexps[i] = NULL;
- }
+
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
iPtr->packageUnknown = NULL;
iPtr->cmdCount = 0;
iPtr->termOffset = 0;
+ TclInitLiteralTable(&(iPtr->literalTable));
iPtr->compileEpoch = 0;
iPtr->compiledProcPtr = NULL;
iPtr->resolverPtr = NULL;
@@ -324,21 +342,64 @@ Tcl_CreateInterp()
iPtr->resultSpace[0] = 0;
iPtr->globalNsPtr = NULL; /* force creation of global ns below */
- iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(
- (Tcl_Interp *) iPtr, "", (ClientData) NULL,
- (Tcl_NamespaceDeleteProc *) NULL);
+ iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
+ (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
if (iPtr->globalNsPtr == NULL) {
panic("Tcl_CreateInterp: can't create global namespace");
}
/*
- * Initialize support for code compilation. Do this after initializing
- * namespaces since TclCreateExecEnv will try to reference a Tcl
- * variable (it links to the Tcl "tcl_traceExec" variable).
+ * Initialize support for code compilation and execution. We call
+ * TclCreateExecEnv after initializing namespaces since it tries to
+ * reference a Tcl variable (it links to the Tcl "tcl_traceExec"
+ * variable).
+ */
+
+ iPtr->execEnvPtr = TclCreateExecEnv(interp);
+
+ /*
+ * Initialize the compilation and execution statistics kept for this
+ * interpreter.
*/
+
+#ifdef TCL_COMPILE_STATS
+ statsPtr = &(iPtr->stats);
+ statsPtr->numExecutions = 0;
+ statsPtr->numCompilations = 0;
+ statsPtr->numByteCodesFreed = 0;
+ (VOID *) memset(statsPtr->instructionCount, 0,
+ sizeof(statsPtr->instructionCount));
+
+ statsPtr->totalSrcBytes = 0.0;
+ statsPtr->totalByteCodeBytes = 0.0;
+ statsPtr->currentSrcBytes = 0.0;
+ statsPtr->currentByteCodeBytes = 0.0;
+ (VOID *) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
+ (VOID *) memset(statsPtr->byteCodeCount, 0,
+ sizeof(statsPtr->byteCodeCount));
+ (VOID *) memset(statsPtr->lifetimeCount, 0,
+ sizeof(statsPtr->lifetimeCount));
- iPtr->execEnvPtr = TclCreateExecEnv((Tcl_Interp *) iPtr);
+ statsPtr->currentInstBytes = 0.0;
+ statsPtr->currentLitBytes = 0.0;
+ statsPtr->currentExceptBytes = 0.0;
+ statsPtr->currentAuxBytes = 0.0;
+ statsPtr->currentCmdMapBytes = 0.0;
+
+ statsPtr->numLiteralsCreated = 0;
+ statsPtr->totalLitStringBytes = 0.0;
+ statsPtr->currentLitStringBytes = 0.0;
+ (VOID *) memset(statsPtr->literalCount, 0,
+ sizeof(statsPtr->literalCount));
+#endif /* TCL_COMPILE_STATS */
+
+ /*
+ * Initialise the stub table pointer.
+ */
+
+ iPtr->stubTable = &tclStubs;
+
/*
* Create the core commands. Do it here, rather than calling
* Tcl_CreateCommand, because it's faster (there's no need to check for
@@ -393,71 +454,106 @@ Tcl_CreateInterp()
}
/*
- * Initialize/Create "errorInfo" and "errorCode" global vars
- * (because some part of the C code assume they exists
- * and we can get a seg fault otherwise (in multiple
- * interps loading of extensions for instance) --dl)
- */
- /*
- * We can't assume that because we initialize
- * the variables here, they won't be unset later.
- * so we had 2 choices:
- * + Check every place where a GetVar of those is used
- * and the NULL result is not checked (like in tclLoad.c)
- * + Make SetVar,... NULL friendly
- * We choosed the second option because :
- * + It is easy and low cost to check for NULL pointer before
- * calling strlen()
- * + It can be helpfull to other people using those API
- * + Passing a NULL value to those closest 'meaning' is empty string
- * (specially with the new objects where 0 bytes strings are ok)
- * So the following init is commented out: -- dl
- */
- /*
- (void)Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL, "",
- TCL_GLOBAL_ONLY);
- (void)Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL, "NONE",
- TCL_GLOBAL_ONLY);
+ * Register the builtin math functions.
*/
-#ifndef TCL_GENERIC_ONLY
- TclSetupEnv((Tcl_Interp *) iPtr);
-#endif
+ i = 0;
+ for (builtinFuncPtr = builtinFuncTable; builtinFuncPtr->name != NULL;
+ builtinFuncPtr++) {
+ Tcl_CreateMathFunc((Tcl_Interp *) iPtr, builtinFuncPtr->name,
+ builtinFuncPtr->numArgs, builtinFuncPtr->argTypes,
+ (Tcl_MathProc *) NULL, (ClientData) 0);
+ hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
+ builtinFuncPtr->name);
+ if (hPtr == NULL) {
+ panic("Tcl_CreateInterp: Tcl_CreateMathFunc incorrectly registered '%s'", builtinFuncPtr->name);
+ return NULL;
+ }
+ mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+ mathFuncPtr->builtinFuncIndex = i;
+ i++;
+ }
+ iPtr->flags |= EXPR_INITIALIZED;
/*
* Do Multiple/Safe Interps Tcl init stuff
*/
- (void) TclInterpInit((Tcl_Interp *)iPtr);
+
+ TclInterpInit(interp);
/*
- * Set up variables such as tcl_version.
+ * We used to create the "errorInfo" and "errorCode" global vars at this
+ * point because so much of the Tcl implementation assumes they already
+ * exist. This is not quite enough, however, since they can be unset
+ * at any time.
+ *
+ * There are 2 choices:
+ * + Check every place where a GetVar of those is used
+ * and the NULL result is not checked (like in tclLoad.c)
+ * + Make SetVar,... NULL friendly
+ * We choose the second option because :
+ * + It is easy and low cost to check for NULL pointer before
+ * calling strlen()
+ * + It can be helpfull to other people using those API
+ * + Passing a NULL value to those closest 'meaning' is empty string
+ * (specially with the new objects where 0 bytes strings are ok)
+ * So the following init is commented out: -- dl
+ *
+ * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL,
+ * "", TCL_GLOBAL_ONLY);
+ * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL,
+ * "NONE", TCL_GLOBAL_ONLY);
*/
- TclPlatformInit((Tcl_Interp *)iPtr);
- Tcl_SetVar((Tcl_Interp *) iPtr, "tcl_patchLevel", TCL_PATCH_LEVEL,
- TCL_GLOBAL_ONLY);
- Tcl_SetVar((Tcl_Interp *) iPtr, "tcl_version", TCL_VERSION,
+#ifndef TCL_GENERIC_ONLY
+ TclSetupEnv(interp);
+#endif
+
+ /*
+ * Compute the byte order of this machine.
+ */
+
+ order.s = 1;
+ Tcl_SetVar2(interp, "tcl_platform", "byteOrder",
+ ((order.c[0] == 1) ? "littleEndian" : "bigEndian"),
TCL_GLOBAL_ONLY);
- Tcl_TraceVar2((Tcl_Interp *) iPtr, "tcl_precision", (char *) NULL,
+
+ /*
+ * Set up other variables such as tcl_version and tcl_library
+ */
+
+ Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
+ Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, (ClientData) NULL);
+ TclpSetVariables(interp);
+#ifdef TCL_THREADS
/*
- * Compute the byte order of this machine.
+ * The existence of the "threaded" element of the tcl_platform array indicates
+ * that this particular Tcl shell has been compiled with threads turned on.
+ * Using "info exists tcl_platform(threaded)" a Tcl script can introspect on the
+ * interpreter level of thread safety.
*/
- order.s = 1;
- Tcl_SetVar2((Tcl_Interp *) iPtr, "tcl_platform", "byteOrder",
- (order.c[0] == 1) ? "littleEndian" : "bigEndian",
+
+ Tcl_SetVar2(interp, "tcl_platform", "threaded", "1",
TCL_GLOBAL_ONLY);
+#endif
/*
* Register Tcl's version number.
*/
- Tcl_PkgProvide((Tcl_Interp *) iPtr, "Tcl", TCL_VERSION);
+ Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);
- return (Tcl_Interp *) iPtr;
+#ifdef Tcl_InitStubs
+#undef Tcl_InitStubs
+#endif
+ Tcl_InitStubs(interp, TCL_VERSION, 1);
+
+ return interp;
}
/*
@@ -526,13 +622,18 @@ Tcl_CallWhenDeleted(interp, proc, clientData)
{
Interp *iPtr = (Interp *) interp;
static int assocDataCounter = 0;
+#ifdef TCL_THREADS
+ static Tcl_Mutex assocMutex;
+#endif
int new;
- char buffer[128];
+ char buffer[32 + TCL_INTEGER_SPACE];
AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
Tcl_HashEntry *hPtr;
+ Tcl_MutexLock(&assocMutex);
sprintf(buffer, "Assoc Data Key #%d", assocDataCounter);
assocDataCounter++;
+ Tcl_MutexUnlock(&assocMutex);
if (iPtr->assocData == (Tcl_HashTable *) NULL) {
iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
@@ -727,6 +828,82 @@ Tcl_GetAssocData(interp, name, procPtr)
/*
*----------------------------------------------------------------------
*
+ * Tcl_InterpDeleted --
+ *
+ * Returns nonzero if the interpreter has been deleted with a call
+ * to Tcl_DeleteInterp.
+ *
+ * Results:
+ * Nonzero if the interpreter is deleted, zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_InterpDeleted(interp)
+ Tcl_Interp *interp;
+{
+ return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteInterp --
+ *
+ * Ensures that the interpreter will be deleted eventually. If there
+ * are no Tcl_Preserve calls in effect for this interpreter, it is
+ * deleted immediately, otherwise the interpreter is deleted when
+ * the last Tcl_Preserve is matched by a call to Tcl_Release. In either
+ * case, the procedure runs the currently registered deletion callbacks.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The interpreter is marked as deleted. The caller may still use it
+ * safely if there are calls to Tcl_Preserve in effect for the
+ * interpreter, but further calls to Tcl_Eval etc in this interpreter
+ * will fail.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteInterp(interp)
+ Tcl_Interp *interp; /* Token for command interpreter (returned
+ * by a previous call to Tcl_CreateInterp). */
+{
+ Interp *iPtr = (Interp *) interp;
+
+ /*
+ * If the interpreter has already been marked deleted, just punt.
+ */
+
+ if (iPtr->flags & DELETED) {
+ return;
+ }
+
+ /*
+ * Mark the interpreter as deleted. No further evals will be allowed.
+ */
+
+ iPtr->flags |= DELETED;
+
+ /*
+ * Ensure that the interpreter is eventually deleted.
+ */
+
+ Tcl_EventuallyFree((ClientData) interp,
+ (Tcl_FreeProc *) DeleteInterpProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* DeleteInterpProc --
*
* Helper procedure to delete an interpreter. This procedure is
@@ -753,9 +930,7 @@ DeleteInterpProc(interp)
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_HashTable *hTablePtr;
- AssocData *dPtr;
ResolverScheme *resPtr, *nextResPtr;
- int i;
/*
* Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
@@ -774,6 +949,8 @@ DeleteInterpProc(interp)
panic("DeleteInterpProc called on interpreter not marked deleted");
}
+ TclHandleFree(iPtr->handle);
+
/*
* Dismantle everything in the global namespace except for the
* "errorInfo" and "errorCode" variables. These remain until the
@@ -786,6 +963,27 @@ DeleteInterpProc(interp)
TclTeardownNamespace(iPtr->globalNsPtr);
/*
+ * Delete all the hidden commands.
+ */
+
+ hTablePtr = iPtr->hiddenCmdTablePtr;
+ if (hTablePtr != NULL) {
+ /*
+ * Non-pernicious deletion. The deletion callbacks will not be
+ * allowed to create any new hidden or non-hidden commands.
+ * Tcl_DeleteCommandFromToken() will remove the entry from the
+ * hiddenCmdTablePtr.
+ */
+
+ hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_DeleteCommandFromToken(interp,
+ (Tcl_Command) Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(hTablePtr);
+ ckfree((char *) hTablePtr);
+ }
+ /*
* Tear down the math function table.
*/
@@ -802,6 +1000,8 @@ DeleteInterpProc(interp)
*/
while (iPtr->assocData != (Tcl_HashTable *) NULL) {
+ AssocData *dPtr;
+
hTablePtr = iPtr->assocData;
iPtr->assocData = (Tcl_HashTable *) NULL;
for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
@@ -846,14 +1046,6 @@ DeleteInterpProc(interp)
ckfree(iPtr->appendResult);
iPtr->appendResult = NULL;
}
- for (i = 0; i < NUM_REGEXPS; i++) {
- if (iPtr->patterns[i] == NULL) {
- break;
- }
- ckfree(iPtr->patterns[i]);
- ckfree((char *) iPtr->regexps[i]);
- iPtr->regexps[i] = NULL;
- }
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
Trace *nextPtr = iPtr->tracePtr->nextPtr;
@@ -875,187 +1067,17 @@ DeleteInterpProc(interp)
resPtr = nextResPtr;
}
- ckfree((char *) iPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InterpDeleted --
- *
- * Returns nonzero if the interpreter has been deleted with a call
- * to Tcl_DeleteInterp.
- *
- * Results:
- * Nonzero if the interpreter is deleted, zero otherwise.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_InterpDeleted(interp)
- Tcl_Interp *interp;
-{
- return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteInterp --
- *
- * Ensures that the interpreter will be deleted eventually. If there
- * are no Tcl_Preserve calls in effect for this interpreter, it is
- * deleted immediately, otherwise the interpreter is deleted when
- * the last Tcl_Preserve is matched by a call to Tcl_Release. In either
- * case, the procedure runs the currently registered deletion callbacks.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The interpreter is marked as deleted. The caller may still use it
- * safely if there are calls to Tcl_Preserve in effect for the
- * interpreter, but further calls to Tcl_Eval etc in this interpreter
- * will fail.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DeleteInterp(interp)
- Tcl_Interp *interp; /* Token for command interpreter (returned
- * by a previous call to Tcl_CreateInterp). */
-{
- Interp *iPtr = (Interp *) interp;
-
- /*
- * If the interpreter has already been marked deleted, just punt.
- */
-
- if (iPtr->flags & DELETED) {
- return;
- }
-
- /*
- * Mark the interpreter as deleted. No further evals will be allowed.
- */
-
- iPtr->flags |= DELETED;
-
/*
- * Ensure that the interpreter is eventually deleted.
+ * Free up literal objects created for scripts compiled by the
+ * interpreter.
*/
- Tcl_EventuallyFree((ClientData) interp,
- (Tcl_FreeProc *) DeleteInterpProc);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * HiddenCmdsDeleteProc --
- *
- * Called on interpreter deletion to delete all the hidden
- * commands in an interpreter.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Frees up memory.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-HiddenCmdsDeleteProc(clientData, interp)
- ClientData clientData; /* The hidden commands hash table. */
- Tcl_Interp *interp; /* The interpreter being deleted. */
-{
- Tcl_HashTable *hiddenCmdTblPtr;
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch hSearch;
- Command *cmdPtr;
-
- hiddenCmdTblPtr = (Tcl_HashTable *) clientData;
- for (hPtr = Tcl_FirstHashEntry(hiddenCmdTblPtr, &hSearch);
- hPtr != NULL;
- hPtr = Tcl_FirstHashEntry(hiddenCmdTblPtr, &hSearch)) {
-
- /*
- * Cannot use Tcl_DeleteCommand because (a) the command is not
- * in the command hash table, and (b) that table has already been
- * deleted above. Hence we emulate what it does, below.
- */
-
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
-
- /*
- * The code here is tricky. We can't delete the hash table entry
- * before invoking the deletion callback because there are cases
- * where the deletion callback needs to invoke the command (e.g.
- * object systems such as OTcl). However, this means that the
- * callback could try to delete or rename the command. The deleted
- * flag allows us to detect these cases and skip nested deletes.
- */
-
- if (cmdPtr->deleted) {
-
- /*
- * Another deletion is already in progress. Remove the hash
- * table entry now, but don't invoke a callback or free the
- * command structure.
- */
-
- Tcl_DeleteHashEntry(cmdPtr->hPtr);
- cmdPtr->hPtr = NULL;
- continue;
- }
- cmdPtr->deleted = 1;
- if (cmdPtr->deleteProc != NULL) {
- (*cmdPtr->deleteProc)(cmdPtr->deleteData);
- }
-
- /*
- * Bump the command epoch counter. This will invalidate all cached
- * references that refer to this command.
- */
-
- cmdPtr->cmdEpoch++;
-
- /*
- * Don't use hPtr to delete the hash entry here, because it's
- * possible that the deletion callback renamed the command.
- * Instead, use cmdPtr->hptr, and make sure that no-one else
- * has already deleted the hash entry.
- */
-
- if (cmdPtr->hPtr != NULL) {
- Tcl_DeleteHashEntry(cmdPtr->hPtr);
- }
-
- /*
- * Now free the Command structure, unless there is another reference
- * to it from a CmdName Tcl object in some ByteCode code
- * sequence. In that case, delay the cleanup until all references
- * are either discarded (when a ByteCode is freed) or replaced by a
- * new reference (when a cached CmdName Command reference is found
- * to be invalid and TclExecuteByteCode looks up the command in the
- * command hashtable).
- */
-
- TclCleanupCommand(cmdPtr);
- }
- Tcl_DeleteHashTable(hiddenCmdTblPtr);
- ckfree((char *) hiddenCmdTblPtr);
+ TclDeleteLiteralTable(interp, &(iPtr->literalTable));
+ ckfree((char *) iPtr);
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_HideCommand --
*
@@ -1063,14 +1085,14 @@ HiddenCmdsDeleteProc(clientData, interp)
* an interpreter, only from within an ancestor.
*
* Results:
- * A standard Tcl result; also leaves a message in interp->result
+ * A standard Tcl result; also leaves a message in the interp's result
* if an error occurs.
*
* Side effects:
* Removes a command from the command table and create an entry
* into the hidden command table under the specified token name.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -1082,7 +1104,7 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
Interp *iPtr = (Interp *) interp;
Tcl_Command cmd;
Command *cmdPtr;
- Tcl_HashTable *hTblPtr;
+ Tcl_HashTable *hiddenCmdTablePtr;
Tcl_HashEntry *hPtr;
int new;
@@ -1153,14 +1175,12 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
* Initialize the hidden command table if necessary.
*/
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclHiddenCmds",
- NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- hTblPtr = (Tcl_HashTable *)
+ hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
+ if (hiddenCmdTablePtr == NULL) {
+ hiddenCmdTablePtr = (Tcl_HashTable *)
ckalloc((unsigned) sizeof(Tcl_HashTable));
- Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
- Tcl_SetAssocData(interp, "tclHiddenCmds", HiddenCmdsDeleteProc,
- (ClientData) hTblPtr);
+ Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
+ iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
}
/*
@@ -1169,7 +1189,7 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
* exists.
*/
- hPtr = Tcl_CreateHashEntry(hTblPtr, hiddenCmdToken, &new);
+ hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &new);
if (!new) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"hidden command named \"", hiddenCmdToken, "\" already exists",
@@ -1229,7 +1249,7 @@ Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
*
* Results:
* A standard Tcl result. If an error occurs, a message is left
- * in interp->result.
+ * in the interp's result.
*
* Side effects:
* Moves commands from one hash table to another.
@@ -1248,7 +1268,7 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
Command *cmdPtr;
Namespace *nsPtr;
Tcl_HashEntry *hPtr;
- Tcl_HashTable *hTblPtr;
+ Tcl_HashTable *hiddenCmdTablePtr;
int new;
if (iPtr->flags & DELETED) {
@@ -1275,24 +1295,14 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
}
/*
- * Find the hash table for the hidden commands; error out if there
- * is none.
- */
-
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclHiddenCmds",
- NULL);
- if (hTblPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown hidden command \"", hiddenCmdToken,
- "\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
* Get the command from the hidden command table:
*/
- hPtr = Tcl_FindHashEntry(hTblPtr, hiddenCmdToken);
+ hPtr = NULL;
+ hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
+ if (hiddenCmdTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
+ }
if (hPtr == (Tcl_HashEntry *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"unknown hidden command \"", hiddenCmdToken,
@@ -1421,7 +1431,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
char *tail;
- int new, result;
+ int new;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -1440,10 +1450,9 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
*/
if (strstr(cmdName, "::") != NULL) {
- result = TclGetNamespaceForQualName(interp, cmdName,
- (Namespace *) NULL, CREATE_NS_IF_UNKNOWN, &nsPtr,
- &dummy1, &dummy2, &tail);
- if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
+ TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
+ CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+ if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
@@ -1473,7 +1482,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
* could get stuck in an infinite loop).
*/
- ckfree((char*) cmdPtr);
+ ckfree((char*) Tcl_GetHashValue(hPtr));
}
}
cmdPtr = (Command *) ckalloc(sizeof(Command));
@@ -1527,7 +1536,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
*
* Results:
* The return value is a token for the command, which can
- * be used in future calls to Tcl_NameOfCommand.
+ * be used in future calls to Tcl_GetCommandName.
*
* Side effects:
* If no command named "cmdName" already exists for interp, one is
@@ -1568,7 +1577,7 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
char *tail;
- int new, result;
+ int new;
ImportedCmdData *dataPtr;
if (iPtr->flags & DELETED) {
@@ -1587,10 +1596,9 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
*/
if (strstr(cmdName, "::") != NULL) {
- result = TclGetNamespaceForQualName(interp, cmdName,
- (Namespace *) NULL, CREATE_NS_IF_UNKNOWN, &nsPtr,
- &dummy1, &dummy2, &tail);
- if ((result != TCL_OK) || (nsPtr == NULL) || (tail == NULL)) {
+ TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
+ CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+ if ((nsPtr == NULL) || (tail == NULL)) {
return (Tcl_Command) NULL;
}
} else {
@@ -1726,7 +1734,6 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
* Create the string argument array "argv". Make sure argv is large
* enough to hold the objc arguments plus 1 extra for the zero
* end-of-argv word.
- * THIS FAILS IF ANY ARGUMENT OBJECT CONTAINS AN EMBEDDED NULL.
*/
if ((objc + 1) > NUM_ARGS) {
@@ -1734,7 +1741,7 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
}
for (i = 0; i < objc; i++) {
- argv[i] = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ argv[i] = Tcl_GetString(objv[i]);
}
argv[objc] = 0;
@@ -1827,11 +1834,9 @@ TclInvokeObjectCommand(clientData, interp, argc, argv)
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULL BYTES.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
/*
@@ -1921,12 +1926,9 @@ TclRenameCommand(interp, oldName, newName)
* Tcl_CreateCommand would.
*/
- result = TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
- (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
- &newNsPtr, &dummy1, &dummy2, &newTail);
- if (result != TCL_OK) {
- return result;
- }
+ TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
+ CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
+
if ((newNsPtr == NULL) || (newTail == NULL)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"can't rename to \"", newName, "\": bad command name",
@@ -2023,8 +2025,8 @@ Tcl_SetCommandInfo(interp, cmdName, infoPtr)
Tcl_Interp *interp; /* Interpreter in which to look
* for command. */
char *cmdName; /* Name of desired command. */
- Tcl_CmdInfo *infoPtr; /* Where to store information about
- * command. */
+ Tcl_CmdInfo *infoPtr; /* Where to find information
+ * to store in the command. */
{
Tcl_Command cmd;
Command *cmdPtr;
@@ -2313,6 +2315,16 @@ Tcl_DeleteCommandFromToken(interp, cmd)
* the "real" command that this imported command refers to.
*/
+ /*
+ * If you are getting a crash during the call to deleteProc and
+ * cmdPtr->deleteProc is a pointer to the function free(), the
+ * most likely cause is that your extension allocated memory
+ * for the clientData argument to Tcl_CreateObjCommand() with
+ * the ckalloc() macro and you are now trying to deallocate
+ * this memory with free() instead of ckfree(). You should
+ * pass a pointer to your own method that calls ckfree().
+ */
+
(*cmdPtr->deleteProc)(cmdPtr->deleteData);
}
@@ -2405,86 +2417,96 @@ TclCleanupCommand(cmdPtr)
/*
*----------------------------------------------------------------------
*
- * Tcl_Eval --
+ * Tcl_CreateMathFunc --
*
- * Execute a Tcl command in a string.
+ * Creates a new math function for expressions in a given
+ * interpreter.
*
* Results:
- * The return value is one of the return codes defined in tcl.h
- * (such as TCL_OK), and interp->result contains a string value
- * to supplement the return code. The value of interp->result
- * will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
- * you must copy it or lose it!
+ * None.
*
* Side effects:
- * The string is compiled to produce a ByteCode object that holds the
- * command's bytecode instructions. However, this ByteCode object is
- * lost after executing the command. The command's execution will
- * almost certainly have side effects. interp->termOffset is set to the
- * offset of the character in "string" just after the last one
- * successfully compiled or executed.
+ * The function defined by "name" is created or redefined. If the
+ * function already exists then its definition is replaced; this
+ * includes the builtin functions. Redefining a builtin function forces
+ * all existing code to be invalidated since that code may be compiled
+ * using an instruction specific to the replaced function. In addition,
+ * redefioning a non-builtin function will force existing code to be
+ * invalidated if the number of arguments has changed.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_Eval(interp, string)
- Tcl_Interp *interp; /* Token for command interpreter (returned
- * by previous call to Tcl_CreateInterp). */
- char *string; /* Pointer to TCL command to execute. */
+void
+Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
+ Tcl_Interp *interp; /* Interpreter in which function is
+ * to be available. */
+ char *name; /* Name of function (e.g. "sin"). */
+ int numArgs; /* Nnumber of arguments required by
+ * function. */
+ Tcl_ValueType *argTypes; /* Array of types acceptable for
+ * each argument. */
+ Tcl_MathProc *proc; /* Procedure that implements the
+ * math function. */
+ ClientData clientData; /* Additional value to pass to the
+ * function. */
{
- register Tcl_Obj *cmdPtr;
- int length = strlen(string);
- int result;
-
- if (length > 0) {
- /*
- * Initialize a Tcl object from the command string.
- */
-
- TclNewObj(cmdPtr);
- TclInitStringRep(cmdPtr, string, length);
- Tcl_IncrRefCount(cmdPtr);
-
- /*
- * Compile and execute the bytecodes.
- */
-
- result = Tcl_EvalObj(interp, cmdPtr);
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+ MathFunc *mathFuncPtr;
+ int new, i;
- /*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
- */
+ hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
+ if (new) {
+ Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
+ }
+ mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
- TCL_VOLATILE);
+ if (!new) {
+ if (mathFuncPtr->builtinFuncIndex >= 0) {
+ /*
+ * We are redefining a builtin math function. Invalidate the
+ * interpreter's existing code by incrementing its
+ * compileEpoch member. This field is checked in Tcl_EvalObj
+ * and ObjInterpProc, and code whose compilation epoch doesn't
+ * match is recompiled. Newly compiled code will no longer
+ * treat the function as builtin.
+ */
- /*
- * Discard the Tcl object created to hold the command and its code.
- */
-
- Tcl_DecrRefCount(cmdPtr);
- } else {
- /*
- * An empty string. Just reset the interpreter's result.
- */
+ iPtr->compileEpoch++;
+ } else {
+ /*
+ * A non-builtin function is being redefined. We must invalidate
+ * existing code if the number of arguments has changed. This
+ * is because existing code was compiled assuming that number.
+ */
- Tcl_ResetResult(interp);
- result = TCL_OK;
+ if (numArgs != mathFuncPtr->numArgs) {
+ iPtr->compileEpoch++;
+ }
+ }
}
- return result;
+
+ mathFuncPtr->builtinFuncIndex = -1; /* can't be a builtin function */
+ if (numArgs > MAX_MATH_ARGS) {
+ numArgs = MAX_MATH_ARGS;
+ }
+ mathFuncPtr->numArgs = numArgs;
+ for (i = 0; i < numArgs; i++) {
+ mathFuncPtr->argTypes[i] = argTypes[i];
+ }
+ mathFuncPtr->proc = proc;
+ mathFuncPtr->clientData = clientData;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_EvalObj --
+ * Tcl_EvalObjEx --
*
* Execute Tcl commands stored in a Tcl object. These commands are
- * compiled into bytecodes if necessary.
+ * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT
+ * is specified.
*
* Results:
* The return value is one of the return codes defined in tcl.h
@@ -2503,26 +2525,73 @@ Tcl_Eval(interp, string)
*----------------------------------------------------------------------
*/
-#undef Tcl_EvalObj
-
int
-Tcl_EvalObj(interp, objPtr)
+Tcl_EvalObjEx(interp, objPtr, flags)
Tcl_Interp *interp; /* Token for command interpreter
* (returned by a previous call to
* Tcl_CreateInterp). */
- Tcl_Obj *objPtr; /* Pointer to object containing
+ register Tcl_Obj *objPtr; /* Pointer to object containing
* commands to execute. */
+ int flags; /* Collection of OR-ed bits that
+ * control the evaluation of the
+ * script. Supported values are
+ * TCL_EVAL_GLOBAL and
+ * TCL_EVAL_DIRECT. */
{
register Interp *iPtr = (Interp *) interp;
- int flags; /* Interp->evalFlags value when the
+ int evalFlags; /* Interp->evalFlags value when the
* procedure was called. */
register ByteCode* codePtr; /* Tcl Internal type of bytecode. */
int oldCount = iPtr->cmdCount; /* Used to tell whether any commands
* at all were executed. */
- int numSrcChars;
- register int result;
+ int numSrcBytes;
+ int result;
+ CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
+ * in case TCL_EVAL_GLOBAL was set. */
Namespace *namespacePtr;
+ Tcl_IncrRefCount(objPtr);
+
+ if ((iPtr->flags & USE_EVAL_DIRECT) || (flags & TCL_EVAL_DIRECT)) {
+ /*
+ * We're not supposed to use the compiler or byte-code interpreter.
+ * Let Tcl_EvalEx evaluate the command directly (and probably
+ * more slowly).
+ *
+ * Pure List Optimization (no string representation). In this
+ * case, we can safely use Tcl_EvalObjv instead and get an
+ * appreciable improvement in execution speed. This is because it
+ * allows us to avoid a setFromAny step that would just pack
+ * everything into a string and back out again.
+ *
+ * USE_EVAL_DIRECT is a special flag used for testing purpose only
+ * (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
+ */
+ if (!(iPtr->flags & USE_EVAL_DIRECT) &&
+ (objPtr->typePtr == &tclListType) && /* is a list... */
+ (objPtr->bytes == NULL) /* ...without a string rep */) {
+ register List *listRepPtr =
+ (List *) objPtr->internalRep.otherValuePtr;
+ result = Tcl_EvalObjv(interp, listRepPtr->elemCount,
+ listRepPtr->elements, flags);
+ } else {
+ register char *p;
+ p = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ result = Tcl_EvalEx(interp, p, numSrcBytes, flags);
+ }
+ Tcl_DecrRefCount(objPtr);
+ return result;
+ }
+
+ /*
+ * Prevent the object from being deleted as a side effect of evaling it.
+ */
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ }
+
/*
* Reset both the interpreter's string and object results and clear out
* any error information. This makes sure that we return an empty
@@ -2538,23 +2607,23 @@ Tcl_EvalObj(interp, objPtr)
iPtr->numLevels++;
if (iPtr->numLevels > iPtr->maxNestingDepth) {
- iPtr->numLevels--;
Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
- return TCL_ERROR;
+ "too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
+ result = TCL_ERROR;
+ goto done;
}
/*
- * On the Mac, we will never reach the default recursion limit before blowing
- * the stack. So we need to do a check here.
+ * On the Mac, we will never reach the default recursion limit before
+ * blowing the stack. So we need to do a check here.
*/
if (TclpCheckStackSpace() == 0) {
/*NOTREACHED*/
- iPtr->numLevels--;
Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
- return TCL_ERROR;
+ "too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
+ result = TCL_ERROR;
+ goto done;
}
/*
@@ -2566,9 +2635,10 @@ Tcl_EvalObj(interp, objPtr)
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"attempt to call eval in deleted interpreter", -1);
Tcl_SetErrorCode(interp, "CORE", "IDELETE",
- "attempt to call eval in deleted interpreter", (char *) NULL);
- iPtr->numLevels--;
- return TCL_ERROR;
+ "attempt to call eval in deleted interpreter",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
}
/*
@@ -2582,6 +2652,13 @@ Tcl_EvalObj(interp, objPtr)
*
* Precompiled objects, however, are immutable and therefore
* they are not recompiled, even if the epoch has changed.
+ *
+ * To be pedantically correct, we should also check that the
+ * originating procPtr is the same as the current context procPtr
+ * (assuming one exists at all - none for global level). This
+ * code is #def'ed out because [info body] was changed to never
+ * return a bytecode type object, which should obviate us from
+ * the extra checks here.
*/
if (iPtr->varFramePtr != NULL) {
@@ -2593,12 +2670,16 @@ Tcl_EvalObj(interp, objPtr)
if (objPtr->typePtr == &tclByteCodeType) {
codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if ((codePtr->iPtr != iPtr)
+ if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
+#ifdef CHECK_PROC_ORIGINATION /* [Bug: 3412 Pedantic] */
+ || (codePtr->procPtr != NULL && !(iPtr->varFramePtr &&
+ iPtr->varFramePtr->procPtr == codePtr->procPtr))
+#endif
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if (codePtr->iPtr != iPtr) {
+ if ((Interp *) *codePtr->interpHandle != iPtr) {
panic("Tcl_EvalObj: compiled script jumped interps");
}
codePtr->compileEpoch = iPtr->compileEpoch;
@@ -2608,15 +2689,22 @@ Tcl_EvalObj(interp, objPtr)
}
}
if (objPtr->typePtr != &tclByteCodeType) {
- /*
- * First reset any error line number information.
- */
-
- iPtr->errorLine = 1; /* no correct line # information yet */
+ iPtr->errorLine = 1;
result = tclByteCodeType.setFromAnyProc(interp, objPtr);
if (result != TCL_OK) {
- iPtr->numLevels--;
- return result;
+ goto done;
+ }
+ } else {
+ codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ if (((Interp *) *codePtr->interpHandle != iPtr)
+ || (codePtr->compileEpoch != iPtr->compileEpoch)) {
+ (*tclByteCodeType.freeIntRepProc)(objPtr);
+ iPtr->errorLine = 1;
+ result = (*tclByteCodeType.setFromAnyProc)(interp, objPtr);
+ if (result != TCL_OK) {
+ iPtr->numLevels--;
+ return result;
+ }
}
}
codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
@@ -2626,7 +2714,7 @@ Tcl_EvalObj(interp, objPtr)
* Resetting the flags must be done after any compilation.
*/
- flags = iPtr->evalFlags;
+ evalFlags = iPtr->evalFlags;
iPtr->evalFlags = 0;
/*
@@ -2634,8 +2722,8 @@ Tcl_EvalObj(interp, objPtr)
* don't bother executing the code.
*/
- numSrcChars = codePtr->numSrcChars;
- if ((numSrcChars > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+ numSrcBytes = codePtr->numSrcBytes;
+ if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
/*
* Increment the code's ref count while it is being executed. If
* afterwards no references to it remain, free the code.
@@ -2648,7 +2736,6 @@ Tcl_EvalObj(interp, objPtr)
TclCleanupByteCode(codePtr);
}
} else {
- Tcl_ResetResult(interp);
result = TCL_OK;
}
@@ -2659,33 +2746,23 @@ Tcl_EvalObj(interp, objPtr)
* empty bodies.
*/
- if ((oldCount == iPtr->cmdCount) && (Tcl_AsyncReady())) {
+ if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
result = Tcl_AsyncInvoke(interp, result);
}
/*
- * Free up any extra resources that were allocated.
+ * Update the interpreter's evaluation level count. If we are again at
+ * the top level, process any unusual return code returned by the
+ * evaluated code.
*/
- iPtr->numLevels--;
- if (iPtr->numLevels == 0) {
+ if (iPtr->numLevels == 1) {
if (result == TCL_RETURN) {
result = TclUpdateReturnInfo(iPtr);
}
if ((result != TCL_OK) && (result != TCL_ERROR)
- && !(flags & TCL_ALLOW_EXCEPTIONS)) {
- Tcl_ResetResult(interp);
- if (result == TCL_BREAK) {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "invoked \"break\" outside of a loop", -1);
- } else if (result == TCL_CONTINUE) {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "invoked \"continue\" outside of a loop", -1);
- } else {
- char buf[50];
- sprintf(buf, "command returned bad code: %d", result);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
- }
+ && ((evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) {
+ ProcessUnexpectedResult(interp, result);
result = TCL_ERROR;
}
}
@@ -2696,33 +2773,7 @@ Tcl_EvalObj(interp, objPtr)
*/
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- char buf[200];
- char *ellipsis = "";
- char *bytes;
- int length;
-
- /*
- * Figure out how much of the command to print in the error
- * message (up to a certain number of characters, or up to
- * the first new-line).
- * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS A NULL.
- */
-
- bytes = Tcl_GetStringFromObj(objPtr, &length);
- length = TclMin(numSrcChars, length);
- if (length > 150) {
- length = 150;
- ellipsis = " ...";
- }
-
- if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- sprintf(buf, "\n while executing\n\"%.*s%s\"",
- length, bytes, ellipsis);
- } else {
- sprintf(buf, "\n invoked from within\n\"%.*s%s\"",
- length, bytes, ellipsis);
- }
- Tcl_AddObjErrorInfo(interp, buf, -1);
+ RecordTracebackInfo(interp, objPtr, numSrcBytes);
}
/*
@@ -2732,13 +2783,114 @@ Tcl_EvalObj(interp, objPtr)
* compiled.
*/
- iPtr->termOffset = numSrcChars;
+ iPtr->termOffset = numSrcBytes;
iPtr->flags &= ~ERR_ALREADY_LOGGED;
+
+ done:
+ TclDecrRefCount(objPtr);
+ iPtr->varFramePtr = savedVarFramePtr;
+ iPtr->numLevels--;
return result;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
+ *
+ * ProcessUnexpectedResult --
+ *
+ * Procedure called by Tcl_EvalObj to set the interpreter's result
+ * value to an appropriate error message when the code it evaluates
+ * returns an unexpected result code (not TCL_OK and not TCL_ERROR) to
+ * the topmost evaluation level.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The interpreter result is set to an error message appropriate to
+ * the result code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcessUnexpectedResult(interp, returnCode)
+ Tcl_Interp *interp; /* The interpreter in which the unexpected
+ * result code was returned. */
+ int returnCode; /* The unexpected result code. */
+{
+ Tcl_ResetResult(interp);
+ if (returnCode == TCL_BREAK) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "invoked \"break\" outside of a loop", -1);
+ } else if (returnCode == TCL_CONTINUE) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "invoked \"continue\" outside of a loop", -1);
+ } else {
+ char buf[30 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "command returned bad code: %d", returnCode);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecordTracebackInfo --
+ *
+ * Procedure called by Tcl_EvalObj to record information about what was
+ * being executed when the error occurred.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Appends information about the script being evaluated to the
+ * interpreter's "errorInfo" variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecordTracebackInfo(interp, objPtr, numSrcBytes)
+ Tcl_Interp *interp; /* The interpreter in which the error
+ * occurred. */
+ Tcl_Obj *objPtr; /* Points to object containing script whose
+ * evaluation resulted in an error. */
+ int numSrcBytes; /* Number of bytes compiled in script. */
+{
+ Interp *iPtr = (Interp *) interp;
+ char buf[200];
+ char *ellipsis, *bytes;
+ int length;
+
+ /*
+ * Decide how much of the command to print in the error message
+ * (up to a certain number of bytes).
+ */
+
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ length = TclMin(numSrcBytes, length);
+
+ ellipsis = "";
+ if (length > 150) {
+ length = 150;
+ ellipsis = " ...";
+ }
+
+ if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+ sprintf(buf, "\n while executing\n\"%.*s%s\"",
+ length, bytes, ellipsis);
+ } else {
+ sprintf(buf, "\n invoked from within\n\"%.*s%s\"",
+ length, bytes, ellipsis);
+ }
+ Tcl_AddObjErrorInfo(interp, buf, -1);
+}
+
+/*
+ *---------------------------------------------------------------------------
*
* Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
*
@@ -2747,15 +2899,15 @@ Tcl_EvalObj(interp, objPtr)
*
* Results:
* Each of the procedures below returns a standard Tcl result. If an
- * error occurs then an error message is left in interp->result.
- * Otherwise the value of the expression, in the appropriate form, is
- * stored at *ptr. If the expression had a result that was
+ * error occurs then an error message is left in the interp's result.
+ * Otherwise the value of the expression, in the appropriate form,
+ * is stored at *ptr. If the expression had a result that was
* incompatible with the desired form then an error is returned.
*
* Side effects:
* None.
*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -2793,12 +2945,9 @@ Tcl_ExprLong(interp, string, ptr)
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp),
- (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
@@ -2847,12 +2996,9 @@ Tcl_ExprDouble(interp, string, ptr)
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp),
- (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
@@ -2900,12 +3046,9 @@ Tcl_ExprBoolean(interp, string, ptr)
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp),
- (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
@@ -3013,9 +3156,6 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr)
*ptr = (resultPtr->internalRep.doubleValue != 0.0);
} else {
result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
- if (result != TCL_OK) {
- return result;
- }
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
}
@@ -3092,11 +3232,9 @@ TclInvoke(interp, argc, argv, flags)
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
/*
@@ -3184,15 +3322,15 @@ TclGlobalInvoke(interp, argc, argv, flags)
int
TclObjInvokeGlobal(interp, objc, objv, flags)
- Tcl_Interp *interp; /* Interpreter in which command is
- * to be invoked. */
+ Tcl_Interp *interp; /* Interpreter in which command is to be
+ * invoked. */
int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument value objects; objv[0]
- * points to the name of the
- * command to invoke. */
- int flags; /* Combination of flags controlling
- * the call: TCL_INVOKE_HIDDEN and
- * TCL_INVOKE_NO_UNKNOWN. */
+ Tcl_Obj *CONST objv[]; /* Argument objects; objv[0] points to the
+ * name of the command to invoke. */
+ int flags; /* Combination of flags controlling the
+ * call: TCL_INVOKE_HIDDEN,
+ * TCL_INVOKE_NO_UNKNOWN, or
+ * TCL_INVOKE_NO_TRACEBACK. */
{
register Interp *iPtr = (Interp *) interp;
int result;
@@ -3224,15 +3362,15 @@ TclObjInvokeGlobal(interp, objc, objv, flags)
int
TclObjInvoke(interp, objc, objv, flags)
- Tcl_Interp *interp; /* Interpreter in which command is
- * to be invoked. */
+ Tcl_Interp *interp; /* Interpreter in which command is to be
+ * invoked. */
int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument value objects; objv[0]
- * points to the name of the
- * command to invoke. */
- int flags; /* Combination of flags controlling
- * the call: TCL_INVOKE_HIDDEN and
- * TCL_INVOKE_NO_UNKNOWN. */
+ Tcl_Obj *CONST objv[]; /* Argument objects; objv[0] points to the
+ * name of the command to invoke. */
+ int flags; /* Combination of flags controlling the
+ * call: TCL_INVOKE_HIDDEN,
+ * TCL_INVOKE_NO_UNKNOWN, or
+ * TCL_INVOKE_NO_TRACEBACK. */
{
register Interp *iPtr = (Interp *) interp;
Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
@@ -3256,35 +3394,24 @@ TclObjInvoke(interp, objc, objv, flags)
return TCL_ERROR;
}
- /*
- * THE FOLLOWING CODE FAILS IF THE STRING REP CONTAINS NULLS.
- */
-
- cmdName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+ cmdName = Tcl_GetString(objv[0]);
if (flags & TCL_INVOKE_HIDDEN) {
/*
- * Find the table of hidden commands; error out if none.
+ * We never invoke "unknown" for hidden commands.
*/
-
- hTblPtr = (Tcl_HashTable *)
- Tcl_GetAssocData(interp, "tclHiddenCmds", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- badhiddenCmdToken:
+
+ hPtr = NULL;
+ hTblPtr = ((Interp *) interp)->hiddenCmdTablePtr;
+ if (hTblPtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
+ }
+ if (hPtr == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"invalid hidden command name \"", cmdName, "\"",
(char *) NULL);
return TCL_ERROR;
}
- hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
-
- /*
- * We never invoke "unknown" for hidden commands.
- */
-
- if (hPtr == NULL) {
- goto badhiddenCmdToken;
- }
cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
} else {
cmdPtr = NULL;
@@ -3345,7 +3472,9 @@ TclObjInvoke(interp, objc, objv, flags)
* executed when the error occurred.
*/
- if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ if ((result == TCL_ERROR)
+ && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
+ && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
Tcl_DString ds;
Tcl_DStringInit(&ds);
@@ -3377,13 +3506,14 @@ TclObjInvoke(interp, objc, objv, flags)
*/
if (localObjv != (Tcl_Obj **) NULL) {
+ Tcl_DecrRefCount(localObjv[0]);
ckfree((char *) localObjv);
}
return result;
}
/*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_ExprString --
*
@@ -3391,17 +3521,16 @@ TclObjInvoke(interp, objc, objv, flags)
* form.
*
* Results:
- * A standard Tcl result. If the result is TCL_OK, then the
- * interpreter's result is set to the string value of the
- * expression. If the result is TCL_OK, then interp->result
- * contains an error message.
+ * A standard Tcl result. If the result is TCL_OK, then the interp's
+ * result is set to the string value of the expression. If the result
+ * is TCL_ERROR, then the interp's result contains an error message.
*
* Side effects:
* A Tcl object is allocated to hold a copy of the expression string.
* This expression object is passed to Tcl_ExprObj and then
* deallocated.
*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -3413,7 +3542,7 @@ Tcl_ExprString(interp, string)
register Tcl_Obj *exprPtr;
Tcl_Obj *resultPtr;
int length = strlen(string);
- char buf[100];
+ char buf[TCL_DOUBLE_SPACE];
int result = TCL_OK;
if (length > 0) {
@@ -3437,24 +3566,19 @@ Tcl_ExprString(interp, string)
} else {
/*
* Set interpreter's string result from the result object.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(resultPtr, (int *) NULL),
- TCL_VOLATILE);
+ Tcl_SetResult(interp, TclGetString(resultPtr),
+ TCL_VOLATILE);
}
Tcl_DecrRefCount(resultPtr); /* discard the result object */
} else {
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp),
- (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
Tcl_DecrRefCount(exprPtr); /* discard the expression object */
@@ -3504,15 +3628,42 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure
* allocated in frame. */
+ LiteralTable *localTablePtr = &(compEnv.localLitTable);
register ByteCode *codePtr = NULL;
/* Tcl Internal type of bytecode.
* Initialized to avoid compiler warning. */
AuxData *auxDataPtr;
- Interp dummy;
+ LiteralEntry *entryPtr;
Tcl_Obj *saveObjPtr;
char *string;
- int result;
- int i;
+ int length, i, result;
+
+ /*
+ * First handle some common expressions specially.
+ */
+
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ if (length == 1) {
+ if (*string == '0') {
+ *resultPtrPtr = Tcl_NewLongObj(0);
+ Tcl_IncrRefCount(*resultPtrPtr);
+ return TCL_OK;
+ } else if (*string == '1') {
+ *resultPtrPtr = Tcl_NewLongObj(1);
+ Tcl_IncrRefCount(*resultPtrPtr);
+ return TCL_OK;
+ }
+ } else if ((length == 2) && (*string == '!')) {
+ if (*(string+1) == '0') {
+ *resultPtrPtr = Tcl_NewLongObj(1);
+ Tcl_IncrRefCount(*resultPtrPtr);
+ return TCL_OK;
+ } else if (*(string+1) == '1') {
+ *resultPtrPtr = Tcl_NewLongObj(0);
+ Tcl_IncrRefCount(*resultPtrPtr);
+ return TCL_OK;
+ }
+ }
/*
* Get the ByteCode from the object. If it exists, make sure it hasn't
@@ -3525,72 +3676,53 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
* Precompiled expressions, however, are immutable and therefore
* they are not recompiled, even if the epoch has changed.
*
- * THIS FAILS IF THE OBJECT'S STRING REP HAS A NULL BYTE.
*/
if (objPtr->typePtr == &tclByteCodeType) {
codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if ((codePtr->iPtr != iPtr)
+ if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)) {
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if (codePtr->iPtr != iPtr) {
+ if ((Interp *) *codePtr->interpHandle != iPtr) {
panic("Tcl_ExprObj: compiled expression jumped interps");
}
codePtr->compileEpoch = iPtr->compileEpoch;
} else {
- tclByteCodeType.freeIntRepProc(objPtr);
+ (*tclByteCodeType.freeIntRepProc)(objPtr);
objPtr->typePtr = (Tcl_ObjType *) NULL;
}
}
}
if (objPtr->typePtr != &tclByteCodeType) {
- int length;
- string = Tcl_GetStringFromObj(objPtr, &length);
- TclInitCompileEnv(interp, &compEnv, string);
- result = TclCompileExpr(interp, string, string + length,
- /*flags*/ 0, &compEnv);
- if (result == TCL_OK) {
- /*
- * If the expression yielded no instructions (e.g., was empty),
- * push an integer zero object as the expressions's result.
- */
-
- if (compEnv.codeNext == NULL) {
- int objIndex = TclObjIndexForString("0", 0,
- /*allocStrRep*/ 0, /*inHeap*/ 0, &compEnv);
- Tcl_Obj *objPtr = compEnv.objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = 0;
- objPtr->typePtr = &tclIntType;
-
- TclEmitPush(objIndex, &compEnv);
- }
-
- /*
- * Add done instruction at the end of the instruction sequence.
- */
-
- TclEmitOpcode(INST_DONE, &compEnv);
-
- TclInitByteCodeObj(objPtr, &compEnv);
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if (tclTraceCompile == 2) {
- TclPrintByteCodeObj(interp, objPtr);
- }
- TclFreeCompileEnv(&compEnv);
- } else {
+ TclInitCompileEnv(interp, &compEnv, string, length);
+ result = TclCompileExpr(interp, string, length, &compEnv);
+
+ /*
+ * Free the compilation environment's literal table bucket array if
+ * it was dynamically allocated.
+ */
+
+ if (localTablePtr->buckets != localTablePtr->staticBuckets) {
+ ckfree((char *) localTablePtr->buckets);
+ }
+
+ if (result != TCL_OK) {
/*
- * Compilation errors. Decrement the ref counts on any objects
- * in the object array before freeing the compilation
- * environment.
+ * Compilation errors. Free storage allocated for compilation.
*/
-
- for (i = 0; i < compEnv.objArrayNext; i++) {
- Tcl_Obj *elemPtr = compEnv.objArrayPtr[i];
- Tcl_DecrRefCount(elemPtr);
- }
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyLocalLiteralTable(&compEnv);
+#endif /*TCL_COMPILE_DEBUG*/
+ entryPtr = compEnv.literalArrayPtr;
+ for (i = 0; i < compEnv.literalArrayNext; i++) {
+ TclReleaseLiteral(interp, entryPtr->objPtr);
+ entryPtr++;
+ }
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyGlobalLiteralTable(iPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
auxDataPtr = compEnv.auxDataArrayPtr;
for (i = 0; i < compEnv.auxDataArrayNext; i++) {
if (auxDataPtr->type->freeProc != NULL) {
@@ -3601,28 +3733,43 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
TclFreeCompileEnv(&compEnv);
return result;
}
+
+ /*
+ * Successful compilation. If the expression yielded no
+ * instructions, push an zero object as the expression's result.
+ */
+
+ if (compEnv.codeNext == compEnv.codeStart) {
+ TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0),
+ &compEnv);
+ }
+
+ /*
+ * Add a "done" instruction as the last instruction and change the
+ * object into a ByteCode object. Ownership of the literal objects
+ * and aux data items is given to the ByteCode object.
+ */
+
+ compEnv.numSrcBytes = iPtr->termOffset;
+ TclEmitOpcode(INST_DONE, &compEnv);
+ TclInitByteCodeObj(objPtr, &compEnv);
+ TclFreeCompileEnv(&compEnv);
+ codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceCompile == 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ }
+#endif /* TCL_COMPILE_DEBUG */
}
/*
* Execute the expression after first saving the interpreter's result.
*/
- dummy.objResultPtr = Tcl_NewObj();
- Tcl_IncrRefCount(dummy.objResultPtr);
- if (interp->freeProc == 0) {
- dummy.freeProc = (Tcl_FreeProc *) 0;
- dummy.result = "";
- Tcl_SetResult((Tcl_Interp *) &dummy, interp->result,
- TCL_VOLATILE);
- } else {
- dummy.freeProc = interp->freeProc;
- dummy.result = interp->result;
- interp->freeProc = (Tcl_FreeProc *) 0;
- }
-
saveObjPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(saveObjPtr);
-
+ Tcl_ResetResult(interp);
+
/*
* Increment the code's ref count while it is being executed. If
* afterwards no references to it remain, free the code.
@@ -3633,6 +3780,8 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
+ objPtr->typePtr = NULL;
+ objPtr->internalRep.otherValuePtr = NULL;
}
/*
@@ -3648,17 +3797,9 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
*resultPtrPtr = iPtr->objResultPtr;
Tcl_IncrRefCount(iPtr->objResultPtr);
- Tcl_SetResult(interp, dummy.result,
- ((dummy.freeProc == 0) ? TCL_VOLATILE : dummy.freeProc));
- Tcl_DecrRefCount(iPtr->objResultPtr);
- iPtr->objResultPtr = saveObjPtr;
- } else {
- Tcl_DecrRefCount(saveObjPtr);
- Tcl_FreeResult((Tcl_Interp *) &dummy);
+ Tcl_SetObjResult(interp, saveObjPtr);
}
-
- Tcl_DecrRefCount(dummy.objResultPtr);
- dummy.objResultPtr = NULL;
+ Tcl_DecrRefCount(saveObjPtr);
return result;
}
@@ -3813,7 +3954,7 @@ void
Tcl_AddErrorInfo(interp, message)
Tcl_Interp *interp; /* Interpreter to which error information
* pertains. */
- char *message; /* Message to record. */
+ CONST char *message; /* Message to record. */
{
Tcl_AddObjErrorInfo(interp, message, -1);
}
@@ -3845,29 +3986,26 @@ void
Tcl_AddObjErrorInfo(interp, message, length)
Tcl_Interp *interp; /* Interpreter to which error information
* pertains. */
- char *message; /* Points to the first byte of an array of
+ CONST char *message; /* Points to the first byte of an array of
* bytes of the message. */
- register int length; /* The number of bytes in the message.
+ int length; /* The number of bytes in the message.
* If < 0, then append all bytes up to a
* NULL byte. */
{
register Interp *iPtr = (Interp *) interp;
- Tcl_Obj *namePtr, *messagePtr;
+ Tcl_Obj *messagePtr;
/*
* If we are just starting to log an error, errorInfo is initialized
* from the error message in the interpreter's result.
*/
- namePtr = Tcl_NewStringObj("errorInfo", -1);
- Tcl_IncrRefCount(namePtr);
-
if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */
iPtr->flags |= ERR_IN_PROGRESS;
if (iPtr->result[0] == 0) {
- (void) Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL,
- iPtr->objResultPtr, TCL_GLOBAL_ONLY);
+ (void) Tcl_SetVar2Ex(interp, "errorInfo", NULL, iPtr->objResultPtr,
+ TCL_GLOBAL_ONLY);
} else { /* use the string result */
Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
TCL_GLOBAL_ONLY);
@@ -3891,39 +4029,37 @@ Tcl_AddObjErrorInfo(interp, message, length)
if (length != 0) {
messagePtr = Tcl_NewStringObj(message, length);
Tcl_IncrRefCount(messagePtr);
- Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, messagePtr,
+ Tcl_SetVar2Ex(interp, "errorInfo", NULL, messagePtr,
(TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
Tcl_DecrRefCount(messagePtr); /* free msg object appended above */
}
-
- Tcl_DecrRefCount(namePtr); /* free the name object */
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_VarEval --
+ * Tcl_VarEvalVA --
*
* Given a variable number of string arguments, concatenate them
* all together and execute the result as a Tcl command.
*
* Results:
- * A standard Tcl return result. An error message or other
- * result may be left in interp->result.
+ * A standard Tcl return result. An error message or other result may
+ * be left in the interp's result.
*
* Side effects:
* Depends on what was done by the command.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
- /* VARARGS2 */ /* ARGSUSED */
+
int
-Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+Tcl_VarEvalVA (interp, argList)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate command. */
+ va_list argList; /* Variable argument list. */
{
- va_list argList;
Tcl_DString buf;
char *string;
- Tcl_Interp *interp;
int result;
/*
@@ -3933,7 +4069,6 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
* space.
*/
- interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
Tcl_DStringInit(&buf);
while (1) {
string = va_arg(argList, char *);
@@ -3942,7 +4077,6 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
}
Tcl_DStringAppend(&buf, string, -1);
}
- va_end(argList);
result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
Tcl_DStringFree(&buf);
@@ -3952,72 +4086,59 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
/*
*----------------------------------------------------------------------
*
- * Tcl_GlobalEval --
+ * Tcl_VarEval --
*
- * Evaluate a command at global level in an interpreter.
+ * Given a variable number of string arguments, concatenate them
+ * all together and execute the result as a Tcl command.
*
* Results:
- * A standard Tcl result is returned, and interp->result is
- * modified accordingly.
+ * A standard Tcl return result. An error message or other
+ * result may be left in interp->result.
*
* Side effects:
- * The command string is executed in interp, and the execution
- * is carried out in the variable context of global level (no
- * procedures active), just as if an "uplevel #0" command were
- * being executed.
+ * Depends on what was done by the command.
*
*----------------------------------------------------------------------
*/
-
+ /* VARARGS2 */ /* ARGSUSED */
int
-Tcl_GlobalEval(interp, command)
- Tcl_Interp *interp; /* Interpreter in which to evaluate command. */
- char *command; /* Command to evaluate. */
+Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
{
- register Interp *iPtr = (Interp *) interp;
+ Tcl_Interp *interp;
+ va_list argList;
int result;
- CallFrame *savedVarFramePtr;
- savedVarFramePtr = iPtr->varFramePtr;
- iPtr->varFramePtr = NULL;
- result = Tcl_Eval(interp, command);
- iPtr->varFramePtr = savedVarFramePtr;
+ interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+ result = Tcl_VarEvalVA(interp, argList);
+ va_end(argList);
+
return result;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_GlobalEvalObj --
+ * Tcl_GlobalEval --
*
- * Execute Tcl commands stored in a Tcl object at global level in
- * an interpreter. These commands are compiled into bytecodes if
- * necessary.
+ * Evaluate a command at global level in an interpreter.
*
* Results:
- * A standard Tcl result is returned, and the interpreter's result
- * contains a Tcl object value to supplement the return code.
+ * A standard Tcl result is returned, and the interp's result is
+ * modified accordingly.
*
* Side effects:
- * The object is converted, if necessary, to a ByteCode object that
- * holds the bytecode instructions for the commands. Executing the
- * commands will almost certainly have side effects that depend on
- * those commands.
- *
- * The commands are executed in interp, and the execution
+ * The command string is executed in interp, and the execution
* is carried out in the variable context of global level (no
* procedures active), just as if an "uplevel #0" command were
* being executed.
*
- *----------------------------------------------------------------------
+ ---------------------------------------------------------------------------
*/
int
-Tcl_GlobalEvalObj(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter in which to evaluate
- * commands. */
- Tcl_Obj *objPtr; /* Pointer to object containing commands
- * to execute. */
+Tcl_GlobalEval(interp, command)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate command. */
+ char *command; /* Command to evaluate. */
{
register Interp *iPtr = (Interp *) interp;
int result;
@@ -4025,7 +4146,7 @@ Tcl_GlobalEvalObj(interp, objPtr)
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = NULL;
- result = Tcl_EvalObj(interp, objPtr);
+ result = Tcl_Eval(interp, command);
iPtr->varFramePtr = savedVarFramePtr;
return result;
}
@@ -4092,3 +4213,43 @@ Tcl_AllowExceptions(interp)
iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetVersion
+ *
+ * Get the Tcl major, minor, and patchlevel version numbers and
+ * the release type. A patch is a release type TCL_FINAL_RELEASE
+ * with a patchLevel > 0.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void Tcl_GetVersion(majorV, minorV, patchLevelV, type)
+ int *majorV;
+ int *minorV;
+ int *patchLevelV;
+ int *type;
+{
+ if (majorV != NULL) {
+ *majorV = TCL_MAJOR_VERSION;
+ }
+ if (minorV != NULL) {
+ *minorV = TCL_MINOR_VERSION;
+ }
+ if (patchLevelV != NULL) {
+ *patchLevelV = TCL_RELEASE_SERIAL;
+ }
+ if (type != NULL) {
+ *type = TCL_RELEASE_LEVEL;
+ }
+}
+
+
diff --git a/tcl/generic/tclBinary.c b/tcl/generic/tclBinary.c
index b059ce83aea..199109637a5 100644
--- a/tcl/generic/tclBinary.c
+++ b/tcl/generic/tclBinary.c
@@ -2,9 +2,10 @@
* tclBinary.c --
*
* This file contains the implementation of the "binary" Tcl built-in
- * command .
+ * command and the Tcl binary data object.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -28,11 +29,499 @@
* Prototypes for local procedures defined in this file:
*/
+static void DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
+ Tcl_Obj *src, unsigned char **cursorPtr));
+static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static int GetFormatSpec _ANSI_ARGS_((char **formatPtr,
char *cmdPtr, int *countPtr));
-static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
- Tcl_Obj *src, char **cursorPtr));
-static Tcl_Obj * ScanNumber _ANSI_ARGS_((char *buffer, int type));
+static Tcl_Obj * ScanNumber _ANSI_ARGS_((unsigned char *buffer, int type));
+static int SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static void UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
+
+
+/*
+ * The following object type represents an array of bytes. An array of
+ * bytes is not equivalent to an internationalized string. Conceptually, a
+ * string is an array of 16-bit quantities organized as a sequence of properly
+ * formed UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
+ * Accessor functions are provided to convert a ByteArray to a String or a
+ * String to a ByteArray. Two or more consecutive bytes in an array of bytes
+ * may look like a single UTF-8 character if the array is casually treated as
+ * a string. But obtaining the String from a ByteArray is guaranteed to
+ * produced properly formed UTF-8 sequences so that there is a one-to-one
+ * map between bytes and characters.
+ *
+ * Converting a ByteArray to a String proceeds by casting each byte in the
+ * array to a 16-bit quantity, treating that number as a Unicode character,
+ * and storing the UTF-8 version of that Unicode character in the String.
+ * For ByteArrays consisting entirely of values 1..127, the corresponding
+ * String representation is the same as the ByteArray representation.
+ *
+ * Converting a String to a ByteArray proceeds by getting the Unicode
+ * representation of each character in the String, casting it to a
+ * byte by truncating the upper 8 bits, and then storing the byte in the
+ * ByteArray. Converting from ByteArray to String and back to ByteArray
+ * is not lossy, but converting an arbitrary String to a ByteArray may be.
+ */
+
+Tcl_ObjType tclByteArrayType = {
+ "bytearray",
+ FreeByteArrayInternalRep,
+ DupByteArrayInternalRep,
+ UpdateStringOfByteArray,
+ SetByteArrayFromAny
+};
+
+/*
+ * The following structure is the internal rep for a ByteArray object.
+ * Keeps track of how much memory has been used and how much has been
+ * allocated for the byte array to enable growing and shrinking of the
+ * ByteArray object with fewer mallocs.
+ */
+
+typedef struct ByteArray {
+ int used; /* The number of bytes used in the byte
+ * array. */
+ int allocated; /* The amount of space actually allocated
+ * minus 1 byte. */
+ unsigned char bytes[4]; /* The array of bytes. The actual size of
+ * this field depends on the 'allocated' field
+ * above. */
+} ByteArray;
+
+#define BYTEARRAY_SIZE(len) \
+ ((unsigned) (sizeof(ByteArray) - 4 + (len)))
+#define GET_BYTEARRAY(objPtr) \
+ ((ByteArray *) (objPtr)->internalRep.otherValuePtr)
+#define SET_BYTEARRAY(objPtr, baPtr) \
+ (objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_NewByteArrayObj --
+ *
+ * This procedure is creates a new ByteArray object and initializes
+ * it from the given array of bytes.
+ *
+ * Results:
+ * The newly create object is returned. This object will have no
+ * initial string representation. The returned object has a ref count
+ * of 0.
+ *
+ * Side effects:
+ * Memory allocated for new object and copy of byte array argument.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewByteArrayObj
+
+
+Tcl_Obj *
+Tcl_NewByteArrayObj(bytes, length)
+ unsigned char *bytes; /* The array of bytes used to initialize
+ * the new object. */
+ int length; /* Length of the array of bytes, which must
+ * be >= 0. */
+{
+ return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewByteArrayObj(bytes, length)
+ unsigned char *bytes; /* The array of bytes used to initialize
+ * the new object. */
+ int length; /* Length of the array of bytes, which must
+ * be >= 0. */
+{
+ Tcl_Obj *objPtr;
+
+ TclNewObj(objPtr);
+ Tcl_SetByteArrayObj(objPtr, bytes, length);
+ return objPtr;
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_DbNewByteArrayObj --
+ *
+ * This procedure is normally called when debugging: i.e., when
+ * TCL_MEM_DEBUG is defined. It is the same as the Tcl_NewByteArrayObj
+ * above except that it calls Tcl_DbCkalloc directly with the file name
+ * and line number from its caller. This simplifies debugging since then
+ * the checkmem command will report the correct file name and line number
+ * when reporting objects that haven't been freed.
+ *
+ * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * result of calling Tcl_NewByteArrayObj.
+ *
+ * Results:
+ * The newly create object is returned. This object will have no
+ * initial string representation. The returned object has a ref count
+ * of 0.
+ *
+ * Side effects:
+ * Memory allocated for new object and copy of byte array argument.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+
+Tcl_Obj *
+Tcl_DbNewByteArrayObj(bytes, length, file, line)
+ unsigned char *bytes; /* The array of bytes used to initialize
+ * the new object. */
+ int length; /* Length of the array of bytes, which must
+ * be >= 0. */
+ char *file; /* The name of the source file calling this
+ * procedure; used for debugging. */
+ int line; /* Line number in the source file; used
+ * for debugging. */
+{
+ Tcl_Obj *objPtr;
+
+ TclDbNewObj(objPtr, file, line);
+ Tcl_SetByteArrayObj(objPtr, bytes, length);
+ return objPtr;
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_DbNewByteArrayObj(bytes, length, file, line)
+ unsigned char *bytes; /* The array of bytes used to initialize
+ * the new object. */
+ int length; /* Length of the array of bytes, which must
+ * be >= 0. */
+ char *file; /* The name of the source file calling this
+ * procedure; used for debugging. */
+ int line; /* Line number in the source file; used
+ * for debugging. */
+{
+ return Tcl_NewByteArrayObj(bytes, length);
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_SetByteArrayObj --
+ *
+ * Modify an object to be a ByteArray object and to have the specified
+ * array of bytes as its value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's old string rep and internal rep is freed.
+ * Memory allocated for copy of byte array argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetByteArrayObj(objPtr, bytes, length)
+ Tcl_Obj *objPtr; /* Object to initialize as a ByteArray. */
+ unsigned char *bytes; /* The array of bytes to use as the new
+ * value. */
+ int length; /* Length of the array of bytes, which must
+ * be >= 0. */
+{
+ Tcl_ObjType *typePtr;
+ ByteArray *byteArrayPtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ panic("Tcl_SetByteArrayObj called with shared object");
+ }
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ Tcl_InvalidateStringRep(objPtr);
+
+ byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ byteArrayPtr->used = length;
+ byteArrayPtr->allocated = length;
+ memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
+
+ objPtr->typePtr = &tclByteArrayType;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetByteArrayFromObj --
+ *
+ * Attempt to get the array of bytes from the Tcl object. If the
+ * object is not already a ByteArray object, an attempt will be
+ * made to convert it to one.
+ *
+ * Results:
+ * Pointer to array of bytes representing the ByteArray object.
+ *
+ * Side effects:
+ * Frees old internal rep. Allocates memory for new internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned char *
+Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
+ Tcl_Obj *objPtr; /* The ByteArray object. */
+ int *lengthPtr; /* If non-NULL, filled with length of the
+ * array of bytes in the ByteArray object. */
+{
+ ByteArray *baPtr;
+
+ SetByteArrayFromAny(NULL, objPtr);
+ baPtr = GET_BYTEARRAY(objPtr);
+
+ if (lengthPtr != NULL) {
+ *lengthPtr = baPtr->used;
+ }
+ return (unsigned char *) baPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetByteArrayLength --
+ *
+ * This procedure changes the length of the byte array for this
+ * object. Once the caller has set the length of the array, it
+ * is acceptable to directly modify the bytes in the array up until
+ * Tcl_GetStringFromObj() has been called on this object.
+ *
+ * Results:
+ * The new byte array of the specified length.
+ *
+ * Side effects:
+ * Allocates enough memory for an array of bytes of the requested
+ * size. When growing the array, the old array is copied to the
+ * new array; new bytes are undefined. When shrinking, the
+ * old array is truncated to the specified length.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+unsigned char *
+Tcl_SetByteArrayLength(objPtr, length)
+ Tcl_Obj *objPtr; /* The ByteArray object. */
+ int length; /* New length for internal byte array. */
+{
+ ByteArray *byteArrayPtr, *newByteArrayPtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ panic("Tcl_SetObjLength called with shared object");
+ }
+ if (objPtr->typePtr != &tclByteArrayType) {
+ SetByteArrayFromAny(NULL, objPtr);
+ }
+
+ byteArrayPtr = GET_BYTEARRAY(objPtr);
+ if (length > byteArrayPtr->allocated) {
+ newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ newByteArrayPtr->used = length;
+ newByteArrayPtr->allocated = length;
+ memcpy((VOID *) newByteArrayPtr->bytes,
+ (VOID *) byteArrayPtr->bytes, (size_t) byteArrayPtr->used);
+ ckfree((char *) byteArrayPtr);
+ byteArrayPtr = newByteArrayPtr;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
+ }
+ Tcl_InvalidateStringRep(objPtr);
+ byteArrayPtr->used = length;
+ return byteArrayPtr->bytes;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetByteArrayFromAny --
+ *
+ * Generate the ByteArray internal rep from the string rep.
+ *
+ * Results:
+ * The return value is always TCL_OK.
+ *
+ * Side effects:
+ * A ByteArray object is stored as the internal rep of objPtr.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetByteArrayFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Not used. */
+ Tcl_Obj *objPtr; /* The object to convert to type ByteArray. */
+{
+ Tcl_ObjType *typePtr;
+ int length;
+ char *src, *srcEnd;
+ unsigned char *dst;
+ ByteArray *byteArrayPtr;
+ Tcl_UniChar ch;
+
+ typePtr = objPtr->typePtr;
+ if (typePtr != &tclByteArrayType) {
+ src = Tcl_GetStringFromObj(objPtr, &length);
+ srcEnd = src + length;
+
+ byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
+ src += Tcl_UtfToUniChar(src, &ch);
+ *dst++ = (unsigned char) ch;
+ }
+
+ byteArrayPtr->used = dst - byteArrayPtr->bytes;
+ byteArrayPtr->allocated = length;
+
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tclByteArrayType;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeByteArrayInternalRep --
+ *
+ * Deallocate the storage associated with a ByteArray data object's
+ * internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeByteArrayInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* Object with internal rep to free. */
+{
+ ckfree((char *) GET_BYTEARRAY(objPtr));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupByteArrayInternalRep --
+ *
+ * Initialize the internal representation of a ByteArray Tcl_Obj
+ * to a copy of the internal representation of an existing ByteArray
+ * object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupByteArrayInternalRep(srcPtr, copyPtr)
+ Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ int length;
+ ByteArray *srcArrayPtr, *copyArrayPtr;
+
+ srcArrayPtr = GET_BYTEARRAY(srcPtr);
+ length = srcArrayPtr->used;
+
+ copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ copyArrayPtr->used = length;
+ copyArrayPtr->allocated = length;
+ memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes,
+ (size_t) length);
+ SET_BYTEARRAY(copyPtr, copyArrayPtr);
+
+ copyPtr->typePtr = &tclByteArrayType;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * UpdateStringOfByteArray --
+ *
+ * Update the string representation for a ByteArray data object.
+ * Note: This procedure does not invalidate an existing old string rep
+ * so storage will be lost if this has not already been done.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's string is set to a valid string that results from
+ * the ByteArray-to-string conversion.
+ *
+ * The object becomes a string object -- the internal rep is
+ * discarded and the typePtr becomes NULL.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfByteArray(objPtr)
+ Tcl_Obj *objPtr; /* ByteArray object whose string rep to
+ * update. */
+{
+ int i, length, size;
+ unsigned char *src;
+ char *dst;
+ ByteArray *byteArrayPtr;
+
+ byteArrayPtr = GET_BYTEARRAY(objPtr);
+ src = byteArrayPtr->bytes;
+ length = byteArrayPtr->used;
+
+ /*
+ * How much space will string rep need?
+ */
+
+ size = length;
+ for (i = 0; i < length; i++) {
+ if ((src[i] == 0) || (src[i] > 127)) {
+ size++;
+ }
+ }
+
+ dst = (char *) ckalloc((unsigned) (size + 1));
+ objPtr->bytes = dst;
+ objPtr->length = size;
+
+ if (size == length) {
+ memcpy((VOID *) dst, (VOID *) src, (size_t) size);
+ dst[size] = '\0';
+ } else {
+ for (i = 0; i < length; i++) {
+ dst += Tcl_UniCharToUtf(src[i], dst);
+ }
+ *dst = '\0';
+ }
+}
/*
*----------------------------------------------------------------------
@@ -65,43 +554,49 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
* character. */
char *format; /* Pointer to current position in format
* string. */
- char *cursor; /* Current position within result buffer. */
- char *maxPos; /* Greatest position within result buffer that
+ Tcl_Obj *resultPtr; /* Object holding result buffer. */
+ unsigned char *buffer; /* Start of result buffer. */
+ unsigned char *cursor; /* Current position within result buffer. */
+ unsigned char *maxPos; /* Greatest position within result buffer that
* cursor has visited.*/
- char *buffer; /* Start of data buffer. */
char *errorString, *errorValue, *str;
- int offset, size, length;
- Tcl_Obj *resultPtr;
-
- static char *subCmds[] = { "format", "scan", (char *) NULL };
- enum { BinaryFormat, BinaryScan } index;
+ int offset, size, length, index;
+ static char *options[] = {
+ "format", "scan", NULL
+ };
+ enum options {
+ BINARY_FORMAT, BINARY_SCAN
+ };
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
- (int *) &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- switch (index) {
- case BinaryFormat:
+ switch ((enum options) index) {
+ case BINARY_FORMAT: {
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
return TCL_ERROR;
}
+
/*
* To avoid copying the data, we format the string in two passes.
* The first pass computes the size of the output buffer. The
* second pass places the formatted data into the buffer.
*/
- format = Tcl_GetStringFromObj(objv[2], NULL);
+ format = Tcl_GetString(objv[2]);
arg = 3;
- offset = length = 0;
- while (*format != 0) {
+ offset = 0;
+ length = 0;
+ while (*format != '\0') {
+ str = format;
if (!GetFormatSpec(&format, &cmd, &count)) {
break;
}
@@ -111,17 +606,17 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
case 'b':
case 'B':
case 'h':
- case 'H':
+ case 'H': {
/*
* For string-type specifiers, the count corresponds
- * to the number of characters in a single argument.
+ * to the number of bytes in a single argument.
*/
if (arg >= objc) {
goto badIndex;
}
if (count == BINARY_ALL) {
- (void)Tcl_GetStringFromObj(objv[arg], &count);
+ Tcl_GetByteArrayFromObj(objv[arg], &count);
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -134,24 +629,29 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset += (count + 1) / 2;
}
break;
-
- case 'c':
+ }
+ case 'c': {
size = 1;
goto doNumbers;
+ }
case 's':
- case 'S':
+ case 'S': {
size = 2;
goto doNumbers;
+ }
case 'i':
- case 'I':
+ case 'I': {
size = 4;
goto doNumbers;
- case 'f':
+ }
+ case 'f': {
size = sizeof(float);
goto doNumbers;
- case 'd':
+ }
+ case 'd': {
size = sizeof(double);
- doNumbers:
+
+ doNumbers:
if (arg >= objc) {
goto badIndex;
}
@@ -176,23 +676,28 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
- errorString = "number of elements in list does not match count";
- goto error;
+ Tcl_AppendResult(interp,
+ "number of elements in list does not match count",
+ (char *) NULL);
+ return TCL_ERROR;
}
}
offset += count*size;
break;
-
- case 'x':
+ }
+ case 'x': {
if (count == BINARY_ALL) {
- errorString = "cannot use \"*\" in format string with \"x\"";
- goto error;
+ Tcl_AppendResult(interp,
+ "cannot use \"*\" in format string with \"x\"",
+ (char *) NULL);
+ return TCL_ERROR;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
offset += count;
break;
- case 'X':
+ }
+ case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -204,7 +709,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
offset -= count;
break;
- case '@':
+ }
+ case '@': {
if (offset > length) {
length = offset;
}
@@ -216,15 +722,10 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset = count;
}
break;
+ }
default: {
- char buf[2];
-
- Tcl_ResetResult(interp);
- buf[0] = cmd;
- buf[1] = '\0';
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad field specifier \"", buf, "\"", NULL);
- return TCL_ERROR;
+ errorString = str;
+ goto badfield;
}
}
}
@@ -241,9 +742,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
*/
resultPtr = Tcl_GetObjResult(interp);
- Tcl_SetObjLength(resultPtr, length);
- buffer = Tcl_GetStringFromObj(resultPtr, NULL);
- memset(buffer, 0, (size_t) length);
+ buffer = Tcl_SetByteArrayLength(resultPtr, length);
+ memset((VOID *) buffer, 0, (size_t) length);
/*
* Pack the data into the result object. Note that we can skip
@@ -252,7 +752,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
*/
arg = 3;
- format = Tcl_GetStringFromObj(objv[2], NULL);
+ format = Tcl_GetString(objv[2]);
cursor = buffer;
maxPos = cursor;
while (*format != 0) {
@@ -267,8 +767,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
case 'a':
case 'A': {
char pad = (char) (cmd == 'a' ? '\0' : ' ');
+ unsigned char *bytes;
- str = Tcl_GetStringFromObj(objv[arg++], &length);
+ bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
if (count == BINARY_ALL) {
count = length;
@@ -276,12 +777,12 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
count = 1;
}
if (length >= count) {
- memcpy((VOID *) cursor, (VOID *) str,
+ memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) count);
} else {
- memcpy((VOID *) cursor, (VOID *) str,
+ memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) length);
- memset(cursor+length, pad,
+ memset((VOID *) (cursor + length), pad,
(size_t) (count - length));
}
cursor += count;
@@ -289,7 +790,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
case 'b':
case 'B': {
- char *last;
+ unsigned char *last;
str = Tcl_GetStringFromObj(objv[arg++], &length);
if (count == BINARY_ALL) {
@@ -313,7 +814,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto badValue;
}
if (((offset + 1) % 8) == 0) {
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char) value;
value = 0;
}
}
@@ -327,7 +828,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto badValue;
}
if (!((offset + 1) % 8)) {
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char) value;
value = 0;
}
}
@@ -338,7 +839,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
} else {
value >>= 8 - (offset % 8);
}
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char) value;
}
while (cursor < last) {
*cursor++ = '\0';
@@ -347,7 +848,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
case 'h':
case 'H': {
- char *last;
+ unsigned char *last;
int c;
str = Tcl_GetStringFromObj(objv[arg++], &length);
@@ -365,15 +866,18 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (cmd == 'H') {
for (offset = 0; offset < count; offset++) {
value <<= 4;
- c = tolower(((unsigned char *) str)[offset]);
- if ((c >= 'a') && (c <= 'f')) {
- value |= ((c - 'a' + 10) & 0xf);
- } else if ((c >= '0') && (c <= '9')) {
- value |= (c - '0') & 0xf;
- } else {
+ if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
errorValue = str;
goto badValue;
}
+ c = str[offset] - '0';
+ if (c > 9) {
+ c += ('0' - 'A') + 10;
+ }
+ if (c > 16) {
+ c += ('A' - 'a');
+ }
+ value |= (c & 0xf);
if (offset % 2) {
*cursor++ = (char) value;
value = 0;
@@ -382,17 +886,21 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
} else {
for (offset = 0; offset < count; offset++) {
value >>= 4;
- c = tolower(((unsigned char *) str)[offset]);
- if ((c >= 'a') && (c <= 'f')) {
- value |= ((c - 'a' + 10) << 4) & 0xf0;
- } else if ((c >= '0') && (c <= '9')) {
- value |= ((c - '0') << 4) & 0xf0;
- } else {
+
+ if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
errorValue = str;
goto badValue;
}
+ c = str[offset] - '0';
+ if (c > 9) {
+ c += ('0' - 'A') + 10;
+ }
+ if (c > 16) {
+ c += ('A' - 'a');
+ }
+ value |= ((c << 4) & 0xf0);
if (offset % 2) {
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char)(value & 0xff);
value = 0;
}
}
@@ -403,7 +911,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
} else {
value >>= 4;
}
- *cursor++ = (char) value;
+ *cursor++ = (unsigned char) value;
}
while (cursor < last) {
@@ -447,14 +955,15 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
break;
}
- case 'x':
+ case 'x': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
memset(cursor, 0, (size_t) count);
cursor += count;
break;
- case 'X':
+ }
+ case 'X': {
if (cursor > maxPos) {
maxPos = cursor;
}
@@ -468,7 +977,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
cursor -= count;
}
break;
- case '@':
+ }
+ case '@': {
if (cursor > maxPos) {
maxPos = cursor;
}
@@ -478,11 +988,12 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
cursor = buffer + count;
}
break;
+ }
}
}
break;
-
- case BinaryScan: {
+ }
+ case BINARY_SCAN: {
int i;
Tcl_Obj *valuePtr, *elementPtr;
@@ -491,18 +1002,21 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
"value formatString ?varName varName ...?");
return TCL_ERROR;
}
- buffer = Tcl_GetStringFromObj(objv[2], &length);
- format = Tcl_GetStringFromObj(objv[3], NULL);
+ buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
+ format = Tcl_GetString(objv[3]);
cursor = buffer;
arg = 4;
offset = 0;
- while (*format != 0) {
+ while (*format != '\0') {
+ str = format;
if (!GetFormatSpec(&format, &cmd, &count)) {
goto done;
}
switch (cmd) {
case 'a':
- case 'A':
+ case 'A': {
+ unsigned char *src;
+
if (arg >= objc) {
goto badIndex;
}
@@ -517,7 +1031,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
}
- str = buffer + offset;
+ src = buffer + offset;
size = count;
/*
@@ -526,50 +1040,52 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (cmd == 'A') {
while (size > 0) {
- if (str[size-1] != '\0' && str[size-1] != ' ') {
+ if (src[size-1] != '\0' && src[size-1] != ' ') {
break;
}
size--;
}
}
- valuePtr = Tcl_NewStringObj(str, size);
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
- valuePtr,
- TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+ valuePtr = Tcl_NewByteArrayObj(src, size);
+ resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
+ NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ arg++;
if (resultPtr == NULL) {
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
offset += count;
break;
+ }
case 'b':
case 'B': {
+ unsigned char *src;
char *dest;
if (arg >= objc) {
goto badIndex;
}
if (count == BINARY_ALL) {
- count = (length - offset)*8;
+ count = (length - offset) * 8;
} else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
- if (count > (length - offset)*8) {
+ if (count > (length - offset) * 8) {
goto done;
}
}
- str = buffer + offset;
+ src = buffer + offset;
valuePtr = Tcl_NewObj();
Tcl_SetObjLength(valuePtr, count);
- dest = Tcl_GetStringFromObj(valuePtr, NULL);
+ dest = Tcl_GetString(valuePtr);
if (cmd == 'b') {
for (i = 0; i < count; i++) {
if (i % 8) {
value >>= 1;
} else {
- value = *str++;
+ value = *src++;
}
*dest++ = (char) ((value & 1) ? '1' : '0');
}
@@ -578,15 +1094,15 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (i % 8) {
value <<= 1;
} else {
- value = *str++;
+ value = *src++;
}
*dest++ = (char) ((value & 0x80) ? '1' : '0');
}
}
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
- valuePtr,
- TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+ resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
+ NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ arg++;
if (resultPtr == NULL) {
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
@@ -597,6 +1113,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
case 'h':
case 'H': {
char *dest;
+ unsigned char *src;
int i;
static char hexdigit[] = "0123456789abcdef";
@@ -613,17 +1130,17 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto done;
}
}
- str = buffer + offset;
+ src = buffer + offset;
valuePtr = Tcl_NewObj();
Tcl_SetObjLength(valuePtr, count);
- dest = Tcl_GetStringFromObj(valuePtr, NULL);
+ dest = Tcl_GetString(valuePtr);
if (cmd == 'h') {
for (i = 0; i < count; i++) {
if (i % 2) {
value >>= 4;
} else {
- value = *str++;
+ value = *src++;
}
*dest++ = hexdigit[value & 0xf];
}
@@ -632,15 +1149,15 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (i % 2) {
value <<= 4;
} else {
- value = *str++;
+ value = *src++;
}
*dest++ = hexdigit[(value >> 4) & 0xf];
}
}
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
- valuePtr,
- TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+ resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
+ NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ arg++;
if (resultPtr == NULL) {
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
@@ -648,24 +1165,31 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset += (count + 1) / 2;
break;
}
- case 'c':
+ case 'c': {
size = 1;
goto scanNumber;
+ }
case 's':
- case 'S':
+ case 'S': {
size = 2;
goto scanNumber;
+ }
case 'i':
- case 'I':
+ case 'I': {
size = 4;
goto scanNumber;
- case 'f':
+ }
+ case 'f': {
size = sizeof(float);
goto scanNumber;
- case 'd':
+ }
+ case 'd': {
+ unsigned char *src;
+
size = sizeof(double);
/* fall through */
- scanNumber:
+
+ scanNumber:
if (arg >= objc) {
goto badIndex;
}
@@ -683,25 +1207,26 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto done;
}
valuePtr = Tcl_NewObj();
- str = buffer+offset;
+ src = buffer+offset;
for (i = 0; i < count; i++) {
- elementPtr = ScanNumber(str, cmd);
- str += size;
+ elementPtr = ScanNumber(src, cmd);
+ src += size;
Tcl_ListObjAppendElement(NULL, valuePtr,
elementPtr);
}
offset += count*size;
}
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
- valuePtr,
- TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+ resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
+ NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ arg++;
if (resultPtr == NULL) {
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
break;
- case 'x':
+ }
+ case 'x': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -712,7 +1237,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset += count;
}
break;
- case 'X':
+ }
+ case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -722,7 +1248,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset -= count;
}
break;
- case '@':
+ }
+ case '@': {
if (count == BINARY_NOCOUNT) {
goto badCount;
}
@@ -732,15 +1259,10 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset = count;
}
break;
+ }
default: {
- char buf[2];
-
- Tcl_ResetResult(interp);
- buf[0] = cmd;
- buf[1] = '\0';
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad field specifier \"", buf, "\"", NULL);
- return TCL_ERROR;
+ errorString = str;
+ goto badfield;
}
}
}
@@ -771,9 +1293,18 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
errorString = "not enough arguments for all format specifiers";
goto error;
+ badfield: {
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX + 1];
+
+ Tcl_UtfToUniChar(errorString, &ch);
+ buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+ Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
+ return TCL_ERROR;
+ }
+
error:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), errorString, -1);
+ Tcl_AppendResult(interp, errorString, NULL);
return TCL_ERROR;
}
@@ -829,7 +1360,7 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
if (**formatPtr == '*') {
(*formatPtr)++;
(*countPtr) = BINARY_ALL;
- } else if (isdigit(UCHAR(**formatPtr))) {
+ } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
(*countPtr) = strtoul(*formatPtr, formatPtr, 10);
} else {
(*countPtr) = BINARY_NOCOUNT;
@@ -860,13 +1391,12 @@ FormatNumber(interp, type, src, cursorPtr)
* errors. */
int type; /* Type of number to format. */
Tcl_Obj *src; /* Number to format. */
- char **cursorPtr; /* Pointer to index into destination buffer. */
+ unsigned char **cursorPtr; /* Pointer to index into destination buffer. */
{
int value;
double dvalue;
- char cmd = (char)type;
- if (cmd == 'd' || cmd == 'f') {
+ if ((type == 'd') || (type == 'f')) {
/*
* For floating point types, we need to copy the data using
* memcpy to avoid alignment issues.
@@ -875,9 +1405,9 @@ FormatNumber(interp, type, src, cursorPtr)
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
return TCL_ERROR;
}
- if (cmd == 'd') {
- memcpy((*cursorPtr), &dvalue, sizeof(double));
- (*cursorPtr) += sizeof(double);
+ if (type == 'd') {
+ memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double));
+ *cursorPtr += sizeof(double);
} else {
float fvalue;
@@ -892,31 +1422,31 @@ FormatNumber(interp, type, src, cursorPtr)
} else {
fvalue = (float) dvalue;
}
- memcpy((*cursorPtr), &fvalue, sizeof(float));
- (*cursorPtr) += sizeof(float);
+ memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
+ *cursorPtr += sizeof(float);
}
} else {
if (Tcl_GetIntFromObj(interp, src, &value) != TCL_OK) {
return TCL_ERROR;
}
- if (cmd == 'c') {
- *(*cursorPtr)++ = (char)(value & 0xff);
- } else if (cmd == 's') {
- *(*cursorPtr)++ = (char)(value & 0xff);
- *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
- } else if (cmd == 'S') {
- *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
- *(*cursorPtr)++ = (char)(value & 0xff);
- } else if (cmd == 'i') {
- *(*cursorPtr)++ = (char)(value & 0xff);
- *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
- *(*cursorPtr)++ = (char)((value >> 16) & 0xff);
- *(*cursorPtr)++ = (char)((value >> 24) & 0xff);
- } else if (cmd == 'I') {
- *(*cursorPtr)++ = (char)((value >> 24) & 0xff);
- *(*cursorPtr)++ = (char)((value >> 16) & 0xff);
- *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
- *(*cursorPtr)++ = (char)(value & 0xff);
+ if (type == 'c') {
+ *(*cursorPtr)++ = (unsigned char) value;
+ } else if (type == 's') {
+ *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ } else if (type == 'S') {
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) value;
+ } else if (type == 'i') {
+ *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) (value >> 16);
+ *(*cursorPtr)++ = (unsigned char) (value >> 24);
+ } else if (type == 'I') {
+ *(*cursorPtr)++ = (unsigned char) (value >> 24);
+ *(*cursorPtr)++ = (unsigned char) (value >> 16);
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) value;
}
}
return TCL_OK;
@@ -942,10 +1472,10 @@ FormatNumber(interp, type, src, cursorPtr)
static Tcl_Obj *
ScanNumber(buffer, type)
- char *buffer; /* Buffer to scan number from. */
+ unsigned char *buffer; /* Buffer to scan number from. */
int type; /* Format character from "binary scan" */
{
- int value;
+ long value;
/*
* We cannot rely on the compiler to properly sign extend integer values
@@ -955,37 +1485,45 @@ ScanNumber(buffer, type)
* needed.
*/
- switch ((char) type) {
- case 'c':
- value = buffer[0];
+ switch (type) {
+ case 'c': {
+ /*
+ * Characters need special handling. We want to produce a
+ * signed result, but on some platforms (such as AIX) chars
+ * are unsigned. To deal with this, check for a value that
+ * should be negative but isn't.
+ */
+ value = buffer[0];
if (value & 0x80) {
value |= -0x100;
}
return Tcl_NewLongObj((long)value);
- case 's':
- value = (((unsigned char)buffer[0])
- + ((unsigned char)buffer[1] << 8));
+ }
+ case 's': {
+ value = (long) (buffer[0] + (buffer[1] << 8));
goto shortValue;
- case 'S':
- value = (((unsigned char)buffer[1])
- + ((unsigned char)buffer[0] << 8));
+ }
+ case 'S': {
+ value = (long) (buffer[1] + (buffer[0] << 8));
shortValue:
if (value & 0x8000) {
value |= -0x10000;
}
- return Tcl_NewLongObj((long)value);
- case 'i':
- value = (((unsigned char)buffer[0])
- + ((unsigned char)buffer[1] << 8)
- + ((unsigned char)buffer[2] << 16)
- + ((unsigned char)buffer[3] << 24));
+ return Tcl_NewLongObj(value);
+ }
+ case 'i': {
+ value = (long) (buffer[0]
+ + (buffer[1] << 8)
+ + (buffer[2] << 16)
+ + (buffer[3] << 24));
goto intValue;
- case 'I':
- value = (((unsigned char)buffer[3])
- + ((unsigned char)buffer[2] << 8)
- + ((unsigned char)buffer[1] << 16)
- + ((unsigned char)buffer[0] << 24));
+ }
+ case 'I': {
+ value = (long) (buffer[3]
+ + (buffer[2] << 8)
+ + (buffer[1] << 16)
+ + (buffer[0] << 24));
intValue:
/*
* Check to see if the value was sign extended properly on
@@ -996,16 +1534,16 @@ ScanNumber(buffer, type)
value -= (((unsigned int)1)<<31);
value -= (((unsigned int)1)<<31);
}
-
- return Tcl_NewLongObj((long)value);
+ return Tcl_NewLongObj(value);
+ }
case 'f': {
float fvalue;
- memcpy(&fvalue, buffer, sizeof(float));
+ memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
return Tcl_NewDoubleObj(fvalue);
}
case 'd': {
double dvalue;
- memcpy(&dvalue, buffer, sizeof(double));
+ memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double));
return Tcl_NewDoubleObj(dvalue);
}
}
diff --git a/tcl/generic/tclCkalloc.c b/tcl/generic/tclCkalloc.c
index fa089fccfea..1eb906d2af8 100644
--- a/tcl/generic/tclCkalloc.c
+++ b/tcl/generic/tclCkalloc.c
@@ -5,7 +5,8 @@
* involving overwritten, double freeing memory and loss of memory.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -102,9 +103,31 @@ static int init_malloced_bodies = TRUE;
#endif
/*
+ * The following variable indicates to TclFinalizeMemorySubsystem()
+ * that it should dump out the state of memory before exiting. If the
+ * value is non-NULL, it gives the name of the file in which to
+ * dump memory usage information.
+ */
+
+char *tclMemDumpFileName = NULL;
+
+static char dumpFile[100]; /* Records where to dump memory allocation
+ * information. */
+
+/*
+ * Mutex to serialize allocations. This is a low-level mutex that must
+ * be explicitly initialized. This is necessary because the self
+ * initializing mutexes use ckalloc...
+ */
+static Tcl_Mutex *ckallocMutexPtr;
+static int ckallocInit = 0;
+
+/*
* Prototypes for procedures defined in this file:
*/
+static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char *argv[]));
static int MemoryCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
static void ValidateMemory _ANSI_ARGS_((
@@ -114,6 +137,25 @@ static void ValidateMemory _ANSI_ARGS_((
/*
*----------------------------------------------------------------------
*
+ * TclInitDbCkalloc --
+ * Initialize the locks used by the allocator.
+ * This is only appropriate to call in a single threaded environment,
+ * such as during TclInitSubsystems.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TclInitDbCkalloc()
+{
+ if (!ckallocInit) {
+ ckallocInit = 1;
+ ckallocMutexPtr = Tcl_GetAllocMutex();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclDumpMemoryInfo --
* Display the global memory management statistics.
*
@@ -123,34 +165,48 @@ void
TclDumpMemoryInfo(outFile)
FILE *outFile;
{
- fprintf(outFile,"total mallocs %10d\n",
- total_mallocs);
- fprintf(outFile,"total frees %10d\n",
- total_frees);
- fprintf(outFile,"current packets allocated %10d\n",
- current_malloc_packets);
- fprintf(outFile,"current bytes allocated %10d\n",
- current_bytes_malloced);
- fprintf(outFile,"maximum packets allocated %10d\n",
- maximum_malloc_packets);
- fprintf(outFile,"maximum bytes allocated %10d\n",
- maximum_bytes_malloced);
+ fprintf(outFile,"total mallocs %10d\n",
+ total_mallocs);
+ fprintf(outFile,"total frees %10d\n",
+ total_frees);
+ fprintf(outFile,"current packets allocated %10d\n",
+ current_malloc_packets);
+ fprintf(outFile,"current bytes allocated %10d\n",
+ current_bytes_malloced);
+ fprintf(outFile,"maximum packets allocated %10d\n",
+ maximum_malloc_packets);
+ fprintf(outFile,"maximum bytes allocated %10d\n",
+ maximum_bytes_malloced);
}
+
/*
*----------------------------------------------------------------------
*
* ValidateMemory --
- * Procedure to validate allocted memory guard zones.
+ *
+ * Validate memory guard zones for a particular chunk of allocated
+ * memory.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Prints validation information about the allocated memory to stderr.
*
*----------------------------------------------------------------------
*/
+
static void
ValidateMemory(memHeaderP, file, line, nukeGuards)
- struct mem_header *memHeaderP;
- char *file;
- int line;
- int nukeGuards;
+ struct mem_header *memHeaderP; /* Memory chunk to validate */
+ char *file; /* File containing the call to
+ * Tcl_ValidateAllMemory */
+ int line; /* Line number of call to
+ * Tcl_ValidateAllMemory */
+ int nukeGuards; /* If non-zero, indicates that the
+ * memory guards are to be reset to 0
+ * after they have been printed */
{
unsigned char *hiPtr;
int idx;
@@ -164,7 +220,7 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
fflush(stdout);
byte &= 0xff;
fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", idx, byte,
- (isprint(UCHAR(byte)) ? byte : ' '));
+ (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
}
}
if (guard_failed) {
@@ -185,7 +241,7 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
fflush (stdout);
byte &= 0xff;
fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", idx, byte,
- (isprint(UCHAR(byte)) ? byte : ' '));
+ (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
}
}
@@ -211,45 +267,65 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
*----------------------------------------------------------------------
*
* Tcl_ValidateAllMemory --
- * Validates guard regions for all allocated memory.
+ *
+ * Validate memory guard regions for all allocated memory.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Displays memory validation information to stderr.
*
*----------------------------------------------------------------------
*/
void
Tcl_ValidateAllMemory (file, line)
- char *file;
- int line;
+ char *file; /* File from which Tcl_ValidateAllMemory was called */
+ int line; /* Line number of call to Tcl_ValidateAllMemory */
{
struct mem_header *memScanP;
- for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
+ if (!ckallocInit) {
+ TclInitDbCkalloc();
+ }
+ Tcl_MutexLock(ckallocMutexPtr);
+ for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
ValidateMemory(memScanP, file, line, FALSE);
-
+ }
+ Tcl_MutexUnlock(ckallocMutexPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_DumpActiveMemory --
- * Displays all allocated memory to stderr.
+ *
+ * Displays all allocated memory to a file; if no filename is given,
+ * information will be written to stderr.
*
* Results:
- * Return TCL_ERROR if an error accessing the file occures, `errno'
- * will have the file error number left in it.
+ * Return TCL_ERROR if an error accessing the file occures, `errno'
+ * will have the file error number left in it.
*----------------------------------------------------------------------
*/
int
Tcl_DumpActiveMemory (fileName)
- char *fileName;
+ char *fileName; /* Name of the file to write info to */
{
FILE *fileP;
struct mem_header *memScanP;
char *address;
- fileP = fopen(fileName, "w");
- if (fileP == NULL)
- return TCL_ERROR;
+ if (fileName == NULL) {
+ fileP = stderr;
+ } else {
+ fileP = fopen(fileName, "w");
+ if (fileP == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
address = &memScanP->body [0];
fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
@@ -259,7 +335,11 @@ Tcl_DumpActiveMemory (fileName)
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
}
- fclose (fileP);
+ Tcl_MutexUnlock(ckallocMutexPtr);
+
+ if (fileP != stderr) {
+ fclose (fileP);
+ }
return TCL_OK;
}
@@ -297,8 +377,7 @@ Tcl_DbCkalloc(size, file, line)
if (result == NULL) {
fflush(stdout);
TclDumpMemoryInfo(stderr);
- panic("unable to alloc %d bytes, %s line %d", size, file,
- line);
+ panic("unable to alloc %d bytes, %s line %d", size, file, line);
}
/*
@@ -313,6 +392,10 @@ Tcl_DbCkalloc(size, file, line)
memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
}
+ if (!ckallocInit) {
+ TclInitDbCkalloc();
+ }
+ Tcl_MutexLock(ckallocMutexPtr);
result->length = size;
result->tagPtr = curTagPtr;
if (curTagPtr != NULL) {
@@ -322,6 +405,7 @@ Tcl_DbCkalloc(size, file, line)
result->line = line;
result->flink = allocHead;
result->blink = NULL;
+
if (allocHead != NULL)
allocHead->blink = result;
allocHead = result;
@@ -357,6 +441,8 @@ Tcl_DbCkalloc(size, file, line)
if (current_bytes_malloced > maximum_bytes_malloced)
maximum_bytes_malloced = current_bytes_malloced;
+ Tcl_MutexUnlock(ckallocMutexPtr);
+
return result->body;
}
@@ -381,10 +467,16 @@ Tcl_DbCkalloc(size, file, line)
int
Tcl_DbCkfree(ptr, file, line)
- char * ptr;
- char *file;
- int line;
+ char *ptr;
+ char *file;
+ int line;
{
+ struct mem_header *memp;
+
+ if (ptr == NULL) {
+ return 0;
+ }
+
/*
* The following cast is *very* tricky. Must convert the pointer
* to an integer before doing arithmetic on it, because otherwise
@@ -393,16 +485,18 @@ Tcl_DbCkfree(ptr, file, line)
* even though BODY_OFFSET is in words on these machines).
*/
- struct mem_header *memp = (struct mem_header *)
- (((unsigned long) ptr) - BODY_OFFSET);
+ memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
- if (alloc_tracing)
+ if (alloc_tracing) {
fprintf(stderr, "ckfree %lx %ld %s %d\n",
(long unsigned int) memp->body, memp->length, file, line);
+ }
- if (validate_memory)
+ if (validate_memory) {
Tcl_ValidateAllMemory(file, line);
+ }
+ Tcl_MutexLock(ckallocMutexPtr);
ValidateMemory(memp, file, line, TRUE);
if (init_malloced_bodies) {
memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
@@ -429,6 +523,8 @@ Tcl_DbCkfree(ptr, file, line)
if (allocHead == memp)
allocHead = memp->flink;
TclpFree((char *) memp);
+ Tcl_MutexUnlock(ckallocMutexPtr);
+
return 0;
}
@@ -453,14 +549,18 @@ Tcl_DbCkrealloc(ptr, size, file, line)
{
char *new;
unsigned int copySize;
+ struct mem_header *memp;
+
+ if (ptr == NULL) {
+ return Tcl_DbCkalloc(size, file, line);
+ }
/*
* See comment from Tcl_DbCkfree before you change the following
* line.
*/
- struct mem_header *memp = (struct mem_header *)
- (((unsigned long) ptr) - BODY_OFFSET);
+ memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
copySize = size;
if (copySize > (unsigned int) memp->length) {
@@ -469,7 +569,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
new = Tcl_DbCkalloc(size, file, line);
memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
Tcl_DbCkfree(ptr, file, line);
- return(new);
+ return new;
}
@@ -520,13 +620,14 @@ Tcl_Realloc(ptr, size)
*----------------------------------------------------------------------
*
* MemoryCmd --
- * Implements the TCL memory command:
- * memory info
- * memory display
- * break_on_malloc count
- * trace_on_at_malloc count
- * trace on|off
- * validate on|off
+ * Implements the Tcl "memory" command, which provides Tcl-level
+ * control of Tcl memory debugging information.
+ * memory info
+ * memory display
+ * memory break_on_malloc count
+ * memory trace_on_at_malloc count
+ * memory trace on|off
+ * memory validate on|off
*
* Results:
* Standard TCL results.
@@ -580,7 +681,14 @@ MemoryCmd (clientData, interp, argc, argv)
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
- TclDumpMemoryInfo(stdout);
+ char buffer[400];
+ sprintf(buffer, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
+ "total mallocs", total_mallocs, "total frees", total_frees,
+ "current packets allocated", current_malloc_packets,
+ "current bytes allocated", current_bytes_malloced,
+ "maximum packets allocated", maximum_malloc_packets,
+ "maximum bytes allocated", maximum_bytes_malloced);
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
return TCL_OK;
}
if (strcmp(argv[1],"init") == 0) {
@@ -648,20 +756,75 @@ bad_suboption:
/*
*----------------------------------------------------------------------
*
+ * CheckmemCmd --
+ *
+ * This is the command procedure for the "checkmem" command, which
+ * causes the application to exit after printing information about
+ * memory usage to the file passed to this command as its first
+ * argument.
+ *
+ * Results:
+ * Returns a standard Tcl completion code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckmemCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Interpreter for evaluation. */
+ int argc; /* Number of arguments. */
+ char *argv[]; /* String values of arguments. */
+{
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " fileName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tclMemDumpFileName = dumpFile;
+ strcpy(tclMemDumpFileName, argv[1]);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_InitMemory --
- * Initialize the memory command.
+ *
+ * Create the "memory" and "checkmem" commands in the given
+ * interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New commands are added to the interpreter.
*
*----------------------------------------------------------------------
*/
+
void
Tcl_InitMemory(interp)
- Tcl_Interp *interp;
+ Tcl_Interp *interp; /* Interpreter in which commands should be added */
{
+ TclInitDbCkalloc();
Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL,
(Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
}
-#else
+
+#else /* TCL_MEM_DEBUG */
+
+/* This is the !TCL_MEM_DEBUG case */
+
+#undef Tcl_InitMemory
+#undef Tcl_DumpActiveMemory
+#undef Tcl_ValidateAllMemory
/*
@@ -678,14 +841,22 @@ char *
Tcl_Alloc (size)
unsigned int size;
{
- char *result;
-
- result = TclpAlloc(size);
- /* CYGNUS LOCAL -- check that size is not zero */
- if (result == NULL && size )
- panic("unable to alloc %d bytes", size);
- /* End CYGNUS LOCAL */
- return result;
+ char *result;
+
+ result = TclpAlloc(size);
+ /*
+ * Most systems will not alloc(0), instead bumping it to one so
+ * that NULL isn't returned. Some systems (AIX, Tru64) will alloc(0)
+ * by returning NULL, so we have to check that the NULL we get is
+ * not in response to alloc(0).
+ *
+ * The ANSI spec actually says that systems either return NULL *or*
+ * a special pointer on failure, but we only check for NULL
+ */
+ if ((result == NULL) && size) {
+ panic("unable to alloc %d bytes", size);
+ }
+ return result;
}
char *
@@ -698,10 +869,9 @@ Tcl_DbCkalloc(size, file, line)
result = (char *) TclpAlloc(size);
- if (result == NULL) {
+ if ((result == NULL) && size) {
fflush(stdout);
- panic("unable to alloc %d bytes, %s line %d", size, file,
- line);
+ panic("unable to alloc %d bytes, %s line %d", size, file, line);
}
return result;
}
@@ -725,8 +895,10 @@ Tcl_Realloc(ptr, size)
char *result;
result = TclpRealloc(ptr, size);
- if (result == NULL)
+
+ if ((result == NULL) && size) {
panic("unable to realloc %d bytes", size);
+ }
return result;
}
@@ -741,10 +913,9 @@ Tcl_DbCkrealloc(ptr, size, file, line)
result = (char *) TclpRealloc(ptr, size);
- if (result == NULL) {
+ if ((result == NULL) && size) {
fflush(stdout);
- panic("unable to realloc %d bytes, %s line %d", size, file,
- line);
+ panic("unable to realloc %d bytes, %s line %d", size, file, line);
}
return result;
}
@@ -764,14 +935,14 @@ void
Tcl_Free (ptr)
char *ptr;
{
- TclpFree(ptr);
+ TclpFree(ptr);
}
int
Tcl_DbCkfree(ptr, file, line)
- char * ptr;
- char *file;
- int line;
+ char *ptr;
+ char *file;
+ int line;
{
TclpFree(ptr);
return 0;
@@ -793,13 +964,6 @@ Tcl_InitMemory(interp)
{
}
-#undef Tcl_DumpActiveMemory
-#undef Tcl_ValidateAllMemory
-
-extern int Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
-extern void Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
- int line));
-
int
Tcl_DumpActiveMemory(fileName)
char *fileName;
@@ -814,4 +978,51 @@ Tcl_ValidateAllMemory(file, line)
{
}
+void
+TclDumpMemoryInfo(outFile)
+ FILE *outFile;
+{
+}
+
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFinalizeMemorySubsystem --
+ *
+ * This procedure is called to finalize all the structures that
+ * are used by the memory allocator on a per-process basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This subsystem is self-initializing, since memory can be
+ * allocated before Tcl is formally initialized. After this call,
+ * this subsystem has been reset to its initial state and is
+ * usable again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclFinalizeMemorySubsystem()
+{
+#ifdef TCL_MEM_DEBUG
+ Tcl_MutexLock(ckallocMutexPtr);
+ if (tclMemDumpFileName != NULL) {
+ Tcl_DumpActiveMemory(tclMemDumpFileName);
+ }
+ if (curTagPtr != NULL) {
+ TclpFree((char *) curTagPtr);
+ }
+ allocHead = NULL;
+ Tcl_MutexUnlock(ckallocMutexPtr);
#endif
+
+#if USE_TCLALLOC
+ TclFinalizeAllocSubsystem();
+#endif
+}
+
diff --git a/tcl/generic/tclClock.c b/tcl/generic/tclClock.c
index 29ed3560539..ed79949feaa 100644
--- a/tcl/generic/tclClock.c
+++ b/tcl/generic/tclClock.c
@@ -19,6 +19,12 @@
#include "tclPort.h"
/*
+ * The date parsing stuff uses lexx and has tons o statics.
+ */
+
+TCL_DECLARE_MUTEX(clockMutex)
+
+/*
* Function prototypes for local procedures in this file:
*/
@@ -62,7 +68,10 @@ Tcl_ClockObjCmd (client, interp, objc, objv)
char *scanStr;
static char *switches[] =
- {"clicks", "format", "scan", "seconds", (char *) NULL};
+ {"clicks", "format", "scan", "seconds", (char *) NULL};
+ enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN,
+ COMMAND_SECONDS
+ };
static char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
static char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
@@ -76,15 +85,40 @@ Tcl_ClockObjCmd (client, interp, objc, objv)
!= TCL_OK) {
return TCL_ERROR;
}
- switch (index) {
- case 0: /* clicks */
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ switch ((enum command) index) {
+ case COMMAND_CLICKS: { /* clicks */
+ int forceMilli = 0;
+
+ if (objc == 3) {
+ format = Tcl_GetStringFromObj(objv[2], &index);
+ if (strncmp(format, "-milliseconds",
+ (unsigned int) index) == 0) {
+ forceMilli = 1;
+ } else {
+ Tcl_AppendStringsToObj(resultPtr,
+ "bad switch \"", format,
+ "\": must be -milliseconds", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-milliseconds?");
return TCL_ERROR;
}
- Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
+ if (forceMilli) {
+ /*
+ * We can enforce at least millisecond granularity
+ */
+ Tcl_Time time;
+ TclpGetTime(&time);
+ Tcl_SetLongObj(resultPtr,
+ (long) (time.sec*1000 + time.usec/1000));
+ } else {
+ Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
+ }
return TCL_OK;
- case 1: /* format */
+ }
+
+ case COMMAND_FORMAT: /* format */
if ((objc < 3) || (objc > 7)) {
wrongFmtArgs:
Tcl_WrongNumArgs(interp, 2, objv,
@@ -123,7 +157,8 @@ Tcl_ClockObjCmd (client, interp, objc, objv)
}
return FormatClock(interp, (unsigned long) clockVal, useGMT,
format);
- case 2: /* scan */
+
+ case COMMAND_SCAN: /* scan */
if ((objc < 3) || (objc > 7)) {
wrongScanArgs:
Tcl_WrongNumArgs(interp, 2, objv,
@@ -172,17 +207,21 @@ Tcl_ClockObjCmd (client, interp, objc, objv)
}
scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
+ Tcl_MutexLock(&clockMutex);
if (TclGetDate(scanStr, (unsigned long) baseClock, zone,
(unsigned long *) &clockVal) < 0) {
+ Tcl_MutexUnlock(&clockMutex);
Tcl_AppendStringsToObj(resultPtr,
"unable to convert date-time string \"",
scanStr, "\"", (char *) NULL);
return TCL_ERROR;
}
+ Tcl_MutexUnlock(&clockMutex);
Tcl_SetLongObj(resultPtr, (long) clockVal);
return TCL_OK;
- case 3: /* seconds */
+
+ case COMMAND_SECONDS: /* seconds */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
@@ -219,34 +258,44 @@ FormatClock(interp, clockVal, useGMT, format)
char *format; /* Format string */
{
struct tm *timeDataPtr;
- Tcl_DString buffer;
+ Tcl_DString buffer, uniBuffer;
int bufSize;
char *p;
-#ifdef TCL_USE_TIMEZONE_VAR
- int savedTimeZone;
- char *savedTZEnv;
+ int result;
+ time_t tclockVal;
+#ifndef HAVE_TM_ZONE
+ int savedTimeZone = 0; /* lint. */
+ char *savedTZEnv = NULL; /* lint. */
#endif
- Tcl_Obj *resultPtr;
- resultPtr = Tcl_GetObjResult(interp);
#ifdef HAVE_TZSET
/*
* Some systems forgot to call tzset in localtime, make sure its done.
*/
static int calledTzset = 0;
+ Tcl_MutexLock(&clockMutex);
if (!calledTzset) {
tzset();
calledTzset = 1;
}
+ Tcl_MutexUnlock(&clockMutex);
#endif
-#ifdef TCL_USE_TIMEZONE_VAR
/*
- * This is a horrible kludge for systems not having the timezone in
- * struct tm. No matter what was specified, they use the global time
- * zone. (Thanks Solaris).
+ * If the user gave us -format "", just return now
+ */
+ if (*format == '\0') {
+ return TCL_OK;
+ }
+
+#ifndef HAVE_TM_ZONE
+ /*
+ * This is a kludge for systems not having the timezone string in
+ * struct tm. No matter what was specified, they use the local
+ * timezone string.
*/
+
if (useGMT) {
char *varValue;
@@ -263,7 +312,8 @@ FormatClock(interp, clockVal, useGMT, format)
}
#endif
- timeDataPtr = TclpGetDate((time_t *) &clockVal, useGMT);
+ tclockVal = clockVal;
+ timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);
/*
* Make a guess at the upper limit on the substituted string size
@@ -280,14 +330,12 @@ FormatClock(interp, clockVal, useGMT, format)
Tcl_DStringInit(&buffer);
Tcl_DStringSetLength(&buffer, bufSize);
- if ((TclStrftime(buffer.string, (unsigned int) bufSize, format,
- timeDataPtr) == 0) && (*format != '\0')) {
- Tcl_AppendStringsToObj(resultPtr, "bad format string \"",
- format, "\"", (char *) NULL);
- return TCL_ERROR;
- }
+ Tcl_MutexLock(&clockMutex);
+ result = TclpStrftime(buffer.string, (unsigned int) bufSize, format,
+ timeDataPtr);
+ Tcl_MutexUnlock(&clockMutex);
-#ifdef TCL_USE_TIMEZONE_VAR
+#ifndef HAVE_TM_ZONE
if (useGMT) {
if (savedTZEnv != NULL) {
Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
@@ -300,8 +348,30 @@ FormatClock(interp, clockVal, useGMT, format)
}
#endif
- Tcl_SetStringObj(resultPtr, buffer.string, -1);
+ if (result == 0) {
+ /*
+ * A zero return is the error case (can also mean the strftime
+ * didn't get enough space to write into). We know it doesn't
+ * mean that we wrote zero chars because the check for an empty
+ * format string is above.
+ */
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad format string \"", format, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Convert the time to external encoding, in case we asked for
+ * a localized return value. [Bug: 3345]
+ */
+ Tcl_DStringInit(&uniBuffer);
+ Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer);
+
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), uniBuffer.string, -1);
+
+ Tcl_DStringFree(&uniBuffer);
Tcl_DStringFree(&buffer);
return TCL_OK;
}
+
diff --git a/tcl/generic/tclCmdAH.c b/tcl/generic/tclCmdAH.c
index 4382b508220..7788917ef99 100644
--- a/tcl/generic/tclCmdAH.c
+++ b/tcl/generic/tclCmdAH.c
@@ -16,19 +16,31 @@
#include "tclInt.h"
#include "tclPort.h"
+#include <locale.h>
+
+typedef int (StatProc)_ANSI_ARGS_((CONST char *path, struct stat *buf));
/*
* Prototypes for local procedures defined in this file:
*/
+static int CheckAccess _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int mode));
+static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, StatProc *statProc,
+ struct stat *statPtr));
static char * GetTypeFromMode _ANSI_ARGS_((int mode));
+static int SplitPath _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int *argcPtr, char ***argvPtr));
static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
char *varName, struct stat *statPtr));
+static char ** StringifyObjects _ANSI_ARGS_((int objc,
+ Tcl_Obj *CONST objv[]));
/*
*----------------------------------------------------------------------
*
- * Tcl_BreakCmd --
+ * Tcl_BreakObjCmd --
*
* This procedure is invoked to process the "break" Tcl command.
* See the user documentation for details on what it does.
@@ -48,15 +60,14 @@ static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
/* ARGSUSED */
int
-Tcl_BreakCmd(dummy, interp, argc, argv)
+Tcl_BreakObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- if (argc != 1) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], "\"", (char *) NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
return TCL_BREAK;
@@ -90,7 +101,7 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
register int i;
int body, result;
char *string, *arg;
- int argLen, caseObjc;
+ int caseObjc;
Tcl_Obj *CONST *caseObjv;
Tcl_Obj *armPtr;
@@ -100,14 +111,10 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- string = Tcl_GetStringFromObj(objv[1], &argLen);
+ string = Tcl_GetString(objv[1]);
body = -1;
- arg = Tcl_GetStringFromObj(objv[2], &argLen);
+ arg = Tcl_GetString(objv[2]);
if (strcmp(arg, "in") == 0) {
i = 3;
} else {
@@ -119,7 +126,6 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
/*
* If all of the pattern/command pairs are lumped into a single
* argument, split them out again.
- * THIS FAILS IF THE ARG'S STRING REP CONTAINS A NULL
*/
if (caseObjc == 1) {
@@ -133,9 +139,9 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
int patObjc, j;
char **patObjv;
char *pat;
- register char *p;
+ unsigned char *p;
- if (i == (caseObjc-1)) {
+ if (i == (caseObjc - 1)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"extra case pattern with no body", -1);
@@ -147,18 +153,18 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
* no backslash sequences.
*/
- pat = Tcl_GetStringFromObj(caseObjv[i], &argLen);
- for (p = pat; *p != 0; p++) { /* FAILS IF NULL BYTE */
- if (isspace(UCHAR(*p)) || (*p == '\\')) {
+ pat = Tcl_GetString(caseObjv[i]);
+ for (p = (unsigned char *) pat; *p != '\0'; p++) {
+ if (isspace(*p) || (*p == '\\')) { /* INTL: ISO space, UCHAR */
break;
}
}
- if (*p == 0) {
+ if (*p == '\0') {
if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
- body = i+1;
+ body = i + 1;
}
if (Tcl_StringMatch(string, pat)) {
- body = i+1;
+ body = i + 1;
goto match;
}
continue;
@@ -176,7 +182,7 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
}
for (j = 0; j < patObjc; j++) {
if (Tcl_StringMatch(string, patObjv[j])) {
- body = i+1;
+ body = i + 1;
break;
}
}
@@ -188,13 +194,14 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
match:
if (body != -1) {
- armPtr = caseObjv[body-1];
- result = Tcl_EvalObj(interp, caseObjv[body]);
+ armPtr = caseObjv[body - 1];
+ result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
if (result == TCL_ERROR) {
- char msg[100];
+ char msg[100 + TCL_INTEGER_SPACE];
- arg = Tcl_GetStringFromObj(armPtr, &argLen);
- sprintf(msg, "\n (\"%.*s\" arm line %d)", argLen, arg,
+ arg = Tcl_GetString(armPtr);
+ sprintf(msg,
+ "\n (\"%.50s\" arm line %d)", arg,
interp->errorLine);
Tcl_AddObjErrorInfo(interp, msg, -1);
}
@@ -250,12 +257,12 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
if (objc == 3) {
varNamePtr = objv[2];
}
-
- result = Tcl_EvalObj(interp, objv[1]);
+
+ result = Tcl_EvalObjEx(interp, objv[1], 0);
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, varNamePtr, NULL,
- Tcl_GetObjResult(interp), TCL_PARSE_PART1) == NULL) {
+ Tcl_GetObjResult(interp), 0) == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"couldn't save command result in variable", -1);
@@ -301,27 +308,32 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
char *dirName;
- int dirLength;
- Tcl_DString buffer;
+ Tcl_DString ds;
int result;
if (objc > 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "dirName");
+ Tcl_WrongNumArgs(interp, 1, objv, "?dirName?");
return TCL_ERROR;
}
if (objc == 2) {
- dirName = Tcl_GetStringFromObj(objv[1], &dirLength);
+ dirName = Tcl_GetString(objv[1]);
} else {
dirName = "~";
}
- dirName = Tcl_TranslateFileName(interp, dirName, &buffer);
- if (dirName == NULL) {
+ if (Tcl_TranslateFileName(interp, dirName, &ds) == NULL) {
return TCL_ERROR;
}
- result = TclChdir(interp, dirName);
- Tcl_DStringFree(&buffer);
- return result;
+
+ result = Tcl_Chdir(Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "couldn't change working directory to \"",
+ dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
}
/*
@@ -330,7 +342,7 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
* Tcl_ConcatObjCmd --
*
* This object-based procedure is invoked to process the "concat" Tcl
- * command. See the user documentation for details on what it does/
+ * command. See the user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -358,7 +370,7 @@ Tcl_ConcatObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * Tcl_ContinueCmd -
+ * Tcl_ContinueObjCmd -
*
* This procedure is invoked to process the "continue" Tcl command.
* See the user documentation for details on what it does.
@@ -378,15 +390,14 @@ Tcl_ConcatObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ContinueCmd(dummy, interp, argc, argv)
+Tcl_ContinueObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- if (argc != 1) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\"", (char *) NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
return TCL_CONTINUE;
@@ -395,6 +406,131 @@ Tcl_ContinueCmd(dummy, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
+ * Tcl_EncodingObjCmd --
+ *
+ * This command manipulates encodings.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EncodingObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int index, length;
+ Tcl_Encoding encoding;
+ char *string;
+ Tcl_DString ds;
+ Tcl_Obj *resultPtr;
+
+ static char *optionStrings[] = {
+ "convertfrom", "convertto", "names", "system",
+ NULL
+ };
+ enum options {
+ ENC_CONVERTFROM, ENC_CONVERTTO, ENC_NAMES, ENC_SYSTEM
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case ENC_CONVERTTO:
+ case ENC_CONVERTFROM: {
+ char *name;
+ Tcl_Obj *data;
+ if (objc == 3) {
+ name = NULL;
+ data = objv[2];
+ } else if (objc == 4) {
+ name = Tcl_GetString(objv[2]);
+ data = objv[3];
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
+ return TCL_ERROR;
+ }
+
+ encoding = Tcl_GetEncoding(interp, name);
+ if (!encoding) {
+ return TCL_ERROR;
+ }
+
+ if ((enum options) index == ENC_CONVERTFROM) {
+ /*
+ * Treat the string as binary data.
+ */
+
+ string = (char *) Tcl_GetByteArrayFromObj(data, &length);
+ Tcl_ExternalToUtfDString(encoding, string, length, &ds);
+
+ /*
+ * Note that we cannot use Tcl_DStringResult here because
+ * it will truncate the string at the first null byte.
+ */
+
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ } else {
+ /*
+ * Store the result as binary data.
+ */
+
+ string = Tcl_GetStringFromObj(data, &length);
+ Tcl_UtfToExternalDString(encoding, string, length, &ds);
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_SetByteArrayObj(resultPtr,
+ (unsigned char *) Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
+
+ Tcl_FreeEncoding(encoding);
+ break;
+ }
+ case ENC_NAMES: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ Tcl_GetEncodingNames(interp);
+ break;
+ }
+ case ENC_SYSTEM: {
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ Tcl_SetResult(interp, Tcl_GetEncodingName(NULL), TCL_STATIC);
+ } else {
+ return Tcl_SetSystemEncoding(interp,
+ Tcl_GetStringFromObj(objv[2], NULL));
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ErrorObjCmd --
*
* This procedure is invoked to process the "error" Tcl command.
@@ -418,7 +554,6 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- register Tcl_Obj *namePtr;
char *info;
int infoLen;
@@ -436,11 +571,8 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv)
}
if (objc == 4) {
- namePtr = Tcl_NewStringObj("errorCode", -1);
- Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, objv[3],
- TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex(interp, "errorCode", NULL, objv[3], TCL_GLOBAL_ONLY);
iPtr->flags |= ERROR_CODE_SET;
- Tcl_DecrRefCount(namePtr); /* we're done with name object */
}
Tcl_SetObjResult(interp, objv[1]);
@@ -481,19 +613,19 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
}
if (objc == 2) {
- result = Tcl_EvalObj(interp, objv[1]);
+ result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT);
} else {
/*
* More than one argument: concatenate them together with spaces
- * between, then evaluate the result.
+ * between, then evaluate the result. Tcl_EvalObjEx will delete
+ * the object when it decrements its refcount after eval'ing it.
*/
-
- objPtr = Tcl_ConcatObj(objc-1, objv+1);
- result = Tcl_EvalObj(interp, objPtr);
- Tcl_DecrRefCount(objPtr); /* we're done with the object */
+ objPtr = Tcl_ConcatObj(objc-1, objv+1);
+ result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
- char msg[60];
+ char msg[32 + TCL_INTEGER_SPACE];
+
sprintf(msg, "\n (\"eval\" body line %d)", interp->errorLine);
Tcl_AddObjErrorInfo(interp, msg, -1);
}
@@ -573,7 +705,7 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv)
Tcl_Interp *interp; /* Current interpreter. */
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
+{
register Tcl_Obj *objPtr;
Tcl_Obj *resultPtr;
register char *bytes;
@@ -595,7 +727,6 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv)
/*
* Create a new object holding the concatenated argument strings.
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
*/
bytes = Tcl_GetStringFromObj(objv[1], &length);
@@ -652,103 +783,124 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *fileName, *extension, *errorString;
- int statOp = 0; /* Init. to avoid compiler warning. */
- int length;
- int mode = 0; /* Initialized only to prevent
- * compiler warning message. */
- struct stat statBuf;
- Tcl_DString buffer;
Tcl_Obj *resultPtr;
- int index, result;
+ int index;
/*
* This list of constants should match the fileOption string array below.
*/
-enum {FILE_ATIME, FILE_ATTRIBUTES, FILE_COPY, FILE_DELETE, FILE_DIRNAME,
- FILE_EXECUTABLE, FILE_EXISTS, FILE_EXTENSION, FILE_ISDIRECTORY,
- FILE_ISFILE, FILE_JOIN, FILE_LSTAT, FILE_MTIME, FILE_MKDIR,
- FILE_NATIVENAME, FILE_OWNED, FILE_PATHTYPE, FILE_READABLE,
- FILE_READLINK, FILE_RENAME, FILE_ROOTNAME, FILE_SIZE, FILE_SPLIT,
- FILE_STAT, FILE_TAIL, FILE_TYPE, FILE_VOLUMES, FILE_WRITABLE};
-
-
- static char *fileOptions[] = {"atime", "attributes", "copy", "delete",
- "dirname", "executable", "exists", "extension", "isdirectory",
- "isfile", "join", "lstat", "mtime", "mkdir", "nativename",
- "owned", "pathtype", "readable", "readlink", "rename",
- "rootname", "size", "split", "stat", "tail", "type", "volumes",
- "writable", (char *) NULL};
+ static char *fileOptions[] = {
+ "atime", "attributes", "channels", "copy",
+ "delete",
+ "dirname", "executable", "exists", "extension",
+ "isdirectory", "isfile", "join", "lstat",
+ "mtime", "mkdir", "nativename", "owned",
+ "pathtype", "readable", "readlink", "rename",
+ "rootname", "size", "split", "stat",
+ "tail", "type", "volumes", "writable",
+ (char *) NULL
+ };
+ enum options {
+ FILE_ATIME, FILE_ATTRIBUTES, FILE_CHANNELS, FILE_COPY,
+ FILE_DELETE,
+ FILE_DIRNAME, FILE_EXECUTABLE, FILE_EXISTS, FILE_EXTENSION,
+ FILE_ISDIRECTORY, FILE_ISFILE, FILE_JOIN, FILE_LSTAT,
+ FILE_MTIME, FILE_MKDIR, FILE_NATIVENAME, FILE_OWNED,
+ FILE_PATHTYPE, FILE_READABLE, FILE_READLINK, FILE_RENAME,
+ FILE_ROOTNAME, FILE_SIZE, FILE_SPLIT, FILE_STAT,
+ FILE_TAIL, FILE_TYPE, FILE_VOLUMES, FILE_WRITABLE
+ };
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
-
- if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0, &index)
- != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
-
- result = TCL_OK;
- /*
- * First, do the volumes command, since it is the only one that
- * has objc == 2.
- */
-
- if ( index == FILE_VOLUMES) {
- if ( objc != 2 ) {
- Tcl_WrongNumArgs(interp, 1, objv, "volumes");
- return TCL_ERROR;
- }
- result = TclpListVolumes(interp);
- return result;
- }
-
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ?arg ...?");
- return TCL_ERROR;
- }
- Tcl_DStringInit(&buffer);
resultPtr = Tcl_GetObjResult(interp);
-
-
- /*
- * Handle operations on the file name.
- */
-
- switch (index) {
- case FILE_ATTRIBUTES:
- result = TclFileAttrsCmd(interp, objc - 2, objv + 2);
- goto done;
- case FILE_DIRNAME: {
- int pargc;
- char **pargv;
+ switch ((enum options) index) {
+ case FILE_ATIME: {
+ struct stat buf;
+ char *fileName;
+ struct utimbuf tval;
- if (objc != 3) {
- errorString = "dirname name";
- goto not3Args;
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ if (Tcl_GetLongFromObj(interp, objv[3],
+ (long*)(&buf.st_atime)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tval.actime = buf.st_atime;
+ tval.modtime = buf.st_mtime;
+ fileName = Tcl_GetString(objv[2]);
+ if (utime(fileName, &tval) != 0) {
+ Tcl_AppendStringsToObj(resultPtr,
+ "could not set access time for file \"",
+ fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ /*
+ * Do another stat to ensure that the we return the
+ * new recognized atime - hopefully the same as the
+ * one we sent in. However, fs's like FAT don't
+ * even know what atime is.
+ */
+ if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetLongObj(resultPtr, (long) buf.st_atime);
+ return TCL_OK;
+ }
+ case FILE_ATTRIBUTES: {
+ return TclFileAttrsCmd(interp, objc, objv);
+ }
+ case FILE_CHANNELS: {
+ if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+ return TCL_ERROR;
}
+ return Tcl_GetChannelNamesEx(interp,
+ ((objc == 2) ? NULL : Tcl_GetString(objv[2])));
+ }
+ case FILE_COPY: {
+ int result;
+ char **argv;
- fileName = Tcl_GetStringFromObj(objv[2], &length);
+ argv = StringifyObjects(objc, objv);
+ result = TclFileCopyCmd(interp, objc, argv);
+ ckfree((char *) argv);
+ return result;
+ }
+ case FILE_DELETE: {
+ int result;
+ char **argv;
- /*
- * If there is only one element, and it starts with a tilde,
- * perform tilde substitution and resplit the path.
- */
+ argv = StringifyObjects(objc, objv);
+ result = TclFileDeleteCmd(interp, objc, argv);
+ ckfree((char *) argv);
+ return result;
+ }
+ case FILE_DIRNAME: {
+ int argc;
+ char **argv;
- Tcl_SplitPath(fileName, &pargc, &pargv);
- if ((pargc == 1) && (*fileName == '~')) {
- ckfree((char*) pargv);
- fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (fileName == NULL) {
- result = TCL_ERROR;
- goto done;
- }
- Tcl_SplitPath(fileName, &pargc, &pargv);
- Tcl_DStringSetLength(&buffer, 0);
+ if (objc != 3) {
+ goto only3Args;
+ }
+ if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
}
/*
@@ -757,324 +909,237 @@ enum {FILE_ATIME, FILE_ATTRIBUTES, FILE_COPY, FILE_DELETE, FILE_DIRNAME,
* return the current directory.
*/
- if (pargc > 1) {
- Tcl_JoinPath(pargc-1, pargv, &buffer);
- Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buffer),
- buffer.length);
- } else if ((pargc == 0)
- || (Tcl_GetPathType(pargv[0]) == TCL_PATH_RELATIVE)) {
- Tcl_SetStringObj(resultPtr, (tclPlatform == TCL_PLATFORM_MAC)
- ? ":" : ".", 1);
+ if (argc > 1) {
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_JoinPath(argc - 1, argv, &ds);
+ Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ } else if ((argc == 0)
+ || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
+ Tcl_SetStringObj(resultPtr,
+ ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1);
} else {
- Tcl_SetStringObj(resultPtr, pargv[0], -1); }
- ckfree((char *)pargv);
- goto done;
+ Tcl_SetStringObj(resultPtr, argv[0], -1);
+ }
+ ckfree((char *) argv);
+ return TCL_OK;
}
- case FILE_TAIL: {
- int pargc;
- char **pargv;
-
+ case FILE_EXECUTABLE: {
if (objc != 3) {
- errorString = "tail name";
- goto not3Args;
- }
-
- fileName = Tcl_GetStringFromObj(objv[2], &length);
-
- /*
- * If there is only one element, and it starts with a tilde,
- * perform tilde substitution and resplit the path.
- */
-
- Tcl_SplitPath(fileName, &pargc, &pargv);
- if ((pargc == 1) && (*fileName == '~')) {
- ckfree((char*) pargv);
- fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (fileName == NULL) {
- result = TCL_ERROR;
- goto done;
- }
- Tcl_SplitPath(fileName, &pargc, &pargv);
- Tcl_DStringSetLength(&buffer, 0);
+ goto only3Args;
}
-
- /*
- * Return the last component, unless it is the only component,
- * and it is the root of an absolute path.
- */
-
- if (pargc > 0) {
- if ((pargc > 1)
- || (Tcl_GetPathType(pargv[0]) == TCL_PATH_RELATIVE)) {
- Tcl_SetStringObj(resultPtr, pargv[pargc - 1], -1);
- }
- }
- ckfree((char *)pargv);
- goto done;
+ return CheckAccess(interp, objv[2], X_OK);
}
- case FILE_ROOTNAME: {
- char *fileName;
-
+ case FILE_EXISTS: {
if (objc != 3) {
- errorString = "rootname name";
- goto not3Args;
- }
-
- fileName = Tcl_GetStringFromObj(objv[2], &length);
- extension = TclGetExtension(fileName);
- if (extension == NULL) {
- Tcl_SetObjResult(interp, objv[2]);
- } else {
- Tcl_SetStringObj(resultPtr, fileName,
- (int) (length - strlen(extension)));
+ goto only3Args;
}
- goto done;
+ return CheckAccess(interp, objv[2], F_OK);
}
- case FILE_EXTENSION:
+ case FILE_EXTENSION: {
+ char *fileName, *extension;
if (objc != 3) {
- errorString = "extension name";
- goto not3Args;
+ goto only3Args;
}
- extension = TclGetExtension(Tcl_GetStringFromObj(objv[2],&length));
-
+ fileName = Tcl_GetString(objv[2]);
+ extension = TclGetExtension(fileName);
if (extension != NULL) {
- Tcl_SetStringObj(resultPtr, extension, (int)strlen(extension));
+ Tcl_SetStringObj(resultPtr, extension, -1);
}
- goto done;
- case FILE_PATHTYPE:
+ return TCL_OK;
+ }
+ case FILE_ISDIRECTORY: {
+ int value;
+ struct stat buf;
+
if (objc != 3) {
- errorString = "pathtype name";
- goto not3Args;
- }
- switch (Tcl_GetPathType(Tcl_GetStringFromObj(objv[2], &length))) {
- case TCL_PATH_ABSOLUTE:
- Tcl_SetStringObj(resultPtr, "absolute", -1);
- break;
- case TCL_PATH_RELATIVE:
- Tcl_SetStringObj(resultPtr, "relative", -1);
- break;
- case TCL_PATH_VOLUME_RELATIVE:
- Tcl_SetStringObj(resultPtr, "volumerelative", -1);
- break;
+ goto only3Args;
}
- goto done;
- case FILE_SPLIT: {
- int pargc, i;
- char **pargvList;
- Tcl_Obj *listObjPtr;
-
- if (objc != 3) {
- errorString = "split name";
- goto not3Args;
+ value = 0;
+ if (GetStatBuf(NULL, objv[2], TclStat, &buf) == TCL_OK) {
+ value = S_ISDIR(buf.st_mode);
}
-
- Tcl_SplitPath(Tcl_GetStringFromObj(objv[2], &length), &pargc,
- &pargvList);
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- for (i = 0; i < pargc; i++) {
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(pargvList[i], -1));
- }
- ckfree((char *) pargvList);
- Tcl_SetObjResult(interp, listObjPtr);
- goto done;
+ Tcl_SetBooleanObj(resultPtr, value);
+ return TCL_OK;
}
- case FILE_JOIN: {
- char **pargv = (char **) ckalloc((objc - 2) * sizeof(char *));
- int i;
+ case FILE_ISFILE: {
+ int value;
+ struct stat buf;
- for (i = 2; i < objc; i++) {
- pargv[i - 2] = Tcl_GetStringFromObj(objv[i], &length);
- }
- Tcl_JoinPath(objc - 2, pargv, &buffer);
- Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buffer),
- buffer.length);
- ckfree((char *) pargv);
- Tcl_DStringFree(&buffer);
- goto done;
- }
- case FILE_RENAME: {
- char **pargv = (char **) ckalloc(objc * sizeof(char *));
- int i;
-
- for (i = 0; i < objc; i++) {
- pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+ if (objc != 3) {
+ goto only3Args;
+ }
+ value = 0;
+ if (GetStatBuf(NULL, objv[2], TclStat, &buf) == TCL_OK) {
+ value = S_ISREG(buf.st_mode);
}
- result = TclFileRenameCmd(interp, objc, pargv);
- ckfree((char *) pargv);
- goto done;
+ Tcl_SetBooleanObj(resultPtr, value);
+ return TCL_OK;
}
- case FILE_MKDIR: {
- char **pargv = (char **) ckalloc(objc * sizeof(char *));
- int i;
-
- for (i = 0; i < objc; i++) {
- pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+ case FILE_JOIN: {
+ char **argv;
+ Tcl_DString ds;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
+ return TCL_ERROR;
}
- result = TclFileMakeDirsCmd(interp, objc, pargv);
- ckfree((char *) pargv);
- goto done;
+ argv = StringifyObjects(objc - 2, objv + 2);
+ Tcl_DStringInit(&ds);
+ Tcl_JoinPath(objc - 2, argv, &ds);
+ Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ ckfree((char *) argv);
+ return TCL_OK;
}
- case FILE_DELETE: {
- char **pargv = (char **) ckalloc(objc * sizeof(char *));
- int i;
-
- for (i = 0; i < objc; i++) {
- pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+ case FILE_LSTAT: {
+ char *varName;
+ struct stat buf;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name varName");
+ return TCL_ERROR;
+ }
+ if (GetStatBuf(interp, objv[2], TclpLstat, &buf) != TCL_OK) {
+ return TCL_ERROR;
}
- result = TclFileDeleteCmd(interp, objc, pargv);
- ckfree((char *) pargv);
- goto done;
+ varName = Tcl_GetString(objv[3]);
+ return StoreStatData(interp, varName, &buf);
}
- case FILE_COPY: {
- char **pargv = (char **) ckalloc(objc * sizeof(char *));
- int i;
-
- for (i = 0; i < objc; i++) {
- pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+ case FILE_MTIME: {
+ struct stat buf;
+ char *fileName;
+ struct utimbuf tval;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+ return TCL_ERROR;
}
- result = TclFileCopyCmd(interp, objc, pargv);
- ckfree((char *) pargv);
- goto done;
- }
- case FILE_NATIVENAME:
- fileName = Tcl_TranslateFileName(interp,
- Tcl_GetStringFromObj(objv[2], &length), &buffer);
- if (fileName == NULL) {
- result = TCL_ERROR ;
- } else {
- Tcl_SetStringObj(resultPtr, fileName, -1);
+ if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
}
- goto done;
- }
-
- /*
- * Next, handle operations that can be satisfied with the "access"
- * kernel call.
- */
-
- fileName = Tcl_TranslateFileName(interp,
- Tcl_GetStringFromObj(objv[2], &length), &buffer);
-
- switch (index) {
- case FILE_READABLE:
- if (objc != 3) {
- errorString = "readable name";
- goto not3Args;
+ if (objc == 4) {
+ if (Tcl_GetLongFromObj(interp, objv[3],
+ (long*)(&buf.st_mtime)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tval.actime = buf.st_atime;
+ tval.modtime = buf.st_mtime;
+ fileName = Tcl_GetString(objv[2]);
+ if (utime(fileName, &tval) != 0) {
+ Tcl_AppendStringsToObj(resultPtr,
+ "could not set modification time for file \"",
+ fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ /*
+ * Do another stat to ensure that the we return the
+ * new recognized atime - hopefully the same as the
+ * one we sent in. However, fs's like FAT don't
+ * even know what atime is.
+ */
+ if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
- mode = R_OK;
-checkAccess:
- /*
- * The result might have been set within Tcl_TranslateFileName
- * (like no such user "blah" for file exists ~blah)
- * but we don't want to flag an error in that case.
- */
- if (fileName == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
- } else {
- Tcl_SetBooleanObj(resultPtr, (TclAccess(fileName, mode) != -1));
+ Tcl_SetLongObj(resultPtr, (long) buf.st_mtime);
+ return TCL_OK;
+ }
+ case FILE_MKDIR: {
+ char **argv;
+ int result;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
+ return TCL_ERROR;
}
- goto done;
- case FILE_WRITABLE:
+ argv = StringifyObjects(objc, objv);
+ result = TclFileMakeDirsCmd(interp, objc, argv);
+ ckfree((char *) argv);
+ return result;
+ }
+ case FILE_NATIVENAME: {
+ char *fileName;
+ Tcl_DString ds;
+
if (objc != 3) {
- errorString = "writable name";
- goto not3Args;
+ goto only3Args;
}
- mode = W_OK;
- goto checkAccess;
- case FILE_EXECUTABLE:
- if (objc != 3) {
- errorString = "executable name";
- goto not3Args;
+ fileName = Tcl_GetString(objv[2]);
+ fileName = Tcl_TranslateFileName(interp, fileName, &ds);
+ if (fileName == NULL) {
+ return TCL_ERROR;
}
- mode = X_OK;
- goto checkAccess;
- case FILE_EXISTS:
+ Tcl_SetStringObj(resultPtr, fileName, Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return TCL_OK;
+ }
+ case FILE_OWNED: {
+ int value;
+ struct stat buf;
+
if (objc != 3) {
- errorString = "exists name";
- goto not3Args;
+ goto only3Args;
}
- mode = F_OK;
- goto checkAccess;
- }
+ value = 0;
+ if (GetStatBuf(NULL, objv[2], TclStat, &buf) == TCL_OK) {
+ /*
+ * For Windows and Macintosh, there are no user ids
+ * associated with a file, so we always return 1.
+ */
-
- /*
- * Lastly, check stuff that requires the file to be stat-ed.
- */
+#if (defined(__WIN32__) || defined(MAC_TCL))
+ value = 1;
+#else
+ value = (geteuid() == buf.st_uid);
+#endif
+ }
+ Tcl_SetBooleanObj(resultPtr, value);
+ return TCL_OK;
+ }
+ case FILE_PATHTYPE: {
+ char *fileName;
- if (fileName == NULL) {
- result = TCL_ERROR;
- goto done;
- }
-
- switch (index) {
- case FILE_ATIME:
- if (objc != 3) {
- errorString = "atime name";
- goto not3Args;
- }
-
- if (TclStat(fileName, &statBuf) == -1) {
- goto badStat;
- }
- Tcl_SetLongObj(resultPtr, (long) statBuf.st_atime);
- goto done;
- case FILE_ISDIRECTORY:
- if (objc != 3) {
- errorString = "isdirectory name";
- goto not3Args;
- }
- statOp = 2;
- break;
- case FILE_ISFILE:
- if (objc != 3) {
- errorString = "isfile name";
- goto not3Args;
- }
- statOp = 1;
- break;
- case FILE_LSTAT:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "lstat name varName");
- result = TCL_ERROR;
- goto done;
- }
-
- if (lstat(fileName, &statBuf) == -1) {
- Tcl_AppendStringsToObj(resultPtr, "couldn't lstat \"",
- Tcl_GetStringFromObj(objv[2], &length), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- result = TCL_ERROR;
- goto done;
- }
- result = StoreStatData(interp, Tcl_GetStringFromObj(objv[3],
- &length), &statBuf);
- goto done;
- case FILE_MTIME:
if (objc != 3) {
- errorString = "mtime name";
- goto not3Args;
+ goto only3Args;
}
- if (TclStat(fileName, &statBuf) == -1) {
- goto badStat;
+ fileName = Tcl_GetString(objv[2]);
+ switch (Tcl_GetPathType(fileName)) {
+ case TCL_PATH_ABSOLUTE:
+ Tcl_SetStringObj(resultPtr, "absolute", -1);
+ break;
+ case TCL_PATH_RELATIVE:
+ Tcl_SetStringObj(resultPtr, "relative", -1);
+ break;
+ case TCL_PATH_VOLUME_RELATIVE:
+ Tcl_SetStringObj(resultPtr, "volumerelative", -1);
+ break;
}
- Tcl_SetLongObj(resultPtr, (long) statBuf.st_mtime);
- goto done;
- case FILE_OWNED:
+ return TCL_OK;
+ }
+ case FILE_READABLE: {
if (objc != 3) {
- errorString = "owned name";
- goto not3Args;
- }
- statOp = 0;
- break;
+ goto only3Args;
+ }
+ return CheckAccess(interp, objv[2], R_OK);
+ }
case FILE_READLINK: {
- char linkValue[MAXPATHLEN + 1];
- int linkLength;
+ char *fileName, *contents;
+ Tcl_DString name, link;
if (objc != 3) {
- errorString = "readlink name";
- goto not3Args;
+ goto only3Args;
+ }
+
+ fileName = Tcl_GetString(objv[2]);
+ fileName = Tcl_TranslateFileName(interp, fileName, &name);
+ if (fileName == NULL) {
+ return TCL_ERROR;
}
/*
@@ -1086,97 +1151,301 @@ checkAccess:
*/
#ifndef S_IFLNK
- linkLength = -1;
+ contents = NULL;
errno = EINVAL;
#else
- linkLength = readlink(fileName, linkValue, sizeof(linkValue) - 1);
+ contents = TclpReadlink(fileName, &link);
#endif /* S_IFLNK */
- if (linkLength == -1) {
- Tcl_AppendStringsToObj(resultPtr, "couldn't readlink \"",
- Tcl_GetStringFromObj(objv[2], &length), "\": ",
+
+ Tcl_DStringFree(&name);
+ if (contents == NULL) {
+ Tcl_AppendResult(interp, "could not readlink \"",
+ Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
- result = TCL_ERROR;
- goto done;
+ return TCL_ERROR;
}
- linkValue[linkLength] = 0;
- Tcl_SetStringObj(resultPtr, linkValue, linkLength);
- goto done;
+ Tcl_DStringResult(interp, &link);
+ return TCL_OK;
+ }
+ case FILE_RENAME: {
+ int result;
+ char **argv;
+
+ argv = StringifyObjects(objc, objv);
+ result = TclFileRenameCmd(interp, objc, argv);
+ ckfree((char *) argv);
+ return result;
}
- case FILE_SIZE:
+ case FILE_ROOTNAME: {
+ int length;
+ char *fileName, *extension;
+
if (objc != 3) {
- errorString = "size name";
- goto not3Args;
+ goto only3Args;
}
- if (TclStat(fileName, &statBuf) == -1) {
- goto badStat;
+ fileName = Tcl_GetStringFromObj(objv[2], &length);
+ extension = TclGetExtension(fileName);
+ if (extension == NULL) {
+ Tcl_SetObjResult(interp, objv[2]);
+ } else {
+ Tcl_SetStringObj(resultPtr, fileName,
+ (int) (length - strlen(extension)));
}
- Tcl_SetLongObj(resultPtr, (long) statBuf.st_size);
- goto done;
- case FILE_STAT:
+ return TCL_OK;
+ }
+ case FILE_SIZE: {
+ struct stat buf;
+
+ if (objc != 3) {
+ goto only3Args;
+ }
+ if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetLongObj(resultPtr, (long) buf.st_size);
+ return TCL_OK;
+ }
+ case FILE_SPLIT: {
+ int i, argc;
+ char **argv;
+ char *fileName;
+ Tcl_Obj *objPtr;
+
+ if (objc != 3) {
+ goto only3Args;
+ }
+ fileName = Tcl_GetString(objv[2]);
+ Tcl_SplitPath(fileName, &argc, &argv);
+ for (i = 0; i < argc; i++) {
+ objPtr = Tcl_NewStringObj(argv[i], -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ ckfree((char *) argv);
+ return TCL_OK;
+ }
+ case FILE_STAT: {
+ char *varName;
+ struct stat buf;
+
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
- result = TCL_ERROR;
- goto done;
+ return TCL_ERROR;
}
-
- if (TclStat(fileName, &statBuf) == -1) {
-badStat:
- Tcl_AppendStringsToObj(resultPtr, "couldn't stat \"",
- Tcl_GetStringFromObj(objv[2], &length),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
- result = TCL_ERROR;
- goto done;
+ if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
}
- result = StoreStatData(interp, Tcl_GetStringFromObj(objv[3],
- &length), &statBuf);
- goto done;
- case FILE_TYPE:
+ varName = Tcl_GetString(objv[3]);
+ return StoreStatData(interp, varName, &buf);
+ }
+ case FILE_TAIL: {
+ int argc;
+ char **argv;
+
if (objc != 3) {
- errorString = "type name";
- goto not3Args;
+ goto only3Args;
}
- if (lstat(fileName, &statBuf) == -1) {
- goto badStat;
+ if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
}
- errorString = GetTypeFromMode((int) statBuf.st_mode);
- Tcl_SetStringObj(resultPtr, errorString, -1);
- goto done;
- }
- if (TclStat(fileName, &statBuf) == -1) {
- Tcl_SetBooleanObj(resultPtr, 0);
- goto done;
- }
- switch (statOp) {
- case 0:
/*
- * For Windows and Macintosh, there are no user ids
- * associated with a file, so we always return 1.
+ * Return the last component, unless it is the only component,
+ * and it is the root of an absolute path.
*/
-#if (defined(__WIN32__) || defined(MAC_TCL))
- mode = 1;
-#else
- mode = (geteuid() == statBuf.st_uid);
-#endif
- break;
- case 1:
- mode = S_ISREG(statBuf.st_mode);
- break;
- case 2:
- mode = S_ISDIR(statBuf.st_mode);
- break;
+ if (argc > 0) {
+ if ((argc > 1)
+ || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
+ Tcl_SetStringObj(resultPtr, argv[argc - 1], -1);
+ }
+ }
+ ckfree((char *) argv);
+ return TCL_OK;
+ }
+ case FILE_TYPE: {
+ struct stat buf;
+
+ if (objc != 3) {
+ goto only3Args;
+ }
+ if (GetStatBuf(interp, objv[2], TclpLstat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetStringObj(resultPtr,
+ GetTypeFromMode((unsigned short) buf.st_mode), -1);
+ return TCL_OK;
+ }
+ case FILE_VOLUMES: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ return TclpListVolumes(interp);
+ }
+ case FILE_WRITABLE: {
+ if (objc != 3) {
+ goto only3Args;
+ }
+ return CheckAccess(interp, objv[2], W_OK);
+ }
}
- Tcl_SetBooleanObj(resultPtr, mode);
-done:
- Tcl_DStringFree(&buffer);
- return result;
+ only3Args:
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SplitPath --
+ *
+ * Utility procedure used by Tcl_FileObjCmd() to split a path.
+ * Differs from standard Tcl_SplitPath in its handling of home
+ * directories; Tcl_SplitPath preserves the "~" while this
+ * procedure computes the actual full path name.
+ *
+ * Results:
+ * The return value is TCL_OK if the path could be split, TCL_ERROR
+ * otherwise. If TCL_ERROR was returned, an error message is left
+ * in interp. If TCL_OK was returned, *argvPtr is set to a newly
+ * allocated array of strings that represent the individual
+ * directories in the specified path, and *argcPtr is filled with
+ * the length of that array.
+ *
+ * Side effects:
+ * Memory allocated. The caller must eventually free this memory
+ * by calling ckfree() on *argvPtr.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SplitPath(interp, objPtr, argcPtr, argvPtr)
+ Tcl_Interp *interp; /* Interp for error return. May be NULL. */
+ Tcl_Obj *objPtr; /* Path to be split. */
+ int *argcPtr; /* Filled with length of following array. */
+ char ***argvPtr; /* Filled with array of strings representing
+ * the elements of the specified path. */
+{
+ char *fileName;
+
+ fileName = Tcl_GetString(objPtr);
+
+ /*
+ * If there is only one element, and it starts with a tilde,
+ * perform tilde substitution and resplit the path.
+ */
+
+ Tcl_SplitPath(fileName, argcPtr, argvPtr);
+ if ((*argcPtr == 1) && (fileName[0] == '~')) {
+ Tcl_DString ds;
+
+ ckfree((char *) *argvPtr);
+ fileName = Tcl_TranslateFileName(interp, fileName, &ds);
+ if (fileName == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SplitPath(fileName, argcPtr, argvPtr);
+ Tcl_DStringFree(&ds);
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CheckAccess --
+ *
+ * Utility procedure used by Tcl_FileObjCmd() to query file
+ * attributes available through the access() system call.
+ *
+ * Results:
+ * Always returns TCL_OK. Sets interp's result to boolean true or
+ * false depending on whether the file has the specified attribute.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+CheckAccess(interp, objPtr, mode)
+ Tcl_Interp *interp; /* Interp for status return. Must not be
+ * NULL. */
+ Tcl_Obj *objPtr; /* Name of file to check. */
+ int mode; /* Attribute to check; passed as argument to
+ * access(). */
+{
+ int value;
+ char *fileName;
+ Tcl_DString ds;
+
+ fileName = Tcl_GetString(objPtr);
+ fileName = Tcl_TranslateFileName(interp, fileName, &ds);
+ if (fileName == NULL) {
+ value = 0;
+ } else {
+ value = (TclAccess(fileName, mode) == 0);
+ Tcl_DStringFree(&ds);
+ }
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetStatBuf --
+ *
+ * Utility procedure used by Tcl_FileObjCmd() to query file
+ * attributes available through the stat() or lstat() system call.
+ *
+ * Results:
+ * The return value is TCL_OK if the specified file exists and can
+ * be stat'ed, TCL_ERROR otherwise. If TCL_ERROR is returned, an
+ * error message is left in interp's result. If TCL_OK is returned,
+ * *statPtr is filled with information about the specified file.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetStatBuf(interp, objPtr, statProc, statPtr)
+ Tcl_Interp *interp; /* Interp for error return. May be NULL. */
+ Tcl_Obj *objPtr; /* Path name to examine. */
+ StatProc *statProc; /* Either stat() or lstat() depending on
+ * desired behavior. */
+ struct stat *statPtr; /* Filled with info about file obtained by
+ * calling (*statProc)(). */
+{
+ char *fileName;
+ Tcl_DString ds;
+ int status;
+
+ fileName = Tcl_GetString(objPtr);
+ fileName = Tcl_TranslateFileName(interp, fileName, &ds);
+ if (fileName == NULL) {
+ return TCL_ERROR;
+ }
-not3Args:
- Tcl_WrongNumArgs(interp, 1, objv, errorString);
- result = TCL_ERROR;
- goto done;
+ status = (*statProc)(Tcl_DStringValue(&ds), statPtr);
+ Tcl_DStringFree(&ds);
+
+ if (status < 0) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(objPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
}
/*
@@ -1190,7 +1459,7 @@ not3Args:
*
* Results:
* Returns a standard Tcl return value. If an error occurs then
- * a message is left in interp->result.
+ * a message is left in interp's result.
*
* Side effects:
* Elements of the associative array given by "varName" are modified.
@@ -1206,34 +1475,34 @@ StoreStatData(interp, varName, statPtr)
struct stat *statPtr; /* Pointer to buffer containing
* stat data to store in varName. */
{
- char string[30];
+ char string[TCL_INTEGER_SPACE];
- sprintf(string, "%ld", (long) statPtr->st_dev);
+ TclFormatInt(string, (long) statPtr->st_dev);
if (Tcl_SetVar2(interp, varName, "dev", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
}
- sprintf(string, "%ld", (long) statPtr->st_ino);
+ TclFormatInt(string, (long) statPtr->st_ino);
if (Tcl_SetVar2(interp, varName, "ino", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
}
- sprintf(string, "%ld", (long) statPtr->st_mode);
+ TclFormatInt(string, (unsigned short) statPtr->st_mode);
if (Tcl_SetVar2(interp, varName, "mode", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
}
- sprintf(string, "%ld", (long) statPtr->st_nlink);
+ TclFormatInt(string, (long) statPtr->st_nlink);
if (Tcl_SetVar2(interp, varName, "nlink", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
}
- sprintf(string, "%ld", (long) statPtr->st_uid);
+ TclFormatInt(string, (long) statPtr->st_uid);
if (Tcl_SetVar2(interp, varName, "uid", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
}
- sprintf(string, "%ld", (long) statPtr->st_gid);
+ TclFormatInt(string, (long) statPtr->st_gid);
if (Tcl_SetVar2(interp, varName, "gid", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
@@ -1243,24 +1512,24 @@ StoreStatData(interp, varName, statPtr)
== NULL) {
return TCL_ERROR;
}
- sprintf(string, "%ld", (long) statPtr->st_atime);
+ TclFormatInt(string, (long) statPtr->st_atime);
if (Tcl_SetVar2(interp, varName, "atime", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
}
- sprintf(string, "%ld", (long) statPtr->st_mtime);
+ TclFormatInt(string, (long) statPtr->st_mtime);
if (Tcl_SetVar2(interp, varName, "mtime", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
}
- sprintf(string, "%ld", (long) statPtr->st_ctime);
+ TclFormatInt(string, (long) statPtr->st_ctime);
if (Tcl_SetVar2(interp, varName, "ctime", string, TCL_LEAVE_ERR_MSG)
== NULL) {
return TCL_ERROR;
}
if (Tcl_SetVar2(interp, varName, "type",
- GetTypeFromMode((int) statPtr->st_mode), TCL_LEAVE_ERR_MSG)
- == NULL) {
+ GetTypeFromMode((unsigned short) statPtr->st_mode),
+ TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
return TCL_OK;
@@ -1312,7 +1581,7 @@ GetTypeFromMode(mode)
/*
*----------------------------------------------------------------------
*
- * Tcl_ForCmd --
+ * Tcl_ForObjCmd --
*
* This procedure is invoked to process the "for" Tcl command.
* See the user documentation for details on what it does.
@@ -1333,21 +1602,20 @@ GetTypeFromMode(mode)
/* ARGSUSED */
int
-Tcl_ForCmd(dummy, interp, argc, argv)
+Tcl_ForObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int result, value;
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " start test next command\"", (char *) NULL);
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
return TCL_ERROR;
}
- result = Tcl_Eval(interp, argv[1]);
+ result = Tcl_EvalObjEx(interp, objv[1], 0);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)");
@@ -1355,23 +1623,31 @@ Tcl_ForCmd(dummy, interp, argc, argv)
return result;
}
while (1) {
- result = Tcl_ExprBoolean(interp, argv[2], &value);
+ /*
+ * We need to reset the result before passing it off to
+ * Tcl_ExprBooleanObj. Otherwise, any error message will be appended
+ * to the result of the last evaluation.
+ */
+
+ Tcl_ResetResult(interp);
+ result = Tcl_ExprBooleanObj(interp, objv[2], &value);
if (result != TCL_OK) {
return result;
}
if (!value) {
break;
}
- result = Tcl_Eval(interp, argv[4]);
+ result = Tcl_EvalObjEx(interp, objv[4], 0);
if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
if (result == TCL_ERROR) {
- char msg[60];
+ char msg[32 + TCL_INTEGER_SPACE];
+
sprintf(msg, "\n (\"for\" body line %d)",interp->errorLine);
Tcl_AddErrorInfo(interp, msg);
}
break;
}
- result = Tcl_Eval(interp, argv[3]);
+ result = Tcl_EvalObjEx(interp, objv[3], 0);
if (result == TCL_BREAK) {
break;
} else if (result != TCL_OK) {
@@ -1490,7 +1766,6 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
/*
* Break up the value lists and variable lists into elements
- * THIS FAILS IF THE OBJECT'S STRING REP HAS A NULL BYTE.
*/
maxj = 0;
@@ -1562,8 +1837,8 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
valuePtr = Tcl_NewObj(); /* empty string */
isEmptyObj = 1;
}
- varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL,
- valuePtr, TCL_PARSE_PART1);
+ varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
+ NULL, valuePtr, 0);
if (varValuePtr == NULL) {
if (isEmptyObj) {
Tcl_DecrRefCount(valuePtr);
@@ -1571,8 +1846,7 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"couldn't set loop variable: \"",
- Tcl_GetStringFromObj(varvList[i][v], (int *) NULL),
- "\"", (char *) NULL);
+ Tcl_GetString(varvList[i][v]), "\"", (char *) NULL);
result = TCL_ERROR;
goto done;
}
@@ -1580,7 +1854,7 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
}
}
- result = Tcl_EvalObj(interp, bodyPtr);
+ result = Tcl_EvalObjEx(interp, bodyPtr, 0);
if (result != TCL_OK) {
if (result == TCL_CONTINUE) {
result = TCL_OK;
@@ -1588,7 +1862,8 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
result = TCL_OK;
break;
} else if (result == TCL_ERROR) {
- char msg[100];
+ char msg[32 + TCL_INTEGER_SPACE];
+
sprintf(msg, "\n (\"foreach\" body line %d)",
interp->errorLine);
Tcl_AddObjErrorInfo(interp, msg, -1);
@@ -1643,10 +1918,10 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- register char *format; /* Used to read characters from the format
+ char *format; /* Used to read characters from the format
* string. */
int formatLen; /* The length of the format string */
- char *endPtr; /* Points to the last char in format array */
+ char *endPtr; /* Points to the last char in format array */
char newFormat[40]; /* A new format specifier is generated here. */
int width; /* Field width from field specifier, or 0 if
* no width given. */
@@ -1666,8 +1941,10 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
* sprintf, according to the following
* definitions: */
# define INT_VALUE 0
-# define PTR_VALUE 1
-# define DOUBLE_VALUE 2
+# define CHAR_VALUE 1
+# define PTR_VALUE 2
+# define DOUBLE_VALUE 3
+# define STRING_VALUE 4
# define MAX_FLOAT_SIZE 320
Tcl_Obj *resultPtr; /* Where result is stored finally. */
@@ -1688,6 +1965,14 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
* seen. */
int useShort; /* Value to be printed is short (half word). */
char *end; /* Used to locate end of numerical fields. */
+ int stringLen = 0; /* Length of string in characters rather
+ * than bytes. Used for %s substitution. */
+ int gotMinus; /* Non-zero indicates that a minus flag has
+ * been seen in the current field. */
+ int gotPrecision; /* Non-zero indicates that a precision has
+ * been set for the current field. */
+ int gotZero; /* Non-zero indicates that a zero flag has
+ * been seen in the current field. */
/*
* This procedure is a bit nasty. The goal is to use sprintf to
@@ -1695,7 +1980,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
* 1. this procedure can't trust its arguments.
* 2. we must be able to provide a large enough result area to hold
* whatever's generated. This is hard to estimate.
- * 2. there's no way to move the arguments from objv to the call
+ * 3. there's no way to move the arguments from objv to the call
* to sprintf in a reasonable way. This is particularly nasty
* because some of the arguments may be two-word values (doubles).
* So, what happens here is to scan the format string one % group
@@ -1703,12 +1988,11 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
*/
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "formatString ?arg arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
return TCL_ERROR;
}
- format = Tcl_GetStringFromObj(objv[1], &formatLen);
+ format = (char *) Tcl_GetStringFromObj(objv[1], &formatLen);
endPtr = format + formatLen;
resultPtr = Tcl_NewObj();
objIndex = 2;
@@ -1717,6 +2001,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
register char *newPtr = newFormat;
width = precision = noPercent = useShort = 0;
+ gotZero = gotMinus = gotPrecision = 0;
whichValue = PTR_VALUE;
/*
@@ -1748,7 +2033,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
*newPtr = '%';
newPtr++;
format++;
- if (isdigit(UCHAR(*format))) {
+ if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
int tmp;
/*
@@ -1757,7 +2042,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
* in the same format string.
*/
- tmp = strtoul(format, &end, 10);
+ tmp = strtoul(format, &end, 10); /* INTL: "C" locale. */
if (*end != '$') {
goto notXpg;
}
@@ -1782,21 +2067,37 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
xpgCheckDone:
while ((*format == '-') || (*format == '#') || (*format == '0')
|| (*format == ' ') || (*format == '+')) {
+ if (*format == '-') {
+ gotMinus = 1;
+ }
+ if (*format == '0') {
+ /*
+ * This will be handled by sprintf for numbers, but we
+ * need to do the char/string ones ourselves
+ */
+ gotZero = 1;
+ }
*newPtr = *format;
newPtr++;
format++;
}
- if (isdigit(UCHAR(*format))) {
- width = strtoul(format, &end, 10);
+ if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
+ width = strtoul(format, &end, 10); /* INTL: Tcl source. */
format = end;
} else if (*format == '*') {
if (objIndex >= objc) {
goto badIndex;
}
- if (Tcl_GetIntFromObj(interp, objv[objIndex],
- &width) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &width) != TCL_OK) {
goto fmtError;
}
+ if (width < 0) {
+ width = -width;
+ *newPtr = '-';
+ gotMinus = 1;
+ newPtr++;
+ }
objIndex++;
format++;
}
@@ -1812,7 +2113,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
width = 0;
}
if (width != 0) {
- TclFormatInt(newPtr, width);
+ TclFormatInt(newPtr, width); /* INTL: printf format. */
while (*newPtr != 0) {
newPtr++;
}
@@ -1821,23 +2122,24 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
*newPtr = '.';
newPtr++;
format++;
+ gotPrecision = 1;
}
- if (isdigit(UCHAR(*format))) {
- precision = strtoul(format, &end, 10);
+ if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
+ precision = strtoul(format, &end, 10); /* INTL: "C" locale. */
format = end;
} else if (*format == '*') {
if (objIndex >= objc) {
goto badIndex;
}
- if (Tcl_GetIntFromObj(interp, objv[objIndex],
- &precision) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &precision) != TCL_OK) {
goto fmtError;
}
objIndex++;
format++;
}
- if (precision != 0) {
- TclFormatInt(newPtr, precision);
+ if (gotPrecision) {
+ TclFormatInt(newPtr, precision); /* INTL: printf format. */
while (*newPtr != 0) {
newPtr++;
}
@@ -1864,31 +2166,47 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
case 'u':
case 'x':
case 'X':
- if (Tcl_GetIntFromObj(interp, objv[objIndex],
- (int *) &intValue) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &intValue) != TCL_OK) {
goto fmtError;
}
whichValue = INT_VALUE;
size = 40 + precision;
break;
case 's':
+ /*
+ * Compute the length of the string in characters and add
+ * any additional space required by the field width. All of
+ * the extra characters will be spaces, so one byte per
+ * character is adequate.
+ */
+
+ whichValue = STRING_VALUE;
ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
+ stringLen = Tcl_NumUtfChars(ptrValue, size);
+ if (gotPrecision && (precision < stringLen)) {
+ stringLen = precision;
+ }
+ size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
+ if (width > stringLen) {
+ size += (width - stringLen);
+ }
break;
case 'c':
- if (Tcl_GetIntFromObj(interp, objv[objIndex],
- (int *) &intValue) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &intValue) != TCL_OK) {
goto fmtError;
}
- whichValue = INT_VALUE;
- size = 1;
+ whichValue = CHAR_VALUE;
+ size = width + TCL_UTF_MAX;
break;
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
- if (Tcl_GetDoubleFromObj(interp, objv[objIndex],
- &doubleValue) != TCL_OK) {
+ if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &doubleValue) != TCL_OK) {
goto fmtError;
}
whichValue = DOUBLE_VALUE;
@@ -1902,13 +2220,12 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
"format string ended in middle of field specifier",
TCL_STATIC);
goto fmtError;
- default:
- {
- char buf[40];
- sprintf(buf, "bad field specifier \"%c\"", *format);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- goto fmtError;
- }
+ default: {
+ char buf[40];
+ sprintf(buf, "bad field specifier \"%c\"", *format);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ goto fmtError;
+ }
}
objIndex++;
format++;
@@ -1932,17 +2249,70 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
dst = (char *) ckalloc((unsigned) (size + 1));
dstSize = size;
}
+ switch (whichValue) {
+ case DOUBLE_VALUE: {
+ sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */
+ break;
+ }
+ case INT_VALUE: {
+ if (useShort) {
+ sprintf(dst, newFormat, (short) intValue);
+ } else {
+ sprintf(dst, newFormat, intValue);
+ }
+ break;
+ }
+ case CHAR_VALUE: {
+ char *ptr;
+ char padChar = (gotZero ? '0' : ' ');
+ ptr = dst;
+ if (!gotMinus) {
+ for ( ; --width > 0; ptr++) {
+ *ptr = padChar;
+ }
+ }
+ ptr += Tcl_UniCharToUtf(intValue, ptr);
+ for ( ; --width > 0; ptr++) {
+ *ptr = padChar;
+ }
+ *ptr = '\0';
+ break;
+ }
+ case STRING_VALUE: {
+ char *ptr;
+ char padChar = (gotZero ? '0' : ' ');
+ int pad;
+
+ ptr = dst;
+ if (width > stringLen) {
+ pad = width - stringLen;
+ } else {
+ pad = 0;
+ }
- if (whichValue == DOUBLE_VALUE) {
- sprintf(dst, newFormat, doubleValue);
- } else if (whichValue == INT_VALUE) {
- if (useShort) {
- sprintf(dst, newFormat, (short) intValue);
- } else {
- sprintf(dst, newFormat, intValue);
+ if (!gotMinus) {
+ while (pad > 0) {
+ *ptr++ = padChar;
+ pad--;
+ }
+ }
+
+ size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
+ if (size) {
+ memcpy(ptr, ptrValue, (size_t) size);
+ ptr += size;
+ }
+ while (pad > 0) {
+ *ptr++ = padChar;
+ pad--;
+ }
+ *ptr = '\0';
+ break;
+ }
+ default: {
+ sprintf(dst, newFormat, ptrValue);
+ break;
}
- } else {
- sprintf(dst, newFormat, ptrValue);
}
Tcl_AppendToObj(resultPtr, dst, -1);
}
@@ -1975,3 +2345,43 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * StringifyObjects --
+ *
+ * Helper function to bridge the gap between an object-based procedure
+ * and an older string-based procedure.
+ *
+ * Given an array of objects, allocate an array that consists of the
+ * string representations of those objects.
+ *
+ * Results:
+ * The return value is a pointer to the newly allocated array of
+ * strings. Elements 0 to (objc-1) of the string array point to the
+ * string representation of the corresponding element in the source
+ * object array; element objc of the string array is NULL.
+ *
+ * Side effects:
+ * Memory allocated. The caller must eventually free this memory
+ * by calling ckfree() on the return value.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static char **
+StringifyObjects(objc, objv)
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int i;
+ char **argv;
+
+ argv = (char **) ckalloc((objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ argv[i] = Tcl_GetString(objv[i]);
+ }
+ argv[i] = NULL;
+ return argv;
+}
diff --git a/tcl/generic/tclCmdIL.c b/tcl/generic/tclCmdIL.c
index 94b8fc2dfc7..54ed56fa0e8 100644
--- a/tcl/generic/tclCmdIL.c
+++ b/tcl/generic/tclCmdIL.c
@@ -9,7 +9,7 @@
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -20,6 +20,7 @@
#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
+#include "tclRegexp.h"
/*
* During execution of the "lsort" command, structures of the following
@@ -29,6 +30,7 @@
typedef struct SortElement {
Tcl_Obj *objPtr; /* Object being sorted. */
+ int count; /* number of same elements in list */
struct SortElement *nextPtr; /* Next element in the list, or
* NULL for end of list. */
} SortElement;
@@ -45,7 +47,7 @@ typedef struct SortInfo {
int isIncreasing; /* Nonzero means sort in increasing order. */
int sortMode; /* The sort mode. One of SORTMODE_*
* values defined below */
- Tcl_DString compareCmd; /* The Tcl comparison command when sortMode
+ Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode
* is SORTMODE_COMMAND. Pre-initialized to
* hold base of command.*/
int index; /* If the -index option was specified, this
@@ -149,7 +151,7 @@ static int SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
/*
*----------------------------------------------------------------------
*
- * Tcl_IfCmd --
+ * Tcl_IfObjCmd --
*
* This procedure is invoked to process the "if" Tcl command.
* See the user documentation for details on what it does.
@@ -169,44 +171,55 @@ static int SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
/* ARGSUSED */
int
-Tcl_IfCmd(dummy, interp, argc, argv)
+Tcl_IfObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ int thenScriptIndex = 0; /* then script to be evaled after syntax check */
int i, result, value;
-
+ char *clause;
i = 1;
while (1) {
/*
- * At this point in the loop, argv and argc refer to an expression
+ * At this point in the loop, objv and objc refer to an expression
* to test, either for the main expression or an expression
* following an "elseif". The arguments after the expression must
* be "then" (optional) and a script to execute if the expression is
* true.
*/
- if (i >= argc) {
+ if (i >= objc) {
+ clause = Tcl_GetString(objv[i-1]);
Tcl_AppendResult(interp, "wrong # args: no expression after \"",
- argv[i-1], "\" argument", (char *) NULL);
+ clause, "\" argument", (char *) NULL);
return TCL_ERROR;
}
- result = Tcl_ExprBoolean(interp, argv[i], &value);
- if (result != TCL_OK) {
- return result;
+ if (!thenScriptIndex) {
+ result = Tcl_ExprBooleanObj(interp, objv[i], &value);
+ if (result != TCL_OK) {
+ return result;
+ }
}
i++;
- if ((i < argc) && (strcmp(argv[i], "then") == 0)) {
- i++;
- }
- if (i >= argc) {
+ if (i >= objc) {
+ missingScript:
+ clause = Tcl_GetString(objv[i-1]);
Tcl_AppendResult(interp, "wrong # args: no script following \"",
- argv[i-1], "\" argument", (char *) NULL);
+ clause, "\" argument", (char *) NULL);
return TCL_ERROR;
}
+ clause = Tcl_GetString(objv[i]);
+ if ((i < objc) && (strcmp(clause, "then") == 0)) {
+ i++;
+ }
+ if (i >= objc) {
+ goto missingScript;
+ }
if (value) {
- return Tcl_Eval(interp, argv[i]);
+ thenScriptIndex = i;
+ value = 0;
}
/*
@@ -215,10 +228,14 @@ Tcl_IfCmd(dummy, interp, argc, argv)
*/
i++;
- if (i >= argc) {
+ if (i >= objc) {
+ if (thenScriptIndex) {
+ return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+ }
return TCL_OK;
}
- if ((argv[i][0] == 'e') && (strcmp(argv[i], "elseif") == 0)) {
+ clause = Tcl_GetString(objv[i]);
+ if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
i++;
continue;
}
@@ -231,22 +248,31 @@ Tcl_IfCmd(dummy, interp, argc, argv)
* argument when we get here.
*/
- if (strcmp(argv[i], "else") == 0) {
+ if (strcmp(clause, "else") == 0) {
i++;
- if (i >= argc) {
+ if (i >= objc) {
Tcl_AppendResult(interp,
"wrong # args: no script following \"else\" argument",
(char *) NULL);
return TCL_ERROR;
}
}
- return Tcl_Eval(interp, argv[i]);
+ if (i < objc - 1) {
+ Tcl_AppendResult(interp,
+ "wrong # args: extra words after \"else\" clause in \"if\" command",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (thenScriptIndex) {
+ return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+ }
+ return Tcl_EvalObjEx(interp, objv[i], 0);
}
/*
*----------------------------------------------------------------------
*
- * Tcl_IncrCmd --
+ * Tcl_IncrObjCmd --
*
* This procedure is invoked to process the "incr" Tcl command.
* See the user documentation for details on what it does.
@@ -266,54 +292,49 @@ Tcl_IfCmd(dummy, interp, argc, argv)
/* ARGSUSED */
int
-Tcl_IncrCmd(dummy, interp, argc, argv)
+Tcl_IncrObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int value;
- char *oldString, *result;
- char newString[30];
-
- if ((argc != 2) && (argc != 3)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " varName ?increment?\"", (char *) NULL);
+ long incrAmount;
+ Tcl_Obj *newValuePtr;
+
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
return TCL_ERROR;
}
- oldString = Tcl_GetVar(interp, argv[1], TCL_LEAVE_ERR_MSG);
- if (oldString == NULL) {
- return TCL_ERROR;
- }
- if (Tcl_GetInt(interp, oldString, &value) != TCL_OK) {
- Tcl_AddErrorInfo(interp,
- "\n (reading value of variable to increment)");
- return TCL_ERROR;
- }
- if (argc == 2) {
- value += 1;
+ /*
+ * Calculate the amount to increment by.
+ */
+
+ if (objc == 2) {
+ incrAmount = 1;
} else {
- int increment;
-
- if (Tcl_GetInt(interp, argv[2], &increment) != TCL_OK) {
- Tcl_AddErrorInfo(interp,
- "\n (reading increment)");
+ if (Tcl_GetLongFromObj(interp, objv[2], &incrAmount) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (reading increment)");
return TCL_ERROR;
}
- value += increment;
}
- TclFormatInt(newString, value);
- result = Tcl_SetVar(interp, argv[1], newString, TCL_LEAVE_ERR_MSG);
- if (result == NULL) {
+
+ /*
+ * Increment the variable's value.
+ */
+
+ newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL, incrAmount,
+ TCL_LEAVE_ERR_MSG);
+ if (newValuePtr == NULL) {
return TCL_ERROR;
}
/*
- * Copy the result since the variable's value might change.
+ * Set the interpreter's object result to refer to the variable's new
+ * value object.
*/
-
- Tcl_SetResult(interp, result, TCL_VOLATILE);
+
+ Tcl_SetObjResult(interp, newValuePtr);
return TCL_OK;
}
@@ -355,8 +376,8 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
- } index;
- int result;
+ };
+ int index, result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
@@ -445,7 +466,7 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
* info args procName
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -472,7 +493,7 @@ InfoArgsCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ name = Tcl_GetString(objv[2]);
procPtr = TclFindProc(iPtr, name);
if (procPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -507,7 +528,7 @@ InfoArgsCmd(dummy, interp, objc, objv)
* info body procName
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -533,7 +554,7 @@ InfoBodyCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ name = Tcl_GetString(objv[2]);
procPtr = TclFindProc(iPtr, name);
if (procPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -542,9 +563,12 @@ InfoBodyCmd(dummy, interp, objc, objv)
}
/*
- * we need to check if the body from this procedure had been generated
- * from a precompiled body. If that is the case, then the bodyPtr's
- * string representation is bogus, since sources are not available.
+ * We should not return a bytecompiled body. If it is precompiled,
+ * then the bodyPtr's string representation is bogus, since sources
+ * are not available. If it was just a bytecompiled body, then it
+ * is likely to not be of any use to the caller, as it was compiled
+ * for a separate procedure context [Bug: 3412], and noone else can
+ * reasonably use it.
* In order to make sure that later manipulations of the object do not
* invalidate the internal representation, we make a copy of the string
* representation and return that one, instead.
@@ -553,11 +577,7 @@ InfoBodyCmd(dummy, interp, objc, objv)
bodyPtr = procPtr->bodyPtr;
resultPtr = bodyPtr;
if (bodyPtr->typePtr == &tclByteCodeType) {
- ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
-
- if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
- }
+ resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
}
Tcl_SetObjResult(interp, resultPtr);
@@ -576,7 +596,7 @@ InfoBodyCmd(dummy, interp, objc, objv)
* info cmdcount
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -618,7 +638,7 @@ InfoCmdCountCmd(dummy, interp, objc, objv)
* info commands ?pattern?
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -643,7 +663,6 @@ InfoCommandsCmd(dummy, interp, objc, objv)
Tcl_Obj *listPtr, *elemObjPtr;
int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
Tcl_Command cmd;
- int result;
/*
* Get the pattern and find the "effective namespace" in which to
@@ -665,13 +684,11 @@ InfoCommandsCmd(dummy, interp, objc, objv)
Namespace *dummy1NsPtr, *dummy2NsPtr;
- pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
- result = TclGetNamespaceForQualName(interp, pattern,
- (Namespace *) NULL, /*flags*/ TCL_LEAVE_ERR_MSG,
- &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
+
+ pattern = Tcl_GetString(objv[2]);
+ TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+ /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+
if (nsPtr != NULL) { /* we successfully found the pattern's ns */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
}
@@ -747,7 +764,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
* info complete command
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -789,7 +806,7 @@ InfoCompleteCmd(dummy, interp, objc, objv)
* info default procName arg varName
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -816,8 +833,8 @@ InfoDefaultCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- procName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
- argName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+ procName = Tcl_GetString(objv[2]);
+ argName = Tcl_GetString(objv[3]);
procPtr = TclFindProc(iPtr, procName);
if (procPtr == NULL) {
@@ -832,10 +849,10 @@ InfoDefaultCmd(dummy, interp, objc, objv)
&& (strcmp(argName, localPtr->name) == 0)) {
if (localPtr->defValuePtr != NULL) {
valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
- localPtr->defValuePtr, 0);
+ localPtr->defValuePtr, 0);
if (valueObjPtr == NULL) {
defStoreError:
- varName = Tcl_GetStringFromObj(objv[4], (int *) NULL);
+ varName = Tcl_GetString(objv[4]);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"couldn't store default value in variable \"",
varName, "\"", (char *) NULL);
@@ -845,7 +862,7 @@ InfoDefaultCmd(dummy, interp, objc, objv)
} else {
Tcl_Obj *nullObjPtr = Tcl_NewObj();
valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
- nullObjPtr, 0);
+ nullObjPtr, 0);
if (valueObjPtr == NULL) {
Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
goto defStoreError;
@@ -873,7 +890,7 @@ InfoDefaultCmd(dummy, interp, objc, objv)
* info exists varName
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -890,17 +907,15 @@ InfoExistsCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
char *varName;
- Var *varPtr, *arrayPtr;
+ Var *varPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "varName");
return TCL_ERROR;
}
- varName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
- varPtr = TclLookupVar(interp, varName, (char *) NULL,
- TCL_PARSE_PART1, "access",
- /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ varName = Tcl_GetString(objv[2]);
+ varPtr = TclVarTraceExists(interp, varName);
if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
} else {
@@ -921,7 +936,7 @@ InfoExistsCmd(dummy, interp, objc, objv)
* info globals ?pattern?
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -947,7 +962,7 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
if (objc == 2) {
pattern = NULL;
} else if (objc == 3) {
- pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ pattern = Tcl_GetString(objv[2]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
return TCL_ERROR;
@@ -987,7 +1002,7 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
* info hostname
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1031,7 +1046,7 @@ InfoHostnameCmd(dummy, interp, objc, objv)
* info level ?number?
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1068,7 +1083,7 @@ InfoLevelCmd(dummy, interp, objc, objv)
levelError:
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad level \"",
- Tcl_GetStringFromObj(objv[2], (int *) NULL),
+ Tcl_GetString(objv[2]),
"\"", (char *) NULL);
return TCL_ERROR;
}
@@ -1105,7 +1120,7 @@ InfoLevelCmd(dummy, interp, objc, objv)
* info library
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1150,7 +1165,7 @@ InfoLibraryCmd(dummy, interp, objc, objv)
* info loaded ?interp?
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1177,7 +1192,7 @@ InfoLoadedCmd(dummy, interp, objc, objv)
if (objc == 2) { /* get loaded pkgs in all interpreters */
interpName = NULL;
} else { /* get pkgs just in specified interp */
- interpName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ interpName = Tcl_GetString(objv[2]);
}
result = TclGetLoadedPackages(interp, interpName);
return result;
@@ -1195,7 +1210,7 @@ InfoLoadedCmd(dummy, interp, objc, objv)
* info locals ?pattern?
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1218,7 +1233,7 @@ InfoLocalsCmd(dummy, interp, objc, objv)
if (objc == 2) {
pattern = NULL;
} else if (objc == 3) {
- pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ pattern = Tcl_GetString(objv[2]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
return TCL_ERROR;
@@ -1324,7 +1339,7 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
* info nameofexecutable
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1367,7 +1382,7 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv)
* info patchlevel
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1404,14 +1419,17 @@ InfoPatchLevelCmd(dummy, interp, objc, objv)
*
* InfoProcsCmd --
*
- * Called to implement the "info procs" command that returns the
- * procedures in the current namespace that match an optional pattern.
- * Handles the following syntax:
+ * Called to implement the "info procs" command that returns the
+ * list of procedures in the interpreter that match an optional pattern.
+ * The pattern, if any, consists of an optional sequence of namespace
+ * names separated by "::" qualifiers, which is followed by a
+ * glob-style pattern that restricts which commands are returned.
+ * Handles the following syntax:
*
* info procs ?pattern?
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1427,40 +1445,126 @@ InfoProcsCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *cmdName, *pattern;
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ char *cmdName, *pattern, *simplePattern;
+ Namespace *nsPtr;
+#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
+ Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+#endif
+ Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ Tcl_Obj *listPtr, *elemObjPtr;
+ int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
- Command *cmdPtr;
- Tcl_Obj *listPtr;
+ Command *cmdPtr, *realCmdPtr;
+
+ /*
+ * Get the pattern and find the "effective namespace" in which to
+ * list procs.
+ */
if (objc == 2) {
- pattern = NULL;
+ simplePattern = NULL;
+ nsPtr = currNsPtr;
+ specificNsInPattern = 0;
} else if (objc == 3) {
- pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ /*
+ * From the pattern, get the effective namespace and the simple
+ * pattern (no namespace qualifiers or ::'s) at the end. If an
+ * error was found while parsing the pattern, return it. Otherwise,
+ * if the namespace wasn't found, just leave nsPtr NULL: we will
+ * return an empty list since no commands there can be found.
+ */
+
+ Namespace *dummy1NsPtr, *dummy2NsPtr;
+
+ pattern = Tcl_GetString(objv[2]);
+ TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+ /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
+ &simplePattern);
+
+ if (nsPtr != NULL) { /* we successfully found the pattern's ns */
+ specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
+ }
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
return TCL_ERROR;
}
/*
- * Scan through the current namespace's command table and return a list
- * of all procs that match the pattern.
+ * Scan through the effective namespace's command table and create a
+ * list with all procs that match the pattern. If a specific
+ * namespace was requested in the pattern, qualify the command names
+ * with the namespace name.
*/
-
+
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- for (entryPtr = Tcl_FirstHashEntry(&currNsPtr->cmdTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_NextHashEntry(&search)) {
- cmdName = Tcl_GetHashKey(&currNsPtr->cmdTable, entryPtr);
- cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
- if (TclIsProc(cmdPtr)) {
- if ((pattern == NULL) || Tcl_StringMatch(cmdName, pattern)) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(cmdName, -1));
- }
- }
+ if (nsPtr != NULL) {
+ entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ while (entryPtr != NULL) {
+ cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
+ if ((simplePattern == NULL)
+ || Tcl_StringMatch(cmdName, simplePattern)) {
+ cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+
+ if (specificNsInPattern) {
+ elemObjPtr = Tcl_NewObj();
+ Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
+ elemObjPtr);
+ } else {
+ elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+ }
+
+ realCmdPtr = (Command *)
+ TclGetOriginalCommand((Tcl_Command) cmdPtr);
+
+ if (TclIsProc(cmdPtr)
+ || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) {
+ Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
+ }
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ /*
+ * If the effective namespace isn't the global :: namespace, and a
+ * specific namespace wasn't requested in the pattern, then add in
+ * all global :: procs that match the simple pattern. Of course,
+ * we add in only those procs that aren't hidden by a proc in
+ * the effective namespace.
+ */
+
+#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
+ /*
+ * If "info procs" worked like "info commands", returning the
+ * commands also seen in the global namespace, then you would
+ * include this code. As this could break backwards compatibilty
+ * with 8.0-8.2, we decided not to "fix" it in 8.3, leaving the
+ * behavior slightly different.
+ */
+ if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+ entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
+ while (entryPtr != NULL) {
+ cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
+ if ((simplePattern == NULL)
+ || Tcl_StringMatch(cmdName, simplePattern)) {
+ if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
+ cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
+ realCmdPtr = (Command *) TclGetOriginalCommand(
+ (Tcl_Command) cmdPtr);
+
+ if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)
+ && TclIsProc(realCmdPtr))) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(cmdName, -1));
+ }
+ }
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ }
+#endif
}
+
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -1477,7 +1581,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
* info script
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1517,7 +1621,7 @@ InfoScriptCmd(dummy, interp, objc, objv)
* info sharedlibextension
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1555,7 +1659,7 @@ InfoSharedlibCmd(dummy, interp, objc, objv)
* info tclversion
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1602,7 +1706,7 @@ InfoTclVersionCmd(dummy, interp, objc, objv)
* info vars ?pattern?
*
* Results:
- * Returns TCL_OK is successful and TCL_ERROR is there is an error.
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
*
* Side effects:
* Returns a result in the interpreter's result object. If there is
@@ -1628,7 +1732,6 @@ InfoVarsCmd(dummy, interp, objc, objv)
Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
Tcl_Obj *listPtr, *elemObjPtr;
int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
- int result;
/*
* Get the pattern and find the "effective namespace" in which to
@@ -1651,13 +1754,11 @@ InfoVarsCmd(dummy, interp, objc, objv)
Namespace *dummy1NsPtr, *dummy2NsPtr;
- pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
- result = TclGetNamespaceForQualName(interp, pattern,
- (Namespace *) NULL, /*flags*/ TCL_LEAVE_ERR_MSG,
- &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
+ pattern = Tcl_GetString(objv[2]);
+ TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+ /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
+ &simplePattern);
+
if (nsPtr != NULL) { /* we successfully found the pattern's ns */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
}
@@ -1735,7 +1836,7 @@ InfoVarsCmd(dummy, interp, objc, objv)
entryPtr = Tcl_NextHashEntry(&search);
}
}
- } else {
+ } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
AppendLocals(interp, listPtr, simplePattern, 1);
}
@@ -1921,7 +2022,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
Tcl_Obj *listPtr, *resultPtr;
Tcl_ObjType *typePtr;
int index, isDuplicate, len, result;
-
+
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
return TCL_ERROR;
@@ -1932,8 +2033,12 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
* will invalidate the list's internal representation.
*/
- result = TclGetIntForIndex(interp, objv[2], /*endValue*/ INT_MAX,
- &index);
+ result = Tcl_ListObjLength(interp, objv[1], &len);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ result = TclGetIntForIndex(interp, objv[2], /*endValue*/ len, &index);
if (result != TCL_OK) {
return result;
}
@@ -2255,7 +2360,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
&& (strncmp(firstArg, "end", (unsigned) firstArgLen) != 0)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"list doesn't contain element ",
- Tcl_GetStringFromObj(objv[2], (int *) NULL), (int *) NULL);
+ Tcl_GetString(objv[2]), (int *) NULL);
result = TCL_ERROR;
goto errorReturn;
}
@@ -2311,21 +2416,20 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument values. */
{
-#define EXACT 0
-#define GLOB 1
-#define REGEXP 2
-#define DICTIONARY 3
-#define NOCASE 4
char *bytes, *patternBytes;
- int i, match, mode, index, result, listLen, length, elemLen;
- Tcl_Obj **elemPtrs;
- static char *switches[] =
- {"-exact", "-glob", "-regexp", "-dictionary", "-nocase", (char *) NULL};
-
- mode = GLOB;
+ int i, match, mode, index, result, listc, length, elemLen;
+ Tcl_Obj *patObj, **listv;
+ static char *options[] = {
+ "-exact", "-glob", "-regexp", NULL
+ };
+ enum options {
+ LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_REGEXP
+ };
+
+ mode = LSEARCH_GLOB;
if (objc == 4) {
- if (Tcl_GetIndexFromObj(interp, objv[1], switches,
- "search mode", 0, &mode) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "search mode", 0,
+ &mode) != TCL_OK) {
return TCL_ERROR;
}
} else if (objc != 3) {
@@ -2338,54 +2442,43 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
* a pointer to its array of element pointers.
*/
- result = Tcl_ListObjGetElements(interp, objv[objc-2], &listLen, &elemPtrs);
+ result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
if (result != TCL_OK) {
return result;
}
- patternBytes = Tcl_GetStringFromObj(objv[objc-1], &length);
-
+ patObj = objv[objc - 1];
+ patternBytes = Tcl_GetStringFromObj(patObj, &length);
+
index = -1;
- for (i = 0; i < listLen; i++) {
+ for (i = 0; i < listc; i++) {
match = 0;
- bytes = Tcl_GetStringFromObj(elemPtrs[i], &elemLen);
- switch (mode) {
- case EXACT:
+ switch ((enum options) mode) {
+ case LSEARCH_EXACT: {
+ bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
if (length == elemLen) {
match = (memcmp(bytes, patternBytes,
(size_t) length) == 0);
}
break;
- case GLOB:
- /*
- * WARNING: will not work with data containing NULLs.
- */
- match = Tcl_StringMatch(bytes, patternBytes);
+ }
+ case LSEARCH_GLOB: {
+ match = Tcl_StringMatch(Tcl_GetString(listv[i]), patternBytes);
break;
- case REGEXP:
- /*
- * WARNING: will not work with data containing NULLs.
- */
- match = Tcl_RegExpMatch(interp, bytes, patternBytes);
+ }
+ case LSEARCH_REGEXP: {
+ match = Tcl_RegExpMatchObj(interp, listv[i], patObj);
if (match < 0) {
return TCL_ERROR;
}
break;
- case DICTIONARY:
- case NOCASE:
-#if defined(__MSVC__) || defined(_MSC_VER)
- match = strnicmp (bytes, patternBytes, length) == 0;
-#else
- match = strncasecmp (bytes, patternBytes, length) == 0;
-#endif
- break;
+ }
}
- if (match) {
+ if (match != 0) {
index = i;
break;
}
}
-
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
return TCL_OK;
}
@@ -2414,7 +2507,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument values. */
{
- int i, index, dummy;
+ int i, index, unique;
Tcl_Obj *resultPtr;
int length;
Tcl_Obj *cmdPtr, **listObjPtrs;
@@ -2423,9 +2516,10 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
SortInfo sortInfo; /* Information about this sort that
* needs to be passed to the
* comparison function */
- static char *switches[] =
- {"-ascii", "-command", "-decreasing", "-dictionary",
- "-increasing", "-index", "-integer", "-real", (char *) NULL};
+ static char *switches[] = {
+ "-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
+ "-index", "-integer", "-real", "-unique", (char *) NULL
+ };
resultPtr = Tcl_GetObjResult(interp);
if (objc < 2) {
@@ -2443,6 +2537,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.interp = interp;
sortInfo.resultCode = TCL_OK;
cmdPtr = NULL;
+ unique = 0;
for (i = 1; i < objc-1; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
!= TCL_OK) {
@@ -2492,12 +2587,31 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
case 7: /* -real */
sortInfo.sortMode = SORTMODE_REAL;
break;
+ case 8: /* -unique */
+ unique = 1;
+ break;
}
}
if (sortInfo.sortMode == SORTMODE_COMMAND) {
- Tcl_DStringInit(&sortInfo.compareCmd);
- Tcl_DStringAppend(&sortInfo.compareCmd,
- Tcl_GetStringFromObj(cmdPtr, &dummy), -1);
+ /*
+ * The existing command is a list. We want to flatten it, append
+ * two dummy arguments on the end, and replace these arguments
+ * later.
+ */
+
+ Tcl_Obj *newCommandPtr = Tcl_DuplicateObj(cmdPtr);
+ Tcl_Obj *newObjPtr = Tcl_NewObj();
+
+ Tcl_IncrRefCount(newCommandPtr);
+ if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
+ != TCL_OK) {
+ Tcl_DecrRefCount(newCommandPtr);
+ Tcl_IncrRefCount(newObjPtr);
+ Tcl_DecrRefCount(newObjPtr);
+ return TCL_ERROR;
+ }
+ Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
+ sortInfo.compareCmdPtr = newCommandPtr;
}
sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
@@ -2511,6 +2625,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
for (i=0; i < length; i++){
elementArray[i].objPtr = listObjPtrs[i];
+ elementArray[i].count = 0;
elementArray[i].nextPtr = &elementArray[i+1];
}
elementArray[length-1].nextPtr = NULL;
@@ -2523,15 +2638,26 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
Tcl_ResetResult(interp);
resultPtr = Tcl_GetObjResult(interp);
- for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
- Tcl_ListObjAppendElement(interp, resultPtr, elementPtr->objPtr);
+ if (unique) {
+ for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+ if (elementPtr->count == 0) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ elementPtr->objPtr);
+ }
+ }
+ } else {
+ for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ elementPtr->objPtr);
+ }
}
}
ckfree((char*) elementArray);
done:
if (sortInfo.sortMode == SORTMODE_COMMAND) {
- Tcl_DStringFree(&sortInfo.compareCmd);
+ Tcl_DecrRefCount(sortInfo.compareCmdPtr);
+ sortInfo.compareCmdPtr = NULL;
}
return sortInfo.resultCode;
}
@@ -2623,6 +2749,7 @@ MergeLists(leftPtr, rightPtr, infoPtr)
{
SortElement *headPtr;
SortElement *tailPtr;
+ int cmp;
if (leftPtr == NULL) {
return rightPtr;
@@ -2630,20 +2757,28 @@ MergeLists(leftPtr, rightPtr, infoPtr)
if (rightPtr == NULL) {
return leftPtr;
}
- if (SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr) > 0) {
+ cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
+ if (cmp > 0) {
tailPtr = rightPtr;
rightPtr = rightPtr->nextPtr;
} else {
+ if (cmp == 0) {
+ leftPtr->count++;
+ }
tailPtr = leftPtr;
leftPtr = leftPtr->nextPtr;
}
headPtr = tailPtr;
while ((leftPtr != NULL) && (rightPtr != NULL)) {
- if (SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr) > 0) {
+ cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
+ if (cmp > 0) {
tailPtr->nextPtr = rightPtr;
tailPtr = rightPtr;
rightPtr = rightPtr->nextPtr;
} else {
+ if (cmp == 0) {
+ leftPtr->count++;
+ }
tailPtr->nextPtr = leftPtr;
tailPtr = leftPtr;
leftPtr = leftPtr->nextPtr;
@@ -2684,9 +2819,9 @@ SortCompare(objPtr1, objPtr2, infoPtr)
SortInfo *infoPtr; /* Information passed from the
* top-level "lsort" command */
{
- int order, dummy, listLen, index;
+ int order, listLen, index;
Tcl_Obj *objPtr;
- char buffer[30];
+ char buffer[TCL_INTEGER_SPACE];
order = 0;
if (infoPtr->resultCode != TCL_OK) {
@@ -2723,11 +2858,10 @@ SortCompare(objPtr1, objPtr2, infoPtr)
if (objPtr == NULL) {
objPtr = objPtr1;
missingElement:
- sprintf(buffer, "%d", infoPtr->index);
+ TclFormatInt(buffer, infoPtr->index);
Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
"element ", buffer, " missing from sublist \"",
- Tcl_GetStringFromObj(objPtr, (int *) NULL),
- "\"", (char *) NULL);
+ Tcl_GetString(objPtr), "\"", (char *) NULL);
infoPtr->resultCode = TCL_ERROR;
return order;
}
@@ -2755,17 +2889,15 @@ SortCompare(objPtr1, objPtr2, infoPtr)
objPtr2 = objPtr;
}
if (infoPtr->sortMode == SORTMODE_ASCII) {
- order = strcmp(Tcl_GetStringFromObj(objPtr1, &dummy),
- Tcl_GetStringFromObj(objPtr2, &dummy));
+ order = strcmp(Tcl_GetString(objPtr1), Tcl_GetString(objPtr2));
} else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
order = DictionaryCompare(
- Tcl_GetStringFromObj(objPtr1, &dummy),
- Tcl_GetStringFromObj(objPtr2, &dummy));
+ Tcl_GetString(objPtr1), Tcl_GetString(objPtr2));
} else if (infoPtr->sortMode == SORTMODE_INTEGER) {
- int a, b;
+ long a, b;
- if ((Tcl_GetIntFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
- || (Tcl_GetIntFromObj(infoPtr->interp, objPtr2, &b)
+ if ((Tcl_GetLongFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK)
+ || (Tcl_GetLongFromObj(infoPtr->interp, objPtr2, &b)
!= TCL_OK)) {
infoPtr->resultCode = TCL_ERROR;
return order;
@@ -2790,22 +2922,26 @@ SortCompare(objPtr1, objPtr2, infoPtr)
order = -1;
}
} else {
- int oldLength;
+ Tcl_Obj **objv, *paramObjv[2];
+ int objc;
- /*
- * Generate and evaluate a command to determine which string comes
- * first.
+ paramObjv[0] = objPtr1;
+ paramObjv[1] = objPtr2;
+
+ /*
+ * We made space in the command list for the two things to
+ * compare. Replace them and evaluate the result.
*/
- oldLength = Tcl_DStringLength(&infoPtr->compareCmd);
- Tcl_DStringAppendElement(&infoPtr->compareCmd,
- Tcl_GetStringFromObj(objPtr1, &dummy));
- Tcl_DStringAppendElement(&infoPtr->compareCmd,
- Tcl_GetStringFromObj(objPtr2, &dummy));
- infoPtr->resultCode = Tcl_Eval(infoPtr->interp,
- Tcl_DStringValue(&infoPtr->compareCmd));
- Tcl_DStringTrunc(&infoPtr->compareCmd, oldLength);
- if (infoPtr->resultCode != TCL_OK) {
+ Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
+ Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
+ 2, 2, paramObjv);
+ Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
+ &objc, &objv);
+
+ infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
+
+ if (infoPtr->resultCode != TCL_OK) {
Tcl_AddErrorInfo(infoPtr->interp,
"\n (-compare command)");
return order;
@@ -2858,11 +2994,13 @@ static int
DictionaryCompare(left, right)
char *left, *right; /* The strings to compare */
{
+ Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
int diff, zeros;
int secondaryDiff = 0;
while (1) {
- if (isdigit(UCHAR(*right)) && isdigit(UCHAR(*left))) {
+ if (isdigit(UCHAR(*right)) /* INTL: digit */
+ && isdigit(UCHAR(*left))) { /* INTL: digit */
/*
* There are decimal numbers embedded in the two
* strings. Compare them as numbers, rather than
@@ -2898,8 +3036,8 @@ DictionaryCompare(left, right)
}
right++;
left++;
- if (!isdigit(UCHAR(*right))) {
- if (isdigit(UCHAR(*left))) {
+ if (!isdigit(UCHAR(*right))) { /* INTL: digit */
+ if (isdigit(UCHAR(*left))) { /* INTL: digit */
return 1;
} else {
/*
@@ -2912,40 +3050,51 @@ DictionaryCompare(left, right)
}
break;
}
- } else if (!isdigit(UCHAR(*left))) {
+ } else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
return -1;
}
}
continue;
}
- diff = UCHAR(*left) - UCHAR(*right);
- if (diff) {
- if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
- diff = UCHAR(tolower(*left)) - UCHAR(*right);
- if (diff) {
- return diff;
- } else if (secondaryDiff == 0) {
- secondaryDiff = -1;
- }
- } else if (isupper(UCHAR(*right)) && islower(UCHAR(*left))) {
- diff = UCHAR(*left) - UCHAR(tolower(UCHAR(*right)));
- if (diff) {
- return diff;
- } else if (secondaryDiff == 0) {
- secondaryDiff = 1;
- }
- } else {
- return diff;
- }
- }
- if (*left == 0) {
+
+ /*
+ * Convert character to Unicode for comparison purposes. If either
+ * string is at the terminating null, do a byte-wise comparison and
+ * bail out immediately.
+ */
+
+ if ((*left != '\0') && (*right != '\0')) {
+ left += Tcl_UtfToUniChar(left, &uniLeft);
+ right += Tcl_UtfToUniChar(right, &uniRight);
+ /*
+ * Convert both chars to lower for the comparison, because
+ * dictionary sorts are case insensitve. Covert to lower, not
+ * upper, so chars between Z and a will sort before A (where most
+ * other interesting punctuations occur)
+ */
+ uniLeftLower = Tcl_UniCharToLower(uniLeft);
+ uniRightLower = Tcl_UniCharToLower(uniRight);
+ } else {
+ diff = UCHAR(*left) - UCHAR(*right);
break;
}
- left++;
- right++;
+
+ diff = uniLeftLower - uniRightLower;
+ if (diff) {
+ return diff;
+ } else if (secondaryDiff == 0) {
+ if (Tcl_UniCharIsUpper(uniLeft) &&
+ Tcl_UniCharIsLower(uniRight)) {
+ secondaryDiff = -1;
+ } else if (Tcl_UniCharIsUpper(uniRight)
+ && Tcl_UniCharIsLower(uniLeft)) {
+ secondaryDiff = 1;
+ }
+ }
}
if (diff == 0) {
diff = secondaryDiff;
}
return diff;
}
+
diff --git a/tcl/generic/tclCmdMZ.c b/tcl/generic/tclCmdMZ.c
index 87cfd108752..abc7a30d822 100644
--- a/tcl/generic/tclCmdMZ.c
+++ b/tcl/generic/tclCmdMZ.c
@@ -8,6 +8,7 @@
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -18,6 +19,23 @@
#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
+#include "tclRegexp.h"
+
+/*
+ * Flag values used by Tcl_ScanObjCmd.
+ */
+
+#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */
+#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */
+#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */
+#define SCAN_WIDTH 0x8 /* A width value was supplied. */
+
+#define SCAN_SIGNOK 0x10 /* A +/- character is allowed. */
+#define SCAN_NODIGITS 0x20 /* No digits have been scanned. */
+#define SCAN_NOZERO 0x40 /* No zero digits have been scanned. */
+#define SCAN_XOK 0x80 /* An 'x' is allowed. */
+#define SCAN_PTOK 0x100 /* Decimal point is allowed. */
+#define SCAN_EXPOK 0x200 /* An exponent is allowed. */
/*
* Structure used to hold information about variable traces:
@@ -28,7 +46,7 @@ typedef struct {
* to be invoked. */
char *errMsg; /* Error message returned from Tcl command,
* or NULL. Malloc'ed. */
- int length; /* Number of non-NULL chars. in command. */
+ size_t length; /* Number of non-NULL chars. in command. */
char command[4]; /* Space for Tcl command to invoke. Actual
* size will be as large as necessary to
* hold command. This field must be the
@@ -47,7 +65,7 @@ static char * TraceVarProc _ANSI_ARGS_((ClientData clientData,
/*
*----------------------------------------------------------------------
*
- * Tcl_PwdCmd --
+ * Tcl_PwdObjCmd --
*
* This procedure is invoked to process the "pwd" Tcl command.
* See the user documentation for details on what it does.
@@ -63,32 +81,30 @@ static char * TraceVarProc _ANSI_ARGS_((ClientData clientData,
/* ARGSUSED */
int
-Tcl_PwdCmd(dummy, interp, argc, argv)
+Tcl_PwdObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *dirName;
+ Tcl_DString ds;
- if (argc != 1) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], "\"", (char *) NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- dirName = TclGetCwd(interp);
- if (dirName == NULL) {
+ if (Tcl_GetCwd(interp, &ds) == NULL) {
return TCL_ERROR;
}
- Tcl_SetResult(interp, dirName, TCL_VOLATILE);
+ Tcl_DStringResult(interp, &ds);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_RegexpCmd --
+ * Tcl_RegexpObjCmd --
*
* This procedure is invoked to process the "regexp" Tcl command.
* See the user documentation for details on what it does.
@@ -104,148 +120,309 @@ Tcl_PwdCmd(dummy, interp, argc, argv)
/* ARGSUSED */
int
-Tcl_RegexpCmd(dummy, interp, argc, argv)
+Tcl_RegexpObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int noCase = 0;
- int indices = 0;
+ int i, indices, match, about, offset, all, doinline, numMatchesSaved;
+ int cflags, eflags, stringLength;
Tcl_RegExp regExpr;
- char **argPtr, *string, *pattern, *start, *end;
- int match = 0; /* Initialization needed only to
- * prevent compiler warning. */
- int i;
- Tcl_DString stringDString, patternDString;
-
- if (argc < 3) {
- wrongNumArgs:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ?switches? exp string ?matchVar? ?subMatchVar ",
- "subMatchVar ...?\"", (char *) NULL);
- return TCL_ERROR;
- }
- argPtr = argv+1;
- argc--;
- while ((argc > 0) && (argPtr[0][0] == '-')) {
- if (strcmp(argPtr[0], "-indices") == 0) {
- indices = 1;
- } else if (strcmp(argPtr[0], "-nocase") == 0) {
- noCase = 1;
- } else if (strcmp(argPtr[0], "--") == 0) {
- argPtr++;
- argc--;
+ Tcl_Obj *objPtr, *resultPtr;
+ Tcl_RegExpInfo info;
+ static char *options[] = {
+ "-all", "-about", "-indices", "-inline",
+ "-expanded", "-line", "-linestop", "-lineanchor",
+ "-nocase", "-start", "--", (char *) NULL
+ };
+ enum options {
+ REGEXP_ALL, REGEXP_ABOUT, REGEXP_INDICES, REGEXP_INLINE,
+ REGEXP_EXPANDED,REGEXP_LINE, REGEXP_LINESTOP,REGEXP_LINEANCHOR,
+ REGEXP_NOCASE, REGEXP_START, REGEXP_LAST
+ };
+
+ indices = 0;
+ about = 0;
+ cflags = TCL_REG_ADVANCED;
+ eflags = 0;
+ offset = 0;
+ all = 0;
+ doinline = 0;
+
+ for (i = 1; i < objc; i++) {
+ char *name;
+ int index;
+
+ name = Tcl_GetString(objv[i]);
+ if (name[0] != '-') {
break;
- } else {
- Tcl_AppendResult(interp, "bad switch \"", argPtr[0],
- "\": must be -indices, -nocase, or --", (char *) NULL);
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- argPtr++;
- argc--;
- }
- if (argc < 2) {
- goto wrongNumArgs;
- }
-
- /*
- * Convert the string and pattern to lower case, if desired, and
- * perform the matching operation.
- */
-
- if (noCase) {
- register char *p;
-
- Tcl_DStringInit(&patternDString);
- Tcl_DStringAppend(&patternDString, argPtr[0], -1);
- pattern = Tcl_DStringValue(&patternDString);
- for (p = pattern; *p != 0; p++) {
- if (isupper(UCHAR(*p))) {
- *p = (char)tolower(UCHAR(*p));
+ switch ((enum options) index) {
+ case REGEXP_ALL: {
+ all = 1;
+ break;
}
- }
- Tcl_DStringInit(&stringDString);
- Tcl_DStringAppend(&stringDString, argPtr[1], -1);
- string = Tcl_DStringValue(&stringDString);
- for (p = string; *p != 0; p++) {
- if (isupper(UCHAR(*p))) {
- *p = (char)tolower(UCHAR(*p));
+ case REGEXP_INDICES: {
+ indices = 1;
+ break;
+ }
+ case REGEXP_INLINE: {
+ doinline = 1;
+ break;
+ }
+ case REGEXP_NOCASE: {
+ cflags |= TCL_REG_NOCASE;
+ break;
+ }
+ case REGEXP_ABOUT: {
+ about = 1;
+ break;
+ }
+ case REGEXP_EXPANDED: {
+ cflags |= TCL_REG_EXPANDED;
+ break;
+ }
+ case REGEXP_LINE: {
+ cflags |= TCL_REG_NEWLINE;
+ break;
+ }
+ case REGEXP_LINESTOP: {
+ cflags |= TCL_REG_NLSTOP;
+ break;
+ }
+ case REGEXP_LINEANCHOR: {
+ cflags |= TCL_REG_NLANCH;
+ break;
+ }
+ case REGEXP_START: {
+ if (++i >= objc) {
+ goto endOfForLoop;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (offset < 0) {
+ offset = 0;
+ }
+ break;
+ }
+ case REGEXP_LAST: {
+ i++;
+ goto endOfForLoop;
}
}
- } else {
- pattern = argPtr[0];
- string = argPtr[1];
- }
- regExpr = Tcl_RegExpCompile(interp, pattern);
- if (regExpr != NULL) {
- match = Tcl_RegExpExec(interp, regExpr, string, string);
}
- if (noCase) {
- Tcl_DStringFree(&stringDString);
- Tcl_DStringFree(&patternDString);
+
+ endOfForLoop:
+ if ((objc - i) < (2 - about)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
+ return TCL_ERROR;
}
- if (regExpr == NULL) {
+ objc -= i;
+ objv += i;
+
+ if (doinline && ((objc - 2) != 0)) {
+ /*
+ * User requested -inline, but specified match variables - a no-no.
+ */
+ Tcl_AppendResult(interp, "regexp match variables not allowed",
+ " when using -inline", (char *) NULL);
return TCL_ERROR;
}
- if (match < 0) {
+
+ regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
+ if (regExpr == NULL) {
return TCL_ERROR;
}
- if (!match) {
- Tcl_SetResult(interp, "0", TCL_STATIC);
+ objPtr = objv[1];
+
+ if (about) {
+ if (TclRegAbout(interp, regExpr) < 0) {
+ return TCL_ERROR;
+ }
return TCL_OK;
}
+ if (offset > 0) {
+ /*
+ * Add flag if using offset (string is part of a larger string),
+ * so that "^" won't match.
+ */
+ eflags |= TCL_REG_NOTBOL;
+ }
+
+ objc -= 2;
+ objv += 2;
+ resultPtr = Tcl_GetObjResult(interp);
+
+ if (doinline) {
+ /*
+ * Save all the subexpressions, as we will return them as a list
+ */
+ numMatchesSaved = -1;
+ } else {
+ /*
+ * Save only enough subexpressions for matches we want to keep,
+ * expect in the case of -all, where we need to keep at least
+ * one to know where to move the offset.
+ */
+ numMatchesSaved = (objc == 0) ? all : objc;
+ }
+
/*
- * If additional variable names have been specified, return
- * index information in those variables.
+ * Get the length of the string that we are matching against so
+ * we can do the termination test for -all matches.
+ */
+ stringLength = Tcl_GetCharLength(objPtr);
+
+ /*
+ * The following loop is to handle multiple matches within the
+ * same source string; each iteration handles one match. If "-all"
+ * hasn't been specified then the loop body only gets executed once.
+ * We terminate the loop when the starting offset is past the end of the
+ * string.
*/
- argc -= 2;
- for (i = 0; i < argc; i++) {
- char *result, info[50];
+ while (1) {
+ match = Tcl_RegExpExecObj(interp, regExpr, objPtr,
+ offset /* offset */, numMatchesSaved, eflags);
- Tcl_RegExpRange(regExpr, i, &start, &end);
- if (start == NULL) {
- if (indices) {
- result = Tcl_SetVar(interp, argPtr[i+2], "-1 -1", 0);
- } else {
- result = Tcl_SetVar(interp, argPtr[i+2], "", 0);
+ if (match < 0) {
+ return TCL_ERROR;
+ }
+
+ if (match == 0) {
+ /*
+ * We want to set the value of the intepreter result only when
+ * this is the first time through the loop.
+ */
+ if (all <= 1) {
+ /*
+ * If inlining, set the interpreter's object result to an
+ * empty list, otherwise set it to an integer object w/
+ * value 0.
+ */
+ if (doinline) {
+ Tcl_SetListObj(resultPtr, 0, NULL);
+ } else {
+ Tcl_SetIntObj(resultPtr, 0);
+ }
+ return TCL_OK;
}
- } else {
+ break;
+ }
+
+ /*
+ * If additional variable names have been specified, return
+ * index information in those variables.
+ */
+
+ Tcl_RegExpGetInfo(regExpr, &info);
+ if (doinline) {
+ /*
+ * It's the number of substitutions, plus one for the matchVar
+ * at index 0
+ */
+ objc = info.nsubs + 1;
+ }
+ for (i = 0; i < objc; i++) {
+ Tcl_Obj *newPtr;
+
if (indices) {
- sprintf(info, "%d %d", (int)(start - string),
- (int)(end - string - 1));
- result = Tcl_SetVar(interp, argPtr[i+2], info, 0);
- } else {
- char savedChar, *first, *last;
+ int start, end;
+ Tcl_Obj *objs[2];
- first = argPtr[1] + (start - string);
- last = argPtr[1] + (end - string);
- if (first == last) { /* don't modify argument */
- result = Tcl_SetVar(interp, argPtr[i+2], "", 0);
+ if (i <= info.nsubs) {
+ start = offset + info.matches[i].start;
+ end = offset + info.matches[i].end;
+
+ /*
+ * Adjust index so it refers to the last character in the
+ * match instead of the first character after the match.
+ */
+
+ if (end >= offset) {
+ end--;
+ }
} else {
- savedChar = *last;
- *last = 0;
- result = Tcl_SetVar(interp, argPtr[i+2], first, 0);
- *last = savedChar;
+ start = -1;
+ end = -1;
+ }
+
+ objs[0] = Tcl_NewLongObj(start);
+ objs[1] = Tcl_NewLongObj(end);
+
+ newPtr = Tcl_NewListObj(2, objs);
+ } else {
+ if (i <= info.nsubs) {
+ newPtr = Tcl_GetRange(objPtr,
+ offset + info.matches[i].start,
+ offset + info.matches[i].end - 1);
+ } else {
+ newPtr = Tcl_NewObj();
+ }
+ }
+ if (doinline) {
+ if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
+ != TCL_OK) {
+ Tcl_DecrRefCount(newPtr);
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_Obj *valuePtr;
+ valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
+ if (valuePtr == NULL) {
+ Tcl_DecrRefCount(newPtr);
+ Tcl_AppendResult(interp, "couldn't set variable \"",
+ Tcl_GetString(objv[i]), "\"", (char *) NULL);
+ return TCL_ERROR;
}
}
}
- if (result == NULL) {
- Tcl_AppendResult(interp, "couldn't set variable \"",
- argPtr[i+2], "\"", (char *) NULL);
- return TCL_ERROR;
+
+ if (all == 0) {
+ break;
+ }
+ /*
+ * Adjust the offset to the character just after the last one
+ * in the matchVar and increment all to count how many times
+ * we are making a match. We always increment the offset by at least
+ * one to prevent endless looping (as in the case:
+ * regexp -all {a*} a). Otherwise, when we match the NULL string at
+ * the end of the input string, we will loop indefinately (because the
+ * length of the match is 0, so offset never changes).
+ */
+ if (info.matches[0].end == 0) {
+ offset++;
+ }
+ offset += info.matches[0].end;
+ all++;
+ if (offset >= stringLength) {
+ break;
}
}
- Tcl_SetResult(interp, "1", TCL_STATIC);
+
+ /*
+ * Set the interpreter's object result to an integer object
+ * with value 1 if -all wasn't specified, otherwise it's all-1
+ * (the number of times through the while - 1).
+ */
+
+ if (!doinline) {
+ Tcl_SetIntObj(resultPtr, (all ? all-1 : 1));
+ }
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_RegsubCmd --
+ * Tcl_RegsubObjCmd --
*
* This procedure is invoked to process the "regsub" Tcl command.
* See the user documentation for details on what it does.
@@ -261,81 +438,112 @@ Tcl_RegexpCmd(dummy, interp, argc, argv)
/* ARGSUSED */
int
-Tcl_RegsubCmd(dummy, interp, argc, argv)
+Tcl_RegsubObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int noCase = 0, all = 0;
+ int i, result, cflags, all, wlen, numMatches, offset;
Tcl_RegExp regExpr;
- char *string, *pattern, *p, *firstChar, **argPtr;
- int match, code, numMatches;
- char *start, *end, *subStart, *subEnd;
- register char *src, c;
- Tcl_DString stringDString, patternDString, resultDString;
-
- if (argc < 5) {
- wrongNumArgs:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ?switches? exp string subSpec varName\"", (char *) NULL);
- return TCL_ERROR;
- }
- argPtr = argv+1;
- argc--;
- while (argPtr[0][0] == '-') {
- if (strcmp(argPtr[0], "-nocase") == 0) {
- noCase = 1;
- } else if (strcmp(argPtr[0], "-all") == 0) {
- all = 1;
- } else if (strcmp(argPtr[0], "--") == 0) {
- argPtr++;
- argc--;
+ Tcl_Obj *resultPtr, *varPtr, *objPtr;
+ Tcl_UniChar *wstring;
+ char *subspec;
+
+ static char *options[] = {
+ "-all", "-nocase", "-expanded",
+ "-line", "-linestop", "-lineanchor", "-start",
+ "--", NULL
+ };
+ enum options {
+ REGSUB_ALL, REGSUB_NOCASE, REGSUB_EXPANDED,
+ REGSUB_LINE, REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_START,
+ REGSUB_LAST
+ };
+
+ cflags = TCL_REG_ADVANCED;
+ all = 0;
+ offset = 0;
+
+ for (i = 1; i < objc; i++) {
+ char *name;
+ int index;
+
+ name = Tcl_GetString(objv[i]);
+ if (name[0] != '-') {
break;
- } else {
- Tcl_AppendResult(interp, "bad switch \"", argPtr[0],
- "\": must be -all, -nocase, or --", (char *) NULL);
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- argPtr++;
- argc--;
- }
- if (argc != 4) {
- goto wrongNumArgs;
- }
-
- /*
- * Convert the string and pattern to lower case, if desired.
- */
-
- if (noCase) {
- Tcl_DStringInit(&patternDString);
- Tcl_DStringAppend(&patternDString, argPtr[0], -1);
- pattern = Tcl_DStringValue(&patternDString);
- for (p = pattern; *p != 0; p++) {
- if (isupper(UCHAR(*p))) {
- *p = (char)tolower(UCHAR(*p));
+ switch ((enum options) index) {
+ case REGSUB_ALL: {
+ all = 1;
+ break;
}
- }
- Tcl_DStringInit(&stringDString);
- Tcl_DStringAppend(&stringDString, argPtr[1], -1);
- string = Tcl_DStringValue(&stringDString);
- for (p = string; *p != 0; p++) {
- if (isupper(UCHAR(*p))) {
- *p = (char)tolower(UCHAR(*p));
+ case REGSUB_NOCASE: {
+ cflags |= TCL_REG_NOCASE;
+ break;
+ }
+ case REGSUB_EXPANDED: {
+ cflags |= TCL_REG_EXPANDED;
+ break;
+ }
+ case REGSUB_LINE: {
+ cflags |= TCL_REG_NEWLINE;
+ break;
+ }
+ case REGSUB_LINESTOP: {
+ cflags |= TCL_REG_NLSTOP;
+ break;
+ }
+ case REGSUB_LINEANCHOR: {
+ cflags |= TCL_REG_NLANCH;
+ break;
+ }
+ case REGSUB_START: {
+ if (++i >= objc) {
+ goto endOfForLoop;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (offset < 0) {
+ offset = 0;
+ }
+ break;
+ }
+ case REGSUB_LAST: {
+ i++;
+ goto endOfForLoop;
}
}
- } else {
- pattern = argPtr[0];
- string = argPtr[1];
}
- Tcl_DStringInit(&resultDString);
- regExpr = Tcl_RegExpCompile(interp, pattern);
+ endOfForLoop:
+ if (objc - i != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?switches? exp string subSpec varName");
+ return TCL_ERROR;
+ }
+
+ objv += i;
+
+ regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
if (regExpr == NULL) {
- code = TCL_ERROR;
- goto done;
+ return TCL_ERROR;
}
+ result = TCL_OK;
+ resultPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(resultPtr);
+
+ objPtr = objv[1];
+ wlen = Tcl_GetCharLength(objPtr);
+ wstring = Tcl_GetUnicode(objPtr);
+ subspec = Tcl_GetString(objv[2]);
+ varPtr = objv[3];
+
/*
* The following loop is to handle multiple matches within the
* same source string; each iteration handles one match and its
@@ -344,33 +552,55 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
*/
numMatches = 0;
- for (p = string; *p != 0; ) {
- match = Tcl_RegExpExec(interp, regExpr, p, string);
+ for ( ; offset < wlen; ) {
+ int start, end, subStart, subEnd, match;
+ char *src, *firstChar;
+ char c;
+ Tcl_RegExpInfo info;
+
+ /*
+ * The flags argument is set if string is part of a larger string,
+ * so that "^" won't match.
+ */
+
+ match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
+ 10 /* matches */, ((offset > 0) ? TCL_REG_NOTBOL : 0));
+
if (match < 0) {
- code = TCL_ERROR;
+ result = TCL_ERROR;
goto done;
}
- if (!match) {
+ if (match == 0) {
break;
}
- numMatches += 1;
+ if ((numMatches == 0) && (offset > 0)) {
+ /* Copy the initial portion of the string in if an offset
+ * was specified.
+ */
+ Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
+ }
+ numMatches++;
/*
* Copy the portion of the source string before the match to the
* result variable.
*/
- Tcl_RegExpRange(regExpr, 0, &start, &end);
- Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), start - p);
-
+ Tcl_RegExpGetInfo(regExpr, &info);
+ start = info.matches[0].start;
+ end = info.matches[0].end;
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start);
+
/*
* Append the subSpec argument to the variable, making appropriate
* substitutions. This code is a bit hairy because of the backslash
* conventions and because the code saves up ranges of characters in
* subSpec to reduce the number of calls to Tcl_SetVar.
*/
-
- for (src = firstChar = argPtr[2], c = *src; c != 0; src++, c = *src) {
+
+ src = subspec;
+ firstChar = subspec;
+ for (c = *src; c != '\0'; src++, c = *src) {
int index;
if (c == '&') {
@@ -380,12 +610,9 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
if ((c >= '0') && (c <= '9')) {
index = c - '0';
} else if ((c == '\\') || (c == '&')) {
- *src = c;
- src[1] = 0;
- Tcl_DStringAppend(&resultDString, firstChar, -1);
- *src = '\\';
- src[1] = c;
- firstChar = src+2;
+ Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
+ Tcl_AppendToObj(resultPtr, &c, 1);
+ firstChar = src + 2;
src++;
continue;
} else {
@@ -395,42 +622,34 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
continue;
}
if (firstChar != src) {
- c = *src;
- *src = 0;
- Tcl_DStringAppend(&resultDString, firstChar, -1);
- *src = c;
- }
- Tcl_RegExpRange(regExpr, index, &subStart, &subEnd);
- if ((subStart != NULL) && (subEnd != NULL)) {
- char *first, *last, saved;
-
- first = argPtr[1] + (subStart - string);
- last = argPtr[1] + (subEnd - string);
- saved = *last;
- *last = 0;
- Tcl_DStringAppend(&resultDString, first, -1);
- *last = saved;
+ Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
+ }
+ if (index <= info.nsubs) {
+ subStart = info.matches[index].start;
+ subEnd = info.matches[index].end;
+ if ((subStart >= 0) && (subEnd >= 0)) {
+ Tcl_AppendUnicodeToObj(resultPtr,
+ wstring + offset + subStart, subEnd - subStart);
+ }
}
if (*src == '\\') {
src++;
}
- firstChar = src+1;
+ firstChar = src + 1;
}
if (firstChar != src) {
- Tcl_DStringAppend(&resultDString, firstChar, -1);
+ Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
}
- if (end == p) {
-
+ if (end == 0) {
/*
* Always consume at least one character of the input string
* in order to prevent infinite loops.
*/
- Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), 1);
- p = end + 1;
- } else {
- p = end;
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
+ offset++;
}
+ offset += end;
if (!all) {
break;
}
@@ -441,30 +660,31 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
* result variable.
*/
- if ((*p != 0) || (numMatches == 0)) {
- Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), -1);
+ if (numMatches == 0) {
+ /*
+ * On zero matches, just ignore the offset, since it shouldn't
+ * matter to us in this case, and the user may have skewed it.
+ */
+ Tcl_AppendUnicodeToObj(resultPtr, wstring, wlen);
+ } else if (offset < wlen) {
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
}
- if (Tcl_SetVar(interp, argPtr[3], Tcl_DStringValue(&resultDString), 0)
- == NULL) {
- Tcl_AppendResult(interp,
- "couldn't set variable \"", argPtr[3], "\"",
- (char *) NULL);
- code = TCL_ERROR;
+ if (Tcl_ObjSetVar2(interp, varPtr, NULL, resultPtr, 0) == NULL) {
+ Tcl_AppendResult(interp, "couldn't set variable \"",
+ Tcl_GetString(varPtr), "\"", (char *) NULL);
+ result = TCL_ERROR;
} else {
- char buf[40];
+ /*
+ * Set the interpreter's object result to an integer object holding the
+ * number of matches.
+ */
- TclFormatInt(buf, numMatches);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- code = TCL_OK;
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
}
done:
- if (noCase) {
- Tcl_DStringFree(&stringDString);
- Tcl_DStringFree(&patternDString);
- }
- Tcl_DStringFree(&resultDString);
- return code;
+ Tcl_DecrRefCount(resultPtr);
+ return result;
}
/*
@@ -499,8 +719,8 @@ Tcl_RenameObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- oldName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
- newName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ oldName = Tcl_GetString(objv[1]);
+ newName = Tcl_GetString(objv[2]);
return TclRenameCommand(interp, oldName, newName);
}
@@ -541,10 +761,6 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv)
iPtr->errorCode = NULL;
}
code = TCL_OK;
-
- /*
- * THIS FAILS IF AN OBJECT CONTAINS AN EMBEDDED NULL.
- */
for (objv++, objc--; objc > 1; objv += 2, objc -= 2) {
char *option = Tcl_GetStringFromObj(objv[0], &optionLen);
@@ -569,7 +785,7 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv)
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad completion code \"",
- Tcl_GetStringFromObj(objv[1], (int *) NULL),
+ Tcl_GetString(objv[1]),
"\": must be ok, error, return, break, ",
"continue, or an integer", (char *) NULL);
return result;
@@ -607,310 +823,6 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * Tcl_ScanCmd --
- *
- * This procedure is invoked to process the "scan" Tcl command.
- * See the user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-int
-Tcl_ScanCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
-{
-# define MAX_FIELDS 20
- typedef struct {
- char fmt; /* Format for field. */
- int size; /* How many bytes to allow for
- * field. */
- char *location; /* Where field will be stored. */
- } Field;
- Field fields[MAX_FIELDS]; /* Info about all the fields in the
- * format string. */
- register Field *curField;
- int numFields = 0; /* Number of fields actually
- * specified. */
- int suppress; /* Current field is assignment-
- * suppressed. */
- int totalSize = 0; /* Number of bytes needed to store
- * all results combined. */
- char *results; /* Where scanned output goes.
- * Malloced; NULL means not allocated
- * yet. */
- int numScanned; /* sscanf's result. */
- register char *fmt;
- int i, widthSpecified, length, code;
- char buf[40];
-
- /*
- * The variables below are used to hold a copy of the format
- * string, so that we can replace format specifiers like "%f"
- * and "%F" with specifiers like "%lf"
- */
-
-# define STATIC_SIZE 5
- char copyBuf[STATIC_SIZE], *fmtCopy;
- register char *dst;
-
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " string format ?varName varName ...?\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- * This procedure operates in four stages:
- * 1. Scan the format string, collecting information about each field.
- * 2. Allocate an array to hold all of the scanned fields.
- * 3. Call sscanf to do all the dirty work, and have it store the
- * parsed fields in the array.
- * 4. Pick off the fields from the array and assign them to variables.
- */
-
- code = TCL_OK;
- results = NULL;
- length = strlen(argv[2]) * 2 + 1;
- if (length < STATIC_SIZE) {
- fmtCopy = copyBuf;
- } else {
- fmtCopy = (char *) ckalloc((unsigned) length);
- }
- dst = fmtCopy;
- for (fmt = argv[2]; *fmt != 0; fmt++) {
- *dst = *fmt;
- dst++;
- if (*fmt != '%') {
- continue;
- }
- fmt++;
- if (*fmt == '%') {
- *dst = *fmt;
- dst++;
- continue;
- }
- if (*fmt == '*') {
- suppress = 1;
- *dst = *fmt;
- dst++;
- fmt++;
- } else {
- suppress = 0;
- }
- widthSpecified = 0;
- while (isdigit(UCHAR(*fmt))) {
- widthSpecified = 1;
- *dst = *fmt;
- dst++;
- fmt++;
- }
- if ((*fmt == 'l') || (*fmt == 'h') || (*fmt == 'L')) {
- fmt++;
- }
- *dst = *fmt;
- dst++;
- if (suppress) {
- continue;
- }
- if (numFields == MAX_FIELDS) {
- Tcl_SetResult(interp, "too many fields to scan", TCL_STATIC);
- code = TCL_ERROR;
- goto done;
- }
- curField = &fields[numFields];
- numFields++;
- switch (*fmt) {
- case 'd':
- case 'i':
- case 'o':
- case 'x':
- curField->fmt = 'd';
- curField->size = sizeof(int);
- break;
-
- case 'u':
- curField->fmt = 'u';
- curField->size = sizeof(int);
- break;
-
- case 's':
- curField->fmt = 's';
- curField->size = strlen(argv[1]) + 1;
- break;
-
- case 'c':
- if (widthSpecified) {
- Tcl_SetResult(interp,
- "field width may not be specified in %c conversion",
- TCL_STATIC);
- code = TCL_ERROR;
- goto done;
- }
- curField->fmt = 'c';
- curField->size = sizeof(int);
- break;
-
- case 'e':
- case 'f':
- case 'g':
- dst[-1] = 'l';
- dst[0] = 'f';
- dst++;
- curField->fmt = 'f';
- curField->size = sizeof(double);
- break;
-
- case '[':
- curField->fmt = 's';
- curField->size = strlen(argv[1]) + 1;
- do {
- fmt++;
- if (*fmt == 0) {
- Tcl_SetResult(interp,
- "unmatched [ in format string", TCL_STATIC);
- code = TCL_ERROR;
- goto done;
- }
- *dst = *fmt;
- dst++;
- } while (*fmt != ']');
- break;
-
- default:
- {
- char buf[50];
-
- sprintf(buf, "bad scan conversion character \"%c\"", *fmt);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- code = TCL_ERROR;
- goto done;
- }
- }
- curField->size = TCL_ALIGN(curField->size);
- totalSize += curField->size;
- }
- *dst = 0;
-
- if (numFields != (argc-3)) {
- Tcl_SetResult(interp,
- "different numbers of variable names and field specifiers",
- TCL_STATIC);
- code = TCL_ERROR;
- goto done;
- }
-
- /*
- * Step 2:
- */
-
- results = (char *) ckalloc((unsigned) totalSize);
- for (i = 0, totalSize = 0, curField = fields;
- i < numFields; i++, curField++) {
- curField->location = results + totalSize;
- totalSize += curField->size;
- }
-
- /*
- * Fill in the remaining fields with NULL; the only purpose of
- * this is to keep some memory analyzers, like Purify, from
- * complaining.
- */
-
- for ( ; i < MAX_FIELDS; i++, curField++) {
- curField->location = NULL;
- }
-
- /*
- * Step 3:
- */
-
- numScanned = sscanf(argv[1], fmtCopy,
- fields[0].location, fields[1].location, fields[2].location,
- fields[3].location, fields[4].location, fields[5].location,
- fields[6].location, fields[7].location, fields[8].location,
- fields[9].location, fields[10].location, fields[11].location,
- fields[12].location, fields[13].location, fields[14].location,
- fields[15].location, fields[16].location, fields[17].location,
- fields[18].location, fields[19].location);
-
- /*
- * Step 4:
- */
-
- if (numScanned < numFields) {
- numFields = numScanned;
- }
- for (i = 0, curField = fields; i < numFields; i++, curField++) {
- switch (curField->fmt) {
- char string[TCL_DOUBLE_SPACE];
-
- case 'd':
- TclFormatInt(string, *((int *) curField->location));
- if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
- storeError:
- Tcl_AppendResult(interp,
- "couldn't set variable \"", argv[i+3], "\"",
- (char *) NULL);
- code = TCL_ERROR;
- goto done;
- }
- break;
-
- case 'u':
- sprintf(string, "%u", *((int *) curField->location));
- if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
- goto storeError;
- }
- break;
-
- case 'c':
- TclFormatInt(string, *((char *) curField->location) & 0xff);
- if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
- goto storeError;
- }
- break;
-
- case 's':
- if (Tcl_SetVar(interp, argv[i+3], curField->location, 0)
- == NULL) {
- goto storeError;
- }
- break;
-
- case 'f':
- Tcl_PrintDouble((Tcl_Interp *) NULL,
- *((double *) curField->location), string);
- if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
- goto storeError;
- }
- break;
- }
- }
- TclFormatInt(buf, numScanned);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- done:
- if (results != NULL) {
- ckfree(results);
- }
- if (fmtCopy != copyBuf) {
- ckfree(fmtCopy);
- }
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_SourceObjCmd --
*
* This procedure is invoked to process the "source" Tcl command.
@@ -941,11 +853,7 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS A NULL.
- */
-
- bytes = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+ bytes = Tcl_GetString(objv[1]);
result = Tcl_EvalFile(interp, bytes);
return result;
}
@@ -975,10 +883,11 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- register char *p, *p2;
- char *splitChars, *string, *elementStart;
- int splitCharLen, stringLen, i, j;
- Tcl_Obj *listPtr;
+ Tcl_UniChar ch;
+ int len;
+ char *splitChars, *string, *end;
+ int splitCharLen, stringLen;
+ Tcl_Obj *listPtr, *objPtr;
if (objc == 2) {
splitChars = " \n\t\r";
@@ -991,41 +900,50 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
}
string = Tcl_GetStringFromObj(objv[1], &stringLen);
- listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ end = string + stringLen;
+ listPtr = Tcl_GetObjResult(interp);
- /*
- * Handle the special case of splitting on every character.
- */
+ if (stringLen == 0) {
+ /*
+ * Do nothing.
+ */
+ } else if (splitCharLen == 0) {
+ /*
+ * Handle the special case of splitting on every character.
+ */
- if (splitCharLen == 0) {
- for (i = 0, p = string; i < stringLen; i++, p++) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(p, 1));
+ for ( ; string < end; string += len) {
+ len = Tcl_UtfToUniChar(string, &ch);
+ objPtr = Tcl_NewStringObj(string, len);
+ Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
}
} else {
+ char *element, *p, *splitEnd;
+ int splitLen;
+ Tcl_UniChar splitChar;
+
/*
* Normal case: split on any of a given set of characters.
* Discard instances of the split characters.
*/
- for (i = 0, p = elementStart = string; i < stringLen; i++, p++) {
- for (j = 0, p2 = splitChars; j < splitCharLen; j++, p2++) {
- if (*p2 == *p) {
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(elementStart, (p-elementStart)));
- elementStart = p+1;
+ splitEnd = splitChars + splitCharLen;
+
+ for (element = string; string < end; string += len) {
+ len = Tcl_UtfToUniChar(string, &ch);
+ for (p = splitChars; p < splitEnd; p += splitLen) {
+ splitLen = Tcl_UtfToUniChar(p, &splitChar);
+ if (ch == splitChar) {
+ objPtr = Tcl_NewStringObj(element, string - element);
+ Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
+ element = string + len;
break;
}
}
}
- if (p != string) {
- int remainingChars = stringLen - (elementStart-string);
- Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj(elementStart, remainingChars));
- }
+ objPtr = Tcl_NewStringObj(element, string - element);
+ Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
}
-
- Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -1035,7 +953,9 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
* Tcl_StringObjCmd --
*
* This procedure is invoked to process the "string" Tcl command.
- * See the user documentation for details on what it does.
+ * See the user documentation for details on what it does. Note
+ * that this command only functions correctly on properly formed
+ * Tcl UTF strings.
*
* Results:
* A standard Tcl result.
@@ -1059,18 +979,22 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
char *string1, *string2;
int length1, length2;
static char *options[] = {
- "compare", "first", "index", "last",
- "length", "match", "range", "tolower",
- "toupper", "trim", "trimleft", "trimright",
- "wordend", "wordstart", NULL
+ "bytelength", "compare", "equal", "first",
+ "index", "is", "last", "length",
+ "map", "match", "range", "repeat",
+ "replace", "tolower", "toupper", "totitle",
+ "trim", "trimleft", "trimright",
+ "wordend", "wordstart", (char *) NULL
};
enum options {
- STR_COMPARE, STR_FIRST, STR_INDEX, STR_LAST,
- STR_LENGTH, STR_MATCH, STR_RANGE, STR_TOLOWER,
- STR_TOUPPER, STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT,
+ STR_BYTELENGTH, STR_COMPARE, STR_EQUAL, STR_FIRST,
+ STR_INDEX, STR_IS, STR_LAST, STR_LENGTH,
+ STR_MAP, STR_MATCH, STR_RANGE, STR_REPEAT,
+ STR_REPLACE, STR_TOLOWER, STR_TOUPPER, STR_TOTITLE,
+ STR_TRIM, STR_TRIMLEFT, STR_TRIMRIGHT,
STR_WORDEND, STR_WORDSTART
};
-
+
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
@@ -1083,92 +1007,558 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
resultPtr = Tcl_GetObjResult(interp);
switch ((enum options) index) {
+ case STR_EQUAL:
case STR_COMPARE: {
- int match, length;
+ int i, match, length, nocase = 0, reqlength = -1;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
+ if (objc < 4 || objc > 7) {
+ str_cmp_args:
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-nocase? ?-length int? string1 string2");
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- string2 = Tcl_GetStringFromObj(objv[3], &length2);
+ for (i = 2; i < objc-2; i++) {
+ string2 = Tcl_GetStringFromObj(objv[i], &length2);
+ if ((length2 > 1)
+ && strncmp(string2, "-nocase", (size_t) length2) == 0) {
+ nocase = 1;
+ } else if ((length2 > 1)
+ && strncmp(string2, "-length", (size_t) length2) == 0) {
+ if (i+1 >= objc-2) {
+ goto str_cmp_args;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[++i],
+ &reqlength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendStringsToObj(resultPtr, "bad option \"",
+ string2, "\": must be -nocase or -length",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ string1 = Tcl_GetStringFromObj(objv[objc-2], &length1);
+ string2 = Tcl_GetStringFromObj(objv[objc-1], &length2);
+ /*
+ * This is the min length IN BYTES of the two strings
+ */
length = (length1 < length2) ? length1 : length2;
- match = memcmp(string1, string2, (unsigned) length);
- if (match == 0) {
- match = length1 - length2;
+
+ if (reqlength == 0) {
+ /*
+ * Anything matches at 0 chars, right?
+ */
+
+ match = 0;
+ } else if (nocase || ((reqlength > 0) && (reqlength <= length))) {
+ /*
+ * with -nocase or -length we have to check true char length
+ * as it could be smaller than expected
+ */
+
+ length1 = Tcl_NumUtfChars(string1, length1);
+ length2 = Tcl_NumUtfChars(string2, length2);
+ length = (length1 < length2) ? length1 : length2;
+
+ /*
+ * Do the reqlength check again, against 0 as well for
+ * the benfit of nocase
+ */
+
+ if ((reqlength > 0) && (reqlength < length)) {
+ length = reqlength;
+ } else if (reqlength < 0) {
+ /*
+ * The requested length is negative, so we ignore it by
+ * setting it to the longer of the two lengths.
+ */
+
+ reqlength = (length1 > length2) ? length1 : length2;
+ }
+ if (nocase) {
+ match = Tcl_UtfNcasecmp(string1, string2,
+ (unsigned) length);
+ } else {
+ match = Tcl_UtfNcmp(string1, string2, (unsigned) length);
+ }
+ if ((match == 0) && (reqlength > length)) {
+ match = length1 - length2;
+ }
+ } else {
+ match = memcmp(string1, string2, (unsigned) length);
+ if (match == 0) {
+ match = length1 - length2;
+ }
+ }
+
+ if ((enum options) index == STR_EQUAL) {
+ Tcl_SetBooleanObj(resultPtr, (match) ? 0 : 1);
+ } else {
+ Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 :
+ (match < 0) ? -1 : 0));
}
- Tcl_SetIntObj(resultPtr, (match > 0) ? 1 : (match < 0) ? -1 : 0);
break;
}
case STR_FIRST: {
register char *p, *end;
- int match;
+ int match, utflen, start;
- if (objc != 4) {
- badFirstLastArgs:
- Tcl_WrongNumArgs(interp, 2, objv, "string1 string2");
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "string1 string2 ?startIndex?");
return TCL_ERROR;
}
+ /*
+ * This algorithm fails on improperly formed UTF strings.
+ * We are searching string2 for the sequence string1.
+ */
+
match = -1;
+ start = 0;
+ utflen = -1;
string1 = Tcl_GetStringFromObj(objv[2], &length1);
string2 = Tcl_GetStringFromObj(objv[3], &length2);
+
+ if (objc == 5) {
+ /*
+ * If a startIndex is specified, we will need to fast forward
+ * to that point in the string before we think about a match
+ */
+ utflen = Tcl_NumUtfChars(string2, length2);
+ if (TclGetIntForIndex(interp, objv[4], utflen-1,
+ &start) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (start >= utflen) {
+ goto str_first_done;
+ } else if (start > 0) {
+ if (length2 == utflen) {
+ /* no unicode chars */
+ string2 += start;
+ length2 -= start;
+ } else {
+ char *s = Tcl_UtfAtIndex(string2, start);
+ length2 -= s - string2;
+ string2 = s;
+ }
+ }
+ }
+
if (length1 > 0) {
end = string2 + length2 - length1 + 1;
for (p = string2; p < end; p++) {
- /*
- * Scan forward to find the first character.
- */
-
- p = memchr(p, *string1, (unsigned) (end - p));
- if (p == NULL) {
- break;
- }
- if (memcmp(string1, p, (unsigned) length1) == 0) {
- match = p - string2;
- break;
- }
+ /*
+ * Scan forward to find the first character.
+ */
+
+ p = memchr(p, *string1, (unsigned) (end - p));
+ if (p == NULL) {
+ break;
+ }
+ if (memcmp(string1, p, (unsigned) length1) == 0) {
+ match = p - string2;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Compute the character index of the matching string by
+ * counting the number of characters before the match.
+ */
+ str_first_done:
+ if (match != -1) {
+ if (objc == 4) {
+ match = Tcl_NumUtfChars(string2, match);
+ } else if (length2 == utflen) {
+ /* no unicode chars */
+ match += start;
+ } else {
+ match = start + Tcl_NumUtfChars(string2, match);
}
}
Tcl_SetIntObj(resultPtr, match);
break;
}
case STR_INDEX: {
- int index;
+ char buf[TCL_UTF_MAX];
+ Tcl_UniChar unichar;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+ /*
+ * If we have a ByteArray object, avoid indexing in the
+ * Utf string since the byte array contains one byte per
+ * character. Otherwise, use the Unicode string rep to
+ * get the index'th char.
+ */
+
+ if (objv[2]->typePtr == &tclByteArrayType) {
+
+ string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
+
+ if (TclGetIntForIndex(interp, objv[3], length1 - 1,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetByteArrayObj(resultPtr,
+ (unsigned char *)(&string1[index]), 1);
+ } else {
+ string1 = Tcl_GetStringFromObj(objv[2], &length1);
+
+ /*
+ * convert to Unicode internal rep to calulate what
+ * 'end' really means.
+ */
+
+ length2 = Tcl_GetCharLength(objv[2]);
+
+ if (TclGetIntForIndex(interp, objv[3], length2 - 1,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((index >= 0) && (index < length2)) {
+ unichar = Tcl_GetUniChar(objv[2], index);
+ length2 = Tcl_UniCharToUtf((int)unichar, buf);
+ Tcl_SetStringObj(resultPtr, buf, length2);
+ }
+ }
+ break;
+ }
+ case STR_IS: {
+ char *end;
+ Tcl_UniChar ch;
+
+ /*
+ * The UniChar comparison function
+ */
+
+ int (*chcomp)_ANSI_ARGS_((int)) = NULL;
+ int i, failat = 0, result = 1, strict = 0;
+ Tcl_Obj *objPtr, *failVarObj = NULL;
+
+ static char *isOptions[] = {
+ "alnum", "alpha", "ascii", "control",
+ "boolean", "digit", "double", "false",
+ "graph", "integer", "lower", "print",
+ "punct", "space", "true", "upper",
+ "wordchar", "xdigit", (char *) NULL
+ };
+ enum isOptions {
+ STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
+ STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_FALSE,
+ STR_IS_GRAPH, STR_IS_INT, STR_IS_LOWER, STR_IS_PRINT,
+ STR_IS_PUNCT, STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER,
+ STR_IS_WORD, STR_IS_XDIGIT
+ };
+
+ if (objc < 4 || objc > 7) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "class ?-strict? ?-failindex var? str");
return TCL_ERROR;
}
- if ((index >= 0) && (index < length1)) {
- Tcl_SetStringObj(resultPtr, string1 + index, 1);
+ if (Tcl_GetIndexFromObj(interp, objv[2], isOptions, "class", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc != 4) {
+ for (i = 3; i < objc-1; i++) {
+ string2 = Tcl_GetStringFromObj(objv[i], &length2);
+ if ((length2 > 1) &&
+ strncmp(string2, "-strict", (size_t) length2) == 0) {
+ strict = 1;
+ } else if ((length2 > 1) &&
+ strncmp(string2, "-failindex", (size_t) length2) == 0) {
+ if (i+1 >= objc-1) {
+ Tcl_WrongNumArgs(interp, 3, objv,
+ "?-strict? ?-failindex var? str");
+ return TCL_ERROR;
+ }
+ failVarObj = objv[++i];
+ } else {
+ Tcl_AppendStringsToObj(resultPtr, "bad option \"",
+ string2, "\": must be -strict or -failindex",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ /*
+ * We get the objPtr so that we can short-cut for some classes
+ * by checking the object type (int and double), but we need
+ * the string otherwise, because we don't want any conversion
+ * of type occuring (as, for example, Tcl_Get*FromObj would do
+ */
+ objPtr = objv[objc-1];
+ string1 = Tcl_GetStringFromObj(objPtr, &length1);
+ if (length1 == 0) {
+ if (strict) {
+ result = 0;
+ }
+ goto str_is_done;
}
+ end = string1 + length1;
+
+ /*
+ * When entering here, result == 1 and failat == 0
+ */
+ switch ((enum isOptions) index) {
+ case STR_IS_ALNUM:
+ chcomp = Tcl_UniCharIsAlnum;
+ break;
+ case STR_IS_ALPHA:
+ chcomp = Tcl_UniCharIsAlpha;
+ break;
+ case STR_IS_ASCII:
+ for (; string1 < end; string1++, failat++) {
+ /*
+ * This is a valid check in unicode, because all
+ * bytes < 0xC0 are single byte chars (but isascii
+ * limits that def'n to 0x80).
+ */
+ if (*((unsigned char *)string1) >= 0x80) {
+ result = 0;
+ break;
+ }
+ }
+ break;
+ case STR_IS_BOOL:
+ case STR_IS_TRUE:
+ case STR_IS_FALSE:
+ if (objPtr->typePtr == &tclBooleanType) {
+ if ((((enum isOptions) index == STR_IS_TRUE) &&
+ objPtr->internalRep.longValue == 0) ||
+ (((enum isOptions) index == STR_IS_FALSE) &&
+ objPtr->internalRep.longValue != 0)) {
+ result = 0;
+ }
+ } else if ((Tcl_GetBoolean(NULL, string1, &i)
+ == TCL_ERROR) ||
+ (((enum isOptions) index == STR_IS_TRUE) &&
+ i == 0) ||
+ (((enum isOptions) index == STR_IS_FALSE) &&
+ i != 0)) {
+ result = 0;
+ }
+ break;
+ case STR_IS_CONTROL:
+ chcomp = Tcl_UniCharIsControl;
+ break;
+ case STR_IS_DIGIT:
+ chcomp = Tcl_UniCharIsDigit;
+ break;
+ case STR_IS_DOUBLE: {
+ char *stop;
+
+ if ((objPtr->typePtr == &tclDoubleType) ||
+ (objPtr->typePtr == &tclIntType)) {
+ break;
+ }
+ /*
+ * This is adapted from Tcl_GetDouble
+ *
+ * The danger in this function is that
+ * "12345678901234567890" is an acceptable 'double',
+ * but will later be interp'd as an int by something
+ * like [expr]. Therefore, we check to see if it looks
+ * like an int, and if so we do a range check on it.
+ * If strtoul gets to the end, we know we either
+ * received an acceptable int, or over/underflow
+ */
+ if (TclLooksLikeInt(string1, length1)) {
+ errno = 0;
+ strtoul(string1, &stop, 0);
+ if (stop == end) {
+ if (errno == ERANGE) {
+ result = 0;
+ failat = -1;
+ }
+ break;
+ }
+ }
+ errno = 0;
+ strtod(string1, &stop); /* INTL: Tcl source. */
+ if (errno == ERANGE) {
+ /*
+ * if (errno == ERANGE), then it was an over/underflow
+ * problem, but in this method, we only want to know
+ * yes or no, so bad flow returns 0 (false) and sets
+ * the failVarObj to the string length.
+ */
+ result = 0;
+ failat = -1;
+ } else if (stop == string1) {
+ /*
+ * In this case, nothing like a number was found
+ */
+ result = 0;
+ failat = 0;
+ } else {
+ /*
+ * Assume we sucked up one char per byte
+ * and then we go onto SPACE, since we are
+ * allowed trailing whitespace
+ */
+ failat = stop - string1;
+ string1 = stop;
+ chcomp = Tcl_UniCharIsSpace;
+ }
+ break;
+ }
+ case STR_IS_GRAPH:
+ chcomp = Tcl_UniCharIsGraph;
+ break;
+ case STR_IS_INT: {
+ char *stop;
+
+ if ((objPtr->typePtr == &tclIntType) ||
+ (Tcl_GetInt(NULL, string1, &i) == TCL_OK)) {
+ break;
+ }
+ /*
+ * Like STR_IS_DOUBLE, but we use strtoul.
+ * Since Tcl_GetInt already failed, we set result to 0.
+ */
+ result = 0;
+ errno = 0;
+ strtoul(string1, &stop, 0); /* INTL: Tcl source. */
+ if (errno == ERANGE) {
+ /*
+ * if (errno == ERANGE), then it was an over/underflow
+ * problem, but in this method, we only want to know
+ * yes or no, so bad flow returns 0 (false) and sets
+ * the failVarObj to the string length.
+ */
+ failat = -1;
+ } else if (stop == string1) {
+ /*
+ * In this case, nothing like a number was found
+ */
+ failat = 0;
+ } else {
+ /*
+ * Assume we sucked up one char per byte
+ * and then we go onto SPACE, since we are
+ * allowed trailing whitespace
+ */
+ failat = stop - string1;
+ string1 = stop;
+ chcomp = Tcl_UniCharIsSpace;
+ }
+ break;
+ }
+ case STR_IS_LOWER:
+ chcomp = Tcl_UniCharIsLower;
+ break;
+ case STR_IS_PRINT:
+ chcomp = Tcl_UniCharIsPrint;
+ break;
+ case STR_IS_PUNCT:
+ chcomp = Tcl_UniCharIsPunct;
+ break;
+ case STR_IS_SPACE:
+ chcomp = Tcl_UniCharIsSpace;
+ break;
+ case STR_IS_UPPER:
+ chcomp = Tcl_UniCharIsUpper;
+ break;
+ case STR_IS_WORD:
+ chcomp = Tcl_UniCharIsWordChar;
+ break;
+ case STR_IS_XDIGIT: {
+ for (; string1 < end; string1++, failat++) {
+ /* INTL: We assume unicode is bad for this class */
+ if ((*((unsigned char *)string1) >= 0xC0) ||
+ !isxdigit(*(unsigned char *)string1)) {
+ result = 0;
+ break;
+ }
+ }
+ break;
+ }
+ }
+ if (chcomp != NULL) {
+ for (; string1 < end; string1 += length2, failat++) {
+ length2 = Tcl_UtfToUniChar(string1, &ch);
+ if (!chcomp(ch)) {
+ result = 0;
+ break;
+ }
+ }
+ }
+ str_is_done:
+ /*
+ * Only set the failVarObj when we will return 0
+ * and we have indicated a valid fail index (>= 0)
+ */
+ if ((result == 0) && (failVarObj != NULL) &&
+ Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat),
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetBooleanObj(resultPtr, result);
break;
}
case STR_LAST: {
register char *p;
- int match;
+ int match, utflen, start;
- if (objc != 4) {
- goto badFirstLastArgs;
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "string1 string2 ?startIndex?");
+ return TCL_ERROR;
}
+ /*
+ * This algorithm fails on improperly formed UTF strings.
+ */
+
match = -1;
+ start = 0;
+ utflen = -1;
string1 = Tcl_GetStringFromObj(objv[2], &length1);
string2 = Tcl_GetStringFromObj(objv[3], &length2);
+
+ if (objc == 5) {
+ /*
+ * If a startIndex is specified, we will need to restrict
+ * the string range to that char index in the string
+ */
+ utflen = Tcl_NumUtfChars(string2, length2);
+ if (TclGetIntForIndex(interp, objv[4], utflen-1,
+ &start) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (start < 0) {
+ goto str_last_done;
+ } else if (start < utflen) {
+ if (length2 == utflen) {
+ /* no unicode chars */
+ p = string2 + start + 1 - length1;
+ } else {
+ p = Tcl_UtfAtIndex(string2, start+1) - length1;
+ }
+ } else {
+ p = string2 + length2 - length1;
+ }
+ } else {
+ p = string2 + length2 - length1;
+ }
+
if (length1 > 0) {
- for (p = string2 + length2 - length1; p >= string2; p--) {
+ for (; p >= string2; p--) {
/*
* Scan backwards to find the first character.
*/
-
+
while ((p != string2) && (*p != *string1)) {
p--;
}
@@ -1178,28 +1568,175 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
}
}
+
+ /*
+ * Compute the character index of the matching string by counting
+ * the number of characters before the match.
+ */
+ str_last_done:
+ if (match != -1) {
+ if ((objc == 4) || (length2 != utflen)) {
+ /* only check when we've got unicode chars */
+ match = Tcl_NumUtfChars(string2, match);
+ }
+ }
Tcl_SetIntObj(resultPtr, match);
break;
}
+ case STR_BYTELENGTH:
case STR_LENGTH: {
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "string");
return TCL_ERROR;
}
- (void) Tcl_GetStringFromObj(objv[2], &length1);
- Tcl_SetIntObj(resultPtr, length1);
+ if ((enum options) index == STR_BYTELENGTH) {
+ (void) Tcl_GetStringFromObj(objv[2], &length1);
+ Tcl_SetIntObj(resultPtr, length1);
+ } else {
+ /*
+ * If we have a ByteArray object, avoid recomputing the
+ * string since the byte array contains one byte per
+ * character. Otherwise, use the Unicode string rep to
+ * calculate the length.
+ */
+
+ if (objv[2]->typePtr == &tclByteArrayType) {
+ (void) Tcl_GetByteArrayFromObj(objv[2], &length1);
+ Tcl_SetIntObj(resultPtr, length1);
+ } else {
+ Tcl_SetIntObj(resultPtr,
+ Tcl_GetCharLength(objv[2]));
+ }
+ }
+ break;
+ }
+ case STR_MAP: {
+ int uselen, mapElemc, len, nocase = 0;
+ Tcl_Obj **mapElemv;
+ char *end;
+ Tcl_UniChar ch;
+ int (*str_comp_fn)();
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string");
+ return TCL_ERROR;
+ }
+
+ if (objc == 5) {
+ string2 = Tcl_GetStringFromObj(objv[2], &length2);
+ if ((length2 > 1) &&
+ strncmp(string2, "-nocase", (size_t) length2) == 0) {
+ nocase = 1;
+ } else {
+ Tcl_AppendStringsToObj(resultPtr, "bad option \"",
+ string2, "\": must be -nocase",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (Tcl_ListObjGetElements(interp, objv[objc-2], &mapElemc,
+ &mapElemv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (mapElemc == 0) {
+ /*
+ * empty charMap, just return whatever string was given
+ */
+ Tcl_SetObjResult(interp, objv[objc-1]);
+ } else if (mapElemc & 1) {
+ /*
+ * The charMap must be an even number of key/value items
+ */
+ Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
+ return TCL_ERROR;
+ }
+ string1 = Tcl_GetStringFromObj(objv[objc-1], &length1);
+ if (length1 == 0) {
+ break;
+ }
+ end = string1 + length1;
+
+ if (nocase) {
+ length1 = Tcl_NumUtfChars(string1, length1);
+ str_comp_fn = Tcl_UtfNcasecmp;
+ } else {
+ str_comp_fn = memcmp;
+ }
+
+ for ( ; string1 < end; string1 += len) {
+ len = Tcl_UtfToUniChar(string1, &ch);
+ for (index = 0; index < mapElemc; index +=2) {
+ /*
+ * Get the key string to match on
+ */
+ string2 = Tcl_GetStringFromObj(mapElemv[index],
+ &length2);
+ if (nocase) {
+ uselen = Tcl_NumUtfChars(string2, length2);
+ } else {
+ uselen = length2;
+ }
+ if ((uselen > 0) && (uselen <= length1) &&
+ (str_comp_fn(string2, string1, uselen) == 0)) {
+ /*
+ * Adjust len to be full length of matched string
+ * it has to be the BYTE length
+ */
+ len = length2;
+ /*
+ * Change string2 and length2 to the map value
+ */
+ string2 = Tcl_GetStringFromObj(mapElemv[index+1],
+ &length2);
+ Tcl_AppendToObj(resultPtr, string2, length2);
+ break;
+ }
+ }
+ if (index == mapElemc) {
+ /*
+ * No match was found, put the char onto result
+ */
+ Tcl_AppendToObj(resultPtr, string1, len);
+ }
+ /*
+ * in nocase, length1 is in chars
+ * otherwise it is in bytes
+ */
+ if (nocase) {
+ length1--;
+ } else {
+ length1 -= len;
+ }
+ }
break;
}
case STR_MATCH: {
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "pattern string");
+ int nocase = 0;
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? pattern string");
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- string2 = Tcl_GetStringFromObj(objv[3], &length2);
- Tcl_SetBooleanObj(resultPtr, Tcl_StringMatch(string2, string1));
+ if (objc == 5) {
+ string2 = Tcl_GetStringFromObj(objv[2], &length2);
+ if ((length2 > 1) &&
+ strncmp(string2, "-nocase", (size_t) length2) == 0) {
+ nocase = 1;
+ } else {
+ Tcl_AppendStringsToObj(resultPtr, "bad option \"",
+ string2, "\": must be -nocase",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_SetBooleanObj(resultPtr,
+ Tcl_StringCaseMatch(Tcl_GetString(objv[objc-1]),
+ Tcl_GetString(objv[objc-2]),
+ nocase));
break;
}
case STR_RANGE: {
@@ -1210,87 +1747,209 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- if (TclGetIntForIndex(interp, objv[3], length1 - 1,
- &first) != TCL_OK) {
- return TCL_ERROR;
+ /*
+ * If we have a ByteArray object, avoid indexing in the
+ * Utf string since the byte array contains one byte per
+ * character. Otherwise, use the Unicode string rep to
+ * get the range.
+ */
+
+ if (objv[2]->typePtr == &tclByteArrayType) {
+
+ string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
+
+ if (TclGetIntForIndex(interp, objv[3], length1 - 1,
+ &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TclGetIntForIndex(interp, objv[4], length1 - 1,
+ &last) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= length1 - 1) {
+ last = length1 - 1;
+ }
+ if (last >= first) {
+ int numBytes = last - first + 1;
+ resultPtr = Tcl_NewByteArrayObj(
+ (unsigned char *) &string1[first], numBytes);
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ } else {
+ string1 = Tcl_GetStringFromObj(objv[2], &length1);
+
+ /*
+ * Convert to Unicode internal rep to calulate length and
+ * create a result object.
+ */
+
+ length2 = Tcl_GetCharLength(objv[2]) - 1;
+
+ if (TclGetIntForIndex(interp, objv[3], length2,
+ &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TclGetIntForIndex(interp, objv[4], length2,
+ &last) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= length2) {
+ last = length2;
+ }
+ if (last >= first) {
+ resultPtr = Tcl_GetRange(objv[2], first, last);
+ Tcl_SetObjResult(interp, resultPtr);
+ }
}
- if (TclGetIntForIndex(interp, objv[4], length1 - 1,
- &last) != TCL_OK) {
+ break;
+ }
+ case STR_REPEAT: {
+ int count;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string count");
return TCL_ERROR;
}
- if (first < 0) {
- first = 0;
- }
- if (last >= length1 - 1) {
- last = length1 - 1;
+
+ if (Tcl_GetIntFromObj(interp, objv[3], &count) != TCL_OK) {
+ return TCL_ERROR;
}
- if (last >= first) {
- Tcl_SetStringObj(resultPtr, string1 + first, last - first + 1);
+
+ string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ if (length1 > 0) {
+ for (index = 0; index < count; index++) {
+ Tcl_AppendToObj(resultPtr, string1, length1);
+ }
}
break;
}
- case STR_TOLOWER: {
- register char *p, *end;
+ case STR_REPLACE: {
+ int first, last;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ if (objc < 5 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "string first last ?string?");
return TCL_ERROR;
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ length1 = Tcl_NumUtfChars(string1, length1) - 1;
+ if (TclGetIntForIndex(interp, objv[3], length1,
+ &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TclGetIntForIndex(interp, objv[4], length1,
+ &last) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((last < first) || (first > length1) || (last < 0)) {
+ Tcl_SetObjResult(interp, objv[2]);
+ } else {
+ char *start, *end;
- /*
- * Since I know resultPtr is not a shared object, I can reach
- * in and diddle the bytes in its string rep to convert them in
- * place to lower case.
- */
-
- Tcl_SetStringObj(resultPtr, string1, length1);
- string1 = Tcl_GetStringFromObj(resultPtr, &length1);
- end = string1 + length1;
- for (p = string1; p < end; p++) {
- if (isupper(UCHAR(*p))) {
- *p = (char) tolower(UCHAR(*p));
+ if (first < 0) {
+ first = 0;
+ }
+ start = Tcl_UtfAtIndex(string1, first);
+ end = Tcl_UtfAtIndex(start, ((last > length1) ? length1 : last)
+ - first + 1);
+ Tcl_SetStringObj(resultPtr, string1, start - string1);
+ if (objc == 6) {
+ Tcl_AppendObjToObj(resultPtr, objv[5]);
+ }
+ if (last < length1) {
+ Tcl_AppendToObj(resultPtr, end, -1);
}
}
break;
}
- case STR_TOUPPER: {
- register char *p, *end;
-
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
+ case STR_TOLOWER:
+ case STR_TOUPPER:
+ case STR_TOTITLE:
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string ?first? ?last?");
return TCL_ERROR;
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
- /*
- * Since I know resultPtr is not a shared object, I can reach
- * in and diddle the bytes in its string rep to convert them in
- * place to upper case.
- */
+ if (objc == 3) {
+ /*
+ * Since the result object is not a shared object, it is
+ * safe to copy the string into the result and do the
+ * conversion in place. The conversion may change the length
+ * of the string, so reset the length after conversion.
+ */
+
+ Tcl_SetStringObj(resultPtr, string1, length1);
+ if ((enum options) index == STR_TOLOWER) {
+ length1 = Tcl_UtfToLower(Tcl_GetString(resultPtr));
+ } else if ((enum options) index == STR_TOUPPER) {
+ length1 = Tcl_UtfToUpper(Tcl_GetString(resultPtr));
+ } else {
+ length1 = Tcl_UtfToTitle(Tcl_GetString(resultPtr));
+ }
+ Tcl_SetObjLength(resultPtr, length1);
+ } else {
+ int first, last;
+ char *start, *end;
- Tcl_SetStringObj(resultPtr, string1, length1);
- string1 = Tcl_GetStringFromObj(resultPtr, &length1);
- end = string1 + length1;
- for (p = string1; p < end; p++) {
- if (islower(UCHAR(*p))) {
- *p = (char) toupper(UCHAR(*p));
+ length1 = Tcl_NumUtfChars(string1, length1) - 1;
+ if (TclGetIntForIndex(interp, objv[3], length1,
+ &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ last = first;
+ if ((objc == 5) && (TclGetIntForIndex(interp, objv[4], length1,
+ &last) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (last >= length1) {
+ last = length1;
}
+ if (last < first) {
+ Tcl_SetObjResult(interp, objv[2]);
+ break;
+ }
+ start = Tcl_UtfAtIndex(string1, first);
+ end = Tcl_UtfAtIndex(start, last - first + 1);
+ length2 = end-start;
+ string2 = ckalloc((size_t) length2+1);
+ memcpy(string2, start, (size_t) length2);
+ string2[length2] = '\0';
+ if ((enum options) index == STR_TOLOWER) {
+ length2 = Tcl_UtfToLower(string2);
+ } else if ((enum options) index == STR_TOUPPER) {
+ length2 = Tcl_UtfToUpper(string2);
+ } else {
+ length2 = Tcl_UtfToTitle(string2);
+ }
+ Tcl_SetStringObj(resultPtr, string1, start - string1);
+ Tcl_AppendToObj(resultPtr, string2, length2);
+ Tcl_AppendToObj(resultPtr, end, -1);
+ ckfree(string2);
}
break;
- }
+
case STR_TRIM: {
- char ch;
+ Tcl_UniChar ch, trim;
register char *p, *end;
char *check, *checkEnd;
+ int offset;
left = 1;
right = 1;
- trim:
+ dotrim:
if (objc == 4) {
string2 = Tcl_GetStringFromObj(objv[3], &length2);
} else if (objc == 3) {
@@ -1305,16 +1964,26 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
if (left) {
end = string1 + length1;
- for (p = string1; p < end; p++) {
- ch = *p;
- for (check = string2; ; check++) {
+ /*
+ * The outer loop iterates over the string. The inner
+ * loop iterates over the trim characters. The loops
+ * terminate as soon as a non-trim character is discovered
+ * and string1 is left pointing at the first non-trim
+ * character.
+ */
+
+ for (p = string1; p < end; p += offset) {
+ offset = Tcl_UtfToUniChar(p, &ch);
+
+ for (check = string2; ; ) {
if (check >= checkEnd) {
p = end;
break;
}
- if (ch == *check) {
- length1--;
- string1++;
+ check += Tcl_UtfToUniChar(check, &trim);
+ if (ch == trim) {
+ length1 -= offset;
+ string1 += offset;
break;
}
}
@@ -1322,16 +1991,25 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
if (right) {
end = string1;
+
+ /*
+ * The outer loop iterates over the string. The inner
+ * loop iterates over the trim characters. The loops
+ * terminate as soon as a non-trim character is discovered
+ * and length1 marks the last non-trim character.
+ */
+
for (p = string1 + length1; p > end; ) {
- p--;
- ch = *p;
- for (check = string2; ; check++) {
+ p = Tcl_UtfPrev(p, string1);
+ offset = Tcl_UtfToUniChar(p, &ch);
+ for (check = string2; ; ) {
if (check >= checkEnd) {
p = end;
break;
}
- if (ch == *check) {
- length1--;
+ check += Tcl_UtfToUniChar(check, &trim);
+ if (ch == trim) {
+ length1 -= offset;
break;
}
}
@@ -1343,15 +2021,18 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
case STR_TRIMLEFT: {
left = 1;
right = 0;
- goto trim;
+ goto dotrim;
}
case STR_TRIMRIGHT: {
left = 0;
right = 1;
- goto trim;
+ goto dotrim;
}
case STR_WORDEND: {
- int cur, c;
+ int cur;
+ Tcl_UniChar ch;
+ char *p, *end;
+ int numChars;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "string index");
@@ -1359,29 +2040,37 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
- if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
- return TCL_ERROR;
+ numChars = Tcl_NumUtfChars(string1, length1);
+ if (TclGetIntForIndex(interp, objv[3], numChars-1,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
}
if (index < 0) {
index = 0;
}
- cur = length1;
- if (index < length1) {
- for (cur = index; cur < length1; cur++) {
- c = UCHAR(string1[cur]);
- if (!isalnum(c) && (c != '_')) {
+ if (index < numChars) {
+ p = Tcl_UtfAtIndex(string1, index);
+ end = string1+length1;
+ for (cur = index; p < end; cur++) {
+ p += Tcl_UtfToUniChar(p, &ch);
+ if (!Tcl_UniCharIsWordChar(ch)) {
break;
}
}
if (cur == index) {
- cur = index + 1;
+ cur++;
}
+ } else {
+ cur = numChars;
}
Tcl_SetIntObj(resultPtr, cur);
break;
}
case STR_WORDSTART: {
- int cur, c;
+ int cur;
+ Tcl_UniChar ch;
+ char *p;
+ int numChars;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "string index");
@@ -1389,19 +2078,23 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
- if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
+ numChars = Tcl_NumUtfChars(string1, length1);
+ if (TclGetIntForIndex(interp, objv[3], numChars-1,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- if (index >= length1) {
- index = length1 - 1;
+ if (index >= numChars) {
+ index = numChars - 1;
}
cur = 0;
if (index > 0) {
+ p = Tcl_UtfAtIndex(string1, index);
for (cur = index; cur >= 0; cur--) {
- c = UCHAR(string1[cur]);
- if (!isalnum(c) && (c != '_')) {
+ Tcl_UtfToUniChar(p, &ch);
+ if (!Tcl_UniCharIsWordChar(ch)) {
break;
}
+ p = Tcl_UtfPrev(p, string1);
}
if (cur != index) {
cur += 1;
@@ -1417,7 +2110,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * Tcl_SubstCmd --
+ * Tcl_SubstObjCmd --
*
* This procedure is invoked to process the "subst" Tcl command.
* See the user documentation for details on what it does. This
@@ -1435,51 +2128,59 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_SubstCmd(dummy, interp, argc, argv)
+Tcl_SubstObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ static char *substOptions[] = {
+ "-nobackslashes", "-nocommands", "-novariables", (char *) NULL
+ };
+ enum substOptions {
+ SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
+ };
Interp *iPtr = (Interp *) interp;
Tcl_DString result;
char *p, *old, *value;
- int code, count, doVars, doCmds, doBackslashes, i;
- size_t length;
- char c;
+ int optionIndex, code, count, doVars, doCmds, doBackslashes, i;
/*
* Parse command-line options.
*/
doVars = doCmds = doBackslashes = 1;
- for (i = 1; i < (argc-1); i++) {
- p = argv[i];
+ for (i = 1; i < (objc-1); i++) {
+ p = Tcl_GetString(objv[i]);
if (*p != '-') {
break;
}
- length = strlen(p);
- if (length < 4) {
- badSwitch:
- Tcl_AppendResult(interp, "bad switch \"", p,
- "\": must be -nobackslashes, -nocommands, ",
- "or -novariables", (char *) NULL);
+ if (Tcl_GetIndexFromObj(interp, objv[i], substOptions,
+ "switch", 0, &optionIndex) != TCL_OK) {
+
return TCL_ERROR;
}
- if ((p[3] == 'b') && (strncmp(p, "-nobackslashes", length) == 0)) {
- doBackslashes = 0;
- } else if ((p[3] == 'c') && (strncmp(p, "-nocommands", length) == 0)) {
- doCmds = 0;
- } else if ((p[3] == 'v') && (strncmp(p, "-novariables", length) == 0)) {
- doVars = 0;
- } else {
- goto badSwitch;
+ switch (optionIndex) {
+ case SUBST_NOBACKSLASHES: {
+ doBackslashes = 0;
+ break;
+ }
+ case SUBST_NOCOMMANDS: {
+ doCmds = 0;
+ break;
+ }
+ case SUBST_NOVARS: {
+ doVars = 0;
+ break;
+ }
+ default: {
+ panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
+ }
}
}
- if (i != (argc-1)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ?-nobackslashes? ?-nocommands? ?-novariables? string\"",
- (char *) NULL);
+ if (i != (objc-1)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-nobackslashes? ?-nocommands? ?-novariables? string");
return TCL_ERROR;
}
@@ -1489,16 +2190,18 @@ Tcl_SubstCmd(dummy, interp, argc, argv)
*/
Tcl_DStringInit(&result);
- old = p = argv[i];
+ old = p = Tcl_GetString(objv[i]);
while (*p != 0) {
switch (*p) {
case '\\':
if (doBackslashes) {
+ char buf[TCL_UTF_MAX];
+
if (p != old) {
Tcl_DStringAppend(&result, old, p-old);
}
- c = Tcl_Backslash(p, &count);
- Tcl_DStringAppend(&result, &c, 1);
+ Tcl_DStringAppend(&result, buf,
+ Tcl_UtfBackslash(p, &count, buf));
p += count;
old = p;
} else {
@@ -1579,59 +2282,43 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
-#define EXACT 0
-#define GLOB 1
-#define REGEXP 2
- int switchObjc, index;
- Tcl_Obj *CONST *switchObjv;
- Tcl_Obj *patternObj, *bodyObj;
- char *string, *pattern, *body;
- int splitObjs, length, patternLen, i, code, mode, matched, bodyIdx;
- static char *switches[] =
- {"-exact", "-glob", "-regexp", "--", (char *) NULL};
-
- switchObjc = objc-1;
- switchObjv = objv+1;
- mode = EXACT;
-
- while (switchObjc > 0) {
- string = Tcl_GetStringFromObj(switchObjv[0], &length);
- if (*string != '-') {
+ int i, j, index, mode, matched, result, splitObjs, seenComment;
+ char *string, *pattern;
+ Tcl_Obj *stringObj;
+ static char *options[] = {
+ "-exact", "-glob", "-regexp", "--",
+ NULL
+ };
+ enum options {
+ OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_LAST
+ };
+
+ mode = OPT_EXACT;
+ for (i = 1; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ if (string[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, switchObjv[0], switches,
- "option", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- switch (index) {
- case 0: /* -exact */
- mode = EXACT;
- break;
- case 1: /* -glob */
- mode = GLOB;
- break;
- case 2: /* -regexp */
- mode = REGEXP;
- break;
- case 3: /* -- */
- switchObjc--;
- switchObjv++;
- goto doneWithSwitches;
+ if (index == OPT_LAST) {
+ i++;
+ break;
}
- switchObjc--;
- switchObjv++;
+ mode = index;
}
- doneWithSwitches:
- if (switchObjc < 2) {
+ if (objc - i < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?switches? string pattern body ... ?default body?");
return TCL_ERROR;
}
-
- string = Tcl_GetStringFromObj(switchObjv[0], &length);
- switchObjc--;
- switchObjv++;
+
+ stringObj = objv[i];
+ objc -= i + 1;
+ objv += i + 1;
/*
* If all of the pattern/command pairs are lumped into a single
@@ -1639,62 +2326,75 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
*/
splitObjs = 0;
- if (switchObjc == 1) {
- code = Tcl_ListObjLength(interp, switchObjv[0], &switchObjc);
- if (code != TCL_OK) {
- return code;
+ if (objc == 1) {
+ Tcl_Obj **listv;
+
+ if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
+ return TCL_ERROR;
}
+ objv = listv;
splitObjs = 1;
}
- for (i = 0; i < switchObjc; i += 2) {
- if (i == (switchObjc-1)) {
+ seenComment = 0;
+ for (i = 0; i < objc; i += 2) {
+ if (i == objc - 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"extra switch pattern with no body", -1);
- code = TCL_ERROR;
- goto done;
+
+ /*
+ * Check if this can be due to a badly placed comment
+ * in the switch block
+ */
+
+ if (splitObjs && seenComment) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ ", this may be due to a comment incorrectly placed outside of a switch body - see the \"switch\" documentation", -1);
+ }
+
+ return TCL_ERROR;
}
/*
* See if the pattern matches the string.
*/
- if (splitObjs) {
- code = Tcl_ListObjIndex(interp, switchObjv[0], i, &patternObj);
- if (code != TCL_OK) {
- return code;
- }
- pattern = Tcl_GetStringFromObj(patternObj, &patternLen);
- } else {
- pattern = Tcl_GetStringFromObj(switchObjv[i], &patternLen);
+ pattern = Tcl_GetString(objv[i]);
+
+ /*
+ * The following is an heuristic to detect the infamous
+ * "comment in switch" error: just check if a pattern
+ * begins with '#'.
+ */
+
+ if (splitObjs && *pattern == '#') {
+ seenComment = 1;
}
matched = 0;
- if ((*pattern == 'd') && (i == switchObjc-2)
+ if ((i == objc - 2)
+ && (*pattern == 'd')
&& (strcmp(pattern, "default") == 0)) {
matched = 1;
} else {
- /*
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL.
- */
switch (mode) {
- case EXACT:
- matched = (strcmp(string, pattern) == 0);
+ case OPT_EXACT:
+ matched = (strcmp(Tcl_GetString(stringObj), pattern) == 0);
break;
- case GLOB:
- matched = Tcl_StringMatch(string, pattern);
+ case OPT_GLOB:
+ matched = Tcl_StringMatch(Tcl_GetString(stringObj),
+ pattern);
break;
- case REGEXP:
- matched = Tcl_RegExpMatch(interp, string, pattern);
+ case OPT_REGEXP:
+ matched = Tcl_RegExpMatchObj(interp, stringObj, objv[i]);
if (matched < 0) {
- code = TCL_ERROR;
- goto done;
+ return TCL_ERROR;
}
break;
}
}
- if (!matched) {
+ if (matched == 0) {
continue;
}
@@ -1703,53 +2403,28 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
* that are "-".
*/
- for (bodyIdx = i+1; ; bodyIdx += 2) {
- if (bodyIdx >= switchObjc) {
+ for (j = i + 1; ; j += 2) {
+ if (j >= objc) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"no body specified for pattern \"", pattern,
"\"", (char *) NULL);
- code = TCL_ERROR;
- goto done;
- }
-
- if (splitObjs) {
- code = Tcl_ListObjIndex(interp, switchObjv[0], bodyIdx,
- &bodyObj);
- if (code != TCL_OK) {
- return code;
- }
- } else {
- bodyObj = switchObjv[bodyIdx];
+ return TCL_ERROR;
}
- /*
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL.
- */
- body = Tcl_GetStringFromObj(bodyObj, &length);
- if ((length != 1) || (body[0] != '-')) {
+ if (strcmp(Tcl_GetString(objv[j]), "-") != 0) {
break;
}
}
- code = Tcl_EvalObj(interp, bodyObj);
- if (code == TCL_ERROR) {
- char msg[100];
+ result = Tcl_EvalObjEx(interp, objv[j], 0);
+ if (result == TCL_ERROR) {
+ char msg[100 + TCL_INTEGER_SPACE];
+
sprintf(msg, "\n (\"%.50s\" arm line %d)", pattern,
interp->errorLine);
Tcl_AddObjErrorInfo(interp, msg, -1);
}
- goto done;
+ return result;
}
-
- /*
- * Nothing matched: return nothing.
- */
-
- code = TCL_OK;
-
- done:
- return code;
-#undef EXACT
-#undef GLOB
-#undef REGEXP
+ return TCL_OK;
}
/*
@@ -1800,7 +2475,7 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
i = count;
TclpGetTime(&start);
while (i-- > 0) {
- result = Tcl_EvalObj(interp, objPtr);
+ result = Tcl_EvalObjEx(interp, objPtr, 0);
if (result != TCL_OK) {
return result;
}
@@ -1819,7 +2494,7 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * Tcl_TraceCmd --
+ * Tcl_TraceObjCmd --
*
* This procedure is invoked to process the "trace" Tcl command.
* See the user documentation for details on what it does.
@@ -1835,160 +2510,186 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_TraceCmd(dummy, interp, argc, argv)
+Tcl_TraceObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int c;
+ int optionIndex, commandLength;
+ char *name, *rwuOps, *command, *p;
size_t length;
+ static char *traceOptions[] = {
+ "variable", "vdelete", "vinfo", (char *) NULL
+ };
+ enum traceOptions {
+ TRACE_VARIABLE, TRACE_VDELETE, TRACE_VINFO
+ };
- if (argc < 2) {
- Tcl_AppendResult(interp, "too few args: should be \"",
- argv[0], " option [arg arg ...]\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option [arg arg ...]");
return TCL_ERROR;
}
- c = argv[1][1];
- length = strlen(argv[1]);
- if ((c == 'a') && (strncmp(argv[1], "variable", length) == 0)
- && (length >= 2)) {
- char *p;
- int flags, length;
- TraceVarInfo *tvarPtr;
-
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " variable name ops command\"", (char *) NULL);
- return TCL_ERROR;
- }
- flags = 0;
- for (p = argv[3] ; *p != 0; p++) {
- if (*p == 'r') {
- flags |= TCL_TRACE_READS;
- } else if (*p == 'w') {
- flags |= TCL_TRACE_WRITES;
- } else if (*p == 'u') {
- flags |= TCL_TRACE_UNSETS;
- } else {
- goto badOps;
- }
- }
- if (flags == 0) {
- goto badOps;
- }
+ if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
+ "option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum traceOptions) optionIndex) {
+ case TRACE_VARIABLE: {
+ int flags;
+ TraceVarInfo *tvarPtr;
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+ return TCL_ERROR;
+ }
- length = strlen(argv[4]);
- tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
- (sizeof(TraceVarInfo) - sizeof(tvarPtr->command) + length + 1));
- tvarPtr->flags = flags;
- tvarPtr->errMsg = NULL;
- tvarPtr->length = length;
- flags |= TCL_TRACE_UNSETS;
- strcpy(tvarPtr->command, argv[4]);
- if (Tcl_TraceVar(interp, argv[2], flags, TraceVarProc,
- (ClientData) tvarPtr) != TCL_OK) {
- ckfree((char *) tvarPtr);
- return TCL_ERROR;
- }
- } else if ((c == 'd') && (strncmp(argv[1], "vdelete", length)
- && (length >= 2)) == 0) {
- char *p;
- int flags, length;
- TraceVarInfo *tvarPtr;
- ClientData clientData;
-
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " vdelete name ops command\"", (char *) NULL);
- return TCL_ERROR;
- }
+ flags = 0;
+ rwuOps = Tcl_GetString(objv[3]);
+ for (p = rwuOps; *p != 0; p++) {
+ if (*p == 'r') {
+ flags |= TCL_TRACE_READS;
+ } else if (*p == 'w') {
+ flags |= TCL_TRACE_WRITES;
+ } else if (*p == 'u') {
+ flags |= TCL_TRACE_UNSETS;
+ } else {
+ goto badOps;
+ }
+ }
+ if (flags == 0) {
+ goto badOps;
+ }
- flags = 0;
- for (p = argv[3] ; *p != 0; p++) {
- if (*p == 'r') {
- flags |= TCL_TRACE_READS;
- } else if (*p == 'w') {
- flags |= TCL_TRACE_WRITES;
- } else if (*p == 'u') {
+ command = Tcl_GetStringFromObj(objv[4], &commandLength);
+ length = (size_t) commandLength;
+ tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
+ (sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
+ + length + 1));
+ tvarPtr->flags = flags;
+ tvarPtr->errMsg = NULL;
+ tvarPtr->length = length;
flags |= TCL_TRACE_UNSETS;
- } else {
- goto badOps;
+ strcpy(tvarPtr->command, command);
+ name = Tcl_GetString(objv[2]);
+ if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
+ (ClientData) tvarPtr) != TCL_OK) {
+ ckfree((char *) tvarPtr);
+ return TCL_ERROR;
+ }
+ break;
}
- }
- if (flags == 0) {
- goto badOps;
- }
+ case TRACE_VDELETE: {
+ int flags;
+ TraceVarInfo *tvarPtr;
+ ClientData clientData;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+ return TCL_ERROR;
+ }
- /*
- * Search through all of our traces on this variable to
- * see if there's one with the given command. If so, then
- * delete the first one that matches.
- */
+ flags = 0;
+ rwuOps = Tcl_GetString(objv[3]);
+ for (p = rwuOps; *p != 0; p++) {
+ if (*p == 'r') {
+ flags |= TCL_TRACE_READS;
+ } else if (*p == 'w') {
+ flags |= TCL_TRACE_WRITES;
+ } else if (*p == 'u') {
+ flags |= TCL_TRACE_UNSETS;
+ } else {
+ goto badOps;
+ }
+ }
+ if (flags == 0) {
+ goto badOps;
+ }
- length = strlen(argv[4]);
- clientData = 0;
- while ((clientData = Tcl_VarTraceInfo(interp, argv[2], 0,
- TraceVarProc, clientData)) != 0) {
- tvarPtr = (TraceVarInfo *) clientData;
- if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
- && (strncmp(argv[4], tvarPtr->command,
- (size_t) length) == 0)) {
- Tcl_UntraceVar(interp, argv[2], flags | TCL_TRACE_UNSETS,
- TraceVarProc, clientData);
- if (tvarPtr->errMsg != NULL) {
- ckfree(tvarPtr->errMsg);
- }
- ckfree((char *) tvarPtr);
+ /*
+ * Search through all of our traces on this variable to
+ * see if there's one with the given command. If so, then
+ * delete the first one that matches.
+ */
+
+ command = Tcl_GetStringFromObj(objv[4], &commandLength);
+ length = (size_t) commandLength;
+ clientData = 0;
+ name = Tcl_GetString(objv[2]);
+ while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+ TraceVarProc, clientData)) != 0) {
+ tvarPtr = (TraceVarInfo *) clientData;
+ if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
+ && (strncmp(command, tvarPtr->command,
+ (size_t) length) == 0)) {
+ Tcl_UntraceVar(interp, name, flags | TCL_TRACE_UNSETS,
+ TraceVarProc, clientData);
+ if (tvarPtr->errMsg != NULL) {
+ ckfree(tvarPtr->errMsg);
+ }
+ ckfree((char *) tvarPtr);
+ break;
+ }
+ }
break;
}
- }
- } else if ((c == 'i') && (strncmp(argv[1], "vinfo", length) == 0)
- && (length >= 2)) {
- ClientData clientData;
- char ops[4], *p;
- char *prefix = "{";
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " vinfo name\"", (char *) NULL);
- return TCL_ERROR;
- }
- clientData = 0;
- while ((clientData = Tcl_VarTraceInfo(interp, argv[2], 0,
- TraceVarProc, clientData)) != 0) {
- TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
- p = ops;
- if (tvarPtr->flags & TCL_TRACE_READS) {
- *p = 'r';
- p++;
- }
- if (tvarPtr->flags & TCL_TRACE_WRITES) {
- *p = 'w';
- p++;
+ case TRACE_VINFO: {
+ ClientData clientData;
+ char ops[4];
+ Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ resultListPtr = Tcl_GetObjResult(interp);
+ clientData = 0;
+ name = Tcl_GetString(objv[2]);
+ while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+ TraceVarProc, clientData)) != 0) {
+
+ TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+ pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ p = ops;
+ if (tvarPtr->flags & TCL_TRACE_READS) {
+ *p = 'r';
+ p++;
+ }
+ if (tvarPtr->flags & TCL_TRACE_WRITES) {
+ *p = 'w';
+ p++;
+ }
+ if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+ *p = 'u';
+ p++;
+ }
+ *p = '\0';
+
+ /*
+ * Build a pair (2-item list) with the ops string as
+ * the first obj element and the tvarPtr->command string
+ * as the second obj element. Append the pair (as an
+ * element) to the end of the result object list.
+ */
+
+ elemObjPtr = Tcl_NewStringObj(ops, -1);
+ Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+ elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+ Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
+ }
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
}
- if (tvarPtr->flags & TCL_TRACE_UNSETS) {
- *p = 'u';
- p++;
+ default: {
+ panic("Tcl_TraceObjCmd: bad option index to TraceOptions");
}
- *p = '\0';
- Tcl_AppendResult(interp, prefix, (char *) NULL);
- Tcl_AppendElement(interp, ops);
- Tcl_AppendElement(interp, tvarPtr->command);
- Tcl_AppendResult(interp, "}", (char *) NULL);
- prefix = " {";
- }
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be variable, vdelete, or vinfo",
- (char *) NULL);
- return TCL_ERROR;
}
return TCL_OK;
badOps:
- Tcl_AppendResult(interp, "bad operations \"", argv[3],
+ Tcl_AppendResult(interp, "bad operations \"", rwuOps,
"\": should be one or more of rwu", (char *) NULL);
return TCL_ERROR;
}
@@ -2022,13 +2723,11 @@ TraceVarProc(clientData, interp, name1, name2, flags)
int flags; /* OR-ed bits giving operation and other
* information. */
{
- Interp *iPtr = (Interp *) interp;
+ Tcl_SavedResult state;
TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
char *result;
int code;
- Interp dummy;
Tcl_DString cmd;
- Tcl_Obj *saveObjPtr, *oldObjResultPtr;
result = NULL;
if (tvarPtr->errMsg != NULL) {
@@ -2048,7 +2747,7 @@ TraceVarProc(clientData, interp, name1, name2, flags)
name2 = "";
}
Tcl_DStringInit(&cmd);
- Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length);
+ Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
Tcl_DStringAppendElement(&cmd, name1);
Tcl_DStringAppendElement(&cmd, name2);
if (flags & TCL_TRACE_READS) {
@@ -2060,53 +2759,25 @@ TraceVarProc(clientData, interp, name1, name2, flags)
}
/*
- * Execute the command. Be careful to save and restore both the
- * string and object results from the interpreter used for
+ * Execute the command. Save the interp's result used for
* the command. We discard any object result the command returns.
*/
- dummy.objResultPtr = Tcl_NewObj();
- Tcl_IncrRefCount(dummy.objResultPtr);
- if (interp->freeProc == 0) {
- dummy.freeProc = (Tcl_FreeProc *) 0;
- dummy.result = "";
- Tcl_SetResult((Tcl_Interp *) &dummy, interp->result,
- TCL_VOLATILE);
- } else {
- dummy.freeProc = interp->freeProc;
- dummy.result = interp->result;
- interp->freeProc = (Tcl_FreeProc *) 0;
- }
-
- saveObjPtr = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(saveObjPtr);
-
+ Tcl_SaveResult(interp, &state);
+
code = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
if (code != TCL_OK) { /* copy error msg to result */
- tvarPtr->errMsg = (char *)
- ckalloc((unsigned) (strlen(interp->result) + 1));
- strcpy(tvarPtr->errMsg, interp->result);
+ char *string;
+ int length;
+
+ string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+ tvarPtr->errMsg = (char *) ckalloc((unsigned) (length + 1));
+ memcpy(tvarPtr->errMsg, string, (size_t) (length + 1));
result = tvarPtr->errMsg;
- Tcl_ResetResult(interp); /* must clear error state. */
}
- /*
- * Restore the interpreter's string result.
- */
-
- Tcl_SetResult(interp, dummy.result,
- (dummy.freeProc == 0) ? TCL_VOLATILE : dummy.freeProc);
+ Tcl_RestoreResult(interp, &state);
- /*
- * Restore the interpreter's object result from saveObjPtr.
- */
-
- oldObjResultPtr = iPtr->objResultPtr;
- iPtr->objResultPtr = saveObjPtr; /* was incremented above */
- Tcl_DecrRefCount(oldObjResultPtr);
-
- Tcl_DecrRefCount(dummy.objResultPtr);
- dummy.objResultPtr = NULL;
Tcl_DStringFree(&cmd);
}
if (flags & TCL_TRACE_DESTROYED) {
@@ -2122,7 +2793,7 @@ TraceVarProc(clientData, interp, name1, name2, flags)
/*
*----------------------------------------------------------------------
*
- * Tcl_WhileCmd --
+ * Tcl_WhileObjCmd --
*
* This procedure is invoked to process the "while" Tcl command.
* See the user documentation for details on what it does.
@@ -2142,32 +2813,32 @@ TraceVarProc(clientData, interp, name1, name2, flags)
/* ARGSUSED */
int
-Tcl_WhileCmd(dummy, interp, argc, argv)
+Tcl_WhileObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int result, value;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " test command\"", (char *) NULL);
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "test command");
return TCL_ERROR;
}
while (1) {
- result = Tcl_ExprBoolean(interp, argv[1], &value);
+ result = Tcl_ExprBooleanObj(interp, objv[1], &value);
if (result != TCL_OK) {
return result;
}
if (!value) {
break;
}
- result = Tcl_Eval(interp, argv[2]);
+ result = Tcl_EvalObjEx(interp, objv[2], 0);
if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
if (result == TCL_ERROR) {
- char msg[60];
+ char msg[32 + TCL_INTEGER_SPACE];
+
sprintf(msg, "\n (\"while\" body line %d)",
interp->errorLine);
Tcl_AddErrorInfo(interp, msg);
@@ -2184,3 +2855,4 @@ Tcl_WhileCmd(dummy, interp, argc, argv)
return result;
}
+
diff --git a/tcl/generic/tclCompCmds.c b/tcl/generic/tclCompCmds.c
new file mode 100644
index 00000000000..f15b5aa5378
--- /dev/null
+++ b/tcl/generic/tclCompCmds.c
@@ -0,0 +1,2023 @@
+/*
+ * tclCompCmds.c --
+ *
+ * This file contains compilation procedures that compile various
+ * Tcl commands into a sequence of instructions ("bytecodes").
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
+static void FreeForeachInfo _ANSI_ARGS_((
+ ClientData clientData));
+
+/*
+ * The structures below define the AuxData types defined in this file.
+ */
+
+AuxDataType tclForeachInfoType = {
+ "ForeachInfo", /* name */
+ DupForeachInfo, /* dupProc */
+ FreeForeachInfo /* freeProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileBreakCmd --
+ *
+ * Procedure called to compile the "break" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK unless
+ * there was an error during compilation. If an error occurs then
+ * the interpreter's result contains a standard error message.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "break" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileBreakCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ if (parsePtr->numWords != 1) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"break\"", -1);
+ envPtr->maxStackDepth = 0;
+ return TCL_ERROR;
+ }
+
+ /*
+ * Emit a break instruction.
+ */
+
+ TclEmitOpcode(INST_BREAK, envPtr);
+ envPtr->maxStackDepth = 0;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileCatchCmd --
+ *
+ * Procedure called to compile the "catch" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if
+ * compilation was successful. If an error occurs then the
+ * interpreter's result contains a standard error message and TCL_ERROR
+ * is returned. If the command is too complex for TclCompileCatchCmd,
+ * TCL_OUT_LINE_COMPILE is returned indicating that the catch command
+ * should be compiled "out of line" by emitting code to invoke its
+ * command procedure at runtime.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "catch" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileCatchCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ JumpFixup jumpFixup;
+ Tcl_Token *cmdTokenPtr, *nameTokenPtr;
+ char *name;
+ int localIndex, nameChars, range, maxDepth, startOffset, jumpDist;
+ int code;
+ char buffer[32 + TCL_INTEGER_SPACE];
+
+ envPtr->maxStackDepth = 0;
+ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"catch command ?varName?\"", -1);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If a variable was specified and the catch command is at global level
+ * (not in a procedure), don't compile it inline: the payoff is
+ * too small.
+ */
+
+ if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * Make sure the variable name, if any, has no substitutions and just
+ * refers to a local scaler.
+ */
+
+ localIndex = -1;
+ cmdTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ if (parsePtr->numWords == 3) {
+ nameTokenPtr = cmdTokenPtr + (cmdTokenPtr->numComponents + 1);
+ if (nameTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ name = nameTokenPtr[1].start;
+ nameChars = nameTokenPtr[1].size;
+ if (!TclIsLocalScalar(name, nameChars)) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+ localIndex = TclFindCompiledLocal(nameTokenPtr[1].start,
+ nameTokenPtr[1].size, /*create*/ 1,
+ /*flags*/ VAR_SCALAR, envPtr->procPtr);
+ } else {
+ return TCL_OUT_LINE_COMPILE;
+ }
+ }
+
+ /*
+ * We will compile the catch command. Emit a beginCatch instruction at
+ * the start of the catch body: the subcommand it controls.
+ */
+
+ maxDepth = 0;
+
+ envPtr->exceptDepth++;
+ envPtr->maxExceptDepth =
+ TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+
+ startOffset = (envPtr->codeNext - envPtr->codeStart);
+ envPtr->exceptArrayPtr[range].codeOffset = startOffset;
+ code = TclCompileCmdWord(interp, cmdTokenPtr+1,
+ cmdTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"catch\" body line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ envPtr->exceptArrayPtr[range].numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart) - startOffset;
+
+ /*
+ * The "no errors" epilogue code: store the body's result into the
+ * variable (if any), push "0" (TCL_OK) as the catch's "no error"
+ * result, and jump around the "error case" code.
+ */
+
+ if (localIndex != -1) {
+ if (localIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+ }
+ }
+ TclEmitOpcode(INST_POP, envPtr);
+ TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0),
+ envPtr);
+ if (maxDepth == 0) {
+ maxDepth = 1;
+ }
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+
+ /*
+ * The "error case" code: store the body's result into the variable (if
+ * any), then push the error result code. The initial PC offset here is
+ * the catch's error target.
+ */
+
+ envPtr->exceptArrayPtr[range].catchOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ if (localIndex != -1) {
+ TclEmitOpcode(INST_PUSH_RESULT, envPtr);
+ if (localIndex <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+ }
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+ TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
+
+ /*
+ * Update the target of the jump after the "no errors" code, then emit
+ * an endCatch instruction at the end of the catch command.
+ */
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+ panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
+ }
+ TclEmitOpcode(INST_END_CATCH, envPtr);
+
+ done:
+ envPtr->exceptDepth--;
+ envPtr->maxStackDepth = maxDepth;
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileContinueCmd --
+ *
+ * Procedure called to compile the "continue" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK unless
+ * there was an error while parsing string. If an error occurs then
+ * the interpreter's result contains a standard error message.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "continue" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileContinueCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ /*
+ * There should be no argument after the "continue".
+ */
+
+ if (parsePtr->numWords != 1) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"continue\"", -1);
+ envPtr->maxStackDepth = 0;
+ return TCL_ERROR;
+ }
+
+ /*
+ * Emit a continue instruction.
+ */
+
+ TclEmitOpcode(INST_CONTINUE, envPtr);
+ envPtr->maxStackDepth = 0;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileExprCmd --
+ *
+ * Procedure called to compile the "expr" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK
+ * unless there was an error while parsing string. If an error occurs
+ * then the interpreter's result contains a standard error message.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the "expr" command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "expr" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileExprCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *firstWordPtr;
+
+ envPtr->maxStackDepth = 0;
+ if (parsePtr->numWords == 1) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"expr arg ?arg ...?\"", -1);
+ return TCL_ERROR;
+ }
+
+ firstWordPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
+ envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileForCmd --
+ *
+ * Procedure called to compile the "for" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK unless
+ * there was an error while parsing string. If an error occurs then
+ * the interpreter's result contains a standard error message.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "for" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileForCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
+ JumpFixup jumpFalseFixup;
+ int maxDepth, jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist;
+ int bodyRange, nextRange, code;
+ unsigned char *jumpPc;
+ char buffer[32 + TCL_INTEGER_SPACE];
+
+ envPtr->maxStackDepth = 0;
+ if (parsePtr->numWords != 5) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"for start test next command\"", -1);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the test expression requires substitutions, don't compile the for
+ * command inline. E.g., the expression might cause the loop to never
+ * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
+ */
+
+ startTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1);
+ if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * Create ExceptionRange records for the body and the "next" command.
+ * The "next" command's ExceptionRange supports break but not continue
+ * (and has a -1 continueOffset).
+ */
+
+ envPtr->exceptDepth++;
+ envPtr->maxExceptDepth =
+ TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+ bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
+ /*
+ * Inline compile the initial command.
+ */
+
+ maxDepth = 0;
+ code = TclCompileCmdWord(interp, startTokenPtr+1,
+ startTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"for\" initial command)", -1);
+ }
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ TclEmitOpcode(INST_POP, envPtr);
+
+ /*
+ * Compile the test then emit the conditional jump that exits the for.
+ */
+
+ testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"for\" test expression)", -1);
+ }
+ goto done;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+
+ /*
+ * Compile the loop body.
+ */
+
+ nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+ bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
+ envPtr->exceptArrayPtr[bodyRange].codeOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+ bodyTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"for\" body line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+ envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart)
+ - envPtr->exceptArrayPtr[bodyRange].codeOffset;
+ TclEmitOpcode(INST_POP, envPtr);
+
+ /*
+ * Compile the "next" subcommand.
+ */
+
+ envPtr->exceptArrayPtr[bodyRange].continueOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ envPtr->exceptArrayPtr[nextRange].codeOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ code = TclCompileCmdWord(interp, nextTokenPtr+1,
+ nextTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"for\" loop-end command)", -1);
+ }
+ goto done;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+ envPtr->exceptArrayPtr[nextRange].numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart)
+ - envPtr->exceptArrayPtr[nextRange].codeOffset;
+ 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 = (envPtr->codeNext - envPtr->codeStart);
+ jumpBackDist = (jumpBackOffset - testCodeOffset);
+ if (jumpBackDist > 120) {
+ TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+ }
+
+ /*
+ * Fix the target of the jumpFalse after the test.
+ */
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpFalseFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
+ /*
+ * Update the loop body and "next" command ExceptionRanges since
+ * they moved down.
+ */
+
+ envPtr->exceptArrayPtr[bodyRange].codeOffset += 3;
+ envPtr->exceptArrayPtr[bodyRange].continueOffset += 3;
+ envPtr->exceptArrayPtr[nextRange].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);
+ }
+ }
+
+ /*
+ * Set the loop's break target.
+ */
+
+ envPtr->exceptArrayPtr[bodyRange].breakOffset =
+ envPtr->exceptArrayPtr[nextRange].breakOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+
+ /*
+ * The for command's result is an empty string.
+ */
+
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ if (maxDepth == 0) {
+ maxDepth = 1;
+ }
+ code = TCL_OK;
+
+ done:
+ envPtr->maxStackDepth = maxDepth;
+ envPtr->exceptDepth--;
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileForeachCmd --
+ *
+ * Procedure called to compile the "foreach" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if
+ * compilation was successful. If an error occurs then the
+ * interpreter's result contains a standard error message and TCL_ERROR
+ * is returned. If the command is too complex for TclCompileForeachCmd,
+ * TCL_OUT_LINE_COMPILE is returned indicating that the foreach command
+ * should be compiled "out of line" by emitting code to invoke its
+ * command procedure at runtime.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the "while" command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "foreach" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileForeachCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Proc *procPtr = envPtr->procPtr;
+ ForeachInfo *infoPtr; /* Points to the structure describing this
+ * foreach command. Stored in a AuxData
+ * record in the ByteCode. */
+ int firstValueTemp; /* Index of the first temp var in the frame
+ * used to point to a value list. */
+ int loopCtTemp; /* Index of temp var holding the loop's
+ * iteration count. */
+ Tcl_Token *tokenPtr, *bodyTokenPtr;
+ char *varList;
+ unsigned char *jumpPc;
+ JumpFixup jumpFalseFixup;
+ int jumpDist, jumpBackDist, jumpBackOffset, maxDepth, infoIndex, range;
+ int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
+ char savedChar;
+ char buffer[32 + TCL_INTEGER_SPACE];
+
+ /*
+ * 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
+ */
+
+#define STATIC_VAR_LIST_SIZE 5
+ int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
+ char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
+ int *varcList = varcListStaticSpace;
+ char ***varvList = varvListStaticSpace;
+
+ /*
+ * If the foreach command isn't in a procedure, don't compile it inline:
+ * the payoff is too small.
+ */
+
+ envPtr->maxStackDepth = 0;
+ if (procPtr == NULL) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ maxDepth = 0;
+
+ numWords = parsePtr->numWords;
+ if ((numWords < 4) || (numWords%2 != 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Allocate storage for the varcList and varvList arrays if necessary.
+ */
+
+ numLists = (numWords - 2)/2;
+ if (numLists > STATIC_VAR_LIST_SIZE) {
+ varcList = (int *) ckalloc(numLists * sizeof(int));
+ varvList = (char ***) ckalloc(numLists * sizeof(char **));
+ }
+ for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
+ varcList[loopIndex] = 0;
+ varvList[loopIndex] = (char **) NULL;
+ }
+
+ /*
+ * Set the exception stack depth.
+ */
+
+ envPtr->exceptDepth++;
+ envPtr->maxExceptDepth =
+ TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+
+ /*
+ * Break up each var list and set the varcList and varvList arrays.
+ * 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;
+ for (i = 0, tokenPtr = parsePtr->tokenPtr;
+ i < numWords-1;
+ i++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ if (i%2 == 1) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ code = TCL_OUT_LINE_COMPILE;
+ goto done;
+ }
+ varList = tokenPtr[1].start;
+ savedChar = varList[tokenPtr[1].size];
+
+ /*
+ * Note there is a danger that modifying the string could have
+ * undesirable side effects. In this case, Tcl_SplitList does
+ * not have any dependencies on shared strings so we should be
+ * safe.
+ */
+
+ varList[tokenPtr[1].size] = '\0';
+ code = Tcl_SplitList(interp, varList,
+ &varcList[loopIndex], &varvList[loopIndex]);
+ varList[tokenPtr[1].size] = savedChar;
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ numVars = varcList[loopIndex];
+ for (j = 0; j < numVars; j++) {
+ char *varName = varvList[loopIndex][j];
+ if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+ code = TCL_OUT_LINE_COMPILE;
+ goto done;
+ }
+ }
+ loopIndex++;
+ }
+ }
+
+ /*
+ * 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.
+ */
+
+ firstValueTemp = -1;
+ for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
+ tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
+ /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+ if (loopIndex == 0) {
+ firstValueTemp = tempVar;
+ }
+ }
+ loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
+ /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+
+ /*
+ * Create and initialize the ForeachInfo and ForeachVarList data
+ * structures describing this command. Then create a AuxData record
+ * pointing to the ForeachInfo structure.
+ */
+
+ infoPtr = (ForeachInfo *) ckalloc((unsigned)
+ (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 = (ForeachVarList *) ckalloc((unsigned)
+ sizeof(ForeachVarList) + (numVars * sizeof(int)));
+ varListPtr->numVars = numVars;
+ for (j = 0; j < numVars; j++) {
+ char *varName = varvList[loopIndex][j];
+ int nameChars = strlen(varName);
+ varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
+ nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+ }
+ infoPtr->varLists[loopIndex] = varListPtr;
+ }
+ infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
+
+ /*
+ * Evaluate then store each value list in the associated temporary.
+ */
+
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
+ loopIndex = 0;
+ for (i = 0, tokenPtr = parsePtr->tokenPtr;
+ i < numWords-1;
+ i++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ if ((i%2 == 0) && (i > 0)) {
+ code = TclCompileTokens(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+
+ tempVar = (firstValueTemp + loopIndex);
+ if (tempVar <= 255) {
+ TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
+ } else {
+ TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
+ }
+ TclEmitOpcode(INST_POP, envPtr);
+ loopIndex++;
+ }
+ }
+ bodyTokenPtr = tokenPtr;
+
+ /*
+ * 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.
+ */
+
+ envPtr->exceptArrayPtr[range].continueOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+
+ /*
+ * Inline compile the loop body.
+ */
+
+ envPtr->exceptArrayPtr[range].codeOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+ bodyTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"foreach\" body line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+ envPtr->exceptArrayPtr[range].numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart)
+ - envPtr->exceptArrayPtr[range].codeOffset;
+ 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 = (envPtr->codeNext - envPtr->codeStart);
+ jumpBackDist =
+ (jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
+ if (jumpBackDist > 120) {
+ TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+ }
+
+ /*
+ * Fix the target of the jump after the foreach_step test.
+ */
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpFalseFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 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);
+ }
+ }
+
+ /*
+ * Set the loop's break target.
+ */
+
+ envPtr->exceptArrayPtr[range].breakOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+
+ /*
+ * The foreach command's result is an empty string.
+ */
+
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ if (maxDepth == 0) {
+ maxDepth = 1;
+ }
+
+ done:
+ for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
+ if (varvList[loopIndex] != (char **) NULL) {
+ ckfree((char *) varvList[loopIndex]);
+ }
+ }
+ if (varcList != varcListStaticSpace) {
+ ckfree((char *) varcList);
+ ckfree((char *) varvList);
+ }
+ envPtr->maxStackDepth = maxDepth;
+ envPtr->exceptDepth--;
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupForeachInfo --
+ *
+ * This procedure duplicates a ForeachInfo structure created as
+ * auxiliary data during the compilation of a foreach command.
+ *
+ * Results:
+ * A pointer to a newly allocated copy of the existing ForeachInfo
+ * structure is returned.
+ *
+ * Side effects:
+ * Storage for the copied ForeachInfo record is allocated. If the
+ * original ForeachInfo structure pointed to any ForeachVarList
+ * records, these structures are also copied and pointers to them
+ * are stored in the new ForeachInfo record.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+DupForeachInfo(clientData)
+ ClientData clientData; /* The foreach command's compilation
+ * auxiliary data to duplicate. */
+{
+ register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
+ ForeachInfo *dupPtr;
+ register ForeachVarList *srcListPtr, *dupListPtr;
+ int numLists = srcPtr->numLists;
+ int numVars, i, j;
+
+ dupPtr = (ForeachInfo *) ckalloc((unsigned)
+ (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
+ dupPtr->numLists = numLists;
+ dupPtr->firstValueTemp = srcPtr->firstValueTemp;
+ dupPtr->loopCtTemp = srcPtr->loopCtTemp;
+
+ for (i = 0; i < numLists; i++) {
+ srcListPtr = srcPtr->varLists[i];
+ numVars = srcListPtr->numVars;
+ dupListPtr = (ForeachVarList *) ckalloc((unsigned)
+ sizeof(ForeachVarList) + numVars*sizeof(int));
+ dupListPtr->numVars = numVars;
+ for (j = 0; j < numVars; j++) {
+ dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
+ }
+ dupPtr->varLists[i] = dupListPtr;
+ }
+ return (ClientData) dupPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeForeachInfo --
+ *
+ * Procedure to free a ForeachInfo structure created as auxiliary data
+ * during the compilation of a foreach command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage for the ForeachInfo structure pointed to by the ClientData
+ * argument is freed as is any ForeachVarList record pointed to by the
+ * ForeachInfo structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeForeachInfo(clientData)
+ ClientData clientData; /* The foreach command's compilation
+ * auxiliary data to free. */
+{
+ register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
+ register ForeachVarList *listPtr;
+ int numLists = infoPtr->numLists;
+ register int i;
+
+ for (i = 0; i < numLists; i++) {
+ listPtr = infoPtr->varLists[i];
+ ckfree((char *) listPtr);
+ }
+ ckfree((char *) infoPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIfCmd --
+ *
+ * Procedure called to compile the "if" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if
+ * compilation was successful. If an error occurs then the
+ * interpreter's result contains a standard error message and TCL_ERROR
+ * is returned. If the command is too complex for TclCompileIfCmd,
+ * TCL_OUT_LINE_COMPILE is returned indicating that the if command
+ * should be compiled "out of line" by emitting code to invoke its
+ * command procedure at runtime.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "if" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIfCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ JumpFixupArray jumpFalseFixupArray;
+ /* Used to fix the ifFalse jump after each
+ * test when its target PC is determined. */
+ JumpFixupArray jumpEndFixupArray;
+ /* Used to fix the jump after each "then"
+ * body to the end of the "if" when that PC
+ * is determined. */
+ Tcl_Token *tokenPtr, *testTokenPtr;
+ int jumpDist, jumpFalseDist, jumpIndex;
+ int numWords, wordIdx, numBytes, maxDepth, j, code;
+ char *word;
+ char buffer[100];
+
+ TclInitJumpFixupArray(&jumpFalseFixupArray);
+ TclInitJumpFixupArray(&jumpEndFixupArray);
+ maxDepth = 0;
+ code = TCL_OK;
+
+ /*
+ * Each iteration of this loop compiles one "if expr ?then? body"
+ * or "elseif expr ?then? body" clause.
+ */
+
+ tokenPtr = parsePtr->tokenPtr;
+ wordIdx = 0;
+ numWords = parsePtr->numWords;
+ while (wordIdx < numWords) {
+ /*
+ * Stop looping if the token isn't "if" or "elseif".
+ */
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ break;
+ }
+ word = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+ if ((tokenPtr == parsePtr->tokenPtr)
+ || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
+ tokenPtr += (tokenPtr->numComponents + 1);
+ wordIdx++;
+ } else {
+ break;
+ }
+ if (wordIdx >= numWords) {
+ sprintf(buffer,
+ "wrong # args: no expression after \"%.30s\" argument",
+ word);
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Compile the test expression then emit the conditional jump
+ * around the "then" part. If the expression word isn't simple,
+ * we back off and compile the if command out-of-line.
+ */
+
+ testTokenPtr = tokenPtr;
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"if\" test expression)", -1);
+ }
+ goto done;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+ if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
+ TclExpandJumpFixupArray(&jumpFalseFixupArray);
+ }
+ jumpIndex = jumpFalseFixupArray.next;
+ jumpFalseFixupArray.next++;
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+ &(jumpFalseFixupArray.fixup[jumpIndex]));
+
+ /*
+ * Skip over the optional "then" before the then clause.
+ */
+
+ tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+ wordIdx++;
+ if (wordIdx >= numWords) {
+ sprintf(buffer, "wrong # args: no script following \"%.20s\" argument", testTokenPtr->start);
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ word = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+ if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
+ tokenPtr += (tokenPtr->numComponents + 1);
+ wordIdx++;
+ if (wordIdx >= numWords) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: no script following \"then\" argument", -1);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ /*
+ * Compile the "then" command body.
+ */
+
+ code = TclCompileCmdWord(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"if\" then script line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+
+ /*
+ * Jump to the end of the "if" command. Both jumpFalseFixupArray and
+ * jumpEndFixupArray are indexed by "jumpIndex".
+ */
+
+ if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
+ TclExpandJumpFixupArray(&jumpEndFixupArray);
+ }
+ jumpEndFixupArray.next++;
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+ &(jumpEndFixupArray.fixup[jumpIndex]));
+
+ /*
+ * Fix the target of the jumpFalse after the test. Generate a 4 byte
+ * jump if the distance is > 120 bytes. This is conservative, and
+ * ensures that we won't have to replace this jump if we later also
+ * need to replace the proceeding jump to the end of the "if" with a
+ * 4 byte jump.
+ */
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+ if (TclFixupForwardJump(envPtr,
+ &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
+ /*
+ * Adjust the code offset for the proceeding jump to the end
+ * of the "if" command.
+ */
+
+ jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
+ }
+
+ tokenPtr += (tokenPtr->numComponents + 1);
+ wordIdx++;
+ }
+
+ /*
+ * Check for the optional else clause.
+ */
+
+ if ((wordIdx < numWords)
+ && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
+ /*
+ * There is an else clause. Skip over the optional "else" word.
+ */
+
+ word = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+ if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
+ tokenPtr += (tokenPtr->numComponents + 1);
+ wordIdx++;
+ if (wordIdx >= numWords) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: no script following \"else\" argument", -1);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ /*
+ * Compile the else command body.
+ */
+
+ code = TclCompileCmdWord(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"if\" else script line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+
+ /*
+ * Make sure there are no words after the else clause.
+ */
+
+ wordIdx++;
+ if (wordIdx < numWords) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
+ code = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ /*
+ * No else clause: the "if" command's result is an empty string.
+ */
+
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
+ maxDepth = TclMax(1, maxDepth);
+ }
+
+ /*
+ * Fix the unconditional jumps to the end of the "if" command.
+ */
+
+ for (j = jumpEndFixupArray.next; j > 0; j--) {
+ jumpIndex = (j - 1); /* i.e. process the closest jump first */
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpEndFixupArray.fixup[jumpIndex].codeOffset;
+ if (TclFixupForwardJump(envPtr,
+ &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
+ /*
+ * Adjust the immediately preceeding "ifFalse" jump. We moved
+ * it's target (just after this jump) down three bytes.
+ */
+
+ unsigned char *ifFalsePc = envPtr->codeStart
+ + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+ unsigned char opCode = *ifFalsePc;
+ if (opCode == INST_JUMP_FALSE1) {
+ jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
+ jumpFalseDist += 3;
+ TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
+ } else if (opCode == INST_JUMP_FALSE4) {
+ jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
+ jumpFalseDist += 3;
+ TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
+ } else {
+ panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
+ }
+ }
+ }
+
+ /*
+ * Free the jumpFixupArray array if malloc'ed storage was used.
+ */
+
+ done:
+ TclFreeJumpFixupArray(&jumpFalseFixupArray);
+ TclFreeJumpFixupArray(&jumpEndFixupArray);
+ envPtr->maxStackDepth = maxDepth;
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileIncrCmd --
+ *
+ * Procedure called to compile the "incr" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if
+ * compilation was successful. If an error occurs then the
+ * interpreter's result contains a standard error message and TCL_ERROR
+ * is returned. If the command is too complex for TclCompileIncrCmd,
+ * TCL_OUT_LINE_COMPILE is returned indicating that the incr command
+ * should be compiled "out of line" by emitting code to invoke its
+ * command procedure at runtime.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the "incr" command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "incr" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileIncrCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *varTokenPtr, *incrTokenPtr;
+ Tcl_Parse elemParse;
+ int gotElemParse = 0;
+ char *name, *elName, *p;
+ int nameChars, elNameChars, haveImmValue, immValue, localIndex, i, code;
+ int maxDepth = 0;
+ char buffer[160];
+
+ envPtr->maxStackDepth = 0;
+ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"incr varName ?increment?\"", -1);
+ return TCL_ERROR;
+ }
+
+ name = NULL;
+ elName = NULL;
+ elNameChars = 0;
+ localIndex = -1;
+ code = TCL_OK;
+
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 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.
+ * This goes with the hack in TclCompileSetCmd.
+ */
+ if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+ (varTokenPtr->start[0] != '{')) {
+ /*
+ * A simple variable name. Divide it up into "name" and "elName"
+ * strings. If it is not a local variable, look it up at runtime.
+ */
+
+ name = varTokenPtr[1].start;
+ nameChars = varTokenPtr[1].size;
+ for (i = 0, p = name; i < nameChars; i++, p++) {
+ if (*p == '(') {
+ char *openParen = p;
+ p = (name + nameChars-1);
+ if (*p == ')') { /* last char is ')' => array reference */
+ nameChars = (openParen - name);
+ elName = openParen+1;
+ elNameChars = (p - elName);
+ }
+ break;
+ }
+ }
+ if (envPtr->procPtr != NULL) {
+ localIndex = TclFindCompiledLocal(name, nameChars,
+ /*create*/ 0, /*flags*/ 0, envPtr->procPtr);
+ if (localIndex > 255) { /* we'll push the name */
+ localIndex = -1;
+ }
+ }
+ if (localIndex < 0) {
+ TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
+ /*onHeap*/ 0), envPtr);
+ maxDepth = 1;
+ }
+
+ /*
+ * Compile the element script, if any.
+ */
+
+ if (elName != NULL) {
+ /*
+ * Temporarily replace the '(' and ')' by '"'s.
+ */
+
+ *(elName-1) = '"';
+ *(elName+elNameChars) = '"';
+ code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
+ /*nested*/ 0, &elemParse);
+ *(elName-1) = '(';
+ *(elName+elNameChars) = ')';
+ gotElemParse = 1;
+ if ((code != TCL_OK) || (elemParse.numWords > 1)) {
+ sprintf(buffer, "\n (parsing index for array \"%.*s\")",
+ TclMin(nameChars, 100), name);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ code = TCL_ERROR;
+ goto done;
+ } else if (elemParse.numWords == 1) {
+ code = TclCompileTokens(interp, elemParse.tokenPtr+1,
+ elemParse.tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth += envPtr->maxStackDepth;
+ } else {
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
+ /*alreadyAlloced*/ 0), envPtr);
+ maxDepth += 1;
+ }
+ }
+ } else {
+ /*
+ * Not a simple variable name. Look it up at runtime.
+ */
+
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ }
+
+ /*
+ * If an increment is given, push it, but see first if it's a small
+ * integer.
+ */
+
+ haveImmValue = 0;
+ immValue = 0;
+ if (parsePtr->numWords == 3) {
+ incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ char *word = incrTokenPtr[1].start;
+ int numBytes = incrTokenPtr[1].size;
+ char savedChar = word[numBytes];
+ long n;
+
+ /*
+ * Note there is a danger that modifying the string could have
+ * undesirable side effects. In this case, TclLooksLikeInt and
+ * TclGetLong do not have any dependencies on shared strings so we
+ * should be safe.
+ */
+
+ word[numBytes] = '\0';
+ if (TclLooksLikeInt(word, numBytes)
+ && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
+ if ((-127 <= n) && (n <= 127)) {
+ haveImmValue = 1;
+ immValue = n;
+ }
+ }
+ word[numBytes] = savedChar;
+ if (!haveImmValue) {
+ TclEmitPush(TclRegisterLiteral(envPtr, word, numBytes,
+ /*onHeap*/ 0), envPtr);
+ maxDepth += 1;
+ }
+ } else {
+ code = TclCompileTokens(interp, incrTokenPtr+1,
+ incrTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (increment expression)", -1);
+ }
+ goto done;
+ }
+ maxDepth += envPtr->maxStackDepth;
+ }
+ } else { /* no incr amount given so use 1 */
+ haveImmValue = 1;
+ immValue = 1;
+ }
+
+ /*
+ * Emit the instruction to increment the variable.
+ */
+
+ if (name != NULL) {
+ if (elName == NULL) {
+ if (localIndex >= 0) {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex,
+ envPtr);
+ TclEmitInt1(immValue, envPtr);
+ } else {
+ TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
+ }
+ } else {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue,
+ envPtr);
+ } else {
+ TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
+ }
+ }
+ } else {
+ if (localIndex >= 0) {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex,
+ envPtr);
+ TclEmitInt1(immValue, envPtr);
+ } else {
+ TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
+ }
+ } else {
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue,
+ envPtr);
+ } else {
+ TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
+ }
+ }
+ }
+ } else { /* non-simple variable name */
+ if (haveImmValue) {
+ TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
+ } else {
+ TclEmitOpcode(INST_INCR_STK, envPtr);
+ }
+ }
+
+ done:
+ if (gotElemParse) {
+ Tcl_FreeParse(&elemParse);
+ }
+ envPtr->maxStackDepth = maxDepth;
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileSetCmd --
+ *
+ * Procedure called to compile the "set" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is normally TCL_OK
+ * unless there was an error while parsing string. If an error occurs
+ * then the interpreter's result contains a standard error message. If
+ * complation fails because the set command requires a second level of
+ * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+ * set command should be compiled "out of line" by emitting code to
+ * invoke its command procedure (Tcl_SetCmd) at runtime.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the incr command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "set" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileSetCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *varTokenPtr, *valueTokenPtr;
+ Tcl_Parse elemParse;
+ int gotElemParse = 0;
+ register char *p;
+ char *name, *elName;
+ int nameChars, elNameChars;
+ register int i, n;
+ int isAssignment, simpleVarName, localIndex, numWords;
+ int maxDepth = 0;
+ int code = TCL_OK;
+
+ envPtr->maxStackDepth = 0;
+ numWords = parsePtr->numWords;
+ if ((numWords != 2) && (numWords != 3)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"set varName ?newValue?\"", -1);
+ return TCL_ERROR;
+ }
+ isAssignment = (numWords == 3);
+
+ /*
+ * Decide if we can use a frame slot for the var/array name or if we
+ * need to emit code to compute and push the name at runtime. We use a
+ * frame slot (entry in the array of local vars) if we are compiling a
+ * procedure body and if the name is simple text that does not include
+ * namespace qualifiers.
+ */
+
+ simpleVarName = 0;
+ name = elName = NULL;
+ nameChars = elNameChars = 0;
+ localIndex = -1;
+
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 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.
+ * This goes with the hack in TclCompileIncrCmd.
+ */
+ if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+ (varTokenPtr->start[0] != '{')) {
+ simpleVarName = 1;
+
+ name = varTokenPtr[1].start;
+ nameChars = varTokenPtr[1].size;
+ /* last char is ')' => potential array reference */
+ if ( *(name + nameChars - 1) == ')') {
+ for (i = 0, p = name; i < nameChars; i++, p++) {
+ if (*p == '(') {
+ elName = p + 1;
+ elNameChars = nameChars - i - 2;
+ nameChars = i ;
+ break;
+ }
+ }
+ }
+
+ /*
+ * If elName contains any double quotes ("), we can't inline
+ * compile the element script using the replace '()' by '"'
+ * technique below.
+ */
+
+ for (i = 0, p = elName; i < elNameChars; i++, p++) {
+ if (*p == '"') {
+ simpleVarName = 0;
+ break;
+ }
+ }
+ } else if (((n = varTokenPtr->numComponents) > 1)
+ && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
+ && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
+ && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
+ simpleVarName = 0;
+
+ /*
+ * Check for parentheses inside first token
+ */
+ for (i = 0, p = varTokenPtr[1].start;
+ i < varTokenPtr[1].size; i++, p++) {
+ if (*p == '(') {
+ simpleVarName = 1;
+ break;
+ }
+ }
+ if (simpleVarName) {
+ name = varTokenPtr[1].start;
+ nameChars = p - varTokenPtr[1].start;
+ elName = p + 1;
+ elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
+
+ /*
+ * If elName contains any double quotes ("), we can't inline
+ * compile the element script using the replace '()' by '"'
+ * technique below.
+ */
+
+ for (i = 0, p = elName; i < elNameChars; i++, p++) {
+ if (*p == '"') {
+ simpleVarName = 0;
+ break;
+ }
+ }
+ }
+ }
+
+ if (simpleVarName) {
+ /*
+ * See whether name has any namespace separators (::'s).
+ */
+
+ int hasNsQualifiers = 0;
+ for (i = 0, p = name; i < nameChars; i++, p++) {
+ if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
+ hasNsQualifiers = 1;
+ break;
+ }
+ }
+
+ /*
+ * Look up the var name's index in the array of local vars in the
+ * proc frame. If retrieving the var's value and it doesn't already
+ * exist, push its name and look it up at runtime.
+ */
+
+ if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
+ localIndex = TclFindCompiledLocal(name, nameChars,
+ /*create*/ isAssignment,
+ /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
+ envPtr->procPtr);
+ }
+ if (localIndex >= 0) {
+ maxDepth = 0;
+ } else {
+ TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
+ /*onHeap*/ 0), envPtr);
+ maxDepth = 1;
+ }
+
+ /*
+ * Compile the element script, if any.
+ */
+
+ if (elName != NULL) {
+ /*
+ * Temporarily replace the '(' and ')' by '"'s.
+ */
+
+ *(elName-1) = '"';
+ *(elName+elNameChars) = '"';
+ code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
+ /*nested*/ 0, &elemParse);
+ *(elName-1) = '(';
+ *(elName+elNameChars) = ')';
+ gotElemParse = 1;
+ if ((code != TCL_OK) || (elemParse.numWords > 1)) {
+ char buffer[160];
+ sprintf(buffer, "\n (parsing index for array \"%.*s\")",
+ TclMin(nameChars, 100), name);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ code = TCL_ERROR;
+ goto done;
+ } else if (elemParse.numWords == 1) {
+ code = TclCompileTokens(interp, elemParse.tokenPtr+1,
+ elemParse.tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth += envPtr->maxStackDepth;
+ } else {
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
+ /*alreadyAlloced*/ 0), envPtr);
+ maxDepth += 1;
+ }
+ }
+ } else {
+ /*
+ * The var name isn't simple: compile and push it.
+ */
+
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth += envPtr->maxStackDepth;
+ }
+
+ /*
+ * If we are doing an assignment, push the new value.
+ */
+
+ if (isAssignment) {
+ valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
+ valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
+ maxDepth += 1;
+ } else {
+ code = TclCompileTokens(interp, valueTokenPtr+1,
+ valueTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth += envPtr->maxStackDepth;
+ }
+ }
+
+ /*
+ * Emit instructions to set/get the variable.
+ */
+
+ if (simpleVarName) {
+ if (elName == NULL) {
+ if (localIndex >= 0) {
+ if (localIndex <= 255) {
+ TclEmitInstInt1((isAssignment?
+ INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
+ localIndex, envPtr);
+ } else {
+ TclEmitInstInt4((isAssignment?
+ INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
+ localIndex, envPtr);
+ }
+ } else {
+ TclEmitOpcode((isAssignment?
+ INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK),
+ envPtr);
+ }
+ } else {
+ if (localIndex >= 0) {
+ if (localIndex <= 255) {
+ TclEmitInstInt1((isAssignment?
+ INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
+ localIndex, envPtr);
+ } else {
+ TclEmitInstInt4((isAssignment?
+ INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
+ localIndex, envPtr);
+ }
+ } else {
+ TclEmitOpcode((isAssignment?
+ INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK),
+ envPtr);
+ }
+ }
+ } else {
+ TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK),
+ envPtr);
+ }
+
+ done:
+ if (gotElemParse) {
+ Tcl_FreeParse(&elemParse);
+ }
+ envPtr->maxStackDepth = maxDepth;
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileWhileCmd --
+ *
+ * Procedure called to compile the "while" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if
+ * compilation was successful. If an error occurs then the
+ * interpreter's result contains a standard error message and TCL_ERROR
+ * is returned. If compilation failed because the command is too
+ * complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
+ * indicating that the while command should be compiled "out of line"
+ * by emitting code to invoke its command procedure at runtime.
+ *
+ * envPtr->maxStackDepth is updated with the maximum number of stack
+ * elements needed to execute the "while" command.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "while" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileWhileCmd(interp, parsePtr, envPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Points to a parse structure for the
+ * command created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *testTokenPtr, *bodyTokenPtr;
+ JumpFixup jumpFalseFixup;
+ unsigned char *jumpPc;
+ int testCodeOffset, jumpDist, jumpBackDist, jumpBackOffset;
+ int range, maxDepth, code;
+ char buffer[32 + TCL_INTEGER_SPACE];
+
+ envPtr->maxStackDepth = 0;
+ maxDepth = 0;
+ if (parsePtr->numWords != 3) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"while test command\"", -1);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the test expression requires substitutions, don't compile the
+ * while command inline. E.g., the expression might cause the loop to
+ * never execute or execute forever, as in "while "$x < 5" {}".
+ */
+
+ testTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * Create a ExceptionRange record for the loop body. This is used to
+ * implement break and continue.
+ */
+
+ envPtr->exceptDepth++;
+ envPtr->maxExceptDepth =
+ TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+ range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+ envPtr->exceptArrayPtr[range].continueOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+
+ /*
+ * Compile the test expression then emit the conditional jump that
+ * terminates the while. We already know it's a simple word.
+ */
+
+ testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"while\" test expression)", -1);
+ }
+ goto error;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+
+ /*
+ * Compile the loop body.
+ */
+
+ bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+ envPtr->exceptArrayPtr[range].codeOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+ bodyTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"while\" body line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto error;
+ }
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+ envPtr->exceptArrayPtr[range].numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart)
+ - envPtr->exceptArrayPtr[range].codeOffset;
+ 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 = (envPtr->codeNext - envPtr->codeStart);
+ jumpBackDist = (jumpBackOffset - testCodeOffset);
+ if (jumpBackDist > 120) {
+ TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
+ }
+
+ /*
+ * Fix the target of the jumpFalse after the test.
+ */
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpFalseFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 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);
+ }
+ }
+
+ /*
+ * Set the loop's break target.
+ */
+
+ envPtr->exceptArrayPtr[range].breakOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+
+ /*
+ * The while command's result is an empty string.
+ */
+
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ if (maxDepth == 0) {
+ maxDepth = 1;
+ }
+ envPtr->maxStackDepth = maxDepth;
+ envPtr->exceptDepth--;
+ return TCL_OK;
+
+ error:
+ envPtr->maxStackDepth = maxDepth;
+ envPtr->exceptDepth--;
+ return code;
+}
+
+
+
diff --git a/tcl/generic/tclCompExpr.c b/tcl/generic/tclCompExpr.c
index d83752fe801..ff368e20004 100644
--- a/tcl/generic/tclCompExpr.c
+++ b/tcl/generic/tclCompExpr.c
@@ -3,7 +3,7 @@
*
* This file contains the code to compile Tcl expressions.
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -37,7 +37,7 @@ extern int errno; /* Use errno from tclExecute.c. */
*/
#ifdef TCL_COMPILE_DEBUG
-static int traceCompileExpr = 0;
+static int traceExprComp = 0;
#endif /* TCL_COMPILE_DEBUG */
/*
@@ -47,21 +47,12 @@ static int traceCompileExpr = 0;
*/
typedef struct ExprInfo {
- int token; /* Type of the last token parsed in expr.
- * See below for definitions. Corresponds
- * to the characters just before next. */
- int objIndex; /* If token is a literal value, the index of
- * an object holding the value in the code's
- * object table; otherwise is NULL. */
- char *funcName; /* If the token is FUNC_NAME, points to the
- * first character of the math function's
- * name; otherwise is NULL. */
- char *next; /* Position of the next character to be
- * scanned in the expression string. */
- char *originalExpr; /* The entire expression that was originally
- * passed to Tcl_ExprString et al. */
- char *lastChar; /* Pointer to terminating null in
- * originalExpr. */
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Parse *parsePtr; /* Structure filled with information about
+ * the parsed expression. */
+ char *expr; /* The expression that was originally passed
+ * to TclCompileExpr. */
+ char *lastChar; /* Points just after last byte of expr. */
int hasOperators; /* Set 1 if the expr has operators; 0 if
* expr is only a primary. If 1 after
* compiling an expr, a tryCvtToNumeric
@@ -82,135 +73,116 @@ typedef struct ExprInfo {
} ExprInfo;
/*
- * Definitions of the different tokens that appear in expressions. The order
- * of these must match the corresponding entries in the operatorStrings
- * array below.
+ * Definitions of numeric codes representing each expression operator.
+ * The order of these must match the entries in the operatorTable below.
+ * Also the codes for the relational operators (OP_LESS, OP_GREATER,
+ * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order.
+ * Note that OP_PLUS and OP_MINUS represent both unary and binary operators.
*/
-#define LITERAL 0
-#define FUNC_NAME (LITERAL + 1)
-#define OPEN_BRACKET (LITERAL + 2)
-#define CLOSE_BRACKET (LITERAL + 3)
-#define OPEN_PAREN (LITERAL + 4)
-#define CLOSE_PAREN (LITERAL + 5)
-#define DOLLAR (LITERAL + 6)
-#define QUOTE (LITERAL + 7)
-#define COMMA (LITERAL + 8)
-#define END (LITERAL + 9)
-#define UNKNOWN (LITERAL + 10)
+#define OP_MULT 0
+#define OP_DIVIDE 1
+#define OP_MOD 2
+#define OP_PLUS 3
+#define OP_MINUS 4
+#define OP_LSHIFT 5
+#define OP_RSHIFT 6
+#define OP_LESS 7
+#define OP_GREATER 8
+#define OP_LE 9
+#define OP_GE 10
+#define OP_EQ 11
+#define OP_NEQ 12
+#define OP_BITAND 13
+#define OP_BITXOR 14
+#define OP_BITOR 15
+#define OP_LAND 16
+#define OP_LOR 17
+#define OP_QUESTY 18
+#define OP_LNOT 19
+#define OP_BITNOT 20
/*
- * Binary operators:
+ * Table describing the expression operators. Entries in this table must
+ * correspond to the definitions of numeric codes for operators just above.
*/
-#define MULT (UNKNOWN + 1)
-#define DIVIDE (MULT + 1)
-#define MOD (MULT + 2)
-#define PLUS (MULT + 3)
-#define MINUS (MULT + 4)
-#define LEFT_SHIFT (MULT + 5)
-#define RIGHT_SHIFT (MULT + 6)
-#define LESS (MULT + 7)
-#define GREATER (MULT + 8)
-#define LEQ (MULT + 9)
-#define GEQ (MULT + 10)
-#define EQUAL (MULT + 11)
-#define NEQ (MULT + 12)
-#define BIT_AND (MULT + 13)
-#define BIT_XOR (MULT + 14)
-#define BIT_OR (MULT + 15)
-#define AND (MULT + 16)
-#define OR (MULT + 17)
-#define QUESTY (MULT + 18)
-#define COLON (MULT + 19)
-
-/*
- * Unary operators. Unary minus and plus are represented by the (binary)
- * tokens MINUS and PLUS.
- */
-
-#define NOT (COLON + 1)
-#define BIT_NOT (NOT + 1)
+static int opTableInitialized = 0; /* 0 means not yet initialized. */
+
+TCL_DECLARE_MUTEX(opMutex)
+
+typedef struct OperatorDesc {
+ char *name; /* Name of the operator. */
+ int numOperands; /* Number of operands. 0 if the operator
+ * requires special handling. */
+ int instruction; /* Instruction opcode for the operator.
+ * Ignored if numOperands is 0. */
+} OperatorDesc;
+
+OperatorDesc operatorTable[] = {
+ {"*", 2, INST_MULT},
+ {"/", 2, INST_DIV},
+ {"%", 2, INST_MOD},
+ {"+", 0},
+ {"-", 0},
+ {"<<", 2, INST_LSHIFT},
+ {">>", 2, INST_RSHIFT},
+ {"<", 2, INST_LT},
+ {">", 2, INST_GT},
+ {"<=", 2, INST_LE},
+ {">=", 2, INST_GE},
+ {"==", 2, INST_EQ},
+ {"!=", 2, INST_NEQ},
+ {"&", 2, INST_BITAND},
+ {"^", 2, INST_BITXOR},
+ {"|", 2, INST_BITOR},
+ {"&&", 0},
+ {"||", 0},
+ {"?", 0},
+ {"!", 1, INST_LNOT},
+ {"~", 1, INST_BITNOT},
+ {NULL}
+};
/*
- * Mapping from tokens to strings; used for debugging messages. These
- * entries must match the order and number of the token definitions above.
+ * Hashtable used to map the names of expression operators to the index
+ * of their OperatorDesc description.
*/
-#ifdef TCL_COMPILE_DEBUG
-static char *tokenStrings[] = {
- "LITERAL", "FUNCNAME",
- "[", "]", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
- "*", "/", "%", "+", "-",
- "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
- "&", "^", "|", "&&", "||", "?", ":",
- "!", "~"
-};
-#endif /* TCL_COMPILE_DEBUG */
+static Tcl_HashTable opHashTable;
/*
* Declarations for local procedures to this file:
*/
-static int CompileAddExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileBitAndExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileBitOrExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileBitXorExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileCondExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileEqualityExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
+static int CompileCondExpr _ANSI_ARGS_((
+ Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
+ CompileEnv *envPtr, Tcl_Token **endPtrPtr));
+static int CompileLandOrLorExpr _ANSI_ARGS_((
+ Tcl_Token *exprTokenPtr, int opIndex,
+ ExprInfo *infoPtr, CompileEnv *envPtr,
+ Tcl_Token **endPtrPtr));
+static int CompileMathFuncCall _ANSI_ARGS_((
+ Tcl_Token *exprTokenPtr, char *funcName,
+ ExprInfo *infoPtr, CompileEnv *envPtr,
+ Tcl_Token **endPtrPtr));
+static int CompileSubExpr _ANSI_ARGS_((
+ Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
CompileEnv *envPtr));
-static int CompileLandExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileLorExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileMathFuncCall _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileMultiplyExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompilePrimaryExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileRelationalExpr _ANSI_ARGS_((
- Tcl_Interp *interp, ExprInfo *infoPtr,
- int flags, CompileEnv *envPtr));
-static int CompileShiftExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int CompileUnaryExpr _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, int flags,
- CompileEnv *envPtr));
-static int GetToken _ANSI_ARGS_((Tcl_Interp *interp,
- ExprInfo *infoPtr, CompileEnv *envPtr));
+static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
/*
- * Macro used to debug the execution of the recursive descent parser used
- * to compile expressions.
+ * Macro used to debug the execution of the expression compiler.
*/
#ifdef TCL_COMPILE_DEBUG
-#define HERE(production, level) \
- if (traceCompileExpr) { \
- fprintf(stderr, "%*s%s: token=%s, next=\"%.20s\"\n", \
- (level), " ", (production), tokenStrings[infoPtr->token], \
- infoPtr->next); \
+#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \
+ if (traceExprComp) { \
+ fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \
+ (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \
}
#else
-#define HERE(production, level)
+#define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)
#endif /* TCL_COMPILE_DEBUG */
/*
@@ -224,23 +196,11 @@ static int GetToken _ANSI_ARGS_((Tcl_Interp *interp,
* procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,
* Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
*
- * Note that the topmost recursive-descent parsing routine used by
- * TclCompileExpr to compile expressions is called "CompileCondExpr"
- * and not, e.g., "CompileExpr". This is done to avoid an extra
- * procedure call since such a procedure would only return the result
- * of calling CompileCondExpr. Other recursive-descent procedures
- * that need to parse expressions also call CompileCondExpr.
- *
* Results:
* The return value is TCL_OK on a successful compilation and TCL_ERROR
* on failure. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed; this might
- * be the offset of the ']' (if flags & TCL_BRACKET_TERM), or the
- * offset of the '\0' at the end of the string.
- *
* envPtr->maxStackDepth is updated with the maximum number of stack
* elements needed to execute the expression.
*
@@ -261,85 +221,73 @@ static int GetToken _ANSI_ARGS_((Tcl_Interp *interp,
*/
int
-TclCompileExpr(interp, string, lastChar, flags, envPtr)
+TclCompileExpr(interp, script, numBytes, envPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
+ char *script; /* The source script to compile. */
+ int numBytes; /* Number of bytes in script. If < 0, the
+ * string consists of all bytes up to the
+ * first null character. */
CompileEnv *envPtr; /* Holds resulting instructions. */
{
- Interp *iPtr = (Interp *) interp;
ExprInfo info;
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int result;
-
-#ifdef TCL_COMPILE_DEBUG
- if (traceCompileExpr) {
- fprintf(stderr, "expr: string=\"%.30s\"\n", string);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ Tcl_Parse parse;
+ Tcl_HashEntry *hPtr;
+ int maxDepth, new, i, code;
/*
- * Register the builtin math functions the first time an expression is
- * compiled.
+ * If this is the first time we've been called, initialize the table
+ * of expression operators.
*/
- if (!(iPtr->flags & EXPR_INITIALIZED)) {
- BuiltinFunc *funcPtr;
- Tcl_HashEntry *hPtr;
- MathFunc *mathFuncPtr;
- int i;
-
- iPtr->flags |= EXPR_INITIALIZED;
- i = 0;
- for (funcPtr = builtinFuncTable; funcPtr->name != NULL; funcPtr++) {
- Tcl_CreateMathFunc(interp, funcPtr->name,
- funcPtr->numArgs, funcPtr->argTypes,
- (Tcl_MathProc *) NULL, (ClientData) 0);
-
- hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcPtr->name);
- if (hPtr == NULL) {
- panic("TclCompileExpr: Tcl_CreateMathFunc incorrectly registered '%s'", funcPtr->name);
- return TCL_ERROR;
+ if (numBytes < 0) {
+ numBytes = (script? strlen(script) : 0);
+ }
+ if (!opTableInitialized) {
+ Tcl_MutexLock(&opMutex);
+ if (!opTableInitialized) {
+ Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
+ for (i = 0; operatorTable[i].name != NULL; i++) {
+ hPtr = Tcl_CreateHashEntry(&opHashTable,
+ operatorTable[i].name, &new);
+ if (new) {
+ Tcl_SetHashValue(hPtr, (ClientData) i);
+ }
}
- mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
- mathFuncPtr->builtinFuncIndex = i;
- i++;
+ opTableInitialized = 1;
}
+ Tcl_MutexUnlock(&opMutex);
}
- info.token = UNKNOWN;
- info.objIndex = -1;
- info.funcName = NULL;
- info.next = string;
- info.originalExpr = string;
- info.lastChar = lastChar;
+ /*
+ * Initialize the structure containing information abvout this
+ * expression compilation.
+ */
+
+ info.interp = interp;
+ info.parsePtr = &parse;
+ info.expr = script;
+ info.lastChar = (script + numBytes);
info.hasOperators = 0;
info.exprIsJustVarRef = 1; /* will be set 0 if anything else is seen */
- info.exprIsComparison = 0; /* set 1 if topmost operator is <,==,etc. */
+ info.exprIsComparison = 0;
/*
- * Get the first token then compile an expression.
+ * Parse the expression then compile it.
*/
- result = GetToken(interp, &info, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileCondExpr(interp, &info, flags, envPtr);
- if (result != TCL_OK) {
+ maxDepth = 0;
+ code = Tcl_ParseExpr(interp, script, numBytes, &parse);
+ if (code != TCL_OK) {
goto done;
}
- if (info.token != END) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "syntax error in expression \"", string, "\"", (char *) NULL);
- result = TCL_ERROR;
+
+ code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
+ if (code != TCL_OK) {
+ Tcl_FreeParse(&parse);
goto done;
}
+ maxDepth = envPtr->maxStackDepth;
+
if (!info.hasOperators) {
/*
* Attempt to convert the primary's object to an int or double.
@@ -350,186 +298,54 @@ TclCompileExpr(interp, string, lastChar, flags, envPtr)
TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
}
- maxDepth = envPtr->maxStackDepth;
+ Tcl_FreeParse(&parse);
done:
- envPtr->termOffset = (info.next - string);
envPtr->maxStackDepth = maxDepth;
envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
envPtr->exprIsComparison = info.exprIsComparison;
- return result;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * CompileCondExpr --
+ * TclFinalizeCompilation --
*
- * This procedure compiles a Tcl conditional expression:
- * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
- *
- * Note that this is the topmost recursive-descent parsing routine used
- * by TclCompileExpr to compile expressions. It does not call an
- * separate, higher-level "CompileExpr" procedure. This avoids an extra
- * procedure call since such a procedure would only return the result
- * of calling CompileCondExpr. Other recursive-descent procedures that
- * need to parse expressions also call CompileCondExpr.
+ * Clean up the compilation environment so it can later be
+ * properly reinitialized. This procedure is called by
+ * TclFinalizeCompExecEnv() in tclObj.c, which in turn is called
+ * by Tcl_Finalize().
*
* Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
+ * None.
*
* Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
+ * Cleans up the compilation environment. At the moment, just the
+ * table of expression operators is freed.
*
*----------------------------------------------------------------------
*/
-static int
-CompileCondExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+void
+TclFinalizeCompilation()
{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
- /* Used to update or replace one-byte jumps
- * around the then and else expressions when
- * their target PCs are determined. */
- int elseCodeOffset, currCodeOffset, jumpDist, result;
-
- HERE("condExpr", 1);
- result = CompileLorExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
+ Tcl_MutexLock(&opMutex);
+ if (opTableInitialized) {
+ Tcl_DeleteHashTable(&opHashTable);
+ opTableInitialized = 0;
}
- maxDepth = envPtr->maxStackDepth;
-
- if (infoPtr->token == QUESTY) {
- result = GetToken(interp, infoPtr, envPtr); /* skip over the '?' */
- if (result != TCL_OK) {
- goto done;
- }
-
- /*
- * Emit the jump around the "then" clause to the "else" condExpr if
- * the test was false. We emit a one byte (relative) jump here, and
- * replace it later with a four byte jump if the jump target is more
- * than 127 bytes away.
- */
-
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
-
- /*
- * Compile the "then" expression. Note that if a subexpression
- * is only a primary, we need to try to convert it to numeric.
- * This is done in order to support Tcl's policy of interpreting
- * operands if at all possible as first integers, else
- * floating-point numbers.
- */
-
- infoPtr->hasOperators = 0;
- infoPtr->exprIsJustVarRef = 0;
- infoPtr->exprIsComparison = 0;
- result = CompileCondExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- if (infoPtr->token != COLON) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "syntax error in expression \"", infoPtr->originalExpr,
- "\"", (char *) NULL);
- result = TCL_ERROR;
- goto done;
- }
- if (!infoPtr->hasOperators) {
- TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
- }
- result = GetToken(interp, infoPtr, envPtr); /* skip over the ':' */
- if (result != TCL_OK) {
- goto done;
- }
-
- /*
- * Emit an unconditional jump around the "else" condExpr.
- */
-
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- &jumpAroundElseFixup);
-
- /*
- * Compile the "else" expression.
- */
-
- infoPtr->hasOperators = 0;
- elseCodeOffset = TclCurrCodeOffset();
- result = CompileCondExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- if (!infoPtr->hasOperators) {
- TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
- }
-
- /*
- * Fix up the second jump: the unconditional jump around the "else"
- * expression. If the distance is too great (> 127 bytes), replace
- * it with a four byte instruction and move the instructions after
- * the jump down.
- */
-
- currCodeOffset = TclCurrCodeOffset();
- jumpDist = (currCodeOffset - jumpAroundElseFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, jumpDist, 127)) {
- /*
- * Update the else expression's starting code offset since it
- * moved down 3 bytes too.
- */
-
- elseCodeOffset += 3;
- }
-
- /*
- * Now fix up the first branch: the jumpFalse after the test. If the
- * distance is too great, replace it with a four byte instruction
- * and update the code offsets for the commands in both the "then"
- * and "else" expressions.
- */
-
- jumpDist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
- TclFixupForwardJump(envPtr, &jumpAroundThenFixup, jumpDist, 127);
-
- infoPtr->hasOperators = 1;
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 0;
- }
-
- done:
- envPtr->maxStackDepth = maxDepth;
- return result;
+ Tcl_MutexUnlock(&opMutex);
}
/*
*----------------------------------------------------------------------
*
- * CompileLorExpr --
+ * CompileSubExpr --
*
- * This procedure compiles a Tcl logical or expression:
- * lorExpr ::= landExpr {'||' landExpr}
+ * Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
+ * subexpression, this procedure emits instructions to evaluate the
+ * subexpression at runtime.
*
* Results:
* The return value is TCL_OK on a successful compilation and TCL_ERROR
@@ -537,408 +353,292 @@ CompileCondExpr(interp, infoPtr, flags, envPtr)
* contains an error message.
*
* envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
+ * elements needed to execute the subexpression.
+ *
+ * envPtr->exprIsJustVarRef is set 1 if the subexpression consisted of
+ * a single variable reference as in the expression of "if $b then...".
+ * Otherwise it is set 0. This is used to implement Tcl's two level
+ * expression substitution semantics properly.
+ *
+ * envPtr->exprIsComparison is set 1 if the top-level operator in the
+ * subexpression is a comparison. Otherwise it is set 0. If 1, because
+ * the operands might be strings, the expr is compiled out-of-line in
+ * order to implement expr's 2 level substitution semantics properly.
*
* Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
+ * Adds instructions to envPtr to evaluate the subexpression.
*
*----------------------------------------------------------------------
*/
static int
-CompileLorExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
+CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
+ Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
+ * to compile. */
ExprInfo *infoPtr; /* Describes the compilation state for the
* expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
CompileEnv *envPtr; /* Holds resulting instructions. */
{
- int maxDepth; /* Maximum number of stack elements needed
- * to execute the expression. */
- JumpFixupArray jumpFixupArray;
- /* Used to fix up the forward "short
- * circuit" jump after each or-ed
- * subexpression to just after the last
- * subexpression. */
- JumpFixup jumpTrueFixup, jumpFixup;
- /* Used to emit the jumps in the code to
- * convert the first operand to a 0 or 1. */
- int fixupIndex, jumpDist, currCodeOffset, objIndex, j, result;
- Tcl_Obj *objPtr;
-
- HERE("lorExpr", 2);
- result = CompileLandExpr(interp, infoPtr, flags, envPtr);
- if ((result != TCL_OK) || (infoPtr->token != OR)) {
- return result; /* envPtr->maxStackDepth is already set */
- }
-
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- maxDepth = envPtr->maxStackDepth;
- TclInitJumpFixupArray(&jumpFixupArray);
- while (infoPtr->token == OR) {
- result = GetToken(interp, infoPtr, envPtr); /* skip over the '||' */
- if (result != TCL_OK) {
- goto done;
- }
+ Tcl_Interp *interp = infoPtr->interp;
+ Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr;
+ OperatorDesc *opDescPtr;
+ Tcl_HashEntry *hPtr;
+ char *operator;
+ int maxDepth, objIndex, opIndex, length, code;
+ char buffer[TCL_UTF_MAX];
- if (jumpFixupArray.next == 0) {
- /*
- * Just the first "lor" operand is on the stack. The following
- * is slightly ugly: we need to convert that first "lor" operand
- * to a "0" or "1" to get the correct result if it is nonzero.
- * Eventually we'll use a new instruction for this.
- */
+ if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
+ panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
+ exprTokenPtr->type);
+ }
+ maxDepth = 0;
+ code = TCL_OK;
- TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpTrueFixup);
+ /*
+ * Switch on the type of the first token after the subexpression token.
+ * After processing it, advance tokenPtr to point just after the
+ * subexpression's last token.
+ */
+
+ tokenPtr = exprTokenPtr+1;
+ TRACE(exprTokenPtr->start, exprTokenPtr->size,
+ tokenPtr->start, tokenPtr->size);
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_WORD:
+ code = TclCompileTokens(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
+ infoPtr->exprIsJustVarRef = 0;
+ break;
- objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = 0;
- objPtr->typePtr = &tclIntType;
+ case TCL_TOKEN_TEXT:
+ if (tokenPtr->size > 0) {
+ objIndex = TclRegisterLiteral(envPtr, tokenPtr->start,
+ tokenPtr->size, /*onHeap*/ 0);
+ } else {
+ objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
+ }
+ TclEmitPush(objIndex, envPtr);
+ maxDepth = 1;
+ tokenPtr += 1;
+ infoPtr->exprIsJustVarRef = 0;
+ break;
+ case TCL_TOKEN_BS:
+ length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
+ buffer);
+ if (length > 0) {
+ objIndex = TclRegisterLiteral(envPtr, buffer, length,
+ /*onHeap*/ 0);
+ } else {
+ objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
+ }
TclEmitPush(objIndex, envPtr);
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
-
- jumpDist = (TclCurrCodeOffset() - jumpTrueFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpTrueFixup, jumpDist, 127)) {
- panic("CompileLorExpr: bad jump distance %d\n", jumpDist);
+ maxDepth = 1;
+ tokenPtr += 1;
+ infoPtr->exprIsJustVarRef = 0;
+ break;
+
+ case TCL_TOKEN_COMMAND:
+ code = TclCompileScript(interp, tokenPtr->start+1,
+ tokenPtr->size-2, /*nested*/ 1, envPtr);
+ if (code != TCL_OK) {
+ goto done;
}
- objIndex = TclObjIndexForString("1", 1, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = 1;
- objPtr->typePtr = &tclIntType;
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += 1;
+ infoPtr->exprIsJustVarRef = 0;
+ break;
- TclEmitPush(objIndex, envPtr);
-
- jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
- panic("CompileLorExpr: bad jump distance %d\n", jumpDist);
+ case TCL_TOKEN_VARIABLE:
+ code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ goto done;
}
- }
-
- /*
- * Duplicate the value on top of the stack to prevent the jump from
- * consuming it.
- */
-
- TclEmitOpcode(INST_DUP, envPtr);
-
- /*
- * Emit the "short circuit" jump around the rest of the lorExp if
- * the previous expression was true. We emit a one byte (relative)
- * jump here, and replace it later with a four byte jump if the jump
- * target is more than 127 bytes away.
- */
-
- if (jumpFixupArray.next == jumpFixupArray.end) {
- TclExpandJumpFixupArray(&jumpFixupArray);
- }
- fixupIndex = jumpFixupArray.next;
- jumpFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
- &(jumpFixupArray.fixup[fixupIndex]));
-
- /*
- * Compile the subexpression.
- */
-
- result = CompileLandExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
-
- /*
- * Emit a "logical or" instruction. This does not try to "short-
- * circuit" the evaluation of both operands of a Tcl "||" operator,
- * but instead ensures that we either have a "1" or a "0" result.
- */
-
- TclEmitOpcode(INST_LOR, envPtr);
- }
-
- /*
- * Now that we know the target of the forward jumps, update the jumps
- * with the correct distance. Also, if the distance is too great (> 127
- * bytes), replace the jump with a four byte instruction and move the
- * instructions after the jump down.
- */
-
- for (j = jumpFixupArray.next; j > 0; j--) {
- fixupIndex = (j - 1); /* process closest jump first */
- currCodeOffset = TclCurrCodeOffset();
- jumpDist = (currCodeOffset - jumpFixupArray.fixup[fixupIndex].codeOffset);
- TclFixupForwardJump(envPtr, &(jumpFixupArray.fixup[fixupIndex]), jumpDist, 127);
- }
-
- /*
- * We get here only if one or more ||'s appear as top-level operators.
- */
-
- done:
- infoPtr->exprIsComparison = 0;
- TclFreeJumpFixupArray(&jumpFixupArray);
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileLandExpr --
- *
- * This procedure compiles a Tcl logical and expression:
- * landExpr ::= bitOrExpr {'&&' bitOrExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileLandExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth; /* Maximum number of stack elements needed
- * to execute the expression. */
- JumpFixupArray jumpFixupArray;
- /* Used to fix up the forward "short
- * circuit" jump after each and-ed
- * subexpression to just after the last
- * subexpression. */
- JumpFixup jumpTrueFixup, jumpFixup;
- /* Used to emit the jumps in the code to
- * convert the first operand to a 0 or 1. */
- int fixupIndex, jumpDist, currCodeOffset, objIndex, j, result;
- Tcl_Obj *objPtr;
-
- HERE("landExpr", 3);
- result = CompileBitOrExpr(interp, infoPtr, flags, envPtr);
- if ((result != TCL_OK) || (infoPtr->token != AND)) {
- return result; /* envPtr->maxStackDepth is already set */
- }
-
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- maxDepth = envPtr->maxStackDepth;
- TclInitJumpFixupArray(&jumpFixupArray);
- while (infoPtr->token == AND) {
- result = GetToken(interp, infoPtr, envPtr); /* skip over the '&&' */
- if (result != TCL_OK) {
- goto done;
- }
-
- if (jumpFixupArray.next == 0) {
- /*
- * Just the first "land" operand is on the stack. The following
- * is slightly ugly: we need to convert the first "land" operand
- * to a "0" or "1" to get the correct result if it is
- * nonzero. Eventually we'll use a new instruction.
- */
-
- TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpTrueFixup);
-
- objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = 0;
- objPtr->typePtr = &tclIntType;
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
+ break;
- TclEmitPush(objIndex, envPtr);
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
-
- jumpDist = (TclCurrCodeOffset() - jumpTrueFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpTrueFixup, jumpDist, 127)) {
- panic("CompileLandExpr: bad jump distance %d\n", jumpDist);
+ case TCL_TOKEN_SUB_EXPR:
+ infoPtr->exprIsComparison = 0;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
+ goto done;
}
- objIndex = TclObjIndexForString("1", 1, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = 1;
- objPtr->typePtr = &tclIntType;
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
+ break;
- TclEmitPush(objIndex, envPtr);
-
- jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
- panic("CompileLandExpr: bad jump distance %d\n", jumpDist);
+ case TCL_TOKEN_OPERATOR: {
+ Tcl_DString operatorDString;
+
+ Tcl_DStringInit(&operatorDString);
+ Tcl_DStringAppend(&operatorDString, tokenPtr->start,
+ tokenPtr->size);
+ operator = Tcl_DStringValue(&operatorDString);
+ hPtr = Tcl_FindHashEntry(&opHashTable, operator);
+ if (hPtr == NULL) {
+ code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
+ envPtr, &endPtr);
+ Tcl_DStringFree(&operatorDString);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr = endPtr;
+ infoPtr->exprIsJustVarRef = 0;
+ infoPtr->exprIsComparison = 0;
+ break;
}
- }
-
- /*
- * Duplicate the value on top of the stack to prevent the jump from
- * consuming it.
- */
+ Tcl_DStringFree(&operatorDString);
+ opIndex = (int) Tcl_GetHashValue(hPtr);
+ opDescPtr = &(operatorTable[opIndex]);
- TclEmitOpcode(INST_DUP, envPtr);
+ /*
+ * If the operator is "normal", compile it using information
+ * from the operator table.
+ */
- /*
- * Emit the "short circuit" jump around the rest of the landExp if
- * the previous expression was false. We emit a one byte (relative)
- * jump here, and replace it later with a four byte jump if the jump
- * target is more than 127 bytes away.
- */
+ if (opDescPtr->numOperands > 0) {
+ tokenPtr++;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
- if (jumpFixupArray.next == jumpFixupArray.end) {
- TclExpandJumpFixupArray(&jumpFixupArray);
- }
- fixupIndex = jumpFixupArray.next;
- jumpFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
- &(jumpFixupArray.fixup[fixupIndex]));
-
- /*
- * Compile the subexpression.
- */
+ if (opDescPtr->numOperands == 2) {
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = TclMax((envPtr->maxStackDepth + 1),
+ maxDepth);
+ tokenPtr += (tokenPtr->numComponents + 1);
+ }
+ TclEmitOpcode(opDescPtr->instruction, envPtr);
+ infoPtr->hasOperators = 1;
+ infoPtr->exprIsJustVarRef = 0;
+ infoPtr->exprIsComparison =
+ ((opIndex >= OP_LESS) && (opIndex <= OP_NEQ));
+ break;
+ }
+
+ /*
+ * The operator requires special treatment, and is either
+ * "+" or "-", or one of "&&", "||" or "?".
+ */
+
+ switch (opIndex) {
+ case OP_PLUS:
+ case OP_MINUS:
+ tokenPtr++;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
+
+ /*
+ * Check whether the "+" or "-" is unary.
+ */
+
+ afterSubexprPtr = exprTokenPtr
+ + exprTokenPtr->numComponents+1;
+ if (tokenPtr == afterSubexprPtr) {
+ TclEmitOpcode(((opIndex==OP_PLUS)?
+ INST_UPLUS : INST_UMINUS),
+ envPtr);
+ break;
+ }
+
+ /*
+ * The "+" or "-" is binary.
+ */
+
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = TclMax((envPtr->maxStackDepth + 1),
+ maxDepth);
+ tokenPtr += (tokenPtr->numComponents + 1);
+ TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
+ envPtr);
+ break;
- result = CompileBitOrExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
+ case OP_LAND:
+ case OP_LOR:
+ code = CompileLandOrLorExpr(exprTokenPtr, opIndex,
+ infoPtr, envPtr, &endPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr = endPtr;
+ break;
+
+ case OP_QUESTY:
+ code = CompileCondExpr(exprTokenPtr, infoPtr,
+ envPtr, &endPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr = endPtr;
+ break;
+
+ default:
+ panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
+ opIndex);
+ } /* end switch on operator requiring special treatment */
+ infoPtr->hasOperators = 1;
+ infoPtr->exprIsJustVarRef = 0;
+ infoPtr->exprIsComparison = 0;
+ break;
}
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
-
- /*
- * Emit a "logical and" instruction. This does not try to "short-
- * circuit" the evaluation of both operands of a Tcl "&&" operator,
- * but instead ensures that we either have a "1" or a "0" result.
- */
- TclEmitOpcode(INST_LAND, envPtr);
+ default:
+ panic("CompileSubExpr: unexpected token type %d\n",
+ tokenPtr->type);
}
/*
- * Now that we know the target of the forward jumps, update the jumps
- * with the correct distance. Also, if the distance is too great (> 127
- * bytes), replace the jump with a four byte instruction and move the
- * instructions after the jump down.
+ * Verify that the subexpression token had the required number of
+ * subtokens: that we've advanced tokenPtr just beyond the
+ * subexpression's last token. For example, a "*" subexpression must
+ * contain the tokens for exactly two operands.
*/
- for (j = jumpFixupArray.next; j > 0; j--) {
- fixupIndex = (j - 1); /* process closest jump first */
- currCodeOffset = TclCurrCodeOffset();
- jumpDist = (currCodeOffset - jumpFixupArray.fixup[fixupIndex].codeOffset);
- TclFixupForwardJump(envPtr, &(jumpFixupArray.fixup[fixupIndex]),
- jumpDist, 127);
- }
-
- /*
- * We get here only if one or more &&'s appear as top-level operators.
- */
-
- done:
- infoPtr->exprIsComparison = 0;
- TclFreeJumpFixupArray(&jumpFixupArray);
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileBitOrExpr --
- *
- * This procedure compiles a Tcl bitwise or expression:
- * bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileBitOrExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int result;
-
- HERE("bitOrExpr", 4);
- result = CompileBitXorExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
+ if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
+ LogSyntaxError(infoPtr);
+ code = TCL_ERROR;
}
- maxDepth = envPtr->maxStackDepth;
- while (infoPtr->token == BIT_OR) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over the '|' */
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileBitXorExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
-
- TclEmitOpcode(INST_BITOR, envPtr);
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 0;
- }
-
done:
envPtr->maxStackDepth = maxDepth;
- return result;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * CompileBitXorExpr --
+ * CompileLandOrLorExpr --
*
- * This procedure compiles a Tcl bitwise exclusive or expression:
- * bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
+ * This procedure compiles a Tcl logical and ("&&") or logical or
+ * ("||") subexpression.
*
* Results:
* The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * on failure. If TCL_OK is returned, a pointer to the token just after
+ * the last one in the subexpression is stored at the address in
+ * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
* envPtr->maxStackDepth is updated with the maximum number of stack
@@ -951,297 +651,116 @@ CompileBitOrExpr(interp, infoPtr, flags, envPtr)
*/
static int
-CompileBitXorExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
+ Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
+ * containing the "&&" or "||" operator. */
+ int opIndex; /* A code describing the expression
+ * operator: either OP_LAND or OP_LOR. */
+ ExprInfo *infoPtr; /* Describes the compilation state for the
+ * expression being compiled. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+ Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
+ * just after the last token in the
+ * subexpression is stored here. */
{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int result;
+ JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump
+ * after the first subexpression. */
+ JumpFixup lhsTrueFixup, lhsEndFixup;
+ /* Used to fix up jumps used to convert the
+ * first operand to 0 or 1. */
+ Tcl_Token *tokenPtr;
+ int dist, maxDepth, code;
- HERE("bitXorExpr", 5);
- result = CompileBitAndExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
-
- while (infoPtr->token == BIT_XOR) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over the '^' */
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileBitAndExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
-
- TclEmitOpcode(INST_BITXOR, envPtr);
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 0;
- }
-
- done:
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileBitAndExpr --
- *
- * This procedure compiles a Tcl bitwise and expression:
- * bitAndExpr ::= equalityExpr {'&' equalityExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileBitAndExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int result;
+ /*
+ * Emit code for the first operand.
+ */
- HERE("bitAndExpr", 6);
- result = CompileEqualityExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
+ maxDepth = 0;
+ tokenPtr = exprTokenPtr+2;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
goto done;
}
maxDepth = envPtr->maxStackDepth;
-
- while (infoPtr->token == BIT_AND) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over the '&' */
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileEqualityExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
-
- TclEmitOpcode(INST_BITAND, envPtr);
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
+ tokenPtr += (tokenPtr->numComponents + 1);
- infoPtr->exprIsComparison = 0;
+ /*
+ * Convert the first operand to the result that Tcl requires:
+ * "0" or "1". Eventually we'll use a new instruction for this.
+ */
+
+ TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
+ TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
+ dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
+ badDist:
+ panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
}
-
- done:
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileEqualityExpr --
- *
- * This procedure compiles a Tcl equality (inequality) expression:
- * equalityExpr ::= relationalExpr {('==' | '!=') relationalExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileEqualityExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int op, result;
-
- HERE("equalityExpr", 7);
- result = CompileRelationalExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
+ TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr);
+ dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
+ goto badDist;
}
- maxDepth = envPtr->maxStackDepth;
-
- op = infoPtr->token;
- while ((op == EQUAL) || (op == NEQ)) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over == or != */
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileRelationalExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
- if (op == EQUAL) {
- TclEmitOpcode(INST_EQ, envPtr);
- } else {
- TclEmitOpcode(INST_NEQ, envPtr);
- }
-
- op = infoPtr->token;
+ /*
+ * Emit the "short circuit" jump around the rest of the expression.
+ * Duplicate the "0" or "1" on top of the stack first to keep the
+ * jump from consuming it.
+ */
- /*
- * A comparison _is_ the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 1;
- }
+ TclEmitOpcode(INST_DUP, envPtr);
+ TclEmitForwardJump(envPtr,
+ ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
+ &shortCircuitFixup);
- done:
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileRelationalExpr --
- *
- * This procedure compiles a Tcl relational expression:
- * relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileRelationalExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int op, result;
+ /*
+ * Emit code for the second operand.
+ */
- HERE("relationalExpr", 8);
- result = CompileShiftExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
-
- op = infoPtr->token;
- while ((op == LESS) || (op == GREATER) || (op == LEQ) || (op == GEQ)) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over the op */
- if (result != TCL_OK) {
- goto done;
- }
+ maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+ tokenPtr += (tokenPtr->numComponents + 1);
- result = CompileShiftExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+ /*
+ * Emit a "logical and" or "logical or" instruction. This does not try
+ * to "short- circuit" the evaluation of both operands, but instead
+ * ensures that we either have a "1" or a "0" result.
+ */
- switch (op) {
- case LESS:
- TclEmitOpcode(INST_LT, envPtr);
- break;
- case GREATER:
- TclEmitOpcode(INST_GT, envPtr);
- break;
- case LEQ:
- TclEmitOpcode(INST_LE, envPtr);
- break;
- case GEQ:
- TclEmitOpcode(INST_GE, envPtr);
- break;
- }
+ TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr);
- op = infoPtr->token;
+ /*
+ * Now that we know the target of the forward jump, update it with the
+ * correct distance.
+ */
- /*
- * A comparison _is_ the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 1;
- }
+ dist = (envPtr->codeNext - envPtr->codeStart)
+ - shortCircuitFixup.codeOffset;
+ TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);
+ *endPtrPtr = tokenPtr;
done:
envPtr->maxStackDepth = maxDepth;
- return result;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * CompileShiftExpr --
+ * CompileCondExpr --
*
- * This procedure compiles a Tcl shift expression:
- * shiftExpr ::= addExpr {('<<' | '>>') addExpr}
+ * This procedure compiles a Tcl conditional expression:
+ * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
*
* Results:
* The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * on failure. If TCL_OK is returned, a pointer to the token just after
+ * the last one in the subexpression is stored at the address in
+ * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
* envPtr->maxStackDepth is updated with the maximum number of stack
@@ -1254,456 +773,109 @@ CompileRelationalExpr(interp, infoPtr, flags, envPtr)
*/
static int
-CompileShiftExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
+CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
+ Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
+ * containing the "?" operator. */
ExprInfo *infoPtr; /* Describes the compilation state for the
* expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
CompileEnv *envPtr; /* Holds resulting instructions. */
+ Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
+ * just after the last token in the
+ * subexpression is stored here. */
{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int op, result;
+ JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
+ /* Used to update or replace one-byte jumps
+ * around the then and else expressions when
+ * their target PCs are determined. */
+ Tcl_Token *tokenPtr;
+ int elseCodeOffset, dist, maxDepth, code;
+
+ /*
+ * Emit code for the test.
+ */
- HERE("shiftExpr", 9);
- result = CompileAddExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
+ maxDepth = 0;
+ tokenPtr = exprTokenPtr+2;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
goto done;
}
maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
+
+ /*
+ * Emit the jump to the "else" expression if the test was false.
+ */
+
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
- op = infoPtr->token;
- while ((op == LEFT_SHIFT) || (op == RIGHT_SHIFT)) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over << or >> */
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileAddExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
-
- if (op == LEFT_SHIFT) {
- TclEmitOpcode(INST_LSHIFT, envPtr);
- } else {
- TclEmitOpcode(INST_RSHIFT, envPtr);
- }
-
- op = infoPtr->token;
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 0;
- }
-
- done:
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileAddExpr --
- *
- * This procedure compiles a Tcl addition expression:
- * addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileAddExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int op, result;
+ /*
+ * Compile the "then" expression. Note that if a subexpression is only
+ * a primary, we need to try to convert it to numeric. We do this to
+ * support Tcl's policy of interpreting operands if at all possible as
+ * first integers, else floating-point numbers.
+ */
- HERE("addExpr", 10);
- result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
+ infoPtr->hasOperators = 0;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
-
- op = infoPtr->token;
- while ((op == PLUS) || (op == MINUS)) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over + or - */
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
-
- if (op == PLUS) {
- TclEmitOpcode(INST_ADD, envPtr);
- } else {
- TclEmitOpcode(INST_SUB, envPtr);
- }
-
- op = infoPtr->token;
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 0;
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+ tokenPtr += (tokenPtr->numComponents + 1);
+ if (!infoPtr->hasOperators) {
+ TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
}
- done:
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileMultiplyExpr --
- *
- * This procedure compiles a Tcl multiply expression:
- * multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * Emit an unconditional jump around the "else" condExpr.
+ */
+
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+ &jumpAroundElseFixup);
-static int
-CompileMultiplyExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int op, result;
+ /*
+ * Compile the "else" expression.
+ */
- HERE("multiplyExpr", 11);
- result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
+ elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ infoPtr->hasOperators = 0;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
-
- op = infoPtr->token;
- while ((op == MULT) || (op == DIVIDE) || (op == MOD)) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over * or / */
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
-
- if (op == MULT) {
- TclEmitOpcode(INST_MULT, envPtr);
- } else if (op == DIVIDE) {
- TclEmitOpcode(INST_DIV, envPtr);
- } else {
- TclEmitOpcode(INST_MOD, envPtr);
- }
-
- op = infoPtr->token;
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 0;
- }
-
- done:
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileUnaryExpr --
- *
- * This procedure compiles a Tcl unary expression:
- * unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileUnaryExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int op, result;
-
- HERE("unaryExpr", 12);
- op = infoPtr->token;
- if ((op == PLUS) || (op == MINUS) || (op == BIT_NOT) || (op == NOT)) {
- infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- result = GetToken(interp, infoPtr, envPtr); /* skip over the op */
- if (result != TCL_OK) {
- goto done;
- }
-
- result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
-
- switch (op) {
- case PLUS:
- TclEmitOpcode(INST_UPLUS, envPtr);
- break;
- case MINUS:
- TclEmitOpcode(INST_UMINUS, envPtr);
- break;
- case BIT_NOT:
- TclEmitOpcode(INST_BITNOT, envPtr);
- break;
- case NOT:
- TclEmitOpcode(INST_LNOT, envPtr);
- break;
- }
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 0;
- } else { /* must be a primaryExpr */
- result = CompilePrimaryExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
+ maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
+ tokenPtr += (tokenPtr->numComponents + 1);
+ if (!infoPtr->hasOperators) {
+ TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
}
- done:
- envPtr->maxStackDepth = maxDepth;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompilePrimaryExpr --
- *
- * This procedure compiles a Tcl primary expression:
- * primaryExpr ::= literal | varReference | quotedString |
- * '[' command ']' | mathFuncCall | '(' condExpr ')'
- *
- * Results:
- * The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
- * contains an error message.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * Side effects:
- * Adds instructions to envPtr to evaluate the expression at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompilePrimaryExpr(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- ExprInfo *infoPtr; /* Describes the compilation state for the
- * expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int theToken;
- char *dollarPtr, *quotePtr, *cmdPtr, *termPtr;
- int result = TCL_OK;
-
/*
- * We emit tryCvtToNumeric instructions after most of these primary
- * expressions in order to support Tcl's policy of interpreting operands
- * as first integers if possible, otherwise floating-point numbers if
- * possible.
+ * Fix up the second jump around the "else" expression.
*/
- HERE("primaryExpr", 13);
- theToken = infoPtr->token;
-
- if ((theToken != DOLLAR) && (theToken != OPEN_PAREN)) {
- infoPtr->exprIsJustVarRef = 0;
- }
- switch (theToken) {
- case LITERAL: /* int, double, or string in braces */
- TclEmitPush(infoPtr->objIndex, envPtr);
- maxDepth = 1;
- break;
-
- case DOLLAR: /* $var variable reference */
- dollarPtr = (infoPtr->next - 1);
- envPtr->pushSimpleWords = 1;
- result = TclCompileDollarVar(interp, dollarPtr,
- infoPtr->lastChar, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
- infoPtr->next = (dollarPtr + envPtr->termOffset);
- break;
-
- case QUOTE: /* quotedString */
- quotePtr = infoPtr->next;
- envPtr->pushSimpleWords = 1;
- result = TclCompileQuotes(interp, quotePtr,
- infoPtr->lastChar, '"', flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
- infoPtr->next = (quotePtr + envPtr->termOffset);
- break;
-
- case OPEN_BRACKET: /* '[' command ']' */
- cmdPtr = infoPtr->next;
- envPtr->pushSimpleWords = 1;
- result = TclCompileString(interp, cmdPtr,
- infoPtr->lastChar, (flags | TCL_BRACKET_TERM), envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- termPtr = (cmdPtr + envPtr->termOffset);
- if (*termPtr == ']') {
- infoPtr->next = (termPtr + 1); /* advance over the ']'. */
- } else if (termPtr == infoPtr->lastChar) {
- /*
- * Missing ] at end of nested command.
- */
-
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "missing close-bracket", -1);
- result = TCL_ERROR;
- goto done;
- } else {
- panic("CompilePrimaryExpr: unexpected termination char '%c' for nested command\n", *termPtr);
- }
- maxDepth = envPtr->maxStackDepth;
- break;
-
- case FUNC_NAME:
- result = CompileMathFuncCall(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
- break;
-
- case OPEN_PAREN:
- result = GetToken(interp, infoPtr, envPtr); /* skip over the '(' */
- if (result != TCL_OK) {
- goto done;
- }
- infoPtr->exprIsComparison = 0;
- result = CompileCondExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
- if (infoPtr->token != CLOSE_PAREN) {
- goto syntaxError;
- }
- break;
-
- default:
- goto syntaxError;
- }
-
- if (theToken != FUNC_NAME) {
+ dist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpAroundElseFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) {
/*
- * Advance to the next token before returning.
+ * Update the else expression's starting code offset since it
+ * moved down 3 bytes too.
*/
- result = GetToken(interp, infoPtr, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
+ elseCodeOffset += 3;
}
+
+ /*
+ * Fix up the first jump to the "else" expression if the test was false.
+ */
+
+ dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
+ TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
+ *endPtrPtr = tokenPtr;
done:
envPtr->maxStackDepth = maxDepth;
- return result;
-
- syntaxError:
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "syntax error in expression \"", infoPtr->originalExpr,
- "\"", (char *) NULL);
- return TCL_ERROR;
+ return code;
}
/*
@@ -1716,7 +888,9 @@ CompilePrimaryExpr(interp, infoPtr, flags, envPtr)
*
* Results:
* The return value is TCL_OK on a successful compilation and TCL_ERROR
- * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * on failure. If TCL_OK is returned, a pointer to the token just after
+ * the last one in the subexpression is stored at the address in
+ * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
* envPtr->maxStackDepth is updated with the maximum number of stack
@@ -1730,58 +904,35 @@ CompilePrimaryExpr(interp, infoPtr, flags, envPtr)
*/
static int
-CompileMathFuncCall(interp, infoPtr, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
+CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
+ Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
+ * containing the math function call. */
+ char *funcName; /* Name of the math function. */
ExprInfo *infoPtr; /* Describes the compilation state for the
* expression being compiled. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
CompileEnv *envPtr; /* Holds resulting instructions. */
+ Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
+ * just after the last token in the
+ * subexpression is stored here. */
{
+ Tcl_Interp *interp = infoPtr->interp;
Interp *iPtr = (Interp *) interp;
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- MathFunc *mathFuncPtr; /* Info about math function. */
- int objIndex; /* The object array index for an object
- * holding the function name if it is not
- * builtin. */
+ MathFunc *mathFuncPtr;
Tcl_HashEntry *hPtr;
- char *p, *funcName;
- char savedChar;
- int result, i;
+ Tcl_Token *tokenPtr, *afterSubexprPtr;
+ int maxDepth, code, i;
/*
- * infoPtr->funcName points to the first character of the math
- * function's name. Look for the end of its name and look up the
- * MathFunc record for the function.
+ * Look up the MathFunc record for the function.
*/
- funcName = p = infoPtr->funcName;
- while (isalnum(UCHAR(*p)) || (*p == '_')) {
- p++;
- }
- infoPtr->next = p;
-
- result = GetToken(interp, infoPtr, envPtr); /* skip over func name */
- if (result != TCL_OK) {
- goto done;
- }
- if (infoPtr->token != OPEN_PAREN) {
- goto syntaxError;
- }
- result = GetToken(interp, infoPtr, envPtr); /* skip over '(' */
- if (result != TCL_OK) {
- goto done;
- }
-
- savedChar = *p;
- *p = 0;
+ code = TCL_OK;
+ maxDepth = 0;
hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
if (hPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"unknown math function \"", funcName, "\"", (char *) NULL);
- result = TCL_ERROR;
- *p = savedChar;
+ code = TCL_ERROR;
goto done;
}
mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
@@ -1790,597 +941,98 @@ CompileMathFuncCall(interp, infoPtr, flags, envPtr)
* If not a builtin function, push an object with the function's name.
*/
- if (mathFuncPtr->builtinFuncIndex < 0) { /* not builtin */
- objIndex = TclObjIndexForString(funcName, -1, /*allocStrRep*/ 1,
- /*inHeap*/ 0, envPtr);
- TclEmitPush(objIndex, envPtr);
+ if (mathFuncPtr->builtinFuncIndex < 0) {
+ TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0),
+ envPtr);
maxDepth = 1;
}
/*
- * Restore the saved character after the function name.
- */
-
- *p = savedChar;
-
- /*
- * Compile the arguments for the function, if there are any.
+ * Compile any arguments for the function.
*/
+ tokenPtr = exprTokenPtr+2;
+ afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
if (mathFuncPtr->numArgs > 0) {
- for (i = 0; ; i++) {
- infoPtr->exprIsComparison = 0;
- result = CompileCondExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
+ for (i = 0; i < mathFuncPtr->numArgs; i++) {
+ if (tokenPtr == afterSubexprPtr) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "too few arguments for math function", -1);
+ code = TCL_ERROR;
goto done;
}
-
- /*
- * Check for a ',' between arguments or a ')' ending the
- * argument list.
- */
-
- if (i == (mathFuncPtr->numArgs-1)) {
- if (infoPtr->token == CLOSE_PAREN) {
- break; /* exit the argument parsing loop */
- } else if (infoPtr->token == COMMA) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "too many arguments for math function", -1);
- result = TCL_ERROR;
- goto done;
- } else {
- goto syntaxError;
- }
- }
- if (infoPtr->token != COMMA) {
- if (infoPtr->token == CLOSE_PAREN) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "too few arguments for math function", -1);
- result = TCL_ERROR;
- goto done;
- } else {
- goto syntaxError;
- }
- }
- result = GetToken(interp, infoPtr, envPtr); /* skip over , */
- if (result != TCL_OK) {
+ infoPtr->exprIsComparison = 0;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
goto done;
}
+ tokenPtr += (tokenPtr->numComponents + 1);
maxDepth++;
}
- }
-
- if (infoPtr->token != CLOSE_PAREN) {
- goto syntaxError;
- }
- result = GetToken(interp, infoPtr, envPtr); /* skip over ')' */
- if (result != TCL_OK) {
+ if (tokenPtr != afterSubexprPtr) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "too many arguments for math function", -1);
+ code = TCL_ERROR;
+ goto done;
+ }
+ } else if (tokenPtr != afterSubexprPtr) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "too many arguments for math function", -1);
+ code = TCL_ERROR;
goto done;
}
/*
* Compile the call on the math function. Note that the "objc" argument
* count for non-builtin functions is incremented by 1 to include the
- * the function name itself.
+ * function name itself.
*/
if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
- TclEmitInstUInt1(INST_CALL_BUILTIN_FUNC1,
- mathFuncPtr->builtinFuncIndex, envPtr);
+ TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
+ mathFuncPtr->builtinFuncIndex, envPtr);
} else {
- TclEmitInstUInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
+ TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
}
-
- /*
- * A comparison is not the top-level operator in this expression.
- */
+ *endPtrPtr = afterSubexprPtr;
done:
- infoPtr->exprIsComparison = 0;
envPtr->maxStackDepth = maxDepth;
- return result;
-
- syntaxError:
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "syntax error in expression \"", infoPtr->originalExpr,
- "\"", (char *) NULL);
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetToken --
- *
- * Lexical scanner used to compile expressions: parses a single
- * operator or other syntactic element from an expression string.
- *
- * Results:
- * TCL_OK is returned unless an error occurred. In that case a standard
- * Tcl error is returned, using the interpreter's result to hold an
- * error message. TCL_ERROR is returned if an integer overflow, or a
- * floating-point overflow or underflow occurred while reading in a
- * number. If the lexical analysis is successful, infoPtr->token refers
- * to the next symbol in the expression string, and infoPtr->next is
- * advanced past the token. Also, if the token is a integer, double, or
- * string literal, then infoPtr->objIndex the index of an object
- * holding the value in the code's object table; otherwise is NULL.
- *
- * Side effects:
- * Object are added to envPtr to hold the values of scanned literal
- * integers, doubles, or strings.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetToken(interp, infoPtr, envPtr)
- Tcl_Interp *interp; /* Interpreter to use for error
- * reporting. */
- register ExprInfo *infoPtr; /* Describes the state of the
- * compiling the expression,
- * including the resulting token. */
- CompileEnv *envPtr; /* Holds objects that store literal
- * values that are scanned. */
-{
- register char *src; /* Points to current source char. */
- register char c; /* The current char. */
- register int type; /* Current char's CHAR_TYPE type. */
- char *termPtr; /* Points to char terminating a literal. */
- char savedChar; /* Holds the character termporarily replaced
- * by a null character during processing of
- * literal tokens. */
- int objIndex; /* The object array index for an object
- * holding a scanned literal. */
- long longValue; /* Value of a scanned integer literal. */
- double doubleValue; /* Value of a scanned double literal. */
- Tcl_Obj *objPtr;
-
- /*
- * First initialize the scanner's "result" fields to default values.
- */
-
- infoPtr->token = UNKNOWN;
- infoPtr->objIndex = -1;
- infoPtr->funcName = NULL;
-
- /*
- * Scan over leading white space at the start of a token. Note that a
- * backslash-newline is treated as a space.
- */
-
- src = infoPtr->next;
- c = *src;
- type = CHAR_TYPE(src, infoPtr->lastChar);
- while ((type & (TCL_SPACE | TCL_BACKSLASH)) || (c == '\n')) {
- if (type == TCL_BACKSLASH) {
- if (src[1] == '\n') {
- src += 2;
- } else {
- break; /* no longer white space */
- }
- } else {
- src++;
- }
- c = *src;
- type = CHAR_TYPE(src, infoPtr->lastChar);
- }
- if (src == infoPtr->lastChar) {
- infoPtr->token = END;
- infoPtr->next = src;
- return TCL_OK;
- }
-
- /*
- * Try to parse the token first as an integer or floating-point
- * number. Don't check for a number if the first character is "+" or
- * "-". If we did, we might treat a binary operator as unary by mistake,
- * which would eventually cause a syntax error.
- */
-
- if ((*src != '+') && (*src != '-')) {
- int startsWithDigit = isdigit(UCHAR(*src));
-
- if (startsWithDigit && TclLooksLikeInt(src)) {
- errno = 0;
- longValue = strtoul(src, &termPtr, 0);
- if (errno == ERANGE) {
- char *s = "integer value too large to represent";
-
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
- (char *) NULL);
- return TCL_ERROR;
- }
- if (termPtr != src) {
- /*
- * src was the start of a valid integer. Find/create an
- * object in envPtr's object array to contain the integer.
- */
-
- savedChar = *termPtr;
- *termPtr = '\0';
- objIndex = TclObjIndexForString(src, termPtr - src,
- /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
- *termPtr = savedChar; /* restore the saved char */
-
- objPtr = envPtr->objArrayPtr[objIndex];
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = longValue;
- objPtr->typePtr = &tclIntType;
-
- infoPtr->token = LITERAL;
- infoPtr->objIndex = objIndex;
- infoPtr->next = termPtr;
- return TCL_OK;
- }
- } else if (startsWithDigit || (*src == '.')
- || (*src == 'n') || (*src == 'N')) {
- errno = 0;
- doubleValue = strtod(src, &termPtr);
- if (termPtr != src) {
- if (errno != 0) {
- TclExprFloatError(interp, doubleValue);
- return TCL_ERROR;
- }
-
- /*
- * Find/create an object in the object array containing the
- * double.
- */
-
- savedChar = *termPtr;
- *termPtr = '\0';
- objIndex = TclObjIndexForString(src, termPtr - src,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- *termPtr = savedChar; /* restore the saved char */
-
- objPtr = envPtr->objArrayPtr[objIndex];
- objPtr->internalRep.doubleValue = doubleValue;
- objPtr->typePtr = &tclDoubleType;
-
- infoPtr->token = LITERAL;
- infoPtr->objIndex = objIndex;
- infoPtr->next = termPtr;
- return TCL_OK;
- }
- }
- }
-
- /*
- * Not an integer or double literal. Check next for a string literal
- * in braces.
- */
-
- if (*src == '{') {
- int level = 0; /* The {} nesting level. */
- int hasBackslashNL = 0; /* Nonzero if '\newline' was found. */
- char *string = src; /* Set below to point just after the
- * starting '{'. */
- char *last; /* Points just before terminating '}'. */
- int numChars; /* Number of chars in braced string. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null char
- * during braced string processing. */
- int numRead;
-
- /*
- * Check first for any backslash-newlines, since we must treat
- * backslash-newlines specially (they must be replaced by spaces).
- */
-
- while (1) {
- if (src == infoPtr->lastChar) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "missing close-brace", -1);
- return TCL_ERROR;
- } else if (CHAR_TYPE(src, infoPtr->lastChar) == TCL_NORMAL) {
- src++;
- continue;
- }
- c = *src++;
- if (c == '{') {
- level++;
- } else if (c == '}') {
- --level;
- if (level == 0) {
- last = (src - 2); /* i.e. just before terminating } */
- break;
- }
- } else if (c == '\\') {
- if (*src == '\n') {
- hasBackslashNL = 1;
- }
- (void) Tcl_Backslash(src-1, &numRead);
- src += numRead - 1;
- }
- }
-
- /*
- * Create a string object for the braced string. This will start at
- * "string" and ends just after "last" (which points to the final
- * character before the terminating '}'). If backslash-newlines were
- * found, we copy characters one at a time into a heap-allocated
- * buffer and do backslash-newline substitutions.
- */
-
- string++;
- numChars = (last - string + 1);
- savedChar = string[numChars];
- string[numChars] = '\0';
- if (hasBackslashNL && (numChars > 0)) {
- char *buffer = ckalloc((unsigned) numChars + 1);
- register char *dst = buffer;
- register char *p = string;
- while (p <= last) {
- c = *dst++ = *p++;
- if (c == '\\') {
- if (*p == '\n') {
- dst[-1] = Tcl_Backslash(p-1, &numRead);
- p += numRead - 1;
- } else {
- (void) Tcl_Backslash(p-1, &numRead);
- while (numRead > 1) {
- *dst++ = *p++;
- numRead--;
- }
- }
- }
- }
- *dst = '\0';
- objIndex = TclObjIndexForString(buffer, dst - buffer,
- /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
- } else {
- objIndex = TclObjIndexForString(string, numChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- }
- string[numChars] = savedChar; /* restore the saved char */
-
- infoPtr->token = LITERAL;
- infoPtr->objIndex = objIndex;
- infoPtr->next = src;
- return TCL_OK;
- }
-
- /*
- * Not an literal value.
- */
-
- infoPtr->next = src+1; /* assume a 1 char token and advance over it */
- switch (*src) {
- case '[':
- infoPtr->token = OPEN_BRACKET;
- return TCL_OK;
-
- case ']':
- infoPtr->token = CLOSE_BRACKET;
- return TCL_OK;
-
- case '(':
- infoPtr->token = OPEN_PAREN;
- return TCL_OK;
-
- case ')':
- infoPtr->token = CLOSE_PAREN;
- return TCL_OK;
-
- case '$':
- infoPtr->token = DOLLAR;
- return TCL_OK;
-
- case '"':
- infoPtr->token = QUOTE;
- return TCL_OK;
-
- case ',':
- infoPtr->token = COMMA;
- return TCL_OK;
-
- case '*':
- infoPtr->token = MULT;
- return TCL_OK;
-
- case '/':
- infoPtr->token = DIVIDE;
- return TCL_OK;
-
- case '%':
- infoPtr->token = MOD;
- return TCL_OK;
-
- case '+':
- infoPtr->token = PLUS;
- return TCL_OK;
-
- case '-':
- infoPtr->token = MINUS;
- return TCL_OK;
-
- case '?':
- infoPtr->token = QUESTY;
- return TCL_OK;
-
- case ':':
- infoPtr->token = COLON;
- return TCL_OK;
-
- case '<':
- switch (src[1]) {
- case '<':
- infoPtr->next = src+2;
- infoPtr->token = LEFT_SHIFT;
- break;
- case '=':
- infoPtr->next = src+2;
- infoPtr->token = LEQ;
- break;
- default:
- infoPtr->token = LESS;
- break;
- }
- return TCL_OK;
-
- case '>':
- switch (src[1]) {
- case '>':
- infoPtr->next = src+2;
- infoPtr->token = RIGHT_SHIFT;
- break;
- case '=':
- infoPtr->next = src+2;
- infoPtr->token = GEQ;
- break;
- default:
- infoPtr->token = GREATER;
- break;
- }
- return TCL_OK;
-
- case '=':
- if (src[1] == '=') {
- infoPtr->next = src+2;
- infoPtr->token = EQUAL;
- } else {
- infoPtr->token = UNKNOWN;
- }
- return TCL_OK;
-
- case '!':
- if (src[1] == '=') {
- infoPtr->next = src+2;
- infoPtr->token = NEQ;
- } else {
- infoPtr->token = NOT;
- }
- return TCL_OK;
-
- case '&':
- if (src[1] == '&') {
- infoPtr->next = src+2;
- infoPtr->token = AND;
- } else {
- infoPtr->token = BIT_AND;
- }
- return TCL_OK;
-
- case '^':
- infoPtr->token = BIT_XOR;
- return TCL_OK;
-
- case '|':
- if (src[1] == '|') {
- infoPtr->next = src+2;
- infoPtr->token = OR;
- } else {
- infoPtr->token = BIT_OR;
- }
- return TCL_OK;
-
- case '~':
- infoPtr->token = BIT_NOT;
- return TCL_OK;
-
- default:
- if (isalpha(UCHAR(*src))) {
- infoPtr->token = FUNC_NAME;
- infoPtr->funcName = src;
- while (isalnum(UCHAR(*src)) || (*src == '_')) {
- src++;
- }
- infoPtr->next = src;
- return TCL_OK;
- }
- infoPtr->next = src+1;
- infoPtr->token = UNKNOWN;
- return TCL_OK;
- }
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateMathFunc --
+ * LogSyntaxError --
*
- * Creates a new math function for expressions in a given
- * interpreter.
+ * This procedure is invoked after an error occurs when compiling an
+ * expression. It sets the interpreter result to an error message
+ * describing the error.
*
* Results:
* None.
*
* Side effects:
- * The function defined by "name" is created or redefined. If the
- * function already exists then its definition is replaced; this
- * includes the builtin functions. Redefining a builtin function forces
- * all existing code to be invalidated since that code may be compiled
- * using an instruction specific to the replaced function. In addition,
- * redefioning a non-builtin function will force existing code to be
- * invalidated if the number of arguments has changed.
+ * Sets the interpreter result to an error message describing the
+ * expression that was being compiled when the error occurred.
*
*----------------------------------------------------------------------
*/
-void
-Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which function is
- * to be available. */
- char *name; /* Name of function (e.g. "sin"). */
- int numArgs; /* Nnumber of arguments required by
- * function. */
- Tcl_ValueType *argTypes; /* Array of types acceptable for
- * each argument. */
- Tcl_MathProc *proc; /* Procedure that implements the
- * math function. */
- ClientData clientData; /* Additional value to pass to the
- * function. */
+static void
+LogSyntaxError(infoPtr)
+ ExprInfo *infoPtr; /* Describes the compilation state for the
+ * expression being compiled. */
{
- Interp *iPtr = (Interp *) interp;
- Tcl_HashEntry *hPtr;
- MathFunc *mathFuncPtr;
- int new, i;
+ int numBytes = (infoPtr->lastChar - infoPtr->expr);
+ char buffer[100];
- hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
- if (new) {
- Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
- }
- mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
-
- if (!new) {
- if (mathFuncPtr->builtinFuncIndex >= 0) {
- /*
- * We are redefining a builtin math function. Invalidate the
- * interpreter's existing code by incrementing its
- * compileEpoch member. This field is checked in Tcl_EvalObj
- * and ObjInterpProc, and code whose compilation epoch doesn't
- * match is recompiled. Newly compiled code will no longer
- * treat the function as builtin.
- */
-
- iPtr->compileEpoch++;
- } else {
- /*
- * A non-builtin function is being redefined. We must invalidate
- * existing code if the number of arguments has changed. This
- * is because existing code was compiled assuming that number.
- */
-
- if (numArgs != mathFuncPtr->numArgs) {
- iPtr->compileEpoch++;
- }
- }
- }
-
- mathFuncPtr->builtinFuncIndex = -1; /* can't be a builtin function */
- if (numArgs > MAX_MATH_ARGS) {
- numArgs = MAX_MATH_ARGS;
- }
- mathFuncPtr->numArgs = numArgs;
- for (i = 0; i < numArgs; i++) {
- mathFuncPtr->argTypes[i] = argTypes[i];
- }
- mathFuncPtr->proc = proc;
- mathFuncPtr->clientData = clientData;
+ sprintf(buffer, "syntax error in expression \"%.*s\"",
+ ((numBytes > 60)? 60 : numBytes), infoPtr->expr);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
+ buffer, (char *) NULL);
}
diff --git a/tcl/generic/tclCompile.c b/tcl/generic/tclCompile.c
index a6220af88ee..4df50f28378 100644
--- a/tcl/generic/tclCompile.c
+++ b/tcl/generic/tclCompile.c
@@ -5,7 +5,7 @@
* of commands (like quoted strings or nested sub-commands) into a
* sequence of instructions ("bytecodes").
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,6 +17,15 @@
#include "tclCompile.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
@@ -29,34 +38,11 @@ int tclTraceCompile = 0;
static int traceInitialized = 0;
/*
- * Count of the number of compilations and various other compilation-
- * related statistics.
- */
-
-#ifdef TCL_COMPILE_STATS
-long tclNumCompilations = 0;
-double tclTotalSourceBytes = 0.0;
-double tclTotalCodeBytes = 0.0;
-
-double tclTotalInstBytes = 0.0;
-double tclTotalObjBytes = 0.0;
-double tclTotalExceptBytes = 0.0;
-double tclTotalAuxBytes = 0.0;
-double tclTotalCmdMapBytes = 0.0;
-
-double tclCurrentSourceBytes = 0.0;
-double tclCurrentCodeBytes = 0.0;
-
-int tclSourceCount[32];
-int tclByteCodeCount[32];
-#endif /* TCL_COMPILE_STATS */
-
-/*
- * A table describing the Tcl bytecode instructions. The entries in this
- * table must correspond to the list of instructions in tclInt.h. The names
- * "op1" and "op4" refer to an instruction's one or four byte first operand.
- * Similarly, "stktop" and "stknext" refer to the topmost and next to
- * topmost stack elements.
+ * A table describing the Tcl bytecode instructions. Entries in this table
+ * must correspond to the instruction opcode definitions in tclCompile.h.
+ * The names "op1" and "op4" refer to an instruction's one or four byte
+ * first operand. Similarly, "stktop" and "stknext" refer to the topmost
+ * and next to topmost stack elements.
*
* Note that the load, store, and incr instructions do not distinguish local
* from global variables; the bytecode interpreter at runtime uses the
@@ -215,7 +201,7 @@ InstructionDesc instructionTable[] = {
* terminate loop, else push 1. */
{"beginCatch4", 5, 1, {OPERAND_UINT4}},
- /* Record start of catch with the operand's exception range index.
+ /* Record start of catch with the operand's exception index.
* Push the current stack depth onto a special catch stack. */
{"endCatch", 1, 0, {OPERAND_NONE}},
/* End of last catch. Pop the bytecode interpreter's catch stack. */
@@ -228,191 +214,32 @@ InstructionDesc instructionTable[] = {
};
/*
- * The following table assigns a type to each character. Only types
- * meaningful to Tcl parsing are represented here. The table is
- * designed to be referenced with either signed or unsigned characters,
- * so it has 384 entries. The first 128 entries correspond to negative
- * character values, the next 256 correspond to positive character
- * values. The last 128 entries are identical to the first 128. The
- * table is always indexed with a 128-byte offset (the 128th entry
- * corresponds to a 0 character value).
- */
-
-unsigned char tclTypeTable[] = {
- /*
- * Negative character values, from -128 to -1:
- */
-
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
-
- /*
- * Positive character values, from 0-127:
- */
-
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_SPACE, TCL_COMMAND_END, TCL_SPACE,
- TCL_SPACE, TCL_SPACE, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_SPACE, TCL_NORMAL, TCL_QUOTE, TCL_NORMAL,
- TCL_DOLLAR, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_COMMAND_END,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACKET,
- TCL_BACKSLASH, TCL_COMMAND_END, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACE,
- TCL_NORMAL, TCL_CLOSE_BRACE, TCL_NORMAL, TCL_NORMAL,
-
- /*
- * Large unsigned character values, from 128-255:
- */
-
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
- TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
-};
-
-/*
- * Table of all AuxData types.
- */
-
-static Tcl_HashTable auxDataTypeTable;
-static int auxDataTypeTableInitialized = 0; /* 0 means not yet
- * initialized. */
-
-/*
* Prototypes for procedures defined later in this file:
*/
-static void AdvanceToNextWord _ANSI_ARGS_((char *string,
- CompileEnv *envPtr));
-static int CollectArgInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int flags,
- ArgInfo *argInfoPtr));
-static int CompileBraces _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int flags,
- CompileEnv *envPtr));
-static int CompileCmdWordInline _ANSI_ARGS_((
- Tcl_Interp *interp, char *string,
- char *lastChar, int flags, CompileEnv *envPtr));
-static int CompileExprWord _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int flags,
- CompileEnv *envPtr));
-static int CompileMultipartWord _ANSI_ARGS_((
- Tcl_Interp *interp, char *string,
- char *lastChar, int flags, CompileEnv *envPtr));
-static int CompileWord _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int flags,
- CompileEnv *envPtr));
-static int CreateExceptionRange _ANSI_ARGS_((
- ExceptionRangeType type, CompileEnv *envPtr));
static void DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr));
-static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
static unsigned char * EncodeCmdLocMap _ANSI_ARGS_((
CompileEnv *envPtr, ByteCode *codePtr,
unsigned char *startPtr));
static void EnterCmdExtentData _ANSI_ARGS_((
CompileEnv *envPtr, int cmdNumber,
- int numSrcChars, int numCodeBytes));
+ int numSrcBytes, int numCodeBytes));
static void EnterCmdStartData _ANSI_ARGS_((
CompileEnv *envPtr, int cmdNumber,
int srcOffset, int codeOffset));
-static void ExpandObjectArray _ANSI_ARGS_((CompileEnv *envPtr));
-static void FreeForeachInfo _ANSI_ARGS_((
- ClientData clientData));
static void FreeByteCodeInternalRep _ANSI_ARGS_((
Tcl_Obj *objPtr));
-static void FreeArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
static int GetCmdLocEncodingSize _ANSI_ARGS_((
CompileEnv *envPtr));
-static void InitArgInfo _ANSI_ARGS_((ArgInfo *argInfoPtr));
-static int IsLocalScalar _ANSI_ARGS_((char *name, int len));
-static int LookupCompiledLocal _ANSI_ARGS_((
- char *name, int nameChars, int createIfNew,
- int flagsIfCreated, Proc *procPtr));
+static void LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ char *script, char *command, int length));
+#ifdef TCL_COMPILE_STATS
+static void RecordByteCodeStats _ANSI_ARGS_((
+ ByteCode *codePtr));
+#endif /* TCL_COMPILE_STATS */
static int SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
-static void UpdateStringOfByteCode _ANSI_ARGS_((Tcl_Obj *objPtr));
/*
* The structure below defines the bytecode Tcl object type by
@@ -420,481 +247,200 @@ static void UpdateStringOfByteCode _ANSI_ARGS_((Tcl_Obj *objPtr));
*/
Tcl_ObjType tclByteCodeType = {
- "bytecode", /* name */
- FreeByteCodeInternalRep, /* freeIntRepProc */
- DupByteCodeInternalRep, /* dupIntRepProc */
- UpdateStringOfByteCode, /* updateStringProc */
- SetByteCodeFromAny /* setFromAnyProc */
-};
-
-/*
- * The structures below define the AuxData types defined in this file.
- */
-
-AuxDataType tclForeachInfoType = {
- "ForeachInfo", /* name */
- DupForeachInfo, /* dupProc */
- FreeForeachInfo /* freeProc */
+ "bytecode", /* name */
+ FreeByteCodeInternalRep, /* freeIntRepProc */
+ DupByteCodeInternalRep, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ SetByteCodeFromAny /* setFromAnyProc */
};
/*
*----------------------------------------------------------------------
*
- * TclPrintByteCodeObj --
+ * TclSetByteCodeFromAny --
*
- * This procedure prints ("disassembles") the instructions of a
- * bytecode object to stdout.
+ * Part of the bytecode Tcl object type implementation. Attempts to
+ * generate an byte code internal form for the Tcl object "objPtr" by
+ * compiling its string representation. This function also takes
+ * a hook procedure that will be invoked to perform any needed post
+ * processing on the compilation results before generating byte
+ * codes.
*
* Results:
- * None.
+ * The return value is a standard Tcl object result. If an error occurs
+ * during compilation, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
*
* Side effects:
- * None.
+ * Frees the old internal representation. If no error occurs, then the
+ * compiled code is stored as "objPtr"s bytecode representation.
+ * Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
+ * used to trace compilations.
*
*----------------------------------------------------------------------
*/
-void
-TclPrintByteCodeObj(interp, objPtr)
- Tcl_Interp *interp; /* Used only for Tcl_GetStringFromObj. */
- Tcl_Obj *objPtr; /* The bytecode object to disassemble. */
+int
+TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
+ Tcl_Interp *interp; /* The interpreter for which the code is
+ * being compiled. Must not be NULL. */
+ Tcl_Obj *objPtr; /* The object to make a ByteCode object. */
+ CompileHookProc *hookProc; /* Procedure to invoke after compilation. */
+ ClientData clientData; /* Hook procedure private data. */
{
- ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- unsigned char *codeStart, *codeLimit, *pc;
- unsigned char *codeDeltaNext, *codeLengthNext;
- unsigned char *srcDeltaNext, *srcLengthNext;
- int codeOffset, codeLen, srcOffset, srcLen;
- int numCmds, numObjs, delta, objBytes, i;
+ Interp *iPtr = (Interp *) interp;
+ CompileEnv compEnv; /* Compilation environment structure
+ * allocated in frame. */
+ LiteralTable *localTablePtr = &(compEnv.localLitTable);
+ register AuxData *auxDataPtr;
+ LiteralEntry *entryPtr;
+ register int i;
+ int length, nested, result;
+ char *string;
- if (codePtr->refCount <= 0) {
- return; /* already freed */
+ if (!traceInitialized) {
+ if (Tcl_LinkVar(interp, "tcl_traceCompile",
+ (char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
+ panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
+ }
+ traceInitialized = 1;
}
- codeStart = codePtr->codeStart;
- codeLimit = (codeStart + codePtr->numCodeBytes);
- numCmds = codePtr->numCommands;
- numObjs = codePtr->numObjects;
-
- objBytes = (numObjs * sizeof(Tcl_Obj));
- for (i = 0; i < numObjs; i++) {
- Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
- if (litObjPtr->bytes != NULL) {
- objBytes += litObjPtr->length;
- }
+ if (iPtr->evalFlags & TCL_BRACKET_TERM) {
+ nested = 1;
+ } else {
+ nested = 0;
}
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ TclInitCompileEnv(interp, &compEnv, string, length);
+ result = TclCompileScript(interp, string, length, nested, &compEnv);
- /*
- * Print header lines describing the ByteCode.
- */
-
- fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
- (unsigned int) codePtr, codePtr->refCount,
- codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
- codePtr->iPtr->compileEpoch);
- fprintf(stdout, " Source ");
- TclPrintSource(stdout, codePtr->source,
- TclMin(codePtr->numSrcChars, 70));
- fprintf(stdout, "\n Cmds %d, chars %d, inst %d, objs %u, aux %d, stk depth %u, code/src %.2f\n",
- numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
- codePtr->numAuxDataItems, codePtr->maxStackDepth,
- (codePtr->numSrcChars?
- ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
- fprintf(stdout, " Code %d = %d(header)+%d(inst)+%d(objs)+%d(exc)+%d(aux)+%d(cmd map)\n",
- codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
- objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
- (codePtr->numAuxDataItems * sizeof(AuxData)),
- codePtr->numCmdLocBytes);
+ if (result == TCL_OK) {
+ /*
+ * Successful compilation. Add a "done" instruction at the end.
+ */
- /*
- * 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;
- fprintf(stdout,
- " Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
- (unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
- numCompiledLocals);
- if (numCompiledLocals > 0) {
- CompiledLocal *localPtr = procPtr->firstLocalPtr;
- for (i = 0; i < numCompiledLocals; i++) {
- fprintf(stdout, " %d: slot %d%s%s%s%s%s%s",
- i, localPtr->frameIndex,
- ((localPtr->flags & VAR_SCALAR)? ", 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)) {
- fprintf(stdout, "\n");
- } else {
- fprintf(stdout, ", name=\"%s\"\n", localPtr->name);
- }
- localPtr = localPtr->nextPtr;
- }
- }
- }
+ compEnv.numSrcBytes = iPtr->termOffset;
+ TclEmitOpcode(INST_DONE, &compEnv);
- /*
- * Print the ExceptionRange array.
- */
+ /*
+ * Invoke the compilation hook procedure if one exists.
+ */
- if (codePtr->numExcRanges > 0) {
- fprintf(stdout, " Exception ranges %d, depth %d:\n",
- codePtr->numExcRanges, codePtr->maxExcRangeDepth);
- for (i = 0; i < codePtr->numExcRanges; i++) {
- ExceptionRange *rangePtr = &(codePtr->excRangeArrayPtr[i]);
- fprintf(stdout, " %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:
- fprintf(stdout, "continue %d, break %d\n",
- rangePtr->continueOffset, rangePtr->breakOffset);
- break;
- case CATCH_EXCEPTION_RANGE:
- fprintf(stdout, "catch %d\n", rangePtr->catchOffset);
- break;
- default:
- panic("TclPrintSource: unrecognized ExceptionRange type %d\n",
- rangePtr->type);
- }
+ if (hookProc) {
+ result = (*hookProc)(interp, &compEnv, clientData);
}
- }
-
- /*
- * 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) {
- fprintf(stdout, " ");
- pc += TclPrintInstruction(codePtr, pc);
- }
- return;
- }
+ /*
+ * Change the object into a ByteCode object. Ownership of the literal
+ * objects and aux data items is given to the ByteCode object.
+ */
- /*
- * Print table showing the code offset, source offset, and source
- * length for each command. These are encoded as a sequence of bytes.
- */
-
- fprintf(stdout, " 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 int) (*codeDeltaNext) == (unsigned int) 0xFF) {
- codeDeltaNext++;
- delta = TclGetInt4AtPtr(codeDeltaNext);
- codeDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(codeDeltaNext);
- codeDeltaNext++;
- }
- codeOffset += delta;
-
- if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
- codeLengthNext++;
- codeLen = TclGetInt4AtPtr(codeLengthNext);
- codeLengthNext += 4;
- } else {
- codeLen = TclGetInt1AtPtr(codeLengthNext);
- codeLengthNext++;
- }
-
- if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
- srcDeltaNext++;
- delta = TclGetInt4AtPtr(srcDeltaNext);
- srcDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(srcDeltaNext);
- srcDeltaNext++;
- }
- srcOffset += delta;
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyLocalLiteralTable(&compEnv);
+#endif /*TCL_COMPILE_DEBUG*/
- if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
- srcLengthNext++;
- srcLen = TclGetInt4AtPtr(srcLengthNext);
- srcLengthNext += 4;
- } else {
- srcLen = TclGetInt1AtPtr(srcLengthNext);
- srcLengthNext++;
+ TclInitByteCodeObj(objPtr, &compEnv);
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceCompile == 2) {
+ TclPrintByteCodeObj(interp, objPtr);
}
-
- fprintf(stdout, "%s%4d: pc %d-%d, source %d-%d",
- ((i % 2)? " " : "\n "),
- (i+1), codeOffset, (codeOffset + codeLen - 1),
- srcOffset, (srcOffset + srcLen - 1));
- }
- if ((numCmds > 0) && ((numCmds % 2) != 0)) {
- fprintf(stdout, "\n");
+#endif /* TCL_COMPILE_DEBUG */
}
-
- /*
- * 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 int) (*codeDeltaNext) == (unsigned int) 0xFF) {
- codeDeltaNext++;
- delta = TclGetInt4AtPtr(codeDeltaNext);
- codeDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(codeDeltaNext);
- codeDeltaNext++;
- }
- codeOffset += delta;
-
- if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
- srcDeltaNext++;
- delta = TclGetInt4AtPtr(srcDeltaNext);
- srcDeltaNext += 4;
- } else {
- delta = TclGetInt1AtPtr(srcDeltaNext);
- srcDeltaNext++;
- }
- srcOffset += delta;
-
- if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
- srcLengthNext++;
- srcLen = TclGetInt4AtPtr(srcLengthNext);
- srcLengthNext += 4;
- } else {
- srcLen = TclGetInt1AtPtr(srcLengthNext);
- srcLengthNext++;
- }
-
+
+ if (result != TCL_OK) {
/*
- * Print instructions before command i.
+ * Compilation errors.
*/
-
- while ((pc-codeStart) < codeOffset) {
- fprintf(stdout, " ");
- pc += TclPrintInstruction(codePtr, pc);
+
+ entryPtr = compEnv.literalArrayPtr;
+ for (i = 0; i < compEnv.literalArrayNext; i++) {
+ TclReleaseLiteral(interp, entryPtr->objPtr);
+ entryPtr++;
}
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyGlobalLiteralTable(iPtr);
+#endif /*TCL_COMPILE_DEBUG*/
- fprintf(stdout, " Command %d: ", (i+1));
- TclPrintSource(stdout, (codePtr->source + srcOffset),
- TclMin(srcLen, 70));
- fprintf(stdout, "\n");
+ auxDataPtr = compEnv.auxDataArrayPtr;
+ for (i = 0; i < compEnv.auxDataArrayNext; i++) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ }
+ auxDataPtr++;
+ }
}
- if (pc < codeLimit) {
- /*
- * Print instructions after the last command.
- */
- while (pc < codeLimit) {
- fprintf(stdout, " ");
- pc += TclPrintInstruction(codePtr, pc);
- }
+
+ /*
+ * Free storage allocated during compilation.
+ */
+
+ if (localTablePtr->buckets != localTablePtr->staticBuckets) {
+ ckfree((char *) localTablePtr->buckets);
}
+ TclFreeCompileEnv(&compEnv);
+ return result;
}
/*
- *----------------------------------------------------------------------
+ *-----------------------------------------------------------------------
*
- * TclPrintInstruction --
+ * SetByteCodeFromAny --
*
- * This procedure prints ("disassembles") one instruction from a
- * bytecode object to stdout.
+ * Part of the bytecode Tcl object type implementation. Attempts to
+ * generate an byte code internal form for the Tcl object "objPtr" by
+ * compiling its string representation.
*
* Results:
- * Returns the length in bytes of the current instruiction.
+ * The return value is a standard Tcl object result. If an error occurs
+ * during compilation, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
*
* Side effects:
- * None.
+ * Frees the old internal representation. If no error occurs, then the
+ * compiled code is stored as "objPtr"s bytecode representation.
+ * Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
+ * used to trace compilations.
*
*----------------------------------------------------------------------
*/
-int
-TclPrintInstruction(codePtr, pc)
- ByteCode* codePtr; /* Bytecode containing the instruction. */
- unsigned char *pc; /* Points to first byte of instruction. */
+static int
+SetByteCodeFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* The interpreter for which the code is
+ * being compiled. Must not be NULL. */
+ Tcl_Obj *objPtr; /* The object to make a ByteCode object. */
{
- Proc *procPtr = codePtr->procPtr;
- unsigned char opCode = *pc;
- register InstructionDesc *instDesc = &instructionTable[opCode];
- unsigned char *codeStart = codePtr->codeStart;
- unsigned int pcOffset = (pc - codeStart);
- int opnd, elemLen, i, j;
- Tcl_Obj *elemPtr;
- char *string;
-
- fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
- for (i = 0; i < instDesc->numOperands; i++) {
- switch (instDesc->opTypes[i]) {
- case OPERAND_INT1:
- opnd = TclGetInt1AtPtr(pc+1+i);
- if ((i == 0) && ((opCode == INST_JUMP1)
- || (opCode == INST_JUMP_TRUE1)
- || (opCode == INST_JUMP_FALSE1))) {
- fprintf(stdout, "%d # pc %u", opnd, (pcOffset + opnd));
- } else {
- fprintf(stdout, "%d", opnd);
- }
- break;
- case OPERAND_INT4:
- opnd = TclGetInt4AtPtr(pc+1+i);
- if ((i == 0) && ((opCode == INST_JUMP4)
- || (opCode == INST_JUMP_TRUE4)
- || (opCode == INST_JUMP_FALSE4))) {
- fprintf(stdout, "%d # pc %u", opnd, (pcOffset + opnd));
- } else {
- fprintf(stdout, "%d", opnd);
- }
- break;
- case OPERAND_UINT1:
- opnd = TclGetUInt1AtPtr(pc+1+i);
- if ((i == 0) && (opCode == INST_PUSH1)) {
- elemPtr = codePtr->objArrayPtr[opnd];
- string = Tcl_GetStringFromObj(elemPtr, &elemLen);
- fprintf(stdout, "%u # ", (unsigned int) opnd);
- TclPrintSource(stdout, string, TclMin(elemLen, 40));
- } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
- || (opCode == INST_LOAD_ARRAY1)
- || (opCode == INST_STORE_SCALAR1)
- || (opCode == INST_STORE_ARRAY1))) {
- int localCt = procPtr->numCompiledLocals;
- CompiledLocal *localPtr = procPtr->firstLocalPtr;
- if (opnd >= localCt) {
- panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
- (unsigned int) opnd, localCt);
- return instDesc->numBytes;
- }
- for (j = 0; j < opnd; j++) {
- localPtr = localPtr->nextPtr;
- }
- if (TclIsVarTemporary(localPtr)) {
- fprintf(stdout, "%u # temp var %u",
- (unsigned int) opnd, (unsigned int) opnd);
- } else {
- fprintf(stdout, "%u # var ", (unsigned int) opnd);
- TclPrintSource(stdout, localPtr->name, 40);
- }
- } else {
- fprintf(stdout, "%u ", (unsigned int) opnd);
- }
- break;
- case OPERAND_UINT4:
- opnd = TclGetUInt4AtPtr(pc+1+i);
- if (opCode == INST_PUSH4) {
- elemPtr = codePtr->objArrayPtr[opnd];
- string = Tcl_GetStringFromObj(elemPtr, &elemLen);
- fprintf(stdout, "%u # ", opnd);
- TclPrintSource(stdout, string, TclMin(elemLen, 40));
- } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
- || (opCode == INST_LOAD_ARRAY4)
- || (opCode == INST_STORE_SCALAR4)
- || (opCode == INST_STORE_ARRAY4))) {
- int localCt = procPtr->numCompiledLocals;
- CompiledLocal *localPtr = procPtr->firstLocalPtr;
- if (opnd >= localCt) {
- panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
- (unsigned int) opnd, localCt);
- return instDesc->numBytes;
- }
- for (j = 0; j < opnd; j++) {
- localPtr = localPtr->nextPtr;
- }
- if (TclIsVarTemporary(localPtr)) {
- fprintf(stdout, "%u # temp var %u",
- (unsigned int) opnd, (unsigned int) opnd);
- } else {
- fprintf(stdout, "%u # var ", (unsigned int) opnd);
- TclPrintSource(stdout, localPtr->name, 40);
- }
- } else {
- fprintf(stdout, "%u ", (unsigned int) opnd);
- }
- break;
- case OPERAND_NONE:
- default:
- break;
- }
- }
- fprintf(stdout, "\n");
- return instDesc->numBytes;
+ return TclSetByteCodeFromAny(interp, objPtr,
+ (CompileHookProc *) NULL, (ClientData) NULL);
}
/*
*----------------------------------------------------------------------
*
- * TclPrintSource --
+ * DupByteCodeInternalRep --
*
- * 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.
+ * Part of the bytecode Tcl object type implementation. However, it
+ * does not copy the internal representation of a bytecode Tcl_Obj, but
+ * instead leaves the new object untyped (with a NULL type pointer).
+ * Code will be compiled for the new object only if necessary.
*
* Results:
* None.
*
* Side effects:
- * Outputs characters to the specified file.
+ * None.
*
*----------------------------------------------------------------------
*/
-void
-TclPrintSource(outFile, string, maxChars)
- FILE *outFile; /* The file to print the source to. */
- char *string; /* The string to print. */
- int maxChars; /* Maximum number of chars to print. */
+static void
+DupByteCodeInternalRep(srcPtr, copyPtr)
+ Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr; /* Object with internal rep to set. */
{
- register char *p;
- register int i = 0;
-
- if (string == NULL) {
- fprintf(outFile, "\"\"");
- return;
- }
-
- fprintf(outFile, "\"");
- p = string;
- for (; (*p != '\0') && (i < maxChars); p++, i++) {
- switch (*p) {
- case '"':
- fprintf(outFile, "\\\"");
- continue;
- case '\f':
- fprintf(outFile, "\\f");
- continue;
- case '\n':
- fprintf(outFile, "\\n");
- continue;
- case '\r':
- fprintf(outFile, "\\r");
- continue;
- case '\t':
- fprintf(outFile, "\\t");
- continue;
- case '\v':
- fprintf(outFile, "\\v");
- continue;
- default:
- fprintf(outFile, "%c", *p);
- continue;
- }
- }
- fprintf(outFile, "\"");
+ return;
}
/*
@@ -946,202 +492,117 @@ FreeByteCodeInternalRep(objPtr)
* None.
*
* Side effects:
- * Frees objPtr's bytecode internal representation and sets
- * its type and objPtr->internalRep.otherValuePtr NULL. Also
- * decrements the ref counts on each object in its object array,
- * and frees its auxiliary data items.
+ * Frees objPtr's bytecode internal representation and sets its type
+ * and objPtr->internalRep.otherValuePtr NULL. Also releases its
+ * literals and frees its auxiliary data items.
*
*----------------------------------------------------------------------
*/
void
TclCleanupByteCode(codePtr)
- ByteCode *codePtr; /* ByteCode to free. */
+ register ByteCode *codePtr; /* Points to the ByteCode to free. */
{
- Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
- int numObjects = codePtr->numObjects;
+ Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
+ int numLitObjects = codePtr->numLitObjects;
int numAuxDataItems = codePtr->numAuxDataItems;
+ register Tcl_Obj **objArrayPtr;
register AuxData *auxDataPtr;
- register Tcl_Obj *elemPtr;
- register int i;
+ int i;
+#ifdef TCL_COMPILE_STATS
-#ifdef TCL_COMPILE_STATS
- tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
- tclCurrentCodeBytes -= (double) codePtr->totalSize;
+ if (interp != NULL) {
+ ByteCodeStats *statsPtr;
+ Tcl_Time destroyTime;
+ int lifetimeSec, lifetimeMicroSec, log2;
+
+ statsPtr = &((Interp *) interp)->stats;
+
+ statsPtr->numByteCodesFreed++;
+ statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
+ statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize;
+
+ statsPtr->currentInstBytes -= (double) codePtr->numCodeBytes;
+ statsPtr->currentLitBytes -=
+ (double) (codePtr->numLitObjects * sizeof(Tcl_Obj *));
+ statsPtr->currentExceptBytes -=
+ (double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
+ statsPtr->currentAuxBytes -=
+ (double) (codePtr->numAuxDataItems * sizeof(AuxData));
+ statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes;
+
+ TclpGetTime(&destroyTime);
+ lifetimeSec = destroyTime.sec - codePtr->createTime.sec;
+ if (lifetimeSec > 2000) { /* avoid overflow */
+ lifetimeSec = 2000;
+ }
+ lifetimeMicroSec =
+ 1000000*lifetimeSec + (destroyTime.usec - codePtr->createTime.usec);
+
+ log2 = TclLog2(lifetimeMicroSec);
+ if (log2 > 31) {
+ log2 = 31;
+ }
+ statsPtr->lifetimeCount[log2]++;
+ }
#endif /* TCL_COMPILE_STATS */
/*
* A single heap object holds the ByteCode structure and its code,
* object, command location, and auxiliary data arrays. This means we
- * only need to 1) decrement the ref counts on the objects in its
- * object array, 2) call the free procs for the auxiliary data items,
- * and 3) free the ByteCode structure's heap object.
+ * only need to 1) decrement the ref counts of the LiteralEntry's in
+ * its literal array, 2) call the free procs for the auxiliary data
+ * items, and 3) free the ByteCode structure's heap object.
+ *
+ * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes,
+ * like those generated from tbcload) is special, as they doesn't
+ * make use of the global literal table. They instead maintain
+ * private references to their literals which must be decremented.
*/
- for (i = 0; i < numObjects; i++) {
- elemPtr = objArrayPtr[i];
- TclDecrRefCount(elemPtr);
- }
-
- auxDataPtr = codePtr->auxDataArrayPtr;
- for (i = 0; i < numAuxDataItems; i++) {
- if (auxDataPtr->type->freeProc != NULL) {
- auxDataPtr->type->freeProc(auxDataPtr->clientData);
+ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+ register Tcl_Obj *objPtr;
+
+ objArrayPtr = codePtr->objArrayPtr;
+ for (i = 0; i < numLitObjects; i++) {
+ objPtr = *objArrayPtr;
+ if (objPtr) {
+ Tcl_DecrRefCount(objPtr);
+ }
+ objArrayPtr++;
}
- auxDataPtr++;
- }
-
- ckfree((char *) codePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupByteCodeInternalRep --
- *
- * Part of the bytecode Tcl object type implementation. However, it
- * does not copy the internal representation of a bytecode Tcl_Obj, but
- * instead leaves the new object untyped (with a NULL type pointer).
- * Code will be compiled for the new object only if necessary.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupByteCodeInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- return;
-}
-
-/*
- *-----------------------------------------------------------------------
- *
- * SetByteCodeFromAny --
- *
- * Part of the bytecode Tcl object type implementation. Attempts to
- * generate an byte code internal form for the Tcl object "objPtr" by
- * compiling its string representation.
- *
- * Results:
- * The return value is a standard Tcl object result. If an error occurs
- * during compilation, an error message is left in the interpreter's
- * result unless "interp" is NULL.
- *
- * Side effects:
- * Frees the old internal representation. If no error occurs, then the
- * compiled code is stored as "objPtr"s bytecode representation.
- * Also, if debugging, initializes the "tcl_traceCompile" Tcl variable
- * used to trace compilations.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetByteCodeFromAny(interp, objPtr)
- Tcl_Interp *interp; /* The interpreter for which the code is
- * compiled. */
- Tcl_Obj *objPtr; /* The object to convert. */
-{
- Interp *iPtr = (Interp *) interp;
- char *string;
- CompileEnv compEnv; /* Compilation environment structure
- * allocated in frame. */
- AuxData *auxDataPtr;
- register int i;
- int length, result;
-
- if (!traceInitialized) {
- if (Tcl_LinkVar(interp, "tcl_traceCompile",
- (char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
- panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
- }
- traceInitialized = 1;
- }
-
- string = Tcl_GetStringFromObj(objPtr, &length);
- TclInitCompileEnv(interp, &compEnv, string);
- result = TclCompileString(interp, string, string+length,
- iPtr->evalFlags, &compEnv);
- if (result == TCL_OK) {
- /*
- * Add a "done" instruction at the end of the instruction sequence.
- */
-
- TclEmitOpcode(INST_DONE, &compEnv);
-
+ codePtr->numLitObjects = 0;
+ } else if (interp != NULL) {
/*
- * Convert the object to a ByteCode object.
+ * If the interp has already been freed, then Tcl will have already
+ * forcefully released all the literals used by ByteCodes compiled
+ * with respect to that interp.
*/
-
- TclInitByteCodeObj(objPtr, &compEnv);
- } else {
- /*
- * Compilation errors. Decrement the ref counts on any objects in
- * the object array and free any aux data items prior to freeing
- * the compilation environment.
- */
-
- for (i = 0; i < compEnv.objArrayNext; i++) {
- Tcl_Obj *elemPtr = compEnv.objArrayPtr[i];
- Tcl_DecrRefCount(elemPtr);
- }
-
- auxDataPtr = compEnv.auxDataArrayPtr;
- for (i = 0; i < compEnv.auxDataArrayNext; i++) {
- if (auxDataPtr->type->freeProc != NULL) {
- auxDataPtr->type->freeProc(auxDataPtr->clientData);
+
+ objArrayPtr = codePtr->objArrayPtr;
+ for (i = 0; i < numLitObjects; i++) {
+ /*
+ * TclReleaseLiteral sets a ByteCode's object array entry NULL to
+ * indicate that it has already freed the literal.
+ */
+
+ if (*objArrayPtr != NULL) {
+ TclReleaseLiteral(interp, *objArrayPtr);
}
- auxDataPtr++;
+ objArrayPtr++;
}
}
- TclFreeCompileEnv(&compEnv);
-
- if (result == TCL_OK) {
- if (tclTraceCompile == 2) {
- TclPrintByteCodeObj(interp, objPtr);
+
+ auxDataPtr = codePtr->auxDataArrayPtr;
+ for (i = 0; i < numAuxDataItems; i++) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ (*auxDataPtr->type->freeProc)(auxDataPtr->clientData);
}
+ auxDataPtr++;
}
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfByteCode --
- *
- * Part of the bytecode Tcl object type implementation. Called to
- * update the string representation for a byte code object.
- * Note: This procedure does not free an existing old string rep
- * so storage will be lost if this has not already been done.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Generates a panic.
- *
- *----------------------------------------------------------------------
- */
-static void
-UpdateStringOfByteCode(objPtr)
- register Tcl_Obj *objPtr; /* ByteCode object with string rep that
- * needs updating. */
-{
- /*
- * This procedure is never invoked since the internal representation of
- * a bytecode object is never modified.
- */
-
- panic("UpdateStringOfByteCode should never be called.");
+ TclHandleRelease(codePtr->interpHandle);
+ ckfree((char *) codePtr);
}
/*
@@ -1162,44 +623,42 @@ UpdateStringOfByteCode(objPtr)
*/
void
-TclInitCompileEnv(interp, envPtr, string)
+TclInitCompileEnv(interp, envPtr, string, numBytes)
Tcl_Interp *interp; /* The interpreter for which a CompileEnv
* structure is initialized. */
register CompileEnv *envPtr; /* Points to the CompileEnv structure to
* initialize. */
char *string; /* The source string to be compiled. */
+ int numBytes; /* Number of bytes in source string. */
{
Interp *iPtr = (Interp *) interp;
envPtr->iPtr = iPtr;
envPtr->source = string;
+ envPtr->numSrcBytes = numBytes;
envPtr->procPtr = iPtr->compiledProcPtr;
envPtr->numCommands = 0;
- envPtr->excRangeDepth = 0;
- envPtr->maxExcRangeDepth = 0;
+ envPtr->exceptDepth = 0;
+ envPtr->maxExceptDepth = 0;
envPtr->maxStackDepth = 0;
- Tcl_InitHashTable(&(envPtr->objTable), TCL_STRING_KEYS);
- envPtr->pushSimpleWords = 1;
- envPtr->wordIsSimple = 0;
- envPtr->numSimpleWordChars = 0;
+ TclInitLiteralTable(&(envPtr->localLitTable));
envPtr->exprIsJustVarRef = 0;
envPtr->exprIsComparison = 0;
- envPtr->termOffset = 0;
envPtr->codeStart = envPtr->staticCodeSpace;
envPtr->codeNext = envPtr->codeStart;
envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
envPtr->mallocedCodeArray = 0;
- envPtr->objArrayPtr = envPtr->staticObjArraySpace;
- envPtr->objArrayNext = 0;
- envPtr->objArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
- envPtr->mallocedObjArray = 0;
+ envPtr->literalArrayPtr = envPtr->staticLiteralSpace;
+ envPtr->literalArrayNext = 0;
+ envPtr->literalArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
+ envPtr->mallocedLiteralArray = 0;
- envPtr->excRangeArrayPtr = envPtr->staticExcRangeArraySpace;
- envPtr->excRangeArrayNext = 0;
- envPtr->excRangeArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
- envPtr->mallocedExcRangeArray = 0;
+ envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
+ envPtr->exceptArrayNext = 0;
+ envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
+ envPtr->mallocedExceptArray = 0;
envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
@@ -1221,15 +680,14 @@ TclInitCompileEnv(interp, envPtr, string)
*
* Results:
* None.
- *
+ *
* Side effects:
* Allocated storage in the CompileEnv structure is freed. Note that
- * ref counts for Tcl objects in its object table are not decremented.
- * In addition, any storage referenced by any auxiliary data items
- * in the CompileEnv structure are not freed either. The expectation
- * is that when compilation is successful, "ownership" (i.e., the
- * pointers to) these objects and aux data items will just be handed
- * over to the corresponding ByteCode structure.
+ * its local literal table is not deleted and its literal objects are
+ * not released. In addition, storage referenced by its auxiliary data
+ * items is not freed. This is done so that, when compilation is
+ * successful, "ownership" of these objects and aux data items is
+ * handed over to the corresponding ByteCode structure.
*
*----------------------------------------------------------------------
*/
@@ -1238,15 +696,14 @@ void
TclFreeCompileEnv(envPtr)
register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
{
- Tcl_DeleteHashTable(&(envPtr->objTable));
if (envPtr->mallocedCodeArray) {
ckfree((char *) envPtr->codeStart);
}
- if (envPtr->mallocedObjArray) {
- ckfree((char *) envPtr->objArrayPtr);
+ if (envPtr->mallocedLiteralArray) {
+ ckfree((char *) envPtr->literalArrayPtr);
}
- if (envPtr->mallocedExcRangeArray) {
- ckfree((char *) envPtr->excRangeArrayPtr);
+ if (envPtr->mallocedExceptArray) {
+ ckfree((char *) envPtr->exceptArrayPtr);
}
if (envPtr->mallocedCmdMap) {
ckfree((char *) envPtr->cmdMapPtr);
@@ -1259,5323 +716,956 @@ TclFreeCompileEnv(envPtr)
/*
*----------------------------------------------------------------------
*
- * TclInitByteCodeObj --
- *
- * Create a ByteCode structure and initialize it from a CompileEnv
- * compilation environment structure. The ByteCode structure is
- * smaller and contains just that information needed to execute
- * the bytecode instructions resulting from compiling a Tcl script.
- * The resulting structure is placed in the specified object.
- *
- * Results:
- * A newly constructed ByteCode object is stored in the internal
- * representation of the objPtr.
- *
- * Side effects:
- * A single heap object is allocated to hold the new ByteCode structure
- * and its code, object, command location, and aux data arrays. Note
- * that "ownership" (i.e., the pointers to) the Tcl objects and aux
- * data items will be handed over to the new ByteCode structure from
- * the CompileEnv structure.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclInitByteCodeObj(objPtr, envPtr)
- Tcl_Obj *objPtr; /* Points object that should be
- * initialized, and whose string rep
- * contains the source code. */
- register CompileEnv *envPtr; /* Points to the CompileEnv structure from
- * which to create a ByteCode structure. */
-{
- register ByteCode *codePtr;
- size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
- size_t auxDataArrayBytes;
- register size_t size, objBytes, totalSize;
- register unsigned char *p;
- unsigned char *nextPtr;
- int srcLen = envPtr->termOffset;
- int numObjects, i;
- Namespace *namespacePtr;
-#ifdef TCL_COMPILE_STATS
- int srcLenLog2, sizeLog2;
-#endif /*TCL_COMPILE_STATS*/
-
- codeBytes = (envPtr->codeNext - envPtr->codeStart);
- numObjects = envPtr->objArrayNext;
- objArrayBytes = (envPtr->objArrayNext * sizeof(Tcl_Obj *));
- exceptArrayBytes = (envPtr->excRangeArrayNext * sizeof(ExceptionRange));
- auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
- cmdLocBytes = GetCmdLocEncodingSize(envPtr);
-
- size = sizeof(ByteCode);
- size += TCL_ALIGN(codeBytes); /* align object array */
- size += TCL_ALIGN(objArrayBytes); /* align exception range array */
- size += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
- size += auxDataArrayBytes;
- size += cmdLocBytes;
-
- /*
- * Compute the total number of bytes needed for this bytecode
- * including the storage for the Tcl objects in its object array.
- */
-
- objBytes = (numObjects * sizeof(Tcl_Obj));
- for (i = 0; i < numObjects; i++) {
- Tcl_Obj *litObjPtr = envPtr->objArrayPtr[i];
- if (litObjPtr->bytes != NULL) {
- objBytes += litObjPtr->length;
- }
- }
- totalSize = (size + objBytes);
-
-#ifdef TCL_COMPILE_STATS
- tclNumCompilations++;
- tclTotalSourceBytes += (double) srcLen;
- tclTotalCodeBytes += (double) totalSize;
-
- tclTotalInstBytes += (double) codeBytes;
- tclTotalObjBytes += (double) objBytes;
- tclTotalExceptBytes += exceptArrayBytes;
- tclTotalAuxBytes += (double) auxDataArrayBytes;
- tclTotalCmdMapBytes += (double) cmdLocBytes;
-
- tclCurrentSourceBytes += (double) srcLen;
- tclCurrentCodeBytes += (double) totalSize;
-
- srcLenLog2 = TclLog2(srcLen);
- sizeLog2 = TclLog2((int) totalSize);
- if ((srcLenLog2 > 31) || (sizeLog2 > 31)) {
- panic("TclInitByteCodeObj: bad source or code sizes\n");
- }
- tclSourceCount[srcLenLog2]++;
- tclByteCodeCount[sizeLog2]++;
-#endif /* TCL_COMPILE_STATS */
-
- if (envPtr->iPtr->varFramePtr != NULL) {
- namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
- } else {
- namespacePtr = envPtr->iPtr->globalNsPtr;
- }
-
- p = (unsigned char *) ckalloc(size);
- codePtr = (ByteCode *) p;
- codePtr->iPtr = envPtr->iPtr;
- codePtr->compileEpoch = envPtr->iPtr->compileEpoch;
- codePtr->nsPtr = namespacePtr;
- codePtr->nsEpoch = namespacePtr->resolverEpoch;
- codePtr->refCount = 1;
- codePtr->flags = 0;
- codePtr->source = envPtr->source;
- codePtr->procPtr = envPtr->procPtr;
- codePtr->totalSize = totalSize;
- codePtr->numCommands = envPtr->numCommands;
- codePtr->numSrcChars = srcLen;
- codePtr->numCodeBytes = codeBytes;
- codePtr->numObjects = numObjects;
- codePtr->numExcRanges = envPtr->excRangeArrayNext;
- codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
- codePtr->auxDataArrayPtr = NULL;
- codePtr->numCmdLocBytes = cmdLocBytes;
- codePtr->maxExcRangeDepth = envPtr->maxExcRangeDepth;
- codePtr->maxStackDepth = envPtr->maxStackDepth;
-
- p += sizeof(ByteCode);
- codePtr->codeStart = p;
- memcpy((VOID *) p, (VOID *) envPtr->codeStart, codeBytes);
-
- p += TCL_ALIGN(codeBytes); /* align object array */
- codePtr->objArrayPtr = (Tcl_Obj **) p;
- memcpy((VOID *) p, (VOID *) envPtr->objArrayPtr, objArrayBytes);
-
- p += TCL_ALIGN(objArrayBytes); /* align exception range array */
- if (exceptArrayBytes > 0) {
- codePtr->excRangeArrayPtr = (ExceptionRange *) p;
- memcpy((VOID *) p, (VOID *) envPtr->excRangeArrayPtr,
- exceptArrayBytes);
- }
-
- p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
- if (auxDataArrayBytes > 0) {
- codePtr->auxDataArrayPtr = (AuxData *) p;
- memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
- auxDataArrayBytes);
- }
-
- p += auxDataArrayBytes;
- nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
- if (((size_t)(nextPtr - p)) != cmdLocBytes) {
- panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
- }
-
- /*
- * Free the old internal rep then convert the object to a
- * bytecode object by making its internal rep point to the just
- * compiled ByteCode.
- */
-
- if ((objPtr->typePtr != NULL) &&
- (objPtr->typePtr->freeIntRepProc != NULL)) {
- objPtr->typePtr->freeIntRepProc(objPtr);
- }
- objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
- objPtr->typePtr = &tclByteCodeType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetCmdLocEncodingSize --
- *
- * Computes the total number of bytes needed to encode the command
- * location information for some compiled code.
- *
- * Results:
- * The byte count needed to encode the compiled location information.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetCmdLocEncodingSize(envPtr)
- CompileEnv *envPtr; /* Points to compilation environment
- * structure containing the CmdLocation
- * structure to encode. */
-{
- register CmdLocation *mapPtr = envPtr->cmdMapPtr;
- int numCmds = envPtr->numCommands;
- int codeDelta, codeLen, srcDelta, srcLen;
- int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
- /* The offsets in their respective byte
- * sequences where the next encoded offset
- * or length should go. */
- int prevCodeOffset, prevSrcOffset, i;
-
- codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
- prevCodeOffset = prevSrcOffset = 0;
- for (i = 0; i < numCmds; i++) {
- codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
- if (codeDelta < 0) {
- panic("GetCmdLocEncodingSize: bad code offset");
- } else if (codeDelta <= 127) {
- codeDeltaNext++;
- } else {
- codeDeltaNext += 5; /* 1 byte for 0xFF, 4 for positive delta */
- }
- prevCodeOffset = mapPtr[i].codeOffset;
-
- codeLen = mapPtr[i].numCodeBytes;
- if (codeLen < 0) {
- panic("GetCmdLocEncodingSize: bad code length");
- } else if (codeLen <= 127) {
- codeLengthNext++;
- } else {
- codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
- }
-
- srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
- if ((-127 <= srcDelta) && (srcDelta <= 127)) {
- srcDeltaNext++;
- } else {
- srcDeltaNext += 5; /* 1 byte for 0xFF, 4 for delta */
- }
- prevSrcOffset = mapPtr[i].srcOffset;
-
- srcLen = mapPtr[i].numSrcChars;
- if (srcLen < 0) {
- panic("GetCmdLocEncodingSize: bad source length");
- } else if (srcLen <= 127) {
- srcLengthNext++;
- } else {
- srcLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
- }
- }
-
- return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * EncodeCmdLocMap --
- *
- * Encode the command location information for some compiled code into
- * a ByteCode structure. The encoded command location map is stored as
- * three adjacent byte sequences.
- *
- * Results:
- * Pointer to the first byte after the encoded command location
- * information.
- *
- * Side effects:
- * The encoded information is stored into the block of memory headed
- * by codePtr. Also records pointers to the start of the four byte
- * sequences in fields in codePtr's ByteCode header structure.
- *
- *----------------------------------------------------------------------
- */
-
-static unsigned char *
-EncodeCmdLocMap(envPtr, codePtr, startPtr)
- CompileEnv *envPtr; /* Points to compilation environment
- * structure containing the CmdLocation
- * structure to encode. */
- ByteCode *codePtr; /* ByteCode in which to encode envPtr's
- * command location information. */
- unsigned char *startPtr; /* Points to the first byte in codePtr's
- * memory block where the location
- * information is to be stored. */
-{
- register CmdLocation *mapPtr = envPtr->cmdMapPtr;
- int numCmds = envPtr->numCommands;
- register unsigned char *p = startPtr;
- int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
- register int i;
-
- /*
- * Encode the code offset for each command as a sequence of deltas.
- */
-
- codePtr->codeDeltaStart = p;
- prevOffset = 0;
- for (i = 0; i < numCmds; i++) {
- codeDelta = (mapPtr[i].codeOffset - prevOffset);
- if (codeDelta < 0) {
- panic("EncodeCmdLocMap: bad code offset");
- } else if (codeDelta <= 127) {
- TclStoreInt1AtPtr(codeDelta, p);
- p++;
- } else {
- TclStoreInt1AtPtr(0xFF, p);
- p++;
- TclStoreInt4AtPtr(codeDelta, p);
- p += 4;
- }
- prevOffset = mapPtr[i].codeOffset;
- }
-
- /*
- * Encode the code length for each command.
- */
-
- codePtr->codeLengthStart = p;
- for (i = 0; i < numCmds; i++) {
- codeLen = mapPtr[i].numCodeBytes;
- if (codeLen < 0) {
- panic("EncodeCmdLocMap: bad code length");
- } else if (codeLen <= 127) {
- TclStoreInt1AtPtr(codeLen, p);
- p++;
- } else {
- TclStoreInt1AtPtr(0xFF, p);
- p++;
- TclStoreInt4AtPtr(codeLen, p);
- p += 4;
- }
- }
-
- /*
- * Encode the source offset for each command as a sequence of deltas.
- */
-
- codePtr->srcDeltaStart = p;
- prevOffset = 0;
- for (i = 0; i < numCmds; i++) {
- srcDelta = (mapPtr[i].srcOffset - prevOffset);
- if ((-127 <= srcDelta) && (srcDelta <= 127)) {
- TclStoreInt1AtPtr(srcDelta, p);
- p++;
- } else {
- TclStoreInt1AtPtr(0xFF, p);
- p++;
- TclStoreInt4AtPtr(srcDelta, p);
- p += 4;
- }
- prevOffset = mapPtr[i].srcOffset;
- }
-
- /*
- * Encode the source length for each command.
- */
-
- codePtr->srcLengthStart = p;
- for (i = 0; i < numCmds; i++) {
- srcLen = mapPtr[i].numSrcChars;
- if (srcLen < 0) {
- panic("EncodeCmdLocMap: bad source length");
- } else if (srcLen <= 127) {
- TclStoreInt1AtPtr(srcLen, p);
- p++;
- } else {
- TclStoreInt1AtPtr(0xFF, p);
- p++;
- TclStoreInt4AtPtr(srcLen, p);
- p += 4;
- }
- }
-
- return p;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileString --
+ * TclCompileScript --
*
- * Compile a Tcl script in a null-terminated binary string.
+ * Compile a Tcl script in a string.
*
* Results:
* The return value is TCL_OK on a successful compilation and TCL_ERROR
* on failure. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->termOffset and interp->termOffset are filled in with the
- * offset of the character in the string just after the last one
- * successfully processed; this might be the offset of the ']' (if
- * flags & TCL_BRACKET_TERM), or the offset of the '\0' at the end of
- * the string. Also updates envPtr->maxStackDepth with the maximum
- * number of stack elements needed to execute the string's commands.
+ * interp->termOffset is set to the offset of the character in the
+ * script just after the last one successfully processed; this will be
+ * the offset of the ']' if (flags & TCL_BRACKET_TERM).
+ * envPtr->maxStackDepth is set to the maximum number of stack elements
+ * needed to execute the script's commands.
*
* Side effects:
- * Adds instructions to envPtr to evaluate the string at runtime.
+ * Adds instructions to envPtr to evaluate the script at runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileString(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
+TclCompileScript(interp, script, numBytes, nested, envPtr)
+ Tcl_Interp *interp; /* Used for error and status reporting. */
+ char *script; /* The source script to compile. */
+ int numBytes; /* Number of bytes in script. If < 0, the
+ * script consists of all bytes up to the
+ * first null character. */
+ int nested; /* Non-zero means this is a nested command:
+ * close bracket ']' should be considered a
+ * command terminator. If zero, close
+ * bracket has no special meaning. */
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Interp *iPtr = (Interp *) interp;
- register char *src = string;/* Points to current source char. */
- register char c = *src; /* The current char. */
- register int type; /* Current char's CHAR_TYPE type. */
- char termChar = (char)((flags & TCL_BRACKET_TERM)? ']' : '\0');
- /* Return when this character is found
- * (either ']' or '\0'). Zero means newlines
- * terminate cmds. */
- int isFirstCmd = 1; /* 1 if compiling the first cmd. */
- char *cmdSrcStart = NULL; /* Points to first non-blank char in each
- * command. Initialized to avoid compiler
- * warning. */
- int cmdIndex; /* The index of the current command in the
- * compilation environment's command
- * location table. */
+ Tcl_Parse parse;
+ int maxDepth = 0; /* Maximum number of stack elements needed
+ * to execute all cmds. */
int lastTopLevelCmdIndex = -1;
/* Index of most recent toplevel command in
* the command location table. Initialized
* to avoid compiler warning. */
- int cmdCodeOffset = -1; /* Offset of first byte of current command's
- * code. Initialized to avoid compiler
- * warning. */
- int cmdWords; /* Number of words in current command. */
- Tcl_Command cmd; /* Used to search for commands. */
- Command *cmdPtr; /* Points to command's Command structure if
- * first word is simple and command was
- * found; else NULL. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute all cmds. */
- char *termPtr; /* Points to char that terminated word. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null character
- * during processing of words. */
- int objIndex = -1; /* The object array index for a pushed
- * object holding a word or word part
- * Initialized to avoid compiler warning. */
+ int startCodeOffset = -1; /* Offset of first byte of current command's
+ * code. Init. to avoid compiler warning. */
unsigned char *entryCodeNext = envPtr->codeNext;
- /* Value of envPtr's current instruction
- * pointer at entry. Used to tell if any
- * instructions generated. */
- char *ellipsis = ""; /* Used to set errorInfo variable; "..."
- * indicates that not all of offending
- * command is included in errorInfo. ""
- * means that the command is all there. */
- Tcl_Obj *objPtr;
- int numChars;
- int result = TCL_OK;
- int savePushSimpleWords = envPtr->pushSimpleWords;
+ char *p, *next;
+ Namespace *cmdNsPtr;
+ Command *cmdPtr;
+ Tcl_Token *tokenPtr;
+ int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
+ int commandLength, objIndex, code;
+ char prev;
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+
+ if (numBytes < 0) {
+ numBytes = strlen(script);
+ }
+ Tcl_ResetResult(interp);
+ isFirstCmd = 1;
/*
- * commands: command {(';' | '\n') command}
+ * Each iteration through the following loop compiles the next
+ * command from the script.
*/
- while ((src != lastChar) && (c != termChar)) {
- /*
- * Skip white space, semicolons, backslash-newlines (treated as
- * spaces), and comments before command.
- */
-
- type = CHAR_TYPE(src, lastChar);
- while ((type & (TCL_SPACE | TCL_BACKSLASH))
- || (c == '\n') || (c == ';')) {
- if (type == TCL_BACKSLASH) {
- if (src[1] == '\n') {
- src += 2;
- } else {
- break;
- }
- } else {
- src++;
- }
- c = *src;
- type = CHAR_TYPE(src, lastChar);
+ p = script;
+ bytesLeft = numBytes;
+ gotParse = 0;
+ while (bytesLeft > 0) {
+ if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
+ code = TCL_ERROR;
+ goto error;
}
+ gotParse = 1;
+ if (parse.numWords > 0) {
+ /*
+ * If not the first command, pop the previous command's result
+ * and, if we're compiling a top level command, update the last
+ * command's code size to account for the pop instruction.
+ */
- if (c == '#') {
- while (src != lastChar) {
- if (c == '\\') {
- int numRead;
- Tcl_Backslash(src, &numRead);
- src += numRead;
- } else if (c == '\n') {
- src++;
- c = *src;
- envPtr->termOffset = (src - string);
- break;
- } else {
- src++;
+ if (!isFirstCmd) {
+ TclEmitOpcode(INST_POP, envPtr);
+ if (!nested) {
+ envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart)
+ - startCodeOffset;
}
- c = *src;
}
- continue; /* end of comment, restart outer command loop */
- }
- /*
- * Compile one command: zero or more words terminated by a '\n',
- * ';', ']' (if command is terminated by close bracket), or
- * the end of string.
- *
- * command: word*
- */
-
- type = CHAR_TYPE(src, lastChar);
- if ((type == TCL_COMMAND_END)
- && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
- continue; /* empty command; restart outer cmd loop */
- }
+ /*
+ * Determine the actual length of the command.
+ */
- /*
- * If not the first command, discard the previous command's result.
- */
-
- if (!isFirstCmd) {
- TclEmitOpcode(INST_POP, envPtr);
- if (!(flags & TCL_BRACKET_TERM)) {
+ commandLength = parse.commandSize;
+ prev = '\0';
+ if (commandLength > 0) {
+ prev = parse.commandStart[commandLength-1];
+ }
+ if (((parse.commandStart+commandLength) != (script+numBytes))
+ || ((prev=='\n') || (nested && (prev==']')))) {
/*
- * We are compiling a top level command. Update the number
- * of code bytes for the last command to account for the pop
- * instruction.
+ * The command didn't end at the end of the script (i.e. it
+ * ended at a terminator character such as ";". Reduce the
+ * length by one so that the trace message doesn't include
+ * the terminator character.
*/
- (envPtr->cmdMapPtr[lastTopLevelCmdIndex]).numCodeBytes =
- (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset;
+ commandLength -= 1;
}
- }
-
- /*
- * Compile the words of the command. Process the first word
- * specially, since it is the name of a command. If it is a "simple"
- * string (just a sequence of characters), look it up in the table
- * of compilation procedures. If a word other than the first is
- * simple and represents an integer whose formatted representation
- * is the same as the word, just push an integer object. Also record
- * starting source and object information for the command.
- */
- envPtr->numCommands++;
- cmdIndex = (envPtr->numCommands - 1);
- if (!(flags & TCL_BRACKET_TERM)) {
- lastTopLevelCmdIndex = cmdIndex;
- }
-
- cmdSrcStart = src;
- cmdCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- cmdWords = 0;
- EnterCmdStartData(envPtr, cmdIndex, src-envPtr->source,
- cmdCodeOffset);
-
- if ((!(flags & TCL_BRACKET_TERM))
- && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
/*
- * Display a line summarizing the top level command we are about
- * to compile.
- */
-
- char *p = cmdSrcStart;
- int numChars, complete;
-
- while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
- || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
- p++;
- }
- numChars = (p - cmdSrcStart);
- complete = 1;
- if (numChars > 60) {
- numChars = 60;
- complete = 0;
- } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
- complete = 0;
- }
- fprintf(stdout, "Compiling: %.*s%s\n",
- numChars, cmdSrcStart, (complete? "" : " ..."));
- }
-
- while ((type != TCL_COMMAND_END)
- || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {
- /*
- * Skip any leading white space at the start of a word. Note
- * that a backslash-newline is treated as a space.
- */
+ * If tracing, print a line for each top level command compiled.
+ */
- while (type & (TCL_SPACE | TCL_BACKSLASH)) {
- if (type == TCL_BACKSLASH) {
- if (src[1] == '\n') {
- src += 2;
- } else {
- break;
- }
- } else {
- src++;
- }
- c = *src;
- type = CHAR_TYPE(src, lastChar);
- }
- if ((type == TCL_COMMAND_END)
- && ((c != ']') || (flags & TCL_BRACKET_TERM))) {
- break; /* no words remain for command. */
+ if ((tclTraceCompile >= 1)
+ && !nested && (envPtr->procPtr == NULL)) {
+ fprintf(stdout, " Compiling: ");
+ TclPrintSource(stdout, parse.commandStart,
+ TclMin(commandLength, 55));
+ fprintf(stdout, "\n");
}
/*
- * Compile one word. We use an inline version of CompileWord to
- * avoid an extra procedure call.
+ * Each iteration of the following loop compiles one word
+ * from the command.
*/
-
- envPtr->pushSimpleWords = 0;
- if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src++;
- if (type == TCL_QUOTE) {
- result = TclCompileQuotes(interp, src, lastChar,
- '"', flags, envPtr);
- } else {
- result = CompileBraces(interp, src, lastChar,
- flags, envPtr);
- }
- termPtr = (src + envPtr->termOffset);
- if (result != TCL_OK) {
- src = termPtr;
- goto done;
- }
-
- /*
- * Make sure terminating character of the quoted or braced
- * string is the end of word.
- */
-
- c = *termPtr;
- if ((c == '\\') && (*(termPtr+1) == '\n')) {
- /*
- * Line is continued on next line; the backslash-
- * newline turns into space, which terminates the word.
- */
- } else {
- type = CHAR_TYPE(termPtr, lastChar);
- if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
- Tcl_ResetResult(interp);
- if (*(src-1) == '"') {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-quote", -1);
- } else {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-brace", -1);
- }
- result = TCL_ERROR;
- }
- }
- } else {
- result = CompileMultipartWord(interp, src, lastChar,
- flags, envPtr);
- termPtr = (src + envPtr->termOffset);
- }
- if (result != TCL_OK) {
- ellipsis = "...";
- src = termPtr;
- goto done;
- }
- if (envPtr->wordIsSimple) {
- /*
- * A simple word. Temporarily replace the terminating
- * character with a null character.
- */
-
- numChars = envPtr->numSimpleWordChars;
- savedChar = src[numChars];
- src[numChars] = '\0';
-
- if ((cmdWords == 0)
- && (!(iPtr->flags & DONT_COMPILE_CMDS_INLINE))) {
+ envPtr->numCommands++;
+ currCmdIndex = (envPtr->numCommands - 1);
+ if (!nested) {
+ lastTopLevelCmdIndex = currCmdIndex;
+ }
+ startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ EnterCmdStartData(envPtr, currCmdIndex,
+ (parse.commandStart - envPtr->source), startCodeOffset);
+
+ for (wordIdx = 0, tokenPtr = parse.tokenPtr;
+ wordIdx < parse.numWords;
+ wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
- * The first word of a command and inline command
- * compilation has not been disabled (e.g., by command
- * traces). Look up the first word in the interpreter's
- * hashtable of commands. If a compilation procedure is
- * found, let it compile the command after resetting
- * error logging information. Note that if we are
- * compiling a procedure, we must look up the command
- * in the procedure's namespace and not the current
- * namespace.
+ * If this is the first word and the command has a
+ * compile procedure, let it compile the command.
*/
- Namespace *cmdNsPtr;
-
- if (envPtr->procPtr != NULL) {
- cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
- } else {
- cmdNsPtr = NULL;
- }
-
- cmdPtr = NULL;
- cmd = Tcl_FindCommand(interp, src,
- (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
- if (cmd != (Tcl_Command) NULL) {
- cmdPtr = (Command *) cmd;
- }
- if ((cmdPtr != NULL) && (cmdPtr->compileProc != NULL)) {
- char *firstArg = termPtr;
- src[numChars] = savedChar;
- iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
- | ERROR_CODE_SET);
- result = (*(cmdPtr->compileProc))(interp,
- firstArg, lastChar, flags, envPtr);
- if (result == TCL_OK) {
- src = (firstArg + envPtr->termOffset);
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- goto finishCommand;
- } else if (result == TCL_OUT_LINE_COMPILE) {
- result = TCL_OK;
- src[numChars] = '\0';
+ if (wordIdx == 0) {
+ if (envPtr->procPtr != NULL) {
+ cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
} else {
- src = firstArg;
- goto done; /* an error */
+ cmdNsPtr = NULL; /* use current NS */
}
- }
- /*
- * No compile procedure was found for the command: push
- * the word and continue to compile the remaining
- * words. If a hashtable entry was found for the
- * command, push a CmdName object instead to avoid
- * runtime lookups. If necessary, convert the pushed
- * object to be a CmdName object. If this is the first
- * CmdName object in this code unit that refers to the
- * command, increment the reference count in the
- * Command structure to reflect the new reference from
- * the CmdName object and, if the command is deleted
- * later, to keep the Command structure from being freed
- * until TclExecuteByteCode has a chance to recognize
- * that the command was deleted.
- */
+ /*
+ * We copy the string before trying to find the command
+ * by name. We used to modify the string in place, but
+ * this is not safe because the name resolution
+ * handlers could have side effects that rely on the
+ * unmodified string.
+ */
+
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, tokenPtr[1].start,
+ tokenPtr[1].size);
+
+ cmdPtr = (Command *) Tcl_FindCommand(interp,
+ Tcl_DStringValue(&ds),
+ (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);
+
+ if ((cmdPtr != NULL)
+ && (cmdPtr->compileProc != NULL)
+ && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
+ code = (*(cmdPtr->compileProc))(interp, &parse,
+ envPtr);
+ if (code == TCL_OK) {
+ maxDepth = TclMax(envPtr->maxStackDepth,
+ maxDepth);
+ goto finishCommand;
+ } else if (code == TCL_OUT_LINE_COMPILE) {
+ /* do nothing */
+ } else { /* an error */
+ /*
+ * There was a compilation error, the last
+ * command did not get compiled into (*envPtr).
+ * Decrement the number of commands
+ * claimed to be in (*envPtr).
+ */
+ envPtr->numCommands--;
+ goto error;
+ }
+ }
- objIndex = TclObjIndexForString(src, numChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- if (cmdPtr != NULL) {
- objPtr = envPtr->objArrayPtr[objIndex];
- if ((objPtr->typePtr != &tclCmdNameType)
- && (objPtr->bytes != NULL)) {
- ResolvedCmdName *resPtr = (ResolvedCmdName *)
- ckalloc(sizeof(ResolvedCmdName));
- Namespace *nsPtr = (Namespace *)
- Tcl_GetCurrentNamespace(interp);
-
- resPtr->cmdPtr = cmdPtr;
- resPtr->refNsPtr = nsPtr;
- resPtr->refNsId = nsPtr->nsId;
- resPtr->refNsCmdEpoch = nsPtr->cmdRefEpoch;
- resPtr->cmdEpoch = cmdPtr->cmdEpoch;
- resPtr->refCount = 1;
- objPtr->internalRep.twoPtrValue.ptr1 =
- (VOID *) resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
- cmdPtr->refCount++;
+ /*
+ * No compile procedure so push the word. If the
+ * command was found, push a CmdName object to
+ * reduce runtime lookups.
+ */
+
+ objIndex = TclRegisterLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size,
+ /*onHeap*/ 0);
+ if (cmdPtr != NULL) {
+ TclSetCmdNameObj(interp,
+ envPtr->literalArrayPtr[objIndex].objPtr,
+ cmdPtr);
}
+ } else {
+ objIndex = TclRegisterLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size,
+ /*onHeap*/ 0);
}
+ TclEmitPush(objIndex, envPtr);
+ maxDepth = TclMax((wordIdx + 1), maxDepth);
} else {
/*
- * See if the word represents an integer whose formatted
- * representation is the same as the word (e.g., this is
- * true for 123 and -1 but not for 00005). If so, just
- * push an integer object.
+ * The word is not a simple string of characters.
*/
-
- int isCompilableInt = 0;
- long n;
- char buf[40];
- if (TclLooksLikeInt(src)) {
- int code = TclGetLong(interp, src, &n);
- if (code == TCL_OK) {
- TclFormatInt(buf, n);
- if (strcmp(src, buf) == 0) {
- isCompilableInt = 1;
- objIndex = TclObjIndexForString(src,
- numChars, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = n;
- objPtr->typePtr = &tclIntType;
- }
- } else {
- Tcl_ResetResult(interp);
- }
- }
- if (!isCompilableInt) {
- objIndex = TclObjIndexForString(src, numChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
+ code = TclCompileTokens(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto error;
}
+ maxDepth = TclMax((wordIdx + envPtr->maxStackDepth),
+ maxDepth);
}
- src[numChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = TclMax((cmdWords + 1), maxDepth);
- } else { /* not a simple word */
- maxDepth = TclMax((cmdWords + envPtr->maxStackDepth),
- maxDepth);
}
- src = termPtr;
- c = *src;
- type = CHAR_TYPE(src, lastChar);
- cmdWords++;
- }
-
- /*
- * Emit an invoke instruction for the command. If a compile command
- * was found for the command we called it and skipped this.
- */
-
- if (cmdWords > 0) {
- if (cmdWords <= 255) {
- TclEmitInstUInt1(INST_INVOKE_STK1, cmdWords, envPtr);
- } else {
- TclEmitInstUInt4(INST_INVOKE_STK4, cmdWords, envPtr);
- }
- }
- /*
- * Update the compilation environment structure. Record
- * source/object information for the command.
- */
-
- finishCommand:
- EnterCmdExtentData(envPtr, cmdIndex, src-cmdSrcStart,
- (envPtr->codeNext-envPtr->codeStart) - cmdCodeOffset);
-
- isFirstCmd = 0;
- envPtr->termOffset = (src - string);
- c = *src;
- }
-
- done:
- if (result == TCL_OK) {
- /*
- * If the source string yielded no instructions (e.g., if it was
- * empty), push an empty string object as the command's result.
- */
-
- if (entryCodeNext == envPtr->codeNext) {
- int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
- }
- } else {
- /*
- * Add additional error information. First compute the line number
- * where the error occurred.
- */
+ /*
+ * Emit an invoke instruction for the command. We skip this
+ * if a compile procedure was found for the command.
+ */
+
+ if (wordIdx > 0) {
+ if (wordIdx <= 255) {
+ TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
+ } else {
+ TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
+ }
+ }
- register char *p;
- int numChars;
- char buf[200];
+ /*
+ * Update the compilation environment structure and record the
+ * offsets of the source and code for the command.
+ */
- iPtr->errorLine = 1;
- for (p = string; p != cmdSrcStart; p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
- }
- }
- for ( ; isspace(UCHAR(*p)) || (*p == ';'); p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
- }
- }
+ finishCommand:
+ EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
+ (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
+ isFirstCmd = 0;
+ } /* end if parse.numWords > 0 */
/*
- * Figure out how much of the command to print (up to a certain
- * number of characters, or up to the end of the command).
+ * Advance to the next command in the script.
*/
-
- p = cmdSrcStart;
- while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
- || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
- p++;
- }
- numChars = (p - cmdSrcStart);
- if (numChars > 150) {
- numChars = 150;
- ellipsis = " ...";
- } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
- ellipsis = " ...";
- }
- sprintf(buf, "\n while compiling\n\"%.*s%s\"",
- numChars, cmdSrcStart, ellipsis);
- Tcl_AddObjErrorInfo(interp, buf, -1);
- }
-
- envPtr->termOffset = (src - string);
- iPtr->termOffset = envPtr->termOffset;
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileWord --
- *
- * This procedure compiles one word from a command string. It skips
- * any leading white space.
- *
- * Ordinarily, callers set envPtr->pushSimpleWords to 1 and this
- * procedure emits push and other instructions to compute the
- * word on the Tcl evaluation stack at execution time. If a caller sets
- * envPtr->pushSimpleWords to 0, CompileWord will _not_ compile
- * "simple" words: words that are just a sequence of characters without
- * backslashes. It will leave their compilation up to the caller.
- *
- * As an important special case, if the word is simple, this procedure
- * sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
- * number of characters in the simple word. This allows the caller to
- * process these words specially.
- *
- * Results:
- * The return value is a standard Tcl result. If an error occurs, an
- * error message is left in the interpreter's result.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed in the last
- * word. This is normally the character just after the last one in a
- * word (perhaps the command terminator), or the vicinity of an error
- * (if the result is not TCL_OK).
- *
- * envPtr->wordIsSimple is set 1 if the word is simple: just a
- * sequence of characters without backslashes. If so, the word's
- * characters are the envPtr->numSimpleWordChars characters starting
- * at string.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to evaluate the word. This is not changed if
- * the word is simple and envPtr->pushSimpleWords was 0 (false).
- *
- * Side effects:
- * Instructions are added to envPtr to compute and push the word
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
+ next = parse.commandStart + parse.commandSize;
+ bytesLeft -= (next - p);
+ p = next;
+ Tcl_FreeParse(&parse);
+ gotParse = 0;
+ if (nested && (p[-1] == ']')) {
+ /*
+ * We get here in the special case where TCL_BRACKET_TERM was
+ * set in the interpreter and we reached a close bracket in the
+ * script. Stop compilation.
+ */
+
+ break;
+ }
+ }
-static int
-CompileWord(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* First character of word. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same values
- * passed to Tcl_EvalObj). */
- CompileEnv *envPtr; /* Holds the resulting instructions. */
-{
/*
- * Compile one word: approximately
- *
- * word: quoted_string | braced_string | multipart_word
- * quoted_string: '"' char* '"'
- * braced_string: '{' char* '}'
- * multipart_word (see CompileMultipartWord below)
+ * If the source script yielded no instructions (e.g., if it was empty),
+ * push an empty string as the command's result.
*/
- register char *src = string; /* Points to current source char. */
- register int type = CHAR_TYPE(src, lastChar);
- /* Current char's CHAR_TYPE type. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to compute and push the word. */
- char *termPtr = src; /* Points to the character that terminated
- * the word. */
- int result = TCL_OK;
-
- /*
- * Skip any leading white space at the start of a word. Note that a
- * backslash-newline is treated as a space.
- */
-
- while (type & (TCL_SPACE | TCL_BACKSLASH)) {
- if (type == TCL_BACKSLASH) {
- if (src[1] == '\n') {
- src += 2;
- } else {
- break; /* no longer white space */
- }
- } else {
- src++;
- }
- type = CHAR_TYPE(src, lastChar);
+ if (envPtr->codeNext == entryCodeNext) {
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
+ envPtr);
+ maxDepth = 1;
}
- if (type == TCL_COMMAND_END) {
- goto done;
+
+ if ((nested != 0) && (p > script) && (p[-1] == ']')) {
+ iPtr->termOffset = (p - 1) - script;
+ } else {
+ iPtr->termOffset = (p - script);
}
-
+ envPtr->maxStackDepth = maxDepth;
+ Tcl_DStringFree(&ds);
+ return TCL_OK;
+
+ error:
/*
- * Compile the word. Handle quoted and braced string words here in order
- * to avoid an extra procedure call.
+ * Generate various pieces of error information, such as the line
+ * number where the error occurred and information to add to the
+ * errorInfo variable. Then free resources that had been allocated
+ * to the command.
*/
- if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src++;
- if (type == TCL_QUOTE) {
- result = TclCompileQuotes(interp, src, lastChar, '"', flags,
- envPtr);
- } else {
- result = CompileBraces(interp, src, lastChar, flags, envPtr);
- }
- termPtr = (src + envPtr->termOffset);
- if (result != TCL_OK) {
- goto done;
- }
-
+ commandLength = parse.commandSize;
+ prev = '\0';
+ if (commandLength > 0) {
+ prev = parse.commandStart[commandLength-1];
+ }
+ if (((parse.commandStart+commandLength) != (script+numBytes))
+ || ((prev == '\n') || (nested && (prev == ']')))) {
/*
- * Make sure terminating character of the quoted or braced string is
- * the end of word.
+ * The command where the error occurred didn't end at the end
+ * of the script (i.e. it ended at a terminator character such
+ * as ";". Reduce the length by one so that the error message
+ * doesn't include the terminator character.
*/
-
- if ((*termPtr == '\\') && (*(termPtr+1) == '\n')) {
- /*
- * Line is continued on next line; the backslash-newline turns
- * into space, which terminates the word.
- */
- } else {
- type = CHAR_TYPE(termPtr, lastChar);
- if (!(type & (TCL_SPACE | TCL_COMMAND_END))) {
- Tcl_ResetResult(interp);
- if (*(src-1) == '"') {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-quote", -1);
- } else {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-brace", -1);
- }
- result = TCL_ERROR;
- goto done;
- }
- }
- maxDepth = envPtr->maxStackDepth;
- } else {
- result = CompileMultipartWord(interp, src, lastChar, flags, envPtr);
- termPtr = (src + envPtr->termOffset);
- maxDepth = envPtr->maxStackDepth;
- }
- /*
- * Done processing the word. The values of envPtr->wordIsSimple and
- * envPtr->numSimpleWordChars are left at the values returned by
- * TclCompileQuotes/Braces/MultipartWord.
- */
-
- done:
- envPtr->termOffset = (termPtr - string);
+ commandLength -= 1;
+ }
+ LogCompilationInfo(interp, script, parse.commandStart, commandLength);
+ if (gotParse) {
+ Tcl_FreeParse(&parse);
+ }
+ iPtr->termOffset = (p - script);
envPtr->maxStackDepth = maxDepth;
- return result;
+ Tcl_DStringFree(&ds);
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * CompileMultipartWord --
- *
- * This procedure compiles one multipart word: a word comprised of some
- * number of nested commands, variable references, or arbitrary
- * characters. This procedure assumes that quoted string and braced
- * string words and the end of command have already been handled by its
- * caller. It also assumes that any leading white space has already
- * been consumed.
- *
- * Ordinarily, callers set envPtr->pushSimpleWords to 1 and this
- * procedure emits push and other instructions to compute the word on
- * the Tcl evaluation stack at execution time. If a caller sets
- * envPtr->pushSimpleWords to 0, it will _not_ compile "simple" words:
- * words that are just a sequence of characters without backslashes.
- * It will leave their compilation up to the caller. This is done, for
- * example, to provide special support for the first word of commands,
- * which are almost always the (simple) name of a command.
- *
- * As an important special case, if the word is simple, this procedure
- * sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
- * number of characters in the simple word. This allows the caller to
- * process these words specially.
+ * TclCompileTokens --
+ *
+ * Given an array of tokens parsed from a Tcl command (e.g., the tokens
+ * that make up a word) this procedure emits instructions to evaluate
+ * the tokens and concatenate their values to form a single result
+ * value on the interpreter's runtime evaluation stack.
*
* Results:
* The return value is a standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed in the last
- * word. This is normally the character just after the last one in a
- * word (perhaps the command terminator), or the vicinity of an error
- * (if the result is not TCL_OK).
- *
- * envPtr->wordIsSimple is set 1 if the word is simple: just a
- * sequence of characters without backslashes. If so, the word's
- * characters are the envPtr->numSimpleWordChars characters starting
- * at string.
- *
* envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to evaluate the word. This is not changed if
- * the word is simple and envPtr->pushSimpleWords was 0 (false).
+ * elements needed to evaluate the tokens.
*
* Side effects:
- * Instructions are added to envPtr to compute and push the word
+ * Instructions are added to envPtr to push and evaluate the tokens
* at runtime.
*
*----------------------------------------------------------------------
*/
-static int
-CompileMultipartWord(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* First character of word. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same values
- * passed to Tcl_EvalObj). */
+int
+TclCompileTokens(interp, tokenPtr, count, envPtr)
+ Tcl_Interp *interp; /* Used for error and status reporting. */
+ Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
+ * to compile. */
+ int count; /* Number of tokens to consider at tokenPtr.
+ * Must be at least 1. */
CompileEnv *envPtr; /* Holds the resulting instructions. */
{
- /*
- * Compile one multi_part word:
- *
- * multi_part_word: word_part+
- * word_part: nested_cmd | var_reference | char+
- * nested_cmd: '[' command ']'
- * var_reference: '$' name | '$' name '(' index_string ')' |
- * '$' '{' braced_name '}')
- * name: (letter | digit | underscore)+
- * braced_name: (non_close_brace_char)*
- * index_string: (non_close_paren_char)*
- */
-
- register char *src = string; /* Points to current source char. */
- register char c = *src; /* The current char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int bracketNormal = !(flags & TCL_BRACKET_TERM);
- int simpleWord = 0; /* Set 1 if word is simple. */
- int numParts = 0; /* Count of word_part objs pushed. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to compute and push the word. */
- char *start; /* Starting position of char+ word_part. */
- int hasBackslash; /* Nonzero if '\' in char+ word_part. */
- int numChars; /* Number of chars in char+ word_part. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null character
- * during word_part processing. */
- int objIndex; /* The object array index for a pushed
- * object holding a word_part. */
- int savePushSimpleWords = envPtr->pushSimpleWords;
- int result = TCL_OK;
- int numRead;
-
- type = CHAR_TYPE(src, lastChar);
- while (1) {
- /*
- * Process a word_part: a sequence of chars, a var reference, or
- * a nested command.
- */
+ Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
+ * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
+ char buffer[TCL_UTF_MAX];
+ char *name, *p;
+ int numObjsToConcat, nameBytes, hasNsQualifiers, localVar;
+ int length, maxDepth, depthForVar, i, code;
+ unsigned char *entryCodeNext = envPtr->codeNext;
- if ((type & (TCL_NORMAL | TCL_CLOSE_BRACE | TCL_BACKSLASH |
- TCL_QUOTE | TCL_OPEN_BRACE)) ||
- ((c == ']') && bracketNormal)) {
- /*
- * A char+ word part. Scan first looking for any backslashes.
- * Note that a backslash-newline must be treated as a word
- * separator, as if the backslash-newline had been collapsed
- * before command parsing began.
- */
-
- start = src;
- hasBackslash = 0;
- do {
- if (type == TCL_BACKSLASH) {
- hasBackslash = 1;
- Tcl_Backslash(src, &numRead);
- if (src[1] == '\n') {
- src += numRead;
- type = TCL_SPACE; /* force word end */
- break;
- }
- src += numRead;
- } else {
- src++;
- }
- c = *src;
- type = CHAR_TYPE(src, lastChar);
- } while (type & (TCL_NORMAL | TCL_BACKSLASH | TCL_QUOTE |
- TCL_OPEN_BRACE | TCL_CLOSE_BRACE)
- || ((c == ']') && bracketNormal));
-
- if ((numParts == 0) && !hasBackslash
- && (type & (TCL_SPACE | TCL_COMMAND_END))) {
+ Tcl_DStringInit(&textBuffer);
+ maxDepth = 0;
+ numObjsToConcat = 0;
+ for ( ; count > 0; count--, tokenPtr++) {
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_TEXT:
+ Tcl_DStringAppend(&textBuffer, tokenPtr->start,
+ tokenPtr->size);
+ break;
+
+ case TCL_TOKEN_BS:
+ length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
+ buffer);
+ Tcl_DStringAppend(&textBuffer, buffer, length);
+ break;
+
+ case TCL_TOKEN_COMMAND:
/*
- * The word is "simple": just a sequence of characters
- * without backslashes terminated by a TCL_SPACE or
- * TCL_COMMAND_END. Just return if we are not to compile
- * simple words.
+ * Push any accumulated chars appearing before the command.
*/
-
- simpleWord = 1;
- if (!envPtr->pushSimpleWords) {
- envPtr->wordIsSimple = 1;
- envPtr->numSimpleWordChars = (src - string);
- envPtr->termOffset = envPtr->numSimpleWordChars;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return TCL_OK;
+
+ if (Tcl_DStringLength(&textBuffer) > 0) {
+ int literal;
+
+ literal = TclRegisterLiteral(envPtr,
+ Tcl_DStringValue(&textBuffer),
+ Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
+ TclEmitPush(literal, envPtr);
+ numObjsToConcat++;
+ maxDepth = TclMax(numObjsToConcat, maxDepth);
+ Tcl_DStringFree(&textBuffer);
}
- }
-
- /*
- * Create and push a string object for the char+ word_part,
- * which starts at "start" and ends at the char just before
- * src. If backslashes were found, copy the word_part's
- * characters with substituted backslashes into a heap-allocated
- * buffer and use it to create the string object. Temporarily
- * replace the terminating character with a null character.
- */
+
+ code = TclCompileScript(interp, tokenPtr->start+1,
+ tokenPtr->size-2, /*nested*/ 1, envPtr);
+ if (code != TCL_OK) {
+ goto error;
+ }
+ maxDepth = TclMax((numObjsToConcat + envPtr->maxStackDepth),
+ maxDepth);
+ numObjsToConcat++;
+ break;
- numChars = (src - start);
- savedChar = start[numChars];
- start[numChars] = '\0';
- if ((numChars > 0) && (hasBackslash)) {
- char *buffer = ckalloc((unsigned) numChars + 1);
- register char *dst = buffer;
- register char *p = start;
- while (p < src) {
- if (*p == '\\') {
- *dst = Tcl_Backslash(p, &numRead);
- if (p[1] == '\n') {
- break;
- }
- p += numRead;
- dst++;
- } else {
- *dst++ = *p++;
- }
+ case TCL_TOKEN_VARIABLE:
+ /*
+ * Push any accumulated chars appearing before the $<var>.
+ */
+
+ if (Tcl_DStringLength(&textBuffer) > 0) {
+ int literal;
+
+ literal = TclRegisterLiteral(envPtr,
+ Tcl_DStringValue(&textBuffer),
+ Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
+ TclEmitPush(literal, envPtr);
+ numObjsToConcat++;
+ maxDepth = TclMax(numObjsToConcat, maxDepth);
+ Tcl_DStringFree(&textBuffer);
}
- *dst = '\0';
- objIndex = TclObjIndexForString(buffer, dst-buffer,
- /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
- } else {
- objIndex = TclObjIndexForString(start, numChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- }
- start[numChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = TclMax((numParts + 1), maxDepth);
- } else if (type == TCL_DOLLAR) {
- result = TclCompileDollarVar(interp, src, lastChar,
- flags, envPtr);
- src += envPtr->termOffset;
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
- c = *src;
- type = CHAR_TYPE(src, lastChar);
- } else if (type == TCL_OPEN_BRACKET) {
- char *termPtr;
- envPtr->pushSimpleWords = 1;
- src++;
- result = TclCompileString(interp, src, lastChar,
- (flags | TCL_BRACKET_TERM), envPtr);
- termPtr = (src + envPtr->termOffset);
- if (*termPtr == ']') {
- termPtr++;
- } else if (*termPtr == '\0') {
+
/*
- * Missing ] at end of nested command.
+ * Check if the name contains any namespace qualifiers.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "missing close-bracket", -1);
- result = TCL_ERROR;
- }
- src = termPtr;
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
- c = *src;
- type = CHAR_TYPE(src, lastChar);
- } else if (type & (TCL_SPACE | TCL_COMMAND_END)) {
- goto wordEnd;
- }
- numParts++;
- } /* end of infinite loop */
-
- wordEnd:
- /*
- * End of a non-simple word: TCL_SPACE, TCL_COMMAND_END, or
- * backslash-newline. Concatenate the word_parts if necessary.
- */
-
- while (numParts > 255) {
- TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
- numParts -= 254; /* concat pushes 1 obj, the result */
- }
- if (numParts > 1) {
- TclEmitInstUInt1(INST_CONCAT1, numParts, envPtr);
- }
-
- done:
- if (simpleWord) {
- envPtr->wordIsSimple = 1;
- envPtr->numSimpleWordChars = (src - string);
- } else {
- envPtr->wordIsSimple = 0;
- envPtr->numSimpleWordChars = 0;
- }
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileQuotes --
- *
- * This procedure compiles a double-quoted string such as a quoted Tcl
- * command argument or a quoted value in a Tcl expression. This
- * procedure is also used to compile array element names within
- * parentheses (where the termChar will be ')' instead of '"'), or
- * anything else that needs the substitutions that happen in quotes.
- *
- * Ordinarily, callers set envPtr->pushSimpleWords to 1 and
- * TclCompileQuotes always emits push and other instructions to compute
- * the word on the Tcl evaluation stack at execution time. If a caller
- * sets envPtr->pushSimpleWords to 0, TclCompileQuotes will not compile
- * "simple" words: words that are just a sequence of characters without
- * backslashes. It will leave their compilation up to the caller. This
- * is done to provide special support for the first word of commands,
- * which are almost always the (simple) name of a command.
- *
- * As an important special case, if the word is simple, this procedure
- * sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
- * number of characters in the simple word. This allows the caller to
- * process these words specially.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing the quoted string. If an error
- * occurs then the interpreter's result contains a standard error
- * message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed; this is
- * usually the character just after the matching close-quote.
- *
- * envPtr->wordIsSimple is set 1 if the word is simple: just a
- * sequence of characters without backslashes. If so, the word's
- * characters are the envPtr->numSimpleWordChars characters starting
- * at string.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to evaluate the word. This is not changed if
- * the word is simple and envPtr->pushSimpleWords was 0 (false).
- *
- * Side effects:
- * Instructions are added to envPtr to push the quoted-string
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileQuotes(interp, string, lastChar, termChar, flags, envPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* Points to the character just after
- * the opening '"' or '('. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int termChar; /* Character that terminates the "quoted"
- * string (usually double-quote, but might
- * be right-paren or something else). */
- int flags; /* Flags to control compilation (same
- * values passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds the resulting instructions. */
-{
- register char *src = string; /* Points to current source char. */
- register char c = *src; /* The current char. */
- int simpleWord = 0; /* Set 1 if a simple quoted string word. */
- char *start; /* Start position of char+ string_part. */
- int hasBackslash; /* 1 if '\' found in char+ string_part. */
- int numRead; /* Count of chars read by Tcl_Backslash. */
- int numParts = 0; /* Count of string_part objs pushed. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to compute and push the string. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null
- * char during string_part processing. */
- int objIndex; /* The object array index for a pushed
- * object holding a string_part. */
- int numChars; /* Number of chars in string_part. */
- int savePushSimpleWords = envPtr->pushSimpleWords;
- int result = TCL_OK;
-
- /*
- * quoted_string: '"' string_part* '"' (or termChar instead of ")
- * string_part: var_reference | nested_cmd | char+
- */
-
+ name = tokenPtr[1].start;
+ nameBytes = tokenPtr[1].size;
+ hasNsQualifiers = 0;
+ for (i = 0, p = name; i < nameBytes; i++, p++) {
+ if ((*p == ':') && (i < (nameBytes-1))
+ && (*(p+1) == ':')) {
+ hasNsQualifiers = 1;
+ break;
+ }
+ }
- while ((src != lastChar) && (c != termChar)) {
- if (c == '$') {
- result = TclCompileDollarVar(interp, src, lastChar, flags,
- envPtr);
- src += envPtr->termOffset;
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
- c = *src;
- } else if (c == '[') {
- char *termPtr;
- envPtr->pushSimpleWords = 1;
- src++;
- result = TclCompileString(interp, src, lastChar,
- (flags | TCL_BRACKET_TERM), envPtr);
- termPtr = (src + envPtr->termOffset);
- if (*termPtr == ']') {
- termPtr++;
- }
- src = termPtr;
- if (result != TCL_OK) {
- goto done;
- }
- if (termPtr == lastChar) {
/*
- * Missing ] at end of nested command.
+ * Either push the variable's name, or find its index in
+ * the array of local variables in a procedure frame.
*/
-
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "missing close-bracket", -1);
- result = TCL_ERROR;
- goto done;
- }
- maxDepth = TclMax((numParts + envPtr->maxStackDepth), maxDepth);
- c = *src;
- } else {
- /*
- * Start of a char+ string_part. Scan first looking for any
- * backslashes.
- */
- start = src;
- hasBackslash = 0;
- do {
- if (c == '\\') {
- hasBackslash = 1;
- Tcl_Backslash(src, &numRead);
- src += numRead;
+ depthForVar = 0;
+ if ((envPtr->procPtr == NULL) || hasNsQualifiers) {
+ localVar = -1;
+ TclEmitPush(TclRegisterLiteral(envPtr, name, nameBytes,
+ /*onHeap*/ 0), envPtr);
+ depthForVar = 1;
} else {
- src++;
+ localVar = TclFindCompiledLocal(name, nameBytes,
+ /*create*/ 0, /*flags*/ 0, envPtr->procPtr);
+ if (localVar < 0) {
+ TclEmitPush(TclRegisterLiteral(envPtr, name,
+ nameBytes, /*onHeap*/ 0), envPtr);
+ depthForVar = 1;
+ }
}
- c = *src;
- } while ((src != lastChar) && (c != '$') && (c != '[')
- && (c != termChar));
-
- if ((numParts == 0) && !hasBackslash
- && ((src == lastChar) && (c == termChar))) {
+
/*
- * The quoted string is "simple": just a sequence of
- * characters without backslashes terminated by termChar or
- * a null character. Just return if we are not to compile
- * simple words.
+ * Emit instructions to load the variable.
*/
-
- simpleWord = 1;
- if (!envPtr->pushSimpleWords) {
- if ((src == lastChar) && (termChar != '\0')) {
- char buf[40];
- sprintf(buf, "missing %c", termChar);
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
- result = TCL_ERROR;
+
+ if (tokenPtr->numComponents == 1) {
+ if (localVar < 0) {
+ TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
+ } else if (localVar <= 255) {
+ TclEmitInstInt1(INST_LOAD_SCALAR1, localVar,
+ envPtr);
} else {
- src++;
+ TclEmitInstInt4(INST_LOAD_SCALAR4, localVar,
+ envPtr);
}
- envPtr->wordIsSimple = 1;
- envPtr->numSimpleWordChars = (src - string - 1);
- envPtr->termOffset = (src - string);
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
- }
- }
-
- /*
- * Create and push a string object for the char+ string_part
- * that starts at "start" and ends at the char just before
- * src. If backslashes were found, copy the string_part's
- * characters with substituted backslashes into a heap-allocated
- * buffer and use it to create the string object. Temporarily
- * replace the terminating character with a null character.
- */
-
- numChars = (src - start);
- savedChar = start[numChars];
- start[numChars] = '\0';
- if ((numChars > 0) && (hasBackslash)) {
- char *buffer = ckalloc((unsigned) numChars + 1);
- register char *dst = buffer;
- register char *p = start;
- while (p < src) {
- if (*p == '\\') {
- *dst++ = Tcl_Backslash(p, &numRead);
- p += numRead;
+ } else {
+ code = TclCompileTokens(interp, tokenPtr+2,
+ tokenPtr->numComponents-1, envPtr);
+ if (code != TCL_OK) {
+ sprintf(buffer,
+ "\n (parsing index for array \"%.*s\")",
+ ((nameBytes > 100)? 100 : nameBytes), name);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ goto error;
+ }
+ depthForVar += envPtr->maxStackDepth;
+ if (localVar < 0) {
+ TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
+ } else if (localVar <= 255) {
+ TclEmitInstInt1(INST_LOAD_ARRAY1, localVar,
+ envPtr);
} else {
- *dst++ = *p++;
+ TclEmitInstInt4(INST_LOAD_ARRAY4, localVar,
+ envPtr);
}
}
- *dst = '\0';
- objIndex = TclObjIndexForString(buffer, (dst - buffer),
- /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
- } else {
- objIndex = TclObjIndexForString(start, numChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- }
- start[numChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = TclMax((numParts + 1), maxDepth);
- }
- numParts++;
- }
-
- /*
- * End of the quoted string: src points at termChar or '\0'. If
- * necessary, concatenate the string_part objects on the stack.
- */
-
- if ((src == lastChar) && (termChar != '\0')) {
- char buf[40];
- sprintf(buf, "missing %c", termChar);
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
- result = TCL_ERROR;
- goto done;
- } else {
- src++;
- }
-
- if (numParts == 0) {
- /*
- * The quoted string was empty. Push an empty string object.
- */
+ maxDepth = TclMax(numObjsToConcat + depthForVar, maxDepth);
+ numObjsToConcat++;
+ count -= tokenPtr->numComponents;
+ tokenPtr += tokenPtr->numComponents;
+ break;
- int objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- TclEmitPush(objIndex, envPtr);
- } else {
- /*
- * Emit any needed concat instructions.
- */
-
- while (numParts > 255) {
- TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
- numParts -= 254; /* concat pushes 1 obj, the result */
- }
- if (numParts > 1) {
- TclEmitInstUInt1(INST_CONCAT1, numParts, envPtr);
+ default:
+ panic("Unexpected token type in TclCompileTokens");
}
}
- done:
- if (simpleWord) {
- envPtr->wordIsSimple = 1;
- envPtr->numSimpleWordChars = (src - string - 1);
- } else {
- envPtr->wordIsSimple = 0;
- envPtr->numSimpleWordChars = 0;
- }
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * CompileBraces --
- *
- * This procedure compiles characters between matching curly braces.
- *
- * Ordinarily, callers set envPtr->pushSimpleWords to 1 and
- * CompileBraces always emits a push instruction to compute the word on
- * the Tcl evaluation stack at execution time. However, if a caller
- * sets envPtr->pushSimpleWords to 0, CompileBraces will _not_ compile
- * "simple" words: words that are just a sequence of characters without
- * backslash-newlines. It will leave their compilation up to the
- * caller.
- *
- * As an important special case, if the word is simple, this procedure
- * sets envPtr->wordIsSimple to 1 and envPtr->numSimpleWordChars to the
- * number of characters in the simple word. This allows the caller to
- * process these words specially.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed. This is
- * usually the character just after the matching close-brace.
- *
- * envPtr->wordIsSimple is set 1 if the word is simple: just a
- * sequence of characters without backslash-newlines. If so, the word's
- * characters are the envPtr->numSimpleWordChars characters starting
- * at string.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to evaluate the word. This is not changed if
- * the word is simple and envPtr->pushSimpleWords was 0 (false).
- *
- * Side effects:
- * Instructions are added to envPtr to push the braced string
- * at runtime.
- *
- *--------------------------------------------------------------
- */
-
-static int
-CompileBraces(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* Character just after opening bracket. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same
- * values passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds the resulting instructions. */
-{
- register char *src = string; /* Points to current source char. */
- register char c; /* The current char. */
- int simpleWord = 0; /* Set 1 if a simple braced string word. */
- int level = 1; /* {} nesting level. Initially 1 since {
- * was parsed before we were called. */
- int hasBackslashNewline = 0; /* Nonzero if '\' found. */
- char *last; /* Points just before terminating '}'. */
- int numChars; /* Number of chars in braced string. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null
- * char during braced string processing. */
- int objIndex; /* The object array index for a pushed
- * object holding a braced string. */
- int numRead;
- int result = TCL_OK;
-
/*
- * Check for any backslash-newlines, since we must treat
- * backslash-newlines specially (they must be replaced by spaces).
+ * Push any accumulated characters appearing at the end.
*/
- while (1) {
- c = *src;
- if (src == lastChar) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "missing close-brace", -1);
- result = TCL_ERROR;
- goto done;
- }
- if (CHAR_TYPE(src, lastChar) != TCL_NORMAL) {
- if (c == '{') {
- level++;
- } else if (c == '}') {
- --level;
- if (level == 0) {
- src++;
- last = (src - 2); /* point just before terminating } */
- break;
- }
- } else if (c == '\\') {
- if (*(src+1) == '\n') {
- hasBackslashNewline = 1;
- }
- (void) Tcl_Backslash(src, &numRead);
- src += numRead - 1;
- }
- }
- src++;
- }
+ if (Tcl_DStringLength(&textBuffer) > 0) {
+ int literal;
- if (!hasBackslashNewline) {
- /*
- * The braced word is "simple": just a sequence of characters
- * without backslash-newlines. Just return if we are not to compile
- * simple words.
- */
-
- simpleWord = 1;
- if (!envPtr->pushSimpleWords) {
- envPtr->wordIsSimple = 1;
- envPtr->numSimpleWordChars = (src - string - 1);
- envPtr->termOffset = (src - string);
- return TCL_OK;
- }
+ literal = TclRegisterLiteral(envPtr, Tcl_DStringValue(&textBuffer),
+ Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
+ TclEmitPush(literal, envPtr);
+ numObjsToConcat++;
+ maxDepth = TclMax(numObjsToConcat, maxDepth);
}
/*
- * Create and push a string object for the braced string. This starts at
- * "string" and ends just after "last" (which points to the final
- * character before the terminating '}'). If backslash-newlines were
- * found, we copy characters one at a time into a heap-allocated buffer
- * and do backslash-newline substitutions.
+ * If necessary, concatenate the parts of the word.
*/
- numChars = (last - string + 1);
- savedChar = string[numChars];
- string[numChars] = '\0';
- if ((numChars > 0) && (hasBackslashNewline)) {
- char *buffer = ckalloc((unsigned) numChars + 1);
- register char *dst = buffer;
- register char *p = string;
- while (p <= last) {
- c = *dst++ = *p++;
- if (c == '\\') {
- if (*p == '\n') {
- dst[-1] = Tcl_Backslash(p-1, &numRead);
- p += numRead - 1;
- } else {
- (void) Tcl_Backslash(p-1, &numRead);
- while (numRead > 1) {
- *dst++ = *p++;
- numRead--;
- }
- }
- }
- }
- *dst = '\0';
- objIndex = TclObjIndexForString(buffer, (dst - buffer),
- /*allocStrRep*/ 1, /*inHeap*/ 1, envPtr);
- } else {
- objIndex = TclObjIndexForString(string, numChars, /*allocStrRep*/ 1,
- /*inHeap*/ 0, envPtr);
+ while (numObjsToConcat > 255) {
+ TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ numObjsToConcat -= 254; /* concat pushes 1 obj, the result */
}
- string[numChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
-
- done:
- if (simpleWord) {
- envPtr->wordIsSimple = 1;
- envPtr->numSimpleWordChars = (src - string - 1);
- } else {
- envPtr->wordIsSimple = 0;
- envPtr->numSimpleWordChars = 0;
- }
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = 1;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileDollarVar --
- *
- * Given a string starting with a $ sign, parse a variable name
- * and compile instructions to push its value. If the variable
- * reference is just a '$' (i.e. the '$' isn't followed by anything
- * that could possibly be a variable name), just push a string object
- * containing '$'.
- *
- * Results:
- * The return value is a standard Tcl result. If an error occurs
- * then an error message is left in the interpreter's result.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one in the variable reference.
- *
- * envPtr->wordIsSimple is set 0 (false) because the word is not
- * simple: it is not just a sequence of characters without backslashes.
- * For the same reason, envPtr->numSimpleWordChars is set 0.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the string's commands.
- *
- * Side effects:
- * Instructions are added to envPtr to look up the variable and
- * push its value at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileDollarVar(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* First char (i.e. $) of var reference. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same
- * values passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds the resulting instructions. */
-{
- register char *src = string; /* Points to current source char. */
- register char c; /* The current char. */
- char *name; /* Start of 1st part of variable name. */
- int nameChars; /* Count of chars in name. */
- int nameHasNsSeparators = 0; /* Set 1 if name contains "::"s. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null
- * char during name processing. */
- int objIndex; /* The object array index for a pushed
- * object holding a name part. */
- int isArrayRef = 0; /* 1 if reference to array element. */
- int localIndex = -1; /* Frame index of local if found. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to push the variable. */
- int savePushSimpleWords = envPtr->pushSimpleWords;
- int result = TCL_OK;
-
- /*
- * var_reference: '$' '{' braced_name '}' |
- * '$' name ['(' index_string ')']
- *
- * There are three cases:
- * 1. The $ sign is followed by an open curly brace. Then the variable
- * name is everything up to the next close curly brace, and the
- * variable is a scalar variable.
- * 2. The $ sign is not followed by an open curly brace. Then the
- * variable name is everything up to the next character that isn't
- * a letter, digit, underscore, or a "::" namespace separator. If the
- * following character is an open parenthesis, then the information
- * between parentheses is the array element name, which can include
- * any of the substitutions permissible between quotes.
- * 3. The $ sign is followed by something that isn't a letter, digit,
- * underscore, or a "::" namespace separator: in this case,
- * there is no variable name, and "$" is pushed.
- */
-
- src++; /* advance over the '$'. */
-
- /*
- * Collect the first part of the variable's name into "name" and
- * determine if it is an array reference and if it contains any
- * namespace separator (::'s).
- */
-
- if (*src == '{') {
- /*
- * A scalar name in braces.
- */
-
- char *p;
-
- src++;
- name = src;
- c = *src;
- while (c != '}') {
- if (src == lastChar) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "missing close-brace for variable name", -1);
- result = TCL_ERROR;
- goto done;
- }
- src++;
- c = *src;
- }
- nameChars = (src - name);
- for (p = name; p < src; p++) {
- if ((*p == ':') && (*(p+1) == ':')) {
- nameHasNsSeparators = 1;
- break;
- }
- }
- src++; /* advance over the '}'. */
- } else {
- /*
- * Scalar name or array reference not in braces.
- */
-
- name = src;
- c = *src;
- while (isalnum(UCHAR(c)) || (c == '_') || (c == ':')) {
- if (c == ':') {
- if (*(src+1) == ':') {
- nameHasNsSeparators = 1;
- src += 2;
- while (*src == ':') {
- src++;
- }
- c = *src;
- } else {
- break; /* : by itself */
- }
- } else {
- src++;
- c = *src;
- }
- }
- if (src == name) {
- /*
- * A '$' by itself, not a name reference. Push a "$" string.
- */
-
- objIndex = TclObjIndexForString("$", 1, /*allocStrRep*/ 1,
- /*inHeap*/ 0, envPtr);
- TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
- goto done;
- }
- nameChars = (src - name);
- isArrayRef = (c == '(');
+ if (numObjsToConcat > 1) {
+ TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
}
/*
- * Now emit instructions to load the variable. First either push the
- * name of the scalar or array, or determine its index in the array of
- * local variables in a procedure frame. Push the name if we are not
- * compiling a procedure body or if the name has namespace
- * qualifiers ("::"s).
+ * If the tokens yielded no instructions, push an empty string.
*/
- if (!isArrayRef) { /* scalar reference */
- if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
- savedChar = name[nameChars];
- name[nameChars] = '\0';
- objIndex = TclObjIndexForString(name, nameChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
- maxDepth = 1;
- } else {
- localIndex = LookupCompiledLocal(name, nameChars,
- /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
- envPtr->procPtr);
- if (localIndex >= 0) {
- if (localIndex <= 255) {
- TclEmitInstUInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
- } else {
- TclEmitInstUInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
- }
- maxDepth = 0;
- } else {
- savedChar = name[nameChars];
- name[nameChars] = '\0';
- objIndex = TclObjIndexForString(name, nameChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
- maxDepth = 1;
- }
- }
- } else { /* array reference */
- if ((envPtr->procPtr == NULL) || nameHasNsSeparators) {
- savedChar = name[nameChars];
- name[nameChars] = '\0';
- objIndex = TclObjIndexForString(name, nameChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
- } else {
- localIndex = LookupCompiledLocal(name, nameChars,
- /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
- envPtr->procPtr);
- if (localIndex < 0) {
- savedChar = name[nameChars];
- name[nameChars] = '\0';
- objIndex = TclObjIndexForString(name, nameChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
- }
- }
-
- /*
- * Parse and push the array element. Perform substitutions on it,
- * just as is done for quoted strings.
- */
-
- src++;
- envPtr->pushSimpleWords = 1;
- result = TclCompileQuotes(interp, src, lastChar, ')', flags,
- envPtr);
- src += envPtr->termOffset;
- if (result != TCL_OK) {
- char msg[200];
- sprintf(msg, "\n (parsing index for array \"%.*s\")",
- (nameChars > 100? 100 : nameChars), name);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- goto done;
- }
- maxDepth += envPtr->maxStackDepth;
-
- /*
- * Now emit the appropriate load instruction for the array element.
- */
-
- if (localIndex < 0) { /* a global or an unknown local */
- TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
- } else {
- if (localIndex <= 255) {
- TclEmitInstUInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
- } else {
- TclEmitInstUInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
- }
- }
+ if (envPtr->codeNext == entryCodeNext) {
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
+ envPtr);
+ maxDepth = 1;
}
-
- done:
- envPtr->termOffset = (src - string);
- envPtr->wordIsSimple = 0;
- envPtr->numSimpleWordChars = 0;
+ Tcl_DStringFree(&textBuffer);
envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * IsLocalScalar --
- *
- * Checks to see if a variable name refers to a local scalar.
- *
- * Results:
- * Returns 1 if the variable is a local scalar.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-IsLocalScalar(varName, length)
- char *varName; /* The name to check. */
- int length; /* The number of characters in the string. */
-{
- char *p;
- char *lastChar = varName + (length - 1);
-
- for (p = varName; p <= lastChar; p++) {
- if ((CHAR_TYPE(p, lastChar) != TCL_NORMAL) &&
- (CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)) {
- /*
- * TCL_COMMAND_END is returned for the last character
- * of the string. By this point we know it isn't
- * an array or namespace reference.
- */
-
- return 0;
- }
- if (*p == '(') {
- if (*lastChar == ')') { /* we have an array element */
- return 0;
- }
- } else if (*p == ':') {
- if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
- return 0;
- }
- }
- }
-
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileBreakCmd --
- *
- * Procedure called to compile the "break" command.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
- * Side effects:
- * Instructions are added to envPtr to evaluate the "break" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileBreakCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- register char *src = string;/* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int result = TCL_OK;
-
- /*
- * There should be no argument after the "break".
- */
-
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"break\"", -1);
- result = TCL_ERROR;
- goto done;
- }
- }
-
- /*
- * Emit a break instruction.
- */
-
- TclEmitOpcode(INST_BREAK, envPtr);
+ return TCL_OK;
- done:
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = 0;
- return result;
+ error:
+ Tcl_DStringFree(&textBuffer);
+ envPtr->maxStackDepth = maxDepth;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileCatchCmd --
+ * TclCompileCmdWord --
*
- * Procedure called to compile the "catch" command.
+ * Given an array of parse tokens for a word containing one or more Tcl
+ * commands, emit inline instructions to execute them. This procedure
+ * differs from TclCompileTokens in that a simple word such as a loop
+ * body enclosed in braces is not just pushed as a string, but is
+ * itself parsed into tokens and compiled.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If compilation failed because the command is too
- * complex for TclCompileCatchCmd, TCL_OUT_LINE_COMPILE is returned
- * indicating that the catch command should be compiled "out of line"
- * by emitting code to invoke its command procedure at runtime.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
+ * The return value is a standard Tcl result. If an error occurs, an
+ * error message is left in the interpreter's result.
+ *
* envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
+ * elements needed to execute the tokens.
*
* Side effects:
- * Instructions are added to envPtr to evaluate the "catch" command
- * at runtime.
+ * Instructions are added to envPtr to execute the tokens at runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileCatchCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+TclCompileCmdWord(interp, tokenPtr, count, envPtr)
+ Tcl_Interp *interp; /* Used for error and status reporting. */
+ Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
+ * for a command word to compile inline. */
+ int count; /* Number of tokens to consider at tokenPtr.
+ * Must be at least 1. */
+ CompileEnv *envPtr; /* Holds the resulting instructions. */
{
- Proc *procPtr = envPtr->procPtr;
- /* Points to structure describing procedure
- * containing the catch cmd, else NULL. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- ArgInfo argInfo; /* Structure holding information about the
- * start and end of each argument word. */
- int range = -1; /* If we compile the catch command, the
- * index for its catch range record in the
- * ExceptionRange array. -1 if we are not
- * compiling the command. */
- char *name; /* If a var name appears for a scalar local
- * to a procedure, this points to the name's
- * 1st char and nameChars is its length. */
- int nameChars; /* Length of the variable name, if any. */
- int localIndex = -1; /* Index of the variable in the current
- * procedure's array of local variables.
- * Otherwise -1 if not in a procedure or
- * the variable wasn't found. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null character
- * during processing of words. */
- JumpFixup jumpFixup; /* Used to emit the jump after the "no
- * errors" epilogue code. */
- int numWords, objIndex, jumpDist, result;
- char *bodyStart, *bodyEnd;
- Tcl_Obj *objPtr;
- int savePushSimpleWords = envPtr->pushSimpleWords;
-
- /*
- * Scan the words of the command and record the start and finish of
- * each argument word.
- */
-
- InitArgInfo(&argInfo);
- result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
- numWords = argInfo.numArgs; /* i.e., the # after the command name */
- if (result != TCL_OK) {
- goto done;
- }
- if ((numWords != 1) && (numWords != 2)) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"catch command ?varName?\"", -1);
- result = TCL_ERROR;
- goto done;
- }
-
- /*
- * If a variable was specified and the catch command is at global level
- * (not in a procedure), don't compile it inline: the payoff is
- * too small.
- */
-
- if ((numWords == 2) && (procPtr == NULL)) {
- result = TCL_OUT_LINE_COMPILE;
- goto done;
- }
+ int code;
/*
- * Make sure the variable name, if any, has no substitutions and just
- * refers to a local scaler.
- */
-
- if (numWords == 2) {
- char *firstChar = argInfo.startArray[1];
- char *lastChar = argInfo.endArray[1];
-
- if (*firstChar == '{') {
- if (*lastChar != '}') {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-brace", -1);
- result = TCL_ERROR;
- goto done;
- }
- firstChar++;
- lastChar--;
- }
-
- nameChars = (lastChar - firstChar + 1);
- if (!IsLocalScalar(firstChar, nameChars)) {
- result = TCL_OUT_LINE_COMPILE;
- goto done;
- }
-
- name = firstChar;
- localIndex = LookupCompiledLocal(name, nameChars,
- /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR,
- procPtr);
- }
-
- /*
- *==== At this point we believe we can compile the catch command ====
- */
-
- /*
- * Create and initialize a ExceptionRange record to hold information
- * about this catch command.
+ * Handle the common case: if there is a single text token, compile it
+ * into an inline sequence of instructions.
*/
- envPtr->excRangeDepth++;
- envPtr->maxExcRangeDepth =
- TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
- range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
-
- /*
- * Emit the instruction to mark the start of the catch command.
- */
-
- TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
-
- /*
- * Inline compile the catch's body word: the command it controls. Also
- * register the body's starting PC offset and byte length in the
- * ExceptionRange record.
- */
-
- envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
-
- bodyStart = argInfo.startArray[0];
- bodyEnd = argInfo.endArray[0];
- savedChar = *(bodyEnd+1);
- *(bodyEnd+1) = '\0';
- result = CompileCmdWordInline(interp, bodyStart, (bodyEnd+1),
- flags, envPtr);
- *(bodyEnd+1) = savedChar;
-
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- char msg[60];
- sprintf(msg, "\n (\"catch\" body line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- envPtr->excRangeArrayPtr[range].numCodeBytes =
- TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
-
- /*
- * Now emit the "no errors" epilogue code for the catch. First, if a
- * variable was specified, store the body's result into the
- * variable; otherwise, just discard the body's result. Then push
- * a "0" object as the catch command's "no error" TCL_OK result,
- * and jump around the "error case" epilogue code.
- */
-
- if (localIndex != -1) {
- if (localIndex <= 255) {
- TclEmitInstUInt1(INST_STORE_SCALAR1, localIndex, envPtr);
- } else {
- TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
- }
- }
- TclEmitOpcode(INST_POP, envPtr);
-
- objIndex = TclObjIndexForString("0", 1, /*allocStrRep*/ 0, /*inHeap*/ 0,
- envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = 0;
- objPtr->typePtr = &tclIntType;
-
- TclEmitPush(objIndex, envPtr);
- if (maxDepth == 0) {
- maxDepth = 1; /* since we just pushed one object */
- }
-
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
-
- /*
- * Now emit the "error case" epilogue code. First, if a variable was
- * specified, emit instructions to push the interpreter's object result
- * and store it into the variable. Then emit an instruction to push the
- * nonzero error result. Note that the initial PC offset here is the
- * catch's error target.
- */
-
- envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
- if (localIndex != -1) {
- TclEmitOpcode(INST_PUSH_RESULT, envPtr);
- if (localIndex <= 255) {
- TclEmitInstUInt1(INST_STORE_SCALAR1, localIndex, envPtr);
- } else {
- TclEmitInstUInt4(INST_STORE_SCALAR4, localIndex, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
- }
- TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
-
- /*
- * Now that we know the target of the jump after the "no errors"
- * epilogue, update it with the correct distance. This is less
- * than 127 bytes.
- */
-
- jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
- panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
+ envPtr->maxStackDepth = 0;
+ if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
+ code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
+ /*nested*/ 0, envPtr);
+ return code;
}
/*
- * Emit the instruction to mark the end of the catch command.
+ * Multiple tokens or the single token involves substitutions. Emit
+ * instructions to invoke the eval command procedure at runtime on the
+ * result of evaluating the tokens.
*/
- TclEmitOpcode(INST_END_CATCH, envPtr);
-
- done:
- if (numWords == 0) {
- envPtr->termOffset = 0;
- } else {
- envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+ code = TclCompileTokens(interp, tokenPtr, count, envPtr);
+ if (code != TCL_OK) {
+ return code;
}
- if (range != -1) { /* we compiled the catch command */
- envPtr->excRangeDepth--;
- }
- envPtr->pushSimpleWords = savePushSimpleWords;
- envPtr->maxStackDepth = maxDepth;
- FreeArgInfo(&argInfo);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileContinueCmd --
- *
- * Procedure called to compile the "continue" command.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
- * Side effects:
- * Instructions are added to envPtr to evaluate the "continue" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileContinueCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- register char *src = string;/* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int result = TCL_OK;
-
- /*
- * There should be no argument after the "continue".
- */
-
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"continue\"", -1);
- result = TCL_ERROR;
- goto done;
- }
- }
-
- /*
- * Emit a continue instruction.
- */
-
- TclEmitOpcode(INST_CONTINUE, envPtr);
-
- done:
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = 0;
- return result;
+ TclEmitOpcode(INST_EVAL_STK, envPtr);
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileExprCmd --
+ * TclCompileExprWords --
*
- * Procedure called to compile the "expr" command.
+ * Given an array of parse tokens representing one or more words that
+ * contain a Tcl expression, emit inline instructions to execute the
+ * expression. This procedure differs from TclCompileExpr in that it
+ * supports Tcl's two-level substitution semantics for expressions that
+ * appear as command words.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK
- * unless there was an error while parsing string. If an error occurs
- * then the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
+ * The return value is a standard Tcl result. If an error occurs, an
+ * error message is left in the interpreter's result.
+ *
* envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "expr" command.
+ * elements needed to execute the expression.
*
* Side effects:
- * Instructions are added to envPtr to evaluate the "expr" command
- * at runtime.
+ * Instructions are added to envPtr to execute the expression.
*
*----------------------------------------------------------------------
*/
int
-TclCompileExprCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
+ Tcl_Interp *interp; /* Used for error and status reporting. */
+ Tcl_Token *tokenPtr; /* Points to first in an array of word
+ * tokens tokens for the expression to
+ * compile inline. */
+ int numWords; /* Number of word tokens starting at
+ * tokenPtr. Must be at least 1. Each word
+ * token contains one or more subtokens. */
+ CompileEnv *envPtr; /* Holds the resulting instructions. */
{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- ArgInfo argInfo; /* Structure holding information about the
- * start and end of each argument word. */
- Tcl_DString buffer; /* Holds the concatenated expr command
- * argument words. */
- int firstWord; /* 1 if processing the first word; 0 if
- * processing subsequent words. */
- char *first, *last; /* Points to the first and last significant
- * chars of the concatenated expression. */
- int inlineCode; /* 1 if inline "optimistic" code is
- * emitted for the expression; else 0. */
- int range = -1; /* If we inline compile the concatenated
- * expression, the index for its catch range
- * record in the ExceptionRange array.
- * Initialized to avoid compile warning. */
- JumpFixup jumpFixup; /* Used to emit the "success" jump after
- * the inline concat. expression's code. */
- char savedChar; /* Holds the character termporarily replaced
- * by a null character during compilation
- * of the concatenated expression. */
- int numWords, objIndex, i, result;
- char *wordStart, *wordEnd, *p;
- char c;
- int savePushSimpleWords = envPtr->pushSimpleWords;
+ Tcl_Token *wordPtr;
+ int maxDepth, range, numBytes, i, code;
+ char *script;
int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
int saveExprIsComparison = envPtr->exprIsComparison;
- /*
- * Scan the words of the command and record the start and finish of
- * each argument word.
- */
-
- InitArgInfo(&argInfo);
- result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
- numWords = argInfo.numArgs; /* i.e., the # after the command name */
- if (result != TCL_OK) {
- goto done;
- }
- if (numWords == 0) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"expr arg ?arg ...?\"", -1);
- result = TCL_ERROR;
- goto done;
- }
-
- /*
- * If there is a single argument word and it is enclosed in {}s, we may
- * strip them off and safely compile the expr command into an inline
- * sequence of instructions using TclCompileExpr. We know these
- * instructions will have the right Tcl7.x expression semantics.
- *
- * Otherwise, if the word is not enclosed in {}s, or there are multiple
- * words, we may need to call the expr command (Tcl_ExprObjCmd) at
- * runtime. This recompiles the expression each time (typically) and so
- * is slow. However, there are some circumstances where we can still
- * compile inline instructions "optimistically" and check, during their
- * execution, for double substitutions (these appear as nonnumeric
- * operands). We check for any backslash or command substitutions. If
- * none appear, and only variable substitutions are found, we generate
- * inline instructions. If there is a compilation error, we must emit
- * instructions that return the error at runtime, since this is when
- * scripts in Tcl7.x would "see" the error.
- *
- * For now, if there are multiple words, or the single argument word is
- * not in {}s, we concatenate the argument words and strip off any
- * enclosing {}s or ""s. We call the expr command at runtime if
- * either command or backslash substitutions appear (but not if
- * only variable substitutions appear).
- */
-
- if (numWords == 1) {
- wordStart = argInfo.startArray[0]; /* start of 1st arg word */
- wordEnd = argInfo.endArray[0]; /* last char of 1st arg word */
- if ((*wordStart == '{') && (*wordEnd == '}')) {
- /*
- * Simple case: a single argument word in {}'s.
- */
-
- *wordEnd = '\0';
- result = TclCompileExpr(interp, (wordStart + 1), wordEnd,
- flags, envPtr);
- *wordEnd = '}';
-
- envPtr->termOffset = (wordEnd + 1) - string;
- envPtr->pushSimpleWords = savePushSimpleWords;
- FreeArgInfo(&argInfo);
- return result;
- }
- }
-
- /*
- * There are multiple words or no braces around the single word.
- * Concatenate the expression's argument words while stripping off
- * any enclosing {}s or ""s.
- */
-
- Tcl_DStringInit(&buffer);
- firstWord = 1;
- for (i = 0; i < numWords; i++) {
- wordStart = argInfo.startArray[i];
- wordEnd = argInfo.endArray[i];
- if (((*wordStart == '{') && (*wordEnd == '}'))
- || ((*wordStart == '"') && (*wordEnd == '"'))) {
- wordStart++;
- wordEnd--;
- }
- if (!firstWord) {
- Tcl_DStringAppend(&buffer, " ", 1);
- }
- firstWord = 0;
- if (wordEnd >= wordStart) {
- Tcl_DStringAppend(&buffer, wordStart, (wordEnd-wordStart+1));
- }
- }
+ envPtr->maxStackDepth = 0;
+ maxDepth = 0;
+ range = -1;
+ code = TCL_OK;
/*
- * Scan the concatenated expression's characters looking for any
- * '['s or (for now) '\'s. If any are found, just call the expr cmd
- * at runtime.
+ * If the expression is a single word that doesn't require
+ * substitutions, just compile it's string into inline instructions.
*/
-
- inlineCode = 1;
- first = Tcl_DStringValue(&buffer);
- last = first + (Tcl_DStringLength(&buffer) - 1);
- for (p = first; p <= last; p++) {
- c = *p;
- if ((c == '[') || (c == '\\')) {
- inlineCode = 0;
- break;
- }
- }
- if (inlineCode) {
- /*
- * Inline compile the concatenated expression inside a "catch"
- * so that a runtime error will back off to a (slow) call on expr.
- */
-
- int startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- int startRangeNext = envPtr->excRangeArrayNext;
-
- /*
- * Create a ExceptionRange record to hold information about the
- * "catch" range for the expression's inline code. Also emit the
- * instruction to mark the start of the range.
- */
-
- envPtr->excRangeDepth++;
- envPtr->maxExcRangeDepth =
- TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
- range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
- TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
-
+ if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
/*
- * Inline compile the concatenated expression.
+ * Temporarily overwrite the character just after the end of the
+ * string with a 0 byte.
*/
-
- envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
- savedChar = *(last + 1);
- *(last + 1) = '\0';
- result = TclCompileExpr(interp, first, last + 1, flags, envPtr);
- *(last + 1) = savedChar;
-
- maxDepth = envPtr->maxStackDepth;
- envPtr->excRangeArrayPtr[range].numCodeBytes =
- TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
-
- if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
- || (envPtr->exprIsComparison)) {
- /*
- * We must call the expr command at runtime. Either there was a
- * compilation error or the inline code might fail to give the
- * correct 2 level substitution semantics.
- *
- * The latter can happen if the expression consisted of just a
- * single variable reference or if the top-level operator in the
- * expr is a comparison (which might operate on strings). In the
- * latter case, the expression's code might execute (apparently)
- * successfully but produce the wrong result. We depend on its
- * execution failing if a second level of substitutions is
- * required. This causes the "catch" code we generate around the
- * inline code to back off to a call on the expr command at
- * runtime, and this always gives the right 2 level substitution
- * semantics.
- *
- * We delete the inline code by backing up the code pc and catch
- * index. Note that if there was a compilation error, we can't
- * report the error yet since the expression might be valid
- * after the second round of substitutions.
- */
-
- envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
- envPtr->excRangeArrayNext = startRangeNext;
- inlineCode = 0;
- } else {
- TclEmitOpcode(INST_END_CATCH, envPtr); /* for ok case */
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
- TclEmitOpcode(INST_END_CATCH, envPtr); /* for error case */
- }
+
+ script = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+ code = TclCompileExpr(interp, script, numBytes, envPtr);
+ return code;
}
-
+
/*
- * Emit code for the (slow) call on the expr command at runtime.
- * Generate code to concatenate the (already substituted once)
- * expression words with a space between each word.
+ * Emit code to call the expr command proc at runtime. Concatenate the
+ * (already substituted once) expr tokens with a space between each.
*/
-
+
+ wordPtr = tokenPtr;
for (i = 0; i < numWords; i++) {
- wordStart = argInfo.startArray[i];
- wordEnd = argInfo.endArray[i];
- savedChar = *(wordEnd + 1);
- *(wordEnd + 1) = '\0';
- envPtr->pushSimpleWords = 1;
- result = CompileWord(interp, wordStart, wordEnd+1, flags, envPtr);
- *(wordEnd + 1) = savedChar;
- if (result != TCL_OK) {
+ code = TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents,
+ envPtr);
+ if (code != TCL_OK) {
break;
}
- if (i != (numWords - 1)) {
- objIndex = TclObjIndexForString(" ", 1, /*allocStrRep*/ 1,
- /*inHeap*/ 0, envPtr);
- TclEmitPush(objIndex, envPtr);
+ if (i < (numWords - 1)) {
+ TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
+ envPtr);
maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
} else {
maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
}
+ wordPtr += (wordPtr->numComponents + 1);
}
- if (result == TCL_OK) {
+ if (code == TCL_OK) {
int concatItems = 2*numWords - 1;
while (concatItems > 255) {
- TclEmitInstUInt1(INST_CONCAT1, 255, envPtr);
- concatItems -= 254; /* concat pushes 1 obj, the result */
+ TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ concatItems -= 254;
}
if (concatItems > 1) {
- TclEmitInstUInt1(INST_CONCAT1, concatItems, envPtr);
+ TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
}
TclEmitOpcode(INST_EXPR_STK, envPtr);
}
-
- /*
- * If emitting inline code, update the target of the jump after
- * that inline code.
- */
-
- if (inlineCode) {
- int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
- /*
- * Update the inline expression code's catch ExceptionRange
- * target since it, being after the jump, also moved down.
- */
-
- envPtr->excRangeArrayPtr[range].catchOffset += 3;
- }
- }
- Tcl_DStringFree(&buffer);
-
- done:
- if (numWords == 0) {
- envPtr->termOffset = 0;
- } else {
- envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
- }
- if (range != -1) { /* we inline compiled the expr */
- envPtr->excRangeDepth--;
- }
- envPtr->pushSimpleWords = savePushSimpleWords;
+
envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
envPtr->exprIsComparison = saveExprIsComparison;
envPtr->maxStackDepth = maxDepth;
- FreeArgInfo(&argInfo);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileForCmd --
- *
- * Procedure called to compile the "for" command.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
- * Side effects:
- * Instructions are added to envPtr to evaluate the "for" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileForCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- ArgInfo argInfo; /* Structure holding information about the
- * start and end of each argument word. */
- int range1 = -1, range2; /* Indexes in the ExceptionRange array of
- * the loop ranges for this loop: one for
- * its body and one for its "next" cmd. */
- JumpFixup jumpFalseFixup; /* Used to update or replace the ifFalse
- * jump after the "for" test when its target
- * PC is determined. */
- int jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist, objIndex;
- unsigned char *jumpPc;
- int savePushSimpleWords = envPtr->pushSimpleWords;
- int numWords, result;
-
- /*
- * Scan the words of the command and record the start and finish of
- * each argument word.
- */
-
- InitArgInfo(&argInfo);
- result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
- numWords = argInfo.numArgs; /* i.e., the # after the command name */
- if (result != TCL_OK) {
- goto done;
- }
- if (numWords != 4) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"for start test next command\"", -1);
- result = TCL_ERROR;
- goto done;
- }
-
- /*
- * If the test expression is not enclosed in braces, don't compile
- * the for inline. As a result of Tcl's two level substitution
- * semantics for expressions, the expression might have a constant
- * value that results in the loop never executing, or executing forever.
- * Consider "set x 0; for {} "$x > 5" {incr x} {}": the loop body
- * should never be executed.
- * NOTE: This is an overly aggressive test, since there are legitimate
- * literals that could be compiled but aren't in braces. However, until
- * the parser is integrated in 8.1, this is the simplest implementation.
- */
-
- if (*(argInfo.startArray[1]) != '{') {
- result = TCL_OUT_LINE_COMPILE;
- goto done;
- }
-
- /*
- * Create a ExceptionRange record for the for loop's body. This is used
- * to implement break and continue commands inside the body.
- * Then create a second ExceptionRange record for the "next" command in
- * order to implement break (but not continue) inside it. The second,
- * "next" ExceptionRange will always have a -1 continueOffset.
- */
-
- envPtr->excRangeDepth++;
- envPtr->maxExcRangeDepth =
- TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
- range1 = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
- range2 = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
-
- /*
- * Compile inline the next word: the initial command.
- */
-
- result = CompileCmdWordInline(interp, argInfo.startArray[0],
- (argInfo.endArray[0] + 1), flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp, "\n (\"for\" initial command)", -1);
- }
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
-
- /*
- * Discard the start command's result.
- */
-
- TclEmitOpcode(INST_POP, envPtr);
-
- /*
- * Compile the next word: the test expression.
- */
-
- testCodeOffset = TclCurrCodeOffset();
- envPtr->pushSimpleWords = 1; /* process words normally */
- result = CompileExprWord(interp, argInfo.startArray[1],
- (argInfo.endArray[1] + 1), flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp, "\n (\"for\" test expression)", -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-
- /*
- * Emit the jump that terminates the for command if the test was
- * false. We emit a one byte (relative) jump here, and replace it later
- * with a four byte jump if the jump target is > 127 bytes away.
- */
-
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-
- /*
- * Compile the loop body word inline. Also register the loop body's
- * starting PC offset and byte length in the its ExceptionRange record.
- */
-
- envPtr->excRangeArrayPtr[range1].codeOffset = TclCurrCodeOffset();
- result = CompileCmdWordInline(interp, argInfo.startArray[3],
- (argInfo.endArray[3] + 1), flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- char msg[60];
- sprintf(msg, "\n (\"for\" body line %d)", interp->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- envPtr->excRangeArrayPtr[range1].numCodeBytes =
- (TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range1].codeOffset);
-
- /*
- * Discard the loop body's result.
- */
-
- TclEmitOpcode(INST_POP, envPtr);
-
- /*
- * Finally, compile the "next" subcommand word inline.
- */
-
- envPtr->excRangeArrayPtr[range1].continueOffset = TclCurrCodeOffset();
- envPtr->excRangeArrayPtr[range2].codeOffset = TclCurrCodeOffset();
- result = CompileCmdWordInline(interp, argInfo.startArray[2],
- (argInfo.endArray[2] + 1), flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp, "\n (\"for\" loop-end command)", -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- envPtr->excRangeArrayPtr[range2].numCodeBytes =
- TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range2].codeOffset;
-
- /*
- * Discard the "next" subcommand's result.
- */
-
- TclEmitOpcode(INST_POP, envPtr);
-
- /*
- * Emit the unconditional jump back to the test at the top of the for
- * loop. We generate a four byte jump if the distance to the test is
- * greater than 120 bytes. This is conservative, and ensures that we
- * won't have to replace this unconditional jump if we later need to
- * replace the ifFalse jump with a four-byte jump.
- */
-
- jumpBackOffset = TclCurrCodeOffset();
- jumpBackDist = (jumpBackOffset - testCodeOffset);
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
- }
-
- /*
- * Now that we know the target of the jumpFalse after the test, update
- * it with the correct distance. If the distance is too great (more
- * than 127 bytes), replace that jump with a four byte instruction and
- * move the instructions after the jump down.
- */
-
- jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
- /*
- * Update the loop body's ExceptionRange record since it moved down:
- * i.e., increment both its start and continue PC offsets. Also,
- * update the "next" command's start PC offset in its ExceptionRange
- * record since it also moved down.
- */
-
- envPtr->excRangeArrayPtr[range1].codeOffset += 3;
- envPtr->excRangeArrayPtr[range1].continueOffset += 3;
- envPtr->excRangeArrayPtr[range2].codeOffset += 3;
-
- /*
- * Update the distance for the unconditional jump back to the test
- * at the top of the loop since it moved down 3 bytes too.
- */
-
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- if (jumpBackDist > 120) {
- jumpBackDist += 3;
- TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
- jumpPc);
- } else {
- jumpBackDist += 3;
- TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
- jumpPc);
- }
- }
-
- /*
- * The current PC offset (after the loop's body and "next" subcommand)
- * is the loop's break target.
- */
-
- envPtr->excRangeArrayPtr[range1].breakOffset =
- envPtr->excRangeArrayPtr[range2].breakOffset = TclCurrCodeOffset();
-
- /*
- * Push an empty string object as the for command's result.
- */
-
- objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
- envPtr);
- TclEmitPush(objIndex, envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
-
- done:
- if (numWords == 0) {
- envPtr->termOffset = 0;
- } else {
- envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
- }
- envPtr->pushSimpleWords = savePushSimpleWords;
- envPtr->maxStackDepth = maxDepth;
- if (range1 != -1) {
- envPtr->excRangeDepth--;
- }
- FreeArgInfo(&argInfo);
- return result;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileForeachCmd --
+ * TclInitByteCodeObj --
*
- * Procedure called to compile the "foreach" command.
+ * Create a ByteCode structure and initialize it from a CompileEnv
+ * compilation environment structure. The ByteCode structure is
+ * smaller and contains just that information needed to execute
+ * the bytecode instructions resulting from compiling a Tcl script.
+ * The resulting structure is placed in the specified object.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If complation failed because the command is too complex
- * for TclCompileForeachCmd, TCL_OUT_LINE_COMPILE is returned
- * indicating that the foreach command should be compiled "out of line"
- * by emitting code to invoke its command procedure at runtime.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "while" command.
+ * A newly constructed ByteCode object is stored in the internal
+ * representation of the objPtr.
*
* Side effects:
- * Instructions are added to envPtr to evaluate the "foreach" command
- * at runtime.
+ * A single heap object is allocated to hold the new ByteCode structure
+ * and its code, object, command location, and aux data arrays. Note
+ * that "ownership" (i.e., the pointers to) the Tcl objects and aux
+ * data items will be handed over to the new ByteCode structure from
+ * the CompileEnv structure.
*
*----------------------------------------------------------------------
*/
-int
-TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+void
+TclInitByteCodeObj(objPtr, envPtr)
+ Tcl_Obj *objPtr; /* Points object that should be
+ * initialized, and whose string rep
+ * contains the source code. */
+ register CompileEnv *envPtr; /* Points to the CompileEnv structure from
+ * which to create a ByteCode structure. */
{
- Proc *procPtr = envPtr->procPtr;
- /* Points to structure describing procedure
- * containing foreach command, else NULL. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- ArgInfo argInfo; /* Structure holding information about the
- * start and end of each argument word. */
- int numLists = 0; /* Count of variable (and value) lists. */
- int range = -1; /* Index in the ExceptionRange array of the
- * ExceptionRange record for this loop. */
- ForeachInfo *infoPtr; /* Points to the structure describing this
- * foreach command. Stored in a AuxData
- * record in the ByteCode. */
- JumpFixup jumpFalseFixup; /* Used to update or replace the ifFalse
- * jump after test when its target PC is
- * determined. */
- char savedChar; /* Holds the char from string termporarily
- * replaced by a null character during
- * processing of argument words. */
- int firstListTmp = -1; /* If we decide to compile this foreach
- * command, this is the index or "slot
- * number" for the first temp var allocated
- * in the proc frame that holds a pointer to
- * a value list. Initialized to avoid a
- * compiler warning. */
- int loopIterNumTmp; /* If we decide to compile this foreach
- * command, the index for the temp var that
- * holds the current iteration count. */
- char *varListStart, *varListEnd, *valueListStart, *bodyStart, *bodyEnd;
- unsigned char *jumpPc;
- int jumpDist, jumpBackDist, jumpBackOffset;
- int numWords, numVars, infoIndex, tmpIndex, objIndex, i, j, result;
- int savePushSimpleWords = envPtr->pushSimpleWords;
-
- /*
- * We parse the variable list argument words and create two arrays:
- * varcList[i] gives the number of variables in the i-th var list
- * varvList[i] points to an array of the names in the i-th var list
- * These are initially allocated on the stack, and are allocated on
- * the heap if necessary.
- */
-
-#define STATIC_VAR_LIST_SIZE 4
- int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
- char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
-
- int *varcList = varcListStaticSpace;
- char ***varvList = varvListStaticSpace;
-
- /*
- * If the foreach command is at global level (not in a procedure),
- * don't compile it inline: the payoff is too small.
- */
-
- if (procPtr == NULL) {
- return TCL_OUT_LINE_COMPILE;
- }
-
- /*
- * Scan the words of the command and record the start and finish of
- * each argument word.
- */
-
- InitArgInfo(&argInfo);
- result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
- numWords = argInfo.numArgs;
- if (result != TCL_OK) {
- goto done;
- }
- if ((numWords < 3) || (numWords%2 != 1)) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
- result = TCL_ERROR;
- goto done;
- }
-
- /*
- * Initialize the varcList and varvList arrays; allocate heap storage,
- * if necessary, for them. Also make sure the variable names
- * have no substitutions: that they're just "var" or "var(elem)"
- */
-
- numLists = (numWords - 1)/2;
- if (numLists > STATIC_VAR_LIST_SIZE) {
- varcList = (int *) ckalloc(numLists * sizeof(int));
- varvList = (char ***) ckalloc(numLists * sizeof(char **));
- }
- for (i = 0; i < numLists; i++) {
- varcList[i] = 0;
- varvList[i] = (char **) NULL;
- }
- for (i = 0; i < numLists; i++) {
- /*
- * Break each variable list into its component variables. If the
- * lists is enclosed in {}s or ""s, strip them off first.
- */
-
- varListStart = argInfo.startArray[i*2];
- varListEnd = argInfo.endArray[i*2];
- if ((*varListStart == '{') || (*varListStart == '"')) {
- if ((*varListEnd != '}') && (*varListEnd != '"')) {
- Tcl_ResetResult(interp);
- if (*varListStart == '"') {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-quote", -1);
- } else {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-brace", -1);
- }
- result = TCL_ERROR;
- goto done;
- }
- varListStart++;
- varListEnd--;
- }
-
- /*
- * NOTE: THIS NEEDS TO BE CONVERTED TO AN OBJECT LIST.
- */
-
- savedChar = *(varListEnd+1);
- *(varListEnd+1) = '\0';
- result = Tcl_SplitList(interp, varListStart,
- &varcList[i], &varvList[i]);
- *(varListEnd+1) = savedChar;
- if (result != TCL_OK) {
- goto done;
- }
-
- /*
- * Check that each variable name has no substitutions and that
- * it is a local scalar name.
- */
-
- numVars = varcList[i];
- for (j = 0; j < numVars; j++) {
- char *varName = varvList[i][j];
- if (!IsLocalScalar(varName, (int) strlen(varName))) {
- result = TCL_OUT_LINE_COMPILE;
- goto done;
- }
- }
- }
-
- /*
- *==== At this point we believe we can compile the foreach command ====
- */
-
- /*
- * Create and initialize a ExceptionRange record to hold information
- * about this loop. This is used to implement break and continue.
- */
-
- envPtr->excRangeDepth++;
- envPtr->maxExcRangeDepth =
- TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
- range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
-
- /*
- * Reserve (numLists + 1) temporary variables:
- * - numLists temps for each value list
- * - a temp for the "next value" index into each value list
- * At this time we don't try to reuse temporaries; if there are two
- * nonoverlapping foreach loops, they don't share any temps.
- */
-
- for (i = 0; i < numLists; i++) {
- tmpIndex = LookupCompiledLocal(NULL, /*nameChars*/ 0,
- /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR, procPtr);
- if (i == 0) {
- firstListTmp = tmpIndex;
- }
- }
- loopIterNumTmp = LookupCompiledLocal(NULL, /*nameChars*/ 0,
- /*createIfNew*/ 1, /*flagsIfCreated*/ VAR_SCALAR, procPtr);
-
- /*
- * Create and initialize the ForeachInfo and ForeachVarList data
- * structures describing this command. Then create a AuxData record
- * pointing to the ForeachInfo structure in the compilation environment.
- */
-
- infoPtr = (ForeachInfo *) ckalloc((unsigned)
- (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
- infoPtr->numLists = numLists;
- infoPtr->firstListTmp = firstListTmp;
- infoPtr->loopIterNumTmp = loopIterNumTmp;
- for (i = 0; i < numLists; i++) {
- ForeachVarList *varListPtr;
- numVars = varcList[i];
- varListPtr = (ForeachVarList *) ckalloc((unsigned)
- sizeof(ForeachVarList) + numVars*sizeof(int));
- varListPtr->numVars = numVars;
- for (j = 0; j < numVars; j++) {
- char *varName = varvList[i][j];
- int nameChars = strlen(varName);
- varListPtr->varIndexes[j] = LookupCompiledLocal(varName,
- nameChars, /*createIfNew*/ 1,
- /*flagsIfCreated*/ VAR_SCALAR, procPtr);
- }
- infoPtr->varLists[i] = varListPtr;
- }
- infoIndex = TclCreateAuxData((ClientData) infoPtr,
- &tclForeachInfoType, envPtr);
-
- /*
- * Emit code to store each value list into the associated temporary.
- */
-
- for (i = 0; i < numLists; i++) {
- valueListStart = argInfo.startArray[2*i + 1];
- envPtr->pushSimpleWords = 1;
- result = CompileWord(interp, valueListStart, lastChar, flags,
- envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
-
- tmpIndex = (firstListTmp + i);
- if (tmpIndex <= 255) {
- TclEmitInstUInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
- } else {
- TclEmitInstUInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
- }
- TclEmitOpcode(INST_POP, envPtr);
- }
-
- /*
- * Emit the instruction to initialize the foreach loop's index temp var.
- */
-
- TclEmitInstUInt4(INST_FOREACH_START4, infoIndex, envPtr);
-
- /*
- * Emit the top of loop code that assigns each loop variable and checks
- * whether to terminate the loop.
- */
-
- envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
- TclEmitInstUInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
+ register ByteCode *codePtr;
+ size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
+ size_t auxDataArrayBytes, structureSize;
+ register unsigned char *p;
+ unsigned char *nextPtr;
+ int numLitObjects = envPtr->literalArrayNext;
+ Namespace *namespacePtr;
+ int i;
+ Interp *iPtr;
- /*
- * Emit the ifFalse jump that terminates the foreach if all value lists
- * are exhausted. We emit a one byte (relative) jump here, and replace
- * it later with a four byte jump if the jump target is more than
- * 127 bytes away.
- */
+ iPtr = envPtr->iPtr;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+ codeBytes = (envPtr->codeNext - envPtr->codeStart);
+ objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *));
+ exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
+ auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
+ cmdLocBytes = GetCmdLocEncodingSize(envPtr);
/*
- * Compile the loop body word inline. Also register the loop body's
- * starting PC offset and byte length in the ExceptionRange record.
- */
-
- bodyStart = argInfo.startArray[numWords - 1];
- bodyEnd = argInfo.endArray[numWords - 1];
- savedChar = *(bodyEnd+1);
- *(bodyEnd+1) = '\0';
- envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
- result = CompileCmdWordInline(interp, bodyStart, bodyEnd+1, flags,
- envPtr);
- *(bodyEnd+1) = savedChar;
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- char msg[60];
- sprintf(msg, "\n (\"foreach\" body line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- envPtr->excRangeArrayPtr[range].numCodeBytes =
- TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
-
- /*
- * Discard the loop body's result.
+ * Compute the total number of bytes needed for this bytecode.
*/
- TclEmitOpcode(INST_POP, envPtr);
-
- /*
- * Emit the unconditional jump back to the test at the top of the
- * loop. We generate a four byte jump if the distance to the to of
- * the foreach is greater than 120 bytes. This is conservative and
- * ensures that we won't have to replace this unconditional jump if
- * we later need to replace the ifFalse jump with a four-byte jump.
- */
+ structureSize = sizeof(ByteCode);
+ structureSize += TCL_ALIGN(codeBytes); /* align object array */
+ structureSize += TCL_ALIGN(objArrayBytes); /* align exc range arr */
+ structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+ structureSize += auxDataArrayBytes;
+ structureSize += cmdLocBytes;
- jumpBackOffset = TclCurrCodeOffset();
- jumpBackDist =
- (jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
+ if (envPtr->iPtr->varFramePtr != NULL) {
+ namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
} else {
- TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
- }
-
- /*
- * Now that we know the target of the jumpFalse after the foreach_step
- * test, update it with the correct distance. If the distance is too
- * great (more than 127 bytes), replace that jump with a four byte
- * instruction and move the instructions after the jump down.
- */
-
- jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
- /*
- * Update the loop body's starting PC offset since it moved down.
- */
-
- envPtr->excRangeArrayPtr[range].codeOffset += 3;
-
- /*
- * Update the distance for the unconditional jump back to the test
- * at the top of the loop since it moved down 3 bytes too.
- */
-
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- if (jumpBackDist > 120) {
- jumpBackDist += 3;
- TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
- jumpPc);
- } else {
- jumpBackDist += 3;
- TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
- jumpPc);
- }
+ namespacePtr = envPtr->iPtr->globalNsPtr;
}
-
- /*
- * The current PC offset (after the loop's body) is the loop's
- * break target.
- */
-
- envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
- /*
- * Push an empty string object as the foreach command's result.
- */
-
- objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
- envPtr);
- TclEmitPush(objIndex, envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
-
- done:
- for (i = 0; i < numLists; i++) {
- if (varvList[i] != (char **) NULL) {
- ckfree((char *) varvList[i]);
- }
- }
- if (varcList != varcListStaticSpace) {
- ckfree((char *) varcList);
- ckfree((char *) varvList);
- }
- envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
- envPtr->pushSimpleWords = savePushSimpleWords;
- envPtr->maxStackDepth = maxDepth;
- if (range != -1) {
- envPtr->excRangeDepth--;
- }
- FreeArgInfo(&argInfo);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupForeachInfo --
- *
- * This procedure duplicates a ForeachInfo structure created as
- * auxiliary data during the compilation of a foreach command.
- *
- * Results:
- * A pointer to a newly allocated copy of the existing ForeachInfo
- * structure is returned.
- *
- * Side effects:
- * Storage for the copied ForeachInfo record is allocated. If the
- * original ForeachInfo structure pointed to any ForeachVarList
- * records, these structures are also copied and pointers to them
- * are stored in the new ForeachInfo record.
- *
- *----------------------------------------------------------------------
- */
+ p = (unsigned char *) ckalloc((size_t) structureSize);
+ codePtr = (ByteCode *) p;
+ codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
+ codePtr->compileEpoch = iPtr->compileEpoch;
+ codePtr->nsPtr = namespacePtr;
+ codePtr->nsEpoch = namespacePtr->resolverEpoch;
+ codePtr->refCount = 1;
+ codePtr->flags = 0;
+ codePtr->source = envPtr->source;
+ codePtr->procPtr = envPtr->procPtr;
-static ClientData
-DupForeachInfo(clientData)
- ClientData clientData; /* The foreach command's compilation
- * auxiliary data to duplicate. */
-{
- register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
- ForeachInfo *dupPtr;
- register ForeachVarList *srcListPtr, *dupListPtr;
- int numLists = srcPtr->numLists;
- int numVars, i, j;
+ codePtr->numCommands = envPtr->numCommands;
+ codePtr->numSrcBytes = envPtr->numSrcBytes;
+ codePtr->numCodeBytes = codeBytes;
+ codePtr->numLitObjects = numLitObjects;
+ codePtr->numExceptRanges = envPtr->exceptArrayNext;
+ codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
+ codePtr->numCmdLocBytes = cmdLocBytes;
+ codePtr->maxExceptDepth = envPtr->maxExceptDepth;
+ codePtr->maxStackDepth = envPtr->maxStackDepth;
- dupPtr = (ForeachInfo *) ckalloc((unsigned)
- (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
- dupPtr->numLists = numLists;
- dupPtr->firstListTmp = srcPtr->firstListTmp;
- dupPtr->loopIterNumTmp = srcPtr->loopIterNumTmp;
+ p += sizeof(ByteCode);
+ codePtr->codeStart = p;
+ memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
- for (i = 0; i < numLists; i++) {
- srcListPtr = srcPtr->varLists[i];
- numVars = srcListPtr->numVars;
- dupListPtr = (ForeachVarList *) ckalloc((unsigned)
- sizeof(ForeachVarList) + numVars*sizeof(int));
- dupListPtr->numVars = numVars;
- for (j = 0; j < numVars; j++) {
- dupListPtr->varIndexes[j] = srcListPtr->varIndexes[j];
- }
- dupPtr->varLists[i] = dupListPtr;
- }
- return (ClientData) dupPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeForeachInfo --
- *
- * Procedure to free a ForeachInfo structure created as auxiliary data
- * during the compilation of a foreach command.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Storage for the ForeachInfo structure pointed to by the ClientData
- * argument is freed as is any ForeachVarList record pointed to by the
- * ForeachInfo structure.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeForeachInfo(clientData)
- ClientData clientData; /* The foreach command's compilation
- * auxiliary data to free. */
-{
- register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
- register ForeachVarList *listPtr;
- int numLists = infoPtr->numLists;
- register int i;
-
- for (i = 0; i < numLists; i++) {
- listPtr = infoPtr->varLists[i];
- ckfree((char *) listPtr);
+ p += TCL_ALIGN(codeBytes); /* align object array */
+ codePtr->objArrayPtr = (Tcl_Obj **) p;
+ for (i = 0; i < numLitObjects; i++) {
+ codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
}
- ckfree((char *) infoPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileIfCmd --
- *
- * Procedure called to compile the "if" command.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
- * Side effects:
- * Instructions are added to envPtr to evaluate the "if" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileIfCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- register char *src = string;/* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- JumpFixupArray jumpFalseFixupArray;
- /* Used to fix up the ifFalse jump after
- * each "if"/"elseif" test when its target
- * PC is determined. */
- JumpFixupArray jumpEndFixupArray;
- /* Used to fix up the unconditional jump
- * after each "then" command to the end of
- * the "if" when that PC is determined. */
- char *testSrcStart;
- int jumpDist, jumpFalseDist, jumpIndex, objIndex, j, result;
- unsigned char *ifFalsePc;
- unsigned char opCode;
- int savePushSimpleWords = envPtr->pushSimpleWords;
-
- /*
- * Loop compiling "expr then body" clauses after an "if" or "elseif".
- */
-
- TclInitJumpFixupArray(&jumpFalseFixupArray);
- TclInitJumpFixupArray(&jumpEndFixupArray);
- while (1) {
- /*
- * At this point in the loop, we have an expression to test, either
- * the main expression or an expression following an "elseif".
- * The arguments after the expression must be "then" (optional) and
- * a script to execute if the expression is true.
- */
-
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: no expression after \"if\" argument", -1);
- result = TCL_ERROR;
- goto done;
- }
-
- /*
- * Compile the "if"/"elseif" test expression.
- */
-
- testSrcStart = src;
- envPtr->pushSimpleWords = 1;
- result = CompileExprWord(interp, src, lastChar, flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"if\" test expression)", -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- src += envPtr->termOffset;
-
- /*
- * Emit the ifFalse jump around the "then" part if the test was
- * false. We emit a one byte (relative) jump here, and replace it
- * later with a four byte jump if the jump target is more than 127
- * bytes away.
- */
-
- if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
- TclExpandJumpFixupArray(&jumpFalseFixupArray);
- }
- jumpIndex = jumpFalseFixupArray.next;
- jumpFalseFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
- &(jumpFalseFixupArray.fixup[jumpIndex]));
-
- /*
- * Skip over the optional "then" before the then clause.
- */
-
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- char buf[100];
- sprintf(buf, "wrong # args: no script following \"%.20s\" argument", testSrcStart);
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
- result = TCL_ERROR;
- goto done;
- }
- if ((*src == 't') && (strncmp(src, "then", 4) == 0)) {
- type = CHAR_TYPE(src+4, lastChar);
- if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
- src += 4;
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: no script following \"then\" argument", -1);
- result = TCL_ERROR;
- goto done;
- }
- }
- }
-
- /*
- * Compile the "then" command word inline.
- */
-
- result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- char msg[60];
- sprintf(msg, "\n (\"if\" then script line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- src += envPtr->termOffset;
-
- /*
- * Emit an unconditional jump to the end of the "if" command. We
- * emit a one byte jump here, and replace it later with a four byte
- * jump if the jump target is more than 127 bytes away. Note that
- * both the jumpFalseFixupArray and the jumpEndFixupArray are
- * indexed by the same index, "jumpIndex".
- */
- if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
- TclExpandJumpFixupArray(&jumpEndFixupArray);
- }
- jumpEndFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- &(jumpEndFixupArray.fixup[jumpIndex]));
-
- /*
- * Now that we know the target of the jumpFalse after the if test,
- * update it with the correct distance. We generate a four byte
- * jump if the distance is greater than 120 bytes. This is
- * conservative, and ensures that we won't have to replace this
- * jump if we later also need to replace the preceeding
- * unconditional jump to the end of the "if" with a four-byte jump.
- */
-
- jumpDist = (TclCurrCodeOffset() - jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
- if (TclFixupForwardJump(envPtr,
- &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
- /*
- * Adjust the code offset for the unconditional jump at the end
- * of the last "then" clause.
- */
-
- jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
- }
-
- /*
- * Check now for a "elseif" word. If we find one, keep looping.
- */
-
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if ((type != TCL_COMMAND_END)
- && ((*src == 'e') && (strncmp(src, "elseif", 6) == 0))) {
- type = CHAR_TYPE(src+6, lastChar);
- if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
- src += 6;
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: no expression after \"elseif\" argument", -1);
- result = TCL_ERROR;
- goto done;
- }
- continue; /* continue the "expr then body" loop */
- }
- }
- break;
- } /* end of the "expr then body" loop */
-
- /*
- * No more "elseif expr then body" clauses. Check now for an "else"
- * clause. If there is another word, we are at its start.
- */
-
- if (type != TCL_COMMAND_END) {
- if ((*src == 'e') && (strncmp(src, "else", 4) == 0)) {
- type = CHAR_TYPE(src+4, lastChar);
- if ((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
- src += 4;
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: no script following \"else\" argument", -1);
- result = TCL_ERROR;
- goto done;
- }
- }
- }
-
- /*
- * Compile the "else" command word inline.
- */
-
- result = CompileCmdWordInline(interp, src, lastChar, flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- char msg[60];
- sprintf(msg, "\n (\"if\" else script line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- src += envPtr->termOffset;
-
- /*
- * Skip over white space until the end of the command.
- */
-
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
- result = TCL_ERROR;
- goto done;
- }
- }
+ p += TCL_ALIGN(objArrayBytes); /* align exception range array */
+ if (exceptArrayBytes > 0) {
+ codePtr->exceptArrayPtr = (ExceptionRange *) p;
+ memcpy((VOID *) p, (VOID *) envPtr->exceptArrayPtr,
+ (size_t) exceptArrayBytes);
} else {
- /*
- * The "if" command has no "else" clause: push an empty string
- * object as its result.
- */
-
- objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- TclEmitPush(objIndex, envPtr);
- maxDepth = TclMax(1, maxDepth);
+ codePtr->exceptArrayPtr = NULL;
}
-
- /*
- * Now that we know the target of the unconditional jumps to the end of
- * the "if" command, update them with the correct distance. If the
- * distance is too great (> 127 bytes), replace the jump with a four
- * byte instruction and move instructions after the jump down.
- */
- for (j = jumpEndFixupArray.next; j > 0; j--) {
- jumpIndex = (j - 1); /* i.e. process the closest jump first */
- jumpDist = (TclCurrCodeOffset() - jumpEndFixupArray.fixup[jumpIndex].codeOffset);
- if (TclFixupForwardJump(envPtr,
- &(jumpEndFixupArray.fixup[jumpIndex]), jumpDist, 127)) {
- /*
- * Adjust the jump distance for the "ifFalse" jump that
- * immediately preceeds this jump. We've moved it's target
- * (just after this unconditional jump) three bytes down.
- */
-
- ifFalsePc = (envPtr->codeStart + jumpFalseFixupArray.fixup[jumpIndex].codeOffset);
- opCode = *ifFalsePc;
- if (opCode == INST_JUMP_FALSE1) {
- jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
- jumpFalseDist += 3;
- TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
- } else if (opCode == INST_JUMP_FALSE4) {
- jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
- jumpFalseDist += 3;
- TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
- } else {
- panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
- }
- }
- }
-
- /*
- * Free the jumpFixupArray array if malloc'ed storage was used.
- */
-
- done:
- TclFreeJumpFixupArray(&jumpFalseFixupArray);
- TclFreeJumpFixupArray(&jumpEndFixupArray);
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileIncrCmd --
- *
- * Procedure called to compile the "incr" command.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "incr" command.
- *
- * Side effects:
- * Instructions are added to envPtr to evaluate the "incr" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileIncrCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- Proc *procPtr = envPtr->procPtr;
- /* Points to structure describing procedure
- * containing incr command, else NULL. */
- register char *src = string;
- /* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int simpleVarName; /* 1 if name is just sequence of chars with
- * an optional element name in parens. */
- char *name = NULL; /* If simpleVarName, points to first char of
- * variable name and nameChars is length.
- * Otherwise NULL. */
- char *elName = NULL; /* If simpleVarName, points to first char of
- * element name and elNameChars is length.
- * Otherwise NULL. */
- int nameChars = 0; /* Length of the var name. Initialized to
- * avoid a compiler warning. */
- int elNameChars = 0; /* Length of array's element name, if any.
- * Initialized to avoid a compiler
- * warning. */
- int incrementGiven; /* 1 if an increment amount was given. */
- int isImmIncrValue = 0; /* 1 if increment amount is a literal
- * integer in [-127..127]. */
- int immIncrValue = 0; /* if isImmIncrValue is 1, the immediate
- * integer value. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- int localIndex = -1; /* Index of the variable in the current
- * procedure's array of local variables.
- * Otherwise -1 if not in a procedure or
- * the variable wasn't found. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null char
- * during name processing. */
- int objIndex; /* The object array index for a pushed
- * object holding a name part. */
- int savePushSimpleWords = envPtr->pushSimpleWords;
- char *p;
- int i, result;
-
- /*
- * Parse the next word: the variable name. If it is "simple" (requires
- * no substitutions at runtime), divide it up into a simple "name" plus
- * an optional "elName". Otherwise, if not simple, just push the name.
- */
-
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- badArgs:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"incr varName ?increment?\"", -1);
- result = TCL_ERROR;
- goto done;
- }
-
- envPtr->pushSimpleWords = 0;
- result = CompileWord(interp, src, lastChar, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- simpleVarName = envPtr->wordIsSimple;
- if (simpleVarName) {
- name = src;
- nameChars = envPtr->numSimpleWordChars;
- if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- name++;
- }
- elName = NULL;
- elNameChars = 0;
- p = name;
- for (i = 0; i < nameChars; i++) {
- if (*p == '(') {
- char *openParen = p;
- p = (src + nameChars-1);
- if (*p == ')') { /* last char is ')' => array reference */
- nameChars = (openParen - name);
- elName = openParen+1;
- elNameChars = (p - elName);
- }
- break;
- }
- p++;
- }
+ p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
+ if (auxDataArrayBytes > 0) {
+ codePtr->auxDataArrayPtr = (AuxData *) p;
+ memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
+ (size_t) auxDataArrayBytes);
} else {
- maxDepth = envPtr->maxStackDepth;
+ codePtr->auxDataArrayPtr = NULL;
}
- src += envPtr->termOffset;
-
- /*
- * See if there is a next word. If so, we are incrementing the variable
- * by that value (which must be an integer).
- */
- incrementGiven = 0;
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- incrementGiven = (type != TCL_COMMAND_END);
- }
-
- /*
- * Non-simple names have already been pushed. If this is a simple
- * variable, either push its name (if a global or an unknown local
- * variable) or look up the variable's local frame index. If a local is
- * not found, push its name and do the lookup at runtime. If this is an
- * array reference, also push the array element.
- */
-
- if (simpleVarName) {
- if (procPtr == NULL) {
- savedChar = name[nameChars];
- name[nameChars] = '\0';
- objIndex = TclObjIndexForString(name, nameChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
- } else {
- localIndex = LookupCompiledLocal(name, nameChars,
- /*createIfNew*/ 0, /*flagsIfCreated*/ 0,
- envPtr->procPtr);
- if ((localIndex < 0) || (localIndex > 255)) {
- if (localIndex > 255) { /* we'll push the name */
- localIndex = -1;
- }
- savedChar = name[nameChars];
- name[nameChars] = '\0';
- objIndex = TclObjIndexForString(name, nameChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
- } else {
- maxDepth = 0;
- }
- }
-
- if (elName != NULL) {
- /*
- * Parse and push the array element's name. Perform
- * substitutions on it, just as is done for quoted strings.
- */
-
- savedChar = elName[elNameChars];
- elName[elNameChars] = '\0';
- envPtr->pushSimpleWords = 1;
- result = TclCompileQuotes(interp, elName, elName+elNameChars,
- 0, flags, envPtr);
- elName[elNameChars] = savedChar;
- if (result != TCL_OK) {
- char msg[200];
- sprintf(msg, "\n (parsing index for array \"%.*s\")",
- TclMin(nameChars, 100), name);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- goto done;
- }
- maxDepth += envPtr->maxStackDepth;
- }
- }
-
- /*
- * If an increment was given, push the new value.
- */
-
- if (incrementGiven) {
- type = CHAR_TYPE(src, lastChar);
- envPtr->pushSimpleWords = 0;
- result = CompileWord(interp, src, lastChar, flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (increment expression)", -1);
- }
- goto done;
- }
- if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src++;
- }
- if (envPtr->wordIsSimple) {
- /*
- * See if the word represents an integer whose formatted
- * representation is the same as the word (e.g., this is
- * true for 123 and -1 but not for 00005). If so, just
- * push an integer object.
- */
-
- int isCompilableInt = 0;
- int numChars = envPtr->numSimpleWordChars;
- char savedChar = src[numChars];
- char buf[40];
- Tcl_Obj *objPtr;
- long n;
-
- src[numChars] = '\0';
- if (TclLooksLikeInt(src)) {
- int code = TclGetLong(interp, src, &n);
- if (code == TCL_OK) {
- if ((-127 <= n) && (n <= 127)) {
- isCompilableInt = 1;
- isImmIncrValue = 1;
- immIncrValue = n;
- } else {
- TclFormatInt(buf, n);
- if (strcmp(src, buf) == 0) {
- isCompilableInt = 1;
- isImmIncrValue = 0;
- objIndex = TclObjIndexForString(src, numChars,
- /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = n;
- objPtr->typePtr = &tclIntType;
-
- TclEmitPush(objIndex, envPtr);
- maxDepth += 1;
- }
- }
- } else {
- Tcl_ResetResult(interp);
- }
- }
- if (!isCompilableInt) {
- objIndex = TclObjIndexForString(src, numChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- TclEmitPush(objIndex, envPtr);
- maxDepth += 1;
- }
- src[numChars] = savedChar;
- } else {
- maxDepth += envPtr->maxStackDepth;
- }
- if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src += (envPtr->termOffset - 1); /* already advanced 1 above */
- } else {
- src += envPtr->termOffset;
- }
- } else { /* no incr amount given so use 1 */
- isImmIncrValue = 1;
- immIncrValue = 1;
+ p += auxDataArrayBytes;
+ nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
+#ifdef TCL_COMPILE_DEBUG
+ if (((size_t)(nextPtr - p)) != cmdLocBytes) {
+ panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
}
+#endif
/*
- * Now emit instructions to increment the variable.
- */
-
- if (simpleVarName) {
- if (elName == NULL) { /* scalar */
- if (localIndex >= 0) {
- if (isImmIncrValue) {
- TclEmitInstUInt1(INST_INCR_SCALAR1_IMM, localIndex,
- envPtr);
- TclEmitInt1(immIncrValue, envPtr);
- } else {
- TclEmitInstUInt1(INST_INCR_SCALAR1, localIndex, envPtr);
- }
- } else {
- if (isImmIncrValue) {
- TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immIncrValue,
- envPtr);
- } else {
- TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
- }
- }
- } else { /* array */
- if (localIndex >= 0) {
- if (isImmIncrValue) {
- TclEmitInstUInt1(INST_INCR_ARRAY1_IMM, localIndex,
- envPtr);
- TclEmitInt1(immIncrValue, envPtr);
- } else {
- TclEmitInstUInt1(INST_INCR_ARRAY1, localIndex, envPtr);
- }
- } else {
- if (isImmIncrValue) {
- TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immIncrValue,
- envPtr);
- } else {
- TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
- }
- }
- }
- } else { /* non-simple variable name */
- if (isImmIncrValue) {
- TclEmitInstInt1(INST_INCR_STK_IMM, immIncrValue, envPtr);
- } else {
- TclEmitOpcode(INST_INCR_STK, envPtr);
- }
- }
-
- /*
- * Skip over white space until the end of the command.
+ * Record various compilation-related statistics about the new ByteCode
+ * structure. Don't include overhead for statistics-related fields.
*/
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- goto badArgs;
- }
- }
-
- done:
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileSetCmd --
- *
- * Procedure called to compile the "set" command.
- *
- * Results:
- * The return value is a standard Tcl result, which is normally TCL_OK
- * unless there was an error while parsing string. If an error occurs
- * then the interpreter's result contains a standard error message. If
- * complation fails because the set command requires a second level of
- * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- * set command should be compiled "out of line" by emitting code to
- * invoke its command procedure (Tcl_SetCmd) at runtime.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the incr command.
- *
- * Side effects:
- * Instructions are added to envPtr to evaluate the "set" command
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileSetCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- Proc *procPtr = envPtr->procPtr;
- /* Points to structure describing procedure
- * containing the set command, else NULL. */
- ArgInfo argInfo; /* Structure holding information about the
- * start and end of each argument word. */
- int simpleVarName; /* 1 if name is just sequence of chars with
- * an optional element name in parens. */
- char *elName = NULL; /* If simpleVarName, points to first char of
- * element name and elNameChars is length.
- * Otherwise NULL. */
- int isAssignment; /* 1 if assigning value to var, else 0. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- int localIndex = -1; /* Index of the variable in the current
- * procedure's array of local variables.
- * Otherwise -1 if not in a procedure, the
- * name contains "::"s, or the variable
- * wasn't found. */
- char savedChar; /* Holds the character from string
- * termporarily replaced by a null char
- * during name processing. */
- int objIndex = -1; /* The object array index for a pushed
- * object holding a name part. Initialized
- * to avoid a compiler warning. */
- char *wordStart, *p;
- int numWords, isCompilableInt, i, result;
- Tcl_Obj *objPtr;
- int savePushSimpleWords = envPtr->pushSimpleWords;
-
- /*
- * Scan the words of the command and record the start and finish of
- * each argument word.
- */
-
- InitArgInfo(&argInfo);
- result = CollectArgInfo(interp, string, lastChar, flags, &argInfo);
- numWords = argInfo.numArgs; /* i.e., the # after the command name */
- if (result != TCL_OK) {
- goto done;
- }
- if ((numWords < 1) || (numWords > 2)) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"set varName ?newValue?\"", -1);
- result = TCL_ERROR;
- goto done;
- }
- isAssignment = (numWords == 2);
-
- /*
- * Parse the next word: the variable name. If the name is enclosed in
- * quotes or braces, we return TCL_OUT_LINE_COMPILE and call the set
- * command procedure at runtime since this makes sure that a second
- * round of substitutions is done properly.
- */
-
- wordStart = argInfo.startArray[0]; /* start of 1st arg word: varname */
- if ((*wordStart == '{') || (*wordStart == '"')) {
- result = TCL_OUT_LINE_COMPILE;
- goto done;
- }
-
- /*
- * Check whether the name is "simple": requires no substitutions at
- * runtime.
- */
+#ifdef TCL_COMPILE_STATS
+ codePtr->structureSize = structureSize
+ - (sizeof(size_t) + sizeof(Tcl_Time));
+ TclpGetTime(&(codePtr->createTime));
- envPtr->pushSimpleWords = 0;
- result = CompileWord(interp, wordStart, argInfo.endArray[0] + 1,
- flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- simpleVarName = envPtr->wordIsSimple;
+ RecordByteCodeStats(codePtr);
+#endif /* TCL_COMPILE_STATS */
- if (!simpleVarName) {
- /*
- * The name isn't simple. CompileWord already pushed it.
- */
-
- maxDepth = envPtr->maxStackDepth;
- } else {
- char *name; /* If simpleVarName, points to first char of
- * variable name and nameChars is length.
- * Otherwise NULL. */
- int nameChars; /* Length of the var name. */
- int nameHasNsSeparators = 0;
- /* Set 1 if name contains "::"s. */
- int elNameChars; /* Length of array's element name if any. */
-
- /*
- * A simple name. First divide it up into "name" plus "elName"
- * for an array element name, if any.
- */
-
- name = wordStart;
- nameChars = envPtr->numSimpleWordChars;
- elName = NULL;
- elNameChars = 0;
-
- p = name;
- for (i = 0; i < nameChars; i++) {
- if (*p == '(') {
- char *openParen = p;
- p = (name + nameChars-1);
- if (*p == ')') { /* last char is ')' => array reference */
- nameChars = (openParen - name);
- elName = openParen+1;
- elNameChars = (p - elName);
- }
- break;
- }
- p++;
- }
-
- /*
- * Determine if name has any namespace separators (::'s).
- */
-
- p = name;
- for (i = 0; i < nameChars; i++) {
- if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
- nameHasNsSeparators = 1;
- break;
- }
- p++;
- }
-
- /*
- * Now either push the name or determine its index in the array of
- * local variables in a procedure frame. Note that if we are
- * compiling a procedure the variable must be local unless its
- * name has namespace separators ("::"s). Note also that global
- * variables are implemented by a local variable that "points" to
- * the real global. There are two cases:
- * 1) We are not compiling a procedure body. Push the global
- * variable's name and do the lookup at runtime.
- * 2) We are compiling a procedure and the name has "::"s.
- * Push the namespace variable's name and do the lookup at
- * runtime.
- * 3) We are compiling a procedure and the name has no "::"s.
- * If the variable has already been allocated an local index,
- * just look it up. If the variable is unknown and we are
- * doing an assignment, allocate a new index. Otherwise,
- * push the name and try to do the lookup at runtime.
- */
-
- if ((procPtr == NULL) || nameHasNsSeparators) {
- savedChar = name[nameChars];
- name[nameChars] = '\0';
- objIndex = TclObjIndexForString(name, nameChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
- } else {
- localIndex = LookupCompiledLocal(name, nameChars,
- /*createIfNew*/ isAssignment,
- /*flagsIfCreated*/
- ((elName == NULL)? VAR_SCALAR : VAR_ARRAY),
- envPtr->procPtr);
- if (localIndex >= 0) {
- maxDepth = 0;
- } else {
- savedChar = name[nameChars];
- name[nameChars] = '\0';
- objIndex = TclObjIndexForString(name, nameChars,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- name[nameChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
- }
- }
-
- /*
- * If we are dealing with a reference to an array element, push the
- * array element. Perform substitutions on it, just as is done
- * for quoted strings.
- */
-
- if (elName != NULL) {
- savedChar = elName[elNameChars];
- elName[elNameChars] = '\0';
- envPtr->pushSimpleWords = 1;
- result = TclCompileQuotes(interp, elName, elName+elNameChars,
- 0, flags, envPtr);
- elName[elNameChars] = savedChar;
- if (result != TCL_OK) {
- char msg[200];
- sprintf(msg, "\n (parsing index for array \"%.*s\")",
- TclMin(nameChars, 100), name);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- goto done;
- }
- maxDepth += envPtr->maxStackDepth;
- }
- }
-
/*
- * If we are doing an assignment, push the new value.
+ * Free the old internal rep then convert the object to a
+ * bytecode object by making its internal rep point to the just
+ * compiled ByteCode.
*/
-
- if (isAssignment) {
- wordStart = argInfo.startArray[1]; /* start of 2nd arg word */
- envPtr->pushSimpleWords = 0; /* we will handle simple words */
- result = CompileWord(interp, wordStart, argInfo.endArray[1] + 1,
- flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- if (!envPtr->wordIsSimple) {
- /*
- * The value isn't simple. CompileWord already pushed it.
- */
-
- maxDepth += envPtr->maxStackDepth;
- } else {
- /*
- * The value is simple. See if the word represents an integer
- * whose formatted representation is the same as the word (e.g.,
- * this is true for 123 and -1 but not for 00005). If so, just
- * push an integer object.
- */
- char buf[40];
- long n;
-
- p = wordStart;
- if ((*wordStart == '"') || (*wordStart == '{')) {
- p++;
- }
- savedChar = p[envPtr->numSimpleWordChars];
- p[envPtr->numSimpleWordChars] = '\0';
- isCompilableInt = 0;
- if (TclLooksLikeInt(p)) {
- int code = TclGetLong(interp, p, &n);
- if (code == TCL_OK) {
- TclFormatInt(buf, n);
- if (strcmp(p, buf) == 0) {
- isCompilableInt = 1;
- objIndex = TclObjIndexForString(p,
- envPtr->numSimpleWordChars,
- /*allocStrRep*/ 0, /*inHeap*/ 0, envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = n;
- objPtr->typePtr = &tclIntType;
- }
- } else {
- Tcl_ResetResult(interp);
- }
- }
- if (!isCompilableInt) {
- objIndex = TclObjIndexForString(p,
- envPtr->numSimpleWordChars, /*allocStrRep*/ 1,
- /*inHeap*/ 0, envPtr);
- }
- p[envPtr->numSimpleWordChars] = savedChar;
- TclEmitPush(objIndex, envPtr);
- maxDepth += 1;
- }
- }
-
- /*
- * Now emit instructions to set/retrieve the variable.
- */
-
- if (simpleVarName) {
- if (elName == NULL) { /* scalar */
- if (localIndex >= 0) {
- if (localIndex <= 255) {
- TclEmitInstUInt1((isAssignment?
- INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
- localIndex, envPtr);
- } else {
- TclEmitInstUInt4((isAssignment?
- INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
- localIndex, envPtr);
- }
- } else {
- TclEmitOpcode((isAssignment?
- INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK),
- envPtr);
- }
- } else { /* array */
- if (localIndex >= 0) {
- if (localIndex <= 255) {
- TclEmitInstUInt1((isAssignment?
- INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
- localIndex, envPtr);
- } else {
- TclEmitInstUInt4((isAssignment?
- INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
- localIndex, envPtr);
- }
- } else {
- TclEmitOpcode((isAssignment?
- INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK),
- envPtr);
- }
- }
- } else { /* non-simple variable name */
- TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
- }
-
- done:
- if (numWords == 0) {
- envPtr->termOffset = 0;
- } else {
- envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
+ if ((objPtr->typePtr != NULL) &&
+ (objPtr->typePtr->freeIntRepProc != NULL)) {
+ (*objPtr->typePtr->freeIntRepProc)(objPtr);
}
- envPtr->pushSimpleWords = savePushSimpleWords;
- envPtr->maxStackDepth = maxDepth;
- FreeArgInfo(&argInfo);
- return result;
+ objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
+ objPtr->typePtr = &tclByteCodeType;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileWhileCmd --
+ * LogCompilationInfo --
*
- * Procedure called to compile the "while" command.
+ * This procedure is invoked after an error occurs during compilation.
+ * It adds information to the "errorInfo" variable to describe the
+ * command that was being compiled when the error occurred.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If compilation failed because the command is too
- * complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
- * indicating that the while command should be compiled "out of line"
- * by emitting code to invoke its command procedure at runtime.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "while" command.
+ * None.
*
* Side effects:
- * Instructions are added to envPtr to evaluate the "while" command
- * at runtime.
+ * Information about the command is added to errorInfo and the
+ * line number stored internally in the interpreter is set. If this
+ * is the first call to this procedure or Tcl_AddObjErrorInfo since
+ * an error occurred, then old information in errorInfo is
+ * deleted.
*
*----------------------------------------------------------------------
*/
-int
-TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+static void
+LogCompilationInfo(interp, script, command, length)
+ Tcl_Interp *interp; /* Interpreter in which to log the
+ * information. */
+ char *script; /* First character in script containing
+ * command (must be <= command). */
+ char *command; /* First character in command that
+ * generated the error. */
+ int length; /* Number of bytes in command (-1 means
+ * use all bytes up to first null byte). */
{
- register char *src = string;/* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- int range = -1; /* Index in the ExceptionRange array of the
- * ExceptionRange record for this loop. */
- JumpFixup jumpFalseFixup; /* Used to update or replace the ifFalse
- * jump after test when its target PC is
- * determined. */
- unsigned char *jumpPc;
- int jumpDist, jumpBackDist, jumpBackOffset, objIndex, result;
- int savePushSimpleWords = envPtr->pushSimpleWords;
-
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- badArgs:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"while test command\"", -1);
- result = TCL_ERROR;
- goto done;
- }
-
- /*
- * If the test expression is not enclosed in braces, don't compile
- * the while inline. As a result of Tcl's two level substitution
- * semantics for expressions, the expression might have a constant
- * value that results in the loop never executing, or executing forever.
- * Consider "set x 0; whie "$x > 5" {incr x}": the loop body
- * should never be executed.
- * NOTE: This is an overly aggressive test, since there are legitimate
- * literals that could be compiled but aren't in braces. However, until
- * the parser is integrated in 8.1, this is the simplest implementation.
- */
-
- if (*src != '{') {
- result = TCL_OUT_LINE_COMPILE;
- goto done;
- }
-
- /*
- * Create and initialize a ExceptionRange record to hold information
- * about this loop. This is used to implement break and continue.
- */
-
- envPtr->excRangeDepth++;
- envPtr->maxExcRangeDepth =
- TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
-
- range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
- envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
-
- /*
- * Compile the next word: the test expression.
- */
-
- envPtr->pushSimpleWords = 1;
- result = CompileExprWord(interp, src, lastChar, flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"while\" test expression)", -1);
- }
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
- src += envPtr->termOffset;
-
- /*
- * Emit the ifFalse jump that terminates the while if the test was
- * false. We emit a one byte (relative) jump here, and replace it
- * later with a four byte jump if the jump target is more than
- * 127 bytes away.
- */
-
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-
- /*
- * Compile the loop body word inline. Also register the loop body's
- * starting PC offset and byte length in the its ExceptionRange record.
- */
-
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- goto badArgs;
- }
-
- envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
- result = CompileCmdWordInline(interp, src, lastChar,
- flags, envPtr);
- if (result != TCL_OK) {
- if (result == TCL_ERROR) {
- char msg[60];
- sprintf(msg, "\n (\"while\" body line %d)", interp->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- src += envPtr->termOffset;
- envPtr->excRangeArrayPtr[range].numCodeBytes =
- (TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset);
-
- /*
- * Discard the loop body's result.
- */
-
- TclEmitOpcode(INST_POP, envPtr);
-
- /*
- * Emit the unconditional jump back to the test at the top of the
- * loop. We generate a four byte jump if the distance to the while's
- * test is greater than 120 bytes. This is conservative, and ensures
- * that we won't have to replace this unconditional jump if we later
- * need to replace the ifFalse jump with a four-byte jump.
- */
-
- jumpBackOffset = TclCurrCodeOffset();
- jumpBackDist =
- (jumpBackOffset - envPtr->excRangeArrayPtr[range].continueOffset);
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, /*offset*/ -jumpBackDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, /*offset*/ -jumpBackDist, envPtr);
- }
-
- /*
- * Now that we know the target of the jumpFalse after the test, update
- * it with the correct distance. If the distance is too great (more
- * than 127 bytes), replace that jump with a four byte instruction and
- * move the instructions after the jump down.
- */
-
- jumpDist = (TclCurrCodeOffset() - jumpFalseFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
- /*
- * Update the loop body's starting PC offset since it moved down.
- */
-
- envPtr->excRangeArrayPtr[range].codeOffset += 3;
+ char buffer[200];
+ register char *p;
+ char *ellipsis = "";
+ Interp *iPtr = (Interp *) interp;
+ if (iPtr->flags & ERR_ALREADY_LOGGED) {
/*
- * Update the distance for the unconditional jump back to the test
- * at the top of the loop since it moved down 3 bytes too.
+ * Someone else has already logged error information for this
+ * command; we shouldn't add anything more.
*/
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- if (jumpBackDist > 120) {
- jumpBackDist += 3;
- TclUpdateInstInt4AtPc(INST_JUMP4, /*offset*/ -jumpBackDist,
- jumpPc);
- } else {
- jumpBackDist += 3;
- TclUpdateInstInt1AtPc(INST_JUMP1, /*offset*/ -jumpBackDist,
- jumpPc);
- }
- }
-
- /*
- * The current PC offset (after the loop's body) is the loop's
- * break target.
- */
-
- envPtr->excRangeArrayPtr[range].breakOffset = TclCurrCodeOffset();
-
- /*
- * Push an empty string object as the while command's result.
- */
-
- objIndex = TclObjIndexForString("", 0, /*allocStrRep*/ 0, /*inHeap*/ 0,
- envPtr);
- TclEmitPush(objIndex, envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
+ return;
}
/*
- * Skip over white space until the end of the command.
+ * Compute the line number where the error occurred.
*/
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type != TCL_COMMAND_END) {
- goto badArgs;
+ iPtr->errorLine = 1;
+ for (p = script; p != command; p++) {
+ if (*p == '\n') {
+ iPtr->errorLine++;
}
}
- done:
- envPtr->termOffset = (src - string);
- envPtr->pushSimpleWords = savePushSimpleWords;
- envPtr->maxStackDepth = maxDepth;
- if (range != -1) {
- envPtr->excRangeDepth--;
- }
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileExprWord --
- *
- * Procedure that compiles a Tcl expression in a command word.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while compiling string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "expr" word.
- *
- * Side effects:
- * Instructions are added to envPtr to evaluate the expression word
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileExprWord(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- register char *src = string;/* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute the expression. */
- int nestedCmd = (flags & TCL_BRACKET_TERM);
- /* 1 if script being compiled is a nested
- * command and is terminated by a ']';
- * otherwise 0. */
- char *first, *last; /* Points to the first and last significant
- * characters of the word. */
- char savedChar; /* Holds the character termporarily replaced
- * by a null character during compilation
- * of the expression. */
- int inlineCode; /* 1 if inline "optimistic" code is
- * emitted for the expression; else 0. */
- int range = -1; /* If we inline compile an un-{}'d
- * expression, the index for its catch range
- * record in the ExceptionRange array.
- * Initialized to enable proper cleanup. */
- JumpFixup jumpFixup; /* Used to emit the "success" jump after
- * the inline expression code. */
- char *p;
- char c;
- int savePushSimpleWords = envPtr->pushSimpleWords;
- int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
- int saveExprIsComparison = envPtr->exprIsComparison;
- int numChars, result;
-
/*
- * Skip over leading white space.
+ * Create an error message to add to errorInfo, including up to a
+ * maximum number of characters of the command.
*/
- AdvanceToNextWord(src, envPtr);
- src += envPtr->termOffset;
- type = CHAR_TYPE(src, lastChar);
- if (type == TCL_COMMAND_END) {
- badArgs:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "malformed expression word", -1);
- result = TCL_ERROR;
- goto done;
- }
-
- /*
- * If the word is enclosed in {}s, we may strip them off and safely
- * compile the expression into an inline sequence of instructions using
- * TclCompileExpr. We know these instructions will have the right Tcl7.x
- * expression semantics.
- *
- * Otherwise, if the word is not enclosed in {}s, we may need to call
- * the expr command (Tcl_ExprObjCmd) at runtime. This recompiles the
- * expression each time (typically) and so is slow. However, there are
- * some circumstances where we can still compile inline instructions
- * "optimistically" and check, during their execution, for double
- * substitutions (these appear as nonnumeric operands). We check for any
- * backslash or command substitutions. If none appear, and only variable
- * substitutions are found, we generate inline instructions.
- *
- * For now, if the expression is not enclosed in {}s, we call the expr
- * command at runtime if either command or backslash substitutions
- * appear (but not if only variable substitutions appear).
- */
-
- if (*src == '{') {
- /*
- * Inline compile the expression inside {}s.
- */
-
- first = src+1;
- src = TclWordEnd(src, lastChar, nestedCmd, NULL);
- if (*src == 0) {
- goto badArgs;
- }
- if (*src != '}') {
- goto badArgs;
- }
- last = (src-1);
-
- numChars = (last - first + 1);
- savedChar = first[numChars];
- first[numChars] = '\0';
- result = TclCompileExpr(interp, first, first+numChars,
- flags, envPtr);
- first[numChars] = savedChar;
-
- src++;
- maxDepth = envPtr->maxStackDepth;
- } else {
- /*
- * No braces. If the expression is enclosed in '"'s, call the expr
- * cmd at runtime. Otherwise, scan the word's characters looking for
- * any '['s or (for now) '\'s. If any are found, just call expr cmd
- * at runtime.
- */
-
- first = src;
- last = TclWordEnd(first, lastChar, nestedCmd, NULL);
- if (*last == 0) { /* word doesn't end properly. */
- src = last;
- goto badArgs;
- }
-
- inlineCode = 1;
- if ((*first == '"') && (*last == '"')) {
- inlineCode = 0;
- } else {
- for (p = first; p <= last; p++) {
- c = *p;
- if ((c == '[') || (c == '\\')) {
- inlineCode = 0;
- break;
- }
- }
- }
-
- if (inlineCode) {
- /*
- * Inline compile the expression inside a "catch" so that a
- * runtime error will back off to make a (slow) call on expr.
- */
-
- int startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- int startRangeNext = envPtr->excRangeArrayNext;
-
- /*
- * Create a ExceptionRange record to hold information about
- * the "catch" range for the expression's inline code. Also
- * emit the instruction to mark the start of the range.
- */
-
- envPtr->excRangeDepth++;
- envPtr->maxExcRangeDepth =
- TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
- range = CreateExceptionRange(CATCH_EXCEPTION_RANGE, envPtr);
- TclEmitInstUInt4(INST_BEGIN_CATCH4, range, envPtr);
-
- /*
- * Inline compile the expression.
- */
-
- envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
- numChars = (last - first + 1);
- savedChar = first[numChars];
- first[numChars] = '\0';
- result = TclCompileExpr(interp, first, first + numChars,
- flags, envPtr);
- first[numChars] = savedChar;
-
- envPtr->excRangeArrayPtr[range].numCodeBytes =
- TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
-
- if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
- || (envPtr->exprIsComparison)) {
- /*
- * We must call the expr command at runtime. Either there
- * was a compilation error or the inline code might fail to
- * give the correct 2 level substitution semantics.
- *
- * The latter can happen if the expression consisted of just
- * a single variable reference or if the top-level operator
- * in the expr is a comparison (which might operate on
- * strings). In the latter case, the expression's code might
- * execute (apparently) successfully but produce the wrong
- * result. We depend on its execution failing if a second
- * level of substitutions is required. This causes the
- * "catch" code we generate around the inline code to back
- * off to a call on the expr command at runtime, and this
- * always gives the right 2 level substitution semantics.
- *
- * We delete the inline code by backing up the code pc and
- * catch index. Note that if there was a compilation error,
- * we can't report the error yet since the expression might
- * be valid after the second round of substitutions.
- */
-
- envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
- envPtr->excRangeArrayNext = startRangeNext;
- inlineCode = 0;
- } else {
- TclEmitOpcode(INST_END_CATCH, envPtr);
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
- }
- }
-
- /*
- * Arrange to call expr at runtime with the (already substituted
- * once) expression word on the stack.
- */
-
- envPtr->pushSimpleWords = 1;
- result = CompileWord(interp, first, lastChar, flags, envPtr);
- src += envPtr->termOffset;
- maxDepth = envPtr->maxStackDepth;
- if (result == TCL_OK) {
- TclEmitOpcode(INST_EXPR_STK, envPtr);
- }
-
- /*
- * If emitting inline code for this non-{}'d expression, update
- * the target of the jump after that inline code.
- */
-
- if (inlineCode) {
- int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
- /*
- * Update the inline expression code's catch ExceptionRange
- * target since it, being after the jump, also moved down.
- */
-
- envPtr->excRangeArrayPtr[range].catchOffset += 3;
- }
- }
- } /* if expression isn't in {}s */
-
- done:
- if (range != -1) {
- envPtr->excRangeDepth--;
+ if (length < 0) {
+ length = strlen(command);
}
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
- envPtr->exprIsComparison = saveExprIsComparison;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileCmdWordInline --
- *
- * Procedure that compiles a Tcl command word inline. If the word is
- * enclosed in quotes or braces, we call TclCompileString to compile it
- * after stripping them off. Otherwise, we normally push the word's
- * value and call eval at runtime, but if the word is just a sequence
- * of alphanumeric characters, we emit an invoke instruction
- * directly. This procedure assumes that string points to the start of
- * the word to compile.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while compiling string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * envPtr->termOffset is filled in with the offset of the character in
- * "string" just after the last one successfully processed.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
- * Side effects:
- * Instructions are added to envPtr to execute the command word
- * at runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to compile. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- Interp *iPtr = (Interp *) interp;
- register char *src = string;/* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute cmd. */
- char *termPtr; /* Points to char that terminated braced
- * string. */
- char savedChar; /* Holds the character termporarily replaced
- * by a null character during compilation
- * of the command. */
- int savePushSimpleWords = envPtr->pushSimpleWords;
- int objIndex;
- int result = TCL_OK;
- register char c;
-
- type = CHAR_TYPE(src, lastChar);
- if (type & (TCL_QUOTE | TCL_OPEN_BRACE)) {
- src++;
- envPtr->pushSimpleWords = 0;
- if (type == TCL_QUOTE) {
- result = TclCompileQuotes(interp, src, lastChar,
- '"', flags, envPtr);
- } else {
- result = CompileBraces(interp, src, lastChar, flags, envPtr);
- }
- if (result != TCL_OK) {
- goto done;
- }
-
- /*
- * Make sure the terminating character is the end of word.
- */
-
- termPtr = (src + envPtr->termOffset);
- c = *termPtr;
- if ((c == '\\') && (*(termPtr+1) == '\n')) {
- /*
- * Line is continued on next line; the backslash-newline turns
- * into space, which terminates the word.
- */
- } else {
- type = CHAR_TYPE(termPtr, lastChar);
- if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
- Tcl_ResetResult(interp);
- if (*(src-1) == '"') {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-quote", -1);
- } else {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra characters after close-brace", -1);
- }
- result = TCL_ERROR;
- goto done;
- }
- }
-
- if (envPtr->wordIsSimple) {
- /*
- * A simple word enclosed in "" or {}s. Call TclCompileString to
- * compile it inline. Add a null character after the end of the
- * quoted or braced string: i.e., at the " or }. Turn the
- * flag bit TCL_BRACKET_TERM off since the recursively
- * compiled subcommand is now terminated by a null character.
- */
- char *closeCharPos = (termPtr - 1);
-
- savedChar = *closeCharPos;
- *closeCharPos = '\0';
- result = TclCompileString(interp, src, closeCharPos,
- (flags & ~TCL_BRACKET_TERM), envPtr);
- *closeCharPos = savedChar;
- if (result != TCL_OK) {
- goto done;
- }
- } else {
- /*
- * The braced string contained a backslash-newline. Call eval
- * at runtime.
- */
- TclEmitOpcode(INST_EVAL_STK, envPtr);
- }
- src = termPtr;
- maxDepth = envPtr->maxStackDepth;
- } else {
- /*
- * Not a braced or quoted string. We normally push the word's
- * value and call eval at runtime. However, if the word is just
- * a sequence of alphanumeric characters, we call its compile
- * procedure, if any, or otherwise just emit an invoke instruction.
- */
-
- char *p = src;
- c = *p;
- while (isalnum(UCHAR(c)) || (c == '_')) {
- p++;
- c = *p;
- }
- type = CHAR_TYPE(p, lastChar);
- if ((p > src) && (type == TCL_COMMAND_END)) {
- /*
- * Look for a compile procedure and call it. Otherwise emit an
- * invoke instruction to call the command at runtime.
- */
-
- Tcl_Command cmd;
- Command *cmdPtr = NULL;
- int wasCompiled = 0;
-
- savedChar = *p;
- *p = '\0';
-
- cmd = Tcl_FindCommand(interp, src, (Tcl_Namespace *) NULL,
- /*flags*/ 0);
- if (cmd != (Tcl_Command) NULL) {
- cmdPtr = (Command *) cmd;
- }
- if (cmdPtr != NULL && cmdPtr->compileProc != NULL) {
- *p = savedChar;
- src = p;
- iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS
- | ERROR_CODE_SET);
- result = (*(cmdPtr->compileProc))(interp, src, lastChar, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- wasCompiled = 1;
- src += envPtr->termOffset;
- maxDepth = envPtr->maxStackDepth;
- }
- if (!wasCompiled) {
- objIndex = TclObjIndexForString(src, p-src,
- /*allocStrRep*/ 1, /*inHeap*/ 0, envPtr);
- *p = savedChar;
- TclEmitPush(objIndex, envPtr);
- TclEmitInstUInt1(INST_INVOKE_STK1, 1, envPtr);
- src = p;
- maxDepth = 1;
- }
- } else {
- /*
- * Push the word and call eval at runtime.
- */
-
- envPtr->pushSimpleWords = 1;
- result = CompileWord(interp, src, lastChar, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- TclEmitOpcode(INST_EVAL_STK, envPtr);
- src += envPtr->termOffset;
- maxDepth = envPtr->maxStackDepth;
- }
+ if (length > 150) {
+ length = 150;
+ ellipsis = "...";
}
-
- done:
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
+ sprintf(buffer, "\n while compiling\n\"%.*s%s\"",
+ length, command, ellipsis);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
}
/*
*----------------------------------------------------------------------
*
- * LookupCompiledLocal --
+ * TclFindCompiledLocal --
*
* This procedure is called at compile time to look up and optionally
* allocate an entry ("slot") for a variable in a procedure's array of
@@ -6584,39 +1674,37 @@ CompileCmdWordInline(interp, string, lastChar, flags, envPtr)
* referenced using their slot index.)
*
* Results:
- * If createIfNew is 0 (false) and the name is non-NULL, then if the
- * variable is found, the index of its entry in the procedure's array
- * of local variables is returned; otherwise -1 is returned.
- * If name is NULL, the index of a new temporary variable is returned.
- * Finally, if createIfNew is 1 and name is non-NULL, the index of a
- * new entry is returned.
+ * If create is 0 and the name is non-NULL, then if the variable is
+ * found, the index of its entry in the procedure's array of local
+ * variables is returned; otherwise -1 is returned. If name is NULL,
+ * the index of a new temporary variable is returned. Finally, if
+ * create is 1 and name is non-NULL, the index of a new entry is
+ * returned.
*
* Side effects:
- * Creates and registers a new local variable if createIfNew is 1 and
+ * Creates and registers a new local variable if create is 1 and
* the variable is unknown, or if the name is NULL.
*
*----------------------------------------------------------------------
*/
-static int
-LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
+int
+TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
register char *name; /* Points to first character of the name of
* a scalar or array variable. If NULL, a
* temporary var should be created. */
- int nameChars; /* The length of the name excluding the
- * terminating null character. */
- int createIfNew; /* 1 to allocate a local frame entry for the
- * variable if it is new. */
- int flagsIfCreated; /* Flag bits for the compiled local if
+ int nameBytes; /* Number of bytes in the name. */
+ int create; /* If 1, allocate a local frame entry for
+ * the variable if it is new. */
+ int flags; /* Flag bits for the compiled local if
* created. Only VAR_SCALAR, VAR_ARRAY, and
* VAR_LINK make sense. */
register Proc *procPtr; /* Points to structure describing procedure
* containing the variable reference. */
{
register CompiledLocal *localPtr;
- int localIndex = -1;
+ int localVar = -1;
register int i;
- int localCt;
/*
* If not creating a temporary, does a local variable of the specified
@@ -6624,14 +1712,13 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
*/
if (name != NULL) {
- localCt = procPtr->numCompiledLocals;
+ int localCt = procPtr->numCompiledLocals;
localPtr = procPtr->firstLocalPtr;
for (i = 0; i < localCt; i++) {
if (!TclIsVarTemporary(localPtr)) {
char *localName = localPtr->name;
- if ((name[0] == localName[0])
- && (nameChars == localPtr->nameLength)
- && (strncmp(name, localName, (unsigned) nameChars) == 0)) {
+ if ((nameBytes == localPtr->nameLength)
+ && (strncmp(name, localName, (unsigned) nameBytes) == 0)) {
return i;
}
}
@@ -6643,11 +1730,11 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
* Create a new variable if appropriate.
*/
- if (createIfNew || (name == NULL)) {
- localIndex = procPtr->numCompiledLocals;
+ if (create || (name == NULL)) {
+ localVar = procPtr->numCompiledLocals;
localPtr = (CompiledLocal *) ckalloc((unsigned)
(sizeof(CompiledLocal) - sizeof(localPtr->name)
- + nameChars+1));
+ + nameBytes+1));
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
@@ -6655,22 +1742,23 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
procPtr->lastLocalPtr = localPtr;
}
localPtr->nextPtr = NULL;
- localPtr->nameLength = nameChars;
- localPtr->frameIndex = localIndex;
- localPtr->flags = flagsIfCreated;
+ localPtr->nameLength = nameBytes;
+ localPtr->frameIndex = localVar;
+ localPtr->flags = flags;
if (name == NULL) {
localPtr->flags |= VAR_TEMPORARY;
}
localPtr->defValuePtr = NULL;
- localPtr->resolveInfo = NULL;
-
+ localPtr->resolveInfo = NULL;
+
if (name != NULL) {
- memcpy((VOID *) localPtr->name, (VOID *) name, (size_t) nameChars);
+ memcpy((VOID *) localPtr->name, (VOID *) name,
+ (size_t) nameBytes);
}
- localPtr->name[nameChars] = '\0';
+ localPtr->name[nameBytes] = '\0';
procPtr->numCompiledLocals++;
}
- return localIndex;
+ return localVar;
}
/*
@@ -6758,7 +1846,7 @@ TclInitCompiledLocals(interp, framePtr, nsPtr)
if (resVarInfo && resVarInfo->fetchProc) {
resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
- resVarInfo);
+ resVarInfo);
}
if (resolvedVarPtr) {
@@ -6789,277 +1877,6 @@ TclInitCompiledLocals(interp, framePtr, nsPtr)
/*
*----------------------------------------------------------------------
*
- * AdvanceToNextWord --
- *
- * This procedure is called to skip over any leading white space at the
- * start of a word. Note that a backslash-newline is treated as a
- * space.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Updates envPtr->termOffset with the offset of the first
- * character in "string" that was not white space or a
- * backslash-newline. This might be the offset of the character that
- * ends the command: a newline, null, semicolon, or close-bracket.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AdvanceToNextWord(string, envPtr)
- char *string; /* The source string to compile. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
-{
- register char *src; /* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
-
- src = string;
- type = CHAR_TYPE(src, src+1);
- while (type & (TCL_SPACE | TCL_BACKSLASH)) {
- if (type == TCL_BACKSLASH) {
- if (src[1] == '\n') {
- src += 2;
- } else {
- break; /* exit loop; no longer white space */
- }
- } else {
- src++;
- }
- type = CHAR_TYPE(src, src+1);
- }
- envPtr->termOffset = (src - string);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Backslash --
- *
- * Figure out how to handle a backslash sequence.
- *
- * Results:
- * The return value is the character that should be substituted
- * in place of the backslash sequence that starts at src. If
- * readPtr isn't NULL then it is filled in with a count of the
- * number of characters in the backslash sequence.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-char
-Tcl_Backslash(src, readPtr)
- CONST char *src; /* Points to the backslash character of
- * a backslash sequence. */
- int *readPtr; /* Fill in with number of characters read
- * from src, unless NULL. */
-{
- CONST char *p = src + 1;
- char result;
- int count;
-
- count = 2;
-
- switch (*p) {
- /*
- * Note: in the conversions below, use absolute values (e.g.,
- * 0xa) rather than symbolic values (e.g. \n) that get converted
- * by the compiler. It's possible that compilers on some
- * platforms will do the symbolic conversions differently, which
- * could result in non-portable Tcl scripts.
- */
-
- case 'a':
- result = 0x7;
- break;
- case 'b':
- result = 0x8;
- break;
- case 'f':
- result = 0xc;
- break;
- case 'n':
- result = 0xa;
- break;
- case 'r':
- result = 0xd;
- break;
- case 't':
- result = 0x9;
- break;
- case 'v':
- result = 0xb;
- break;
- case 'x':
- if (isxdigit(UCHAR(p[1]))) {
- char *end;
-
- result = (char) strtoul(p+1, &end, 16);
- count = end - src;
- } else {
- count = 2;
- result = 'x';
- }
- break;
- case '\n':
- do {
- p++;
- } while ((*p == ' ') || (*p == '\t'));
- result = ' ';
- count = p - src;
- break;
- case 0:
- result = '\\';
- count = 1;
- break;
- default:
- if (isdigit(UCHAR(*p))) {
- result = (char)(*p - '0');
- p++;
- if (!isdigit(UCHAR(*p))) {
- break;
- }
- count = 3;
- result = (char)((result << 3) + (*p - '0'));
- p++;
- if (!isdigit(UCHAR(*p))) {
- break;
- }
- count = 4;
- result = (char)((result << 3) + (*p - '0'));
- break;
- }
- result = *p;
- count = 2;
- break;
- }
-
- if (readPtr != NULL) {
- *readPtr = count;
- }
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclObjIndexForString --
- *
- * Procedure to find, or if necessary create, an object in a
- * CompileEnv's object array that has a string representation
- * matching the argument string.
- *
- * Results:
- * The index in the CompileEnv's object array of an object with a
- * string representation matching the argument "string". The object is
- * created if necessary. If inHeap is 1, then string is heap allocated
- * and ownership of the string is passed to TclObjIndexForString;
- * otherwise, the string is owned by the caller and must not be
- * modified or freed by TclObjIndexForString. Typically, a caller sets
- * inHeap 1 if string is an already heap-allocated buffer holding the
- * result of backslash substitutions.
- *
- * Side effects:
- * A new Tcl object will be created if no existing object matches the
- * input string. If allocStrRep is 1 then if a new object is created,
- * its string representation is allocated in the heap, else it is left
- * NULL. If inHeap is 1, this procedure is given ownership of the
- * string: if an object is created and allocStrRep is 1 then its
- * string representation is set directly from string, otherwise
- * the string is freed.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclObjIndexForString(string, length, allocStrRep, inHeap, envPtr)
- register char *string; /* Points to string for which an object is
- * found or created in CompileEnv's object
- * array. */
- int length; /* Length of string. */
- int allocStrRep; /* If 1 then the object's string rep should
- * be allocated in the heap. */
- int inHeap; /* If 1 then string is heap allocated and
- * its ownership is passed to
- * TclObjIndexForString. */
- CompileEnv *envPtr; /* Points to the CompileEnv in whose object
- * array an object is found or created. */
-{
- register Tcl_Obj *objPtr; /* Points to the object created for
- * the string, if one was created. */
- int objIndex; /* Index of matching object. */
- Tcl_HashEntry *hPtr;
- int strLength, new;
-
- /*
- * Look up the string in the code's object hashtable. If found, just
- * return the associated object array index. Note that if the string
- * has embedded nulls, we don't create a hash table entry. This
- * should be fixed, but we need to update hash tables, first.
- */
-
- strLength = strlen(string);
- if (length == -1) {
- length = strLength;
- }
- if (strLength != length) {
- hPtr = NULL;
- } else {
- hPtr = Tcl_CreateHashEntry(&envPtr->objTable, string, &new);
- if (!new) { /* already in object table and array */
- objIndex = (int) Tcl_GetHashValue(hPtr);
- if (inHeap) {
- ckfree(string);
- }
- return objIndex;
- }
- }
-
- /*
- * Create a new object holding the string, add it to the object array,
- * and register its index in the object hashtable.
- */
-
- objPtr = Tcl_NewObj();
- if (allocStrRep) {
- if (inHeap) { /* use input string for obj's string rep */
- objPtr->bytes = string;
- } else {
- if (length > 0) {
- objPtr->bytes = ckalloc((unsigned) length + 1);
- memcpy((VOID *) objPtr->bytes, (VOID *) string,
- (size_t) length);
- objPtr->bytes[length] = '\0';
- }
- }
- objPtr->length = length;
- } else { /* leave the string rep NULL */
- if (inHeap) {
- ckfree(string);
- }
- }
-
- if (envPtr->objArrayNext >= envPtr->objArrayEnd) {
- ExpandObjectArray(envPtr);
- }
- objIndex = envPtr->objArrayNext;
- envPtr->objArrayPtr[objIndex] = objPtr;
- Tcl_IncrRefCount(objPtr);
- envPtr->objArrayNext++;
-
- if (hPtr) {
- Tcl_SetHashValue(hPtr, objIndex);
- }
- return objIndex;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclExpandCodeArray --
*
* Procedure that uses malloc to allocate more storage for a
@@ -7088,7 +1905,7 @@ TclExpandCodeArray(envPtr)
* (envPtr->codeNext - 1) [inclusive].
*/
- size_t currBytes = TclCurrCodeOffset();
+ size_t currBytes = (envPtr->codeNext - envPtr->codeStart);
size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);
unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);
@@ -7110,57 +1927,6 @@ TclExpandCodeArray(envPtr)
/*
*----------------------------------------------------------------------
*
- * ExpandObjectArray --
- *
- * Procedure that uses malloc to allocate more storage for a
- * CompileEnv's object array.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object array in *envPtr is reallocated to a new array of
- * double the size, and if envPtr->mallocedObjArray is non-zero the
- * old array is freed. Tcl_Obj pointers are copied from the old array
- * to the new one.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ExpandObjectArray(envPtr)
- CompileEnv *envPtr; /* Points to the CompileEnv whose object
- * array must be enlarged. */
-{
- /*
- * envPtr->objArrayNext is equal to envPtr->objArrayEnd. The currently
- * allocated Tcl_Obj pointers are stored between elements
- * 0 and (envPtr->objArrayNext - 1) [inclusive] in the object array
- * pointed to by objArrayPtr.
- */
-
- size_t currBytes = envPtr->objArrayNext * sizeof(Tcl_Obj *);
- int newElems = 2*envPtr->objArrayEnd;
- size_t newBytes = newElems * sizeof(Tcl_Obj *);
- Tcl_Obj **newPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);
-
- /*
- * Copy from old object array to new, free old object array if needed,
- * and mark new object array as malloced.
- */
-
- memcpy((VOID *) newPtr, (VOID *) envPtr->objArrayPtr, currBytes);
- if (envPtr->mallocedObjArray) {
- ckfree((char *) envPtr->objArrayPtr);
- }
- envPtr->objArrayPtr = (Tcl_Obj **) newPtr;
- envPtr->objArrayEnd = newElems;
- envPtr->mallocedObjArray = 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* EnterCmdStartData --
*
* Registers the starting source and bytecode location of a
@@ -7223,14 +1989,14 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
if (cmdIndex > 0) {
if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
- panic("EnterCmdStartData: cmd map table not sorted by code offset");
+ panic("EnterCmdStartData: cmd map not sorted by code offset");
}
}
cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
cmdLocPtr->codeOffset = codeOffset;
cmdLocPtr->srcOffset = srcOffset;
- cmdLocPtr->numSrcChars = -1;
+ cmdLocPtr->numSrcBytes = -1;
cmdLocPtr->numCodeBytes = -1;
}
@@ -7256,248 +2022,38 @@ EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
*/
static void
-EnterCmdExtentData(envPtr, cmdIndex, numSrcChars, numCodeBytes)
+EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
CompileEnv *envPtr; /* Points to the compilation environment
* structure in which to enter command
* location information. */
int cmdIndex; /* Index of the command whose source and
* code length data is being set. */
- int numSrcChars; /* Number of command source chars. */
+ int numSrcBytes; /* Number of command source chars. */
int numCodeBytes; /* Offset of last byte of command code. */
{
CmdLocation *cmdLocPtr;
if ((cmdIndex < 0) || (cmdIndex >= envPtr->numCommands)) {
- panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
+ panic("EnterCmdExtentData: bad command index %d\n", cmdIndex);
}
if (cmdIndex > envPtr->cmdMapEnd) {
- panic("EnterCmdStartData: no start data registered for command with index %d\n", cmdIndex);
+ panic("EnterCmdExtentData: missing start data for command %d\n",
+ cmdIndex);
}
cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
- cmdLocPtr->numSrcChars = numSrcChars;
+ cmdLocPtr->numSrcBytes = numSrcBytes;
cmdLocPtr->numCodeBytes = numCodeBytes;
}
/*
*----------------------------------------------------------------------
*
- * InitArgInfo --
- *
- * Initializes a ArgInfo structure to hold information about
- * some number of argument words in a command.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The ArgInfo structure is initialized.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-InitArgInfo(argInfoPtr)
- register ArgInfo *argInfoPtr; /* Points to the ArgInfo structure
- * to initialize. */
-{
- argInfoPtr->numArgs = 0;
- argInfoPtr->startArray = argInfoPtr->staticStartSpace;
- argInfoPtr->endArray = argInfoPtr->staticEndSpace;
- argInfoPtr->allocArgs = ARGINFO_INIT_ENTRIES;
- argInfoPtr->mallocedArrays = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CollectArgInfo --
- *
- * Procedure to scan the argument words of a command and record the
- * start and finish of each argument word in a ArgInfo structure.
- *
- * Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while scanning string. If an error occurs then
- * the interpreter's result contains a standard error message.
- *
- * Side effects:
- * If necessary, the argument start and end arrays in *argInfoPtr
- * are grown and reallocated to a new arrays of double the size, and
- * if argInfoPtr->mallocedArray is non-zero the old arrays are freed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CollectArgInfo(interp, string, lastChar, flags, argInfoPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source command string to scan. */
- char *lastChar; /* Pointer to terminating character of
- * string. */
- int flags; /* Flags to control compilation (same as
- * passed to Tcl_Eval). */
- register ArgInfo *argInfoPtr;
- /* Points to the ArgInfo structure in which
- * to record the arg word information. */
-{
- register char *src = string;/* Points to current source char. */
- register int type; /* Current char's CHAR_TYPE type. */
- int nestedCmd = (flags & TCL_BRACKET_TERM);
- /* 1 if string being scanned is a nested
- * command and is terminated by a ']';
- * otherwise 0. */
- int scanningArgs; /* 1 if still scanning argument words to
- * determine their start and end. */
- char *wordStart, *wordEnd; /* Points to the first and last significant
- * characters of each word. */
- CompileEnv tempCompEnv; /* Only used to hold the termOffset field
- * updated by AdvanceToNextWord. */
- char *prev;
-
- argInfoPtr->numArgs = 0;
- scanningArgs = 1;
- while (scanningArgs) {
- AdvanceToNextWord(src, &tempCompEnv);
- src += tempCompEnv.termOffset;
- type = CHAR_TYPE(src, lastChar);
-
- if ((type == TCL_COMMAND_END) && ((*src != ']') || nestedCmd)) {
- break; /* done collecting argument words */
- } else if (*src == '"') {
- wordStart = src;
- src = TclWordEnd(src, lastChar, nestedCmd, NULL);
- if (src == lastChar) {
- badStringTermination:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "quoted string doesn't terminate properly", -1);
- return TCL_ERROR;
- }
- prev = (src-1);
- if (*src == '"') {
- wordEnd = src;
- src++;
- } else if ((*src == ';') && (*prev == '"')) {
- scanningArgs = 0;
- wordEnd = prev;
- } else {
- goto badStringTermination;
- }
- } else if (*src == '{') {
- wordStart = src;
- src = TclWordEnd(src, lastChar, nestedCmd, NULL);
- if (src == lastChar) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "missing close-brace", -1);
- return TCL_ERROR;
- }
- prev = (src-1);
- if (*src == '}') {
- wordEnd = src;
- src++;
- } else if ((*src == ';') && (*prev == '}')) {
- scanningArgs = 0;
- wordEnd = prev;
- } else {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "argument word in braces doesn't terminate properly", -1);
- return TCL_ERROR;
- }
- } else {
- wordStart = src;
- src = TclWordEnd(src, lastChar, nestedCmd, NULL);
- prev = (src-1);
- if (src == lastChar) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "missing close-bracket or close-brace", -1);
- return TCL_ERROR;
- } else if (*src == ';') {
- scanningArgs = 0;
- wordEnd = prev;
- } else {
- wordEnd = src;
- src++;
- if ((src == lastChar) || (*src == '\n')
- || ((*src == ']') && nestedCmd)) {
- scanningArgs = 0;
- }
- }
- } /* end of test on each kind of word */
-
- if (argInfoPtr->numArgs == argInfoPtr->allocArgs) {
- int newArgs = 2*argInfoPtr->numArgs;
- size_t currBytes = argInfoPtr->numArgs * sizeof(char *);
- size_t newBytes = newArgs * sizeof(char *);
- char **newStartArrayPtr =
- (char **) ckalloc((unsigned) newBytes);
- char **newEndArrayPtr =
- (char **) ckalloc((unsigned) newBytes);
-
- /*
- * Copy from the old arrays to the new, free the old arrays if
- * needed, and mark the new arrays as malloc'ed.
- */
-
- memcpy((VOID *) newStartArrayPtr,
- (VOID *) argInfoPtr->startArray, currBytes);
- memcpy((VOID *) newEndArrayPtr,
- (VOID *) argInfoPtr->endArray, currBytes);
- if (argInfoPtr->mallocedArrays) {
- ckfree((char *) argInfoPtr->startArray);
- ckfree((char *) argInfoPtr->endArray);
- }
- argInfoPtr->startArray = newStartArrayPtr;
- argInfoPtr->endArray = newEndArrayPtr;
- argInfoPtr->allocArgs = newArgs;
- argInfoPtr->mallocedArrays = 1;
- }
- argInfoPtr->startArray[argInfoPtr->numArgs] = wordStart;
- argInfoPtr->endArray[argInfoPtr->numArgs] = wordEnd;
- argInfoPtr->numArgs++;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeArgInfo --
- *
- * Free any storage allocated in a ArgInfo structure.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Allocated storage in the ArgInfo structure is freed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeArgInfo(argInfoPtr)
- register ArgInfo *argInfoPtr; /* Points to the ArgInfo structure
- * to free. */
-{
- if (argInfoPtr->mallocedArrays) {
- ckfree((char *) argInfoPtr->startArray);
- ckfree((char *) argInfoPtr->endArray);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CreateExceptionRange --
+ * TclCreateExceptRange --
*
* Procedure that allocates and initializes a new ExceptionRange
- * structure of the specified kind in a CompileEnv's ExceptionRange
- * array.
+ * structure of the specified kind in a CompileEnv.
*
* Results:
* Returns the index for the newly created ExceptionRange.
@@ -7505,37 +2061,32 @@ FreeArgInfo(argInfoPtr)
* Side effects:
* If there is not enough room in the CompileEnv's ExceptionRange
* array, the array in expanded: a new array of double the size is
- * allocated, if envPtr->mallocedExcRangeArray is non-zero the old
+ * allocated, if envPtr->mallocedExceptArray is non-zero the old
* array is freed, and ExceptionRange entries are copied from the old
* array to the new one.
*
*----------------------------------------------------------------------
*/
-static int
-CreateExceptionRange(type, envPtr)
+int
+TclCreateExceptRange(type, envPtr)
ExceptionRangeType type; /* The kind of ExceptionRange desired. */
- register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
- * loop ExceptionRange structure is to be
- * allocated. */
+ register CompileEnv *envPtr;/* Points to CompileEnv for which to
+ * create a new ExceptionRange structure. */
{
- int index; /* Index for the newly-allocated
- * ExceptionRange structure. */
register ExceptionRange *rangePtr;
- /* Points to the new ExceptionRange
- * structure */
+ int index = envPtr->exceptArrayNext;
- index = envPtr->excRangeArrayNext;
- if (index >= envPtr->excRangeArrayEnd) {
+ if (index >= envPtr->exceptArrayEnd) {
/*
* Expand the ExceptionRange array. The currently allocated entries
- * are stored between elements 0 and (envPtr->excRangeArrayNext - 1)
+ * are stored between elements 0 and (envPtr->exceptArrayNext - 1)
* [inclusive].
*/
size_t currBytes =
- envPtr->excRangeArrayNext * sizeof(ExceptionRange);
- int newElems = 2*envPtr->excRangeArrayEnd;
+ envPtr->exceptArrayNext * sizeof(ExceptionRange);
+ int newElems = 2*envPtr->exceptArrayEnd;
size_t newBytes = newElems * sizeof(ExceptionRange);
ExceptionRange *newPtr = (ExceptionRange *)
ckalloc((unsigned) newBytes);
@@ -7546,20 +2097,20 @@ CreateExceptionRange(type, envPtr)
* array as malloced.
*/
- memcpy((VOID *) newPtr, (VOID *) envPtr->excRangeArrayPtr,
+ memcpy((VOID *) newPtr, (VOID *) envPtr->exceptArrayPtr,
currBytes);
- if (envPtr->mallocedExcRangeArray) {
- ckfree((char *) envPtr->excRangeArrayPtr);
+ if (envPtr->mallocedExceptArray) {
+ ckfree((char *) envPtr->exceptArrayPtr);
}
- envPtr->excRangeArrayPtr = (ExceptionRange *) newPtr;
- envPtr->excRangeArrayEnd = newElems;
- envPtr->mallocedExcRangeArray = 1;
+ envPtr->exceptArrayPtr = (ExceptionRange *) newPtr;
+ envPtr->exceptArrayEnd = newElems;
+ envPtr->mallocedExceptArray = 1;
}
- envPtr->excRangeArrayNext++;
+ envPtr->exceptArrayNext++;
- rangePtr = &(envPtr->excRangeArrayPtr[index]);
+ rangePtr = &(envPtr->exceptArrayPtr[index]);
rangePtr->type = type;
- rangePtr->nestingLevel = envPtr->excRangeDepth;
+ rangePtr->nestingLevel = envPtr->exceptDepth;
rangePtr->codeOffset = -1;
rangePtr->numCodeBytes = -1;
rangePtr->breakOffset = -1;
@@ -7594,10 +2145,10 @@ CreateExceptionRange(type, envPtr)
int
TclCreateAuxData(clientData, typePtr, envPtr)
ClientData clientData; /* The compilation auxiliary data to store
- * in the new aux data record. */
+ * in the new aux data record. */
AuxDataType *typePtr; /* Pointer to the type to attach to this AuxData */
register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
- * aux data structure is to be allocated. */
+ * aux data structure is to be allocated. */
{
int index; /* Index for the new AuxData structure. */
register AuxData *auxDataPtr;
@@ -7633,8 +2184,8 @@ TclCreateAuxData(clientData, typePtr, envPtr)
envPtr->auxDataArrayNext++;
auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
- auxDataPtr->type = typePtr;
auxDataPtr->clientData = clientData;
+ auxDataPtr->type = typePtr;
return index;
}
@@ -7781,24 +2332,24 @@ TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
* Initialize the JumpFixup structure:
* - codeOffset is offset of first byte of jump below
* - cmdIndex is index of the command after the current one
- * - excRangeIndex is the index of the first ExceptionRange after
+ * - exceptIndex is the index of the first ExceptionRange after
* the current one.
*/
jumpFixupPtr->jumpType = jumpType;
- jumpFixupPtr->codeOffset = TclCurrCodeOffset();
+ jumpFixupPtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
jumpFixupPtr->cmdIndex = envPtr->numCommands;
- jumpFixupPtr->excRangeIndex = envPtr->excRangeArrayNext;
+ jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;
switch (jumpType) {
case TCL_UNCONDITIONAL_JUMP:
- TclEmitInstInt1(INST_JUMP1, /*offset*/ 0, envPtr);
+ TclEmitInstInt1(INST_JUMP1, 0, envPtr);
break;
case TCL_TRUE_JUMP:
- TclEmitInstInt1(INST_JUMP_TRUE1, /*offset*/ 0, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 0, envPtr);
break;
default:
- TclEmitInstInt1(INST_JUMP_FALSE1, /*offset*/ 0, envPtr);
+ TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
break;
}
}
@@ -7863,9 +2414,14 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
/*
* We must grow the jump then move subsequent instructions down.
+ * Note that if we expand the space for generated instructions,
+ * code addresses might change; be careful about updating any of
+ * these addresses held in variables.
*/
- TclEnsureCodeSpace(3, envPtr); /* NB: might change code addresses! */
+ if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
+ TclExpandCodeArray(envPtr);
+ }
jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
for (numBytes = envPtr->codeNext-jumpPc-2, p = jumpPc+2+numBytes-1;
numBytes > 0; numBytes--, p--) {
@@ -7898,10 +2454,10 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
}
}
- firstRange = jumpFixupPtr->excRangeIndex;
- lastRange = (envPtr->excRangeArrayNext - 1);
+ firstRange = jumpFixupPtr->exceptIndex;
+ lastRange = (envPtr->exceptArrayNext - 1);
for (k = firstRange; k <= lastRange; k++) {
- ExceptionRange *rangePtr = &(envPtr->excRangeArrayPtr[k]);
+ ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[k]);
rangePtr->codeOffset += 3;
switch (rangePtr->type) {
@@ -7915,7 +2471,8 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
rangePtr->catchOffset += 3;
break;
default:
- panic("TclFixupForwardJump: unrecognized ExceptionRange type %d\n", rangePtr->type);
+ panic("TclFixupForwardJump: bad ExceptionRange type %d\n",
+ rangePtr->type);
}
}
return 1; /* the jump was grown */
@@ -7931,8 +2488,8 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
* outside the TCL DLLs.
*
* Results:
- * Returns a pointer to the global instruction table, same as the expression
- * (&instructionTable[0]).
+ * Returns a pointer to the global instruction table, same as the
+ * expression (&instructionTable[0]).
*
* Side effects:
* None.
@@ -7974,6 +2531,7 @@ TclRegisterAuxDataType(typePtr)
register Tcl_HashEntry *hPtr;
int new;
+ Tcl_MutexLock(&tableMutex);
if (!auxDataTypeTableInitialized) {
TclInitAuxDataTypeTable();
}
@@ -7995,6 +2553,7 @@ TclRegisterAuxDataType(typePtr)
if (new) {
Tcl_SetHashValue(hPtr, typePtr);
}
+ Tcl_MutexUnlock(&tableMutex);
}
/*
@@ -8021,6 +2580,7 @@ TclGetAuxDataType(typeName)
register Tcl_HashEntry *hPtr;
AuxDataType *typePtr = NULL;
+ Tcl_MutexLock(&tableMutex);
if (!auxDataTypeTableInitialized) {
TclInitAuxDataTypeTable();
}
@@ -8029,6 +2589,7 @@ TclGetAuxDataType(typeName)
if (hPtr != (Tcl_HashEntry *) NULL) {
typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
}
+ Tcl_MutexUnlock(&tableMutex);
return typePtr;
}
@@ -8055,9 +2616,17 @@ TclGetAuxDataType(typeName)
void
TclInitAuxDataTypeTable()
{
- auxDataTypeTableInitialized = 1;
+ /*
+ * The table mutex must already be held before this routine is invoked.
+ */
+ auxDataTypeTableInitialized = 1;
Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
+
+ /*
+ * There is only one AuxData type at this time, so register it here.
+ */
+
TclRegisterAuxDataType(&tclForeachInfoType);
}
@@ -8068,13 +2637,14 @@ TclInitAuxDataTypeTable()
*
* 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.
+ * types. This procedure is called by TclFinalizeExecution() which
+ * is called by Tcl_Finalize().
*
* Results:
* None.
*
* Side effects:
- * Deletes all entries in the hash table of AuxData types, "auxDataTypeTable".
+ * Deletes all entries in the hash table of AuxData types.
*
*----------------------------------------------------------------------
*/
@@ -8082,8 +2652,747 @@ TclInitAuxDataTypeTable()
void
TclFinalizeAuxDataTypeTable()
{
+ Tcl_MutexLock(&tableMutex);
if (auxDataTypeTableInitialized) {
Tcl_DeleteHashTable(&auxDataTypeTable);
auxDataTypeTableInitialized = 0;
}
+ Tcl_MutexUnlock(&tableMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCmdLocEncodingSize --
+ *
+ * Computes the total number of bytes needed to encode the command
+ * location information for some compiled code.
+ *
+ * Results:
+ * The byte count needed to encode the compiled location information.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetCmdLocEncodingSize(envPtr)
+ CompileEnv *envPtr; /* Points to compilation environment
+ * structure containing the CmdLocation
+ * structure to encode. */
+{
+ register CmdLocation *mapPtr = envPtr->cmdMapPtr;
+ int numCmds = envPtr->numCommands;
+ int codeDelta, codeLen, srcDelta, srcLen;
+ int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
+ /* The offsets in their respective byte
+ * sequences where the next encoded offset
+ * or length should go. */
+ int prevCodeOffset, prevSrcOffset, i;
+
+ codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
+ prevCodeOffset = prevSrcOffset = 0;
+ for (i = 0; i < numCmds; i++) {
+ codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
+ if (codeDelta < 0) {
+ panic("GetCmdLocEncodingSize: bad code offset");
+ } else if (codeDelta <= 127) {
+ codeDeltaNext++;
+ } else {
+ codeDeltaNext += 5; /* 1 byte for 0xFF, 4 for positive delta */
+ }
+ prevCodeOffset = mapPtr[i].codeOffset;
+
+ codeLen = mapPtr[i].numCodeBytes;
+ if (codeLen < 0) {
+ panic("GetCmdLocEncodingSize: bad code length");
+ } else if (codeLen <= 127) {
+ codeLengthNext++;
+ } else {
+ codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
+ }
+
+ srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
+ if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+ srcDeltaNext++;
+ } else {
+ srcDeltaNext += 5; /* 1 byte for 0xFF, 4 for delta */
+ }
+ prevSrcOffset = mapPtr[i].srcOffset;
+
+ srcLen = mapPtr[i].numSrcBytes;
+ if (srcLen < 0) {
+ panic("GetCmdLocEncodingSize: bad source length");
+ } else if (srcLen <= 127) {
+ srcLengthNext++;
+ } else {
+ srcLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
+ }
+ }
+
+ return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncodeCmdLocMap --
+ *
+ * Encode the command location information for some compiled code into
+ * a ByteCode structure. The encoded command location map is stored as
+ * three adjacent byte sequences.
+ *
+ * Results:
+ * Pointer to the first byte after the encoded command location
+ * information.
+ *
+ * Side effects:
+ * The encoded information is stored into the block of memory headed
+ * by codePtr. Also records pointers to the start of the four byte
+ * sequences in fields in codePtr's ByteCode header structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned char *
+EncodeCmdLocMap(envPtr, codePtr, startPtr)
+ CompileEnv *envPtr; /* Points to compilation environment
+ * structure containing the CmdLocation
+ * structure to encode. */
+ ByteCode *codePtr; /* ByteCode in which to encode envPtr's
+ * command location information. */
+ unsigned char *startPtr; /* Points to the first byte in codePtr's
+ * memory block where the location
+ * information is to be stored. */
+{
+ register CmdLocation *mapPtr = envPtr->cmdMapPtr;
+ int numCmds = envPtr->numCommands;
+ register unsigned char *p = startPtr;
+ int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
+ register int i;
+
+ /*
+ * Encode the code offset for each command as a sequence of deltas.
+ */
+
+ codePtr->codeDeltaStart = p;
+ prevOffset = 0;
+ for (i = 0; i < numCmds; i++) {
+ codeDelta = (mapPtr[i].codeOffset - prevOffset);
+ if (codeDelta < 0) {
+ panic("EncodeCmdLocMap: bad code offset");
+ } else if (codeDelta <= 127) {
+ TclStoreInt1AtPtr(codeDelta, p);
+ p++;
+ } else {
+ TclStoreInt1AtPtr(0xFF, p);
+ p++;
+ TclStoreInt4AtPtr(codeDelta, p);
+ p += 4;
+ }
+ prevOffset = mapPtr[i].codeOffset;
+ }
+
+ /*
+ * Encode the code length for each command.
+ */
+
+ codePtr->codeLengthStart = p;
+ for (i = 0; i < numCmds; i++) {
+ codeLen = mapPtr[i].numCodeBytes;
+ if (codeLen < 0) {
+ panic("EncodeCmdLocMap: bad code length");
+ } else if (codeLen <= 127) {
+ TclStoreInt1AtPtr(codeLen, p);
+ p++;
+ } else {
+ TclStoreInt1AtPtr(0xFF, p);
+ p++;
+ TclStoreInt4AtPtr(codeLen, p);
+ p += 4;
+ }
+ }
+
+ /*
+ * Encode the source offset for each command as a sequence of deltas.
+ */
+
+ codePtr->srcDeltaStart = p;
+ prevOffset = 0;
+ for (i = 0; i < numCmds; i++) {
+ srcDelta = (mapPtr[i].srcOffset - prevOffset);
+ if ((-127 <= srcDelta) && (srcDelta <= 127)) {
+ TclStoreInt1AtPtr(srcDelta, p);
+ p++;
+ } else {
+ TclStoreInt1AtPtr(0xFF, p);
+ p++;
+ TclStoreInt4AtPtr(srcDelta, p);
+ p += 4;
+ }
+ prevOffset = mapPtr[i].srcOffset;
+ }
+
+ /*
+ * Encode the source length for each command.
+ */
+
+ codePtr->srcLengthStart = p;
+ for (i = 0; i < numCmds; i++) {
+ srcLen = mapPtr[i].numSrcBytes;
+ if (srcLen < 0) {
+ panic("EncodeCmdLocMap: bad source length");
+ } else if (srcLen <= 127) {
+ TclStoreInt1AtPtr(srcLen, p);
+ p++;
+ } else {
+ TclStoreInt1AtPtr(0xFF, p);
+ p++;
+ TclStoreInt4AtPtr(srcLen, p);
+ p += 4;
+ }
+ }
+
+ 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(interp, objPtr)
+ Tcl_Interp *interp; /* Used only for Tcl_GetStringFromObj. */
+ Tcl_Obj *objPtr; /* The bytecode object to disassemble. */
+{
+ ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ 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;
+
+ if (codePtr->refCount <= 0) {
+ return; /* already freed */
+ }
+
+ codeStart = codePtr->codeStart;
+ codeLimit = (codeStart + codePtr->numCodeBytes);
+ numCmds = codePtr->numCommands;
+
+ /*
+ * Print header lines describing the ByteCode.
+ */
+
+ fprintf(stdout, "\nByteCode 0x%x, refCt %u, epoch %u, interp 0x%x (epoch %u)\n",
+ (unsigned int) codePtr, codePtr->refCount,
+ codePtr->compileEpoch, (unsigned int) iPtr,
+ iPtr->compileEpoch);
+ fprintf(stdout, " Source ");
+ TclPrintSource(stdout, codePtr->source,
+ TclMin(codePtr->numSrcBytes, 55));
+ fprintf(stdout, "\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?
+ ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
+#else
+ 0.0);
+#endif
+#ifdef TCL_COMPILE_STATS
+ fprintf(stdout,
+ " Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
+ codePtr->structureSize,
+ (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
+ codePtr->numCodeBytes,
+ (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+ (codePtr->numExceptRanges * sizeof(ExceptionRange)),
+ (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;
+ fprintf(stdout,
+ " Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
+ (unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
+ numCompiledLocals);
+ if (numCompiledLocals > 0) {
+ CompiledLocal *localPtr = procPtr->firstLocalPtr;
+ for (i = 0; i < numCompiledLocals; i++) {
+ fprintf(stdout, " slot %d%s%s%s%s%s%s", i,
+ ((localPtr->flags & VAR_SCALAR)? ", scalar" : ""),
+ ((localPtr->flags & VAR_ARRAY)? ", array" : ""),
+ ((localPtr->flags & VAR_LINK)? ", link" : ""),
+ ((localPtr->flags & VAR_ARGUMENT)? ", arg" : ""),
+ ((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
+ ((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
+ if (TclIsVarTemporary(localPtr)) {
+ fprintf(stdout, "\n");
+ } else {
+ fprintf(stdout, ", \"%s\"\n", localPtr->name);
+ }
+ localPtr = localPtr->nextPtr;
+ }
+ }
+ }
+
+ /*
+ * Print the ExceptionRange array.
+ */
+
+ if (codePtr->numExceptRanges > 0) {
+ fprintf(stdout, " Exception ranges %d, depth %d:\n",
+ codePtr->numExceptRanges, codePtr->maxExceptDepth);
+ for (i = 0; i < codePtr->numExceptRanges; i++) {
+ ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[i]);
+ fprintf(stdout, " %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:
+ fprintf(stdout, "continue %d, break %d\n",
+ rangePtr->continueOffset, rangePtr->breakOffset);
+ break;
+ case CATCH_EXCEPTION_RANGE:
+ fprintf(stdout, "catch %d\n", rangePtr->catchOffset);
+ break;
+ default:
+ panic("TclPrintByteCodeObj: bad ExceptionRange type %d\n",
+ 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) {
+ fprintf(stdout, " ");
+ pc += TclPrintInstruction(codePtr, pc);
+ }
+ return;
+ }
+
+ /*
+ * Print table showing the code offset, source offset, and source
+ * length for each command. These are encoded as a sequence of bytes.
+ */
+
+ fprintf(stdout, " 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 int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+ codeDeltaNext++;
+ delta = TclGetInt4AtPtr(codeDeltaNext);
+ codeDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(codeDeltaNext);
+ codeDeltaNext++;
+ }
+ codeOffset += delta;
+
+ if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
+ codeLengthNext++;
+ codeLen = TclGetInt4AtPtr(codeLengthNext);
+ codeLengthNext += 4;
+ } else {
+ codeLen = TclGetInt1AtPtr(codeLengthNext);
+ codeLengthNext++;
+ }
+
+ if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+ srcDeltaNext++;
+ delta = TclGetInt4AtPtr(srcDeltaNext);
+ srcDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(srcDeltaNext);
+ srcDeltaNext++;
+ }
+ srcOffset += delta;
+
+ if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+ srcLengthNext++;
+ srcLen = TclGetInt4AtPtr(srcLengthNext);
+ srcLengthNext += 4;
+ } else {
+ srcLen = TclGetInt1AtPtr(srcLengthNext);
+ srcLengthNext++;
+ }
+
+ fprintf(stdout, "%s%4d: pc %d-%d, src %d-%d",
+ ((i % 2)? " " : "\n "),
+ (i+1), codeOffset, (codeOffset + codeLen - 1),
+ srcOffset, (srcOffset + srcLen - 1));
+ }
+ if (numCmds > 0) {
+ fprintf(stdout, "\n");
+ }
+
+ /*
+ * 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 int) (*codeDeltaNext) == (unsigned int) 0xFF) {
+ codeDeltaNext++;
+ delta = TclGetInt4AtPtr(codeDeltaNext);
+ codeDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(codeDeltaNext);
+ codeDeltaNext++;
+ }
+ codeOffset += delta;
+
+ if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
+ srcDeltaNext++;
+ delta = TclGetInt4AtPtr(srcDeltaNext);
+ srcDeltaNext += 4;
+ } else {
+ delta = TclGetInt1AtPtr(srcDeltaNext);
+ srcDeltaNext++;
+ }
+ srcOffset += delta;
+
+ if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
+ srcLengthNext++;
+ srcLen = TclGetInt4AtPtr(srcLengthNext);
+ srcLengthNext += 4;
+ } else {
+ srcLen = TclGetInt1AtPtr(srcLengthNext);
+ srcLengthNext++;
+ }
+
+ /*
+ * Print instructions before command i.
+ */
+
+ while ((pc-codeStart) < codeOffset) {
+ fprintf(stdout, " ");
+ pc += TclPrintInstruction(codePtr, pc);
+ }
+
+ fprintf(stdout, " Command %d: ", (i+1));
+ TclPrintSource(stdout, (codePtr->source + srcOffset),
+ TclMin(srcLen, 55));
+ fprintf(stdout, "\n");
+ }
+ if (pc < codeLimit) {
+ /*
+ * Print instructions after the last command.
+ */
+
+ while (pc < codeLimit) {
+ fprintf(stdout, " ");
+ pc += TclPrintInstruction(codePtr, pc);
+ }
+ }
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(codePtr, pc)
+ ByteCode* codePtr; /* Bytecode containing the instruction. */
+ unsigned char *pc; /* Points to first byte of instruction. */
+{
+ Proc *procPtr = codePtr->procPtr;
+ unsigned char opCode = *pc;
+ register InstructionDesc *instDesc = &instructionTable[opCode];
+ unsigned char *codeStart = codePtr->codeStart;
+ unsigned int pcOffset = (pc - codeStart);
+ int opnd, i, j;
+
+ fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
+ for (i = 0; i < instDesc->numOperands; i++) {
+ switch (instDesc->opTypes[i]) {
+ case OPERAND_INT1:
+ opnd = TclGetInt1AtPtr(pc+1+i);
+ if ((i == 0) && ((opCode == INST_JUMP1)
+ || (opCode == INST_JUMP_TRUE1)
+ || (opCode == INST_JUMP_FALSE1))) {
+ fprintf(stdout, "%d # pc %u", opnd, (pcOffset + opnd));
+ } else {
+ fprintf(stdout, "%d", opnd);
+ }
+ break;
+ case OPERAND_INT4:
+ opnd = TclGetInt4AtPtr(pc+1+i);
+ if ((i == 0) && ((opCode == INST_JUMP4)
+ || (opCode == INST_JUMP_TRUE4)
+ || (opCode == INST_JUMP_FALSE4))) {
+ fprintf(stdout, "%d # pc %u", opnd, (pcOffset + opnd));
+ } else {
+ fprintf(stdout, "%d", opnd);
+ }
+ break;
+ case OPERAND_UINT1:
+ opnd = TclGetUInt1AtPtr(pc+1+i);
+ if ((i == 0) && (opCode == INST_PUSH1)) {
+ fprintf(stdout, "%u # ", (unsigned int) opnd);
+ TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
+ } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
+ || (opCode == INST_LOAD_ARRAY1)
+ || (opCode == INST_STORE_SCALAR1)
+ || (opCode == INST_STORE_ARRAY1))) {
+ int localCt = procPtr->numCompiledLocals;
+ CompiledLocal *localPtr = procPtr->firstLocalPtr;
+ if (opnd >= localCt) {
+ panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
+ (unsigned int) opnd, localCt);
+ return instDesc->numBytes;
+ }
+ for (j = 0; j < opnd; j++) {
+ localPtr = localPtr->nextPtr;
+ }
+ if (TclIsVarTemporary(localPtr)) {
+ fprintf(stdout, "%u # temp var %u",
+ (unsigned int) opnd, (unsigned int) opnd);
+ } else {
+ fprintf(stdout, "%u # var ", (unsigned int) opnd);
+ TclPrintSource(stdout, localPtr->name, 40);
+ }
+ } else {
+ fprintf(stdout, "%u ", (unsigned int) opnd);
+ }
+ break;
+ case OPERAND_UINT4:
+ opnd = TclGetUInt4AtPtr(pc+1+i);
+ if (opCode == INST_PUSH4) {
+ fprintf(stdout, "%u # ", opnd);
+ TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
+ } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
+ || (opCode == INST_LOAD_ARRAY4)
+ || (opCode == INST_STORE_SCALAR4)
+ || (opCode == INST_STORE_ARRAY4))) {
+ int localCt = procPtr->numCompiledLocals;
+ CompiledLocal *localPtr = procPtr->firstLocalPtr;
+ if (opnd >= localCt) {
+ panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
+ (unsigned int) opnd, localCt);
+ return instDesc->numBytes;
+ }
+ for (j = 0; j < opnd; j++) {
+ localPtr = localPtr->nextPtr;
+ }
+ if (TclIsVarTemporary(localPtr)) {
+ fprintf(stdout, "%u # temp var %u",
+ (unsigned int) opnd, (unsigned int) opnd);
+ } else {
+ fprintf(stdout, "%u # var ", (unsigned int) opnd);
+ TclPrintSource(stdout, localPtr->name, 40);
+ }
+ } else {
+ fprintf(stdout, "%u ", (unsigned int) opnd);
+ }
+ break;
+ case OPERAND_NONE:
+ default:
+ break;
+ }
+ }
+ fprintf(stdout, "\n");
+ return instDesc->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(outFile, objPtr, maxChars)
+ 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(outFile, string, maxChars)
+ FILE *outFile; /* The file to print the source to. */
+ char *string; /* The string to print. */
+ int maxChars; /* Maximum number of chars to print. */
+{
+ register char *p;
+ register int i = 0;
+
+ if (string == NULL) {
+ fprintf(outFile, "\"\"");
+ return;
+ }
+
+ fprintf(outFile, "\"");
+ p = string;
+ for (; (*p != '\0') && (i < maxChars); p++, i++) {
+ switch (*p) {
+ case '"':
+ fprintf(outFile, "\\\"");
+ continue;
+ case '\f':
+ fprintf(outFile, "\\f");
+ continue;
+ case '\n':
+ fprintf(outFile, "\\n");
+ continue;
+ case '\r':
+ fprintf(outFile, "\\r");
+ continue;
+ case '\t':
+ fprintf(outFile, "\\t");
+ continue;
+ case '\v':
+ fprintf(outFile, "\\v");
+ continue;
+ default:
+ fprintf(outFile, "%c", *p);
+ continue;
+ }
+ }
+ fprintf(outFile, "\"");
+}
+
+#ifdef TCL_COMPILE_STATS
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecordByteCodeStats --
+ *
+ * Accumulates various compilation-related statistics for each newly
+ * compiled ByteCode. Called by the TclInitByteCodeObj when Tcl is
+ * compiled with the -DTCL_COMPILE_STATS flag
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Accumulates aggregate code-related statistics in the interpreter's
+ * ByteCodeStats structure. Records statistics specific to a ByteCode
+ * in its ByteCode structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+RecordByteCodeStats(codePtr)
+ ByteCode *codePtr; /* Points to ByteCode structure with info
+ * to add to accumulated statistics. */
+{
+ Interp *iPtr = (Interp *) *codePtr->interpHandle;
+ register ByteCodeStats *statsPtr = &(iPtr->stats);
+
+ statsPtr->numCompilations++;
+ statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes;
+ statsPtr->totalByteCodeBytes += (double) codePtr->structureSize;
+ statsPtr->currentSrcBytes += (double) codePtr->numSrcBytes;
+ statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;
+
+ statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++;
+ statsPtr->byteCodeCount[TclLog2(codePtr->structureSize)]++;
+
+ statsPtr->currentInstBytes += (double) codePtr->numCodeBytes;
+ statsPtr->currentLitBytes +=
+ (double) (codePtr->numLitObjects * sizeof(Tcl_Obj *));
+ statsPtr->currentExceptBytes +=
+ (double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
+ statsPtr->currentAuxBytes +=
+ (double) (codePtr->numAuxDataItems * sizeof(AuxData));
+ statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
+}
+#endif /* TCL_COMPILE_STATS */
+
diff --git a/tcl/generic/tclCompile.h b/tcl/generic/tclCompile.h
index 20a0f0fc17b..cd513510f38 100644
--- a/tcl/generic/tclCompile.h
+++ b/tcl/generic/tclCompile.h
@@ -1,7 +1,7 @@
/*
* tclCompile.h --
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -60,32 +60,6 @@ extern int tclTraceCompile;
extern int tclTraceExec;
/*
- * The number of bytecode compilations and various other compilation-related
- * statistics. The tclByteCodeCount and tclSourceCount arrays are used to
- * hold the count of ByteCodes and sources whose sizes fall into various
- * binary decades; e.g., tclByteCodeCount[5] is a count of the ByteCodes
- * with size larger than 2**4 and less than or equal to 2**5.
- */
-
-#ifdef TCL_COMPILE_STATS
-extern long tclNumCompilations;
-extern double tclTotalSourceBytes;
-extern double tclTotalCodeBytes;
-
-extern double tclTotalInstBytes;
-extern double tclTotalObjBytes;
-extern double tclTotalExceptBytes;
-extern double tclTotalAuxBytes;
-extern double tclTotalCmdMapBytes;
-
-extern double tclCurrentSourceBytes;
-extern double tclCurrentCodeBytes;
-
-extern int tclSourceCount[32];
-extern int tclByteCodeCount[32];
-#endif /* TCL_COMPILE_STATS */
-
-/*
*------------------------------------------------------------------------
* Data structures related to compilation.
*------------------------------------------------------------------------
@@ -108,12 +82,12 @@ extern int tclByteCodeCount[32];
*/
typedef enum {
- LOOP_EXCEPTION_RANGE, /* Code range is part of a loop command.
- * break and continue "exceptions" cause
+ LOOP_EXCEPTION_RANGE, /* Exception's range is part of a loop.
+ * Break and continue "exceptions" cause
* jumps to appropriate PC offsets. */
- CATCH_EXCEPTION_RANGE /* Code range is controlled by a catch
- * command. Errors in the range cause a
- * jump to a particular PC offset. */
+ CATCH_EXCEPTION_RANGE /* Exception's range is controlled by a
+ * catch command. Errors in the range cause
+ * a jump to a catch PC offset. */
} ExceptionRangeType;
typedef struct ExceptionRange {
@@ -124,16 +98,14 @@ typedef struct ExceptionRange {
int codeOffset; /* Offset of the first instruction byte of
* the code range. */
int numCodeBytes; /* Number of bytes in the code range. */
- int breakOffset; /* If a LOOP_EXCEPTION_RANGE, the target
- * PC offset for a break command in the
- * range. */
- int continueOffset; /* If a LOOP_EXCEPTION_RANGE and not -1,
- * the target PC offset for a continue
- * command in the code range. Otherwise,
- * ignore this range when processing a
- * continue command. */
+ int breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC
+ * offset for a break command in the range. */
+ int continueOffset; /* If LOOP_EXCEPTION_RANGE and not -1, the
+ * target PC offset for a continue command in
+ * the code range. Otherwise, ignore this range
+ * when processing a continue command. */
int catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC
- * offset for an "exception" in range. */
+ * offset for any "exception" in range. */
} ExceptionRange;
/*
@@ -148,7 +120,7 @@ typedef struct CmdLocation {
int codeOffset; /* Offset of first byte of command code. */
int numCodeBytes; /* Number of bytes for command's code. */
int srcOffset; /* Offset of first char of the command. */
- int numSrcChars; /* Number of command source chars. */
+ int numSrcBytes; /* Number of command source chars. */
} CmdLocation;
/*
@@ -210,7 +182,7 @@ typedef struct AuxData {
*/
#define COMPILEENV_INIT_CODE_BYTES 250
-#define COMPILEENV_INIT_NUM_OBJECTS 40
+#define COMPILEENV_INIT_NUM_OBJECTS 60
#define COMPILEENV_INIT_EXCEPT_RANGES 5
#define COMPILEENV_INIT_CMD_MAP_SIZE 40
#define COMPILEENV_INIT_AUX_DATA_SIZE 5
@@ -225,36 +197,25 @@ typedef struct CompileEnv {
* SetByteCodeFromAny. This pointer is not
* owned by the CompileEnv and must not be
* freed or changed by it. */
+ int numSrcBytes; /* Number of bytes in source. */
Proc *procPtr; /* If a procedure is being compiled, a
* pointer to its Proc structure; otherwise
* NULL. Used to compile local variables.
* Set from information provided by
* ObjInterpProc in tclProc.c. */
int numCommands; /* Number of commands compiled. */
- int excRangeDepth; /* Current exception range nesting level;
+ int exceptDepth; /* Current exception range nesting level;
* -1 if not in any range currently. */
- int maxExcRangeDepth; /* Max nesting level of exception ranges;
+ int maxExceptDepth; /* Max nesting level of exception ranges;
* -1 if no ranges have been compiled. */
int maxStackDepth; /* Maximum number of stack elements needed
* to execute the code. Set by compilation
* procedures before returning. */
- Tcl_HashTable objTable; /* Contains all Tcl objects referenced by
- * the compiled code. Indexed by the string
- * representations of the objects. Used to
+ LiteralTable localLitTable; /* Contains LiteralEntry's describing
+ * all Tcl objects referenced by this
+ * compiled code. Indexed by the string
+ * representations of the literals. Used to
* avoid creating duplicate objects. */
- int pushSimpleWords; /* Set 1 by callers of compilation routines
- * if they should emit instructions to push
- * "simple" command words (those that are
- * just a sequence of characters). If 0, the
- * callers are responsible for compiling
- * simple words. */
- int wordIsSimple; /* Set 1 by compilation procedures before
- * returning if the previous command word
- * was just a sequence of characters,
- * otherwise 0. Used to help determine the
- * command being compiled. */
- int numSimpleWordChars; /* If wordIsSimple is 1 then the number of
- * characters in the simple word, else 0. */
int exprIsJustVarRef; /* Set 1 if the expression last compiled by
* TclCompileExpr consisted of just a
* variable reference as in the expression
@@ -267,31 +228,29 @@ typedef struct CompileEnv {
* might be strings, the expr is compiled
* out-of-line to implement expr's 2 level
* substitution semantics properly. */
- int termOffset; /* Offset of character just after the last
- * one compiled. Set by compilation
- * procedures before returning. */
unsigned char *codeStart; /* Points to the first byte of the code. */
unsigned char *codeNext; /* Points to next code array byte to use. */
unsigned char *codeEnd; /* Points just after the last allocated
* code array byte. */
int mallocedCodeArray; /* Set 1 if code array was expanded
* and codeStart points into the heap.*/
- Tcl_Obj **objArrayPtr; /* Points to start of object array. */
- int objArrayNext; /* Index of next free object array entry. */
- int objArrayEnd; /* Index just after last obj array entry. */
- int mallocedObjArray; /* 1 if object array was expanded and
+ LiteralEntry *literalArrayPtr;
+ /* Points to start of LiteralEntry array. */
+ int literalArrayNext; /* Index of next free object array entry. */
+ int literalArrayEnd; /* Index just after last obj array entry. */
+ int mallocedLiteralArray; /* 1 if object array was expanded and
* objArray points into the heap, else 0. */
- ExceptionRange *excRangeArrayPtr;
+ ExceptionRange *exceptArrayPtr;
/* Points to start of the ExceptionRange
* array. */
- int excRangeArrayNext; /* Next free ExceptionRange array index.
- * excRangeArrayNext is the number of ranges
- * and (excRangeArrayNext-1) is the index of
+ int exceptArrayNext; /* Next free ExceptionRange array index.
+ * exceptArrayNext is the number of ranges
+ * and (exceptArrayNext-1) is the index of
* the current range's array entry. */
- int excRangeArrayEnd; /* Index after the last ExceptionRange
+ int exceptArrayEnd; /* Index after the last ExceptionRange
* array entry. */
- int mallocedExcRangeArray; /* 1 if ExceptionRange array was expanded
- * and excRangeArrayPtr points in heap,
+ int mallocedExceptArray; /* 1 if ExceptionRange array was expanded
+ * and exceptArrayPtr points in heap,
* else 0. */
CmdLocation *cmdMapPtr; /* Points to start of CmdLocation array.
* numCommands is the index of the next
@@ -310,9 +269,9 @@ typedef struct CompileEnv {
* auxDataArrayPtr points in heap else 0. */
unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
/* Initial storage for code. */
- Tcl_Obj *staticObjArraySpace[COMPILEENV_INIT_NUM_OBJECTS];
- /* Initial storage for object array. */
- ExceptionRange staticExcRangeArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
+ LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
+ /* Initial storage of LiteralEntry array. */
+ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
/* Initial ExceptionRange array storage. */
CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
/* Initial storage for cmd location map. */
@@ -324,8 +283,8 @@ typedef struct CompileEnv {
* The structure defining the bytecode instructions resulting from compiling
* a Tcl script. Note that this structure is variable length: a single heap
* object is allocated to hold the ByteCode structure immediately followed
- * by the code bytes, the object array, the ExceptionRange array, the
- * CmdLocation map, and the compilation AuxData array.
+ * by the code bytes, the literal object array, the ExceptionRange array,
+ * the CmdLocation map, and the compilation AuxData array.
*/
/*
@@ -335,10 +294,10 @@ typedef struct CompileEnv {
#define TCL_BYTECODE_PRECOMPILED 0x0001
typedef struct ByteCode {
- Interp *iPtr; /* Interpreter containing the code being
- * compiled. Commands and their compile
- * procs are specific to an interpreter so
- * the code emitted will depend on the
+ TclHandle interpHandle; /* Handle for interpreter containing the
+ * compiled code. Commands and their compile
+ * procs are specific to an interpreter so the
+ * code emitted will depend on the
* interpreter. */
int compileEpoch; /* Value of iPtr->compileEpoch when this
* ByteCode was compiled. Used to invalidate
@@ -367,29 +326,30 @@ typedef struct ByteCode {
* procedure body, this is a pointer to its
* Proc structure; otherwise NULL. This
* pointer is also not owned by the ByteCode
- * and must not be freed by it. Used for
- * debugging. */
- size_t totalSize; /* Total number of bytes required for this
- * ByteCode structure including the storage
- * for Tcl objects in its object array. */
+ * and must not be freed by it. */
+ size_t structureSize; /* Number of bytes in the ByteCode structure
+ * itself. Does not include heap space for
+ * literal Tcl objects or storage referenced
+ * by AuxData entries. */
int numCommands; /* Number of commands compiled. */
- int numSrcChars; /* Number of source chars compiled. */
+ int numSrcBytes; /* Number of source bytes compiled. */
int numCodeBytes; /* Number of code bytes. */
- int numObjects; /* Number of Tcl objects in object array. */
- int numExcRanges; /* Number of ExceptionRange array elems. */
+ int numLitObjects; /* Number of objects in literal array. */
+ int numExceptRanges; /* Number of ExceptionRange array elems. */
int numAuxDataItems; /* Number of AuxData items. */
int numCmdLocBytes; /* Number of bytes needed for encoded
* command location information. */
- int maxExcRangeDepth; /* Maximum nesting level of ExceptionRanges;
+ int maxExceptDepth; /* Maximum nesting level of ExceptionRanges;
* -1 if no ranges were compiled. */
int maxStackDepth; /* Maximum number of stack elements needed
* to execute the code. */
unsigned char *codeStart; /* Points to the first byte of the code.
* This is just after the final ByteCode
* member cmdMapPtr. */
- Tcl_Obj **objArrayPtr; /* Points to the start of the object array.
- * This is just after the last code byte. */
- ExceptionRange *excRangeArrayPtr;
+ Tcl_Obj **objArrayPtr; /* Points to the start of the literal
+ * object array. This is just after the
+ * last code byte. */
+ ExceptionRange *exceptArrayPtr;
/* Points to the start of the ExceptionRange
* array. This is just after the last
* object in the object array. */
@@ -430,106 +390,111 @@ typedef struct ByteCode {
* are always positive. This sequence is
* just after the last byte in the source
* delta sequence. */
+#ifdef TCL_COMPILE_STATS
+ Tcl_Time createTime; /* Absolute time when the ByteCode was
+ * created. */
+#endif /* TCL_COMPILE_STATS */
} ByteCode;
/*
- * Opcodes for the Tcl bytecode instructions. These opcodes must correspond
- * to the entries in the table of instruction descriptions in tclCompile.c.
- * Also, the order and number of the expression opcodes (e.g., INST_LOR)
- * must match the entries in the array operatorStrings in tclExecute.c.
+ * Opcodes for the Tcl bytecode instructions. These must correspond to the
+ * entries in the table of instruction descriptions, instructionTable, in
+ * tclCompile.c. Also, the order and number of the expression opcodes
+ * (e.g., INST_LOR) must match the entries in the array operatorStrings in
+ * tclExecute.c.
*/
/* Opcodes 0 to 9 */
#define INST_DONE 0
-#define INST_PUSH1 (INST_DONE + 1)
-#define INST_PUSH4 (INST_DONE + 2)
-#define INST_POP (INST_DONE + 3)
-#define INST_DUP (INST_DONE + 4)
-#define INST_CONCAT1 (INST_DONE + 5)
-#define INST_INVOKE_STK1 (INST_DONE + 6)
-#define INST_INVOKE_STK4 (INST_DONE + 7)
-#define INST_EVAL_STK (INST_DONE + 8)
-#define INST_EXPR_STK (INST_DONE + 9)
+#define INST_PUSH1 1
+#define INST_PUSH4 2
+#define INST_POP 3
+#define INST_DUP 4
+#define INST_CONCAT1 5
+#define INST_INVOKE_STK1 6
+#define INST_INVOKE_STK4 7
+#define INST_EVAL_STK 8
+#define INST_EXPR_STK 9
/* Opcodes 10 to 23 */
-#define INST_LOAD_SCALAR1 (INST_EXPR_STK + 1)
-#define INST_LOAD_SCALAR4 (INST_LOAD_SCALAR1 + 1)
-#define INST_LOAD_SCALAR_STK (INST_LOAD_SCALAR1 + 2)
-#define INST_LOAD_ARRAY1 (INST_LOAD_SCALAR1 + 3)
-#define INST_LOAD_ARRAY4 (INST_LOAD_SCALAR1 + 4)
-#define INST_LOAD_ARRAY_STK (INST_LOAD_SCALAR1 + 5)
-#define INST_LOAD_STK (INST_LOAD_SCALAR1 + 6)
-#define INST_STORE_SCALAR1 (INST_LOAD_SCALAR1 + 7)
-#define INST_STORE_SCALAR4 (INST_LOAD_SCALAR1 + 8)
-#define INST_STORE_SCALAR_STK (INST_LOAD_SCALAR1 + 9)
-#define INST_STORE_ARRAY1 (INST_LOAD_SCALAR1 + 10)
-#define INST_STORE_ARRAY4 (INST_LOAD_SCALAR1 + 11)
-#define INST_STORE_ARRAY_STK (INST_LOAD_SCALAR1 + 12)
-#define INST_STORE_STK (INST_LOAD_SCALAR1 + 13)
+#define INST_LOAD_SCALAR1 10
+#define INST_LOAD_SCALAR4 11
+#define INST_LOAD_SCALAR_STK 12
+#define INST_LOAD_ARRAY1 13
+#define INST_LOAD_ARRAY4 14
+#define INST_LOAD_ARRAY_STK 15
+#define INST_LOAD_STK 16
+#define INST_STORE_SCALAR1 17
+#define INST_STORE_SCALAR4 18
+#define INST_STORE_SCALAR_STK 19
+#define INST_STORE_ARRAY1 20
+#define INST_STORE_ARRAY4 21
+#define INST_STORE_ARRAY_STK 22
+#define INST_STORE_STK 23
/* Opcodes 24 to 33 */
-#define INST_INCR_SCALAR1 (INST_STORE_STK + 1)
-#define INST_INCR_SCALAR_STK (INST_INCR_SCALAR1 + 1)
-#define INST_INCR_ARRAY1 (INST_INCR_SCALAR1 + 2)
-#define INST_INCR_ARRAY_STK (INST_INCR_SCALAR1 + 3)
-#define INST_INCR_STK (INST_INCR_SCALAR1 + 4)
-#define INST_INCR_SCALAR1_IMM (INST_INCR_SCALAR1 + 5)
-#define INST_INCR_SCALAR_STK_IMM (INST_INCR_SCALAR1 + 6)
-#define INST_INCR_ARRAY1_IMM (INST_INCR_SCALAR1 + 7)
-#define INST_INCR_ARRAY_STK_IMM (INST_INCR_SCALAR1 + 8)
-#define INST_INCR_STK_IMM (INST_INCR_SCALAR1 + 9)
+#define INST_INCR_SCALAR1 24
+#define INST_INCR_SCALAR_STK 25
+#define INST_INCR_ARRAY1 26
+#define INST_INCR_ARRAY_STK 27
+#define INST_INCR_STK 28
+#define INST_INCR_SCALAR1_IMM 29
+#define INST_INCR_SCALAR_STK_IMM 30
+#define INST_INCR_ARRAY1_IMM 31
+#define INST_INCR_ARRAY_STK_IMM 32
+#define INST_INCR_STK_IMM 33
/* Opcodes 34 to 39 */
-#define INST_JUMP1 (INST_INCR_STK_IMM + 1)
-#define INST_JUMP4 (INST_JUMP1 + 1)
-#define INST_JUMP_TRUE1 (INST_JUMP1 + 2)
-#define INST_JUMP_TRUE4 (INST_JUMP1 + 3)
-#define INST_JUMP_FALSE1 (INST_JUMP1 + 4)
-#define INST_JUMP_FALSE4 (INST_JUMP1 + 5)
+#define INST_JUMP1 34
+#define INST_JUMP4 35
+#define INST_JUMP_TRUE1 36
+#define INST_JUMP_TRUE4 37
+#define INST_JUMP_FALSE1 38
+#define INST_JUMP_FALSE4 39
/* Opcodes 40 to 64 */
-#define INST_LOR (INST_JUMP_FALSE4 + 1)
-#define INST_LAND (INST_LOR + 1)
-#define INST_BITOR (INST_LOR + 2)
-#define INST_BITXOR (INST_LOR + 3)
-#define INST_BITAND (INST_LOR + 4)
-#define INST_EQ (INST_LOR + 5)
-#define INST_NEQ (INST_LOR + 6)
-#define INST_LT (INST_LOR + 7)
-#define INST_GT (INST_LOR + 8)
-#define INST_LE (INST_LOR + 9)
-#define INST_GE (INST_LOR + 10)
-#define INST_LSHIFT (INST_LOR + 11)
-#define INST_RSHIFT (INST_LOR + 12)
-#define INST_ADD (INST_LOR + 13)
-#define INST_SUB (INST_LOR + 14)
-#define INST_MULT (INST_LOR + 15)
-#define INST_DIV (INST_LOR + 16)
-#define INST_MOD (INST_LOR + 17)
-#define INST_UPLUS (INST_LOR + 18)
-#define INST_UMINUS (INST_LOR + 19)
-#define INST_BITNOT (INST_LOR + 20)
-#define INST_LNOT (INST_LOR + 21)
-#define INST_CALL_BUILTIN_FUNC1 (INST_LOR + 22)
-#define INST_CALL_FUNC1 (INST_LOR + 23)
-#define INST_TRY_CVT_TO_NUMERIC (INST_LOR + 24)
+#define INST_LOR 40
+#define INST_LAND 41
+#define INST_BITOR 42
+#define INST_BITXOR 43
+#define INST_BITAND 44
+#define INST_EQ 45
+#define INST_NEQ 46
+#define INST_LT 47
+#define INST_GT 48
+#define INST_LE 49
+#define INST_GE 50
+#define INST_LSHIFT 51
+#define INST_RSHIFT 52
+#define INST_ADD 53
+#define INST_SUB 54
+#define INST_MULT 55
+#define INST_DIV 56
+#define INST_MOD 57
+#define INST_UPLUS 58
+#define INST_UMINUS 59
+#define INST_BITNOT 60
+#define INST_LNOT 61
+#define INST_CALL_BUILTIN_FUNC1 62
+#define INST_CALL_FUNC1 63
+#define INST_TRY_CVT_TO_NUMERIC 64
/* Opcodes 65 to 66 */
-#define INST_BREAK (INST_TRY_CVT_TO_NUMERIC + 1)
-#define INST_CONTINUE (INST_BREAK + 1)
+#define INST_BREAK 65
+#define INST_CONTINUE 66
/* Opcodes 67 to 68 */
-#define INST_FOREACH_START4 (INST_CONTINUE + 1)
-#define INST_FOREACH_STEP4 (INST_FOREACH_START4 + 1)
+#define INST_FOREACH_START4 67
+#define INST_FOREACH_STEP4 68
/* Opcodes 69 to 72 */
-#define INST_BEGIN_CATCH4 (INST_FOREACH_STEP4 + 1)
-#define INST_END_CATCH (INST_BEGIN_CATCH4 + 1)
-#define INST_PUSH_RESULT (INST_BEGIN_CATCH4 + 2)
-#define INST_PUSH_RETURN_CODE (INST_BEGIN_CATCH4 + 3)
+#define INST_BEGIN_CATCH4 69
+#define INST_END_CATCH 70
+#define INST_PUSH_RESULT 71
+#define INST_PUSH_RETURN_CODE 72
/* The last opcode */
-#define LAST_INST_OPCODE INST_PUSH_RETURN_CODE
+#define LAST_INST_OPCODE 72
/*
* Table describing the Tcl bytecode instructions: their name (for
@@ -594,7 +559,7 @@ extern InstructionDesc instructionTable[];
#define BUILTIN_FUNC_ROUND 23
#define BUILTIN_FUNC_SRAND 24
-#define LAST_BUILTIN_FUNC BUILTIN_FUNC_SRAND
+#define LAST_BUILTIN_FUNC 24
/*
* Table describing the built-in math functions. Entries in this table are
@@ -618,30 +583,6 @@ typedef struct {
extern BuiltinFunc builtinFuncTable[];
/*
- * The structure used to hold information about the start and end of each
- * argument word in a command.
- */
-
-#define ARGINFO_INIT_ENTRIES 5
-
-typedef struct ArgInfo {
- int numArgs; /* Number of argument words in command. */
- char **startArray; /* Array of pointers to the first character
- * of each argument word. */
- char **endArray; /* Array of pointers to the last character
- * of each argument word. */
- int allocArgs; /* Number of array entries currently
- * allocated. */
- int mallocedArrays; /* 1 if the arrays were expanded and
- * wordStartArray/wordEndArray point into
- * the heap, else 0. */
- char *staticStartSpace[ARGINFO_INIT_ENTRIES];
- /* Initial storage for word start array. */
- char *staticEndSpace[ARGINFO_INIT_ENTRIES];
- /* Initial storage for word end array. */
-} ArgInfo;
-
-/*
* 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
@@ -669,7 +610,7 @@ typedef struct JumpFixup {
* update the code offsets for subsequent
* commands if the two-byte jump at jumpPc
* must be replaced with a five-byte one. */
- int excRangeIndex; /* Index of the first range entry in the
+ int exceptIndex; /* Index of the first range entry in the
* ExceptionRange array after the current
* one. This field is used to adjust the
* code offsets in subsequent ExceptionRange
@@ -716,12 +657,12 @@ typedef struct ForeachVarList {
typedef struct ForeachInfo {
int numLists; /* The number of both the variable and value
* lists of the foreach command. */
- int firstListTmp; /* The slot number of the first temporary
- * variable holding the lists themselves. */
- int loopIterNumTmp; /* The slot number of the temp var holding
- * the count of times the loop body has been
- * executed. This is used to determine which
- * list element to assign each loop var. */
+ int firstValueTemp; /* Index of the first temp var in a proc
+ * frame used to point to a value list. */
+ int loopCtTemp; /* Index of temp var in a proc frame
+ * holding the loop's iteration count. Used
+ * to determine next value list element to
+ * assign each loop var. */
ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
* structures describing each var list. The
* actual size of this field will be large
@@ -729,6 +670,8 @@ typedef struct ForeachInfo {
* THE LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;
+extern AuxDataType tclForeachInfoType;
+
/*
* Structure containing a cached pointer to a command that is the result
* of resolving the command's name in some namespace. It is the internal
@@ -772,25 +715,31 @@ typedef struct ResolvedCmdName {
*/
EXTERN void TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
+EXTERN int TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, int count,
+ CompileEnv *envPtr));
EXTERN int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int flags,
+ char *script, int numBytes,
CompileEnv *envPtr));
-EXTERN int TclCompileQuotes _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int termChar,
- int flags, CompileEnv *envPtr));
-EXTERN int TclCompileString _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int flags,
+EXTERN int TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, int numWords,
CompileEnv *envPtr));
-EXTERN int TclCompileDollarVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int flags,
+EXTERN int TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
+ char *script, int numBytes, int nested,
+ CompileEnv *envPtr));
+EXTERN int TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, int count,
CompileEnv *envPtr));
EXTERN int TclCreateAuxData _ANSI_ARGS_((ClientData clientData,
- AuxDataType *typePtr, CompileEnv *envPtr));
+ AuxDataType *typePtr, CompileEnv *envPtr));
+EXTERN int TclCreateExceptRange _ANSI_ARGS_((
+ ExceptionRangeType type, CompileEnv *envPtr));
EXTERN ExecEnv * TclCreateExecEnv _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void TclDeleteExecEnv _ANSI_ARGS_((ExecEnv *eePtr));
+EXTERN void TclDeleteLiteralTable _ANSI_ARGS_((
+ Tcl_Interp *interp, LiteralTable *tablePtr));
EXTERN void TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
TclJumpType jumpType, JumpFixup *jumpFixupPtr));
-EXTERN AuxDataType *TclGetAuxDataType _ANSI_ARGS_((char *typeName));
EXTERN ExceptionRange * TclGetExceptionRangeForPc _ANSI_ARGS_((
unsigned char *pc, int catchOnly,
ByteCode* codePtr));
@@ -798,10 +747,15 @@ EXTERN InstructionDesc * TclGetInstructionTable _ANSI_ARGS_(());
EXTERN int TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
ByteCode *codePtr));
EXTERN void TclExpandCodeArray _ANSI_ARGS_((
- CompileEnv *envPtr));
+ CompileEnv *envPtr));
EXTERN void TclExpandJumpFixupArray _ANSI_ARGS_((
JumpFixupArray *fixupArrayPtr));
EXTERN void TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void));
+EXTERN int TclFindCompiledLocal _ANSI_ARGS_((char *name,
+ int nameChars, int create, int flags,
+ Proc *procPtr));
+EXTERN LiteralEntry * TclLookupLiteralEntry _ANSI_ARGS_((
+ Tcl_Interp *interp, Tcl_Obj *objPtr));
EXTERN int TclFixupForwardJump _ANSI_ARGS_((
CompileEnv *envPtr, JumpFixup *jumpFixupPtr,
int jumpDist, int distThreshold));
@@ -811,21 +765,42 @@ EXTERN void TclFreeJumpFixupArray _ANSI_ARGS_((
EXTERN void TclInitAuxDataTypeTable _ANSI_ARGS_((void));
EXTERN void TclInitByteCodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
CompileEnv *envPtr));
+EXTERN void TclInitCompilation _ANSI_ARGS_((void));
EXTERN void TclInitCompileEnv _ANSI_ARGS_((Tcl_Interp *interp,
- CompileEnv *envPtr, char *string));
+ CompileEnv *envPtr, char *string,
+ int numBytes));
EXTERN void TclInitJumpFixupArray _ANSI_ARGS_((
JumpFixupArray *fixupArrayPtr));
+EXTERN void TclInitLiteralTable _ANSI_ARGS_((
+ LiteralTable *tablePtr));
#ifdef TCL_COMPILE_STATS
+EXTERN char * TclLiteralStats _ANSI_ARGS_((
+ LiteralTable *tablePtr));
EXTERN int TclLog2 _ANSI_ARGS_((int value));
-#endif /*TCL_COMPILE_STATS*/
-EXTERN int TclObjIndexForString _ANSI_ARGS_((char *start,
- int length, int allocStrRep, int inHeap,
- CompileEnv *envPtr));
+#endif
+#ifdef TCL_COMPILE_DEBUG
+EXTERN void TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+#endif
EXTERN int TclPrintInstruction _ANSI_ARGS_((ByteCode* codePtr,
unsigned char *pc));
+EXTERN void TclPrintObject _ANSI_ARGS_((FILE *outFile,
+ Tcl_Obj *objPtr, int maxChars));
EXTERN void TclPrintSource _ANSI_ARGS_((FILE *outFile,
char *string, int maxChars));
EXTERN void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
+EXTERN int TclRegisterLiteral _ANSI_ARGS_((CompileEnv *envPtr,
+ char *bytes, int length, int onHeap));
+EXTERN void TclReleaseLiteral _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+EXTERN void TclSetCmdNameObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Command *cmdPtr));
+#ifdef TCL_COMPILE_DEBUG
+EXTERN void TclVerifyGlobalLiteralTable _ANSI_ARGS_((
+ Interp *iPtr));
+EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
+ CompileEnv *envPtr));
+#endif
/*
*----------------------------------------------------------------
@@ -835,23 +810,6 @@ EXTERN void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
*/
/*
- * Macros to ensure there is enough room in a CompileEnv's code array.
- * The ANSI C "prototypes" for these macros are:
- *
- * EXTERN void TclEnsureCodeSpace1 _ANSI_ARGS_((CompileEnv *envPtr));
- * EXTERN void TclEnsureCodeSpace _ANSI_ARGS_((int nBytes,
- * CompileEnv *envPtr));
- */
-
-#define TclEnsureCodeSpace1(envPtr) \
- if ((envPtr)->codeNext == (envPtr)->codeEnd) \
- TclExpandCodeArray(envPtr)
-
-#define TclEnsureCodeSpace(nBytes, envPtr) \
- if (((envPtr)->codeNext + nBytes) > (envPtr)->codeEnd) \
- TclExpandCodeArray(envPtr)
-
-/*
* Macro to emit an opcode byte into a CompileEnv's code array.
* The ANSI C "prototype" for this macro is:
*
@@ -860,55 +818,45 @@ EXTERN void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
*/
#define TclEmitOpcode(op, envPtr) \
- TclEnsureCodeSpace1(envPtr); \
+ if ((envPtr)->codeNext == (envPtr)->codeEnd) \
+ TclExpandCodeArray(envPtr); \
*(envPtr)->codeNext++ = (unsigned char) (op)
/*
- * Macros to emit a (signed or unsigned) int operand. The two variants
- * depend on the number of bytes needed for the int. Four byte integers
- * are stored in "big-endian" order with the high order byte stored at
- * the lowest address. The ANSI C "prototypes" for these macros are:
+ * Macro to emit an integer operand.
+ * The ANSI C "prototype" for this macro is:
*
* EXTERN void TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr));
- * EXTERN void TclEmitInt4 _ANSI_ARGS_((int i, CompileEnv *envPtr));
*/
#define TclEmitInt1(i, envPtr) \
- TclEnsureCodeSpace(1, (envPtr)); \
+ if ((envPtr)->codeNext == (envPtr)->codeEnd) \
+ TclExpandCodeArray(envPtr); \
*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
-#define TclEmitInt4(i, envPtr) \
- TclEnsureCodeSpace(4, (envPtr)); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 24); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 16); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) >> 8); \
- *(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) )
-
/*
- * Macros to emit an instruction with signed or unsigned int operands.
+ * Macros to emit an instruction with signed or unsigned integer operands.
+ * Four byte integers are stored in "big-endian" order with the high order
+ * byte stored at the lowest address.
* The ANSI C "prototypes" for these macros are:
*
* EXTERN void TclEmitInstInt1 _ANSI_ARGS_((unsigned char op, int i,
* CompileEnv *envPtr));
* EXTERN void TclEmitInstInt4 _ANSI_ARGS_((unsigned char op, int i,
* CompileEnv *envPtr));
- * EXTERN void TclEmitInstUInt1 _ANSI_ARGS_((unsigned char op,
- * unsigned int i, CompileEnv *envPtr));
- * EXTERN void TclEmitInstUInt4 _ANSI_ARGS_((unsigned char op,
- * unsigned int i, CompileEnv *envPtr));
*/
#define TclEmitInstInt1(op, i, envPtr) \
- TclEnsureCodeSpace(2, (envPtr)); \
+ if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
*(envPtr)->codeNext++ = (unsigned char) (op); \
*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
#define TclEmitInstInt4(op, i, envPtr) \
- TclEnsureCodeSpace(5, (envPtr)); \
+ if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
+ TclExpandCodeArray(envPtr); \
+ } \
*(envPtr)->codeNext++ = (unsigned char) (op); \
*(envPtr)->codeNext++ = \
(unsigned char) ((unsigned int) (i) >> 24); \
@@ -919,12 +867,6 @@ EXTERN void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
*(envPtr)->codeNext++ = \
(unsigned char) ((unsigned int) (i) )
-#define TclEmitInstUInt1(op, i, envPtr) \
- TclEmitInstInt1((op), (i), (envPtr))
-
-#define TclEmitInstUInt4(op, i, envPtr) \
- TclEmitInstInt4((op), (i), (envPtr))
-
/*
* Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
* object's one or four byte array index into the CompileEnv's code
@@ -936,9 +878,9 @@ EXTERN void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
#define TclEmitPush(objIndex, envPtr) \
if ((objIndex) <= 255) { \
- TclEmitInstUInt1(INST_PUSH1, (objIndex), (envPtr)); \
+ TclEmitInstInt1(INST_PUSH1, (objIndex), (envPtr)); \
} else { \
- TclEmitInstUInt4(INST_PUSH4, (objIndex), (envPtr)); \
+ TclEmitInstInt4(INST_PUSH4, (objIndex), (envPtr)); \
}
/*
@@ -1032,22 +974,6 @@ EXTERN void TclRegisterAuxDataType _ANSI_ARGS_((AuxDataType *typePtr));
#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j))
#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j))
-/*
- * Macro used to compute the offset of the current instruction in the
- * bytecode instruction stream. The ANSI C "prototypes" for this macro is:
- *
- * EXTERN int TclCurrCodeOffset _ANSI_ARGS_((void));
- */
-
-#define TclCurrCodeOffset() ((envPtr)->codeNext - (envPtr)->codeStart)
-
-/*
- * Upper bound for legal jump distances. Checked during compilation if
- * debugging.
- */
-
-#define MAX_JUMP_DIST 5000
-
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT
diff --git a/tcl/generic/tclDate.c b/tcl/generic/tclDate.c
index 9d91c2b4719..c7d01419618 100644
--- a/tcl/generic/tclDate.c
+++ b/tcl/generic/tclDate.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id$
+ * RCS: @(#) $Id$
*/
#include "tclInt.h"
@@ -37,7 +37,7 @@
#define HOUR(x) ((int) (60 * x))
#define SECSPERDAY (24L * 60L * 60L)
-
+#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
/*
* An entry in the lexical lookup table.
@@ -74,8 +74,10 @@ static char *TclDateInput;
static DSTMODE TclDateDSTmode;
static time_t TclDateDayOrdinal;
static time_t TclDateDayNumber;
+static time_t TclDateMonthOrdinal;
static int TclDateHaveDate;
static int TclDateHaveDay;
+static int TclDateHaveOrdinalMonth;
static int TclDateHaveRel;
static int TclDateHaveTime;
static int TclDateHaveZone;
@@ -88,8 +90,9 @@ static time_t TclDateSeconds;
static time_t TclDateYear;
static MERIDIAN TclDateMeridian;
static time_t TclDateRelMonth;
+static time_t TclDateRelDay;
static time_t TclDateRelSeconds;
-
+static time_t *TclDateRelPointer;
/*
* Prototypes of internal functions.
@@ -101,10 +104,14 @@ static int Convert _ANSI_ARGS_((time_t Month, time_t Day, time_t Year,
time_t Hours, time_t Minutes, time_t Seconds,
MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr));
static time_t DSTcorrect _ANSI_ARGS_((time_t Start, time_t Future));
-static time_t RelativeDate _ANSI_ARGS_((time_t Start, time_t DayOrdinal,
+static time_t NamedDay _ANSI_ARGS_((time_t Start, time_t DayOrdinal,
time_t DayNumber));
+static time_t NamedMonth _ANSI_ARGS_((time_t Start, time_t MonthOrdinal,
+ time_t MonthNumber));
static int RelativeMonth _ANSI_ARGS_((time_t Start, time_t RelMonth,
time_t *TimePtr));
+static int RelativeDay _ANSI_ARGS_((time_t Start, time_t RelDay,
+ time_t *TimePtr));
static int LookupWord _ANSI_ARGS_((char *buff));
static int TclDatelex _ANSI_ARGS_((void));
@@ -126,31 +133,40 @@ typedef union
# define tMINUTE_UNIT 262
# define tMONTH 263
# define tMONTH_UNIT 264
-# define tSEC_UNIT 265
-# define tSNUMBER 266
-# define tUNUMBER 267
-# define tZONE 268
-# define tEPOCH 269
-# define tDST 270
+# define tSTARDATE 265
+# define tSEC_UNIT 266
+# define tSNUMBER 267
+# define tUNUMBER 268
+# define tZONE 269
+# define tEPOCH 270
+# define tDST 271
+# define tISOBASE 272
+# define tDAY_UNIT 273
+# define tNEXT 274
-#ifdef __cplusplus
+#if defined(__cplusplus) || defined(__STDC__)
+
+#if defined(__cplusplus) && defined(__EXTERN_C__)
+extern "C" {
+#endif
#ifndef TclDateerror
- void TclDateerror(const char *);
+#if defined(__cplusplus)
+ void TclDateerror(CONST char *);
+#endif
#endif
-
#ifndef TclDatelex
-#ifdef __EXTERN_C__
- extern "C" { int TclDatelex(void); }
-#else
int TclDatelex(void);
#endif
-#endif
int TclDateparse(void);
+#if defined(__cplusplus) && defined(__EXTERN_C__)
+}
+#endif
#endif
+
#define TclDateclearin TclDatechar = -1
#define TclDateerrok TclDateerrflag = 0
extern int TclDatechar;
@@ -208,15 +224,15 @@ static TABLE MonthDayTable[] = {
*/
static TABLE UnitsTable[] = {
{ "year", tMONTH_UNIT, 12 },
- { "month", tMONTH_UNIT, 1 },
- { "fortnight", tMINUTE_UNIT, 14 * 24 * 60 },
- { "week", tMINUTE_UNIT, 7 * 24 * 60 },
- { "day", tMINUTE_UNIT, 1 * 24 * 60 },
- { "hour", tMINUTE_UNIT, 60 },
- { "minute", tMINUTE_UNIT, 1 },
- { "min", tMINUTE_UNIT, 1 },
- { "second", tSEC_UNIT, 1 },
- { "sec", tSEC_UNIT, 1 },
+ { "month", tMONTH_UNIT, 1 },
+ { "fortnight", tDAY_UNIT, 14 },
+ { "week", tDAY_UNIT, 7 },
+ { "day", tDAY_UNIT, 1 },
+ { "hour", tSEC_UNIT, 60 * 60 },
+ { "minute", tSEC_UNIT, 60 },
+ { "min", tSEC_UNIT, 60 },
+ { "second", tSEC_UNIT, 1 },
+ { "sec", tSEC_UNIT, 1 },
{ NULL }
};
@@ -224,16 +240,16 @@ static TABLE UnitsTable[] = {
* Assorted relative-time words.
*/
static TABLE OtherTable[] = {
- { "tomorrow", tMINUTE_UNIT, 1 * 24 * 60 },
- { "yesterday", tMINUTE_UNIT, -1 * 24 * 60 },
- { "today", tMINUTE_UNIT, 0 },
- { "now", tMINUTE_UNIT, 0 },
- { "last", tUNUMBER, -1 },
- { "this", tMINUTE_UNIT, 0 },
- { "next", tUNUMBER, 2 },
+ { "tomorrow", tDAY_UNIT, 1 },
+ { "yesterday", tDAY_UNIT, -1 },
+ { "today", tDAY_UNIT, 0 },
+ { "now", tSEC_UNIT, 0 },
+ { "last", tUNUMBER, -1 },
+ { "this", tSEC_UNIT, 0 },
+ { "next", tNEXT, 1 },
#if 0
{ "first", tUNUMBER, 1 },
-/* { "second", tUNUMBER, 2 }, */
+ { "second", tUNUMBER, 2 },
{ "third", tUNUMBER, 3 },
{ "fourth", tUNUMBER, 4 },
{ "fifth", tUNUMBER, 5 },
@@ -247,6 +263,7 @@ static TABLE OtherTable[] = {
#endif
{ "ago", tAGO, 1 },
{ "epoch", tEPOCH, 0 },
+ { "stardate", tSTARDATE, 0},
{ NULL }
};
@@ -258,7 +275,8 @@ static TABLE TimezoneTable[] = {
{ "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */
{ "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */
{ "utc", tZONE, HOUR( 0) },
- { "wet", tZONE, HOUR( 0) } , /* Western European */
+ { "uct", tZONE, HOUR( 0) }, /* Universal Coordinated Time */
+ { "wet", tZONE, HOUR( 0) }, /* Western European */
{ "bst", tDAYZONE, HOUR( 0) }, /* British Summer */
{ "wat", tZONE, HOUR( 1) }, /* West Africa */
{ "at", tZONE, HOUR( 2) }, /* Azores */
@@ -290,6 +308,7 @@ static TABLE TimezoneTable[] = {
{ "nt", tZONE, HOUR(11) }, /* Nome */
{ "idlw", tZONE, HOUR(12) }, /* International Date Line West */
{ "cet", tZONE, -HOUR( 1) }, /* Central European */
+ { "cest", tDAYZONE, -HOUR( 1) }, /* Central European Summer */
{ "met", tZONE, -HOUR( 1) }, /* Middle European */
{ "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */
{ "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */
@@ -399,7 +418,22 @@ ToSeconds(Hours, Minutes, Seconds, Meridian)
return -1; /* Should never be reached */
}
-
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Convert --
+ *
+ * Convert a {month, day, year, hours, minutes, seconds, meridian, dst}
+ * tuple into a clock seconds value.
+ *
+ * Results:
+ * 0 or -1 indicating success or failure.
+ *
+ * Side effects:
+ * Fills TimePtr with the computed value.
+ *
+ *-----------------------------------------------------------------------------
+ */
static int
Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
time_t Month;
@@ -419,29 +453,44 @@ Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
time_t Julian;
int i;
- DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0)
- ? 29 : 28;
+ /* Figure out how many days are in February for the given year.
+ * Every year divisible by 4 is a leap year.
+ * But, every year divisible by 100 is not a leap year.
+ * But, every year divisible by 400 is a leap year after all.
+ */
+ DaysInMonth[1] = IsLeapYear(Year) ? 29 : 28;
+
+ /* Check the inputs for validity */
if (Month < 1 || Month > 12
- || Year < START_OF_TIME || Year > END_OF_TIME
- || Day < 1 || Day > DaysInMonth[(int)--Month])
+ || Year < START_OF_TIME || Year > END_OF_TIME
+ || Day < 1 || Day > DaysInMonth[(int)--Month])
return -1;
+ /* Start computing the value. First determine the number of days
+ * represented by the date, then multiply by the number of seconds/day.
+ */
for (Julian = Day - 1, i = 0; i < Month; i++)
Julian += DaysInMonth[i];
if (Year >= EPOCH) {
for (i = EPOCH; i < Year; i++)
- Julian += 365 + (i % 4 == 0);
+ Julian += 365 + IsLeapYear(i);
} else {
for (i = Year; i < EPOCH; i++)
- Julian -= 365 + (i % 4 == 0);
+ Julian -= 365 + IsLeapYear(i);
}
Julian *= SECSPERDAY;
+
+ /* Add the timezone offset ?? */
Julian += TclDateTimezone * 60L;
+
+ /* Add the number of seconds represented by the time component */
if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
return -1;
Julian += tod;
+
+ /* Perform a preliminary DST compensation ?? */
if (DSTmode == DSTon
- || (DSTmode == DSTmaybe && TclpGetDate(&Julian, 0)->tm_isdst))
+ || (DSTmode == DSTmaybe && TclpGetDate((TclpTime_t)&Julian, 0)->tm_isdst))
Julian -= 60 * 60;
*TimePtr = Julian;
return 0;
@@ -455,15 +504,14 @@ DSTcorrect(Start, Future)
{
time_t StartDay;
time_t FutureDay;
-
- StartDay = (TclpGetDate(&Start, 0)->tm_hour + 1) % 24;
- FutureDay = (TclpGetDate(&Future, 0)->tm_hour + 1) % 24;
+ StartDay = (TclpGetDate((TclpTime_t)&Start, 0)->tm_hour + 1) % 24;
+ FutureDay = (TclpGetDate((TclpTime_t)&Future, 0)->tm_hour + 1) % 24;
return (Future - Start) + (StartDay - FutureDay) * 60L * 60L;
}
static time_t
-RelativeDate(Start, DayOrdinal, DayNumber)
+NamedDay(Start, DayOrdinal, DayNumber)
time_t Start;
time_t DayOrdinal;
time_t DayNumber;
@@ -472,12 +520,41 @@ RelativeDate(Start, DayOrdinal, DayNumber)
time_t now;
now = Start;
- tm = TclpGetDate(&now, 0);
+ tm = TclpGetDate((TclpTime_t)&now, 0);
now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7);
now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1);
return DSTcorrect(Start, now);
}
+static time_t
+NamedMonth(Start, MonthOrdinal, MonthNumber)
+ time_t Start;
+ time_t MonthOrdinal;
+ time_t MonthNumber;
+{
+ struct tm *tm;
+ time_t now;
+ int result;
+
+ now = Start;
+ tm = TclpGetDate((TclpTime_t)&now, 0);
+ /* To compute the next n'th month, we use this alg:
+ * add n to year value
+ * if currentMonth < requestedMonth decrement year value by 1 (so that
+ * doing next february from january gives us february of the current year)
+ * set day to 1, time to 0
+ */
+ tm->tm_year += MonthOrdinal;
+ if (tm->tm_mon < MonthNumber - 1) {
+ tm->tm_year--;
+ }
+ result = Convert(MonthNumber, (time_t) 1, tm->tm_year + TM_YEAR_BASE,
+ (time_t) 0, (time_t) 0, (time_t) 0, MER24, DSTmaybe, &now);
+ if (result < 0) {
+ return 0;
+ }
+ return DSTcorrect(Start, now);
+}
static int
RelativeMonth(Start, RelMonth, TimePtr)
@@ -495,7 +572,7 @@ RelativeMonth(Start, RelMonth, TimePtr)
*TimePtr = 0;
return 0;
}
- tm = TclpGetDate(&Start, 0);
+ tm = TclpGetDate((TclpTime_t)&Start, 0);
Month = 12 * (tm->tm_year + TM_YEAR_BASE) + tm->tm_mon + RelMonth;
Year = Month / 12;
Month = Month % 12 + 1;
@@ -524,6 +601,36 @@ RelativeMonth(Start, RelMonth, TimePtr)
}
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * RelativeDay --
+ *
+ * Given a starting time and a number of days before or after, compute the
+ * DST corrected difference between those dates.
+ *
+ * Results:
+ * 1 or -1 indicating success or failure.
+ *
+ * Side effects:
+ * Fills TimePtr with the computed value.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+RelativeDay(Start, RelDay, TimePtr)
+ time_t Start;
+ time_t RelDay;
+ time_t *TimePtr;
+{
+ time_t new;
+
+ new = Start + (RelDay * 60 * 60 * 24);
+ *TimePtr = DSTcorrect(Start, new);
+ return 1;
+}
+
static int
LookupWord(buff)
char *buff;
@@ -537,11 +644,8 @@ LookupWord(buff)
/*
* Make it lowercase.
*/
- for (p = buff; *p; p++) {
- if (isupper(UCHAR(*p))) {
- *p = (char) tolower(UCHAR(*p));
- }
- }
+
+ Tcl_UtfToLower(buff);
if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
TclDatelval.Meridian = MERam;
@@ -614,7 +718,8 @@ LookupWord(buff)
/*
* Military timezones.
*/
- if (buff[1] == '\0' && isalpha(UCHAR(*buff))) {
+ if (buff[1] == '\0' && !(*buff & 0x80)
+ && isalpha(UCHAR(*buff))) { /* INTL: ISO only */
for (tp = MilitaryTable; tp->name; tp++) {
if (strcmp(buff, tp->name) == 0) {
TclDatelval.Number = tp->value;
@@ -653,36 +758,31 @@ TclDatelex()
register char *p;
char buff[20];
int Count;
- int sign;
for ( ; ; ) {
- while (isspace((unsigned char) (*TclDateInput))) {
+ while (isspace(UCHAR(*TclDateInput))) {
TclDateInput++;
}
- if (isdigit(c = *TclDateInput) || c == '-' || c == '+') {
- if (c == '-' || c == '+') {
- sign = c == '-' ? -1 : 1;
- if (!isdigit(*++TclDateInput)) {
- /*
- * skip the '-' sign
- */
- continue;
- }
- } else {
- sign = 0;
- }
- for (TclDatelval.Number = 0; isdigit(c = *TclDateInput++); ) {
+ if (isdigit(UCHAR(c = *TclDateInput))) { /* INTL: digit */
+ /* convert the string into a number; count the number of digits */
+ Count = 0;
+ for (TclDatelval.Number = 0;
+ isdigit(UCHAR(c = *TclDateInput++)); ) { /* INTL: digit */
TclDatelval.Number = 10 * TclDatelval.Number + c - '0';
+ Count++;
}
TclDateInput--;
- if (sign < 0) {
- TclDatelval.Number = -TclDatelval.Number;
+ /* A number with 6 or more digits is considered an ISO 8601 base */
+ if (Count >= 6) {
+ return tISOBASE;
+ } else {
+ return tUNUMBER;
}
- return sign ? tSNUMBER : tUNUMBER;
}
- if (isalpha(UCHAR(c))) {
- for (p = buff; isalpha(c = *TclDateInput++) || c == '.'; ) {
+ if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
+ for (p = buff; isalpha(UCHAR(c = *TclDateInput++)) /* INTL: ISO only. */
+ || c == '.'; ) {
if (p < &buff[sizeof buff - 1]) {
*p++ = c;
}
@@ -726,7 +826,9 @@ TclGetDate(p, now, zone, timePtr)
int thisyear;
TclDateInput = p;
- tm = TclpGetDate((time_t *) &now, 0);
+ /* now has to be cast to a time_t for 64bit compliance */
+ Start = now;
+ tm = TclpGetDate((TclpTime_t) &Start, 0);
thisyear = tm->tm_year + TM_YEAR_BASE;
TclDateYear = thisyear;
TclDateMonth = tm->tm_mon + 1;
@@ -744,14 +846,18 @@ TclGetDate(p, now, zone, timePtr)
TclDateMeridian = MER24;
TclDateRelSeconds = 0;
TclDateRelMonth = 0;
+ TclDateRelDay = 0;
+ TclDateRelPointer = NULL;
+
TclDateHaveDate = 0;
TclDateHaveDay = 0;
+ TclDateHaveOrdinalMonth = 0;
TclDateHaveRel = 0;
TclDateHaveTime = 0;
TclDateHaveZone = 0;
if (TclDateparse() || TclDateHaveTime > 1 || TclDateHaveZone > 1 || TclDateHaveDate > 1 ||
- TclDateHaveDay > 1) {
+ TclDateHaveDay > 1 || TclDateHaveOrdinalMonth > 1) {
return -1;
}
@@ -783,7 +889,8 @@ TclGetDate(p, now, zone, timePtr)
} else {
Start = now;
if (!TclDateHaveRel) {
- Start -= ((tm->tm_hour * 60L) + tm->tm_min * 60L) + tm->tm_sec;
+ Start -= ((tm->tm_hour * 60L * 60L) +
+ tm->tm_min * 60L) + tm->tm_sec;
}
}
@@ -793,31 +900,45 @@ TclGetDate(p, now, zone, timePtr)
}
Start += Time;
+ if (RelativeDay(Start, TclDateRelDay, &Time) < 0) {
+ return -1;
+ }
+ Start += Time;
+
if (TclDateHaveDay && !TclDateHaveDate) {
- tod = RelativeDate(Start, TclDateDayOrdinal, TclDateDayNumber);
+ tod = NamedDay(Start, TclDateDayOrdinal, TclDateDayNumber);
Start += tod;
}
+ if (TclDateHaveOrdinalMonth) {
+ tod = NamedMonth(Start, TclDateMonthOrdinal, TclDateMonth);
+ Start += tod;
+ }
+
*timePtr = Start;
return 0;
}
-TclDatetabelem TclDateexca[] ={
+static CONST TclDatetabelem TclDateexca[] ={
-1, 1,
0, -1,
-2, 0,
};
-# define YYNPROD 41
-# define YYLAST 227
-TclDatetabelem TclDateact[]={
-
- 14, 11, 23, 28, 17, 12, 19, 18, 16, 9,
- 10, 13, 42, 21, 46, 45, 44, 48, 41, 37,
- 36, 35, 32, 29, 34, 33, 31, 43, 39, 38,
- 30, 15, 8, 7, 6, 5, 4, 3, 2, 1,
+# define YYNPROD 56
+# define YYLAST 261
+static CONST TclDatetabelem TclDateact[]={
+
+ 24, 40, 23, 36, 54, 81, 41, 28, 53, 26,
+ 37, 42, 58, 38, 56, 28, 27, 26, 28, 33,
+ 26, 32, 61, 50, 27, 80, 76, 27, 51, 75,
+ 74, 73, 30, 72, 71, 70, 69, 52, 49, 48,
+ 47, 45, 39, 62, 78, 46, 79, 68, 25, 65,
+ 60, 67, 66, 55, 44, 21, 63, 11, 10, 9,
+ 8, 35, 7, 6, 5, 4, 3, 43, 2, 1,
+ 20, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 57, 0, 0, 59, 77, 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, 47, 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,
@@ -827,51 +948,65 @@ TclDatetabelem TclDateact[]={
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 22, 0, 0, 20, 25, 24, 27,
- 26, 42, 0, 0, 0, 0, 40 };
-TclDatetabelem TclDatepact[]={
-
--10000000, -258,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000, -45,
- -267,-10000000, -244,-10000000, -14, -231, -240,-10000000,-10000000,-10000000,
--10000000, -246,-10000000, -247, -248,-10000000,-10000000,-10000000,-10000000, -15,
--10000000,-10000000,-10000000,-10000000,-10000000, -40, -20,-10000000, -251,-10000000,
--10000000, -252,-10000000, -253,-10000000, -249,-10000000,-10000000,-10000000 };
-TclDatetabelem TclDatepgo[]={
-
- 0, 28, 39, 38, 37, 36, 35, 34, 33, 32,
- 31 };
-TclDatetabelem TclDater1[]={
-
- 0, 2, 2, 3, 3, 3, 3, 3, 3, 4,
- 4, 4, 4, 4, 5, 5, 5, 7, 7, 7,
- 6, 6, 6, 6, 6, 6, 6, 8, 8, 10,
- 10, 10, 10, 10, 10, 10, 10, 10, 9, 1,
- 1 };
-TclDatetabelem TclDater2[]={
-
- 0, 0, 4, 3, 3, 3, 3, 3, 2, 5,
- 9, 9, 13, 13, 5, 3, 3, 3, 5, 5,
- 7, 11, 5, 9, 5, 3, 7, 5, 2, 5,
- 5, 3, 5, 5, 3, 5, 5, 3, 3, 1,
- 3 };
-TclDatetabelem TclDatechk[]={
-
--10000000, -2, -3, -4, -5, -6, -7, -8, -9, 267,
- 268, 259, 263, 269, 258, -10, 266, 262, 265, 264,
- 261, 58, 258, 47, 263, 262, 265, 264, 270, 267,
- 44, 257, 262, 265, 264, 267, 267, 267, 44, -1,
- 266, 58, 261, 47, 267, 267, 267, -1, 266 };
-TclDatetabelem TclDatedef[]={
-
- 1, -2, 2, 3, 4, 5, 6, 7, 8, 38,
- 15, 16, 0, 25, 17, 28, 0, 31, 34, 37,
- 9, 0, 19, 0, 24, 29, 33, 36, 14, 22,
- 18, 27, 30, 32, 35, 39, 20, 26, 0, 10,
- 11, 0, 40, 0, 23, 39, 21, 12, 13 };
+ 0, 0, 0, 0, 0, 19, 14, 0, 0, 0,
+ 16, 28, 22, 26, 0, 12, 13, 17, 0, 15,
+ 27, 18, 31, 0, 0, 29, 0, 34, 28, 0,
+ 26, 0, 0, 0, 0, 0, 0, 27, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 64,
+ 64 };
+static CONST TclDatetabelem TclDatepact[]={
+
+-10000000, -43,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,
+-10000000,-10000000, -26, -268,-10000000, -259, -226,-10000000, -257, 10,
+ -227, -212, -228,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,
+ -229,-10000000, -230, -240, -231,-10000000,-10000000, -264,-10000000, 9,
+-10000000,-10000000, -249,-10000000,-10000000, -246,-10000000, 4, -2, 2,
+ 7, 6,-10000000,-10000000, -11, -232,-10000000,-10000000,-10000000,-10000000,
+ -233,-10000000, -234, -235,-10000000, -237, -238, -239, -242,-10000000,
+-10000000,-10000000, -1,-10000000,-10000000,-10000000, -12,-10000000, -243, -263,
+-10000000,-10000000 };
+static CONST TclDatetabelem TclDatepgo[]={
+
+ 0, 48, 70, 22, 69, 68, 66, 65, 64, 63,
+ 62, 60, 59, 58, 57, 55 };
+static CONST TclDatetabelem TclDater1[]={
+
+ 0, 4, 4, 5, 5, 5, 5, 5, 5, 5,
+ 5, 5, 6, 6, 6, 6, 6, 7, 7, 7,
+ 10, 10, 10, 10, 10, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 9, 9, 12, 12, 12,
+ 13, 11, 11, 15, 15, 15, 15, 15, 2, 2,
+ 1, 1, 1, 14, 3, 3 };
+static CONST TclDatetabelem TclDater2[]={
+
+ 0, 0, 4, 3, 3, 3, 3, 3, 3, 3,
+ 3, 2, 5, 9, 11, 13, 15, 5, 3, 3,
+ 3, 5, 5, 7, 5, 7, 11, 3, 11, 11,
+ 5, 9, 5, 3, 7, 5, 7, 7, 15, 5,
+ 9, 5, 2, 7, 5, 5, 7, 3, 3, 3,
+ 3, 3, 3, 3, 1, 3 };
+static CONST TclDatetabelem TclDatechk[]={
+
+-10000000, -4, -5, -6, -7, -8, -9, -10, -11, -12,
+ -13, -14, 268, 269, 259, 272, 263, 270, 274, 258,
+ -2, -15, 265, 45, 43, -1, 266, 273, 264, 261,
+ 58, 258, 47, 45, 263, -1, 271, 269, 272, 268,
+ 258, 263, 268, -1, 44, 268, 257, 268, 268, 268,
+ 263, 268, 268, 272, 268, 44, 263, -1, 258, -1,
+ 46, -3, 45, 58, 261, 47, 45, 45, 58, 268,
+ 268, 268, 268, 268, 268, 268, 268, -3, 45, 58,
+ 268, 268 };
+static CONST TclDatetabelem TclDatedef[]={
+
+ 1, -2, 2, 3, 4, 5, 6, 7, 8, 9,
+ 10, 11, 53, 18, 19, 27, 0, 33, 0, 20,
+ 0, 42, 0, 48, 49, 47, 50, 51, 52, 12,
+ 0, 22, 0, 0, 32, 44, 17, 0, 39, 30,
+ 24, 35, 0, 45, 21, 0, 41, 0, 54, 25,
+ 0, 0, 34, 37, 0, 0, 36, 46, 23, 43,
+ 0, 13, 0, 0, 55, 0, 0, 0, 0, 31,
+ 40, 14, 54, 26, 28, 29, 0, 15, 0, 0,
+ 16, 38 };
typedef struct
#ifdef __cplusplus
TclDatetoktype
@@ -893,12 +1028,16 @@ TclDatetoktype TclDatetoks[] =
"tMINUTE_UNIT", 262,
"tMONTH", 263,
"tMONTH_UNIT", 264,
- "tSEC_UNIT", 265,
- "tSNUMBER", 266,
- "tUNUMBER", 267,
- "tZONE", 268,
- "tEPOCH", 269,
- "tDST", 270,
+ "tSTARDATE", 265,
+ "tSEC_UNIT", 266,
+ "tSNUMBER", 267,
+ "tUNUMBER", 268,
+ "tZONE", 269,
+ "tEPOCH", 270,
+ "tDST", 271,
+ "tISOBASE", 272,
+ "tDAY_UNIT", 273,
+ "tNEXT", 274,
"-unknown-", -1 /* ends search */
};
@@ -910,38 +1049,53 @@ char * TclDatereds[] =
"item : time",
"item : zone",
"item : date",
+ "item : ordMonth",
"item : day",
- "item : rel",
+ "item : relspec",
+ "item : iso",
+ "item : trek",
"item : number",
"time : tUNUMBER tMERIDIAN",
"time : tUNUMBER ':' tUNUMBER o_merid",
- "time : tUNUMBER ':' tUNUMBER tSNUMBER",
+ "time : tUNUMBER ':' tUNUMBER '-' tUNUMBER",
"time : tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid",
- "time : tUNUMBER ':' tUNUMBER ':' tUNUMBER tSNUMBER",
+ "time : tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER",
"zone : tZONE tDST",
"zone : tZONE",
"zone : tDAYZONE",
"day : tDAY",
"day : tDAY ','",
"day : tUNUMBER tDAY",
+ "day : sign tUNUMBER tDAY",
+ "day : tNEXT tDAY",
"date : tUNUMBER '/' tUNUMBER",
"date : tUNUMBER '/' tUNUMBER '/' tUNUMBER",
+ "date : tISOBASE",
+ "date : tUNUMBER '-' tMONTH '-' tUNUMBER",
+ "date : tUNUMBER '-' tUNUMBER '-' tUNUMBER",
"date : tMONTH tUNUMBER",
"date : tMONTH tUNUMBER ',' tUNUMBER",
"date : tUNUMBER tMONTH",
"date : tEPOCH",
"date : tUNUMBER tMONTH tUNUMBER",
- "rel : relunit tAGO",
- "rel : relunit",
- "relunit : tUNUMBER tMINUTE_UNIT",
- "relunit : tSNUMBER tMINUTE_UNIT",
- "relunit : tMINUTE_UNIT",
- "relunit : tSNUMBER tSEC_UNIT",
- "relunit : tUNUMBER tSEC_UNIT",
- "relunit : tSEC_UNIT",
- "relunit : tSNUMBER tMONTH_UNIT",
- "relunit : tUNUMBER tMONTH_UNIT",
- "relunit : tMONTH_UNIT",
+ "ordMonth : tNEXT tMONTH",
+ "ordMonth : tNEXT tUNUMBER tMONTH",
+ "iso : tISOBASE tZONE tISOBASE",
+ "iso : tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER",
+ "iso : tISOBASE tISOBASE",
+ "trek : tSTARDATE tUNUMBER '.' tUNUMBER",
+ "relspec : relunits tAGO",
+ "relspec : relunits",
+ "relunits : sign tUNUMBER unit",
+ "relunits : tUNUMBER unit",
+ "relunits : tNEXT unit",
+ "relunits : tNEXT tUNUMBER unit",
+ "relunits : unit",
+ "sign : '-'",
+ "sign : '+'",
+ "unit : tSEC_UNIT",
+ "unit : tDAY_UNIT",
+ "unit : tMONTH_UNIT",
"number : tUNUMBER",
"o_merid : /* empty */",
"o_merid : tMERIDIAN",
@@ -977,7 +1131,7 @@ char * TclDatereds[] =
#define YYRECOVERING() (!!TclDateerrflag)
#define YYNEW(type) malloc(sizeof(type) * TclDatenewmax)
#define YYCOPY(to, from, type) \
- (type *) memcpy(to, (char *) from, TclDatenewmax * sizeof(type))
+ (type *) memcpy(to, (char *) from, TclDatemaxdepth * sizeof (type))
#define YYENLARGE( from, type) \
(type *) realloc((char *) from, TclDatenewmax * sizeof(type))
#ifndef YYDEBUG
@@ -1061,12 +1215,12 @@ int TclDateparse(void)
int TclDateparse()
#endif
{
- register YYSTYPE *TclDatepvt; /* top of value stack for $vars */
+ register YYSTYPE *TclDatepvt = 0; /* top of value stack for $vars */
#if defined(__cplusplus) || defined(lint)
/*
- hacks to please C++ and lint - goto's inside switch should never be
- executed; TclDatepvt is set to 0 to avoid "used before set" warning.
+ hacks to please C++ and lint - goto's inside
+ switch should never be executed
*/
static int __yaccpar_lint_hack__ = 0;
switch (__yaccpar_lint_hack__)
@@ -1074,7 +1228,6 @@ int TclDateparse()
case 1: goto TclDateerrlab;
case 2: goto TclDatenewstate;
}
- TclDatepvt = 0;
#endif
/*
@@ -1165,9 +1318,9 @@ int TclDateparse()
** reallocate and recover. Note that pointers
** have to be reset, or bad things will happen
*/
- int TclDateps_index = (TclDate_ps - TclDates);
- int TclDatepv_index = (TclDate_pv - TclDatev);
- int TclDatepvt_index = (TclDatepvt - TclDatev);
+ long TclDateps_index = (TclDate_ps - TclDates);
+ long TclDatepv_index = (TclDate_pv - TclDatev);
+ long TclDatepvt_index = (TclDatepvt - TclDatev);
int TclDatenewmax;
#ifdef YYEXPAND
TclDatenewmax = YYEXPAND(TclDatemaxdepth);
@@ -1293,7 +1446,7 @@ int TclDateparse()
** look through exception table
*/
{
- register int *TclDatexi = TclDateexca;
+ register CONST int *TclDatexi = TclDateexca;
while ( ( *TclDatexi != -1 ) ||
( TclDatexi[1] != TclDate_state ) )
@@ -1485,139 +1638,203 @@ case 5:{
TclDateHaveDate++;
} break;
case 6:{
- TclDateHaveDay++;
+ TclDateHaveOrdinalMonth++;
} break;
case 7:{
+ TclDateHaveDay++;
+ } break;
+case 8:{
TclDateHaveRel++;
} break;
case 9:{
+ TclDateHaveTime++;
+ TclDateHaveDate++;
+ } break;
+case 10:{
+ TclDateHaveTime++;
+ TclDateHaveDate++;
+ TclDateHaveRel++;
+ } break;
+case 12:{
TclDateHour = TclDatepvt[-1].Number;
TclDateMinutes = 0;
TclDateSeconds = 0;
TclDateMeridian = TclDatepvt[-0].Meridian;
} break;
-case 10:{
+case 13:{
TclDateHour = TclDatepvt[-3].Number;
TclDateMinutes = TclDatepvt[-1].Number;
TclDateSeconds = 0;
TclDateMeridian = TclDatepvt[-0].Meridian;
} break;
-case 11:{
- TclDateHour = TclDatepvt[-3].Number;
- TclDateMinutes = TclDatepvt[-1].Number;
+case 14:{
+ TclDateHour = TclDatepvt[-4].Number;
+ TclDateMinutes = TclDatepvt[-2].Number;
TclDateMeridian = MER24;
TclDateDSTmode = DSToff;
- TclDateTimezone = - (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
+ TclDateTimezone = (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
} break;
-case 12:{
+case 15:{
TclDateHour = TclDatepvt[-5].Number;
TclDateMinutes = TclDatepvt[-3].Number;
TclDateSeconds = TclDatepvt[-1].Number;
TclDateMeridian = TclDatepvt[-0].Meridian;
} break;
-case 13:{
- TclDateHour = TclDatepvt[-5].Number;
- TclDateMinutes = TclDatepvt[-3].Number;
- TclDateSeconds = TclDatepvt[-1].Number;
+case 16:{
+ TclDateHour = TclDatepvt[-6].Number;
+ TclDateMinutes = TclDatepvt[-4].Number;
+ TclDateSeconds = TclDatepvt[-2].Number;
TclDateMeridian = MER24;
TclDateDSTmode = DSToff;
- TclDateTimezone = - (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
+ TclDateTimezone = (TclDatepvt[-0].Number % 100 + (TclDatepvt[-0].Number / 100) * 60);
} break;
-case 14:{
+case 17:{
TclDateTimezone = TclDatepvt[-1].Number;
TclDateDSTmode = DSTon;
} break;
-case 15:{
+case 18:{
TclDateTimezone = TclDatepvt[-0].Number;
TclDateDSTmode = DSToff;
} break;
-case 16:{
+case 19:{
TclDateTimezone = TclDatepvt[-0].Number;
TclDateDSTmode = DSTon;
} break;
-case 17:{
+case 20:{
TclDateDayOrdinal = 1;
TclDateDayNumber = TclDatepvt[-0].Number;
} break;
-case 18:{
+case 21:{
TclDateDayOrdinal = 1;
TclDateDayNumber = TclDatepvt[-1].Number;
} break;
-case 19:{
+case 22:{
TclDateDayOrdinal = TclDatepvt[-1].Number;
TclDateDayNumber = TclDatepvt[-0].Number;
} break;
-case 20:{
- TclDateMonth = TclDatepvt[-2].Number;
- TclDateDay = TclDatepvt[-0].Number;
- } break;
-case 21:{
- TclDateMonth = TclDatepvt[-4].Number;
- TclDateDay = TclDatepvt[-2].Number;
- TclDateYear = TclDatepvt[-0].Number;
- } break;
-case 22:{
- TclDateMonth = TclDatepvt[-1].Number;
- TclDateDay = TclDatepvt[-0].Number;
- } break;
case 23:{
- TclDateMonth = TclDatepvt[-3].Number;
- TclDateDay = TclDatepvt[-2].Number;
- TclDateYear = TclDatepvt[-0].Number;
+ TclDateDayOrdinal = TclDatepvt[-2].Number * TclDatepvt[-1].Number;
+ TclDateDayNumber = TclDatepvt[-0].Number;
} break;
case 24:{
- TclDateMonth = TclDatepvt[-0].Number;
- TclDateDay = TclDatepvt[-1].Number;
+ TclDateDayOrdinal = 2;
+ TclDateDayNumber = TclDatepvt[-0].Number;
} break;
case 25:{
- TclDateMonth = 1;
- TclDateDay = 1;
- TclDateYear = EPOCH;
- } break;
+ TclDateMonth = TclDatepvt[-2].Number;
+ TclDateDay = TclDatepvt[-0].Number;
+ } break;
case 26:{
- TclDateMonth = TclDatepvt[-1].Number;
+ TclDateMonth = TclDatepvt[-4].Number;
TclDateDay = TclDatepvt[-2].Number;
TclDateYear = TclDatepvt[-0].Number;
} break;
case 27:{
- TclDateRelSeconds = -TclDateRelSeconds;
- TclDateRelMonth = -TclDateRelMonth;
- } break;
+ TclDateYear = TclDatepvt[-0].Number / 10000;
+ TclDateMonth = (TclDatepvt[-0].Number % 10000)/100;
+ TclDateDay = TclDatepvt[-0].Number % 100;
+ } break;
+case 28:{
+ TclDateDay = TclDatepvt[-4].Number;
+ TclDateMonth = TclDatepvt[-2].Number;
+ TclDateYear = TclDatepvt[-0].Number;
+ } break;
case 29:{
- TclDateRelSeconds += TclDatepvt[-1].Number * TclDatepvt[-0].Number * 60L;
+ TclDateMonth = TclDatepvt[-2].Number;
+ TclDateDay = TclDatepvt[-0].Number;
+ TclDateYear = TclDatepvt[-4].Number;
} break;
case 30:{
- TclDateRelSeconds += TclDatepvt[-1].Number * TclDatepvt[-0].Number * 60L;
+ TclDateMonth = TclDatepvt[-1].Number;
+ TclDateDay = TclDatepvt[-0].Number;
} break;
case 31:{
- TclDateRelSeconds += TclDatepvt[-0].Number * 60L;
+ TclDateMonth = TclDatepvt[-3].Number;
+ TclDateDay = TclDatepvt[-2].Number;
+ TclDateYear = TclDatepvt[-0].Number;
} break;
case 32:{
- TclDateRelSeconds += TclDatepvt[-1].Number;
+ TclDateMonth = TclDatepvt[-0].Number;
+ TclDateDay = TclDatepvt[-1].Number;
} break;
case 33:{
- TclDateRelSeconds += TclDatepvt[-1].Number;
- } break;
+ TclDateMonth = 1;
+ TclDateDay = 1;
+ TclDateYear = EPOCH;
+ } break;
case 34:{
- TclDateRelSeconds++;
+ TclDateMonth = TclDatepvt[-1].Number;
+ TclDateDay = TclDatepvt[-2].Number;
+ TclDateYear = TclDatepvt[-0].Number;
} break;
case 35:{
- TclDateRelMonth += TclDatepvt[-1].Number * TclDatepvt[-0].Number;
- } break;
+ TclDateMonthOrdinal = 1;
+ TclDateMonth = TclDatepvt[-0].Number;
+ } break;
case 36:{
- TclDateRelMonth += TclDatepvt[-1].Number * TclDatepvt[-0].Number;
- } break;
+ TclDateMonthOrdinal = TclDatepvt[-1].Number;
+ TclDateMonth = TclDatepvt[-0].Number;
+ } break;
case 37:{
- TclDateRelMonth += TclDatepvt[-0].Number;
+ if (TclDatepvt[-1].Number != HOUR(- 7)) YYABORT;
+ TclDateYear = TclDatepvt[-2].Number / 10000;
+ TclDateMonth = (TclDatepvt[-2].Number % 10000)/100;
+ TclDateDay = TclDatepvt[-2].Number % 100;
+ TclDateHour = TclDatepvt[-0].Number / 10000;
+ TclDateMinutes = (TclDatepvt[-0].Number % 10000)/100;
+ TclDateSeconds = TclDatepvt[-0].Number % 100;
} break;
case 38:{
+ if (TclDatepvt[-5].Number != HOUR(- 7)) YYABORT;
+ TclDateYear = TclDatepvt[-6].Number / 10000;
+ TclDateMonth = (TclDatepvt[-6].Number % 10000)/100;
+ TclDateDay = TclDatepvt[-6].Number % 100;
+ TclDateHour = TclDatepvt[-4].Number;
+ TclDateMinutes = TclDatepvt[-2].Number;
+ TclDateSeconds = TclDatepvt[-0].Number;
+ } break;
+case 39:{
+ TclDateYear = TclDatepvt[-1].Number / 10000;
+ TclDateMonth = (TclDatepvt[-1].Number % 10000)/100;
+ TclDateDay = TclDatepvt[-1].Number % 100;
+ TclDateHour = TclDatepvt[-0].Number / 10000;
+ TclDateMinutes = (TclDatepvt[-0].Number % 10000)/100;
+ TclDateSeconds = TclDatepvt[-0].Number % 100;
+ } break;
+case 40:{
+ /*
+ * Offset computed year by -377 so that the returned years will
+ * be in a range accessible with a 32 bit clock seconds value
+ */
+ TclDateYear = TclDatepvt[-2].Number/1000 + 2323 - 377;
+ TclDateDay = 1;
+ TclDateMonth = 1;
+ TclDateRelDay += ((TclDatepvt[-2].Number%1000)*(365 + IsLeapYear(TclDateYear)))/1000;
+ TclDateRelSeconds += TclDatepvt[-0].Number * 144 * 60;
+ } break;
+case 41:{
+ TclDateRelSeconds *= -1;
+ TclDateRelMonth *= -1;
+ TclDateRelDay *= -1;
+ } break;
+case 43:{ *TclDateRelPointer += TclDatepvt[-2].Number * TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
+case 44:{ *TclDateRelPointer += TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
+case 45:{ *TclDateRelPointer += TclDatepvt[-0].Number; } break;
+case 46:{ *TclDateRelPointer += TclDatepvt[-1].Number * TclDatepvt[-0].Number; } break;
+case 47:{ *TclDateRelPointer += TclDatepvt[-0].Number; } break;
+case 48:{ TclDateval.Number = -1; } break;
+case 49:{ TclDateval.Number = 1; } break;
+case 50:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelSeconds; } break;
+case 51:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelDay; } break;
+case 52:{ TclDateval.Number = TclDatepvt[-0].Number; TclDateRelPointer = &TclDateRelMonth; } break;
+case 53:{
if (TclDateHaveTime && TclDateHaveDate && !TclDateHaveRel) {
TclDateYear = TclDatepvt[-0].Number;
} else {
TclDateHaveTime++;
if (TclDatepvt[-0].Number < 100) {
- TclDateHour = 0;
- TclDateMinutes = TclDatepvt[-0].Number;
+ TclDateHour = TclDatepvt[-0].Number;
+ TclDateMinutes = 0;
} else {
TclDateHour = TclDatepvt[-0].Number / 100;
TclDateMinutes = TclDatepvt[-0].Number % 100;
@@ -1626,13 +1843,14 @@ case 38:{
TclDateMeridian = MER24;
}
} break;
-case 39:{
+case 54:{
TclDateval.Meridian = MER24;
} break;
-case 40:{
+case 55:{
TclDateval.Meridian = TclDatepvt[-0].Meridian;
} break;
}
goto TclDatestack; /* reset registers in driver code */
}
+
diff --git a/tcl/generic/tclDecls.h b/tcl/generic/tclDecls.h
new file mode 100644
index 00000000000..b231e49d59c
--- /dev/null
+++ b/tcl/generic/tclDecls.h
@@ -0,0 +1,3462 @@
+/*
+ * tclDecls.h --
+ *
+ * Declarations of functions in the platform independent public Tcl API.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLDECLS
+#define _TCLDECLS
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tcl.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, char * version,
+ ClientData clientData));
+/* 1 */
+EXTERN char * Tcl_PkgRequireEx _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, char * version, int exact,
+ ClientData * clientDataPtr));
+/* 2 */
+EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+/* 3 */
+EXTERN char * Tcl_Alloc _ANSI_ARGS_((unsigned int size));
+/* 4 */
+EXTERN void Tcl_Free _ANSI_ARGS_((char * ptr));
+/* 5 */
+EXTERN char * Tcl_Realloc _ANSI_ARGS_((char * ptr,
+ unsigned int size));
+/* 6 */
+EXTERN char * Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
+ char * file, int line));
+/* 7 */
+EXTERN int Tcl_DbCkfree _ANSI_ARGS_((char * ptr, char * file,
+ int line));
+/* 8 */
+EXTERN char * Tcl_DbCkrealloc _ANSI_ARGS_((char * ptr,
+ unsigned int size, char * file, int line));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 9 */
+EXTERN void Tcl_CreateFileHandler _ANSI_ARGS_((int fd, int mask,
+ Tcl_FileProc * proc, ClientData clientData));
+#endif /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 10 */
+EXTERN void Tcl_DeleteFileHandler _ANSI_ARGS_((int fd));
+#endif /* UNIX */
+/* 11 */
+EXTERN void Tcl_SetTimer _ANSI_ARGS_((Tcl_Time * timePtr));
+/* 12 */
+EXTERN void Tcl_Sleep _ANSI_ARGS_((int ms));
+/* 13 */
+EXTERN int Tcl_WaitForEvent _ANSI_ARGS_((Tcl_Time * timePtr));
+/* 14 */
+EXTERN int Tcl_AppendAllObjTypes _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr));
+/* 15 */
+EXTERN void Tcl_AppendStringsToObj _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr));
+/* 16 */
+EXTERN void Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ char * bytes, int length));
+/* 17 */
+EXTERN Tcl_Obj * Tcl_ConcatObj _ANSI_ARGS_((int objc,
+ Tcl_Obj *CONST objv[]));
+/* 18 */
+EXTERN int Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, Tcl_ObjType * typePtr));
+/* 19 */
+EXTERN void Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj * objPtr,
+ char * file, int line));
+/* 20 */
+EXTERN void Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj * objPtr,
+ char * file, int line));
+/* 21 */
+EXTERN int Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj * objPtr,
+ char * file, int line));
+/* 22 */
+EXTERN Tcl_Obj * Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue,
+ char * file, int line));
+/* 23 */
+EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj _ANSI_ARGS_((
+ unsigned char * bytes, int length,
+ char * file, int line));
+/* 24 */
+EXTERN Tcl_Obj * Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue,
+ char * file, int line));
+/* 25 */
+EXTERN Tcl_Obj * Tcl_DbNewListObj _ANSI_ARGS_((int objc,
+ Tcl_Obj *CONST objv[], char * file, int line));
+/* 26 */
+EXTERN Tcl_Obj * Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
+ char * file, int line));
+/* 27 */
+EXTERN Tcl_Obj * Tcl_DbNewObj _ANSI_ARGS_((char * file, int line));
+/* 28 */
+EXTERN Tcl_Obj * Tcl_DbNewStringObj _ANSI_ARGS_((CONST char * bytes,
+ int length, char * file, int line));
+/* 29 */
+EXTERN Tcl_Obj * Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj * objPtr));
+/* 30 */
+EXTERN void TclFreeObj _ANSI_ARGS_((Tcl_Obj * objPtr));
+/* 31 */
+EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, int * boolPtr));
+/* 32 */
+EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr,
+ int * boolPtr));
+/* 33 */
+EXTERN unsigned char * Tcl_GetByteArrayFromObj _ANSI_ARGS_((
+ Tcl_Obj * objPtr, int * lengthPtr));
+/* 34 */
+EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, double * doublePtr));
+/* 35 */
+EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr,
+ double * doublePtr));
+/* 36 */
+EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, char ** tablePtr,
+ char * msg, int flags, int * indexPtr));
+/* 37 */
+EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, int * intPtr));
+/* 38 */
+EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, int * intPtr));
+/* 39 */
+EXTERN int Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, long * longPtr));
+/* 40 */
+EXTERN Tcl_ObjType * Tcl_GetObjType _ANSI_ARGS_((char * typeName));
+/* 41 */
+EXTERN char * Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ int * lengthPtr));
+/* 42 */
+EXTERN void Tcl_InvalidateStringRep _ANSI_ARGS_((
+ Tcl_Obj * objPtr));
+/* 43 */
+EXTERN int Tcl_ListObjAppendList _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * listPtr,
+ Tcl_Obj * elemListPtr));
+/* 44 */
+EXTERN int Tcl_ListObjAppendElement _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * listPtr,
+ Tcl_Obj * objPtr));
+/* 45 */
+EXTERN int Tcl_ListObjGetElements _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * listPtr,
+ int * objcPtr, Tcl_Obj *** objvPtr));
+/* 46 */
+EXTERN int Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * listPtr, int index,
+ Tcl_Obj ** objPtrPtr));
+/* 47 */
+EXTERN int Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * listPtr, int * intPtr));
+/* 48 */
+EXTERN int Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * listPtr, int first, int count,
+ int objc, Tcl_Obj *CONST objv[]));
+/* 49 */
+EXTERN Tcl_Obj * Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue));
+/* 50 */
+EXTERN Tcl_Obj * Tcl_NewByteArrayObj _ANSI_ARGS_((
+ unsigned char * bytes, int length));
+/* 51 */
+EXTERN Tcl_Obj * Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue));
+/* 52 */
+EXTERN Tcl_Obj * Tcl_NewIntObj _ANSI_ARGS_((int intValue));
+/* 53 */
+EXTERN Tcl_Obj * Tcl_NewListObj _ANSI_ARGS_((int objc,
+ Tcl_Obj *CONST objv[]));
+/* 54 */
+EXTERN Tcl_Obj * Tcl_NewLongObj _ANSI_ARGS_((long longValue));
+/* 55 */
+EXTERN Tcl_Obj * Tcl_NewObj _ANSI_ARGS_((void));
+/* 56 */
+EXTERN Tcl_Obj * Tcl_NewStringObj _ANSI_ARGS_((CONST char * bytes,
+ int length));
+/* 57 */
+EXTERN void Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ int boolValue));
+/* 58 */
+EXTERN unsigned char * Tcl_SetByteArrayLength _ANSI_ARGS_((Tcl_Obj * objPtr,
+ int length));
+/* 59 */
+EXTERN void Tcl_SetByteArrayObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ unsigned char * bytes, int length));
+/* 60 */
+EXTERN void Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ double doubleValue));
+/* 61 */
+EXTERN void Tcl_SetIntObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ int intValue));
+/* 62 */
+EXTERN void Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+/* 63 */
+EXTERN void Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ long longValue));
+/* 64 */
+EXTERN void Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj * objPtr,
+ int length));
+/* 65 */
+EXTERN void Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ char * bytes, int length));
+/* 66 */
+EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * message));
+/* 67 */
+EXTERN void Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * message, int length));
+/* 68 */
+EXTERN void Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp * interp));
+/* 69 */
+EXTERN void Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * string));
+/* 70 */
+EXTERN void Tcl_AppendResult _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
+/* 71 */
+EXTERN Tcl_AsyncHandler Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc * proc,
+ ClientData clientData));
+/* 72 */
+EXTERN void Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
+/* 73 */
+EXTERN int Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp * interp,
+ int code));
+/* 74 */
+EXTERN void Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
+/* 75 */
+EXTERN int Tcl_AsyncReady _ANSI_ARGS_((void));
+/* 76 */
+EXTERN void Tcl_BackgroundError _ANSI_ARGS_((Tcl_Interp * interp));
+/* 77 */
+EXTERN char Tcl_Backslash _ANSI_ARGS_((CONST char * src,
+ int * readPtr));
+/* 78 */
+EXTERN int Tcl_BadChannelOption _ANSI_ARGS_((
+ Tcl_Interp * interp, char * optionName,
+ char * optionList));
+/* 79 */
+EXTERN void Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_InterpDeleteProc * proc,
+ ClientData clientData));
+/* 80 */
+EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_((
+ Tcl_IdleProc * idleProc,
+ ClientData clientData));
+/* 81 */
+EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Channel chan));
+/* 82 */
+EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char * cmd));
+/* 83 */
+EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc, char ** argv));
+/* 84 */
+EXTERN int Tcl_ConvertElement _ANSI_ARGS_((CONST char * src,
+ char * dst, int flags));
+/* 85 */
+EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_((
+ CONST char * src, int length, char * dst,
+ int flags));
+/* 86 */
+EXTERN int Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp * slave,
+ char * slaveCmd, Tcl_Interp * target,
+ char * targetCmd, int argc, char ** argv));
+/* 87 */
+EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp * slave,
+ char * slaveCmd, Tcl_Interp * target,
+ char * targetCmd, int objc,
+ Tcl_Obj *CONST objv[]));
+/* 88 */
+EXTERN Tcl_Channel Tcl_CreateChannel _ANSI_ARGS_((
+ Tcl_ChannelType * typePtr, char * chanName,
+ ClientData instanceData, int mask));
+/* 89 */
+EXTERN void Tcl_CreateChannelHandler _ANSI_ARGS_((
+ Tcl_Channel chan, int mask,
+ Tcl_ChannelProc * proc,
+ ClientData clientData));
+/* 90 */
+EXTERN void Tcl_CreateCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
+ Tcl_CloseProc * proc, ClientData clientData));
+/* 91 */
+EXTERN Tcl_Command Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp * interp,
+ char * cmdName, Tcl_CmdProc * proc,
+ ClientData clientData,
+ Tcl_CmdDeleteProc * deleteProc));
+/* 92 */
+EXTERN void Tcl_CreateEventSource _ANSI_ARGS_((
+ Tcl_EventSetupProc * setupProc,
+ Tcl_EventCheckProc * checkProc,
+ ClientData clientData));
+/* 93 */
+EXTERN void Tcl_CreateExitHandler _ANSI_ARGS_((
+ Tcl_ExitProc * proc, ClientData clientData));
+/* 94 */
+EXTERN Tcl_Interp * Tcl_CreateInterp _ANSI_ARGS_((void));
+/* 95 */
+EXTERN void Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, int numArgs,
+ Tcl_ValueType * argTypes,
+ Tcl_MathProc * proc, ClientData clientData));
+/* 96 */
+EXTERN Tcl_Command Tcl_CreateObjCommand _ANSI_ARGS_((
+ Tcl_Interp * interp, char * cmdName,
+ Tcl_ObjCmdProc * proc, ClientData clientData,
+ Tcl_CmdDeleteProc * deleteProc));
+/* 97 */
+EXTERN Tcl_Interp * Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp * interp,
+ char * slaveName, int isSafe));
+/* 98 */
+EXTERN Tcl_TimerToken Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
+ Tcl_TimerProc * proc, ClientData clientData));
+/* 99 */
+EXTERN Tcl_Trace Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp * interp,
+ int level, Tcl_CmdTraceProc * proc,
+ ClientData clientData));
+/* 100 */
+EXTERN void Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name));
+/* 101 */
+EXTERN void Tcl_DeleteChannelHandler _ANSI_ARGS_((
+ Tcl_Channel chan, Tcl_ChannelProc * proc,
+ ClientData clientData));
+/* 102 */
+EXTERN void Tcl_DeleteCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
+ Tcl_CloseProc * proc, ClientData clientData));
+/* 103 */
+EXTERN int Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp * interp,
+ char * cmdName));
+/* 104 */
+EXTERN int Tcl_DeleteCommandFromToken _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Command command));
+/* 105 */
+EXTERN void Tcl_DeleteEvents _ANSI_ARGS_((
+ Tcl_EventDeleteProc * proc,
+ ClientData clientData));
+/* 106 */
+EXTERN void Tcl_DeleteEventSource _ANSI_ARGS_((
+ Tcl_EventSetupProc * setupProc,
+ Tcl_EventCheckProc * checkProc,
+ ClientData clientData));
+/* 107 */
+EXTERN void Tcl_DeleteExitHandler _ANSI_ARGS_((
+ Tcl_ExitProc * proc, ClientData clientData));
+/* 108 */
+EXTERN void Tcl_DeleteHashEntry _ANSI_ARGS_((
+ Tcl_HashEntry * entryPtr));
+/* 109 */
+EXTERN void Tcl_DeleteHashTable _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr));
+/* 110 */
+EXTERN void Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp * interp));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 111 */
+EXTERN void Tcl_DetachPids _ANSI_ARGS_((int numPids,
+ Tcl_Pid * pidPtr));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 111 */
+EXTERN void Tcl_DetachPids _ANSI_ARGS_((int numPids,
+ Tcl_Pid * pidPtr));
+#endif /* __WIN32__ */
+/* 112 */
+EXTERN void Tcl_DeleteTimerHandler _ANSI_ARGS_((
+ Tcl_TimerToken token));
+/* 113 */
+EXTERN void Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Trace trace));
+/* 114 */
+EXTERN void Tcl_DontCallWhenDeleted _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ Tcl_InterpDeleteProc * proc,
+ ClientData clientData));
+/* 115 */
+EXTERN int Tcl_DoOneEvent _ANSI_ARGS_((int flags));
+/* 116 */
+EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc * proc,
+ ClientData clientData));
+/* 117 */
+EXTERN char * Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString * dsPtr,
+ CONST char * str, int length));
+/* 118 */
+EXTERN char * Tcl_DStringAppendElement _ANSI_ARGS_((
+ Tcl_DString * dsPtr, CONST char * string));
+/* 119 */
+EXTERN void Tcl_DStringEndSublist _ANSI_ARGS_((
+ Tcl_DString * dsPtr));
+/* 120 */
+EXTERN void Tcl_DStringFree _ANSI_ARGS_((Tcl_DString * dsPtr));
+/* 121 */
+EXTERN void Tcl_DStringGetResult _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_DString * dsPtr));
+/* 122 */
+EXTERN void Tcl_DStringInit _ANSI_ARGS_((Tcl_DString * dsPtr));
+/* 123 */
+EXTERN void Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_DString * dsPtr));
+/* 124 */
+EXTERN void Tcl_DStringSetLength _ANSI_ARGS_((
+ Tcl_DString * dsPtr, int length));
+/* 125 */
+EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_((
+ Tcl_DString * dsPtr));
+/* 126 */
+EXTERN int Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
+/* 127 */
+EXTERN char * Tcl_ErrnoId _ANSI_ARGS_((void));
+/* 128 */
+EXTERN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
+/* 129 */
+EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string));
+/* 130 */
+EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp * interp,
+ char * fileName));
+/* 131 */
+EXTERN int Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr));
+/* 132 */
+EXTERN void Tcl_EventuallyFree _ANSI_ARGS_((
+ ClientData clientData,
+ Tcl_FreeProc * freeProc));
+/* 133 */
+EXTERN void Tcl_Exit _ANSI_ARGS_((int status));
+/* 134 */
+EXTERN int Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp * interp,
+ char * hiddenCmdToken, char * cmdName));
+/* 135 */
+EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, int * ptr));
+/* 136 */
+EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, int * ptr));
+/* 137 */
+EXTERN int Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, double * ptr));
+/* 138 */
+EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, double * ptr));
+/* 139 */
+EXTERN int Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, long * ptr));
+/* 140 */
+EXTERN int Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, long * ptr));
+/* 141 */
+EXTERN int Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr));
+/* 142 */
+EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string));
+/* 143 */
+EXTERN void Tcl_Finalize _ANSI_ARGS_((void));
+/* 144 */
+EXTERN void Tcl_FindExecutable _ANSI_ARGS_((CONST char * argv0));
+/* 145 */
+EXTERN Tcl_HashEntry * Tcl_FirstHashEntry _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr,
+ Tcl_HashSearch * searchPtr));
+/* 146 */
+EXTERN int Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan));
+/* 147 */
+EXTERN void Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp * interp));
+/* 148 */
+EXTERN int Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp * interp,
+ char * slaveCmd,
+ Tcl_Interp ** targetInterpPtr,
+ char ** targetCmdPtr, int * argcPtr,
+ char *** argvPtr));
+/* 149 */
+EXTERN int Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp * interp,
+ char * slaveCmd,
+ Tcl_Interp ** targetInterpPtr,
+ char ** targetCmdPtr, int * objcPtr,
+ Tcl_Obj *** objv));
+/* 150 */
+EXTERN ClientData Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, Tcl_InterpDeleteProc ** procPtr));
+/* 151 */
+EXTERN Tcl_Channel Tcl_GetChannel _ANSI_ARGS_((Tcl_Interp * interp,
+ char * chanName, int * modePtr));
+/* 152 */
+EXTERN int Tcl_GetChannelBufferSize _ANSI_ARGS_((
+ Tcl_Channel chan));
+/* 153 */
+EXTERN int Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan,
+ int direction, ClientData * handlePtr));
+/* 154 */
+EXTERN ClientData Tcl_GetChannelInstanceData _ANSI_ARGS_((
+ Tcl_Channel chan));
+/* 155 */
+EXTERN int Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
+/* 156 */
+EXTERN char * Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan));
+/* 157 */
+EXTERN int Tcl_GetChannelOption _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Channel chan,
+ char * optionName, Tcl_DString * dsPtr));
+/* 158 */
+EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
+/* 159 */
+EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ char * cmdName, Tcl_CmdInfo * infoPtr));
+/* 160 */
+EXTERN char * Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Command command));
+/* 161 */
+EXTERN int Tcl_GetErrno _ANSI_ARGS_((void));
+/* 162 */
+EXTERN char * Tcl_GetHostName _ANSI_ARGS_((void));
+/* 163 */
+EXTERN int Tcl_GetInterpPath _ANSI_ARGS_((
+ Tcl_Interp * askInterp,
+ Tcl_Interp * slaveInterp));
+/* 164 */
+EXTERN Tcl_Interp * Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp * interp));
+/* 165 */
+EXTERN CONST char * Tcl_GetNameOfExecutable _ANSI_ARGS_((void));
+/* 166 */
+EXTERN Tcl_Obj * Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp * interp));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 167 */
+EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, int forWriting, int checkUsage,
+ ClientData * filePtr));
+#endif /* UNIX */
+/* 168 */
+EXTERN Tcl_PathType Tcl_GetPathType _ANSI_ARGS_((char * path));
+/* 169 */
+EXTERN int Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
+ Tcl_DString * dsPtr));
+/* 170 */
+EXTERN int Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan,
+ Tcl_Obj * objPtr));
+/* 171 */
+EXTERN int Tcl_GetServiceMode _ANSI_ARGS_((void));
+/* 172 */
+EXTERN Tcl_Interp * Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp * interp,
+ char * slaveName));
+/* 173 */
+EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_((int type));
+/* 174 */
+EXTERN char * Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp * interp));
+/* 175 */
+EXTERN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName, int flags));
+/* 176 */
+EXTERN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2, int flags));
+/* 177 */
+EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp * interp,
+ char * command));
+/* 178 */
+EXTERN int Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr));
+/* 179 */
+EXTERN int Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp * interp,
+ char * cmdName, char * hiddenCmdToken));
+/* 180 */
+EXTERN int Tcl_Init _ANSI_ARGS_((Tcl_Interp * interp));
+/* 181 */
+EXTERN void Tcl_InitHashTable _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr, int keyType));
+/* 182 */
+EXTERN int Tcl_InputBlocked _ANSI_ARGS_((Tcl_Channel chan));
+/* 183 */
+EXTERN int Tcl_InputBuffered _ANSI_ARGS_((Tcl_Channel chan));
+/* 184 */
+EXTERN int Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp * interp));
+/* 185 */
+EXTERN int Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp * interp));
+/* 186 */
+EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc, char ** argv,
+ Tcl_DString * resultPtr));
+/* 187 */
+EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName, char * addr, int type));
+/* Slot 188 is reserved */
+/* 189 */
+EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
+ int mode));
+/* 190 */
+EXTERN int Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp * interp));
+/* 191 */
+EXTERN Tcl_Channel Tcl_MakeTcpClientChannel _ANSI_ARGS_((
+ ClientData tcpSocket));
+/* 192 */
+EXTERN char * Tcl_Merge _ANSI_ARGS_((int argc, char ** argv));
+/* 193 */
+EXTERN Tcl_HashEntry * Tcl_NextHashEntry _ANSI_ARGS_((
+ Tcl_HashSearch * searchPtr));
+/* 194 */
+EXTERN void Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel,
+ int mask));
+/* 195 */
+EXTERN Tcl_Obj * Tcl_ObjGetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr,
+ int flags));
+/* 196 */
+EXTERN Tcl_Obj * Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr,
+ Tcl_Obj * newValuePtr, int flags));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 197 */
+EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_((
+ Tcl_Interp * interp, int argc, char ** argv,
+ int flags));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 197 */
+EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_((
+ Tcl_Interp * interp, int argc, char ** argv,
+ int flags));
+#endif /* __WIN32__ */
+/* 198 */
+EXTERN Tcl_Channel Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp,
+ char * fileName, char * modeString,
+ int permissions));
+/* 199 */
+EXTERN Tcl_Channel Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp * interp,
+ int port, char * address, char * myaddr,
+ int myport, int async));
+/* 200 */
+EXTERN Tcl_Channel Tcl_OpenTcpServer _ANSI_ARGS_((Tcl_Interp * interp,
+ int port, char * host,
+ Tcl_TcpAcceptProc * acceptProc,
+ ClientData callbackData));
+/* 201 */
+EXTERN void Tcl_Preserve _ANSI_ARGS_((ClientData data));
+/* 202 */
+EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp,
+ double value, char * dst));
+/* 203 */
+EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * string));
+/* 204 */
+EXTERN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp));
+/* 205 */
+EXTERN void Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event * evPtr,
+ Tcl_QueuePosition position));
+/* 206 */
+EXTERN int Tcl_Read _ANSI_ARGS_((Tcl_Channel chan,
+ char * bufPtr, int toRead));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 207 */
+EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 207 */
+EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
+#endif /* __WIN32__ */
+/* 208 */
+EXTERN int Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp * interp,
+ char * cmd, int flags));
+/* 209 */
+EXTERN int Tcl_RecordAndEvalObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * cmdPtr,
+ int flags));
+/* 210 */
+EXTERN void Tcl_RegisterChannel _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Channel chan));
+/* 211 */
+EXTERN void Tcl_RegisterObjType _ANSI_ARGS_((
+ Tcl_ObjType * typePtr));
+/* 212 */
+EXTERN Tcl_RegExp Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string));
+/* 213 */
+EXTERN int Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_RegExp regexp, CONST char * str,
+ CONST char * start));
+/* 214 */
+EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, char * pattern));
+/* 215 */
+EXTERN void Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
+ int index, char ** startPtr, char ** endPtr));
+/* 216 */
+EXTERN void Tcl_Release _ANSI_ARGS_((ClientData clientData));
+/* 217 */
+EXTERN void Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp * interp));
+/* 218 */
+EXTERN int Tcl_ScanElement _ANSI_ARGS_((CONST char * str,
+ int * flagPtr));
+/* 219 */
+EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_((CONST char * str,
+ int length, int * flagPtr));
+/* 220 */
+EXTERN int Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan, int offset,
+ int mode));
+/* 221 */
+EXTERN int Tcl_ServiceAll _ANSI_ARGS_((void));
+/* 222 */
+EXTERN int Tcl_ServiceEvent _ANSI_ARGS_((int flags));
+/* 223 */
+EXTERN void Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, Tcl_InterpDeleteProc * proc,
+ ClientData clientData));
+/* 224 */
+EXTERN void Tcl_SetChannelBufferSize _ANSI_ARGS_((
+ Tcl_Channel chan, int sz));
+/* 225 */
+EXTERN int Tcl_SetChannelOption _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Channel chan,
+ char * optionName, char * newValue));
+/* 226 */
+EXTERN int Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ char * cmdName, Tcl_CmdInfo * infoPtr));
+/* 227 */
+EXTERN void Tcl_SetErrno _ANSI_ARGS_((int err));
+/* 228 */
+EXTERN void Tcl_SetErrorCode _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
+/* 229 */
+EXTERN void Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time * timePtr));
+/* 230 */
+EXTERN void Tcl_SetPanicProc _ANSI_ARGS_((
+ Tcl_PanicProc * panicProc));
+/* 231 */
+EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_((
+ Tcl_Interp * interp, int depth));
+/* 232 */
+EXTERN void Tcl_SetResult _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, Tcl_FreeProc * freeProc));
+/* 233 */
+EXTERN int Tcl_SetServiceMode _ANSI_ARGS_((int mode));
+/* 234 */
+EXTERN void Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * errorObjPtr));
+/* 235 */
+EXTERN void Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * resultObjPtr));
+/* 236 */
+EXTERN void Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
+ int type));
+/* 237 */
+EXTERN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName, char * newValue, int flags));
+/* 238 */
+EXTERN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2, char * newValue,
+ int flags));
+/* 239 */
+EXTERN char * Tcl_SignalId _ANSI_ARGS_((int sig));
+/* 240 */
+EXTERN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
+/* 241 */
+EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp * interp));
+/* 242 */
+EXTERN int Tcl_SplitList _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * listStr, int * argcPtr,
+ char *** argvPtr));
+/* 243 */
+EXTERN void Tcl_SplitPath _ANSI_ARGS_((CONST char * path,
+ int * argcPtr, char *** argvPtr));
+/* 244 */
+EXTERN void Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp * interp,
+ char * pkgName,
+ Tcl_PackageInitProc * initProc,
+ Tcl_PackageInitProc * safeInitProc));
+/* 245 */
+EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str,
+ CONST char * pattern));
+/* 246 */
+EXTERN int Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
+/* 247 */
+EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName, int flags,
+ Tcl_VarTraceProc * proc,
+ ClientData clientData));
+/* 248 */
+EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2, int flags,
+ Tcl_VarTraceProc * proc,
+ ClientData clientData));
+/* 249 */
+EXTERN char * Tcl_TranslateFileName _ANSI_ARGS_((
+ Tcl_Interp * interp, char * name,
+ Tcl_DString * bufferPtr));
+/* 250 */
+EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan, char * str,
+ int len, int atHead));
+/* 251 */
+EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName));
+/* 252 */
+EXTERN int Tcl_UnregisterChannel _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Channel chan));
+/* 253 */
+EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName, int flags));
+/* 254 */
+EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2, int flags));
+/* 255 */
+EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName, int flags,
+ Tcl_VarTraceProc * proc,
+ ClientData clientData));
+/* 256 */
+EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2, int flags,
+ Tcl_VarTraceProc * proc,
+ ClientData clientData));
+/* 257 */
+EXTERN void Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName));
+/* 258 */
+EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * frameName, char * varName,
+ char * localName, int flags));
+/* 259 */
+EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ char * frameName, char * part1, char * part2,
+ char * localName, int flags));
+/* 260 */
+EXTERN int Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
+/* 261 */
+EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName, int flags,
+ Tcl_VarTraceProc * procPtr,
+ ClientData prevClientData));
+/* 262 */
+EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2, int flags,
+ Tcl_VarTraceProc * procPtr,
+ ClientData prevClientData));
+/* 263 */
+EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan, char * s,
+ int slen));
+/* 264 */
+EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[],
+ char * message));
+/* 265 */
+EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_((char * fileName));
+/* 266 */
+EXTERN void Tcl_ValidateAllMemory _ANSI_ARGS_((char * file,
+ int line));
+/* 267 */
+EXTERN void Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp * interp,
+ va_list argList));
+/* 268 */
+EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_((
+ Tcl_Obj * objPtr, va_list argList));
+/* 269 */
+EXTERN char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable * tablePtr));
+/* 270 */
+EXTERN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, char ** termPtr));
+/* 271 */
+EXTERN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, char * version, int exact));
+/* 272 */
+EXTERN char * Tcl_PkgPresentEx _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, char * version, int exact,
+ ClientData * clientDataPtr));
+/* 273 */
+EXTERN int Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, char * version));
+/* 274 */
+EXTERN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, char * version, int exact));
+/* 275 */
+EXTERN void Tcl_SetErrorCodeVA _ANSI_ARGS_((Tcl_Interp * interp,
+ va_list argList));
+/* 276 */
+EXTERN int Tcl_VarEvalVA _ANSI_ARGS_((Tcl_Interp * interp,
+ va_list argList));
+/* 277 */
+EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int * statPtr,
+ int options));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 278 */
+EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format,
+ va_list argList));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 278 */
+EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format,
+ va_list argList));
+#endif /* __WIN32__ */
+/* 279 */
+EXTERN void Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor,
+ int * patchLevel, int * type));
+/* 280 */
+EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp * interp));
+/* 281 */
+EXTERN Tcl_Channel Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_ChannelType * typePtr,
+ ClientData instanceData, int mask,
+ Tcl_Channel prevChan));
+/* 282 */
+EXTERN int Tcl_UnstackChannel _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Channel chan));
+/* 283 */
+EXTERN Tcl_Channel Tcl_GetStackedChannel _ANSI_ARGS_((Tcl_Channel chan));
+/* Slot 284 is reserved */
+/* Slot 285 is reserved */
+/* 286 */
+EXTERN void Tcl_AppendObjToObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ Tcl_Obj * appendObjPtr));
+/* 287 */
+EXTERN Tcl_Encoding Tcl_CreateEncoding _ANSI_ARGS_((
+ Tcl_EncodingType * typePtr));
+/* 288 */
+EXTERN void Tcl_CreateThreadExitHandler _ANSI_ARGS_((
+ Tcl_ExitProc * proc, ClientData clientData));
+/* 289 */
+EXTERN void Tcl_DeleteThreadExitHandler _ANSI_ARGS_((
+ Tcl_ExitProc * proc, ClientData clientData));
+/* 290 */
+EXTERN void Tcl_DiscardResult _ANSI_ARGS_((
+ Tcl_SavedResult * statePtr));
+/* 291 */
+EXTERN int Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp * interp,
+ char * script, int numBytes, int flags));
+/* 292 */
+EXTERN int Tcl_EvalObjv _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[], int flags));
+/* 293 */
+EXTERN int Tcl_EvalObjEx _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, int flags));
+/* 294 */
+EXTERN void Tcl_ExitThread _ANSI_ARGS_((int status));
+/* 295 */
+EXTERN int Tcl_ExternalToUtf _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Encoding encoding, CONST char * src,
+ int srcLen, int flags,
+ Tcl_EncodingState * statePtr, char * dst,
+ int dstLen, int * srcReadPtr,
+ int * dstWrotePtr, int * dstCharsPtr));
+/* 296 */
+EXTERN char * Tcl_ExternalToUtfDString _ANSI_ARGS_((
+ Tcl_Encoding encoding, CONST char * src,
+ int srcLen, Tcl_DString * dsPtr));
+/* 297 */
+EXTERN void Tcl_FinalizeThread _ANSI_ARGS_((void));
+/* 298 */
+EXTERN void Tcl_FinalizeNotifier _ANSI_ARGS_((
+ ClientData clientData));
+/* 299 */
+EXTERN void Tcl_FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
+/* 300 */
+EXTERN Tcl_ThreadId Tcl_GetCurrentThread _ANSI_ARGS_((void));
+/* 301 */
+EXTERN Tcl_Encoding Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name));
+/* 302 */
+EXTERN char * Tcl_GetEncodingName _ANSI_ARGS_((
+ Tcl_Encoding encoding));
+/* 303 */
+EXTERN void Tcl_GetEncodingNames _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 304 */
+EXTERN int Tcl_GetIndexFromObjStruct _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr,
+ char ** tablePtr, int offset, char * msg,
+ int flags, int * indexPtr));
+/* 305 */
+EXTERN VOID * Tcl_GetThreadData _ANSI_ARGS_((
+ Tcl_ThreadDataKey * keyPtr, int size));
+/* 306 */
+EXTERN Tcl_Obj * Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2, int flags));
+/* 307 */
+EXTERN ClientData Tcl_InitNotifier _ANSI_ARGS_((void));
+/* 308 */
+EXTERN void Tcl_MutexLock _ANSI_ARGS_((Tcl_Mutex * mutexPtr));
+/* 309 */
+EXTERN void Tcl_MutexUnlock _ANSI_ARGS_((Tcl_Mutex * mutexPtr));
+/* 310 */
+EXTERN void Tcl_ConditionNotify _ANSI_ARGS_((
+ Tcl_Condition * condPtr));
+/* 311 */
+EXTERN void Tcl_ConditionWait _ANSI_ARGS_((
+ Tcl_Condition * condPtr,
+ Tcl_Mutex * mutexPtr, Tcl_Time * timePtr));
+/* 312 */
+EXTERN int Tcl_NumUtfChars _ANSI_ARGS_((CONST char * src,
+ int len));
+/* 313 */
+EXTERN int Tcl_ReadChars _ANSI_ARGS_((Tcl_Channel channel,
+ Tcl_Obj * objPtr, int charsToRead,
+ int appendFlag));
+/* 314 */
+EXTERN void Tcl_RestoreResult _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_SavedResult * statePtr));
+/* 315 */
+EXTERN void Tcl_SaveResult _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_SavedResult * statePtr));
+/* 316 */
+EXTERN int Tcl_SetSystemEncoding _ANSI_ARGS_((
+ Tcl_Interp * interp, CONST char * name));
+/* 317 */
+EXTERN Tcl_Obj * Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2,
+ Tcl_Obj * newValuePtr, int flags));
+/* 318 */
+EXTERN void Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId));
+/* 319 */
+EXTERN void Tcl_ThreadQueueEvent _ANSI_ARGS_((
+ Tcl_ThreadId threadId, Tcl_Event* evPtr,
+ Tcl_QueuePosition position));
+/* 320 */
+EXTERN Tcl_UniChar Tcl_UniCharAtIndex _ANSI_ARGS_((CONST char * src,
+ int index));
+/* 321 */
+EXTERN Tcl_UniChar Tcl_UniCharToLower _ANSI_ARGS_((int ch));
+/* 322 */
+EXTERN Tcl_UniChar Tcl_UniCharToTitle _ANSI_ARGS_((int ch));
+/* 323 */
+EXTERN Tcl_UniChar Tcl_UniCharToUpper _ANSI_ARGS_((int ch));
+/* 324 */
+EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char * buf));
+/* 325 */
+EXTERN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src,
+ int index));
+/* 326 */
+EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src,
+ int len));
+/* 327 */
+EXTERN int Tcl_UtfBackslash _ANSI_ARGS_((CONST char * src,
+ int * readPtr, char * dst));
+/* 328 */
+EXTERN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src,
+ int ch));
+/* 329 */
+EXTERN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src,
+ int ch));
+/* 330 */
+EXTERN char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src));
+/* 331 */
+EXTERN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src,
+ CONST char * start));
+/* 332 */
+EXTERN int Tcl_UtfToExternal _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Encoding encoding, CONST char * src,
+ int srcLen, int flags,
+ Tcl_EncodingState * statePtr, char * dst,
+ int dstLen, int * srcReadPtr,
+ int * dstWrotePtr, int * dstCharsPtr));
+/* 333 */
+EXTERN char * Tcl_UtfToExternalDString _ANSI_ARGS_((
+ Tcl_Encoding encoding, CONST char * src,
+ int srcLen, Tcl_DString * dsPtr));
+/* 334 */
+EXTERN int Tcl_UtfToLower _ANSI_ARGS_((char * src));
+/* 335 */
+EXTERN int Tcl_UtfToTitle _ANSI_ARGS_((char * src));
+/* 336 */
+EXTERN int Tcl_UtfToUniChar _ANSI_ARGS_((CONST char * src,
+ Tcl_UniChar * chPtr));
+/* 337 */
+EXTERN int Tcl_UtfToUpper _ANSI_ARGS_((char * src));
+/* 338 */
+EXTERN int Tcl_WriteChars _ANSI_ARGS_((Tcl_Channel chan,
+ CONST char * src, int srcLen));
+/* 339 */
+EXTERN int Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan,
+ Tcl_Obj * objPtr));
+/* 340 */
+EXTERN char * Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr));
+/* 341 */
+EXTERN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
+/* 342 */
+EXTERN void Tcl_SetDefaultEncodingDir _ANSI_ARGS_((char * path));
+/* 343 */
+EXTERN void Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData));
+/* 344 */
+EXTERN void Tcl_ServiceModeHook _ANSI_ARGS_((int mode));
+/* 345 */
+EXTERN int Tcl_UniCharIsAlnum _ANSI_ARGS_((int ch));
+/* 346 */
+EXTERN int Tcl_UniCharIsAlpha _ANSI_ARGS_((int ch));
+/* 347 */
+EXTERN int Tcl_UniCharIsDigit _ANSI_ARGS_((int ch));
+/* 348 */
+EXTERN int Tcl_UniCharIsLower _ANSI_ARGS_((int ch));
+/* 349 */
+EXTERN int Tcl_UniCharIsSpace _ANSI_ARGS_((int ch));
+/* 350 */
+EXTERN int Tcl_UniCharIsUpper _ANSI_ARGS_((int ch));
+/* 351 */
+EXTERN int Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch));
+/* 352 */
+EXTERN int Tcl_UniCharLen _ANSI_ARGS_((Tcl_UniChar * str));
+/* 353 */
+EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar * cs,
+ CONST Tcl_UniChar * ct, unsigned long n));
+/* 354 */
+EXTERN char * Tcl_UniCharToUtfDString _ANSI_ARGS_((
+ CONST Tcl_UniChar * string, int numChars,
+ Tcl_DString * dsPtr));
+/* 355 */
+EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString _ANSI_ARGS_((
+ CONST char * string, int length,
+ Tcl_DString * dsPtr));
+/* 356 */
+EXTERN Tcl_RegExp Tcl_GetRegExpFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * patObj,
+ int flags));
+/* 357 */
+EXTERN Tcl_Obj * Tcl_EvalTokens _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Token * tokenPtr, int count));
+/* 358 */
+EXTERN void Tcl_FreeParse _ANSI_ARGS_((Tcl_Parse * parsePtr));
+/* 359 */
+EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ char * script, char * command, int length));
+/* 360 */
+EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string, int numBytes,
+ Tcl_Parse * parsePtr, int append,
+ char ** termPtr));
+/* 361 */
+EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string, int numBytes, int nested,
+ Tcl_Parse * parsePtr));
+/* 362 */
+EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string, int numBytes,
+ Tcl_Parse * parsePtr));
+/* 363 */
+EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_((
+ Tcl_Interp * interp, char * string,
+ int numBytes, Tcl_Parse * parsePtr,
+ int append, char ** termPtr));
+/* 364 */
+EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string, int numBytes,
+ Tcl_Parse * parsePtr, int append));
+/* 365 */
+EXTERN char * Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_DString * cwdPtr));
+/* 366 */
+EXTERN int Tcl_Chdir _ANSI_ARGS_((CONST char * dirName));
+/* 367 */
+EXTERN int Tcl_Access _ANSI_ARGS_((CONST char * path, int mode));
+/* 368 */
+EXTERN int Tcl_Stat _ANSI_ARGS_((CONST char * path,
+ struct stat * bufPtr));
+/* 369 */
+EXTERN int Tcl_UtfNcmp _ANSI_ARGS_((CONST char * s1,
+ CONST char * s2, unsigned long n));
+/* 370 */
+EXTERN int Tcl_UtfNcasecmp _ANSI_ARGS_((CONST char * s1,
+ CONST char * s2, unsigned long n));
+/* 371 */
+EXTERN int Tcl_StringCaseMatch _ANSI_ARGS_((CONST char * str,
+ CONST char * pattern, int nocase));
+/* 372 */
+EXTERN int Tcl_UniCharIsControl _ANSI_ARGS_((int ch));
+/* 373 */
+EXTERN int Tcl_UniCharIsGraph _ANSI_ARGS_((int ch));
+/* 374 */
+EXTERN int Tcl_UniCharIsPrint _ANSI_ARGS_((int ch));
+/* 375 */
+EXTERN int Tcl_UniCharIsPunct _ANSI_ARGS_((int ch));
+/* 376 */
+EXTERN int Tcl_RegExpExecObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_RegExp regexp, Tcl_Obj * objPtr,
+ int offset, int nmatches, int flags));
+/* 377 */
+EXTERN void Tcl_RegExpGetInfo _ANSI_ARGS_((Tcl_RegExp regexp,
+ Tcl_RegExpInfo * infoPtr));
+/* 378 */
+EXTERN Tcl_Obj * Tcl_NewUnicodeObj _ANSI_ARGS_((Tcl_UniChar * unicode,
+ int numChars));
+/* 379 */
+EXTERN void Tcl_SetUnicodeObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ Tcl_UniChar * unicode, int numChars));
+/* 380 */
+EXTERN int Tcl_GetCharLength _ANSI_ARGS_((Tcl_Obj * objPtr));
+/* 381 */
+EXTERN Tcl_UniChar Tcl_GetUniChar _ANSI_ARGS_((Tcl_Obj * objPtr,
+ int index));
+/* 382 */
+EXTERN Tcl_UniChar * Tcl_GetUnicode _ANSI_ARGS_((Tcl_Obj * objPtr));
+/* 383 */
+EXTERN Tcl_Obj * Tcl_GetRange _ANSI_ARGS_((Tcl_Obj * objPtr,
+ int first, int last));
+/* 384 */
+EXTERN void Tcl_AppendUnicodeToObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ Tcl_UniChar * unicode, int length));
+/* 385 */
+EXTERN int Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * stringObj, Tcl_Obj * patternObj));
+/* 386 */
+EXTERN void Tcl_SetNotifier _ANSI_ARGS_((
+ Tcl_NotifierProcs * notifierProcPtr));
+/* 387 */
+EXTERN Tcl_Mutex * Tcl_GetAllocMutex _ANSI_ARGS_((void));
+/* 388 */
+EXTERN int Tcl_GetChannelNames _ANSI_ARGS_((Tcl_Interp * interp));
+/* 389 */
+EXTERN int Tcl_GetChannelNamesEx _ANSI_ARGS_((
+ Tcl_Interp * interp, char * pattern));
+/* 390 */
+EXTERN int Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp * interp, int objc,
+ Tcl_Obj *CONST objv[]));
+/* 391 */
+EXTERN void Tcl_ConditionFinalize _ANSI_ARGS_((
+ Tcl_Condition * condPtr));
+/* 392 */
+EXTERN void Tcl_MutexFinalize _ANSI_ARGS_((Tcl_Mutex * mutex));
+/* 393 */
+EXTERN int Tcl_CreateThread _ANSI_ARGS_((Tcl_ThreadId * idPtr,
+ Tcl_ThreadCreateProc proc,
+ ClientData clientData, int stackSize,
+ int flags));
+/* 394 */
+EXTERN int Tcl_ReadRaw _ANSI_ARGS_((Tcl_Channel chan,
+ char * dst, int bytesToRead));
+/* 395 */
+EXTERN int Tcl_WriteRaw _ANSI_ARGS_((Tcl_Channel chan,
+ char * src, int srcLen));
+/* 396 */
+EXTERN Tcl_Channel Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan));
+/* 397 */
+EXTERN int Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan));
+/* 398 */
+EXTERN char * Tcl_ChannelName _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 399 */
+EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 400 */
+EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 401 */
+EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 402 */
+EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 403 */
+EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 404 */
+EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 405 */
+EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 406 */
+EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 407 */
+EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 408 */
+EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 409 */
+EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 410 */
+EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+/* 411 */
+EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
+
+typedef struct TclStubHooks {
+ struct TclPlatStubs *tclPlatStubs;
+ struct TclIntStubs *tclIntStubs;
+ struct TclIntPlatStubs *tclIntPlatStubs;
+} TclStubHooks;
+
+typedef struct TclStubs {
+ int magic;
+ struct TclStubHooks *hooks;
+
+ int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, ClientData clientData)); /* 0 */
+ char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, int exact, ClientData * clientDataPtr)); /* 1 */
+ void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(char *,format)); /* 2 */
+ char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */
+ void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */
+ char * (*tcl_Realloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 5 */
+ char * (*tcl_DbCkalloc) _ANSI_ARGS_((unsigned int size, char * file, int line)); /* 6 */
+ int (*tcl_DbCkfree) _ANSI_ARGS_((char * ptr, char * file, int line)); /* 7 */
+ char * (*tcl_DbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, char * file, int line)); /* 8 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void (*tcl_CreateFileHandler) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc * proc, ClientData clientData)); /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved9;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved9;
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void (*tcl_DeleteFileHandler) _ANSI_ARGS_((int fd)); /* 10 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved10;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved10;
+#endif /* MAC_TCL */
+ void (*tcl_SetTimer) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 11 */
+ void (*tcl_Sleep) _ANSI_ARGS_((int ms)); /* 12 */
+ int (*tcl_WaitForEvent) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 13 */
+ int (*tcl_AppendAllObjTypes) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 14 */
+ void (*tcl_AppendStringsToObj) _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr)); /* 15 */
+ void (*tcl_AppendToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, char * bytes, int length)); /* 16 */
+ Tcl_Obj * (*tcl_ConcatObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 17 */
+ int (*tcl_ConvertToType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_ObjType * typePtr)); /* 18 */
+ void (*tcl_DbDecrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, char * file, int line)); /* 19 */
+ void (*tcl_DbIncrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, char * file, int line)); /* 20 */
+ int (*tcl_DbIsShared) _ANSI_ARGS_((Tcl_Obj * objPtr, char * file, int line)); /* 21 */
+ Tcl_Obj * (*tcl_DbNewBooleanObj) _ANSI_ARGS_((int boolValue, char * file, int line)); /* 22 */
+ Tcl_Obj * (*tcl_DbNewByteArrayObj) _ANSI_ARGS_((unsigned char * bytes, int length, char * file, int line)); /* 23 */
+ Tcl_Obj * (*tcl_DbNewDoubleObj) _ANSI_ARGS_((double doubleValue, char * file, int line)); /* 24 */
+ Tcl_Obj * (*tcl_DbNewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[], char * file, int line)); /* 25 */
+ Tcl_Obj * (*tcl_DbNewLongObj) _ANSI_ARGS_((long longValue, char * file, int line)); /* 26 */
+ Tcl_Obj * (*tcl_DbNewObj) _ANSI_ARGS_((char * file, int line)); /* 27 */
+ Tcl_Obj * (*tcl_DbNewStringObj) _ANSI_ARGS_((CONST char * bytes, int length, char * file, int line)); /* 28 */
+ Tcl_Obj * (*tcl_DuplicateObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 29 */
+ void (*tclFreeObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 30 */
+ int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * boolPtr)); /* 31 */
+ int (*tcl_GetBooleanFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * boolPtr)); /* 32 */
+ unsigned char * (*tcl_GetByteArrayFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 33 */
+ int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp * interp, char * str, double * doublePtr)); /* 34 */
+ int (*tcl_GetDoubleFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * doublePtr)); /* 35 */
+ int (*tcl_GetIndexFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, char ** tablePtr, char * msg, int flags, int * indexPtr)); /* 36 */
+ int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * intPtr)); /* 37 */
+ int (*tcl_GetIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)); /* 38 */
+ int (*tcl_GetLongFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)); /* 39 */
+ Tcl_ObjType * (*tcl_GetObjType) _ANSI_ARGS_((char * typeName)); /* 40 */
+ char * (*tcl_GetStringFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 41 */
+ void (*tcl_InvalidateStringRep) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 42 */
+ int (*tcl_ListObjAppendList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr)); /* 43 */
+ int (*tcl_ListObjAppendElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)); /* 44 */
+ int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj *** objvPtr)); /* 45 */
+ int (*tcl_ListObjIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)); /* 46 */
+ int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * intPtr)); /* 47 */
+ int (*tcl_ListObjReplace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 48 */
+ Tcl_Obj * (*tcl_NewBooleanObj) _ANSI_ARGS_((int boolValue)); /* 49 */
+ Tcl_Obj * (*tcl_NewByteArrayObj) _ANSI_ARGS_((unsigned char * bytes, int length)); /* 50 */
+ Tcl_Obj * (*tcl_NewDoubleObj) _ANSI_ARGS_((double doubleValue)); /* 51 */
+ Tcl_Obj * (*tcl_NewIntObj) _ANSI_ARGS_((int intValue)); /* 52 */
+ Tcl_Obj * (*tcl_NewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 53 */
+ Tcl_Obj * (*tcl_NewLongObj) _ANSI_ARGS_((long longValue)); /* 54 */
+ Tcl_Obj * (*tcl_NewObj) _ANSI_ARGS_((void)); /* 55 */
+ Tcl_Obj * (*tcl_NewStringObj) _ANSI_ARGS_((CONST char * bytes, int length)); /* 56 */
+ void (*tcl_SetBooleanObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int boolValue)); /* 57 */
+ unsigned char * (*tcl_SetByteArrayLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 58 */
+ void (*tcl_SetByteArrayObj) _ANSI_ARGS_((Tcl_Obj * objPtr, unsigned char * bytes, int length)); /* 59 */
+ void (*tcl_SetDoubleObj) _ANSI_ARGS_((Tcl_Obj * objPtr, double doubleValue)); /* 60 */
+ void (*tcl_SetIntObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int intValue)); /* 61 */
+ void (*tcl_SetListObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int objc, Tcl_Obj *CONST objv[])); /* 62 */
+ void (*tcl_SetLongObj) _ANSI_ARGS_((Tcl_Obj * objPtr, long longValue)); /* 63 */
+ void (*tcl_SetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 64 */
+ void (*tcl_SetStringObj) _ANSI_ARGS_((Tcl_Obj * objPtr, char * bytes, int length)); /* 65 */
+ void (*tcl_AddErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message)); /* 66 */
+ void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message, int length)); /* 67 */
+ void (*tcl_AllowExceptions) _ANSI_ARGS_((Tcl_Interp * interp)); /* 68 */
+ void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 69 */
+ void (*tcl_AppendResult) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 70 */
+ Tcl_AsyncHandler (*tcl_AsyncCreate) _ANSI_ARGS_((Tcl_AsyncProc * proc, ClientData clientData)); /* 71 */
+ void (*tcl_AsyncDelete) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 72 */
+ int (*tcl_AsyncInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int code)); /* 73 */
+ void (*tcl_AsyncMark) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 74 */
+ int (*tcl_AsyncReady) _ANSI_ARGS_((void)); /* 75 */
+ void (*tcl_BackgroundError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 76 */
+ char (*tcl_Backslash) _ANSI_ARGS_((CONST char * src, int * readPtr)); /* 77 */
+ int (*tcl_BadChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, char * optionName, char * optionList)); /* 78 */
+ void (*tcl_CallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 79 */
+ void (*tcl_CancelIdleCall) _ANSI_ARGS_((Tcl_IdleProc * idleProc, ClientData clientData)); /* 80 */
+ int (*tcl_Close) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 81 */
+ int (*tcl_CommandComplete) _ANSI_ARGS_((char * cmd)); /* 82 */
+ char * (*tcl_Concat) _ANSI_ARGS_((int argc, char ** argv)); /* 83 */
+ int (*tcl_ConvertElement) _ANSI_ARGS_((CONST char * src, char * dst, int flags)); /* 84 */
+ int (*tcl_ConvertCountedElement) _ANSI_ARGS_((CONST char * src, int length, char * dst, int flags)); /* 85 */
+ int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, char * slaveCmd, Tcl_Interp * target, char * targetCmd, int argc, char ** argv)); /* 86 */
+ int (*tcl_CreateAliasObj) _ANSI_ARGS_((Tcl_Interp * slave, char * slaveCmd, Tcl_Interp * target, char * targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 87 */
+ Tcl_Channel (*tcl_CreateChannel) _ANSI_ARGS_((Tcl_ChannelType * typePtr, char * chanName, ClientData instanceData, int mask)); /* 88 */
+ void (*tcl_CreateChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, int mask, Tcl_ChannelProc * proc, ClientData clientData)); /* 89 */
+ void (*tcl_CreateCloseHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)); /* 90 */
+ Tcl_Command (*tcl_CreateCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * cmdName, Tcl_CmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 91 */
+ void (*tcl_CreateEventSource) _ANSI_ARGS_((Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)); /* 92 */
+ void (*tcl_CreateExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 93 */
+ Tcl_Interp * (*tcl_CreateInterp) _ANSI_ARGS_((void)); /* 94 */
+ void (*tcl_CreateMathFunc) _ANSI_ARGS_((Tcl_Interp * interp, char * name, int numArgs, Tcl_ValueType * argTypes, Tcl_MathProc * proc, ClientData clientData)); /* 95 */
+ Tcl_Command (*tcl_CreateObjCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * cmdName, Tcl_ObjCmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 96 */
+ Tcl_Interp * (*tcl_CreateSlave) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveName, int isSafe)); /* 97 */
+ Tcl_TimerToken (*tcl_CreateTimerHandler) _ANSI_ARGS_((int milliseconds, Tcl_TimerProc * proc, ClientData clientData)); /* 98 */
+ Tcl_Trace (*tcl_CreateTrace) _ANSI_ARGS_((Tcl_Interp * interp, int level, Tcl_CmdTraceProc * proc, ClientData clientData)); /* 99 */
+ void (*tcl_DeleteAssocData) _ANSI_ARGS_((Tcl_Interp * interp, char * name)); /* 100 */
+ void (*tcl_DeleteChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_ChannelProc * proc, ClientData clientData)); /* 101 */
+ void (*tcl_DeleteCloseHandler) _ANSI_ARGS_((Tcl_Channel chan, Tcl_CloseProc * proc, ClientData clientData)); /* 102 */
+ int (*tcl_DeleteCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * cmdName)); /* 103 */
+ int (*tcl_DeleteCommandFromToken) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 104 */
+ void (*tcl_DeleteEvents) _ANSI_ARGS_((Tcl_EventDeleteProc * proc, ClientData clientData)); /* 105 */
+ void (*tcl_DeleteEventSource) _ANSI_ARGS_((Tcl_EventSetupProc * setupProc, Tcl_EventCheckProc * checkProc, ClientData clientData)); /* 106 */
+ void (*tcl_DeleteExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 107 */
+ void (*tcl_DeleteHashEntry) _ANSI_ARGS_((Tcl_HashEntry * entryPtr)); /* 108 */
+ void (*tcl_DeleteHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 109 */
+ void (*tcl_DeleteInterp) _ANSI_ARGS_((Tcl_Interp * interp)); /* 110 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid * pidPtr)); /* 111 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid * pidPtr)); /* 111 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved111;
+#endif /* MAC_TCL */
+ void (*tcl_DeleteTimerHandler) _ANSI_ARGS_((Tcl_TimerToken token)); /* 112 */
+ void (*tcl_DeleteTrace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Trace trace)); /* 113 */
+ void (*tcl_DontCallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 114 */
+ int (*tcl_DoOneEvent) _ANSI_ARGS_((int flags)); /* 115 */
+ void (*tcl_DoWhenIdle) _ANSI_ARGS_((Tcl_IdleProc * proc, ClientData clientData)); /* 116 */
+ char * (*tcl_DStringAppend) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * str, int length)); /* 117 */
+ char * (*tcl_DStringAppendElement) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * string)); /* 118 */
+ void (*tcl_DStringEndSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 119 */
+ void (*tcl_DStringFree) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 120 */
+ void (*tcl_DStringGetResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 121 */
+ void (*tcl_DStringInit) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 122 */
+ void (*tcl_DStringResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 123 */
+ void (*tcl_DStringSetLength) _ANSI_ARGS_((Tcl_DString * dsPtr, int length)); /* 124 */
+ void (*tcl_DStringStartSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 125 */
+ int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */
+ char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */
+ char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */
+ int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 129 */
+ int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName)); /* 130 */
+ int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 131 */
+ void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc * freeProc)); /* 132 */
+ void (*tcl_Exit) _ANSI_ARGS_((int status)); /* 133 */
+ int (*tcl_ExposeCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * hiddenCmdToken, char * cmdName)); /* 134 */
+ int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * ptr)); /* 135 */
+ int (*tcl_ExprBooleanObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * ptr)); /* 136 */
+ int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp * interp, char * str, double * ptr)); /* 137 */
+ int (*tcl_ExprDoubleObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * ptr)); /* 138 */
+ int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, char * str, long * ptr)); /* 139 */
+ int (*tcl_ExprLongObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * ptr)); /* 140 */
+ int (*tcl_ExprObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr)); /* 141 */
+ int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 142 */
+ void (*tcl_Finalize) _ANSI_ARGS_((void)); /* 143 */
+ void (*tcl_FindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 144 */
+ Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */
+ int (*tcl_Flush) _ANSI_ARGS_((Tcl_Channel chan)); /* 146 */
+ void (*tcl_FreeResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 147 */
+ int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveCmd, Tcl_Interp ** targetInterpPtr, char ** targetCmdPtr, int * argcPtr, char *** argvPtr)); /* 148 */
+ int (*tcl_GetAliasObj) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveCmd, Tcl_Interp ** targetInterpPtr, char ** targetCmdPtr, int * objcPtr, Tcl_Obj *** objv)); /* 149 */
+ ClientData (*tcl_GetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_InterpDeleteProc ** procPtr)); /* 150 */
+ Tcl_Channel (*tcl_GetChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * chanName, int * modePtr)); /* 151 */
+ int (*tcl_GetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan)); /* 152 */
+ int (*tcl_GetChannelHandle) _ANSI_ARGS_((Tcl_Channel chan, int direction, ClientData * handlePtr)); /* 153 */
+ ClientData (*tcl_GetChannelInstanceData) _ANSI_ARGS_((Tcl_Channel chan)); /* 154 */
+ int (*tcl_GetChannelMode) _ANSI_ARGS_((Tcl_Channel chan)); /* 155 */
+ char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */
+ int (*tcl_GetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, char * optionName, Tcl_DString * dsPtr)); /* 157 */
+ Tcl_ChannelType * (*tcl_GetChannelType) _ANSI_ARGS_((Tcl_Channel chan)); /* 158 */
+ int (*tcl_GetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * cmdName, Tcl_CmdInfo * infoPtr)); /* 159 */
+ char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */
+ int (*tcl_GetErrno) _ANSI_ARGS_((void)); /* 161 */
+ char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */
+ int (*tcl_GetInterpPath) _ANSI_ARGS_((Tcl_Interp * askInterp, Tcl_Interp * slaveInterp)); /* 163 */
+ Tcl_Interp * (*tcl_GetMaster) _ANSI_ARGS_((Tcl_Interp * interp)); /* 164 */
+ CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */
+ Tcl_Obj * (*tcl_GetObjResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 166 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved167;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved167;
+#endif /* MAC_TCL */
+ Tcl_PathType (*tcl_GetPathType) _ANSI_ARGS_((char * path)); /* 168 */
+ int (*tcl_Gets) _ANSI_ARGS_((Tcl_Channel chan, Tcl_DString * dsPtr)); /* 169 */
+ int (*tcl_GetsObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 170 */
+ int (*tcl_GetServiceMode) _ANSI_ARGS_((void)); /* 171 */
+ Tcl_Interp * (*tcl_GetSlave) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveName)); /* 172 */
+ Tcl_Channel (*tcl_GetStdChannel) _ANSI_ARGS_((int type)); /* 173 */
+ char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */
+ char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 175 */
+ char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 176 */
+ int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * command)); /* 177 */
+ int (*tcl_GlobalEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 178 */
+ int (*tcl_HideCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * cmdName, char * hiddenCmdToken)); /* 179 */
+ int (*tcl_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 180 */
+ void (*tcl_InitHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType)); /* 181 */
+ int (*tcl_InputBlocked) _ANSI_ARGS_((Tcl_Channel chan)); /* 182 */
+ int (*tcl_InputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 183 */
+ int (*tcl_InterpDeleted) _ANSI_ARGS_((Tcl_Interp * interp)); /* 184 */
+ int (*tcl_IsSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 185 */
+ char * (*tcl_JoinPath) _ANSI_ARGS_((int argc, char ** argv, Tcl_DString * resultPtr)); /* 186 */
+ int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * addr, int type)); /* 187 */
+ void *reserved188;
+ Tcl_Channel (*tcl_MakeFileChannel) _ANSI_ARGS_((ClientData handle, int mode)); /* 189 */
+ int (*tcl_MakeSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 190 */
+ Tcl_Channel (*tcl_MakeTcpClientChannel) _ANSI_ARGS_((ClientData tcpSocket)); /* 191 */
+ char * (*tcl_Merge) _ANSI_ARGS_((int argc, char ** argv)); /* 192 */
+ Tcl_HashEntry * (*tcl_NextHashEntry) _ANSI_ARGS_((Tcl_HashSearch * searchPtr)); /* 193 */
+ void (*tcl_NotifyChannel) _ANSI_ARGS_((Tcl_Channel channel, int mask)); /* 194 */
+ Tcl_Obj * (*tcl_ObjGetVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, int flags)); /* 195 */
+ Tcl_Obj * (*tcl_ObjSetVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, Tcl_Obj * newValuePtr, int flags)); /* 196 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 197 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 197 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved197;
+#endif /* MAC_TCL */
+ Tcl_Channel (*tcl_OpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 198 */
+ Tcl_Channel (*tcl_OpenTcpClient) _ANSI_ARGS_((Tcl_Interp * interp, int port, char * address, char * myaddr, int myport, int async)); /* 199 */
+ Tcl_Channel (*tcl_OpenTcpServer) _ANSI_ARGS_((Tcl_Interp * interp, int port, char * host, Tcl_TcpAcceptProc * acceptProc, ClientData callbackData)); /* 200 */
+ void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */
+ void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 202 */
+ int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * string)); /* 203 */
+ char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */
+ void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 205 */
+ int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); /* 206 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved207;
+#endif /* MAC_TCL */
+ int (*tcl_RecordAndEval) _ANSI_ARGS_((Tcl_Interp * interp, char * cmd, int flags)); /* 208 */
+ int (*tcl_RecordAndEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * cmdPtr, int flags)); /* 209 */
+ void (*tcl_RegisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 210 */
+ void (*tcl_RegisterObjType) _ANSI_ARGS_((Tcl_ObjType * typePtr)); /* 211 */
+ Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 212 */
+ int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * str, CONST char * start)); /* 213 */
+ int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char * pattern)); /* 214 */
+ void (*tcl_RegExpRange) _ANSI_ARGS_((Tcl_RegExp regexp, int index, char ** startPtr, char ** endPtr)); /* 215 */
+ void (*tcl_Release) _ANSI_ARGS_((ClientData clientData)); /* 216 */
+ void (*tcl_ResetResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 217 */
+ int (*tcl_ScanElement) _ANSI_ARGS_((CONST char * str, int * flagPtr)); /* 218 */
+ int (*tcl_ScanCountedElement) _ANSI_ARGS_((CONST char * str, int length, int * flagPtr)); /* 219 */
+ int (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, int offset, int mode)); /* 220 */
+ int (*tcl_ServiceAll) _ANSI_ARGS_((void)); /* 221 */
+ int (*tcl_ServiceEvent) _ANSI_ARGS_((int flags)); /* 222 */
+ void (*tcl_SetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 223 */
+ void (*tcl_SetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan, int sz)); /* 224 */
+ int (*tcl_SetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, char * optionName, char * newValue)); /* 225 */
+ int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * cmdName, Tcl_CmdInfo * infoPtr)); /* 226 */
+ void (*tcl_SetErrno) _ANSI_ARGS_((int err)); /* 227 */
+ void (*tcl_SetErrorCode) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 228 */
+ void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 229 */
+ void (*tcl_SetPanicProc) _ANSI_ARGS_((Tcl_PanicProc * panicProc)); /* 230 */
+ int (*tcl_SetRecursionLimit) _ANSI_ARGS_((Tcl_Interp * interp, int depth)); /* 231 */
+ void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tcl_FreeProc * freeProc)); /* 232 */
+ int (*tcl_SetServiceMode) _ANSI_ARGS_((int mode)); /* 233 */
+ void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */
+ void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */
+ void (*tcl_SetStdChannel) _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 236 */
+ char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * newValue, int flags)); /* 237 */
+ char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, char * newValue, int flags)); /* 238 */
+ char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */
+ char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */
+ void (*tcl_SourceRCFile) _ANSI_ARGS_((Tcl_Interp * interp)); /* 241 */
+ int (*tcl_SplitList) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int * argcPtr, char *** argvPtr)); /* 242 */
+ void (*tcl_SplitPath) _ANSI_ARGS_((CONST char * path, int * argcPtr, char *** argvPtr)); /* 243 */
+ void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp * interp, char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 244 */
+ int (*tcl_StringMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 245 */
+ int (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */
+ int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */
+ int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */
+ char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_DString * bufferPtr)); /* 249 */
+ int (*tcl_Ungets) _ANSI_ARGS_((Tcl_Channel chan, char * str, int len, int atHead)); /* 250 */
+ void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 251 */
+ int (*tcl_UnregisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 252 */
+ int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 253 */
+ int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 254 */
+ void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */
+ void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */
+ void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 257 */
+ int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, char * frameName, char * varName, char * localName, int flags)); /* 258 */
+ int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * frameName, char * part1, char * part2, char * localName, int flags)); /* 259 */
+ int (*tcl_VarEval) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 260 */
+ ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */
+ ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */
+ int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, char * s, int slen)); /* 263 */
+ void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], char * message)); /* 264 */
+ int (*tcl_DumpActiveMemory) _ANSI_ARGS_((char * fileName)); /* 265 */
+ void (*tcl_ValidateAllMemory) _ANSI_ARGS_((char * file, int line)); /* 266 */
+ void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */
+ void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj * objPtr, va_list argList)); /* 268 */
+ char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */
+ char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char ** termPtr)); /* 270 */
+ char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, int exact)); /* 271 */
+ char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, int exact, ClientData * clientDataPtr)); /* 272 */
+ int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version)); /* 273 */
+ char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, int exact)); /* 274 */
+ void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 275 */
+ int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */
+ Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 277 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved278;
+#endif /* MAC_TCL */
+ void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */
+ void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */
+ Tcl_Channel (*tcl_StackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */
+ int (*tcl_UnstackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 282 */
+ Tcl_Channel (*tcl_GetStackedChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 283 */
+ void *reserved284;
+ void *reserved285;
+ void (*tcl_AppendObjToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_Obj * appendObjPtr)); /* 286 */
+ Tcl_Encoding (*tcl_CreateEncoding) _ANSI_ARGS_((Tcl_EncodingType * typePtr)); /* 287 */
+ void (*tcl_CreateThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 288 */
+ void (*tcl_DeleteThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 289 */
+ void (*tcl_DiscardResult) _ANSI_ARGS_((Tcl_SavedResult * statePtr)); /* 290 */
+ int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, char * script, int numBytes, int flags)); /* 291 */
+ int (*tcl_EvalObjv) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 292 */
+ int (*tcl_EvalObjEx) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 293 */
+ void (*tcl_ExitThread) _ANSI_ARGS_((int status)); /* 294 */
+ int (*tcl_ExternalToUtf) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 295 */
+ char * (*tcl_ExternalToUtfDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 296 */
+ void (*tcl_FinalizeThread) _ANSI_ARGS_((void)); /* 297 */
+ void (*tcl_FinalizeNotifier) _ANSI_ARGS_((ClientData clientData)); /* 298 */
+ void (*tcl_FreeEncoding) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 299 */
+ Tcl_ThreadId (*tcl_GetCurrentThread) _ANSI_ARGS_((void)); /* 300 */
+ Tcl_Encoding (*tcl_GetEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 301 */
+ char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */
+ void (*tcl_GetEncodingNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 303 */
+ int (*tcl_GetIndexFromObjStruct) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, char ** tablePtr, int offset, char * msg, int flags, int * indexPtr)); /* 304 */
+ VOID * (*tcl_GetThreadData) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr, int size)); /* 305 */
+ Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 306 */
+ ClientData (*tcl_InitNotifier) _ANSI_ARGS_((void)); /* 307 */
+ void (*tcl_MutexLock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 308 */
+ void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */
+ void (*tcl_ConditionNotify) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 310 */
+ void (*tcl_ConditionWait) _ANSI_ARGS_((Tcl_Condition * condPtr, Tcl_Mutex * mutexPtr, Tcl_Time * timePtr)); /* 311 */
+ int (*tcl_NumUtfChars) _ANSI_ARGS_((CONST char * src, int len)); /* 312 */
+ int (*tcl_ReadChars) _ANSI_ARGS_((Tcl_Channel channel, Tcl_Obj * objPtr, int charsToRead, int appendFlag)); /* 313 */
+ void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 314 */
+ void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */
+ int (*tcl_SetSystemEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 316 */
+ Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */
+ void (*tcl_ThreadAlert) _ANSI_ARGS_((Tcl_ThreadId threadId)); /* 318 */
+ void (*tcl_ThreadQueueEvent) _ANSI_ARGS_((Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position)); /* 319 */
+ Tcl_UniChar (*tcl_UniCharAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 320 */
+ Tcl_UniChar (*tcl_UniCharToLower) _ANSI_ARGS_((int ch)); /* 321 */
+ Tcl_UniChar (*tcl_UniCharToTitle) _ANSI_ARGS_((int ch)); /* 322 */
+ Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */
+ int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char * buf)); /* 324 */
+ char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */
+ int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int len)); /* 326 */
+ int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */
+ char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */
+ char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */
+ char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */
+ char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */
+ int (*tcl_UtfToExternal) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 332 */
+ char * (*tcl_UtfToExternalDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 333 */
+ int (*tcl_UtfToLower) _ANSI_ARGS_((char * src)); /* 334 */
+ int (*tcl_UtfToTitle) _ANSI_ARGS_((char * src)); /* 335 */
+ int (*tcl_UtfToUniChar) _ANSI_ARGS_((CONST char * src, Tcl_UniChar * chPtr)); /* 336 */
+ int (*tcl_UtfToUpper) _ANSI_ARGS_((char * src)); /* 337 */
+ int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */
+ int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */
+ char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */
+ char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
+ void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((char * path)); /* 342 */
+ void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */
+ void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */
+ int (*tcl_UniCharIsAlnum) _ANSI_ARGS_((int ch)); /* 345 */
+ int (*tcl_UniCharIsAlpha) _ANSI_ARGS_((int ch)); /* 346 */
+ int (*tcl_UniCharIsDigit) _ANSI_ARGS_((int ch)); /* 347 */
+ int (*tcl_UniCharIsLower) _ANSI_ARGS_((int ch)); /* 348 */
+ int (*tcl_UniCharIsSpace) _ANSI_ARGS_((int ch)); /* 349 */
+ int (*tcl_UniCharIsUpper) _ANSI_ARGS_((int ch)); /* 350 */
+ int (*tcl_UniCharIsWordChar) _ANSI_ARGS_((int ch)); /* 351 */
+ int (*tcl_UniCharLen) _ANSI_ARGS_((Tcl_UniChar * str)); /* 352 */
+ int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 353 */
+ char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * string, int numChars, Tcl_DString * dsPtr)); /* 354 */
+ Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * string, int length, Tcl_DString * dsPtr)); /* 355 */
+ Tcl_RegExp (*tcl_GetRegExpFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * patObj, int flags)); /* 356 */
+ Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 357 */
+ void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 358 */
+ void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * script, char * command, int length)); /* 359 */
+ int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 360 */
+ int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */
+ int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */
+ int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 363 */
+ int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */
+ char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */
+ int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */
+ int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */
+ int (*tcl_Stat) _ANSI_ARGS_((CONST char * path, struct stat * bufPtr)); /* 368 */
+ int (*tcl_UtfNcmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 369 */
+ int (*tcl_UtfNcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 370 */
+ int (*tcl_StringCaseMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern, int nocase)); /* 371 */
+ int (*tcl_UniCharIsControl) _ANSI_ARGS_((int ch)); /* 372 */
+ int (*tcl_UniCharIsGraph) _ANSI_ARGS_((int ch)); /* 373 */
+ int (*tcl_UniCharIsPrint) _ANSI_ARGS_((int ch)); /* 374 */
+ int (*tcl_UniCharIsPunct) _ANSI_ARGS_((int ch)); /* 375 */
+ int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * objPtr, int offset, int nmatches, int flags)); /* 376 */
+ void (*tcl_RegExpGetInfo) _ANSI_ARGS_((Tcl_RegExp regexp, Tcl_RegExpInfo * infoPtr)); /* 377 */
+ Tcl_Obj * (*tcl_NewUnicodeObj) _ANSI_ARGS_((Tcl_UniChar * unicode, int numChars)); /* 378 */
+ void (*tcl_SetUnicodeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_UniChar * unicode, int numChars)); /* 379 */
+ int (*tcl_GetCharLength) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 380 */
+ Tcl_UniChar (*tcl_GetUniChar) _ANSI_ARGS_((Tcl_Obj * objPtr, int index)); /* 381 */
+ Tcl_UniChar * (*tcl_GetUnicode) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 382 */
+ Tcl_Obj * (*tcl_GetRange) _ANSI_ARGS_((Tcl_Obj * objPtr, int first, int last)); /* 383 */
+ void (*tcl_AppendUnicodeToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_UniChar * unicode, int length)); /* 384 */
+ int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * stringObj, Tcl_Obj * patternObj)); /* 385 */
+ void (*tcl_SetNotifier) _ANSI_ARGS_((Tcl_NotifierProcs * notifierProcPtr)); /* 386 */
+ Tcl_Mutex * (*tcl_GetAllocMutex) _ANSI_ARGS_((void)); /* 387 */
+ int (*tcl_GetChannelNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 388 */
+ int (*tcl_GetChannelNamesEx) _ANSI_ARGS_((Tcl_Interp * interp, char * pattern)); /* 389 */
+ int (*tcl_ProcObjCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 390 */
+ void (*tcl_ConditionFinalize) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 391 */
+ void (*tcl_MutexFinalize) _ANSI_ARGS_((Tcl_Mutex * mutex)); /* 392 */
+ int (*tcl_CreateThread) _ANSI_ARGS_((Tcl_ThreadId * idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags)); /* 393 */
+ int (*tcl_ReadRaw) _ANSI_ARGS_((Tcl_Channel chan, char * dst, int bytesToRead)); /* 394 */
+ int (*tcl_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, char * src, int srcLen)); /* 395 */
+ Tcl_Channel (*tcl_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 396 */
+ int (*tcl_ChannelBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */
+ char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */
+ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 399 */
+ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 400 */
+ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 401 */
+ Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 402 */
+ Tcl_DriverInputProc * (*tcl_ChannelInputProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 403 */
+ Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 404 */
+ Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 405 */
+ Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 406 */
+ Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 407 */
+ Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 408 */
+ Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 409 */
+ Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 410 */
+ Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 411 */
+} TclStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TclStubs *tclStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifndef Tcl_PkgProvideEx
+#define Tcl_PkgProvideEx \
+ (tclStubsPtr->tcl_PkgProvideEx) /* 0 */
+#endif
+#ifndef Tcl_PkgRequireEx
+#define Tcl_PkgRequireEx \
+ (tclStubsPtr->tcl_PkgRequireEx) /* 1 */
+#endif
+#ifndef Tcl_Panic
+#define Tcl_Panic \
+ (tclStubsPtr->tcl_Panic) /* 2 */
+#endif
+#ifndef Tcl_Alloc
+#define Tcl_Alloc \
+ (tclStubsPtr->tcl_Alloc) /* 3 */
+#endif
+#ifndef Tcl_Free
+#define Tcl_Free \
+ (tclStubsPtr->tcl_Free) /* 4 */
+#endif
+#ifndef Tcl_Realloc
+#define Tcl_Realloc \
+ (tclStubsPtr->tcl_Realloc) /* 5 */
+#endif
+#ifndef Tcl_DbCkalloc
+#define Tcl_DbCkalloc \
+ (tclStubsPtr->tcl_DbCkalloc) /* 6 */
+#endif
+#ifndef Tcl_DbCkfree
+#define Tcl_DbCkfree \
+ (tclStubsPtr->tcl_DbCkfree) /* 7 */
+#endif
+#ifndef Tcl_DbCkrealloc
+#define Tcl_DbCkrealloc \
+ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_CreateFileHandler
+#define Tcl_CreateFileHandler \
+ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */
+#endif
+#endif /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_DeleteFileHandler
+#define Tcl_DeleteFileHandler \
+ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
+#endif
+#endif /* UNIX */
+#ifndef Tcl_SetTimer
+#define Tcl_SetTimer \
+ (tclStubsPtr->tcl_SetTimer) /* 11 */
+#endif
+#ifndef Tcl_Sleep
+#define Tcl_Sleep \
+ (tclStubsPtr->tcl_Sleep) /* 12 */
+#endif
+#ifndef Tcl_WaitForEvent
+#define Tcl_WaitForEvent \
+ (tclStubsPtr->tcl_WaitForEvent) /* 13 */
+#endif
+#ifndef Tcl_AppendAllObjTypes
+#define Tcl_AppendAllObjTypes \
+ (tclStubsPtr->tcl_AppendAllObjTypes) /* 14 */
+#endif
+#ifndef Tcl_AppendStringsToObj
+#define Tcl_AppendStringsToObj \
+ (tclStubsPtr->tcl_AppendStringsToObj) /* 15 */
+#endif
+#ifndef Tcl_AppendToObj
+#define Tcl_AppendToObj \
+ (tclStubsPtr->tcl_AppendToObj) /* 16 */
+#endif
+#ifndef Tcl_ConcatObj
+#define Tcl_ConcatObj \
+ (tclStubsPtr->tcl_ConcatObj) /* 17 */
+#endif
+#ifndef Tcl_ConvertToType
+#define Tcl_ConvertToType \
+ (tclStubsPtr->tcl_ConvertToType) /* 18 */
+#endif
+#ifndef Tcl_DbDecrRefCount
+#define Tcl_DbDecrRefCount \
+ (tclStubsPtr->tcl_DbDecrRefCount) /* 19 */
+#endif
+#ifndef Tcl_DbIncrRefCount
+#define Tcl_DbIncrRefCount \
+ (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
+#endif
+#ifndef Tcl_DbIsShared
+#define Tcl_DbIsShared \
+ (tclStubsPtr->tcl_DbIsShared) /* 21 */
+#endif
+#ifndef Tcl_DbNewBooleanObj
+#define Tcl_DbNewBooleanObj \
+ (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
+#endif
+#ifndef Tcl_DbNewByteArrayObj
+#define Tcl_DbNewByteArrayObj \
+ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
+#endif
+#ifndef Tcl_DbNewDoubleObj
+#define Tcl_DbNewDoubleObj \
+ (tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
+#endif
+#ifndef Tcl_DbNewListObj
+#define Tcl_DbNewListObj \
+ (tclStubsPtr->tcl_DbNewListObj) /* 25 */
+#endif
+#ifndef Tcl_DbNewLongObj
+#define Tcl_DbNewLongObj \
+ (tclStubsPtr->tcl_DbNewLongObj) /* 26 */
+#endif
+#ifndef Tcl_DbNewObj
+#define Tcl_DbNewObj \
+ (tclStubsPtr->tcl_DbNewObj) /* 27 */
+#endif
+#ifndef Tcl_DbNewStringObj
+#define Tcl_DbNewStringObj \
+ (tclStubsPtr->tcl_DbNewStringObj) /* 28 */
+#endif
+#ifndef Tcl_DuplicateObj
+#define Tcl_DuplicateObj \
+ (tclStubsPtr->tcl_DuplicateObj) /* 29 */
+#endif
+#ifndef TclFreeObj
+#define TclFreeObj \
+ (tclStubsPtr->tclFreeObj) /* 30 */
+#endif
+#ifndef Tcl_GetBoolean
+#define Tcl_GetBoolean \
+ (tclStubsPtr->tcl_GetBoolean) /* 31 */
+#endif
+#ifndef Tcl_GetBooleanFromObj
+#define Tcl_GetBooleanFromObj \
+ (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
+#endif
+#ifndef Tcl_GetByteArrayFromObj
+#define Tcl_GetByteArrayFromObj \
+ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
+#endif
+#ifndef Tcl_GetDouble
+#define Tcl_GetDouble \
+ (tclStubsPtr->tcl_GetDouble) /* 34 */
+#endif
+#ifndef Tcl_GetDoubleFromObj
+#define Tcl_GetDoubleFromObj \
+ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */
+#endif
+#ifndef Tcl_GetIndexFromObj
+#define Tcl_GetIndexFromObj \
+ (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */
+#endif
+#ifndef Tcl_GetInt
+#define Tcl_GetInt \
+ (tclStubsPtr->tcl_GetInt) /* 37 */
+#endif
+#ifndef Tcl_GetIntFromObj
+#define Tcl_GetIntFromObj \
+ (tclStubsPtr->tcl_GetIntFromObj) /* 38 */
+#endif
+#ifndef Tcl_GetLongFromObj
+#define Tcl_GetLongFromObj \
+ (tclStubsPtr->tcl_GetLongFromObj) /* 39 */
+#endif
+#ifndef Tcl_GetObjType
+#define Tcl_GetObjType \
+ (tclStubsPtr->tcl_GetObjType) /* 40 */
+#endif
+#ifndef Tcl_GetStringFromObj
+#define Tcl_GetStringFromObj \
+ (tclStubsPtr->tcl_GetStringFromObj) /* 41 */
+#endif
+#ifndef Tcl_InvalidateStringRep
+#define Tcl_InvalidateStringRep \
+ (tclStubsPtr->tcl_InvalidateStringRep) /* 42 */
+#endif
+#ifndef Tcl_ListObjAppendList
+#define Tcl_ListObjAppendList \
+ (tclStubsPtr->tcl_ListObjAppendList) /* 43 */
+#endif
+#ifndef Tcl_ListObjAppendElement
+#define Tcl_ListObjAppendElement \
+ (tclStubsPtr->tcl_ListObjAppendElement) /* 44 */
+#endif
+#ifndef Tcl_ListObjGetElements
+#define Tcl_ListObjGetElements \
+ (tclStubsPtr->tcl_ListObjGetElements) /* 45 */
+#endif
+#ifndef Tcl_ListObjIndex
+#define Tcl_ListObjIndex \
+ (tclStubsPtr->tcl_ListObjIndex) /* 46 */
+#endif
+#ifndef Tcl_ListObjLength
+#define Tcl_ListObjLength \
+ (tclStubsPtr->tcl_ListObjLength) /* 47 */
+#endif
+#ifndef Tcl_ListObjReplace
+#define Tcl_ListObjReplace \
+ (tclStubsPtr->tcl_ListObjReplace) /* 48 */
+#endif
+#ifndef Tcl_NewBooleanObj
+#define Tcl_NewBooleanObj \
+ (tclStubsPtr->tcl_NewBooleanObj) /* 49 */
+#endif
+#ifndef Tcl_NewByteArrayObj
+#define Tcl_NewByteArrayObj \
+ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
+#endif
+#ifndef Tcl_NewDoubleObj
+#define Tcl_NewDoubleObj \
+ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */
+#endif
+#ifndef Tcl_NewIntObj
+#define Tcl_NewIntObj \
+ (tclStubsPtr->tcl_NewIntObj) /* 52 */
+#endif
+#ifndef Tcl_NewListObj
+#define Tcl_NewListObj \
+ (tclStubsPtr->tcl_NewListObj) /* 53 */
+#endif
+#ifndef Tcl_NewLongObj
+#define Tcl_NewLongObj \
+ (tclStubsPtr->tcl_NewLongObj) /* 54 */
+#endif
+#ifndef Tcl_NewObj
+#define Tcl_NewObj \
+ (tclStubsPtr->tcl_NewObj) /* 55 */
+#endif
+#ifndef Tcl_NewStringObj
+#define Tcl_NewStringObj \
+ (tclStubsPtr->tcl_NewStringObj) /* 56 */
+#endif
+#ifndef Tcl_SetBooleanObj
+#define Tcl_SetBooleanObj \
+ (tclStubsPtr->tcl_SetBooleanObj) /* 57 */
+#endif
+#ifndef Tcl_SetByteArrayLength
+#define Tcl_SetByteArrayLength \
+ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
+#endif
+#ifndef Tcl_SetByteArrayObj
+#define Tcl_SetByteArrayObj \
+ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
+#endif
+#ifndef Tcl_SetDoubleObj
+#define Tcl_SetDoubleObj \
+ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */
+#endif
+#ifndef Tcl_SetIntObj
+#define Tcl_SetIntObj \
+ (tclStubsPtr->tcl_SetIntObj) /* 61 */
+#endif
+#ifndef Tcl_SetListObj
+#define Tcl_SetListObj \
+ (tclStubsPtr->tcl_SetListObj) /* 62 */
+#endif
+#ifndef Tcl_SetLongObj
+#define Tcl_SetLongObj \
+ (tclStubsPtr->tcl_SetLongObj) /* 63 */
+#endif
+#ifndef Tcl_SetObjLength
+#define Tcl_SetObjLength \
+ (tclStubsPtr->tcl_SetObjLength) /* 64 */
+#endif
+#ifndef Tcl_SetStringObj
+#define Tcl_SetStringObj \
+ (tclStubsPtr->tcl_SetStringObj) /* 65 */
+#endif
+#ifndef Tcl_AddErrorInfo
+#define Tcl_AddErrorInfo \
+ (tclStubsPtr->tcl_AddErrorInfo) /* 66 */
+#endif
+#ifndef Tcl_AddObjErrorInfo
+#define Tcl_AddObjErrorInfo \
+ (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */
+#endif
+#ifndef Tcl_AllowExceptions
+#define Tcl_AllowExceptions \
+ (tclStubsPtr->tcl_AllowExceptions) /* 68 */
+#endif
+#ifndef Tcl_AppendElement
+#define Tcl_AppendElement \
+ (tclStubsPtr->tcl_AppendElement) /* 69 */
+#endif
+#ifndef Tcl_AppendResult
+#define Tcl_AppendResult \
+ (tclStubsPtr->tcl_AppendResult) /* 70 */
+#endif
+#ifndef Tcl_AsyncCreate
+#define Tcl_AsyncCreate \
+ (tclStubsPtr->tcl_AsyncCreate) /* 71 */
+#endif
+#ifndef Tcl_AsyncDelete
+#define Tcl_AsyncDelete \
+ (tclStubsPtr->tcl_AsyncDelete) /* 72 */
+#endif
+#ifndef Tcl_AsyncInvoke
+#define Tcl_AsyncInvoke \
+ (tclStubsPtr->tcl_AsyncInvoke) /* 73 */
+#endif
+#ifndef Tcl_AsyncMark
+#define Tcl_AsyncMark \
+ (tclStubsPtr->tcl_AsyncMark) /* 74 */
+#endif
+#ifndef Tcl_AsyncReady
+#define Tcl_AsyncReady \
+ (tclStubsPtr->tcl_AsyncReady) /* 75 */
+#endif
+#ifndef Tcl_BackgroundError
+#define Tcl_BackgroundError \
+ (tclStubsPtr->tcl_BackgroundError) /* 76 */
+#endif
+#ifndef Tcl_Backslash
+#define Tcl_Backslash \
+ (tclStubsPtr->tcl_Backslash) /* 77 */
+#endif
+#ifndef Tcl_BadChannelOption
+#define Tcl_BadChannelOption \
+ (tclStubsPtr->tcl_BadChannelOption) /* 78 */
+#endif
+#ifndef Tcl_CallWhenDeleted
+#define Tcl_CallWhenDeleted \
+ (tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
+#endif
+#ifndef Tcl_CancelIdleCall
+#define Tcl_CancelIdleCall \
+ (tclStubsPtr->tcl_CancelIdleCall) /* 80 */
+#endif
+#ifndef Tcl_Close
+#define Tcl_Close \
+ (tclStubsPtr->tcl_Close) /* 81 */
+#endif
+#ifndef Tcl_CommandComplete
+#define Tcl_CommandComplete \
+ (tclStubsPtr->tcl_CommandComplete) /* 82 */
+#endif
+#ifndef Tcl_Concat
+#define Tcl_Concat \
+ (tclStubsPtr->tcl_Concat) /* 83 */
+#endif
+#ifndef Tcl_ConvertElement
+#define Tcl_ConvertElement \
+ (tclStubsPtr->tcl_ConvertElement) /* 84 */
+#endif
+#ifndef Tcl_ConvertCountedElement
+#define Tcl_ConvertCountedElement \
+ (tclStubsPtr->tcl_ConvertCountedElement) /* 85 */
+#endif
+#ifndef Tcl_CreateAlias
+#define Tcl_CreateAlias \
+ (tclStubsPtr->tcl_CreateAlias) /* 86 */
+#endif
+#ifndef Tcl_CreateAliasObj
+#define Tcl_CreateAliasObj \
+ (tclStubsPtr->tcl_CreateAliasObj) /* 87 */
+#endif
+#ifndef Tcl_CreateChannel
+#define Tcl_CreateChannel \
+ (tclStubsPtr->tcl_CreateChannel) /* 88 */
+#endif
+#ifndef Tcl_CreateChannelHandler
+#define Tcl_CreateChannelHandler \
+ (tclStubsPtr->tcl_CreateChannelHandler) /* 89 */
+#endif
+#ifndef Tcl_CreateCloseHandler
+#define Tcl_CreateCloseHandler \
+ (tclStubsPtr->tcl_CreateCloseHandler) /* 90 */
+#endif
+#ifndef Tcl_CreateCommand
+#define Tcl_CreateCommand \
+ (tclStubsPtr->tcl_CreateCommand) /* 91 */
+#endif
+#ifndef Tcl_CreateEventSource
+#define Tcl_CreateEventSource \
+ (tclStubsPtr->tcl_CreateEventSource) /* 92 */
+#endif
+#ifndef Tcl_CreateExitHandler
+#define Tcl_CreateExitHandler \
+ (tclStubsPtr->tcl_CreateExitHandler) /* 93 */
+#endif
+#ifndef Tcl_CreateInterp
+#define Tcl_CreateInterp \
+ (tclStubsPtr->tcl_CreateInterp) /* 94 */
+#endif
+#ifndef Tcl_CreateMathFunc
+#define Tcl_CreateMathFunc \
+ (tclStubsPtr->tcl_CreateMathFunc) /* 95 */
+#endif
+#ifndef Tcl_CreateObjCommand
+#define Tcl_CreateObjCommand \
+ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */
+#endif
+#ifndef Tcl_CreateSlave
+#define Tcl_CreateSlave \
+ (tclStubsPtr->tcl_CreateSlave) /* 97 */
+#endif
+#ifndef Tcl_CreateTimerHandler
+#define Tcl_CreateTimerHandler \
+ (tclStubsPtr->tcl_CreateTimerHandler) /* 98 */
+#endif
+#ifndef Tcl_CreateTrace
+#define Tcl_CreateTrace \
+ (tclStubsPtr->tcl_CreateTrace) /* 99 */
+#endif
+#ifndef Tcl_DeleteAssocData
+#define Tcl_DeleteAssocData \
+ (tclStubsPtr->tcl_DeleteAssocData) /* 100 */
+#endif
+#ifndef Tcl_DeleteChannelHandler
+#define Tcl_DeleteChannelHandler \
+ (tclStubsPtr->tcl_DeleteChannelHandler) /* 101 */
+#endif
+#ifndef Tcl_DeleteCloseHandler
+#define Tcl_DeleteCloseHandler \
+ (tclStubsPtr->tcl_DeleteCloseHandler) /* 102 */
+#endif
+#ifndef Tcl_DeleteCommand
+#define Tcl_DeleteCommand \
+ (tclStubsPtr->tcl_DeleteCommand) /* 103 */
+#endif
+#ifndef Tcl_DeleteCommandFromToken
+#define Tcl_DeleteCommandFromToken \
+ (tclStubsPtr->tcl_DeleteCommandFromToken) /* 104 */
+#endif
+#ifndef Tcl_DeleteEvents
+#define Tcl_DeleteEvents \
+ (tclStubsPtr->tcl_DeleteEvents) /* 105 */
+#endif
+#ifndef Tcl_DeleteEventSource
+#define Tcl_DeleteEventSource \
+ (tclStubsPtr->tcl_DeleteEventSource) /* 106 */
+#endif
+#ifndef Tcl_DeleteExitHandler
+#define Tcl_DeleteExitHandler \
+ (tclStubsPtr->tcl_DeleteExitHandler) /* 107 */
+#endif
+#ifndef Tcl_DeleteHashEntry
+#define Tcl_DeleteHashEntry \
+ (tclStubsPtr->tcl_DeleteHashEntry) /* 108 */
+#endif
+#ifndef Tcl_DeleteHashTable
+#define Tcl_DeleteHashTable \
+ (tclStubsPtr->tcl_DeleteHashTable) /* 109 */
+#endif
+#ifndef Tcl_DeleteInterp
+#define Tcl_DeleteInterp \
+ (tclStubsPtr->tcl_DeleteInterp) /* 110 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_DetachPids
+#define Tcl_DetachPids \
+ (tclStubsPtr->tcl_DetachPids) /* 111 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef Tcl_DetachPids
+#define Tcl_DetachPids \
+ (tclStubsPtr->tcl_DetachPids) /* 111 */
+#endif
+#endif /* __WIN32__ */
+#ifndef Tcl_DeleteTimerHandler
+#define Tcl_DeleteTimerHandler \
+ (tclStubsPtr->tcl_DeleteTimerHandler) /* 112 */
+#endif
+#ifndef Tcl_DeleteTrace
+#define Tcl_DeleteTrace \
+ (tclStubsPtr->tcl_DeleteTrace) /* 113 */
+#endif
+#ifndef Tcl_DontCallWhenDeleted
+#define Tcl_DontCallWhenDeleted \
+ (tclStubsPtr->tcl_DontCallWhenDeleted) /* 114 */
+#endif
+#ifndef Tcl_DoOneEvent
+#define Tcl_DoOneEvent \
+ (tclStubsPtr->tcl_DoOneEvent) /* 115 */
+#endif
+#ifndef Tcl_DoWhenIdle
+#define Tcl_DoWhenIdle \
+ (tclStubsPtr->tcl_DoWhenIdle) /* 116 */
+#endif
+#ifndef Tcl_DStringAppend
+#define Tcl_DStringAppend \
+ (tclStubsPtr->tcl_DStringAppend) /* 117 */
+#endif
+#ifndef Tcl_DStringAppendElement
+#define Tcl_DStringAppendElement \
+ (tclStubsPtr->tcl_DStringAppendElement) /* 118 */
+#endif
+#ifndef Tcl_DStringEndSublist
+#define Tcl_DStringEndSublist \
+ (tclStubsPtr->tcl_DStringEndSublist) /* 119 */
+#endif
+#ifndef Tcl_DStringFree
+#define Tcl_DStringFree \
+ (tclStubsPtr->tcl_DStringFree) /* 120 */
+#endif
+#ifndef Tcl_DStringGetResult
+#define Tcl_DStringGetResult \
+ (tclStubsPtr->tcl_DStringGetResult) /* 121 */
+#endif
+#ifndef Tcl_DStringInit
+#define Tcl_DStringInit \
+ (tclStubsPtr->tcl_DStringInit) /* 122 */
+#endif
+#ifndef Tcl_DStringResult
+#define Tcl_DStringResult \
+ (tclStubsPtr->tcl_DStringResult) /* 123 */
+#endif
+#ifndef Tcl_DStringSetLength
+#define Tcl_DStringSetLength \
+ (tclStubsPtr->tcl_DStringSetLength) /* 124 */
+#endif
+#ifndef Tcl_DStringStartSublist
+#define Tcl_DStringStartSublist \
+ (tclStubsPtr->tcl_DStringStartSublist) /* 125 */
+#endif
+#ifndef Tcl_Eof
+#define Tcl_Eof \
+ (tclStubsPtr->tcl_Eof) /* 126 */
+#endif
+#ifndef Tcl_ErrnoId
+#define Tcl_ErrnoId \
+ (tclStubsPtr->tcl_ErrnoId) /* 127 */
+#endif
+#ifndef Tcl_ErrnoMsg
+#define Tcl_ErrnoMsg \
+ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */
+#endif
+#ifndef Tcl_Eval
+#define Tcl_Eval \
+ (tclStubsPtr->tcl_Eval) /* 129 */
+#endif
+#ifndef Tcl_EvalFile
+#define Tcl_EvalFile \
+ (tclStubsPtr->tcl_EvalFile) /* 130 */
+#endif
+#ifndef Tcl_EvalObj
+#define Tcl_EvalObj \
+ (tclStubsPtr->tcl_EvalObj) /* 131 */
+#endif
+#ifndef Tcl_EventuallyFree
+#define Tcl_EventuallyFree \
+ (tclStubsPtr->tcl_EventuallyFree) /* 132 */
+#endif
+#ifndef Tcl_Exit
+#define Tcl_Exit \
+ (tclStubsPtr->tcl_Exit) /* 133 */
+#endif
+#ifndef Tcl_ExposeCommand
+#define Tcl_ExposeCommand \
+ (tclStubsPtr->tcl_ExposeCommand) /* 134 */
+#endif
+#ifndef Tcl_ExprBoolean
+#define Tcl_ExprBoolean \
+ (tclStubsPtr->tcl_ExprBoolean) /* 135 */
+#endif
+#ifndef Tcl_ExprBooleanObj
+#define Tcl_ExprBooleanObj \
+ (tclStubsPtr->tcl_ExprBooleanObj) /* 136 */
+#endif
+#ifndef Tcl_ExprDouble
+#define Tcl_ExprDouble \
+ (tclStubsPtr->tcl_ExprDouble) /* 137 */
+#endif
+#ifndef Tcl_ExprDoubleObj
+#define Tcl_ExprDoubleObj \
+ (tclStubsPtr->tcl_ExprDoubleObj) /* 138 */
+#endif
+#ifndef Tcl_ExprLong
+#define Tcl_ExprLong \
+ (tclStubsPtr->tcl_ExprLong) /* 139 */
+#endif
+#ifndef Tcl_ExprLongObj
+#define Tcl_ExprLongObj \
+ (tclStubsPtr->tcl_ExprLongObj) /* 140 */
+#endif
+#ifndef Tcl_ExprObj
+#define Tcl_ExprObj \
+ (tclStubsPtr->tcl_ExprObj) /* 141 */
+#endif
+#ifndef Tcl_ExprString
+#define Tcl_ExprString \
+ (tclStubsPtr->tcl_ExprString) /* 142 */
+#endif
+#ifndef Tcl_Finalize
+#define Tcl_Finalize \
+ (tclStubsPtr->tcl_Finalize) /* 143 */
+#endif
+#ifndef Tcl_FindExecutable
+#define Tcl_FindExecutable \
+ (tclStubsPtr->tcl_FindExecutable) /* 144 */
+#endif
+#ifndef Tcl_FirstHashEntry
+#define Tcl_FirstHashEntry \
+ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */
+#endif
+#ifndef Tcl_Flush
+#define Tcl_Flush \
+ (tclStubsPtr->tcl_Flush) /* 146 */
+#endif
+#ifndef Tcl_FreeResult
+#define Tcl_FreeResult \
+ (tclStubsPtr->tcl_FreeResult) /* 147 */
+#endif
+#ifndef Tcl_GetAlias
+#define Tcl_GetAlias \
+ (tclStubsPtr->tcl_GetAlias) /* 148 */
+#endif
+#ifndef Tcl_GetAliasObj
+#define Tcl_GetAliasObj \
+ (tclStubsPtr->tcl_GetAliasObj) /* 149 */
+#endif
+#ifndef Tcl_GetAssocData
+#define Tcl_GetAssocData \
+ (tclStubsPtr->tcl_GetAssocData) /* 150 */
+#endif
+#ifndef Tcl_GetChannel
+#define Tcl_GetChannel \
+ (tclStubsPtr->tcl_GetChannel) /* 151 */
+#endif
+#ifndef Tcl_GetChannelBufferSize
+#define Tcl_GetChannelBufferSize \
+ (tclStubsPtr->tcl_GetChannelBufferSize) /* 152 */
+#endif
+#ifndef Tcl_GetChannelHandle
+#define Tcl_GetChannelHandle \
+ (tclStubsPtr->tcl_GetChannelHandle) /* 153 */
+#endif
+#ifndef Tcl_GetChannelInstanceData
+#define Tcl_GetChannelInstanceData \
+ (tclStubsPtr->tcl_GetChannelInstanceData) /* 154 */
+#endif
+#ifndef Tcl_GetChannelMode
+#define Tcl_GetChannelMode \
+ (tclStubsPtr->tcl_GetChannelMode) /* 155 */
+#endif
+#ifndef Tcl_GetChannelName
+#define Tcl_GetChannelName \
+ (tclStubsPtr->tcl_GetChannelName) /* 156 */
+#endif
+#ifndef Tcl_GetChannelOption
+#define Tcl_GetChannelOption \
+ (tclStubsPtr->tcl_GetChannelOption) /* 157 */
+#endif
+#ifndef Tcl_GetChannelType
+#define Tcl_GetChannelType \
+ (tclStubsPtr->tcl_GetChannelType) /* 158 */
+#endif
+#ifndef Tcl_GetCommandInfo
+#define Tcl_GetCommandInfo \
+ (tclStubsPtr->tcl_GetCommandInfo) /* 159 */
+#endif
+#ifndef Tcl_GetCommandName
+#define Tcl_GetCommandName \
+ (tclStubsPtr->tcl_GetCommandName) /* 160 */
+#endif
+#ifndef Tcl_GetErrno
+#define Tcl_GetErrno \
+ (tclStubsPtr->tcl_GetErrno) /* 161 */
+#endif
+#ifndef Tcl_GetHostName
+#define Tcl_GetHostName \
+ (tclStubsPtr->tcl_GetHostName) /* 162 */
+#endif
+#ifndef Tcl_GetInterpPath
+#define Tcl_GetInterpPath \
+ (tclStubsPtr->tcl_GetInterpPath) /* 163 */
+#endif
+#ifndef Tcl_GetMaster
+#define Tcl_GetMaster \
+ (tclStubsPtr->tcl_GetMaster) /* 164 */
+#endif
+#ifndef Tcl_GetNameOfExecutable
+#define Tcl_GetNameOfExecutable \
+ (tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
+#endif
+#ifndef Tcl_GetObjResult
+#define Tcl_GetObjResult \
+ (tclStubsPtr->tcl_GetObjResult) /* 166 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_GetOpenFile
+#define Tcl_GetOpenFile \
+ (tclStubsPtr->tcl_GetOpenFile) /* 167 */
+#endif
+#endif /* UNIX */
+#ifndef Tcl_GetPathType
+#define Tcl_GetPathType \
+ (tclStubsPtr->tcl_GetPathType) /* 168 */
+#endif
+#ifndef Tcl_Gets
+#define Tcl_Gets \
+ (tclStubsPtr->tcl_Gets) /* 169 */
+#endif
+#ifndef Tcl_GetsObj
+#define Tcl_GetsObj \
+ (tclStubsPtr->tcl_GetsObj) /* 170 */
+#endif
+#ifndef Tcl_GetServiceMode
+#define Tcl_GetServiceMode \
+ (tclStubsPtr->tcl_GetServiceMode) /* 171 */
+#endif
+#ifndef Tcl_GetSlave
+#define Tcl_GetSlave \
+ (tclStubsPtr->tcl_GetSlave) /* 172 */
+#endif
+#ifndef Tcl_GetStdChannel
+#define Tcl_GetStdChannel \
+ (tclStubsPtr->tcl_GetStdChannel) /* 173 */
+#endif
+#ifndef Tcl_GetStringResult
+#define Tcl_GetStringResult \
+ (tclStubsPtr->tcl_GetStringResult) /* 174 */
+#endif
+#ifndef Tcl_GetVar
+#define Tcl_GetVar \
+ (tclStubsPtr->tcl_GetVar) /* 175 */
+#endif
+#ifndef Tcl_GetVar2
+#define Tcl_GetVar2 \
+ (tclStubsPtr->tcl_GetVar2) /* 176 */
+#endif
+#ifndef Tcl_GlobalEval
+#define Tcl_GlobalEval \
+ (tclStubsPtr->tcl_GlobalEval) /* 177 */
+#endif
+#ifndef Tcl_GlobalEvalObj
+#define Tcl_GlobalEvalObj \
+ (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
+#endif
+#ifndef Tcl_HideCommand
+#define Tcl_HideCommand \
+ (tclStubsPtr->tcl_HideCommand) /* 179 */
+#endif
+#ifndef Tcl_Init
+#define Tcl_Init \
+ (tclStubsPtr->tcl_Init) /* 180 */
+#endif
+#ifndef Tcl_InitHashTable
+#define Tcl_InitHashTable \
+ (tclStubsPtr->tcl_InitHashTable) /* 181 */
+#endif
+#ifndef Tcl_InputBlocked
+#define Tcl_InputBlocked \
+ (tclStubsPtr->tcl_InputBlocked) /* 182 */
+#endif
+#ifndef Tcl_InputBuffered
+#define Tcl_InputBuffered \
+ (tclStubsPtr->tcl_InputBuffered) /* 183 */
+#endif
+#ifndef Tcl_InterpDeleted
+#define Tcl_InterpDeleted \
+ (tclStubsPtr->tcl_InterpDeleted) /* 184 */
+#endif
+#ifndef Tcl_IsSafe
+#define Tcl_IsSafe \
+ (tclStubsPtr->tcl_IsSafe) /* 185 */
+#endif
+#ifndef Tcl_JoinPath
+#define Tcl_JoinPath \
+ (tclStubsPtr->tcl_JoinPath) /* 186 */
+#endif
+#ifndef Tcl_LinkVar
+#define Tcl_LinkVar \
+ (tclStubsPtr->tcl_LinkVar) /* 187 */
+#endif
+/* Slot 188 is reserved */
+#ifndef Tcl_MakeFileChannel
+#define Tcl_MakeFileChannel \
+ (tclStubsPtr->tcl_MakeFileChannel) /* 189 */
+#endif
+#ifndef Tcl_MakeSafe
+#define Tcl_MakeSafe \
+ (tclStubsPtr->tcl_MakeSafe) /* 190 */
+#endif
+#ifndef Tcl_MakeTcpClientChannel
+#define Tcl_MakeTcpClientChannel \
+ (tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */
+#endif
+#ifndef Tcl_Merge
+#define Tcl_Merge \
+ (tclStubsPtr->tcl_Merge) /* 192 */
+#endif
+#ifndef Tcl_NextHashEntry
+#define Tcl_NextHashEntry \
+ (tclStubsPtr->tcl_NextHashEntry) /* 193 */
+#endif
+#ifndef Tcl_NotifyChannel
+#define Tcl_NotifyChannel \
+ (tclStubsPtr->tcl_NotifyChannel) /* 194 */
+#endif
+#ifndef Tcl_ObjGetVar2
+#define Tcl_ObjGetVar2 \
+ (tclStubsPtr->tcl_ObjGetVar2) /* 195 */
+#endif
+#ifndef Tcl_ObjSetVar2
+#define Tcl_ObjSetVar2 \
+ (tclStubsPtr->tcl_ObjSetVar2) /* 196 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_OpenCommandChannel
+#define Tcl_OpenCommandChannel \
+ (tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef Tcl_OpenCommandChannel
+#define Tcl_OpenCommandChannel \
+ (tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
+#endif
+#endif /* __WIN32__ */
+#ifndef Tcl_OpenFileChannel
+#define Tcl_OpenFileChannel \
+ (tclStubsPtr->tcl_OpenFileChannel) /* 198 */
+#endif
+#ifndef Tcl_OpenTcpClient
+#define Tcl_OpenTcpClient \
+ (tclStubsPtr->tcl_OpenTcpClient) /* 199 */
+#endif
+#ifndef Tcl_OpenTcpServer
+#define Tcl_OpenTcpServer \
+ (tclStubsPtr->tcl_OpenTcpServer) /* 200 */
+#endif
+#ifndef Tcl_Preserve
+#define Tcl_Preserve \
+ (tclStubsPtr->tcl_Preserve) /* 201 */
+#endif
+#ifndef Tcl_PrintDouble
+#define Tcl_PrintDouble \
+ (tclStubsPtr->tcl_PrintDouble) /* 202 */
+#endif
+#ifndef Tcl_PutEnv
+#define Tcl_PutEnv \
+ (tclStubsPtr->tcl_PutEnv) /* 203 */
+#endif
+#ifndef Tcl_PosixError
+#define Tcl_PosixError \
+ (tclStubsPtr->tcl_PosixError) /* 204 */
+#endif
+#ifndef Tcl_QueueEvent
+#define Tcl_QueueEvent \
+ (tclStubsPtr->tcl_QueueEvent) /* 205 */
+#endif
+#ifndef Tcl_Read
+#define Tcl_Read \
+ (tclStubsPtr->tcl_Read) /* 206 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_ReapDetachedProcs
+#define Tcl_ReapDetachedProcs \
+ (tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef Tcl_ReapDetachedProcs
+#define Tcl_ReapDetachedProcs \
+ (tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
+#endif
+#endif /* __WIN32__ */
+#ifndef Tcl_RecordAndEval
+#define Tcl_RecordAndEval \
+ (tclStubsPtr->tcl_RecordAndEval) /* 208 */
+#endif
+#ifndef Tcl_RecordAndEvalObj
+#define Tcl_RecordAndEvalObj \
+ (tclStubsPtr->tcl_RecordAndEvalObj) /* 209 */
+#endif
+#ifndef Tcl_RegisterChannel
+#define Tcl_RegisterChannel \
+ (tclStubsPtr->tcl_RegisterChannel) /* 210 */
+#endif
+#ifndef Tcl_RegisterObjType
+#define Tcl_RegisterObjType \
+ (tclStubsPtr->tcl_RegisterObjType) /* 211 */
+#endif
+#ifndef Tcl_RegExpCompile
+#define Tcl_RegExpCompile \
+ (tclStubsPtr->tcl_RegExpCompile) /* 212 */
+#endif
+#ifndef Tcl_RegExpExec
+#define Tcl_RegExpExec \
+ (tclStubsPtr->tcl_RegExpExec) /* 213 */
+#endif
+#ifndef Tcl_RegExpMatch
+#define Tcl_RegExpMatch \
+ (tclStubsPtr->tcl_RegExpMatch) /* 214 */
+#endif
+#ifndef Tcl_RegExpRange
+#define Tcl_RegExpRange \
+ (tclStubsPtr->tcl_RegExpRange) /* 215 */
+#endif
+#ifndef Tcl_Release
+#define Tcl_Release \
+ (tclStubsPtr->tcl_Release) /* 216 */
+#endif
+#ifndef Tcl_ResetResult
+#define Tcl_ResetResult \
+ (tclStubsPtr->tcl_ResetResult) /* 217 */
+#endif
+#ifndef Tcl_ScanElement
+#define Tcl_ScanElement \
+ (tclStubsPtr->tcl_ScanElement) /* 218 */
+#endif
+#ifndef Tcl_ScanCountedElement
+#define Tcl_ScanCountedElement \
+ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */
+#endif
+#ifndef Tcl_Seek
+#define Tcl_Seek \
+ (tclStubsPtr->tcl_Seek) /* 220 */
+#endif
+#ifndef Tcl_ServiceAll
+#define Tcl_ServiceAll \
+ (tclStubsPtr->tcl_ServiceAll) /* 221 */
+#endif
+#ifndef Tcl_ServiceEvent
+#define Tcl_ServiceEvent \
+ (tclStubsPtr->tcl_ServiceEvent) /* 222 */
+#endif
+#ifndef Tcl_SetAssocData
+#define Tcl_SetAssocData \
+ (tclStubsPtr->tcl_SetAssocData) /* 223 */
+#endif
+#ifndef Tcl_SetChannelBufferSize
+#define Tcl_SetChannelBufferSize \
+ (tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */
+#endif
+#ifndef Tcl_SetChannelOption
+#define Tcl_SetChannelOption \
+ (tclStubsPtr->tcl_SetChannelOption) /* 225 */
+#endif
+#ifndef Tcl_SetCommandInfo
+#define Tcl_SetCommandInfo \
+ (tclStubsPtr->tcl_SetCommandInfo) /* 226 */
+#endif
+#ifndef Tcl_SetErrno
+#define Tcl_SetErrno \
+ (tclStubsPtr->tcl_SetErrno) /* 227 */
+#endif
+#ifndef Tcl_SetErrorCode
+#define Tcl_SetErrorCode \
+ (tclStubsPtr->tcl_SetErrorCode) /* 228 */
+#endif
+#ifndef Tcl_SetMaxBlockTime
+#define Tcl_SetMaxBlockTime \
+ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */
+#endif
+#ifndef Tcl_SetPanicProc
+#define Tcl_SetPanicProc \
+ (tclStubsPtr->tcl_SetPanicProc) /* 230 */
+#endif
+#ifndef Tcl_SetRecursionLimit
+#define Tcl_SetRecursionLimit \
+ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */
+#endif
+#ifndef Tcl_SetResult
+#define Tcl_SetResult \
+ (tclStubsPtr->tcl_SetResult) /* 232 */
+#endif
+#ifndef Tcl_SetServiceMode
+#define Tcl_SetServiceMode \
+ (tclStubsPtr->tcl_SetServiceMode) /* 233 */
+#endif
+#ifndef Tcl_SetObjErrorCode
+#define Tcl_SetObjErrorCode \
+ (tclStubsPtr->tcl_SetObjErrorCode) /* 234 */
+#endif
+#ifndef Tcl_SetObjResult
+#define Tcl_SetObjResult \
+ (tclStubsPtr->tcl_SetObjResult) /* 235 */
+#endif
+#ifndef Tcl_SetStdChannel
+#define Tcl_SetStdChannel \
+ (tclStubsPtr->tcl_SetStdChannel) /* 236 */
+#endif
+#ifndef Tcl_SetVar
+#define Tcl_SetVar \
+ (tclStubsPtr->tcl_SetVar) /* 237 */
+#endif
+#ifndef Tcl_SetVar2
+#define Tcl_SetVar2 \
+ (tclStubsPtr->tcl_SetVar2) /* 238 */
+#endif
+#ifndef Tcl_SignalId
+#define Tcl_SignalId \
+ (tclStubsPtr->tcl_SignalId) /* 239 */
+#endif
+#ifndef Tcl_SignalMsg
+#define Tcl_SignalMsg \
+ (tclStubsPtr->tcl_SignalMsg) /* 240 */
+#endif
+#ifndef Tcl_SourceRCFile
+#define Tcl_SourceRCFile \
+ (tclStubsPtr->tcl_SourceRCFile) /* 241 */
+#endif
+#ifndef Tcl_SplitList
+#define Tcl_SplitList \
+ (tclStubsPtr->tcl_SplitList) /* 242 */
+#endif
+#ifndef Tcl_SplitPath
+#define Tcl_SplitPath \
+ (tclStubsPtr->tcl_SplitPath) /* 243 */
+#endif
+#ifndef Tcl_StaticPackage
+#define Tcl_StaticPackage \
+ (tclStubsPtr->tcl_StaticPackage) /* 244 */
+#endif
+#ifndef Tcl_StringMatch
+#define Tcl_StringMatch \
+ (tclStubsPtr->tcl_StringMatch) /* 245 */
+#endif
+#ifndef Tcl_Tell
+#define Tcl_Tell \
+ (tclStubsPtr->tcl_Tell) /* 246 */
+#endif
+#ifndef Tcl_TraceVar
+#define Tcl_TraceVar \
+ (tclStubsPtr->tcl_TraceVar) /* 247 */
+#endif
+#ifndef Tcl_TraceVar2
+#define Tcl_TraceVar2 \
+ (tclStubsPtr->tcl_TraceVar2) /* 248 */
+#endif
+#ifndef Tcl_TranslateFileName
+#define Tcl_TranslateFileName \
+ (tclStubsPtr->tcl_TranslateFileName) /* 249 */
+#endif
+#ifndef Tcl_Ungets
+#define Tcl_Ungets \
+ (tclStubsPtr->tcl_Ungets) /* 250 */
+#endif
+#ifndef Tcl_UnlinkVar
+#define Tcl_UnlinkVar \
+ (tclStubsPtr->tcl_UnlinkVar) /* 251 */
+#endif
+#ifndef Tcl_UnregisterChannel
+#define Tcl_UnregisterChannel \
+ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */
+#endif
+#ifndef Tcl_UnsetVar
+#define Tcl_UnsetVar \
+ (tclStubsPtr->tcl_UnsetVar) /* 253 */
+#endif
+#ifndef Tcl_UnsetVar2
+#define Tcl_UnsetVar2 \
+ (tclStubsPtr->tcl_UnsetVar2) /* 254 */
+#endif
+#ifndef Tcl_UntraceVar
+#define Tcl_UntraceVar \
+ (tclStubsPtr->tcl_UntraceVar) /* 255 */
+#endif
+#ifndef Tcl_UntraceVar2
+#define Tcl_UntraceVar2 \
+ (tclStubsPtr->tcl_UntraceVar2) /* 256 */
+#endif
+#ifndef Tcl_UpdateLinkedVar
+#define Tcl_UpdateLinkedVar \
+ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */
+#endif
+#ifndef Tcl_UpVar
+#define Tcl_UpVar \
+ (tclStubsPtr->tcl_UpVar) /* 258 */
+#endif
+#ifndef Tcl_UpVar2
+#define Tcl_UpVar2 \
+ (tclStubsPtr->tcl_UpVar2) /* 259 */
+#endif
+#ifndef Tcl_VarEval
+#define Tcl_VarEval \
+ (tclStubsPtr->tcl_VarEval) /* 260 */
+#endif
+#ifndef Tcl_VarTraceInfo
+#define Tcl_VarTraceInfo \
+ (tclStubsPtr->tcl_VarTraceInfo) /* 261 */
+#endif
+#ifndef Tcl_VarTraceInfo2
+#define Tcl_VarTraceInfo2 \
+ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
+#endif
+#ifndef Tcl_Write
+#define Tcl_Write \
+ (tclStubsPtr->tcl_Write) /* 263 */
+#endif
+#ifndef Tcl_WrongNumArgs
+#define Tcl_WrongNumArgs \
+ (tclStubsPtr->tcl_WrongNumArgs) /* 264 */
+#endif
+#ifndef Tcl_DumpActiveMemory
+#define Tcl_DumpActiveMemory \
+ (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
+#endif
+#ifndef Tcl_ValidateAllMemory
+#define Tcl_ValidateAllMemory \
+ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */
+#endif
+#ifndef Tcl_AppendResultVA
+#define Tcl_AppendResultVA \
+ (tclStubsPtr->tcl_AppendResultVA) /* 267 */
+#endif
+#ifndef Tcl_AppendStringsToObjVA
+#define Tcl_AppendStringsToObjVA \
+ (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */
+#endif
+#ifndef Tcl_HashStats
+#define Tcl_HashStats \
+ (tclStubsPtr->tcl_HashStats) /* 269 */
+#endif
+#ifndef Tcl_ParseVar
+#define Tcl_ParseVar \
+ (tclStubsPtr->tcl_ParseVar) /* 270 */
+#endif
+#ifndef Tcl_PkgPresent
+#define Tcl_PkgPresent \
+ (tclStubsPtr->tcl_PkgPresent) /* 271 */
+#endif
+#ifndef Tcl_PkgPresentEx
+#define Tcl_PkgPresentEx \
+ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */
+#endif
+#ifndef Tcl_PkgProvide
+#define Tcl_PkgProvide \
+ (tclStubsPtr->tcl_PkgProvide) /* 273 */
+#endif
+#ifndef Tcl_PkgRequire
+#define Tcl_PkgRequire \
+ (tclStubsPtr->tcl_PkgRequire) /* 274 */
+#endif
+#ifndef Tcl_SetErrorCodeVA
+#define Tcl_SetErrorCodeVA \
+ (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
+#endif
+#ifndef Tcl_VarEvalVA
+#define Tcl_VarEvalVA \
+ (tclStubsPtr->tcl_VarEvalVA) /* 276 */
+#endif
+#ifndef Tcl_WaitPid
+#define Tcl_WaitPid \
+ (tclStubsPtr->tcl_WaitPid) /* 277 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_PanicVA
+#define Tcl_PanicVA \
+ (tclStubsPtr->tcl_PanicVA) /* 278 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef Tcl_PanicVA
+#define Tcl_PanicVA \
+ (tclStubsPtr->tcl_PanicVA) /* 278 */
+#endif
+#endif /* __WIN32__ */
+#ifndef Tcl_GetVersion
+#define Tcl_GetVersion \
+ (tclStubsPtr->tcl_GetVersion) /* 279 */
+#endif
+#ifndef Tcl_InitMemory
+#define Tcl_InitMemory \
+ (tclStubsPtr->tcl_InitMemory) /* 280 */
+#endif
+#ifndef Tcl_StackChannel
+#define Tcl_StackChannel \
+ (tclStubsPtr->tcl_StackChannel) /* 281 */
+#endif
+#ifndef Tcl_UnstackChannel
+#define Tcl_UnstackChannel \
+ (tclStubsPtr->tcl_UnstackChannel) /* 282 */
+#endif
+#ifndef Tcl_GetStackedChannel
+#define Tcl_GetStackedChannel \
+ (tclStubsPtr->tcl_GetStackedChannel) /* 283 */
+#endif
+/* Slot 284 is reserved */
+/* Slot 285 is reserved */
+#ifndef Tcl_AppendObjToObj
+#define Tcl_AppendObjToObj \
+ (tclStubsPtr->tcl_AppendObjToObj) /* 286 */
+#endif
+#ifndef Tcl_CreateEncoding
+#define Tcl_CreateEncoding \
+ (tclStubsPtr->tcl_CreateEncoding) /* 287 */
+#endif
+#ifndef Tcl_CreateThreadExitHandler
+#define Tcl_CreateThreadExitHandler \
+ (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */
+#endif
+#ifndef Tcl_DeleteThreadExitHandler
+#define Tcl_DeleteThreadExitHandler \
+ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */
+#endif
+#ifndef Tcl_DiscardResult
+#define Tcl_DiscardResult \
+ (tclStubsPtr->tcl_DiscardResult) /* 290 */
+#endif
+#ifndef Tcl_EvalEx
+#define Tcl_EvalEx \
+ (tclStubsPtr->tcl_EvalEx) /* 291 */
+#endif
+#ifndef Tcl_EvalObjv
+#define Tcl_EvalObjv \
+ (tclStubsPtr->tcl_EvalObjv) /* 292 */
+#endif
+#ifndef Tcl_EvalObjEx
+#define Tcl_EvalObjEx \
+ (tclStubsPtr->tcl_EvalObjEx) /* 293 */
+#endif
+#ifndef Tcl_ExitThread
+#define Tcl_ExitThread \
+ (tclStubsPtr->tcl_ExitThread) /* 294 */
+#endif
+#ifndef Tcl_ExternalToUtf
+#define Tcl_ExternalToUtf \
+ (tclStubsPtr->tcl_ExternalToUtf) /* 295 */
+#endif
+#ifndef Tcl_ExternalToUtfDString
+#define Tcl_ExternalToUtfDString \
+ (tclStubsPtr->tcl_ExternalToUtfDString) /* 296 */
+#endif
+#ifndef Tcl_FinalizeThread
+#define Tcl_FinalizeThread \
+ (tclStubsPtr->tcl_FinalizeThread) /* 297 */
+#endif
+#ifndef Tcl_FinalizeNotifier
+#define Tcl_FinalizeNotifier \
+ (tclStubsPtr->tcl_FinalizeNotifier) /* 298 */
+#endif
+#ifndef Tcl_FreeEncoding
+#define Tcl_FreeEncoding \
+ (tclStubsPtr->tcl_FreeEncoding) /* 299 */
+#endif
+#ifndef Tcl_GetCurrentThread
+#define Tcl_GetCurrentThread \
+ (tclStubsPtr->tcl_GetCurrentThread) /* 300 */
+#endif
+#ifndef Tcl_GetEncoding
+#define Tcl_GetEncoding \
+ (tclStubsPtr->tcl_GetEncoding) /* 301 */
+#endif
+#ifndef Tcl_GetEncodingName
+#define Tcl_GetEncodingName \
+ (tclStubsPtr->tcl_GetEncodingName) /* 302 */
+#endif
+#ifndef Tcl_GetEncodingNames
+#define Tcl_GetEncodingNames \
+ (tclStubsPtr->tcl_GetEncodingNames) /* 303 */
+#endif
+#ifndef Tcl_GetIndexFromObjStruct
+#define Tcl_GetIndexFromObjStruct \
+ (tclStubsPtr->tcl_GetIndexFromObjStruct) /* 304 */
+#endif
+#ifndef Tcl_GetThreadData
+#define Tcl_GetThreadData \
+ (tclStubsPtr->tcl_GetThreadData) /* 305 */
+#endif
+#ifndef Tcl_GetVar2Ex
+#define Tcl_GetVar2Ex \
+ (tclStubsPtr->tcl_GetVar2Ex) /* 306 */
+#endif
+#ifndef Tcl_InitNotifier
+#define Tcl_InitNotifier \
+ (tclStubsPtr->tcl_InitNotifier) /* 307 */
+#endif
+#ifndef Tcl_MutexLock
+#define Tcl_MutexLock \
+ (tclStubsPtr->tcl_MutexLock) /* 308 */
+#endif
+#ifndef Tcl_MutexUnlock
+#define Tcl_MutexUnlock \
+ (tclStubsPtr->tcl_MutexUnlock) /* 309 */
+#endif
+#ifndef Tcl_ConditionNotify
+#define Tcl_ConditionNotify \
+ (tclStubsPtr->tcl_ConditionNotify) /* 310 */
+#endif
+#ifndef Tcl_ConditionWait
+#define Tcl_ConditionWait \
+ (tclStubsPtr->tcl_ConditionWait) /* 311 */
+#endif
+#ifndef Tcl_NumUtfChars
+#define Tcl_NumUtfChars \
+ (tclStubsPtr->tcl_NumUtfChars) /* 312 */
+#endif
+#ifndef Tcl_ReadChars
+#define Tcl_ReadChars \
+ (tclStubsPtr->tcl_ReadChars) /* 313 */
+#endif
+#ifndef Tcl_RestoreResult
+#define Tcl_RestoreResult \
+ (tclStubsPtr->tcl_RestoreResult) /* 314 */
+#endif
+#ifndef Tcl_SaveResult
+#define Tcl_SaveResult \
+ (tclStubsPtr->tcl_SaveResult) /* 315 */
+#endif
+#ifndef Tcl_SetSystemEncoding
+#define Tcl_SetSystemEncoding \
+ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */
+#endif
+#ifndef Tcl_SetVar2Ex
+#define Tcl_SetVar2Ex \
+ (tclStubsPtr->tcl_SetVar2Ex) /* 317 */
+#endif
+#ifndef Tcl_ThreadAlert
+#define Tcl_ThreadAlert \
+ (tclStubsPtr->tcl_ThreadAlert) /* 318 */
+#endif
+#ifndef Tcl_ThreadQueueEvent
+#define Tcl_ThreadQueueEvent \
+ (tclStubsPtr->tcl_ThreadQueueEvent) /* 319 */
+#endif
+#ifndef Tcl_UniCharAtIndex
+#define Tcl_UniCharAtIndex \
+ (tclStubsPtr->tcl_UniCharAtIndex) /* 320 */
+#endif
+#ifndef Tcl_UniCharToLower
+#define Tcl_UniCharToLower \
+ (tclStubsPtr->tcl_UniCharToLower) /* 321 */
+#endif
+#ifndef Tcl_UniCharToTitle
+#define Tcl_UniCharToTitle \
+ (tclStubsPtr->tcl_UniCharToTitle) /* 322 */
+#endif
+#ifndef Tcl_UniCharToUpper
+#define Tcl_UniCharToUpper \
+ (tclStubsPtr->tcl_UniCharToUpper) /* 323 */
+#endif
+#ifndef Tcl_UniCharToUtf
+#define Tcl_UniCharToUtf \
+ (tclStubsPtr->tcl_UniCharToUtf) /* 324 */
+#endif
+#ifndef Tcl_UtfAtIndex
+#define Tcl_UtfAtIndex \
+ (tclStubsPtr->tcl_UtfAtIndex) /* 325 */
+#endif
+#ifndef Tcl_UtfCharComplete
+#define Tcl_UtfCharComplete \
+ (tclStubsPtr->tcl_UtfCharComplete) /* 326 */
+#endif
+#ifndef Tcl_UtfBackslash
+#define Tcl_UtfBackslash \
+ (tclStubsPtr->tcl_UtfBackslash) /* 327 */
+#endif
+#ifndef Tcl_UtfFindFirst
+#define Tcl_UtfFindFirst \
+ (tclStubsPtr->tcl_UtfFindFirst) /* 328 */
+#endif
+#ifndef Tcl_UtfFindLast
+#define Tcl_UtfFindLast \
+ (tclStubsPtr->tcl_UtfFindLast) /* 329 */
+#endif
+#ifndef Tcl_UtfNext
+#define Tcl_UtfNext \
+ (tclStubsPtr->tcl_UtfNext) /* 330 */
+#endif
+#ifndef Tcl_UtfPrev
+#define Tcl_UtfPrev \
+ (tclStubsPtr->tcl_UtfPrev) /* 331 */
+#endif
+#ifndef Tcl_UtfToExternal
+#define Tcl_UtfToExternal \
+ (tclStubsPtr->tcl_UtfToExternal) /* 332 */
+#endif
+#ifndef Tcl_UtfToExternalDString
+#define Tcl_UtfToExternalDString \
+ (tclStubsPtr->tcl_UtfToExternalDString) /* 333 */
+#endif
+#ifndef Tcl_UtfToLower
+#define Tcl_UtfToLower \
+ (tclStubsPtr->tcl_UtfToLower) /* 334 */
+#endif
+#ifndef Tcl_UtfToTitle
+#define Tcl_UtfToTitle \
+ (tclStubsPtr->tcl_UtfToTitle) /* 335 */
+#endif
+#ifndef Tcl_UtfToUniChar
+#define Tcl_UtfToUniChar \
+ (tclStubsPtr->tcl_UtfToUniChar) /* 336 */
+#endif
+#ifndef Tcl_UtfToUpper
+#define Tcl_UtfToUpper \
+ (tclStubsPtr->tcl_UtfToUpper) /* 337 */
+#endif
+#ifndef Tcl_WriteChars
+#define Tcl_WriteChars \
+ (tclStubsPtr->tcl_WriteChars) /* 338 */
+#endif
+#ifndef Tcl_WriteObj
+#define Tcl_WriteObj \
+ (tclStubsPtr->tcl_WriteObj) /* 339 */
+#endif
+#ifndef Tcl_GetString
+#define Tcl_GetString \
+ (tclStubsPtr->tcl_GetString) /* 340 */
+#endif
+#ifndef Tcl_GetDefaultEncodingDir
+#define Tcl_GetDefaultEncodingDir \
+ (tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */
+#endif
+#ifndef Tcl_SetDefaultEncodingDir
+#define Tcl_SetDefaultEncodingDir \
+ (tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */
+#endif
+#ifndef Tcl_AlertNotifier
+#define Tcl_AlertNotifier \
+ (tclStubsPtr->tcl_AlertNotifier) /* 343 */
+#endif
+#ifndef Tcl_ServiceModeHook
+#define Tcl_ServiceModeHook \
+ (tclStubsPtr->tcl_ServiceModeHook) /* 344 */
+#endif
+#ifndef Tcl_UniCharIsAlnum
+#define Tcl_UniCharIsAlnum \
+ (tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */
+#endif
+#ifndef Tcl_UniCharIsAlpha
+#define Tcl_UniCharIsAlpha \
+ (tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */
+#endif
+#ifndef Tcl_UniCharIsDigit
+#define Tcl_UniCharIsDigit \
+ (tclStubsPtr->tcl_UniCharIsDigit) /* 347 */
+#endif
+#ifndef Tcl_UniCharIsLower
+#define Tcl_UniCharIsLower \
+ (tclStubsPtr->tcl_UniCharIsLower) /* 348 */
+#endif
+#ifndef Tcl_UniCharIsSpace
+#define Tcl_UniCharIsSpace \
+ (tclStubsPtr->tcl_UniCharIsSpace) /* 349 */
+#endif
+#ifndef Tcl_UniCharIsUpper
+#define Tcl_UniCharIsUpper \
+ (tclStubsPtr->tcl_UniCharIsUpper) /* 350 */
+#endif
+#ifndef Tcl_UniCharIsWordChar
+#define Tcl_UniCharIsWordChar \
+ (tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */
+#endif
+#ifndef Tcl_UniCharLen
+#define Tcl_UniCharLen \
+ (tclStubsPtr->tcl_UniCharLen) /* 352 */
+#endif
+#ifndef Tcl_UniCharNcmp
+#define Tcl_UniCharNcmp \
+ (tclStubsPtr->tcl_UniCharNcmp) /* 353 */
+#endif
+#ifndef Tcl_UniCharToUtfDString
+#define Tcl_UniCharToUtfDString \
+ (tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */
+#endif
+#ifndef Tcl_UtfToUniCharDString
+#define Tcl_UtfToUniCharDString \
+ (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
+#endif
+#ifndef Tcl_GetRegExpFromObj
+#define Tcl_GetRegExpFromObj \
+ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
+#endif
+#ifndef Tcl_EvalTokens
+#define Tcl_EvalTokens \
+ (tclStubsPtr->tcl_EvalTokens) /* 357 */
+#endif
+#ifndef Tcl_FreeParse
+#define Tcl_FreeParse \
+ (tclStubsPtr->tcl_FreeParse) /* 358 */
+#endif
+#ifndef Tcl_LogCommandInfo
+#define Tcl_LogCommandInfo \
+ (tclStubsPtr->tcl_LogCommandInfo) /* 359 */
+#endif
+#ifndef Tcl_ParseBraces
+#define Tcl_ParseBraces \
+ (tclStubsPtr->tcl_ParseBraces) /* 360 */
+#endif
+#ifndef Tcl_ParseCommand
+#define Tcl_ParseCommand \
+ (tclStubsPtr->tcl_ParseCommand) /* 361 */
+#endif
+#ifndef Tcl_ParseExpr
+#define Tcl_ParseExpr \
+ (tclStubsPtr->tcl_ParseExpr) /* 362 */
+#endif
+#ifndef Tcl_ParseQuotedString
+#define Tcl_ParseQuotedString \
+ (tclStubsPtr->tcl_ParseQuotedString) /* 363 */
+#endif
+#ifndef Tcl_ParseVarName
+#define Tcl_ParseVarName \
+ (tclStubsPtr->tcl_ParseVarName) /* 364 */
+#endif
+#ifndef Tcl_GetCwd
+#define Tcl_GetCwd \
+ (tclStubsPtr->tcl_GetCwd) /* 365 */
+#endif
+#ifndef Tcl_Chdir
+#define Tcl_Chdir \
+ (tclStubsPtr->tcl_Chdir) /* 366 */
+#endif
+#ifndef Tcl_Access
+#define Tcl_Access \
+ (tclStubsPtr->tcl_Access) /* 367 */
+#endif
+#ifndef Tcl_Stat
+#define Tcl_Stat \
+ (tclStubsPtr->tcl_Stat) /* 368 */
+#endif
+#ifndef Tcl_UtfNcmp
+#define Tcl_UtfNcmp \
+ (tclStubsPtr->tcl_UtfNcmp) /* 369 */
+#endif
+#ifndef Tcl_UtfNcasecmp
+#define Tcl_UtfNcasecmp \
+ (tclStubsPtr->tcl_UtfNcasecmp) /* 370 */
+#endif
+#ifndef Tcl_StringCaseMatch
+#define Tcl_StringCaseMatch \
+ (tclStubsPtr->tcl_StringCaseMatch) /* 371 */
+#endif
+#ifndef Tcl_UniCharIsControl
+#define Tcl_UniCharIsControl \
+ (tclStubsPtr->tcl_UniCharIsControl) /* 372 */
+#endif
+#ifndef Tcl_UniCharIsGraph
+#define Tcl_UniCharIsGraph \
+ (tclStubsPtr->tcl_UniCharIsGraph) /* 373 */
+#endif
+#ifndef Tcl_UniCharIsPrint
+#define Tcl_UniCharIsPrint \
+ (tclStubsPtr->tcl_UniCharIsPrint) /* 374 */
+#endif
+#ifndef Tcl_UniCharIsPunct
+#define Tcl_UniCharIsPunct \
+ (tclStubsPtr->tcl_UniCharIsPunct) /* 375 */
+#endif
+#ifndef Tcl_RegExpExecObj
+#define Tcl_RegExpExecObj \
+ (tclStubsPtr->tcl_RegExpExecObj) /* 376 */
+#endif
+#ifndef Tcl_RegExpGetInfo
+#define Tcl_RegExpGetInfo \
+ (tclStubsPtr->tcl_RegExpGetInfo) /* 377 */
+#endif
+#ifndef Tcl_NewUnicodeObj
+#define Tcl_NewUnicodeObj \
+ (tclStubsPtr->tcl_NewUnicodeObj) /* 378 */
+#endif
+#ifndef Tcl_SetUnicodeObj
+#define Tcl_SetUnicodeObj \
+ (tclStubsPtr->tcl_SetUnicodeObj) /* 379 */
+#endif
+#ifndef Tcl_GetCharLength
+#define Tcl_GetCharLength \
+ (tclStubsPtr->tcl_GetCharLength) /* 380 */
+#endif
+#ifndef Tcl_GetUniChar
+#define Tcl_GetUniChar \
+ (tclStubsPtr->tcl_GetUniChar) /* 381 */
+#endif
+#ifndef Tcl_GetUnicode
+#define Tcl_GetUnicode \
+ (tclStubsPtr->tcl_GetUnicode) /* 382 */
+#endif
+#ifndef Tcl_GetRange
+#define Tcl_GetRange \
+ (tclStubsPtr->tcl_GetRange) /* 383 */
+#endif
+#ifndef Tcl_AppendUnicodeToObj
+#define Tcl_AppendUnicodeToObj \
+ (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */
+#endif
+#ifndef Tcl_RegExpMatchObj
+#define Tcl_RegExpMatchObj \
+ (tclStubsPtr->tcl_RegExpMatchObj) /* 385 */
+#endif
+#ifndef Tcl_SetNotifier
+#define Tcl_SetNotifier \
+ (tclStubsPtr->tcl_SetNotifier) /* 386 */
+#endif
+#ifndef Tcl_GetAllocMutex
+#define Tcl_GetAllocMutex \
+ (tclStubsPtr->tcl_GetAllocMutex) /* 387 */
+#endif
+#ifndef Tcl_GetChannelNames
+#define Tcl_GetChannelNames \
+ (tclStubsPtr->tcl_GetChannelNames) /* 388 */
+#endif
+#ifndef Tcl_GetChannelNamesEx
+#define Tcl_GetChannelNamesEx \
+ (tclStubsPtr->tcl_GetChannelNamesEx) /* 389 */
+#endif
+#ifndef Tcl_ProcObjCmd
+#define Tcl_ProcObjCmd \
+ (tclStubsPtr->tcl_ProcObjCmd) /* 390 */
+#endif
+#ifndef Tcl_ConditionFinalize
+#define Tcl_ConditionFinalize \
+ (tclStubsPtr->tcl_ConditionFinalize) /* 391 */
+#endif
+#ifndef Tcl_MutexFinalize
+#define Tcl_MutexFinalize \
+ (tclStubsPtr->tcl_MutexFinalize) /* 392 */
+#endif
+#ifndef Tcl_CreateThread
+#define Tcl_CreateThread \
+ (tclStubsPtr->tcl_CreateThread) /* 393 */
+#endif
+#ifndef Tcl_ReadRaw
+#define Tcl_ReadRaw \
+ (tclStubsPtr->tcl_ReadRaw) /* 394 */
+#endif
+#ifndef Tcl_WriteRaw
+#define Tcl_WriteRaw \
+ (tclStubsPtr->tcl_WriteRaw) /* 395 */
+#endif
+#ifndef Tcl_GetTopChannel
+#define Tcl_GetTopChannel \
+ (tclStubsPtr->tcl_GetTopChannel) /* 396 */
+#endif
+#ifndef Tcl_ChannelBuffered
+#define Tcl_ChannelBuffered \
+ (tclStubsPtr->tcl_ChannelBuffered) /* 397 */
+#endif
+#ifndef Tcl_ChannelName
+#define Tcl_ChannelName \
+ (tclStubsPtr->tcl_ChannelName) /* 398 */
+#endif
+#ifndef Tcl_ChannelVersion
+#define Tcl_ChannelVersion \
+ (tclStubsPtr->tcl_ChannelVersion) /* 399 */
+#endif
+#ifndef Tcl_ChannelBlockModeProc
+#define Tcl_ChannelBlockModeProc \
+ (tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */
+#endif
+#ifndef Tcl_ChannelCloseProc
+#define Tcl_ChannelCloseProc \
+ (tclStubsPtr->tcl_ChannelCloseProc) /* 401 */
+#endif
+#ifndef Tcl_ChannelClose2Proc
+#define Tcl_ChannelClose2Proc \
+ (tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */
+#endif
+#ifndef Tcl_ChannelInputProc
+#define Tcl_ChannelInputProc \
+ (tclStubsPtr->tcl_ChannelInputProc) /* 403 */
+#endif
+#ifndef Tcl_ChannelOutputProc
+#define Tcl_ChannelOutputProc \
+ (tclStubsPtr->tcl_ChannelOutputProc) /* 404 */
+#endif
+#ifndef Tcl_ChannelSeekProc
+#define Tcl_ChannelSeekProc \
+ (tclStubsPtr->tcl_ChannelSeekProc) /* 405 */
+#endif
+#ifndef Tcl_ChannelSetOptionProc
+#define Tcl_ChannelSetOptionProc \
+ (tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */
+#endif
+#ifndef Tcl_ChannelGetOptionProc
+#define Tcl_ChannelGetOptionProc \
+ (tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */
+#endif
+#ifndef Tcl_ChannelWatchProc
+#define Tcl_ChannelWatchProc \
+ (tclStubsPtr->tcl_ChannelWatchProc) /* 408 */
+#endif
+#ifndef Tcl_ChannelGetHandleProc
+#define Tcl_ChannelGetHandleProc \
+ (tclStubsPtr->tcl_ChannelGetHandleProc) /* 409 */
+#endif
+#ifndef Tcl_ChannelFlushProc
+#define Tcl_ChannelFlushProc \
+ (tclStubsPtr->tcl_ChannelFlushProc) /* 410 */
+#endif
+#ifndef Tcl_ChannelHandlerProc
+#define Tcl_ChannelHandlerProc \
+ (tclStubsPtr->tcl_ChannelHandlerProc) /* 411 */
+#endif
+
+#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#endif /* _TCLDECLS */
+
+
diff --git a/tcl/generic/tclEncoding.c b/tcl/generic/tclEncoding.c
new file mode 100644
index 00000000000..8a43126c075
--- /dev/null
+++ b/tcl/generic/tclEncoding.c
@@ -0,0 +1,2767 @@
+/*
+ * tclEncoding.c --
+ *
+ * Contains the implementation of the encoding conversion package.
+ *
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+typedef size_t (LengthProc)_ANSI_ARGS_((CONST char *src));
+
+/*
+ * The following data structure represents an encoding, which describes how
+ * to convert between various character sets and UTF-8.
+ */
+
+typedef struct Encoding {
+ char *name; /* Name of encoding. Malloced because (1)
+ * hash table entry that owns this encoding
+ * may be freed prior to this encoding being
+ * freed, (2) string passed in the
+ * Tcl_EncodingType structure may not be
+ * persistent. */
+ Tcl_EncodingConvertProc *toUtfProc;
+ /* Procedure to convert from external
+ * encoding into UTF-8. */
+ Tcl_EncodingConvertProc *fromUtfProc;
+ /* Procedure to convert from UTF-8 into
+ * external encoding. */
+ Tcl_EncodingFreeProc *freeProc;
+ /* If non-NULL, procedure to call when this
+ * encoding is deleted. */
+ int nullSize; /* Number of 0x00 bytes that signify
+ * end-of-string in this encoding. This
+ * number is used to determine the source
+ * string length when the srcLen argument is
+ * negative. This number can be 1 or 2. */
+ ClientData clientData; /* Arbitrary value associated with encoding
+ * type. Passed to conversion procedures. */
+ LengthProc *lengthProc; /* Function to compute length of
+ * null-terminated strings in this encoding.
+ * If nullSize is 1, this is strlen; if
+ * nullSize is 2, this is a function that
+ * returns the number of bytes in a 0x0000
+ * terminated string. */
+ int refCount; /* Number of uses of this structure. */
+ Tcl_HashEntry *hPtr; /* Hash table entry that owns this encoding. */
+} Encoding;
+
+/*
+ * The following structure is the clientData for a dynamically-loaded,
+ * table-driven encoding created by LoadTableEncoding(). It maps between
+ * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
+ * encoding.
+ */
+
+typedef struct TableEncodingData {
+ int fallback; /* Character (in this encoding) to
+ * substitute when this encoding cannot
+ * represent a UTF-8 character. */
+ char prefixBytes[256]; /* If a byte in the input stream is a lead
+ * byte for a 2-byte sequence, the
+ * corresponding entry in this array is 1,
+ * otherwise it is 0. */
+ unsigned short **toUnicode; /* Two dimensional sparse matrix to map
+ * characters from the encoding to Unicode.
+ * Each element of the toUnicode array points
+ * to an array of 256 shorts. If there is no
+ * corresponding character in Unicode, the
+ * value in the matrix is 0x0000. malloc'd. */
+ unsigned short **fromUnicode;
+ /* Two dimensional sparse matrix to map
+ * characters from Unicode to the encoding.
+ * Each element of the fromUnicode array
+ * points to an array of 256 shorts. If there
+ * is no corresponding character the encoding,
+ * the value in the matrix is 0x0000.
+ * malloc'd. */
+} TableEncodingData;
+
+/*
+ * The following structures is the clientData for a dynamically-loaded,
+ * escape-driven encoding that is itself comprised of other simpler
+ * encodings. An example is "iso-2022-jp", which uses escape sequences to
+ * switch between ascii, jis0208, jis0212, gb2312, and ksc5601. Note that
+ * "escape-driven" does not necessarily mean that the ESCAPE character is
+ * the character used for switching character sets.
+ */
+
+typedef struct EscapeSubTable {
+ unsigned int sequenceLen; /* Length of following string. */
+ char sequence[16]; /* Escape code that marks this encoding. */
+ char name[32]; /* Name for encoding. */
+ Encoding *encodingPtr; /* Encoding loaded using above name, or NULL
+ * if this sub-encoding has not been needed
+ * yet. */
+} EscapeSubTable;
+
+typedef struct EscapeEncodingData {
+ int fallback; /* Character (in this encoding) to
+ * substitute when this encoding cannot
+ * represent a UTF-8 character. */
+ unsigned int initLen; /* Length of following string. */
+ char init[16]; /* String to emit or expect before first char
+ * in conversion. */
+ unsigned int finalLen; /* Length of following string. */
+ char final[16]; /* String to emit or expect after last char
+ * in conversion. */
+ char prefixBytes[256]; /* If a byte in the input stream is the
+ * first character of one of the escape
+ * sequences in the following array, the
+ * corresponding entry in this array is 1,
+ * otherwise it is 0. */
+ int numSubTables; /* Length of following array. */
+ EscapeSubTable subTables[1];/* Information about each EscapeSubTable
+ * used by this encoding type. The actual
+ * size will be as large as necessary to
+ * hold all EscapeSubTables. */
+} EscapeEncodingData;
+
+/*
+ * Constants used when loading an encoding file to identify the type of the
+ * file.
+ */
+
+#define ENCODING_SINGLEBYTE 0
+#define ENCODING_DOUBLEBYTE 1
+#define ENCODING_MULTIBYTE 2
+#define ENCODING_ESCAPE 3
+
+/*
+ * Initialize the default encoding directory. If this variable contains
+ * a non NULL value, it will be the first path used to locate the
+ * system encoding files.
+ */
+
+char *tclDefaultEncodingDir = NULL;
+
+static int encodingsInitialized = 0;
+
+/*
+ * Hash table that keeps track of all loaded Encodings. Keys are
+ * the string names that represent the encoding, values are (Encoding *).
+ */
+
+static Tcl_HashTable encodingTable;
+TCL_DECLARE_MUTEX(encodingMutex)
+
+/*
+ * The following are used to hold the default and current system encodings.
+ * If NULL is passed to one of the conversion routines, the current setting
+ * of the system encoding will be used to perform the conversion.
+ */
+
+static Tcl_Encoding defaultEncoding;
+static Tcl_Encoding systemEncoding;
+
+/*
+ * The following variable is used in the sparse matrix code for a
+ * TableEncoding to represent a page in the table that has no entries.
+ */
+
+static unsigned short emptyPage[256];
+
+/*
+ * Procedures used only in this module.
+ */
+
+static int BinaryProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static void EscapeFreeProc _ANSI_ARGS_((ClientData clientData));
+static int EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static int EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static void FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
+static Encoding * GetTableEncoding _ANSI_ARGS_((
+ EscapeEncodingData *dataPtr, int state));
+static Tcl_Encoding LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *name));
+static Tcl_Encoding LoadTableEncoding _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *name, int type, Tcl_Channel chan));
+static Tcl_Encoding LoadEscapeEncoding _ANSI_ARGS_((CONST char *name,
+ Tcl_Channel chan));
+static Tcl_Channel OpenEncodingFile _ANSI_ARGS_((CONST char *dir,
+ CONST char *name));
+static void TableFreeProc _ANSI_ARGS_((ClientData clientData));
+static int TableFromUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static int TableToUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static size_t unilen _ANSI_ARGS_((CONST char *src));
+static int UnicodeToUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static int UtfToUnicodeProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static int UtfToUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst, int dstLen,
+ int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclInitEncodingSubsystem --
+ *
+ * Initialize all resources used by this subsystem on a per-process
+ * basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the memory, object, and IO subsystems.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclInitEncodingSubsystem()
+{
+ Tcl_EncodingType type;
+
+ Tcl_MutexLock(&encodingMutex);
+ Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
+ Tcl_MutexUnlock(&encodingMutex);
+
+ /*
+ * Create a few initial encodings. Note that the UTF-8 to UTF-8
+ * translation is not a no-op, because it will turn a stream of
+ * improperly formed UTF-8 into a properly formed stream.
+ */
+
+ type.encodingName = "identity";
+ type.toUtfProc = BinaryProc;
+ type.fromUtfProc = BinaryProc;
+ type.freeProc = NULL;
+ type.nullSize = 1;
+ type.clientData = NULL;
+
+ defaultEncoding = Tcl_CreateEncoding(&type);
+ systemEncoding = Tcl_GetEncoding(NULL, type.encodingName);
+
+ type.encodingName = "utf-8";
+ type.toUtfProc = UtfToUtfProc;
+ type.fromUtfProc = UtfToUtfProc;
+ type.freeProc = NULL;
+ type.nullSize = 1;
+ type.clientData = NULL;
+ Tcl_CreateEncoding(&type);
+
+ type.encodingName = "unicode";
+ type.toUtfProc = UnicodeToUtfProc;
+ type.fromUtfProc = UtfToUnicodeProc;
+ type.freeProc = NULL;
+ type.nullSize = 2;
+ type.clientData = NULL;
+ Tcl_CreateEncoding(&type);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeEncodingSubsystem --
+ *
+ * Release the state associated with the encoding subsystem.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees all of the encodings.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeEncodingSubsystem()
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ Encoding *encodingPtr;
+
+ Tcl_MutexLock(&encodingMutex);
+ encodingsInitialized = 0;
+ hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
+ while (hPtr != NULL) {
+ encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+ if (encodingPtr->freeProc != NULL) {
+ (*encodingPtr->freeProc)(encodingPtr->clientData);
+ }
+ ckfree((char *) encodingPtr->name);
+ ckfree((char *) encodingPtr);
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&encodingTable);
+ Tcl_MutexUnlock(&encodingMutex);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_GetDefaultEncodingDir --
+ *
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetDefaultEncodingDir()
+{
+ return tclDefaultEncodingDir;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_SetDefaultEncodingDir --
+ *
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+Tcl_SetDefaultEncodingDir(path)
+ char *path;
+{
+ tclDefaultEncodingDir = (char *)ckalloc((unsigned) strlen(path) + 1);
+ strcpy(tclDefaultEncodingDir, path);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_GetEncoding --
+ *
+ * Given the name of a encoding, find the corresponding Tcl_Encoding
+ * token. If the encoding did not already exist, Tcl attempts to
+ * dynamically load an encoding by that name.
+ *
+ * Results:
+ * Returns a token that represents the encoding. If the name didn't
+ * refer to any known or loadable encoding, NULL is returned. If
+ * NULL was returned, an error message is left in interp's result
+ * object, unless interp was NULL.
+ *
+ * Side effects:
+ * The new encoding type is entered into a table visible to all
+ * interpreters, keyed off the encoding's name. For each call to
+ * this procedure, there should eventually be a call to
+ * Tcl_FreeEncoding, so that the database can be cleaned up when
+ * encodings aren't needed anymore.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+Tcl_Encoding
+Tcl_GetEncoding(interp, name)
+ Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
+ CONST char *name; /* The name of the desired encoding. */
+{
+ Tcl_HashEntry *hPtr;
+ Encoding *encodingPtr;
+
+ Tcl_MutexLock(&encodingMutex);
+ if (name == NULL) {
+ encodingPtr = (Encoding *) systemEncoding;
+ encodingPtr->refCount++;
+ Tcl_MutexUnlock(&encodingMutex);
+ return systemEncoding;
+ }
+
+ hPtr = Tcl_FindHashEntry(&encodingTable, name);
+ if (hPtr != NULL) {
+ encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+ encodingPtr->refCount++;
+ Tcl_MutexUnlock(&encodingMutex);
+ return (Tcl_Encoding) encodingPtr;
+ }
+ Tcl_MutexUnlock(&encodingMutex);
+ return LoadEncodingFile(interp, name);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FreeEncoding --
+ *
+ * This procedure is called to release an encoding allocated by
+ * Tcl_CreateEncoding() or Tcl_GetEncoding().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the encoding is decremented
+ * and the encoding may be deleted if nothing is using it anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tcl_FreeEncoding(encoding)
+ Tcl_Encoding encoding;
+{
+ Tcl_MutexLock(&encodingMutex);
+ FreeEncoding(encoding);
+ Tcl_MutexUnlock(&encodingMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeEncoding --
+ *
+ * This procedure is called to release an encoding by procedures
+ * that already have the encodingMutex.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with the encoding is decremented
+ * and the encoding may be deleted if nothing is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeEncoding(encoding)
+ Tcl_Encoding encoding;
+{
+ Encoding *encodingPtr;
+
+ encodingPtr = (Encoding *) encoding;
+ if (encodingPtr == NULL) {
+ return;
+ }
+ encodingPtr->refCount--;
+ if (encodingPtr->refCount == 0) {
+ if (encodingPtr->freeProc != NULL) {
+ (*encodingPtr->freeProc)(encodingPtr->clientData);
+ }
+ if (encodingPtr->hPtr != NULL) {
+ Tcl_DeleteHashEntry(encodingPtr->hPtr);
+ }
+ ckfree((char *) encodingPtr->name);
+ ckfree((char *) encodingPtr);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_GetEncodingName --
+ *
+ * Given an encoding, return the name that was used to constuct
+ * the encoding.
+ *
+ * Results:
+ * The name of the encoding.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetEncodingName(encoding)
+ Tcl_Encoding encoding; /* The encoding whose name to fetch. */
+{
+ Encoding *encodingPtr;
+
+ if (encoding == NULL) {
+ encoding = systemEncoding;
+ }
+ encodingPtr = (Encoding *) encoding;
+ return encodingPtr->name;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_GetEncodingNames --
+ *
+ * Get the list of all known encodings, including the ones stored
+ * as files on disk in the encoding path.
+ *
+ * Results:
+ * Modifies interp's result object to hold a list of all the available
+ * encodings.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+Tcl_GetEncodingNames(interp)
+ Tcl_Interp *interp; /* Interp to hold result. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ Tcl_Obj *pathPtr, *resultPtr;
+ int dummy;
+
+ Tcl_HashTable table;
+
+ Tcl_MutexLock(&encodingMutex);
+ Tcl_InitHashTable(&table, TCL_STRING_KEYS);
+ hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
+ while (hPtr != NULL) {
+ Encoding *encodingPtr;
+
+ encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+ Tcl_CreateHashEntry(&table, encodingPtr->name, &dummy);
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_MutexUnlock(&encodingMutex);
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int i, objc;
+ Tcl_Obj **objv;
+ Tcl_DString pwdString;
+ char globArgString[10];
+
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+
+ Tcl_GetCwd(interp, &pwdString);
+
+ for (i = 0; i < objc; i++) {
+ char *string;
+ int j, objc2, length;
+ Tcl_Obj **objv2;
+
+ string = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_ResetResult(interp);
+
+ /*
+ * TclGlob() changes the contents of globArgString, which causes
+ * a segfault if we pass in a pointer to non-writeable memory.
+ * TclGlob() puts its results directly into interp.
+ */
+
+ strcpy(globArgString, "*.enc");
+ if ((Tcl_Chdir(string) == 0)
+ && (Tcl_Chdir("encoding") == 0)
+ && (TclGlob(interp, globArgString, NULL, 0, NULL) == TCL_OK)) {
+ objc2 = 0;
+
+ Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
+ &objv2);
+
+ for (j = 0; j < objc2; j++) {
+ string = Tcl_GetStringFromObj(objv2[j], &length);
+ length -= 4;
+ if (length > 0) {
+ string[length] = '\0';
+ Tcl_CreateHashEntry(&table, string, &dummy);
+ string[length] = '.';
+ }
+ }
+ }
+ Tcl_Chdir(Tcl_DStringValue(&pwdString));
+ }
+ Tcl_DStringFree(&pwdString);
+ }
+
+ /*
+ * Clear any values placed in the result by globbing.
+ */
+
+ Tcl_ResetResult(interp);
+ resultPtr = Tcl_GetObjResult(interp);
+
+ hPtr = Tcl_FirstHashEntry(&table, &search);
+ while (hPtr != NULL) {
+ Tcl_Obj *strPtr;
+
+ strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&table, hPtr), -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&table);
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * Tcl_SetSystemEncoding --
+ *
+ * Sets the default encoding that should be used whenever the user
+ * passes a NULL value in to one of the conversion routines.
+ * If the supplied name is NULL, the system encoding is reset to the
+ * default system encoding.
+ *
+ * Results:
+ * The return value is TCL_OK if the system encoding was successfully
+ * set to the encoding specified by name, TCL_ERROR otherwise. If
+ * TCL_ERROR is returned, an error message is left in interp's result
+ * object, unless interp was NULL.
+ *
+ * Side effects:
+ * The reference count of the new system encoding is incremented.
+ * The reference count of the old system encoding is decremented and
+ * it may be freed.
+ *
+ *------------------------------------------------------------------------
+ */
+
+int
+Tcl_SetSystemEncoding(interp, name)
+ Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
+ CONST char *name; /* The name of the desired encoding, or NULL
+ * to reset to default encoding. */
+{
+ Tcl_Encoding encoding;
+ Encoding *encodingPtr;
+
+ if (name == NULL) {
+ Tcl_MutexLock(&encodingMutex);
+ encoding = defaultEncoding;
+ encodingPtr = (Encoding *) encoding;
+ encodingPtr->refCount++;
+ Tcl_MutexUnlock(&encodingMutex);
+ } else {
+ encoding = Tcl_GetEncoding(interp, name);
+ if (encoding == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_MutexLock(&encodingMutex);
+ FreeEncoding(systemEncoding);
+ systemEncoding = encoding;
+ Tcl_MutexUnlock(&encodingMutex);
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_CreateEncoding --
+ *
+ * This procedure is called to define a new encoding and the procedures
+ * that are used to convert between the specified encoding and Unicode.
+ *
+ * Results:
+ * Returns a token that represents the encoding. If an encoding with
+ * the same name already existed, the old encoding token remains
+ * valid and continues to behave as it used to, and will eventually
+ * be garbage collected when the last reference to it goes away. Any
+ * subsequent calls to Tcl_GetEncoding with the specified name will
+ * retrieve the most recent encoding token.
+ *
+ * Side effects:
+ * The new encoding type is entered into a table visible to all
+ * interpreters, keyed off the encoding's name. For each call to
+ * this procedure, there should eventually be a call to
+ * Tcl_FreeEncoding, so that the database can be cleaned up when
+ * encodings aren't needed anymore.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Encoding
+Tcl_CreateEncoding(typePtr)
+ Tcl_EncodingType *typePtr; /* The encoding type. */
+{
+ Tcl_HashEntry *hPtr;
+ int new;
+ Encoding *encodingPtr;
+ char *name;
+
+ Tcl_MutexLock(&encodingMutex);
+ hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &new);
+ if (new == 0) {
+ /*
+ * Remove old encoding from hash table, but don't delete it until
+ * last reference goes away.
+ */
+
+ encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
+ encodingPtr->hPtr = NULL;
+ }
+
+ name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);
+
+ encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
+ encodingPtr->name = strcpy(name, typePtr->encodingName);
+ encodingPtr->toUtfProc = typePtr->toUtfProc;
+ encodingPtr->fromUtfProc = typePtr->fromUtfProc;
+ encodingPtr->freeProc = typePtr->freeProc;
+ encodingPtr->nullSize = typePtr->nullSize;
+ encodingPtr->clientData = typePtr->clientData;
+ if (typePtr->nullSize == 1) {
+ encodingPtr->lengthProc = (LengthProc *) strlen;
+ } else {
+ encodingPtr->lengthProc = (LengthProc *) unilen;
+ }
+ encodingPtr->refCount = 1;
+ encodingPtr->hPtr = hPtr;
+ Tcl_SetHashValue(hPtr, encodingPtr);
+
+ Tcl_MutexUnlock(&encodingMutex);
+
+ return (Tcl_Encoding) encodingPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_ExternalToUtfDString --
+ *
+ * Convert a source buffer from the specified encoding into UTF-8.
+ * If any of the bytes in the source buffer are invalid or cannot
+ * be represented in the target encoding, a default fallback
+ * character will be substituted.
+ *
+ * Results:
+ * The converted bytes are stored in the DString, which is then NULL
+ * terminated. The return value is a pointer to the value stored
+ * in the DString.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char *
+Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
+ Tcl_Encoding encoding; /* The encoding for the source string, or
+ * NULL for the default system encoding. */
+ CONST char *src; /* Source string in specified encoding. */
+ int srcLen; /* Source string length in bytes, or < 0 for
+ * encoding-specific string length. */
+ Tcl_DString *dstPtr; /* Uninitialized or free DString in which
+ * the converted string is stored. */
+{
+ char *dst;
+ Tcl_EncodingState state;
+ Encoding *encodingPtr;
+ int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
+
+ Tcl_DStringInit(dstPtr);
+ dst = Tcl_DStringValue(dstPtr);
+ dstLen = dstPtr->spaceAvl - 1;
+
+ if (encoding == NULL) {
+ encoding = systemEncoding;
+ }
+ encodingPtr = (Encoding *) encoding;
+
+ if (src == NULL) {
+ srcLen = 0;
+ } else if (srcLen < 0) {
+ srcLen = (*encodingPtr->lengthProc)(src);
+ }
+ flags = TCL_ENCODING_START | TCL_ENCODING_END;
+ while (1) {
+ result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src,
+ srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
+ &dstChars);
+ soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
+ if (result != TCL_CONVERT_NOSPACE) {
+ Tcl_DStringSetLength(dstPtr, soFar);
+ return Tcl_DStringValue(dstPtr);
+ }
+ flags &= ~TCL_ENCODING_START;
+ src += srcRead;
+ srcLen -= srcRead;
+ if (Tcl_DStringLength(dstPtr) == 0) {
+ Tcl_DStringSetLength(dstPtr, dstLen);
+ }
+ Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
+ dst = Tcl_DStringValue(dstPtr) + soFar;
+ dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_ExternalToUtf --
+ *
+ * Convert a source buffer from the specified encoding into UTF-8,
+ *
+ * Results:
+ * The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE,
+ * TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE,
+ * as documented in tcl.h.
+ *
+ * Side effects:
+ * The converted bytes are stored in the output buffer.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst,
+ dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
+ Tcl_Interp *interp; /* Interp for error return, if not NULL. */
+ Tcl_Encoding encoding; /* The encoding for the source string, or
+ * NULL for the default system encoding. */
+ CONST char *src; /* Source string in specified encoding. */
+ int srcLen; /* Source string length in bytes, or < 0 for
+ * encoding-specific string length. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ Encoding *encodingPtr;
+ int result, srcRead, dstWrote, dstChars;
+ Tcl_EncodingState state;
+
+ if (encoding == NULL) {
+ encoding = systemEncoding;
+ }
+ encodingPtr = (Encoding *) encoding;
+
+ if (src == NULL) {
+ srcLen = 0;
+ } else if (srcLen < 0) {
+ srcLen = (*encodingPtr->lengthProc)(src);
+ }
+ if (statePtr == NULL) {
+ flags |= TCL_ENCODING_START | TCL_ENCODING_END;
+ statePtr = &state;
+ }
+ if (srcReadPtr == NULL) {
+ srcReadPtr = &srcRead;
+ }
+ if (dstWrotePtr == NULL) {
+ dstWrotePtr = &dstWrote;
+ }
+ if (dstCharsPtr == NULL) {
+ dstCharsPtr = &dstChars;
+ }
+
+ /*
+ * 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.
+ */
+
+ dstLen--;
+ result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src, srcLen,
+ flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
+ dstCharsPtr);
+ dst[*dstWrotePtr] = '\0';
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_UtfToExternalDString --
+ *
+ * Convert a source buffer from UTF-8 into the specified encoding.
+ * If any of the bytes in the source buffer are invalid or cannot
+ * be represented in the target encoding, a default fallback
+ * character will be substituted.
+ *
+ * Results:
+ * The converted bytes are stored in the DString, which is then
+ * NULL terminated in an encoding-specific manner. The return value
+ * is a pointer to the value stored in the DString.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char *
+Tcl_UtfToExternalDString(encoding, src, srcLen, dstPtr)
+ Tcl_Encoding encoding; /* The encoding for the converted string,
+ * or NULL for the default system encoding. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes, or < 0 for
+ * strlen(). */
+ Tcl_DString *dstPtr; /* Uninitialized or free DString in which
+ * the converted string is stored. */
+{
+ char *dst;
+ Tcl_EncodingState state;
+ Encoding *encodingPtr;
+ int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
+
+ Tcl_DStringInit(dstPtr);
+ dst = Tcl_DStringValue(dstPtr);
+ dstLen = dstPtr->spaceAvl - 1;
+
+ if (encoding == NULL) {
+ encoding = systemEncoding;
+ }
+ encodingPtr = (Encoding *) encoding;
+
+ if (src == NULL) {
+ srcLen = 0;
+ } else if (srcLen < 0) {
+ srcLen = strlen(src);
+ }
+ flags = TCL_ENCODING_START | TCL_ENCODING_END;
+ while (1) {
+ result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src,
+ srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
+ &dstChars);
+ soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
+ if (result != TCL_CONVERT_NOSPACE) {
+ if (encodingPtr->nullSize == 2) {
+ Tcl_DStringSetLength(dstPtr, soFar + 1);
+ }
+ Tcl_DStringSetLength(dstPtr, soFar);
+ return Tcl_DStringValue(dstPtr);
+ }
+ flags &= ~TCL_ENCODING_START;
+ src += srcRead;
+ srcLen -= srcRead;
+ if (Tcl_DStringLength(dstPtr) == 0) {
+ Tcl_DStringSetLength(dstPtr, dstLen);
+ }
+ Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
+ dst = Tcl_DStringValue(dstPtr) + soFar;
+ dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tcl_UtfToExternal --
+ *
+ * Convert a buffer from UTF-8 into the specified encoding.
+ *
+ * Results:
+ * The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE,
+ * TCL_CONVERT_SYNTAX, TCL_CONVERT_UNKNOWN, or TCL_CONVERT_NOSPACE,
+ * as documented in tcl.h.
+ *
+ * Side effects:
+ * The converted bytes are stored in the output buffer.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst,
+ dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
+ Tcl_Interp *interp; /* Interp for error return, if not NULL. */
+ Tcl_Encoding encoding; /* The encoding for the converted string,
+ * or NULL for the default system encoding. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes, or < 0 for
+ * strlen(). */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ Encoding *encodingPtr;
+ int result, srcRead, dstWrote, dstChars;
+ Tcl_EncodingState state;
+
+ if (encoding == NULL) {
+ encoding = systemEncoding;
+ }
+ encodingPtr = (Encoding *) encoding;
+
+ if (src == NULL) {
+ srcLen = 0;
+ } else if (srcLen < 0) {
+ srcLen = strlen(src);
+ }
+ if (statePtr == NULL) {
+ flags |= TCL_ENCODING_START | TCL_ENCODING_END;
+ statePtr = &state;
+ }
+ if (srcReadPtr == NULL) {
+ srcReadPtr = &srcRead;
+ }
+ if (dstWrotePtr == NULL) {
+ dstWrotePtr = &dstWrote;
+ }
+ if (dstCharsPtr == NULL) {
+ dstCharsPtr = &dstChars;
+ }
+
+ dstLen -= encodingPtr->nullSize;
+ result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src, srcLen,
+ flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
+ dstCharsPtr);
+ if (encodingPtr->nullSize == 2) {
+ dst[*dstWrotePtr + 1] = '\0';
+ }
+ dst[*dstWrotePtr] = '\0';
+
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FindExecutable --
+ *
+ * This procedure computes the absolute path name of the current
+ * application, given its argv[0] value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The variable tclExecutableName gets filled in with the file
+ * name for the application, if we figured it out. If we couldn't
+ * figure it out, tclExecutableName is set to NULL.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tcl_FindExecutable(argv0)
+ CONST char *argv0; /* The value of the application's argv[0]
+ * (native). */
+{
+ CONST char *name;
+ Tcl_DString buffer, nameString;
+
+ TclInitSubsystems(argv0);
+
+ if (argv0 == NULL) {
+ goto done;
+ }
+ if (tclExecutableName != NULL) {
+ ckfree(tclExecutableName);
+ tclExecutableName = NULL;
+ }
+ if ((name = TclpFindExecutable(argv0)) == NULL) {
+ goto done;
+ }
+
+ /*
+ * The value returned from TclpNameOfExecutable is a UTF string that
+ * is possibly dirty depending on when it was initialized. To assure
+ * that the UTF string is a properly encoded native string for this
+ * system, convert the UTF string to the default native encoding
+ * before the default encoding is initialized. Then, convert it back
+ * to UTF after the system encoding is loaded.
+ */
+
+ Tcl_UtfToExternalDString(NULL, name, -1, &buffer);
+ TclFindEncodings(argv0);
+
+ /*
+ * Now it is OK to convert the native string back to UTF and set
+ * the value of the tclExecutableName.
+ */
+
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1, &nameString);
+ tclExecutableName = (char *)
+ ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
+ strcpy(tclExecutableName, Tcl_DStringValue(&nameString));
+
+ Tcl_DStringFree(&buffer);
+ Tcl_DStringFree(&nameString);
+ return;
+
+ done:
+ TclFindEncodings(argv0);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * LoadEncodingFile --
+ *
+ * Read a file that describes an encoding and create a new Encoding
+ * from the data.
+ *
+ * Results:
+ * The return value is the newly loaded Encoding, or NULL if
+ * the file didn't exist of was in the incorrect format. If NULL was
+ * returned, an error message is left in interp's result object,
+ * unless interp was NULL.
+ *
+ * Side effects:
+ * File read from disk.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Tcl_Encoding
+LoadEncodingFile(interp, name)
+ Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
+ CONST char *name; /* The name of the encoding file on disk
+ * and also the name for new encoding. */
+{
+ int objc, i, ch;
+ Tcl_Obj **objv;
+ Tcl_Obj *pathPtr;
+ Tcl_Channel chan;
+ Tcl_Encoding encoding;
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr == NULL) {
+ goto unknown;
+ }
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+
+ chan = NULL;
+ for (i = 0; i < objc; i++) {
+ chan = OpenEncodingFile(Tcl_GetString(objv[i]), name);
+ if (chan != NULL) {
+ break;
+ }
+ }
+
+ if (chan == NULL) {
+ goto unknown;
+ }
+
+ Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
+
+ while (1) {
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+ Tcl_Gets(chan, &ds);
+ ch = Tcl_DStringValue(&ds)[0];
+ Tcl_DStringFree(&ds);
+ if (ch != '#') {
+ break;
+ }
+ }
+
+ encoding = NULL;
+ switch (ch) {
+ case 'S': {
+ encoding = LoadTableEncoding(interp, name, ENCODING_SINGLEBYTE,
+ chan);
+ break;
+ }
+ case 'D': {
+ encoding = LoadTableEncoding(interp, name, ENCODING_DOUBLEBYTE,
+ chan);
+ break;
+ }
+ case 'M': {
+ encoding = LoadTableEncoding(interp, name, ENCODING_MULTIBYTE,
+ chan);
+ break;
+ }
+ case 'E': {
+ encoding = LoadEscapeEncoding(name, chan);
+ break;
+ }
+ }
+ if ((encoding == NULL) && (interp != NULL)) {
+ Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL);
+ }
+ Tcl_Close(NULL, chan);
+ return encoding;
+
+ unknown:
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenEncodingFile --
+ *
+ * Look for the file encoding/<name>.enc in the specified
+ * directory.
+ *
+ * Results:
+ * Returns an open file channel if the file exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+OpenEncodingFile(dir, name)
+ CONST char *dir;
+ CONST char *name;
+
+{
+ char *argv[3];
+ Tcl_DString pathString;
+ char *path;
+ Tcl_Channel chan;
+
+ argv[0] = (char *) dir;
+ argv[1] = "encoding";
+ argv[2] = (char *) name;
+
+ Tcl_DStringInit(&pathString);
+ Tcl_JoinPath(3, argv, &pathString);
+ path = Tcl_DStringAppend(&pathString, ".enc", -1);
+ chan = Tcl_OpenFileChannel(NULL, path, "r", 0);
+ Tcl_DStringFree(&pathString);
+
+ return chan;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * LoadTableEncoding --
+ *
+ * Helper function for LoadEncodingTable(). Loads a table to that
+ * converts between Unicode and some other encoding and creates an
+ * encoding (using a TableEncoding structure) from that information.
+ *
+ * File contains binary data, but begins with a marker to indicate
+ * byte-ordering, so that same binary file can be read on either
+ * endian platforms.
+ *
+ * Results:
+ * The return value is the new encoding, or NULL if the encoding
+ * could not be created (because the file contained invalid data).
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Encoding
+LoadTableEncoding(interp, name, type, chan)
+ Tcl_Interp *interp; /* Interp for temporary obj while reading. */
+ CONST char *name; /* Name for new encoding. */
+ int type; /* Type of encoding (ENCODING_?????). */
+ Tcl_Channel chan; /* File containing new encoding. */
+{
+ Tcl_DString lineString;
+ Tcl_Obj *objPtr;
+ char *line;
+ int i, hi, lo, numPages, symbol, fallback;
+ unsigned char used[256];
+ unsigned int size;
+ TableEncodingData *dataPtr;
+ unsigned short *pageMemPtr;
+ Tcl_EncodingType encType;
+ char *hex;
+ static char staticHex[] = {
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, 0,
+ 10, 11, 12, 13, 14, 15
+ };
+
+ hex = staticHex - '0';
+
+ Tcl_DStringInit(&lineString);
+ Tcl_Gets(chan, &lineString);
+ line = Tcl_DStringValue(&lineString);
+
+ fallback = (int) strtol(line, &line, 16);
+ symbol = (int) strtol(line, &line, 10);
+ numPages = (int) strtol(line, &line, 10);
+ Tcl_DStringFree(&lineString);
+
+ if (numPages < 0) {
+ numPages = 0;
+ } else if (numPages > 256) {
+ numPages = 256;
+ }
+
+ memset(used, 0, sizeof(used));
+
+#undef PAGESIZE
+#define PAGESIZE (256 * sizeof(unsigned short))
+
+ dataPtr = (TableEncodingData *) ckalloc(sizeof(TableEncodingData));
+ memset(dataPtr, 0, sizeof(TableEncodingData));
+
+ dataPtr->fallback = fallback;
+
+ /*
+ * Read the table that maps characters to Unicode. Performs a single
+ * malloc to get the memory for the array and all the pages needed by
+ * the array.
+ */
+
+ size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
+ dataPtr->toUnicode = (unsigned short **) ckalloc(size);
+ memset(dataPtr->toUnicode, 0, size);
+ pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);
+
+ if (interp == NULL) {
+ objPtr = Tcl_NewObj();
+ } else {
+ objPtr = Tcl_GetObjResult(interp);
+ }
+ for (i = 0; i < numPages; i++) {
+ int ch;
+ char *p;
+
+ Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
+ p = Tcl_GetString(objPtr);
+ hi = (hex[(int)p[0]] << 4) + hex[(int)p[1]];
+ dataPtr->toUnicode[hi] = pageMemPtr;
+ p += 2;
+ for (lo = 0; lo < 256; lo++) {
+ if ((lo & 0x0f) == 0) {
+ p++;
+ }
+ ch = (hex[(int)p[0]] << 12) + (hex[(int)p[1]] << 8)
+ + (hex[(int)p[2]] << 4) + hex[(int)p[3]];
+ if (ch != 0) {
+ used[ch >> 8] = 1;
+ }
+ *pageMemPtr = (unsigned short) ch;
+ pageMemPtr++;
+ p += 4;
+ }
+ }
+ if (interp == NULL) {
+ Tcl_DecrRefCount(objPtr);
+ } else {
+ Tcl_ResetResult(interp);
+ }
+
+ if (type == ENCODING_DOUBLEBYTE) {
+ memset(dataPtr->prefixBytes, 1, sizeof(dataPtr->prefixBytes));
+ } else {
+ for (hi = 1; hi < 256; hi++) {
+ if (dataPtr->toUnicode[hi] != NULL) {
+ dataPtr->prefixBytes[hi] = 1;
+ }
+ }
+ }
+
+ /*
+ * Invert toUnicode array to produce the fromUnicode array. Performs a
+ * single malloc to get the memory for the array and all the pages
+ * needed by the array. While reading in the toUnicode array, we
+ * remembered what pages that would be needed for the fromUnicode array.
+ */
+
+ if (symbol) {
+ used[0] = 1;
+ }
+ numPages = 0;
+ for (hi = 0; hi < 256; hi++) {
+ if (used[hi]) {
+ numPages++;
+ }
+ }
+ size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
+ dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
+ memset(dataPtr->fromUnicode, 0, size);
+ pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);
+
+ for (hi = 0; hi < 256; hi++) {
+ if (dataPtr->toUnicode[hi] == NULL) {
+ dataPtr->toUnicode[hi] = emptyPage;
+ } else {
+ for (lo = 0; lo < 256; lo++) {
+ int ch;
+
+ ch = dataPtr->toUnicode[hi][lo];
+ if (ch != 0) {
+ unsigned short *page;
+
+ page = dataPtr->fromUnicode[ch >> 8];
+ if (page == NULL) {
+ page = pageMemPtr;
+ pageMemPtr += 256;
+ dataPtr->fromUnicode[ch >> 8] = page;
+ }
+ page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
+ }
+ }
+ }
+ }
+ if (type == ENCODING_MULTIBYTE) {
+ /*
+ * If multibyte encodings don't have a backslash character, define
+ * one. Otherwise, on Windows, native file names won't work because
+ * the backslash in the file name will map to the unknown character
+ * (question mark) when converting from UTF-8 to external encoding.
+ */
+
+ if (dataPtr->fromUnicode[0] != NULL) {
+ if (dataPtr->fromUnicode[0]['\\'] == '\0') {
+ dataPtr->fromUnicode[0]['\\'] = '\\';
+ }
+ }
+ }
+ if (symbol) {
+ unsigned short *page;
+
+ /*
+ * Make a special symbol encoding that not only maps the symbol
+ * characters from their Unicode code points down into page 0, but
+ * also ensure that the characters on page 0 map to themselves.
+ * This is so that a symbol font can be used to display a simple
+ * string like "abcd" and have alpha, beta, chi, delta show up,
+ * rather than have "unknown" chars show up because strictly
+ * speaking the symbol font doesn't have glyphs for those low ascii
+ * chars.
+ */
+
+ page = dataPtr->fromUnicode[0];
+ if (page == NULL) {
+ page = pageMemPtr;
+ dataPtr->fromUnicode[0] = page;
+ }
+ for (lo = 0; lo < 256; lo++) {
+ if (dataPtr->toUnicode[0][lo] != 0) {
+ page[lo] = (unsigned short) lo;
+ }
+ }
+ }
+ for (hi = 0; hi < 256; hi++) {
+ if (dataPtr->fromUnicode[hi] == NULL) {
+ dataPtr->fromUnicode[hi] = emptyPage;
+ }
+ }
+ encType.encodingName = name;
+ encType.toUtfProc = TableToUtfProc;
+ encType.fromUtfProc = TableFromUtfProc;
+ encType.freeProc = TableFreeProc;
+ encType.nullSize = (type == ENCODING_DOUBLEBYTE) ? 2 : 1;
+ encType.clientData = (ClientData) dataPtr;
+ return Tcl_CreateEncoding(&encType);
+
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * LoadEscapeEncoding --
+ *
+ * Helper function for LoadEncodingTable(). Loads a state machine
+ * that converts between Unicode and some other encoding.
+ *
+ * File contains text data that describes the escape sequences that
+ * are used to choose an encoding and the associated names for the
+ * sub-encodings.
+ *
+ * Results:
+ * The return value is the new encoding, or NULL if the encoding
+ * could not be created (because the file contained invalid data).
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Encoding
+LoadEscapeEncoding(name, chan)
+ CONST char *name; /* Name for new encoding. */
+ Tcl_Channel chan; /* File containing new encoding. */
+{
+ int i;
+ unsigned int size;
+ Tcl_DString escapeData;
+ char init[16], final[16];
+ EscapeEncodingData *dataPtr;
+ Tcl_EncodingType type;
+
+ init[0] = '\0';
+ final[0] = '\0';
+ Tcl_DStringInit(&escapeData);
+
+ while (1) {
+ int argc;
+ char **argv;
+ char *line;
+ Tcl_DString lineString;
+
+ Tcl_DStringInit(&lineString);
+ if (Tcl_Gets(chan, &lineString) < 0) {
+ break;
+ }
+ line = Tcl_DStringValue(&lineString);
+ if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
+ continue;
+ }
+ if (argc >= 2) {
+ if (strcmp(argv[0], "name") == 0) {
+ ;
+ } else if (strcmp(argv[0], "init") == 0) {
+ strncpy(init, argv[1], sizeof(init));
+ init[sizeof(init) - 1] = '\0';
+ } else if (strcmp(argv[0], "final") == 0) {
+ strncpy(final, argv[1], sizeof(final));
+ final[sizeof(final) - 1] = '\0';
+ } else {
+ EscapeSubTable est;
+
+ strncpy(est.sequence, argv[1], sizeof(est.sequence));
+ est.sequence[sizeof(est.sequence) - 1] = '\0';
+ est.sequenceLen = strlen(est.sequence);
+
+ strncpy(est.name, argv[0], sizeof(est.name));
+ est.name[sizeof(est.name) - 1] = '\0';
+
+ est.encodingPtr = NULL;
+ Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
+ }
+ }
+ ckfree((char *) argv);
+ Tcl_DStringFree(&lineString);
+ }
+
+ size = sizeof(EscapeEncodingData)
+ - sizeof(EscapeSubTable) + Tcl_DStringLength(&escapeData);
+ dataPtr = (EscapeEncodingData *) ckalloc(size);
+ dataPtr->initLen = strlen(init);
+ strcpy(dataPtr->init, init);
+ dataPtr->finalLen = strlen(final);
+ strcpy(dataPtr->final, final);
+ dataPtr->numSubTables = Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
+ memcpy((VOID *) dataPtr->subTables, (VOID *) Tcl_DStringValue(&escapeData),
+ (size_t) Tcl_DStringLength(&escapeData));
+ Tcl_DStringFree(&escapeData);
+
+ memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
+ for (i = 0; i < dataPtr->numSubTables; i++) {
+ dataPtr->prefixBytes[UCHAR(dataPtr->subTables[i].sequence[0])] = 1;
+ }
+ if (dataPtr->init[0] != '\0') {
+ dataPtr->prefixBytes[UCHAR(dataPtr->init[0])] = 1;
+ }
+ if (dataPtr->final[0] != '\0') {
+ dataPtr->prefixBytes[UCHAR(dataPtr->final[0])] = 1;
+ }
+
+ type.encodingName = name;
+ type.toUtfProc = EscapeToUtfProc;
+ type.fromUtfProc = EscapeFromUtfProc;
+ type.freeProc = EscapeFreeProc;
+ type.nullSize = 1;
+ type.clientData = (ClientData) dataPtr;
+
+ return Tcl_CreateEncoding(&type);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * BinaryProc --
+ *
+ * The default conversion when no other conversion is specified.
+ * No translation is done; source bytes are copied directly to
+ * destination bytes.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+BinaryProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* Not used. */
+ CONST char *src; /* Source string (unknown encoding). */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ int result;
+
+ result = TCL_OK;
+ dstLen -= TCL_UTF_MAX - 1;
+ if (dstLen < 0) {
+ dstLen = 0;
+ }
+ if (srcLen > dstLen) {
+ srcLen = dstLen;
+ result = TCL_CONVERT_NOSPACE;
+ }
+
+ *srcReadPtr = srcLen;
+ *dstWrotePtr = srcLen;
+ *dstCharsPtr = srcLen;
+ for ( ; --srcLen >= 0; ) {
+ *dst++ = *src++;
+ }
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * UtfToUtfProc --
+ *
+ * Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8
+ * translation is not a no-op, because it will turn a stream of
+ * improperly formed UTF-8 into a properly formed stream.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* Not used. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *srcStart, *srcEnd, *srcClose;
+ char *dstStart, *dstEnd;
+ int result, numChars;
+ Tcl_UniChar ch;
+
+ result = TCL_OK;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+ srcClose = srcEnd;
+ if ((flags & TCL_ENCODING_END) == 0) {
+ srcClose -= TCL_UTF_MAX;
+ }
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - TCL_UTF_MAX;
+
+ for (numChars = 0; src < srcEnd; numChars++) {
+ if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+ /*
+ * If there is more string to follow, this will ensure that the
+ * last UTF-8 character in the source buffer hasn't been cut off.
+ */
+
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ src += Tcl_UtfToUniChar(src, &ch);
+ dst += Tcl_UniCharToUtf(ch, dst);
+ }
+
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * UnicodeToUtfProc --
+ *
+ * Convert from Unicode to UTF-8.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+UnicodeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* Not used. */
+ CONST char *src; /* Source string in Unicode. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST Tcl_UniChar *wSrc, *wSrcStart, *wSrcEnd;
+ char *dstEnd, *dstStart;
+ int result, numChars;
+
+ result = TCL_OK;
+ if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
+ result = TCL_CONVERT_MULTIBYTE;
+ srcLen /= sizeof(Tcl_UniChar);
+ srcLen *= sizeof(Tcl_UniChar);
+ }
+
+ wSrc = (Tcl_UniChar *) src;
+
+ wSrcStart = (Tcl_UniChar *) src;
+ wSrcEnd = (Tcl_UniChar *) (src + srcLen);
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - TCL_UTF_MAX;
+
+ for (numChars = 0; wSrc < wSrcEnd; numChars++) {
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ dst += Tcl_UniCharToUtf(*wSrc, dst);
+ wSrc++;
+ }
+
+ *srcReadPtr = (char *) wSrc - (char *) wSrcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * UtfToUnicodeProc --
+ *
+ * Convert from UTF-8 to Unicode.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+UtfToUnicodeProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* TableEncodingData that specifies encoding. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *srcStart, *srcEnd, *srcClose;
+ Tcl_UniChar *wDst, *wDstStart, *wDstEnd;
+ int result, numChars;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+ srcClose = srcEnd;
+ if ((flags & TCL_ENCODING_END) == 0) {
+ srcClose -= TCL_UTF_MAX;
+ }
+
+ wDst = (Tcl_UniChar *) dst;
+ wDstStart = (Tcl_UniChar *) dst;
+ wDstEnd = (Tcl_UniChar *) (dst + dstLen - sizeof(Tcl_UniChar));
+
+ result = TCL_OK;
+ for (numChars = 0; src < srcEnd; numChars++) {
+ if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+ /*
+ * If there is more string to follow, this will ensure that the
+ * last UTF-8 character in the source buffer hasn't been cut off.
+ */
+
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ if (wDst > wDstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ src += Tcl_UtfToUniChar(src, wDst);
+ wDst++;
+ }
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = (char *) wDst - (char *) wDstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TableToUtfProc --
+ *
+ * Convert from the encoding specified by the TableEncodingData into
+ * UTF-8.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* TableEncodingData that specifies
+ * encoding. */
+ CONST char *src; /* Source string in specified encoding. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *srcStart, *srcEnd;
+ char *dstEnd, *dstStart, *prefixBytes;
+ int result, byte, numChars;
+ Tcl_UniChar ch;
+ unsigned short **toUnicode;
+ unsigned short *pageZero;
+ TableEncodingData *dataPtr;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - TCL_UTF_MAX;
+
+ dataPtr = (TableEncodingData *) clientData;
+ toUnicode = dataPtr->toUnicode;
+ prefixBytes = dataPtr->prefixBytes;
+ pageZero = toUnicode[0];
+
+ result = TCL_OK;
+ for (numChars = 0; src < srcEnd; numChars++) {
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ byte = *((unsigned char *) src);
+ if (prefixBytes[byte]) {
+ src++;
+ if (src >= srcEnd) {
+ src--;
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ ch = toUnicode[byte][*((unsigned char *) src)];
+ } else {
+ ch = pageZero[byte];
+ }
+ if ((ch == 0) && (byte != 0)) {
+ if (flags & TCL_ENCODING_STOPONERROR) {
+ result = TCL_CONVERT_SYNTAX;
+ break;
+ }
+ if (prefixBytes[byte]) {
+ src--;
+ }
+ ch = (Tcl_UniChar) byte;
+ }
+ dst += Tcl_UniCharToUtf(ch, dst);
+ src++;
+ }
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TableFromUtfProc --
+ *
+ * Convert from UTF-8 into the encoding specified by the
+ * TableEncodingData.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+TableFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* TableEncodingData that specifies
+ * encoding. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *srcStart, *srcEnd, *srcClose;
+ char *dstStart, *dstEnd, *prefixBytes;
+ Tcl_UniChar ch;
+ int result, len, word, numChars;
+ TableEncodingData *dataPtr;
+ unsigned short **fromUnicode;
+
+ result = TCL_OK;
+
+ dataPtr = (TableEncodingData *) clientData;
+ prefixBytes = dataPtr->prefixBytes;
+ fromUnicode = dataPtr->fromUnicode;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+ srcClose = srcEnd;
+ if ((flags & TCL_ENCODING_END) == 0) {
+ srcClose -= TCL_UTF_MAX;
+ }
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - 1;
+
+ for (numChars = 0; src < srcEnd; numChars++) {
+ if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+ /*
+ * If there is more string to follow, this will ensure that the
+ * last UTF-8 character in the source buffer hasn't been cut off.
+ */
+
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ len = Tcl_UtfToUniChar(src, &ch);
+ word = fromUnicode[(ch >> 8)][ch & 0xff];
+ if ((word == 0) && (ch != 0)) {
+ if (flags & TCL_ENCODING_STOPONERROR) {
+ result = TCL_CONVERT_UNKNOWN;
+ break;
+ }
+ word = dataPtr->fallback;
+ }
+ if (prefixBytes[(word >> 8)] != 0) {
+ if (dst + 1 > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ dst[0] = (char) (word >> 8);
+ dst[1] = (char) word;
+ dst += 2;
+ } else {
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ dst[0] = (char) word;
+ dst++;
+ }
+ src += len;
+ }
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TableFreeProc --
+ *
+ * This procedure is invoked when an encoding is deleted. It deletes
+ * the memory used by the TableEncodingData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TableFreeProc(clientData)
+ ClientData clientData; /* TableEncodingData that specifies
+ * encoding. */
+{
+ TableEncodingData *dataPtr;
+
+ dataPtr = (TableEncodingData *) clientData;
+ ckfree((char *) dataPtr->toUnicode);
+ ckfree((char *) dataPtr->fromUnicode);
+ ckfree((char *) dataPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * EscapeToUtfProc --
+ *
+ * Convert from the encoding specified by the EscapeEncodingData into
+ * UTF-8.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* EscapeEncodingData that specifies
+ * encoding. */
+ CONST char *src; /* Source string in specified encoding. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ EscapeEncodingData *dataPtr;
+ char *prefixBytes, *tablePrefixBytes;
+ unsigned short **tableToUnicode;
+ Encoding *encodingPtr;
+ int state, result, numChars;
+ CONST char *srcStart, *srcEnd;
+ char *dstStart, *dstEnd;
+
+ result = TCL_OK;
+
+ tablePrefixBytes = NULL; /* lint. */
+ tableToUnicode = NULL; /* lint. */
+
+ dataPtr = (EscapeEncodingData *) clientData;
+ prefixBytes = dataPtr->prefixBytes;
+ encodingPtr = NULL;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - TCL_UTF_MAX;
+
+ state = (int) *statePtr;
+ if (flags & TCL_ENCODING_START) {
+ state = 0;
+ }
+
+ for (numChars = 0; src < srcEnd; ) {
+ int byte, hi, lo, ch;
+
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ byte = *((unsigned char *) src);
+ if (prefixBytes[byte]) {
+ unsigned int left, len, longest;
+ int checked, i;
+ EscapeSubTable *subTablePtr;
+
+ /*
+ * Saw the beginning of an escape sequence.
+ */
+
+ left = srcEnd - src;
+ len = dataPtr->initLen;
+ longest = len;
+ checked = 0;
+ if (len <= left) {
+ checked++;
+ if ((len > 0) &&
+ (memcmp(src, dataPtr->init, len) == 0)) {
+ /*
+ * If we see initialization string, skip it, even if we're
+ * not at the beginning of the buffer.
+ */
+
+ src += len;
+ continue;
+ }
+ }
+ len = dataPtr->finalLen;
+ if (len > longest) {
+ longest = len;
+ }
+ if (len <= left) {
+ checked++;
+ if ((len > 0) &&
+ (memcmp(src, dataPtr->final, len) == 0)) {
+ /*
+ * If we see finalization string, skip it, even if we're
+ * not at the end of the buffer.
+ */
+
+ src += len;
+ continue;
+ }
+ }
+ subTablePtr = dataPtr->subTables;
+ for (i = 0; i < dataPtr->numSubTables; i++) {
+ len = subTablePtr->sequenceLen;
+ if (len > longest) {
+ longest = len;
+ }
+ if (len <= left) {
+ checked++;
+ if ((len > 0) &&
+ (memcmp(src, subTablePtr->sequence, len) == 0)) {
+ state = i;
+ encodingPtr = NULL;
+ subTablePtr = NULL;
+ src += len;
+ break;
+ }
+ }
+ subTablePtr++;
+ }
+ if (subTablePtr == NULL) {
+ /*
+ * A match was found, the escape sequence was consumed, and
+ * the state was updated.
+ */
+
+ continue;
+ }
+
+ /*
+ * We have a split-up or unrecognized escape sequence. If we
+ * checked all the sequences, then it's a syntax error,
+ * otherwise we need more bytes to determine a match.
+ */
+
+ if ((checked == dataPtr->numSubTables + 2)
+ || (flags & TCL_ENCODING_END)) {
+ if ((flags & TCL_ENCODING_STOPONERROR) == 0) {
+ /*
+ * Skip the unknown escape sequence.
+ */
+
+ src += longest;
+ continue;
+ }
+ result = TCL_CONVERT_SYNTAX;
+ } else {
+ result = TCL_CONVERT_MULTIBYTE;
+ }
+ break;
+ }
+
+ if (encodingPtr == NULL) {
+ TableEncodingData *tableDataPtr;
+
+ encodingPtr = GetTableEncoding(dataPtr, state);
+ tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+ tablePrefixBytes = tableDataPtr->prefixBytes;
+ tableToUnicode = tableDataPtr->toUnicode;
+ }
+ if (tablePrefixBytes[byte]) {
+ src++;
+ if (src >= srcEnd) {
+ src--;
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ hi = byte;
+ lo = *((unsigned char *) src);
+ } else {
+ hi = 0;
+ lo = byte;
+ }
+ ch = tableToUnicode[hi][lo];
+ dst += Tcl_UniCharToUtf(ch, dst);
+ src++;
+ numChars++;
+ }
+
+ *statePtr = (Tcl_EncodingState) state;
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * EscapeFromUtfProc --
+ *
+ * Convert from UTF-8 into the encoding specified by the
+ * EscapeEncodingData.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* EscapeEncodingData that specifies
+ * encoding. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ EscapeEncodingData *dataPtr;
+ Encoding *encodingPtr;
+ CONST char *srcStart, *srcEnd, *srcClose;
+ char *dstStart, *dstEnd;
+ int state, result, numChars;
+ TableEncodingData *tableDataPtr;
+ char *tablePrefixBytes;
+ unsigned short **tableFromUnicode;
+
+ result = TCL_OK;
+
+ dataPtr = (EscapeEncodingData *) clientData;
+
+ srcStart = src;
+ srcEnd = src + srcLen;
+ srcClose = srcEnd;
+ if ((flags & TCL_ENCODING_END) == 0) {
+ srcClose -= TCL_UTF_MAX;
+ }
+
+ dstStart = dst;
+ dstEnd = dst + dstLen - 1;
+
+ if (flags & TCL_ENCODING_START) {
+ unsigned int len;
+
+ state = 0;
+ len = dataPtr->subTables[0].sequenceLen;
+ if (dst + dataPtr->initLen + len > dstEnd) {
+ *srcReadPtr = 0;
+ *dstWrotePtr = 0;
+ return TCL_CONVERT_NOSPACE;
+ }
+ memcpy((VOID *) dst, (VOID *) dataPtr->init,
+ (size_t) dataPtr->initLen);
+ dst += dataPtr->initLen;
+ memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
+ (size_t) len);
+ dst += len;
+ } else {
+ state = (int) *statePtr;
+ }
+
+ encodingPtr = GetTableEncoding(dataPtr, state);
+ tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+ tablePrefixBytes = tableDataPtr->prefixBytes;
+ tableFromUnicode = tableDataPtr->fromUnicode;
+
+ for (numChars = 0; src < srcEnd; numChars++) {
+ unsigned int len;
+ int word;
+ Tcl_UniChar ch;
+
+ if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
+ /*
+ * If there is more string to follow, this will ensure that the
+ * last UTF-8 character in the source buffer hasn't been cut off.
+ */
+
+ result = TCL_CONVERT_MULTIBYTE;
+ break;
+ }
+ len = Tcl_UtfToUniChar(src, &ch);
+ word = tableFromUnicode[(ch >> 8)][ch & 0xff];
+
+ if ((word == 0) && (ch != 0)) {
+ int oldState;
+ EscapeSubTable *subTablePtr;
+
+ oldState = state;
+ for (state = 0; state < dataPtr->numSubTables; state++) {
+ encodingPtr = GetTableEncoding(dataPtr, state);
+ tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+ word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
+ if (word != 0) {
+ break;
+ }
+ }
+
+ if (word == 0) {
+ state = oldState;
+ if (flags & TCL_ENCODING_STOPONERROR) {
+ result = TCL_CONVERT_UNKNOWN;
+ break;
+ }
+ encodingPtr = GetTableEncoding(dataPtr, state);
+ tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+ word = tableDataPtr->fallback;
+ }
+
+ tablePrefixBytes = tableDataPtr->prefixBytes;
+ tableFromUnicode = tableDataPtr->fromUnicode;
+
+ subTablePtr = &dataPtr->subTables[state];
+ if (dst + subTablePtr->sequenceLen > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ memcpy((VOID *) dst, (VOID *) subTablePtr->sequence,
+ (size_t) subTablePtr->sequenceLen);
+ dst += subTablePtr->sequenceLen;
+ }
+
+ if (tablePrefixBytes[(word >> 8)] != 0) {
+ if (dst + 1 > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ dst[0] = (char) (word >> 8);
+ dst[1] = (char) word;
+ dst += 2;
+ } else {
+ if (dst > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ dst[0] = (char) word;
+ dst++;
+ }
+ src += len;
+ }
+
+ if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
+ if (dst + dataPtr->finalLen > dstEnd) {
+ result = TCL_CONVERT_NOSPACE;
+ } else {
+ memcpy((VOID *) dst, (VOID *) dataPtr->final,
+ (size_t) dataPtr->finalLen);
+ dst += dataPtr->finalLen;
+ }
+ }
+
+ *statePtr = (Tcl_EncodingState) state;
+ *srcReadPtr = src - srcStart;
+ *dstWrotePtr = dst - dstStart;
+ *dstCharsPtr = numChars;
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EscapeFreeProc --
+ *
+ * This procedure is invoked when an EscapeEncodingData encoding is
+ * deleted. It deletes the memory used by the encoding.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+EscapeFreeProc(clientData)
+ ClientData clientData; /* EscapeEncodingData that specifies encoding. */
+{
+ EscapeEncodingData *dataPtr;
+ EscapeSubTable *subTablePtr;
+ int i;
+
+ dataPtr = (EscapeEncodingData *) clientData;
+ if (dataPtr == NULL) {
+ return;
+ }
+ subTablePtr = dataPtr->subTables;
+ for (i = 0; i < dataPtr->numSubTables; i++) {
+ FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
+ subTablePtr++;
+ }
+ ckfree((char *) dataPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetTableEncoding --
+ *
+ * Helper function for the EscapeEncodingData conversions. Gets the
+ * encoding (of type TextEncodingData) that represents the specified
+ * state.
+ *
+ * Results:
+ * The return value is the encoding.
+ *
+ * Side effects:
+ * If the encoding that represents the specified state has not
+ * already been used by this EscapeEncoding, it will be loaded
+ * and cached in the dataPtr.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Encoding *
+GetTableEncoding(dataPtr, state)
+ EscapeEncodingData *dataPtr;/* Contains names of encodings. */
+ int state; /* Index in dataPtr of desired Encoding. */
+{
+ EscapeSubTable *subTablePtr;
+ Encoding *encodingPtr;
+
+ subTablePtr = &dataPtr->subTables[state];
+ encodingPtr = subTablePtr->encodingPtr;
+ if (encodingPtr == NULL) {
+ encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name);
+ if ((encodingPtr == NULL)
+ || (encodingPtr->toUtfProc != TableToUtfProc)) {
+ panic("EscapeToUtfProc: invalid sub table");
+ }
+ subTablePtr->encodingPtr = encodingPtr;
+ }
+ return encodingPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * unilen --
+ *
+ * A helper function for the Tcl_ExternalToUtf functions. This
+ * function is similar to strlen for double-byte characters: it
+ * returns the number of bytes in a 0x0000 terminated string.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static size_t
+unilen(src)
+ CONST char *src;
+{
+ unsigned short *p;
+
+ p = (unsigned short *) src;
+ while (*p != 0x0000) {
+ p++;
+ }
+ return (char *) p - src;
+}
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclFindEncodings --
+ *
+ * Find and load the encoding file for this operating system.
+ * Before this is called, Tcl makes assumptions about the
+ * native string representation, but the true encoding is not
+ * assured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Varied, see the respective initialization routines.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclFindEncodings(argv0)
+ CONST char *argv0; /* Name of executable from argv[0] to main()
+ * in native multi-byte encoding. */
+{
+ char *native;
+ Tcl_Obj *pathPtr;
+ Tcl_DString libPath, buffer;
+
+ if (encodingsInitialized == 0) {
+ /*
+ * Double check inside the mutex. There may be calls
+ * back into this routine from some of the procedures below.
+ */
+
+ TclpInitLock();
+ if (encodingsInitialized == 0) {
+ /*
+ * Have to set this bit here to avoid deadlock with the
+ * routines below us that call into TclInitSubsystems.
+ */
+
+ encodingsInitialized = 1;
+
+ native = TclpFindExecutable(argv0);
+ TclpInitLibraryPath(native);
+
+ /*
+ * The library path was set in the TclpInitLibraryPath routine.
+ * The string set is a dirty UTF string. To preserve the value
+ * convert the UTF string back to native before setting the new
+ * default encoding.
+ */
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1,
+ &libPath);
+ }
+
+ TclpSetInitialEncodings();
+
+ /*
+ * Now convert the native string back to UTF.
+ */
+
+ if (pathPtr != NULL) {
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&libPath), -1,
+ &buffer);
+ pathPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer), -1);
+ TclSetLibraryPath(pathPtr);
+
+ Tcl_DStringFree(&libPath);
+ Tcl_DStringFree(&buffer);
+ }
+ }
+ TclpInitUnlock();
+ }
+}
+
diff --git a/tcl/generic/tclEnv.c b/tcl/generic/tclEnv.c
index d7532582acb..994bc292dbd 100644
--- a/tcl/generic/tclEnv.c
+++ b/tcl/generic/tclEnv.c
@@ -7,7 +7,7 @@
* the "env" arrays in sync with the system environment variables.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -18,41 +18,29 @@
#include "tclInt.h"
#include "tclPort.h"
+TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */
+
/* CYGNUS LOCAL */
#ifdef __CYGWIN32__
/* On cygwin32, the environment is imported from the cygwin32 DLL. */
-extern char ***_imp____cygwin_environ;
+__declspec(dllimport) extern char **__cygwin_environ;
-#define environ (*_imp____cygwin_environ)
+#define environ (__cygwin_environ)
/* We need to use a special putenv function to handle PATH. */
#ifndef USE_PUTENV
#define USE_PUTENV
#endif
#define putenv TclCygwin32Putenv
-
#endif
/* END CYGNUS LOCAL */
-/*
- * The structure below is used to keep track of all of the interpereters
- * for which we're managing the "env" array. It's needed so that they
- * can all be updated whenever an environment variable is changed
- * anywhere.
- */
-
-typedef struct EnvInterp {
- Tcl_Interp *interp; /* Interpreter for which we're managing
- * the env array. */
- struct EnvInterp *nextPtr; /* Next in list of all such interpreters,
- * or zero. */
-} EnvInterp;
+#ifdef TCL_THREADS
-static EnvInterp *firstInterpPtr = NULL;
- /* First in list of all managed interpreters,
- * or NULL if none. */
+static Tcl_Mutex envMutex; /* To serialize access to environ */
+#endif
static int cacheSize = 0; /* Number of env strings in environCache. */
static char **environCache = NULL;
@@ -68,14 +56,20 @@ static int environSize = 0; /* Non-zero means that the environ array was
#endif
/*
+ * For MacOS X
+ */
+#if defined(__APPLE__) && defined(__DYNAMIC__)
+#include <crt_externs.h>
+char **environ = NULL;
+#endif
+
+/*
* Declarations for local procedures defined in this file:
*/
static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
-static int FindVariable _ANSI_ARGS_((CONST char *name,
- int *lengthPtr));
static void ReplaceString _ANSI_ARGS_((CONST char *oldStr,
char *newStr));
void TclSetEnv _ANSI_ARGS_((CONST char *name,
@@ -103,7 +97,7 @@ static void TclCygwin32Putenv _ANSI_ARGS_((CONST char *string));
* The interpreter is added to a list of interpreters managed
* by us, so that its view of envariables can be kept consistent
* with the view in other interpreters. If this is the first
- * call to Tcl_SetupEnv, then additional initialization happens,
+ * call to TclSetupEnv, then additional initialization happens,
* such as copying the environment to dynamically-allocated space
* for ease of management.
*
@@ -115,73 +109,66 @@ TclSetupEnv(interp)
Tcl_Interp *interp; /* Interpreter whose "env" array is to be
* managed. */
{
- EnvInterp *eiPtr;
- char *p, *p2;
- Tcl_DString ds;
- int i, sz;
-
-#ifdef MAC_TCL
- if (environ == NULL) {
- environSize = TclMacCreateEnv();
- }
-#endif
-
- /*
- * Next, initialize the DString we are going to use for copying
- * the names of the environment variables.
- */
+ Tcl_DString envString;
+ char *p1, *p2;
+ int i;
- Tcl_DStringInit(&ds);
-
/*
- * Next, add the interpreter to the list of those that we manage.
+ * For MacOS X
*/
-
- eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
- eiPtr->interp = interp;
- eiPtr->nextPtr = firstInterpPtr;
- firstInterpPtr = eiPtr;
+#if defined(__APPLE__) && defined(__DYNAMIC__)
+ environ = *_NSGetEnviron();
+#endif
/*
- * Store the environment variable values into the interpreter's
- * "env" array, and arrange for us to be notified on future
- * writes and unsets to that array.
+ * 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.
*/
-
- (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
- for (i = 0; ; i++) {
- p = environ[i];
- if (p == NULL) {
- break;
- }
- for (p2 = p; *p2 != '='; p2++) {
- if (*p2 == 0) {
+
+ Tcl_UntraceVar2(interp, "env", (char *) NULL,
+ TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+ TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
+ (ClientData) NULL);
+
+ Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
+
+ if (environ[0] == NULL) {
+ Tcl_Obj *varNamePtr;
+
+ varNamePtr = Tcl_NewStringObj("env", -1);
+ Tcl_IncrRefCount(varNamePtr);
+ TclArraySet(interp, varNamePtr, NULL);
+ Tcl_DecrRefCount(varNamePtr);
+ } else {
+ Tcl_MutexLock(&envMutex);
+ for (i = 0; environ[i] != NULL; i++) {
+ p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
+ p2 = strchr(p1, '=');
+ if (p2 == NULL) {
/*
- * This condition doesn't seem like it should ever happen,
- * but it does seem to happen occasionally under some
+ * This condition seem to happen occasionally under some
* versions of Solaris; ignore the entry.
*/
-
- goto nextEntry;
+
+ continue;
}
+ p2++;
+ p2[-1] = '\0';
+ Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&envString);
}
- sz = p2 - p;
- Tcl_DStringSetLength(&ds, 0);
- Tcl_DStringAppend(&ds, p, sz);
- (void) Tcl_SetVar2(interp, "env", Tcl_DStringValue(&ds),
- p2+1, TCL_GLOBAL_ONLY);
- nextEntry:
- continue;
+ Tcl_MutexUnlock(&envMutex);
}
- Tcl_TraceVar2(interp, "env", (char *) NULL,
- TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
- EnvTraceProc, (ClientData) NULL);
- /*
- * Finally clean up the DString.
- */
-
- Tcl_DStringFree(&ds);
+ Tcl_TraceVar2(interp, "env", (char *) NULL,
+ TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+ TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
+ (ClientData) NULL);
}
/*
@@ -200,8 +187,7 @@ TclSetupEnv(interp)
* None.
*
* Side effects:
- * The environ array gets updated, as do all of the interpreters
- * that we manage.
+ * The environ array gets updated.
*
*----------------------------------------------------------------------
*/
@@ -209,33 +195,29 @@ TclSetupEnv(interp)
void
TclSetEnv(name, value)
CONST char *name; /* Name of variable whose value is to be
- * set. */
- CONST char *value; /* New value for variable. */
+ * set (UTF-8). */
+ CONST char *value; /* New value for variable (UTF-8). */
{
+ Tcl_DString envString;
int index, length, nameLength;
- char *p, *oldValue;
- EnvInterp *eiPtr;
-
-#ifdef MAC_TCL
- if (environ == NULL) {
- environSize = TclMacCreateEnv();
- }
-#endif
+ char *p, *p2, *oldValue;
/*
* Figure out where the entry is going to go. If the name doesn't
- * already exist, enlarge the array if necessary to make room. If
- * the name exists, free its old entry.
+ * already exist, enlarge the array if necessary to make room. If the
+ * name exists, free its old entry.
*/
- index = FindVariable(name, &length);
+ Tcl_MutexLock(&envMutex);
+ index = TclpFindVariable(name, &length);
+
if (index == -1) {
#ifndef USE_PUTENV
- if ((length+2) > environSize) {
+ if ((length + 2) > environSize) {
char **newEnviron;
newEnviron = (char **) ckalloc((unsigned)
- ((length+5) * sizeof(char *)));
+ ((length + 5) * sizeof(char *)));
/* CYGNUS LOCAL: Added to avoid an error from Purify,
although I don't personally see where the error would
@@ -248,14 +230,16 @@ TclSetEnv(name, value)
ckfree((char *) environ);
}
environ = newEnviron;
- environSize = length+5;
+ environSize = length + 5;
}
index = length;
- environ[index+1] = NULL;
+ environ[index + 1] = NULL;
#endif
oldValue = NULL;
nameLength = strlen(name);
} else {
+ char *env;
+
/*
* Compare the new value to the existing value. If they're
* the same then quit immediately (e.g. don't rewrite the
@@ -264,61 +248,61 @@ TclSetEnv(name, value)
* of the same value among the interpreters.
*/
- if (strcmp(value, environ[index]+length+1) == 0) {
+ env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
+ if (strcmp(value, (env + length + 1)) == 0) {
+ Tcl_DStringFree(&envString);
+ Tcl_MutexUnlock(&envMutex);
return;
}
+ Tcl_DStringFree(&envString);
+
oldValue = environ[index];
nameLength = length;
}
/*
- * Create a new entry.
+ * Create a new entry. Build a complete UTF string that contains
+ * a "name=value" pattern. Then convert the string to the native
+ * encoding, and set the environ array value.
*/
p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
strcpy(p, name);
p[nameLength] = '=';
strcpy(p+nameLength+1, value);
+ p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
/*
- * Update the system environment.
+ * Copy the native string to heap memory.
*/
+
+ p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
+ strcpy(p, p2);
+ Tcl_DStringFree(&envString);
#ifdef USE_PUTENV
+ /*
+ * Update the system environment.
+ */
+
putenv(p);
+ index = TclpFindVariable(name, &length);
#else
environ[index] = p;
#endif
/*
- * Replace the old value with the new value in the cache.
- */
-
- ReplaceString(oldValue, p);
-
- /*
- * Update all of the interpreters.
+ * Watch out for versions of putenv that copy the string (e.g. VC++).
+ * In this case we need to free the string immediately. Otherwise
+ * update the string in the cache.
*/
- /* CYGNUS LOCAL: The original code was bogus. If we are being
- called because of a trace on the env array, then the call to
- Tcl_SetVar2 would free value. We avoid that by checking
- whether the value is the same before calling Tcl_SetVar2.
-
- NOTE: This is not necessary in tcl8.1a2 which handles this in a
- completely different, and better, way. */
-
- for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
- CONST char *v;
-
- v = Tcl_GetVar2(eiPtr->interp, "env", (char *) name, TCL_GLOBAL_ONLY);
- if (v == NULL || (v != value && strcmp (v, value) != 0)) {
- (void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name,
- (char *) value, TCL_GLOBAL_ONLY);
- }
+ if ((index != -1) && (environ[index] == p)) {
+ ReplaceString(oldValue, p);
}
+ Tcl_MutexUnlock(&envMutex);
}
/*
@@ -347,8 +331,9 @@ TclSetEnv(name, value)
int
Tcl_PutEnv(string)
CONST char *string; /* Info about environment variable in the
- * form NAME=value. */
+ * form NAME=value. (native) */
{
+ Tcl_DString nameString;
int nameLength;
char *name, *value;
@@ -357,23 +342,24 @@ Tcl_PutEnv(string)
}
/*
- * Separate the string into name and value parts, then call
- * TclSetEnv to do all of the real work.
+ * First convert the native string to UTF. Then separate the
+ * string into name and value parts, and call TclSetEnv to do
+ * all of the real work.
*/
- value = strchr(string, '=');
+ name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString);
+ value = strchr(name, '=');
if (value == NULL) {
return 0;
}
- nameLength = value - string;
+ nameLength = value - name;
if (nameLength == 0) {
return 0;
}
- name = (char *) ckalloc((unsigned) nameLength+1);
- memcpy((VOID *) name, (VOID *) string, (size_t) nameLength);
- name[nameLength] = 0;
+
+ value[0] = '\0';
TclSetEnv(name, value+1);
- ckfree(name);
+ Tcl_DStringFree(&nameString);
return 0;
}
@@ -399,24 +385,20 @@ Tcl_PutEnv(string)
void
TclUnsetEnv(name)
- CONST char *name; /* Name of variable to remove. */
+ CONST char *name; /* Name of variable to remove (UTF-8). */
{
- EnvInterp *eiPtr;
char *oldValue;
- int length, index;
+ unsigned int length;
+ int index;
#ifdef USE_PUTENV
+ Tcl_DString envString;
char *string;
#else
char **envPtr;
#endif
-#ifdef MAC_TCL
- if (environ == NULL) {
- environSize = TclMacCreateEnv();
- }
-#endif
-
- index = FindVariable(name, &length);
+ Tcl_MutexLock(&envMutex);
+ index = TclpFindVariable(name, &length);
/*
* First make sure that the environment variable exists to avoid
@@ -424,6 +406,7 @@ TclUnsetEnv(name)
*/
if (index == -1) {
+ Tcl_MutexUnlock(&envMutex);
return;
}
/*
@@ -442,8 +425,23 @@ TclUnsetEnv(name)
memcpy((VOID *) string, (VOID *) name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
+
+ Tcl_UtfToExternalDString(NULL, string, -1, &envString);
+ string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
+ strcpy(string, Tcl_DStringValue(&envString));
+ Tcl_DStringFree(&envString);
+
putenv(string);
- ckfree(string);
+
+ /*
+ * Watch out for versions of putenv that copy the string (e.g. VC++).
+ * In this case we need to free the string immediately. Otherwise
+ * update the string in the cache.
+ */
+
+ if (environ[index] == string) {
+ ReplaceString(oldValue, string);
+ }
#else
for (envPtr = environ+index+1; ; envPtr++) {
envPtr[-1] = *envPtr;
@@ -451,34 +449,25 @@ TclUnsetEnv(name)
break;
}
}
-#endif
-
- /*
- * Replace the old value in the cache.
- */
-
ReplaceString(oldValue, NULL);
+#endif
- /*
- * Update all of the interpreters.
- */
-
- for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
- (void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *) name,
- TCL_GLOBAL_ONLY);
- }
+ Tcl_MutexUnlock(&envMutex);
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TclGetEnv --
*
* Retrieve the value of an environment variable.
*
* Results:
- * Returns a pointer to a static string in the environment,
- * or NULL if the value was not found.
+ * The result is a pointer to a string specifying the value of the
+ * environment variable, or NULL if that environment variable does
+ * not exist. Storage for the result string is allocated in valuePtr;
+ * the caller must call Tcl_DStringFree() when the result is no
+ * longer needed.
*
* Side effects:
* None.
@@ -487,23 +476,36 @@ TclUnsetEnv(name)
*/
char *
-TclGetEnv(name)
- CONST char *name; /* Name of variable to find. */
+TclGetEnv(name, valuePtr)
+ CONST char *name; /* Name of environment variable to find
+ * (UTF-8). */
+ Tcl_DString *valuePtr; /* Uninitialized or free DString in which
+ * the value of the environment variable is
+ * stored. */
{
int length, index;
+ char *result;
-#ifdef MAC_TCL
- if (environ == NULL) {
- environSize = TclMacCreateEnv();
- }
-#endif
-
- index = FindVariable(name, &length);
- if ((index != -1) && (*(environ[index]+length) == '=')) {
- return environ[index]+length+1;
- } else {
- return NULL;
+ Tcl_MutexLock(&envMutex);
+ index = TclpFindVariable(name, &length);
+ result = NULL;
+ if (index != -1) {
+ Tcl_DString envStr;
+
+ result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
+ result += length;
+ if (*result == '=') {
+ result++;
+ Tcl_DStringInit(valuePtr);
+ Tcl_DStringAppend(valuePtr, result, -1);
+ result = Tcl_DStringValue(valuePtr);
+ } else {
+ result = NULL;
+ }
+ Tcl_DStringFree(&envStr);
}
+ Tcl_MutexUnlock(&envMutex);
+ return result;
}
/*
@@ -512,9 +514,8 @@ TclGetEnv(name)
* EnvTraceProc --
*
* This procedure is invoked whenever an environment variable
- * is modified or deleted. It propagates the change to the
- * "environ" array and to any other interpreters for whom
- * we're managing an "env" array.
+ * is read, modified or deleted. It propagates the change to the global
+ * "environ" array.
*
* Results:
* Always returns NULL to indicate success.
@@ -535,38 +536,24 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
Tcl_Interp *interp; /* Interpreter whose "env" variable is
* being modified. */
char *name1; /* Better be "env". */
- char *name2; /* Name of variable being modified, or
- * NULL if whole array is being deleted. */
+ char *name2; /* Name of variable being modified, or NULL
+ * if whole array is being deleted (UTF-8). */
int flags; /* Indicates what's happening. */
{
/*
- * First see if the whole "env" variable is being deleted. If
- * so, just forget about this interpreter.
+ * For array traces, let TclSetupEnv do all the work.
*/
- if (name2 == NULL) {
- register EnvInterp *eiPtr, *prevPtr;
+ if (flags & TCL_TRACE_ARRAY) {
+ TclSetupEnv(interp);
+ return NULL;
+ }
- if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
- != (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
- panic("EnvTraceProc called with confusing arguments");
- }
- eiPtr = firstInterpPtr;
- if (eiPtr->interp == interp) {
- firstInterpPtr = eiPtr->nextPtr;
- } else {
- for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
- prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
- if (eiPtr == NULL) {
- panic("EnvTraceProc couldn't find interpreter");
- }
- if (eiPtr->interp == interp) {
- prevPtr->nextPtr = eiPtr->nextPtr;
- break;
- }
- }
- }
- ckfree((char *) eiPtr);
+ /*
+ * If name2 is NULL, then return and do nothing.
+ */
+
+ if (name2 == NULL) {
return NULL;
}
@@ -575,9 +562,32 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
*/
if (flags & TCL_TRACE_WRITES) {
- TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
+ char *value;
+
+ value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
+ TclSetEnv(name2, value);
}
+ /*
+ * If a value is being read, call TclGetEnv to do all of the work.
+ */
+
+ if (flags & TCL_TRACE_READS) {
+ Tcl_DString valueString;
+ char *value;
+
+ value = TclGetEnv(name2, &valueString);
+ if (value == NULL) {
+ return "no such variable";
+ }
+ Tcl_SetVar2(interp, name1, name2, value, 0);
+ Tcl_DStringFree(&valueString);
+ }
+
+ /*
+ * For unset traces, let TclUnsetEnv do all the work.
+ */
+
if (flags & TCL_TRACE_UNSETS) {
TclUnsetEnv(name2);
}
@@ -646,7 +656,7 @@ ReplaceString(oldStr, newStr)
* We need to grow the cache in order to hold the new string.
*/
- newCache = (char **) ckalloc((size_t) allocatedSize);
+ newCache = (char **) ckalloc((unsigned) allocatedSize);
(VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
if (environCache) {
@@ -664,50 +674,6 @@ ReplaceString(oldStr, newStr)
/*
*----------------------------------------------------------------------
*
- * FindVariable --
- *
- * Locate the entry in environ for a given name.
- *
- * Results:
- * The return value is the index in environ of an entry with the
- * name "name", or -1 if there is no such entry. The integer at
- * *lengthPtr is filled in with the length of name (if a matching
- * entry is found) or the length of the environ array (if no matching
- * entry is found).
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FindVariable(name, lengthPtr)
- CONST char *name; /* Name of desired environment variable. */
- int *lengthPtr; /* Used to return length of name (for
- * successful searches) or number of non-NULL
- * entries in environ (for unsuccessful
- * searches). */
-{
- int i;
- register CONST char *p1, *p2;
-
- for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
- for (p2 = name; *p2 == *p1; p1++, p2++) {
- /* NULL loop body. */
- }
- if ((*p1 == '=') && (*p2 == '\0')) {
- *lengthPtr = p2-name;
- return i;
- }
- }
- *lengthPtr = i;
- return -1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclFinalizeEnvironment --
*
* This function releases any storage allocated by this module
@@ -747,8 +713,6 @@ TclFinalizeEnvironment()
/* CYGNUS LOCAL */
#ifdef __CYGWIN32__
-#include "windows.h"
-
/* When using cygwin32, when an environment variable changes, we need
to synch with both the cygwin32 environment (in case the
application C code calls fork) and the Windows environment (in case
@@ -827,3 +791,4 @@ TclCygwin32Putenv(str)
#endif /* __CYGWIN32__ */
/* END CYGNUS LOCAL */
+
diff --git a/tcl/generic/tclEvent.c b/tcl/generic/tclEvent.c
index 554878884a3..c4b16abdfce 100644
--- a/tcl/generic/tclEvent.c
+++ b/tcl/generic/tclEvent.c
@@ -6,7 +6,7 @@
* command procedures.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -28,8 +28,9 @@ typedef struct BgError {
Tcl_Interp *interp; /* Interpreter in which error occurred. NULL
* means this error report has been cancelled
* (a previous report generated a break). */
- char *errorMsg; /* The error message (interp->result when
- * the error occurred). Malloc-ed. */
+ char *errorMsg; /* Copy of the error message (the interp's
+ * result when the error occurred).
+ * Malloc-ed. */
char *errorInfo; /* Value of the errorInfo variable
* (malloc-ed). */
char *errorCode; /* Value of the errorCode variable
@@ -66,27 +67,36 @@ typedef struct ExitHandler {
* this application, or NULL for end of list. */
} ExitHandler;
-static ExitHandler *firstExitPtr = NULL;
- /* First in list of all exit handlers for
- * application. */
-
/*
- * The following variable is a "secret" indication to Tcl_Exit that
- * it should dump out the state of memory before exiting. If the
- * value is non-NULL, it gives the name of the file in which to
- * dump memory usage information.
+ * There is both per-process and per-thread exit handlers.
+ * The first list is controlled by a mutex. The other is in
+ * thread local storage.
*/
-char *tclMemDumpFileName = NULL;
+static ExitHandler *firstExitPtr = NULL;
+ /* First in list of all exit handlers for
+ * application. */
+TCL_DECLARE_MUTEX(exitMutex)
/*
- * This variable is set to 1 when Tcl_Exit is called, and at the end of
+ * This variable is set to 1 when Tcl_Finalize is called, and at the end of
* its work, it is reset to 0. The variable is checked by TclInExit() to
* allow different behavior for exit-time processing, e.g. in closing of
* files and pipes.
*/
-static int tclInExit = 0;
+static int inFinalize = 0;
+static int subsystemsInitialized = 0;
+
+typedef struct ThreadSpecificData {
+ ExitHandler *firstExitPtr; /* First in list of all exit handlers for
+ * this thread. */
+ int inExit; /* True when this thread is exiting. This
+ * is used as a hack to decide to close
+ * the standard channels. */
+ Tcl_Obj *tclLibraryPath; /* Path(s) to the Tcl library */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
/*
* Prototypes for procedures referenced only in this file:
@@ -127,6 +137,7 @@ Tcl_BackgroundError(interp)
BgError *errPtr;
char *errResult, *varValue;
ErrAssocData *assocPtr;
+ int length;
/*
* The Tcl_AddErrorInfo call below (with an empty string) ensures that
@@ -138,12 +149,12 @@ Tcl_BackgroundError(interp)
Tcl_AddErrorInfo(interp, "");
- errResult = TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL);
+ errResult = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
errPtr = (BgError *) ckalloc(sizeof(BgError));
errPtr->interp = interp;
- errPtr->errorMsg = (char *) ckalloc((unsigned) (strlen(errResult) + 1));
- strcpy(errPtr->errorMsg, errResult);
+ errPtr->errorMsg = (char *) ckalloc((unsigned) (length + 1));
+ memcpy(errPtr->errorMsg, errResult, (size_t) (length + 1));
varValue = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if (varValue == NULL) {
varValue = errPtr->errorMsg;
@@ -206,7 +217,6 @@ HandleBgErrors(clientData)
ClientData clientData; /* Pointer to ErrAssocData structure. */
{
Tcl_Interp *interp;
- char *command;
char *argv[2];
int code;
BgError *errPtr;
@@ -237,11 +247,10 @@ HandleBgErrors(clientData)
argv[0] = "bgerror";
argv[1] = assocPtr->firstBgPtr->errorMsg;
- command = Tcl_Merge(2, argv);
+
Tcl_AllowExceptions(interp);
Tcl_Preserve((ClientData) interp);
- code = Tcl_GlobalEval(interp, command);
- ckfree(command);
+ code = TclGlobalInvoke(interp, 2, argv, 0);
if (code == TCL_ERROR) {
/*
@@ -256,29 +265,11 @@ HandleBgErrors(clientData)
*/
if (Tcl_IsSafe(interp)) {
- Tcl_HashTable *hTblPtr;
- Tcl_HashEntry *hPtr;
-
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
- "tclHiddenCmds", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- goto doneWithInterp;
- }
- hPtr = Tcl_FindHashEntry(hTblPtr, "bgerror");
- if (hPtr == (Tcl_HashEntry *) NULL) {
- goto doneWithInterp;
- }
-
- /*
- * OK, the hidden command "bgerror" exists, invoke it.
- */
-
- argv[0] = "bgerror";
- argv[1] = ckalloc((unsigned)
- strlen(assocPtr->firstBgPtr->errorMsg));
- strcpy(argv[1], assocPtr->firstBgPtr->errorMsg);
- (void) TclInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);
- ckfree(argv[1]);
+ Tcl_SavedResult save;
+
+ Tcl_SaveResult(interp, &save);
+ TclGlobalInvoke(interp, 2, argv, TCL_INVOKE_HIDDEN);
+ Tcl_RestoreResult(interp, &save);
goto doneWithInterp;
}
@@ -290,22 +281,24 @@ HandleBgErrors(clientData)
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel != (Tcl_Channel) NULL) {
- if (strcmp(interp->result,
- "\"bgerror\" is an invalid command name or ambiguous abbreviation")
- == 0) {
- Tcl_Write(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
- Tcl_Write(errChannel, "\n", -1);
+ char *string;
+ int len;
+
+ string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
+ if (strcmp(string, "\"bgerror\" is an invalid command name or ambiguous abbreviation") == 0) {
+ Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
+ Tcl_WriteChars(errChannel, "\n", -1);
} else {
- Tcl_Write(errChannel,
+ Tcl_WriteChars(errChannel,
"bgerror failed to handle background error.\n",
-1);
- Tcl_Write(errChannel, " Original error: ", -1);
- Tcl_Write(errChannel, assocPtr->firstBgPtr->errorMsg,
+ Tcl_WriteChars(errChannel, " Original error: ", -1);
+ Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorMsg,
-1);
- Tcl_Write(errChannel, "\n", -1);
- Tcl_Write(errChannel, " Error in bgerror: ", -1);
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", -1);
+ Tcl_WriteChars(errChannel, "\n", -1);
+ Tcl_WriteChars(errChannel, " Error in bgerror: ", -1);
+ Tcl_WriteChars(errChannel, string, len);
+ Tcl_WriteChars(errChannel, "\n", -1);
}
Tcl_Flush(errChannel);
}
@@ -416,8 +409,10 @@ Tcl_CreateExitHandler(proc, clientData)
exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
exitPtr->proc = proc;
exitPtr->clientData = clientData;
+ Tcl_MutexLock(&exitMutex);
exitPtr->nextPtr = firstExitPtr;
firstExitPtr = exitPtr;
+ Tcl_MutexUnlock(&exitMutex);
}
/*
@@ -446,6 +441,7 @@ Tcl_DeleteExitHandler(proc, clientData)
{
ExitHandler *exitPtr, *prevPtr;
+ Tcl_MutexLock(&exitMutex);
for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
if ((exitPtr->proc == proc)
@@ -456,6 +452,83 @@ Tcl_DeleteExitHandler(proc, clientData)
prevPtr->nextPtr = exitPtr->nextPtr;
}
ckfree((char *) exitPtr);
+ break;
+ }
+ }
+ Tcl_MutexUnlock(&exitMutex);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateThreadExitHandler --
+ *
+ * Arrange for a given procedure to be invoked just before the
+ * current thread exits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Proc will be invoked with clientData as argument when the
+ * application exits.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateThreadExitHandler(proc, clientData)
+ Tcl_ExitProc *proc; /* Procedure to invoke. */
+ ClientData clientData; /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+ exitPtr->proc = proc;
+ exitPtr->clientData = clientData;
+ exitPtr->nextPtr = tsdPtr->firstExitPtr;
+ tsdPtr->firstExitPtr = exitPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteThreadExitHandler --
+ *
+ * This procedure cancels an existing exit handler matching proc
+ * and clientData, if such a handler exits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there is an exit handler corresponding to proc and clientData
+ * then it is cancelled; if no such handler exists then nothing
+ * happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteThreadExitHandler(proc, clientData)
+ Tcl_ExitProc *proc; /* Procedure that was previously registered. */
+ ClientData clientData; /* Arbitrary value to pass to proc. */
+{
+ ExitHandler *exitPtr, *prevPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
+ prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
+ if ((exitPtr->proc == proc)
+ && (exitPtr->clientData == clientData)) {
+ if (prevPtr == NULL) {
+ tsdPtr->firstExitPtr = exitPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = exitPtr->nextPtr;
+ }
+ ckfree((char *) exitPtr);
return;
}
}
@@ -484,12 +557,165 @@ Tcl_Exit(status)
* 0 for normal return, 1 for error return. */
{
Tcl_Finalize();
-#ifdef TCL_MEM_DEBUG
- if (tclMemDumpFileName != NULL) {
- Tcl_DumpActiveMemory(tclMemDumpFileName);
+ TclpExit(status);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclSetLibraryPath --
+ *
+ * Set the path that will be used for searching for init.tcl and
+ * encodings when an interp is being created.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changing the library path will affect what directories are
+ * examined when looking for encodings for all interps from that
+ * point forward.
+ *
+ * The refcount of the new library path is incremented and the
+ * refcount of the old path is decremented.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclSetLibraryPath(pathPtr)
+ Tcl_Obj *pathPtr; /* A Tcl list object whose elements are
+ * the new library path. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (pathPtr != NULL) {
+ Tcl_IncrRefCount(pathPtr);
+ }
+ if (tsdPtr->tclLibraryPath != NULL) {
+ Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
+ }
+ tsdPtr->tclLibraryPath = pathPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclGetLibraryPath --
+ *
+ * Return a Tcl list object whose elements are the library path.
+ * The caller should not modify the contents of the returned object.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetLibraryPath()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ return tsdPtr->tclLibraryPath;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclInitSubsystems --
+ *
+ * Initialize various subsytems in Tcl. This should be called the
+ * first time an interp is created, or before any of the subsystems
+ * are used. This function ensures an order for the initialization
+ * of subsystems:
+ *
+ * 1. that cannot be initialized in lazy order because they are
+ * mutually dependent.
+ *
+ * 2. so that they can be finalized in a known order w/o causing
+ * the subsequent re-initialization of a subsystem in the act of
+ * shutting down another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Varied, see the respective initialization routines.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclInitSubsystems(argv0)
+ CONST char *argv0; /* Name of executable from argv[0] to main()
+ * in native multi-byte encoding. */
+{
+ ThreadSpecificData *tsdPtr;
+
+ if (inFinalize != 0) {
+ panic("TclInitSubsystems called while finalizing");
}
+
+ /*
+ * Grab the thread local storage pointer before doing anything because
+ * the initialization routines will be registering exit handlers.
+ * We use this pointer to detect if this is the first time this
+ * thread has created an interpreter.
+ */
+
+ tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
+
+ if (subsystemsInitialized == 0) {
+ /*
+ * Double check inside the mutex. There are definitly calls
+ * back into this routine from some of the procedures below.
+ */
+
+ TclpInitLock();
+ if (subsystemsInitialized == 0) {
+ /*
+ * Have to set this bit here to avoid deadlock with the
+ * routines below us that call into TclInitSubsystems.
+ */
+
+ subsystemsInitialized = 1;
+
+ tclExecutableName = NULL;
+
+ /*
+ * Initialize locks used by the memory allocators before anything
+ * interesting happens so we can use the allocators in the
+ * implementation of self-initializing locks.
+ */
+#if USE_TCLALLOC
+ TclInitAlloc(); /* process wide mutex init */
+#endif
+#ifdef TCL_MEM_DEBUG
+ TclInitDbCkalloc(); /* process wide mutex init */
#endif
- TclPlatformExit(status);
+
+ TclpInitPlatform(); /* creates signal handler(s) */
+ TclInitObjSubsystem(); /* register obj types, create mutexes */
+ TclInitIOSubsystem(); /* inits a tsd key (noop) */
+ TclInitEncodingSubsystem(); /* process wide encoding init */
+ TclInitNamespaceSubsystem(); /* register ns obj type (mutexed) */
+ }
+ TclpInitUnlock();
+ }
+
+ if (tsdPtr == NULL) {
+ /*
+ * First time this thread has created an interpreter.
+ * We fetch the key again just in case no exit handlers were
+ * registered by this point.
+ */
+
+ (void) TCL_TSD_INIT(&dataKey);
+ TclInitNotifier();
+ }
}
/*
@@ -497,16 +723,16 @@ Tcl_Exit(status)
*
* Tcl_Finalize --
*
- * Runs the exit handlers to allow Tcl to clean up its state prior
- * to being unloaded. Called by Tcl_Exit and when Tcl was dynamically
- * loaded and is now being unloaded.
+ * Shut down Tcl. First calls registered exit handlers, then
+ * carefully shuts down various subsystems.
+ * Called by Tcl_Exit or when the Tcl shared library is being
+ * unloaded.
*
* Results:
* None.
*
* Side effects:
- * Whatever the exit handlers do. Also frees up storage associated
- * with the Tcl object type table.
+ * Varied, see the respective finalization routines.
*
*----------------------------------------------------------------------
*/
@@ -515,34 +741,156 @@ void
Tcl_Finalize()
{
ExitHandler *exitPtr;
-
- /*
- * Invoke exit handler first.
- */
+ ThreadSpecificData *tsdPtr;
+
+ TclpInitLock();
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (subsystemsInitialized != 0) {
+ subsystemsInitialized = 0;
- tclInExit = 1;
- for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
/*
- * Be careful to remove the handler from the list before invoking
- * its callback. This protects us against double-freeing if the
- * callback should call Tcl_DeleteExitHandler on itself.
+ * Invoke exit handlers first.
*/
- firstExitPtr = exitPtr->nextPtr;
- (*exitPtr->proc)(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ Tcl_MutexLock(&exitMutex);
+ inFinalize = 1;
+ for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
+ /*
+ * Be careful to remove the handler from the list before
+ * invoking its callback. This protects us against
+ * double-freeing if the callback should call
+ * Tcl_DeleteExitHandler on itself.
+ */
+
+ firstExitPtr = exitPtr->nextPtr;
+ Tcl_MutexUnlock(&exitMutex);
+ (*exitPtr->proc)(exitPtr->clientData);
+ ckfree((char *) exitPtr);
+ Tcl_MutexLock(&exitMutex);
+ }
+ firstExitPtr = NULL;
+ Tcl_MutexUnlock(&exitMutex);
+
+ /*
+ * Clean up the library path now, before we invalidate thread-local
+ * storage.
+ */
+ if (tsdPtr->tclLibraryPath != NULL) {
+ Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
+ tsdPtr->tclLibraryPath = NULL;
+ }
+
+ /*
+ * Clean up after the current thread now, after exit handlers.
+ * In particular, the testexithandler command sets up something
+ * that writes to standard output, which gets closed.
+ * Note that there is no thread-local storage after this call.
+ */
+
+ Tcl_FinalizeThread();
+
+ /*
+ * Now finalize the Tcl execution environment. Note that this
+ * must be done after the exit handlers, because there are
+ * order dependencies.
+ */
+
+ TclFinalizeCompExecEnv();
+ TclFinalizeEnvironment();
+
+ TclFinalizeEncodingSubsystem();
+
+ if (tclExecutableName != NULL) {
+ ckfree(tclExecutableName);
+ tclExecutableName = NULL;
+ }
+ if (tclNativeExecutableName != NULL) {
+ ckfree(tclNativeExecutableName);
+ tclNativeExecutableName = NULL;
+ }
+ if (tclDefaultEncodingDir != NULL) {
+ ckfree(tclDefaultEncodingDir);
+ tclDefaultEncodingDir = NULL;
+ }
+
+ Tcl_SetPanicProc(NULL);
+
+ /*
+ * Free synchronization objects. There really should only be one
+ * thread alive at this moment.
+ */
+
+ TclFinalizeSynchronization();
+
+ /*
+ * We defer unloading of packages until very late
+ * to avoid memory access issues. Both exit callbacks and
+ * synchronization variables may be stored in packages.
+ */
+
+ TclFinalizeLoad();
+
+ /*
+ * There shouldn't be any malloc'ed memory after this.
+ */
+
+ TclFinalizeMemorySubsystem();
+ inFinalize = 0;
}
+ TclpInitUnlock();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeThread --
+ *
+ * Runs the exit handlers to allow Tcl to clean up its state
+ * about a particular thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Varied, see the respective finalization routines.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * Now finalize the Tcl execution environment. Note that this must be done
- * after the exit handlers, because there are order dependencies.
- */
-
- TclFinalizeCompExecEnv();
- TclFinalizeEnvironment();
- TclpFinalize();
- firstExitPtr = NULL;
- tclInExit = 0;
+void
+Tcl_FinalizeThread()
+{
+ ExitHandler *exitPtr;
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+
+ if (tsdPtr != NULL) {
+ /*
+ * Invoke thread exit handlers first.
+ */
+
+ tsdPtr->inExit = 1;
+ for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
+ exitPtr = tsdPtr->firstExitPtr) {
+ /*
+ * Be careful to remove the handler from the list before invoking
+ * its callback. This protects us against double-freeing if the
+ * callback should call Tcl_DeleteThreadExitHandler on itself.
+ */
+
+ tsdPtr->firstExitPtr = exitPtr->nextPtr;
+ (*exitPtr->proc)(exitPtr->clientData);
+ ckfree((char *) exitPtr);
+ }
+ TclFinalizeIOSubsystem();
+ TclFinalizeNotifier();
+
+ /*
+ * Blow away all thread local storage blocks.
+ */
+
+ TclFinalizeThreadData();
+ }
}
/*
@@ -564,13 +912,14 @@ Tcl_Finalize()
int
TclInExit()
{
- return tclInExit;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ return tsdPtr->inExit;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_VwaitCmd --
+ * Tcl_VwaitObjCmd --
*
* This procedure is invoked to process the "vwait" Tcl command.
* See the user documentation for details on what it does.
@@ -586,20 +935,21 @@ TclInExit()
/* ARGSUSED */
int
-Tcl_VwaitCmd(clientData, interp, argc, argv)
+Tcl_VwaitObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int done, foundEvent;
+ char *nameString;
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " name\"", (char *) NULL);
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
- if (Tcl_TraceVar(interp, argv[1],
+ nameString = Tcl_GetString(objv[1]);
+ if (Tcl_TraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, (ClientData) &done) != TCL_OK) {
return TCL_ERROR;
@@ -609,7 +959,7 @@ Tcl_VwaitCmd(clientData, interp, argc, argv)
while (!done && foundEvent) {
foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
}
- Tcl_UntraceVar(interp, argv[1],
+ Tcl_UntraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, (ClientData) &done);
@@ -620,7 +970,7 @@ Tcl_VwaitCmd(clientData, interp, argc, argv)
Tcl_ResetResult(interp);
if (!foundEvent) {
- Tcl_AppendResult(interp, "can't wait for variable \"", argv[1],
+ Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
"\": would wait forever", (char *) NULL);
return TCL_ERROR;
}
@@ -645,7 +995,7 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
/*
*----------------------------------------------------------------------
*
- * Tcl_UpdateCmd --
+ * Tcl_UpdateObjCmd --
*
* This procedure is invoked to process the "update" Tcl command.
* See the user documentation for details on what it does.
@@ -661,29 +1011,38 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
/* ARGSUSED */
int
-Tcl_UpdateCmd(clientData, interp, argc, argv)
+Tcl_UpdateObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int flags;
+ int optionIndex;
+ int flags = 0; /* Initialized to avoid compiler warning. */
+ static char *updateOptions[] = {"idletasks", (char *) NULL};
+ enum updateOptions {REGEXP_IDLETASKS};
- if (argc == 1) {
+ if (objc == 1) {
flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
- } else if (argc == 2) {
- if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be idletasks", (char *) NULL);
+ } else if (objc == 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
+ "option", 0, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
- flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+ switch ((enum updateOptions) optionIndex) {
+ case REGEXP_IDLETASKS: {
+ flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+ break;
+ }
+ default: {
+ panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
+ }
+ }
} else {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " ?idletasks?\"", (char *) NULL);
+ Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
return TCL_ERROR;
}
-
+
while (Tcl_DoOneEvent(flags) != 0) {
/* Empty loop body */
}
@@ -696,3 +1055,4 @@ Tcl_UpdateCmd(clientData, interp, argc, argv)
Tcl_ResetResult(interp);
return TCL_OK;
}
+
diff --git a/tcl/generic/tclExecute.c b/tcl/generic/tclExecute.c
index fdfe08344b9..95c0c9e04d5 100644
--- a/tcl/generic/tclExecute.c
+++ b/tcl/generic/tclExecute.c
@@ -48,6 +48,7 @@ int errno;
*/
static int execInitialized = 0;
+TCL_DECLARE_MUTEX(execMutex)
/*
* Variable that controls whether execution tracing is enabled and, if so,
@@ -61,14 +62,19 @@ static int execInitialized = 0;
int tclTraceExec = 0;
-/*
- * The following global variable is use to signal matherr that Tcl
- * is responsible for the arithmetic, so errors can be handled in a
- * fashion appropriate for Tcl. Zero means no Tcl math is in
- * progress; non-zero means Tcl is doing math.
- */
+typedef struct ThreadSpecificData {
+ /*
+ * The following global variable is use to signal matherr that Tcl
+ * is responsible for the arithmetic, so errors can be handled in a
+ * fashion appropriate for Tcl. Zero means no Tcl math is in
+ * progress; non-zero means Tcl is doing math.
+ */
+
+ int mathInProgress;
+
+} ThreadSpecificData;
-int tcl_MathInProgress = 0;
+static Tcl_ThreadDataKey dataKey;
/*
* The variable below serves no useful purpose except to generate
@@ -84,12 +90,6 @@ int (*tclMatherrPtr)() = matherr;
#endif
/*
- * Array of instruction names.
- */
-
-static char *opName[256];
-
-/*
* Mapping from expression instruction opcodes to strings; used for error
* messages. Note that these entries must match the order and number of the
* expression opcodes (e.g., INST_LOR) in tclCompile.h.
@@ -110,18 +110,7 @@ static char *operatorStrings[] = {
static char *resultStrings[] = {
"TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
};
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- * The following are statistics-related variables that record information
- * about the bytecode compiler and interpreter's operation. This includes
- * an array that records for each instruction how often it is executed.
- */
-
-#ifdef TCL_COMPILE_STATS
-static long numExecutions = 0;
-static int instructionCount[256];
-#endif /* TCL_COMPILE_STATS */
+#endif
/*
* Macros for testing floating-point values for certain special cases. Test
@@ -142,7 +131,8 @@ static int instructionCount[256];
*/
#define ADJUST_PC(instBytes) \
- pc += instBytes; continue
+ pc += (instBytes); \
+ continue
/*
* Macros used to cache often-referenced Tcl evaluation stack information
@@ -168,85 +158,47 @@ static int instructionCount[256];
* decremented before the caller had a chance to, e.g., store it in a
* variable. It is the caller's responsibility to decrement the ref count
* when it is finished with an object.
- */
-
-#define STK_ITEM(offset) (stackPtr[stackTop + (offset)])
-#define STK_OBJECT(offset) (STK_ITEM(offset).o)
-#define STK_INT(offset) (STK_ITEM(offset).i)
-#define STK_POINTER(offset) (STK_ITEM(offset).p)
-
-/*
+ *
* WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT
* macro. The actual parameter might be an expression with side effects,
* and this ensures that it will be executed only once.
*/
#define PUSH_OBJECT(objPtr) \
- Tcl_IncrRefCount(stackPtr[++stackTop].o = (objPtr))
+ Tcl_IncrRefCount(stackPtr[++stackTop] = (objPtr))
#define POP_OBJECT() \
- (stackPtr[stackTop--].o)
+ (stackPtr[stackTop--])
/*
* Macros used to trace instruction execution. The macros TRACE,
* TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode.
* O2S is only used in TRACE* calls to get a string from an object.
- *
- * NOTE THAT CLIENTS OF O2S ARE LIKELY TO FAIL IF THE OBJECT'S
- * STRING REP CONTAINS NULLS.
*/
#ifdef TCL_COMPILE_DEBUG
-
-#define O2S(objPtr) \
- Tcl_GetStringFromObj((objPtr), &length)
-
-#ifdef TCL_COMPILE_STATS
-#define TRACE(a) \
- if (traceInstructions) { \
- fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
- stackTop, (tclObjsAlloced - tclObjsFreed), \
- (unsigned int)(pc - codePtr->codeStart)); \
- printf a; \
- fflush(stdout); \
- }
-#define TRACE_WITH_OBJ(a, objPtr) \
- if (traceInstructions) { \
- fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
- stackTop, (tclObjsAlloced - tclObjsFreed), \
- (unsigned int)(pc - codePtr->codeStart)); \
- printf a; \
- bytes = Tcl_GetStringFromObj((objPtr), &length); \
- TclPrintSource(stdout, bytes, TclMin(length, 30)); \
- fprintf(stdout, "\n"); \
- fflush(stdout); \
- }
-#else /* not TCL_COMPILE_STATS */
#define TRACE(a) \
if (traceInstructions) { \
- fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
- (unsigned int)(pc - codePtr->codeStart)); \
+ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
+ (unsigned int)(pc - codePtr->codeStart), \
+ GetOpcodeName(pc)); \
printf a; \
- fflush(stdout); \
}
#define TRACE_WITH_OBJ(a, objPtr) \
if (traceInstructions) { \
- fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
- (unsigned int)(pc - codePtr->codeStart)); \
+ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
+ (unsigned int)(pc - codePtr->codeStart), \
+ GetOpcodeName(pc)); \
printf a; \
- bytes = Tcl_GetStringFromObj((objPtr), &length); \
- TclPrintSource(stdout, bytes, TclMin(length, 30)); \
+ TclPrintObject(stdout, (objPtr), 30); \
fprintf(stdout, "\n"); \
- fflush(stdout); \
}
-#endif /* TCL_COMPILE_STATS */
-
-#else /* not TCL_COMPILE_DEBUG */
-
+#define O2S(objPtr) \
+ Tcl_GetString(objPtr)
+#else
#define TRACE(a)
#define TRACE_WITH_OBJ(a, objPtr)
#define O2S(objPtr)
-
#endif /* TCL_COMPILE_DEBUG */
/*
@@ -280,32 +232,36 @@ static int ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
#ifdef TCL_COMPILE_STATS
static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
-#endif /* TCL_COMPILE_STATS */
+#endif
static void FreeCmdNameInternalRep _ANSI_ARGS_((
Tcl_Obj *objPtr));
+#ifdef TCL_COMPILE_DEBUG
+static char * GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
+#endif
+static ExceptionRange * GetExceptRangeForPc _ANSI_ARGS_((unsigned char *pc,
+ int catchOnly, ByteCode* codePtr));
static char * GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
ByteCode* codePtr, int *lengthPtr));
static void GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
static void IllegalExprOperandType _ANSI_ARGS_((
- Tcl_Interp *interp, unsigned int opCode,
+ Tcl_Interp *interp, unsigned char *pc,
Tcl_Obj *opndPtr));
static void InitByteCodeExecution _ANSI_ARGS_((
Tcl_Interp *interp));
+#ifdef TCL_COMPILE_DEBUG
static void PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
-static void RecordTracebackInfo _ANSI_ARGS_((Tcl_Interp *interp,
- unsigned char *pc, ByteCode *codePtr));
+#endif
static int SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
#ifdef TCL_COMPILE_DEBUG
static char * StringForResultCode _ANSI_ARGS_((int result));
-#endif /* TCL_COMPILE_DEBUG */
-static void UpdateStringOfCmdName _ANSI_ARGS_((Tcl_Obj *objPtr));
-#ifdef TCL_COMPILE_DEBUG
static void ValidatePcAndStackTop _ANSI_ARGS_((
ByteCode *codePtr, unsigned char *pc,
int stackTop, int stackLowerBound,
int stackUpperBound));
-#endif /* TCL_COMPILE_DEBUG */
+#endif
+static int VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
/*
* Table describing the built-in math functions. Entries in this table are
@@ -356,7 +312,7 @@ Tcl_ObjType tclCmdNameType = {
"cmdName", /* name */
FreeCmdNameInternalRep, /* freeIntRepProc */
DupCmdNameInternalRep, /* dupIntRepProc */
- UpdateStringOfCmdName, /* updateStringProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
SetCmdNameFromAny /* setFromAnyProc */
};
@@ -388,28 +344,16 @@ InitByteCodeExecution(interp)
* "tcl_traceExec" is linked to control
* instruction tracing. */
{
- int i;
-
Tcl_RegisterObjType(&tclCmdNameType);
-
- (VOID *) memset(opName, 0, sizeof(opName));
- for (i = 0; instructionTable[i].name != NULL; i++) {
- opName[i] = instructionTable[i].name;
+ if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
+ TCL_LINK_INT) != TCL_OK) {
+ panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
}
#ifdef TCL_COMPILE_STATS
- (VOID *) memset(instructionCount, 0, sizeof(instructionCount));
- (VOID *) memset(tclByteCodeCount, 0, sizeof(tclByteCodeCount));
- (VOID *) memset(tclSourceCount, 0, sizeof(tclSourceCount));
-
Tcl_CreateCommand(interp, "evalstats", EvalStatsCmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
#endif /* TCL_COMPILE_STATS */
-
- if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
- TCL_LINK_INT) != TCL_OK) {
- panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
- }
}
/*
@@ -443,16 +387,18 @@ TclCreateExecEnv(interp)
{
ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
- eePtr->stackPtr = (StackItem *)
- ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(StackItem)));
+ eePtr->stackPtr = (Tcl_Obj **)
+ ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
eePtr->stackTop = -1;
eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1);
+ Tcl_MutexLock(&execMutex);
if (!execInitialized) {
- TclInitAuxDataTypeTable();
- InitByteCodeExecution(interp);
- execInitialized = 1;
+ TclInitAuxDataTypeTable();
+ InitByteCodeExecution(interp);
+ execInitialized = 1;
}
+ Tcl_MutexUnlock(&execMutex);
return eePtr;
}
@@ -486,7 +432,7 @@ TclDeleteExecEnv(eePtr)
/*
*----------------------------------------------------------------------
*
- * TclFinalizeExecEnv --
+ * TclFinalizeExecution --
*
* Finalizes the execution environment setup so that it can be
* later reinitialized.
@@ -502,9 +448,11 @@ TclDeleteExecEnv(eePtr)
*/
void
-TclFinalizeExecEnv()
+TclFinalizeExecution()
{
+ Tcl_MutexLock(&execMutex);
execInitialized = 0;
+ Tcl_MutexUnlock(&execMutex);
TclFinalizeAuxDataTypeTable();
}
@@ -536,9 +484,9 @@ GrowEvaluationStack(eePtr)
int currElems = (eePtr->stackEnd + 1);
int newElems = 2*currElems;
- int currBytes = currElems * sizeof(StackItem);
+ int currBytes = currElems * sizeof(Tcl_Obj *);
int newBytes = 2*currBytes;
- StackItem *newStackPtr = (StackItem *) ckalloc((unsigned) newBytes);
+ Tcl_Obj **newStackPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);
/*
* Copy the existing stack items to the new stack space, free the old
@@ -580,15 +528,12 @@ TclExecuteByteCode(interp, codePtr)
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr = iPtr->execEnvPtr;
/* Points to the execution environment. */
- register StackItem *stackPtr = eePtr->stackPtr;
+ register Tcl_Obj **stackPtr = eePtr->stackPtr;
/* Cached evaluation stack base pointer. */
register int stackTop = eePtr->stackTop;
/* Cached top index of evaluation stack. */
- Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
- /* Points to the ByteCode's object array. */
- unsigned char *pc = codePtr->codeStart;
+ register unsigned char *pc = codePtr->codeStart;
/* The current program counter. */
- unsigned char opCode; /* The current instruction code. */
int opnd; /* Current instruction's operand byte. */
int pcAdjustment; /* Hold pc adjustment after instruction. */
int initStackTop = stackTop;/* Stack top at start of execution. */
@@ -598,13 +543,10 @@ TclExecuteByteCode(interp, codePtr)
* process break, continue, and errors. */
int result = TCL_OK; /* Return code returned after execution. */
int traceInstructions = (tclTraceExec == 3);
- Tcl_Obj *valuePtr, *value2Ptr, *namePtr, *objPtr;
+ Tcl_Obj *valuePtr, *value2Ptr, *objPtr;
char *bytes;
int length;
long i;
- Tcl_DString command; /* Used for debugging. If tclTraceExec >= 2
- * holds a string representing the last
- * command invoked. */
/*
* This procedure uses a stack to hold information about catch commands.
@@ -613,29 +555,22 @@ TclExecuteByteCode(interp, codePtr)
* allocated space but uses dynamically-allocated storage if needed.
*/
-#define STATIC_CATCH_STACK_SIZE 5
+#define STATIC_CATCH_STACK_SIZE 4
int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
int *catchStackPtr = catchStackStorage;
int catchTop = -1;
- /*
- * THIS PROC FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
+#ifdef TCL_COMPILE_DEBUG
if (tclTraceExec >= 2) {
PrintByteCodeInfo(codePtr);
-#ifdef TCL_COMPILE_STATS
- fprintf(stdout, " Starting stack top=%d, system objects=%ld\n",
- eePtr->stackTop, (tclObjsAlloced - tclObjsFreed));
-#else
fprintf(stdout, " Starting stack top=%d\n", eePtr->stackTop);
-#endif /* TCL_COMPILE_STATS */
fflush(stdout);
}
-
+#endif
+
#ifdef TCL_COMPILE_STATS
- numExecutions++;
-#endif /* TCL_COMPILE_STATS */
+ iPtr->stats.numExecutions++;
+#endif
/*
* Make sure the catch stack is large enough to hold the maximum number
@@ -643,9 +578,9 @@ TclExecuteByteCode(interp, codePtr)
* will be no more than the exception range array's depth.
*/
- if (codePtr->maxExcRangeDepth > STATIC_CATCH_STACK_SIZE) {
+ if (codePtr->maxExceptDepth > STATIC_CATCH_STACK_SIZE) {
catchStackPtr = (int *)
- ckalloc(codePtr->maxExcRangeDepth * sizeof(int));
+ ckalloc(codePtr->maxExceptDepth * sizeof(int));
}
/*
@@ -658,13 +593,6 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Initialize the buffer that holds a string containing the name and
- * arguments for the last invoked command.
- */
-
- Tcl_DStringInit(&command);
-
- /*
* Loop executing instructions until a "done" instruction, a TCL_RETURN,
* or some error.
*/
@@ -674,24 +602,17 @@ TclExecuteByteCode(interp, codePtr)
ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
eePtr->stackEnd);
#else /* not TCL_COMPILE_DEBUG */
- if (traceInstructions) {
-#ifdef TCL_COMPILE_STATS
- fprintf(stdout, "%d: %d,%ld ", iPtr->numLevels, stackTop,
- (tclObjsAlloced - tclObjsFreed));
-#else /* TCL_COMPILE_STATS */
- fprintf(stdout, "%d: %d ", iPtr->numLevels, stackTop);
-#endif /* TCL_COMPILE_STATS */
- TclPrintInstruction(codePtr, pc);
- fflush(stdout);
- }
+ if (traceInstructions) {
+ fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop);
+ TclPrintInstruction(codePtr, pc);
+ fflush(stdout);
+ }
#endif /* TCL_COMPILE_DEBUG */
- opCode = *pc;
#ifdef TCL_COMPILE_STATS
- instructionCount[opCode]++;
-#endif /* TCL_COMPILE_STATS */
-
- switch (opCode) {
+ iPtr->stats.instructionCount[*pc]++;
+#endif
+ switch (*pc) {
case INST_DONE:
/*
* Pop the topmost object from the stack, set the interpreter's
@@ -705,38 +626,43 @@ TclExecuteByteCode(interp, codePtr)
(unsigned int)(pc - codePtr->codeStart),
(unsigned int) stackTop,
(unsigned int) initStackTop);
- fprintf(stderr, " Source: ");
- TclPrintSource(stderr, codePtr->source, 150);
panic("TclExecuteByteCode execution failure: end stack top != start stack top");
}
- TRACE_WITH_OBJ(("done => return code=%d, result is ", result),
+ TRACE_WITH_OBJ(("=> return code=%d, result=", result),
iPtr->objResultPtr);
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, "\n");
+ }
+#endif
goto done;
case INST_PUSH1:
- valuePtr = objArrayPtr[TclGetUInt1AtPtr(pc+1)];
+#ifdef TCL_COMPILE_DEBUG
+ valuePtr = codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)];
PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("push1 %u => ", TclGetUInt1AtPtr(pc+1)),
- valuePtr);
+ TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), valuePtr);
+#else
+ PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
+#endif /* TCL_COMPILE_DEBUG */
ADJUST_PC(2);
case INST_PUSH4:
- valuePtr = objArrayPtr[TclGetUInt4AtPtr(pc+1)];
+ valuePtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("push4 %u => ", TclGetUInt4AtPtr(pc+1)),
- valuePtr);
+ TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), valuePtr);
ADJUST_PC(5);
case INST_POP:
valuePtr = POP_OBJECT();
- TRACE_WITH_OBJ(("pop => discarding "), valuePtr);
+ TRACE_WITH_OBJ(("=> discarding "), valuePtr);
TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
ADJUST_PC(1);
case INST_DUP:
- valuePtr = stackPtr[stackTop].o;
+ valuePtr = stackPtr[stackTop];
PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
- TRACE_WITH_OBJ(("dup => "), valuePtr);
+ TRACE_WITH_OBJ(("=> "), valuePtr);
ADJUST_PC(1);
case INST_CONCAT1:
@@ -752,8 +678,7 @@ TclExecuteByteCode(interp, codePtr)
*/
for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
- valuePtr = stackPtr[i].o;
- bytes = TclGetStringFromObj(valuePtr, &length);
+ bytes = Tcl_GetStringFromObj(stackPtr[i], &length);
if (bytes != NULL) {
totalLen += length;
}
@@ -770,8 +695,8 @@ TclExecuteByteCode(interp, codePtr)
concatObjPtr->bytes = p;
concatObjPtr->length = totalLen;
for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
- valuePtr = stackPtr[i].o;
- bytes = TclGetStringFromObj(valuePtr, &length);
+ valuePtr = stackPtr[i];
+ bytes = Tcl_GetStringFromObj(valuePtr, &length);
if (bytes != NULL) {
memcpy((VOID *) p, (VOID *) bytes,
(size_t) length);
@@ -782,14 +707,13 @@ TclExecuteByteCode(interp, codePtr)
*p = '\0';
} else {
for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
- valuePtr = stackPtr[i].o;
- Tcl_DecrRefCount(valuePtr);
+ Tcl_DecrRefCount(stackPtr[i]);
}
}
stackTop -= opnd;
PUSH_OBJECT(concatObjPtr);
- TRACE_WITH_OBJ(("concat %u => ", opnd), concatObjPtr);
+ TRACE_WITH_OBJ(("%u => ", opnd), concatObjPtr);
ADJUST_PC(2);
}
@@ -804,19 +728,13 @@ TclExecuteByteCode(interp, codePtr)
doInvocation:
{
- char *cmdName;
- Command *cmdPtr; /* Points to command's Command struct. */
- int objc = opnd; /* The number of arguments. */
- Tcl_Obj **objv; /* The array of argument objects. */
- Tcl_Obj *objv0Ptr; /* Holds objv[0], the command name. */
- int newPcOffset = 0;
- /* Instruction offset computed during
- * break, continue, error processing.
- * Init. to avoid compiler warning. */
- Tcl_Command cmd;
+ int objc = opnd; /* The number of arguments. */
+ Tcl_Obj **objv; /* The array of argument objects. */
+ Command *cmdPtr; /* Points to command's Command struct. */
+ int newPcOffset; /* New inst offset for break, continue. */
#ifdef TCL_COMPILE_DEBUG
int isUnknownCmd = 0;
- char cmdNameBuf[30];
+ char cmdNameBuf[21];
#endif /* TCL_COMPILE_DEBUG */
/*
@@ -834,49 +752,31 @@ TclExecuteByteCode(interp, codePtr)
goto checkForCatch;
}
- objv = &(stackPtr[stackTop - (objc-1)].o);
- objv0Ptr = objv[0];
- cmdName = TclGetStringFromObj(objv0Ptr, (int *) NULL);
-
/*
- * Find the procedure to execute this command. If there
- * isn't one, then see if there is a command "unknown". If
- * so, invoke it, passing it the original command words as
- * arguments.
- *
- * We convert the objv[0] object to be a CmdName object.
- * This caches a pointer to the Command structure for the
- * command; this pointer is held in a ResolvedCmdName
- * structure the object's internal rep. points to.
- */
-
- cmd = Tcl_GetCommandFromObj(interp, objv0Ptr);
- cmdPtr = (Command *) cmd;
-
- /*
- * If the command is still not found, handle it with the
- * "unknown" proc.
+ * Find the procedure to execute this command. If the
+ * command is not found, handle it with the "unknown" proc.
*/
+ objv = &(stackPtr[stackTop - (objc-1)]);
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
if (cmdPtr == NULL) {
- cmd = Tcl_FindCommand(interp, "unknown",
- (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
- if (cmd == (Tcl_Command) NULL) {
+ cmdPtr = (Command *) Tcl_FindCommand(interp, "unknown",
+ (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY);
+ if (cmdPtr == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "invalid command name \"", cmdName, "\"",
+ "invalid command name \"",
+ Tcl_GetString(objv[0]), "\"",
(char *) NULL);
- TRACE(("%s %u => unknown proc not found: ",
- opName[opCode], objc));
+ TRACE(("%u => unknown proc not found: ", objc));
result = TCL_ERROR;
goto checkForCatch;
}
- cmdPtr = (Command *) cmd;
#ifdef TCL_COMPILE_DEBUG
isUnknownCmd = 1;
#endif /*TCL_COMPILE_DEBUG*/
stackTop++; /* need room for new inserted objv[0] */
- for (i = objc; i >= 0; i--) {
+ for (i = objc-1; i >= 0; i--) {
objv[i+1] = objv[i];
}
objc++;
@@ -916,38 +816,28 @@ TclExecuteByteCode(interp, codePtr)
*/
Tcl_ResetResult(interp);
-
if (tclTraceExec >= 2) {
- char buffer[50];
-
- sprintf(buffer, "%d: (%u) invoking ", iPtr->numLevels,
- (unsigned int)(pc - codePtr->codeStart));
- Tcl_DStringAppend(&command, buffer, -1);
-
#ifdef TCL_COMPILE_DEBUG
- if (traceInstructions) { /* tclTraceExec == 3 */
- strncpy(cmdNameBuf, cmdName, 20);
- TRACE(("%s %u => call ", opName[opCode],
- (isUnknownCmd? objc-1 : objc)));
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, Tcl_GetString(objv[0]), 20);
+ TRACE(("%u => call ", (isUnknownCmd? objc-1:objc)));
} else {
- fprintf(stdout, "%s", buffer);
+ fprintf(stdout, "%d: (%u) invoking ",
+ iPtr->numLevels,
+ (unsigned int)(pc - codePtr->codeStart));
}
-#else /* TCL_COMPILE_DEBUG */
- fprintf(stdout, "%s", buffer);
-#endif /*TCL_COMPILE_DEBUG*/
-
for (i = 0; i < objc; i++) {
- bytes = TclGetStringFromObj(objv[i], &length);
- TclPrintSource(stdout, bytes, TclMin(length, 15));
+ TclPrintObject(stdout, objv[i], 15);
fprintf(stdout, " ");
-
- sprintf(buffer, "\"%.*s\" ", TclMin(length, 15), bytes);
- Tcl_DStringAppend(&command, buffer, -1);
}
fprintf(stdout, "\n");
fflush(stdout);
-
- Tcl_DStringFree(&command);
+#else /* TCL_COMPILE_DEBUG */
+ fprintf(stdout, "%d: (%u) invoking %s\n",
+ iPtr->numLevels,
+ (unsigned int)(pc - codePtr->codeStart),
+ Tcl_GetString(objv[0]));
+#endif /*TCL_COMPILE_DEBUG*/
}
iPtr->cmdCount++;
@@ -975,14 +865,12 @@ TclExecuteByteCode(interp, codePtr)
* Pop the objc top stack elements and decrement their ref
* counts.
*/
-
- i = (stackTop - (objc-1));
- while (i <= stackTop) {
- valuePtr = stackPtr[i].o;
+
+ for (i = 0; i < objc; i++) {
+ valuePtr = stackPtr[stackTop];
TclDecrRefCount(valuePtr);
- i++;
+ stackTop--;
}
- stackTop -= objc;
/*
* Process the result of the Tcl_ObjCmdProc call.
@@ -995,9 +883,8 @@ TclExecuteByteCode(interp, codePtr)
* with the next instruction.
*/
PUSH_OBJECT(Tcl_GetObjResult(interp));
- TRACE_WITH_OBJ(("%s %u => ...after \"%.20s\", result=",
- opName[opCode], objc, cmdNameBuf),
- Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%u => ...after \"%.20s\", result=",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
ADJUST_PC(pcAdjustment);
case TCL_BREAK:
@@ -1011,38 +898,39 @@ TclExecuteByteCode(interp, codePtr)
* catchOffset. If no enclosing range is found, stop
* execution and return the TCL_BREAK or TCL_CONTINUE.
*/
- rangePtr = TclGetExceptionRangeForPc(pc,
- /*catchOnly*/ 0, codePtr);
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0,
+ codePtr);
if (rangePtr == NULL) {
- TRACE(("%s %u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
- opName[opCode], objc, cmdNameBuf,
+ TRACE(("%u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
+ objc, cmdNameBuf,
StringForResultCode(result)));
goto abnormalReturn; /* no catch exists to check */
}
+ newPcOffset = 0;
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
if (result == TCL_BREAK) {
newPcOffset = rangePtr->breakOffset;
} else if (rangePtr->continueOffset == -1) {
- TRACE(("%s %u => ... after \"%.20s\", %s, loop w/o continue, checking for catch\n",
- opName[opCode], objc, cmdNameBuf,
+ TRACE(("%u => ... after \"%.20s\", %s, loop w/o continue, checking for catch\n",
+ objc, cmdNameBuf,
StringForResultCode(result)));
goto checkForCatch;
} else {
newPcOffset = rangePtr->continueOffset;
}
- TRACE(("%s %u => ... after \"%.20s\", %s, range at %d, new pc %d\n",
- opName[opCode], objc, cmdNameBuf,
+ TRACE(("%u => ... after \"%.20s\", %s, range at %d, new pc %d\n",
+ objc, cmdNameBuf,
StringForResultCode(result),
rangePtr->codeOffset, newPcOffset));
break;
case CATCH_EXCEPTION_RANGE:
- TRACE(("%s %u => ... after \"%.20s\", %s...\n",
- opName[opCode], objc, cmdNameBuf,
+ TRACE(("%u => ... after \"%.20s\", %s...\n",
+ objc, cmdNameBuf,
StringForResultCode(result)));
goto processCatch; /* it will use rangePtr */
default:
- panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
+ panic("TclExecuteByteCode: bad ExceptionRange type\n");
}
result = TCL_OK;
pc = (codePtr->codeStart + newPcOffset);
@@ -1053,9 +941,8 @@ TclExecuteByteCode(interp, codePtr)
* The invoked command returned an error. Look for an
* enclosing catch exception range, if any.
*/
- TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", TCL_ERROR ",
- opName[opCode], objc, cmdNameBuf),
- Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\", TCL_ERROR ",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
goto checkForCatch;
case TCL_RETURN:
@@ -1064,30 +951,29 @@ TclExecuteByteCode(interp, codePtr)
* procedure stop execution and return. First check
* for an enclosing catch exception range, if any.
*/
- TRACE(("%s %u => ... after \"%.20s\", TCL_RETURN\n",
- opName[opCode], objc, cmdNameBuf));
+ TRACE(("%u => ... after \"%.20s\", TCL_RETURN\n",
+ objc, cmdNameBuf));
goto checkForCatch;
default:
- TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", OTHER RETURN CODE %d ",
- opName[opCode], objc, cmdNameBuf, result),
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\", OTHER RETURN CODE %d ",
+ objc, cmdNameBuf, result),
Tcl_GetObjResult(interp));
goto checkForCatch;
- } /* end of switch on result from invoke instruction */
+ }
}
case INST_EVAL_STK:
objPtr = POP_OBJECT();
DECACHE_STACK_INFO();
- result = Tcl_EvalObj(interp, objPtr);
+ result = Tcl_EvalObjEx(interp, objPtr, 0);
CACHE_STACK_INFO();
if (result == TCL_OK) {
/*
* Normal return; push the eval's object result.
*/
-
PUSH_OBJECT(Tcl_GetObjResult(interp));
- TRACE_WITH_OBJ(("evalStk \"%.30s\" => ", O2S(objPtr)),
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
Tcl_GetObjResult(interp));
TclDecrRefCount(objPtr);
ADJUST_PC(1);
@@ -1105,10 +991,10 @@ TclExecuteByteCode(interp, codePtr)
* continue, error processing. Init.
* to avoid compiler warning. */
- rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0,
codePtr);
if (rangePtr == NULL) {
- TRACE(("evalStk \"%.30s\" => no encl. loop or catch, returning %s\n",
+ TRACE(("\"%.30s\" => no encl. loop or catch, returning %s\n",
O2S(objPtr), StringForResultCode(result)));
Tcl_DecrRefCount(objPtr);
goto abnormalReturn; /* no catch exists to check */
@@ -1118,7 +1004,7 @@ TclExecuteByteCode(interp, codePtr)
if (result == TCL_BREAK) {
newPcOffset = rangePtr->breakOffset;
} else if (rangePtr->continueOffset == -1) {
- TRACE(("evalStk \"%.30s\" => %s, loop w/o continue, checking for catch\n",
+ TRACE(("\"%.30s\" => %s, loop w/o continue, checking for catch\n",
O2S(objPtr), StringForResultCode(result)));
Tcl_DecrRefCount(objPtr);
goto checkForCatch;
@@ -1126,12 +1012,12 @@ TclExecuteByteCode(interp, codePtr)
newPcOffset = rangePtr->continueOffset;
}
result = TCL_OK;
- TRACE_WITH_OBJ(("evalStk \"%.30s\" => %s, range at %d, new pc %d ",
+ TRACE_WITH_OBJ(("\"%.30s\" => %s, range at %d, new pc %d ",
O2S(objPtr), StringForResultCode(result),
rangePtr->codeOffset, newPcOffset), valuePtr);
break;
case CATCH_EXCEPTION_RANGE:
- TRACE_WITH_OBJ(("evalStk \"%.30s\" => %s ",
+ TRACE_WITH_OBJ(("\"%.30s\" => %s ",
O2S(objPtr), StringForResultCode(result)),
valuePtr);
Tcl_DecrRefCount(objPtr);
@@ -1143,7 +1029,7 @@ TclExecuteByteCode(interp, codePtr)
pc = (codePtr->codeStart + newPcOffset);
continue; /* restart outer instruction loop at pc */
} else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */
- TRACE_WITH_OBJ(("evalStk \"%.30s\" => ERROR: ", O2S(objPtr)),
+ TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
Tcl_GetObjResult(interp));
Tcl_DecrRefCount(objPtr);
goto checkForCatch;
@@ -1156,57 +1042,75 @@ TclExecuteByteCode(interp, codePtr)
result = Tcl_ExprObj(interp, objPtr, &valuePtr);
CACHE_STACK_INFO();
if (result != TCL_OK) {
- TRACE_WITH_OBJ(("exprStk \"%.30s\" => ERROR: ",
+ TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ",
O2S(objPtr)), Tcl_GetObjResult(interp));
Tcl_DecrRefCount(objPtr);
goto checkForCatch;
}
- stackPtr[++stackTop].o = valuePtr; /* already has right refct */
- TRACE_WITH_OBJ(("exprStk \"%.30s\" => ", O2S(objPtr)), valuePtr);
+ stackPtr[++stackTop] = valuePtr; /* already has right refct */
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
TclDecrRefCount(objPtr);
ADJUST_PC(1);
- case INST_LOAD_SCALAR4:
- opnd = TclGetInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doLoadScalar;
-
case INST_LOAD_SCALAR1:
+#ifdef TCL_COMPILE_DEBUG
opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doLoadScalar:
+ DECACHE_STACK_INFO();
+ valuePtr = TclGetIndexedScalar(interp, opnd,
+ /*leaveErrorMsg*/ 1);
+ CACHE_STACK_INFO();
+ if (valuePtr == NULL) {
+ TRACE_WITH_OBJ(("%u => ERROR: ", opnd),
+ Tcl_GetObjResult(interp));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ PUSH_OBJECT(valuePtr);
+ TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
+#else /* TCL_COMPILE_DEBUG */
+ DECACHE_STACK_INFO();
+ opnd = TclGetUInt1AtPtr(pc+1);
+ valuePtr = TclGetIndexedScalar(interp, opnd, /*leaveErrorMsg*/ 1);
+ CACHE_STACK_INFO();
+ if (valuePtr == NULL) {
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ PUSH_OBJECT(valuePtr);
+#endif /* TCL_COMPILE_DEBUG */
+ ADJUST_PC(2);
+
+ case INST_LOAD_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
DECACHE_STACK_INFO();
valuePtr = TclGetIndexedScalar(interp, opnd,
/*leaveErrorMsg*/ 1);
CACHE_STACK_INFO();
if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("%s %u => ERROR: ", opName[opCode], opnd),
- Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%u => ERROR: ", opnd),
+ Tcl_GetObjResult(interp));
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("%s %u => ", opName[opCode], opnd), valuePtr);
- ADJUST_PC(pcAdjustment);
+ TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
+ ADJUST_PC(5);
case INST_LOAD_SCALAR_STK:
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* scalar name */
DECACHE_STACK_INFO();
- valuePtr = Tcl_ObjGetVar2(interp, namePtr, (Tcl_Obj *) NULL,
- TCL_LEAVE_ERR_MSG);
+ valuePtr = Tcl_ObjGetVar2(interp, objPtr, NULL, TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ERROR: ",
- O2S(namePtr)), Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
+ Tcl_GetObjResult(interp));
+ Tcl_DecrRefCount(objPtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ",
- O2S(namePtr)), valuePtr);
- TclDecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
+ TclDecrRefCount(objPtr);
ADJUST_PC(1);
case INST_LOAD_ARRAY4:
@@ -1227,16 +1131,15 @@ TclExecuteByteCode(interp, codePtr)
elemPtr, /*leaveErrorMsg*/ 1);
CACHE_STACK_INFO();
if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("%s %u \"%.30s\" => ERROR: ",
- opName[opCode], opnd, O2S(elemPtr)),
- Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%u \"%.30s\" => ERROR: ",
+ opnd, O2S(elemPtr)), Tcl_GetObjResult(interp));
Tcl_DecrRefCount(elemPtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("%s %u \"%.30s\" => ",
- opName[opCode], opnd, O2S(elemPtr)), valuePtr);
+ TRACE_WITH_OBJ(("%u \"%.30s\" => ",
+ opnd, O2S(elemPtr)),valuePtr);
TclDecrRefCount(elemPtr);
}
ADJUST_PC(pcAdjustment);
@@ -1245,45 +1148,43 @@ TclExecuteByteCode(interp, codePtr)
{
Tcl_Obj *elemPtr = POP_OBJECT();
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* array name */
DECACHE_STACK_INFO();
- valuePtr = Tcl_ObjGetVar2(interp, namePtr, elemPtr,
+ valuePtr = Tcl_ObjGetVar2(interp, objPtr, elemPtr,
TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ERROR: ",
- O2S(namePtr), O2S(elemPtr)),
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ERROR: ",
+ O2S(objPtr), O2S(elemPtr)),
Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(elemPtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ",
- O2S(namePtr), O2S(elemPtr)), valuePtr);
- TclDecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ",
+ O2S(objPtr), O2S(elemPtr)), valuePtr);
+ TclDecrRefCount(objPtr);
TclDecrRefCount(elemPtr);
}
ADJUST_PC(1);
case INST_LOAD_STK:
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* variable name */
DECACHE_STACK_INFO();
- valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL,
- TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG);
+ valuePtr = Tcl_ObjGetVar2(interp, objPtr, NULL, TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("loadStk \"%.30s\" => ERROR: ",
- O2S(namePtr)), Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ",
+ O2S(objPtr)), Tcl_GetObjResult(interp));
+ Tcl_DecrRefCount(objPtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("loadStk \"%.30s\" => ", O2S(namePtr)),
- valuePtr);
- TclDecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
+ TclDecrRefCount(objPtr);
ADJUST_PC(1);
case INST_STORE_SCALAR4:
@@ -1299,46 +1200,41 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = POP_OBJECT();
DECACHE_STACK_INFO();
value2Ptr = TclSetIndexedScalar(interp, opnd, valuePtr,
- /*leaveErrorMsg*/ 1);
+ /*leaveErrorMsg*/ 1);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ERROR: ",
- opName[opCode], opnd, O2S(valuePtr)),
- Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%u <- \"%.30s\" => ERROR: ",
+ opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
Tcl_DecrRefCount(valuePtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ",
- opName[opCode], opnd, O2S(valuePtr)), value2Ptr);
+ TRACE_WITH_OBJ(("%u <- \"%.30s\" => ",
+ opnd, O2S(valuePtr)), value2Ptr);
TclDecrRefCount(valuePtr);
ADJUST_PC(pcAdjustment);
case INST_STORE_SCALAR_STK:
valuePtr = POP_OBJECT();
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* scalar name */
DECACHE_STACK_INFO();
- value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
- TCL_LEAVE_ERR_MSG);
+ value2Ptr = Tcl_ObjSetVar2(interp, objPtr, NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(
- ("storeScalarStk \"%.30s\" <- \"%.30s\" => ERROR: ",
- O2S(namePtr), O2S(valuePtr)),
+ TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ERROR: ",
+ O2S(objPtr), O2S(valuePtr)),
Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(valuePtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(
- ("storeScalarStk \"%.30s\" <- \"%.30s\" => ",
- O2S(namePtr),
- O2S(valuePtr)),
- value2Ptr);
- TclDecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ",
+ O2S(objPtr), O2S(valuePtr)), value2Ptr);
+ TclDecrRefCount(objPtr);
TclDecrRefCount(valuePtr);
ADJUST_PC(1);
@@ -1362,19 +1258,17 @@ TclExecuteByteCode(interp, codePtr)
elemPtr, valuePtr, TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(
- ("%s %u \"%.30s\" <- \"%.30s\" => ERROR: ",
- opName[opCode], opnd, O2S(elemPtr),
- O2S(valuePtr)), Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ERROR: ",
+ opnd, O2S(elemPtr), O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
Tcl_DecrRefCount(elemPtr);
Tcl_DecrRefCount(valuePtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%s %u \"%.30s\" <- \"%.30s\" => ",
- opName[opCode], opnd, O2S(elemPtr), O2S(valuePtr)),
- value2Ptr);
+ TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ",
+ opnd, O2S(elemPtr), O2S(valuePtr)), value2Ptr);
TclDecrRefCount(elemPtr);
TclDecrRefCount(valuePtr);
}
@@ -1386,26 +1280,26 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = POP_OBJECT();
elemPtr = POP_OBJECT();
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* array name */
DECACHE_STACK_INFO();
- value2Ptr = Tcl_ObjSetVar2(interp, namePtr, elemPtr,
- valuePtr, TCL_LEAVE_ERR_MSG);
+ value2Ptr = Tcl_ObjSetVar2(interp, objPtr, elemPtr, valuePtr,
+ TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ",
- O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ",
+ O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(elemPtr);
Tcl_DecrRefCount(valuePtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ",
- O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
+ O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
value2Ptr);
- TclDecrRefCount(namePtr);
+ TclDecrRefCount(objPtr);
TclDecrRefCount(elemPtr);
TclDecrRefCount(valuePtr);
}
@@ -1413,24 +1307,24 @@ TclExecuteByteCode(interp, codePtr)
case INST_STORE_STK:
valuePtr = POP_OBJECT();
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* variable name */
DECACHE_STACK_INFO();
- value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
- TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG);
+ value2Ptr = Tcl_ObjSetVar2(interp, objPtr, NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ERROR: ",
- O2S(namePtr), O2S(valuePtr)),
+ TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ERROR: ",
+ O2S(objPtr), O2S(valuePtr)),
Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(valuePtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ",
- O2S(namePtr), O2S(valuePtr)), value2Ptr);
- TclDecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ",
+ O2S(objPtr), O2S(valuePtr)), value2Ptr);
+ TclDecrRefCount(objPtr);
TclDecrRefCount(valuePtr);
ADJUST_PC(1);
@@ -1440,7 +1334,7 @@ TclExecuteByteCode(interp, codePtr)
if (valuePtr->typePtr != &tclIntType) {
result = tclIntType.setFromAnyProc(interp, valuePtr);
if (result != TCL_OK) {
- TRACE_WITH_OBJ(("incrScalar1 %u (by %s) => ERROR converting increment amount to int: ",
+ TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
Tcl_DecrRefCount(valuePtr);
goto checkForCatch;
@@ -1451,51 +1345,49 @@ TclExecuteByteCode(interp, codePtr)
value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ERROR: ",
- opnd, i), Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%u (by %ld) => ERROR: ", opnd, i),
+ Tcl_GetObjResult(interp));
Tcl_DecrRefCount(valuePtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ", opnd, i),
- value2Ptr);
+ TRACE_WITH_OBJ(("%u (by %ld) => ", opnd, i), value2Ptr);
TclDecrRefCount(valuePtr);
ADJUST_PC(2);
case INST_INCR_SCALAR_STK:
case INST_INCR_STK:
valuePtr = POP_OBJECT();
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* scalar name */
if (valuePtr->typePtr != &tclIntType) {
result = tclIntType.setFromAnyProc(interp, valuePtr);
if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%s \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
- opName[opCode], O2S(namePtr), O2S(valuePtr)),
+ TRACE_WITH_OBJ(("\"%.30s\" (by %s) => ERROR converting increment amount to int: ",
+ O2S(objPtr), O2S(valuePtr)),
Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(valuePtr);
goto checkForCatch;
}
}
i = valuePtr->internalRep.longValue;
DECACHE_STACK_INFO();
- value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
- /*part1NotParsed*/ (opCode == INST_INCR_STK));
+ value2Ptr = TclIncrVar2(interp, objPtr, (Tcl_Obj *) NULL, i,
+ TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ERROR: ",
- opName[opCode], O2S(namePtr), i),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ERROR: ",
+ O2S(objPtr), i), Tcl_GetObjResult(interp));
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(valuePtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ",
- opName[opCode], O2S(namePtr), i), value2Ptr);
- Tcl_DecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ", O2S(objPtr), i),
+ value2Ptr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(valuePtr);
ADJUST_PC(1);
@@ -1509,7 +1401,7 @@ TclExecuteByteCode(interp, codePtr)
if (valuePtr->typePtr != &tclIntType) {
result = tclIntType.setFromAnyProc(interp, valuePtr);
if (result != TCL_OK) {
- TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
+ TRACE_WITH_OBJ(("%u \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
opnd, O2S(elemPtr), O2S(valuePtr)),
Tcl_GetObjResult(interp));
Tcl_DecrRefCount(elemPtr);
@@ -1523,7 +1415,7 @@ TclExecuteByteCode(interp, codePtr)
elemPtr, i);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ERROR: ",
+ TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ",
opnd, O2S(elemPtr), i),
Tcl_GetObjResult(interp));
Tcl_DecrRefCount(elemPtr);
@@ -1532,7 +1424,7 @@ TclExecuteByteCode(interp, codePtr)
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ",
+ TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ",
opnd, O2S(elemPtr), i), value2Ptr);
Tcl_DecrRefCount(elemPtr);
Tcl_DecrRefCount(valuePtr);
@@ -1545,14 +1437,14 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = POP_OBJECT();
elemPtr = POP_OBJECT();
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* array name */
if (valuePtr->typePtr != &tclIntType) {
result = tclIntType.setFromAnyProc(interp, valuePtr);
if (result != TCL_OK) {
- TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ",
- O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ",
+ O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(elemPtr);
Tcl_DecrRefCount(valuePtr);
goto checkForCatch;
@@ -1560,23 +1452,23 @@ TclExecuteByteCode(interp, codePtr)
}
i = valuePtr->internalRep.longValue;
DECACHE_STACK_INFO();
- value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
- /*part1NotParsed*/ 0);
+ value2Ptr = TclIncrVar2(interp, objPtr, elemPtr, i,
+ TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ERROR: ",
- O2S(namePtr), O2S(elemPtr), i),
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ",
+ O2S(objPtr), O2S(elemPtr), i),
Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(elemPtr);
Tcl_DecrRefCount(valuePtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ",
- O2S(namePtr), O2S(elemPtr), i), value2Ptr);
- Tcl_DecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ",
+ O2S(objPtr), O2S(elemPtr), i), value2Ptr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(elemPtr);
Tcl_DecrRefCount(valuePtr);
}
@@ -1589,36 +1481,34 @@ TclExecuteByteCode(interp, codePtr)
value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ERROR: ",
- opnd, i), Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%u %ld => ERROR: ", opnd, i),
+ Tcl_GetObjResult(interp));
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ", opnd, i),
- value2Ptr);
+ TRACE_WITH_OBJ(("%u %ld => ", opnd, i), value2Ptr);
ADJUST_PC(3);
case INST_INCR_SCALAR_STK_IMM:
case INST_INCR_STK_IMM:
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* variable name */
i = TclGetInt1AtPtr(pc+1);
DECACHE_STACK_INFO();
- value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
- /*part1NotParsed*/ (opCode == INST_INCR_STK_IMM));
+ value2Ptr = TclIncrVar2(interp, objPtr, (Tcl_Obj *) NULL, i,
+ TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ERROR: ",
- opName[opCode], O2S(namePtr), i),
- Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("\"%.30s\" %ld => ERROR: ",
+ O2S(objPtr), i), Tcl_GetObjResult(interp));
result = TCL_ERROR;
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ",
- opName[opCode], O2S(namePtr), i), value2Ptr);
- TclDecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s\" %ld => ", O2S(objPtr), i),
+ value2Ptr);
+ TclDecrRefCount(objPtr);
ADJUST_PC(2);
case INST_INCR_ARRAY1_IMM:
@@ -1633,7 +1523,7 @@ TclExecuteByteCode(interp, codePtr)
elemPtr, i);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ERROR: ",
+ TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ",
opnd, O2S(elemPtr), i),
Tcl_GetObjResult(interp));
Tcl_DecrRefCount(elemPtr);
@@ -1641,7 +1531,7 @@ TclExecuteByteCode(interp, codePtr)
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ",
+ TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ",
opnd, O2S(elemPtr), i), value2Ptr);
Tcl_DecrRefCount(elemPtr);
}
@@ -1653,37 +1543,42 @@ TclExecuteByteCode(interp, codePtr)
i = TclGetInt1AtPtr(pc+1);
elemPtr = POP_OBJECT();
- namePtr = POP_OBJECT();
+ objPtr = POP_OBJECT(); /* array name */
DECACHE_STACK_INFO();
- value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
- /*part1NotParsed*/ 0);
+ value2Ptr = TclIncrVar2(interp, objPtr, elemPtr, i,
+ TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ERROR: ",
- O2S(namePtr), O2S(elemPtr), i),
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ",
+ O2S(objPtr), O2S(elemPtr), i),
Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(namePtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(elemPtr);
result = TCL_ERROR;
goto checkForCatch;
}
PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ",
- O2S(namePtr), O2S(elemPtr), i), value2Ptr);
- Tcl_DecrRefCount(namePtr);
+ TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ",
+ O2S(objPtr), O2S(elemPtr), i), value2Ptr);
+ Tcl_DecrRefCount(objPtr);
Tcl_DecrRefCount(elemPtr);
}
ADJUST_PC(2);
case INST_JUMP1:
+#ifdef TCL_COMPILE_DEBUG
opnd = TclGetInt1AtPtr(pc+1);
- TRACE(("jump1 %d => new pc %u\n", opnd,
+ TRACE(("%d => new pc %u\n", opnd,
(unsigned int)(pc + opnd - codePtr->codeStart)));
- ADJUST_PC(opnd);
+ pc += opnd;
+#else
+ pc += TclGetInt1AtPtr(pc+1);
+#endif /* TCL_COMPILE_DEBUG */
+ continue;
case INST_JUMP4:
opnd = TclGetInt4AtPtr(pc+1);
- TRACE(("jump4 %d => new pc %u\n", opnd,
+ TRACE(("%d => new pc %u\n", opnd,
(unsigned int)(pc + opnd - codePtr->codeStart)));
ADJUST_PC(opnd);
@@ -1708,21 +1603,20 @@ TclExecuteByteCode(interp, codePtr)
} else {
result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%s %d => ERROR: ", opName[opCode],
- opnd), Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%d => ERROR: ", opnd),
+ Tcl_GetObjResult(interp));
Tcl_DecrRefCount(valuePtr);
goto checkForCatch;
}
}
if (b) {
- TRACE(("%s %d => %.20s true, new pc %u\n",
- opName[opCode], opnd, O2S(valuePtr),
+ TRACE(("%d => %.20s true, new pc %u\n",
+ opnd, O2S(valuePtr),
(unsigned int)(pc+opnd - codePtr->codeStart)));
TclDecrRefCount(valuePtr);
ADJUST_PC(opnd);
} else {
- TRACE(("%s %d => %.20s false\n", opName[opCode], opnd,
- O2S(valuePtr)));
+ TRACE(("%d => %.20s false\n", opnd, O2S(valuePtr)));
TclDecrRefCount(valuePtr);
ADJUST_PC(pcAdjustment);
}
@@ -1749,20 +1643,19 @@ TclExecuteByteCode(interp, codePtr)
} else {
result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%s %d => ERROR: ", opName[opCode],
- opnd), Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("%d => ERROR: ", opnd),
+ Tcl_GetObjResult(interp));
Tcl_DecrRefCount(valuePtr);
goto checkForCatch;
}
}
if (b) {
- TRACE(("%s %d => %.20s true\n", opName[opCode], opnd,
- O2S(valuePtr)));
+ TRACE(("%d => %.20s true\n", opnd, O2S(valuePtr)));
TclDecrRefCount(valuePtr);
ADJUST_PC(pcAdjustment);
} else {
- TRACE(("%s %d => %.20s false, new pc %u\n",
- opName[opCode], opnd, O2S(valuePtr),
+ TRACE(("%d => %.20s false, new pc %u\n",
+ opnd, O2S(valuePtr),
(unsigned int)(pc + opnd - codePtr->codeStart)));
TclDecrRefCount(valuePtr);
ADJUST_PC(opnd);
@@ -1791,9 +1684,9 @@ TclExecuteByteCode(interp, codePtr)
i1 = (valuePtr->internalRep.longValue != 0);
} else if (t1Ptr == &tclDoubleType) {
i1 = (valuePtr->internalRep.doubleValue != 0.0);
- } else { /* FAILS IF NULL STRING REP */
- s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
- if (TclLooksLikeInt(s)) {
+ } else {
+ s = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
valuePtr, &i);
i1 = (i != 0);
@@ -1803,10 +1696,10 @@ TclExecuteByteCode(interp, codePtr)
i1 = (i1 != 0);
}
if (result != TCL_OK) {
- TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
- opName[opCode], O2S(valuePtr),
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
+ O2S(valuePtr),
(t1Ptr? t1Ptr->name : "null")));
- IllegalExprOperandType(interp, opCode, valuePtr);
+ IllegalExprOperandType(interp, pc, valuePtr);
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto checkForCatch;
@@ -1817,22 +1710,21 @@ TclExecuteByteCode(interp, codePtr)
i2 = (value2Ptr->internalRep.longValue != 0);
} else if (t2Ptr == &tclDoubleType) {
i2 = (value2Ptr->internalRep.doubleValue != 0.0);
- } else { /* FAILS IF NULL STRING REP */
- s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
- if (TclLooksLikeInt(s)) {
+ } else {
+ s = Tcl_GetStringFromObj(value2Ptr, &length);
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
value2Ptr, &i);
i2 = (i != 0);
} else {
result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
value2Ptr, &i2);
- i2 = (i2 != 0);
}
if (result != TCL_OK) {
- TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
- opName[opCode], O2S(value2Ptr),
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
+ O2S(value2Ptr),
(t2Ptr? t2Ptr->name : "null")));
- IllegalExprOperandType(interp, opCode, value2Ptr);
+ IllegalExprOperandType(interp, pc, value2Ptr);
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto checkForCatch;
@@ -1843,19 +1735,18 @@ TclExecuteByteCode(interp, codePtr)
* Reuse the valuePtr object already on stack if possible.
*/
- if (opCode == INST_LOR) {
+ if (*pc == INST_LOR) {
iResult = (i1 || i2);
} else {
iResult = (i1 && i2);
}
if (Tcl_IsShared(valuePtr)) {
PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%s %.20s %.20s => %d\n", opName[opCode],
+ TRACE(("%.20s %.20s => %d\n",
O2S(valuePtr), O2S(value2Ptr), iResult));
TclDecrRefCount(valuePtr);
} else { /* reuse the valuePtr object */
- TRACE(("%s %.20s %.20s => %d\n",
- opName[opCode], /* NB: stack top is off by 1 */
+ TRACE(("%.20s %.20s => %d\n",
O2S(valuePtr), O2S(value2Ptr), iResult));
Tcl_SetLongObj(valuePtr, iResult);
++stackTop; /* valuePtr now on stk top has right r.c. */
@@ -1888,41 +1779,49 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = POP_OBJECT();
t1Ptr = valuePtr->typePtr;
t2Ptr = value2Ptr->typePtr;
-
- if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
- s1 = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s1)) { /* FAILS IF NULLS */
- (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d1);
+
+ /*
+ * We only want to coerce numeric validation if
+ * neither type is NULL. A NULL type means the arg is
+ * essentially an empty object ("", {} or [list]).
+ */
+ if (!((((t1Ptr == NULL) && (valuePtr->bytes == NULL))
+ || (valuePtr->bytes && (valuePtr->length == 0)))
+ || (((t2Ptr == NULL) && (value2Ptr->bytes == NULL))
+ || (value2Ptr->bytes && (value2Ptr->length == 0))))) {
+ if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
+ s1 = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s1, length)) {
+ (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+ valuePtr, &i);
+ } else {
+ (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+ valuePtr, &d1);
+ }
+ t1Ptr = valuePtr->typePtr;
}
- t1Ptr = valuePtr->typePtr;
- }
- if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
- s2 = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s2)) { /* FAILS IF NULLS */
- (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- value2Ptr, &i2);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- value2Ptr, &d2);
+ if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
+ s2 = Tcl_GetStringFromObj(value2Ptr, &length);
+ if (TclLooksLikeInt(s2, length)) {
+ (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+ value2Ptr, &i2);
+ } else {
+ (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+ value2Ptr, &d2);
+ }
+ t2Ptr = value2Ptr->typePtr;
}
- t2Ptr = value2Ptr->typePtr;
}
-
if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
|| ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
/*
* One operand is not numeric. Compare as strings.
- * THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
*/
int cmpValue;
- s1 = TclGetStringFromObj(valuePtr, &length);
- s2 = TclGetStringFromObj(value2Ptr, &length);
+ s1 = Tcl_GetString(valuePtr);
+ s2 = Tcl_GetString(value2Ptr);
cmpValue = strcmp(s1, s2);
- switch (opCode) {
+ switch (*pc) {
case INST_EQ:
iResult = (cmpValue == 0);
break;
@@ -1958,7 +1857,7 @@ TclExecuteByteCode(interp, codePtr)
d1 = valuePtr->internalRep.longValue;
d2 = value2Ptr->internalRep.doubleValue;
}
- switch (opCode) {
+ switch (*pc) {
case INST_EQ:
iResult = d1 == d2;
break;
@@ -1984,7 +1883,7 @@ TclExecuteByteCode(interp, codePtr)
*/
i = valuePtr->internalRep.longValue;
i2 = value2Ptr->internalRep.longValue;
- switch (opCode) {
+ switch (*pc) {
case INST_EQ:
iResult = i == i2;
break;
@@ -2012,13 +1911,12 @@ TclExecuteByteCode(interp, codePtr)
if (Tcl_IsShared(valuePtr)) {
PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%s %.20s %.20s => %ld\n", opName[opCode],
- O2S(valuePtr), O2S(value2Ptr), iResult));
+ TRACE(("%.20s %.20s => %ld\n",
+ O2S(valuePtr), O2S(value2Ptr), iResult));
TclDecrRefCount(valuePtr);
} else { /* reuse the valuePtr object */
- TRACE(("%s %.20s %.20s => %ld\n",
- opName[opCode], /* NB: stack top is off by 1 */
- O2S(valuePtr), O2S(value2Ptr), iResult));
+ TRACE(("%.20s %.20s => %ld\n",
+ O2S(valuePtr), O2S(value2Ptr), iResult));
Tcl_SetLongObj(valuePtr, iResult);
++stackTop; /* valuePtr now on stk top has right r.c. */
}
@@ -2048,11 +1946,11 @@ TclExecuteByteCode(interp, codePtr)
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
valuePtr, &i);
if (result != TCL_OK) {
- TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
- opName[opCode], O2S(valuePtr), O2S(value2Ptr),
+ TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
+ O2S(valuePtr), O2S(value2Ptr),
(valuePtr->typePtr?
valuePtr->typePtr->name : "null")));
- IllegalExprOperandType(interp, opCode, valuePtr);
+ IllegalExprOperandType(interp, pc, valuePtr);
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto checkForCatch;
@@ -2064,18 +1962,18 @@ TclExecuteByteCode(interp, codePtr)
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
value2Ptr, &i2);
if (result != TCL_OK) {
- TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
- opName[opCode], O2S(valuePtr), O2S(value2Ptr),
+ TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
+ O2S(valuePtr), O2S(value2Ptr),
(value2Ptr->typePtr?
value2Ptr->typePtr->name : "null")));
- IllegalExprOperandType(interp, opCode, value2Ptr);
+ IllegalExprOperandType(interp, pc, value2Ptr);
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto checkForCatch;
}
}
- switch (opCode) {
+ switch (*pc) {
case INST_MOD:
/*
* This code is tricky: C doesn't guarantee much about
@@ -2084,7 +1982,7 @@ TclExecuteByteCode(interp, codePtr)
* a smaller absolute value.
*/
if (i2 == 0) {
- TRACE(("mod %ld %ld => DIVIDE BY ZERO\n", i, i2));
+ TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto divideByZero;
@@ -2136,12 +2034,10 @@ TclExecuteByteCode(interp, codePtr)
if (Tcl_IsShared(valuePtr)) {
PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
- iResult));
+ TRACE(("%ld %ld => %ld\n", i, i2, iResult));
TclDecrRefCount(valuePtr);
} else { /* reuse the valuePtr object */
- TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
- iResult)); /* NB: stack top is off by 1 */
+ TRACE(("%ld %ld => %ld\n", i, i2, iResult));
Tcl_SetLongObj(valuePtr, iResult);
++stackTop; /* valuePtr now on stk top has right r.c. */
}
@@ -2173,11 +2069,18 @@ TclExecuteByteCode(interp, codePtr)
if (t1Ptr == &tclIntType) {
i = valuePtr->internalRep.longValue;
- } else if (t1Ptr == &tclDoubleType) {
+ } else if ((t1Ptr == &tclDoubleType)
+ && (valuePtr->bytes == NULL)) {
+ /*
+ * We can only use the internal rep directly if there is
+ * no string rep. Otherwise the string rep might actually
+ * look like an integer, which is preferred.
+ */
+
d1 = valuePtr->internalRep.doubleValue;
- } else { /* try to convert; FAILS IF NULLS */
+ } else {
char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s)) {
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
valuePtr, &i);
} else {
@@ -2185,11 +2088,11 @@ TclExecuteByteCode(interp, codePtr)
valuePtr, &d1);
}
if (result != TCL_OK) {
- TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
- opName[opCode], s, O2S(value2Ptr),
+ TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
+ s, O2S(valuePtr),
(valuePtr->typePtr?
valuePtr->typePtr->name : "null")));
- IllegalExprOperandType(interp, opCode, valuePtr);
+ IllegalExprOperandType(interp, pc, valuePtr);
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto checkForCatch;
@@ -2199,11 +2102,18 @@ TclExecuteByteCode(interp, codePtr)
if (t2Ptr == &tclIntType) {
i2 = value2Ptr->internalRep.longValue;
- } else if (t2Ptr == &tclDoubleType) {
+ } else if ((t2Ptr == &tclDoubleType)
+ && (value2Ptr->bytes == NULL)) {
+ /*
+ * We can only use the internal rep directly if there is
+ * no string rep. Otherwise the string rep might actually
+ * look like an integer, which is preferred.
+ */
+
d2 = value2Ptr->internalRep.doubleValue;
- } else { /* try to convert; FAILS IF NULLS */
+ } else {
char *s = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s)) {
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
value2Ptr, &i2);
} else {
@@ -2211,11 +2121,11 @@ TclExecuteByteCode(interp, codePtr)
value2Ptr, &d2);
}
if (result != TCL_OK) {
- TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
- opName[opCode], O2S(valuePtr), s,
+ TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
+ O2S(value2Ptr), s,
(value2Ptr->typePtr?
value2Ptr->typePtr->name : "null")));
- IllegalExprOperandType(interp, opCode, value2Ptr);
+ IllegalExprOperandType(interp, pc, value2Ptr);
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto checkForCatch;
@@ -2233,7 +2143,7 @@ TclExecuteByteCode(interp, codePtr)
} else if (t2Ptr == &tclIntType) {
d2 = i2; /* promote value 2 to double */
}
- switch (opCode) {
+ switch (*pc) {
case INST_ADD:
dResult = d1 + d2;
break;
@@ -2245,8 +2155,7 @@ TclExecuteByteCode(interp, codePtr)
break;
case INST_DIV:
if (d2 == 0.0) {
- TRACE(("div %.6g %.6g => DIVIDE BY ZERO\n",
- d1, d2));
+ TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto divideByZero;
@@ -2260,8 +2169,8 @@ TclExecuteByteCode(interp, codePtr)
*/
if (IS_NAN(dResult) || IS_INF(dResult)) {
- TRACE(("%s %.20s %.20s => IEEE FLOATING PT ERROR\n",
- opName[opCode], O2S(valuePtr), O2S(value2Ptr)));
+ TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
+ O2S(valuePtr), O2S(value2Ptr)));
TclExprFloatError(interp, dResult);
result = TCL_ERROR;
Tcl_DecrRefCount(valuePtr);
@@ -2272,7 +2181,7 @@ TclExecuteByteCode(interp, codePtr)
/*
* Do integer arithmetic.
*/
- switch (opCode) {
+ switch (*pc) {
case INST_ADD:
iResult = i + i2;
break;
@@ -2290,8 +2199,7 @@ TclExecuteByteCode(interp, codePtr)
* divisor and a smaller absolute value.
*/
if (i2 == 0) {
- TRACE(("div %ld %ld => DIVIDE BY ZERO\n",
- i, i2));
+ TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
goto divideByZero;
@@ -2317,22 +2225,18 @@ TclExecuteByteCode(interp, codePtr)
if (Tcl_IsShared(valuePtr)) {
if (doDouble) {
PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
- TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
- d1, d2, dResult));
+ TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
} else {
PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%s %ld %ld => %ld\n", opName[opCode],
- i, i2, iResult));
+ TRACE(("%ld %ld => %ld\n", i, i2, iResult));
}
TclDecrRefCount(valuePtr);
} else { /* reuse the valuePtr object */
if (doDouble) { /* NB: stack top is off by 1 */
- TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
- d1, d2, dResult));
+ TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
Tcl_SetDoubleObj(valuePtr, dResult);
} else {
- TRACE(("%s %ld %ld => %ld\n", opName[opCode],
- i, i2, iResult));
+ TRACE(("%ld %ld => %ld\n", i, i2, iResult));
Tcl_SetLongObj(valuePtr, iResult);
}
++stackTop; /* valuePtr now on stk top has right r.c. */
@@ -2350,11 +2254,12 @@ TclExecuteByteCode(interp, codePtr)
double d;
Tcl_ObjType *tPtr;
- valuePtr = stackPtr[stackTop].o;
+ valuePtr = stackPtr[stackTop];
tPtr = valuePtr->typePtr;
- if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
- if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
+ if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
+ || (valuePtr->bytes != NULL))) {
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
valuePtr, &i);
} else {
@@ -2362,14 +2267,39 @@ TclExecuteByteCode(interp, codePtr)
valuePtr, &d);
}
if (result != TCL_OK) {
- TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
- opName[opCode], s,
- (tPtr? tPtr->name : "null")));
- IllegalExprOperandType(interp, opCode, valuePtr);
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
+ s, (tPtr? tPtr->name : "null")));
+ IllegalExprOperandType(interp, pc, valuePtr);
goto checkForCatch;
}
+ tPtr = valuePtr->typePtr;
+ }
+
+ /*
+ * Ensure that the operand's string rep is the same as the
+ * formatted version of its internal rep. This makes sure
+ * that "expr +000123" yields "83", not "000123". We
+ * implement this by _discarding_ the string rep since we
+ * know it will be regenerated, if needed later, by
+ * formatting the internal rep's value.
+ */
+
+ if (Tcl_IsShared(valuePtr)) {
+ if (tPtr == &tclIntType) {
+ i = valuePtr->internalRep.longValue;
+ objPtr = Tcl_NewLongObj(i);
+ } else {
+ d = valuePtr->internalRep.doubleValue;
+ objPtr = Tcl_NewDoubleObj(d);
+ }
+ Tcl_IncrRefCount(objPtr);
+ Tcl_DecrRefCount(valuePtr);
+ valuePtr = objPtr;
+ stackPtr[stackTop] = valuePtr;
+ } else {
+ Tcl_InvalidateStringRep(valuePtr);
}
- TRACE_WITH_OBJ(("uplus %s => ", O2S(valuePtr)), valuePtr);
+ TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), valuePtr);
}
ADJUST_PC(1);
@@ -2388,22 +2318,27 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = POP_OBJECT();
tPtr = valuePtr->typePtr;
- if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
- if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
+ if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
+ || (valuePtr->bytes != NULL))) {
+ if ((tPtr == &tclBooleanType)
+ && (valuePtr->bytes == NULL)) {
+ valuePtr->typePtr = &tclIntType;
} else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d);
- }
- if (result != TCL_OK) {
- TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s\n",
- opName[opCode], s,
- (tPtr? tPtr->name : "null")));
- IllegalExprOperandType(interp, opCode, valuePtr);
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s, length)) {
+ result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+ valuePtr, &i);
+ } else {
+ result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+ valuePtr, &d);
+ }
+ if (result != TCL_OK) {
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
+ s, (tPtr? tPtr->name : "null")));
+ IllegalExprOperandType(interp, pc, valuePtr);
+ Tcl_DecrRefCount(valuePtr);
+ goto checkForCatch;
+ }
}
tPtr = valuePtr->typePtr;
}
@@ -2415,12 +2350,11 @@ TclExecuteByteCode(interp, codePtr)
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
objPtr = Tcl_NewLongObj(
- (opCode == INST_UMINUS)? -i : !i);
- TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
- objPtr); /* NB: stack top is off by 1 */
+ (*pc == INST_UMINUS)? -i : !i);
+ TRACE_WITH_OBJ(("%ld => ", i), objPtr);
} else {
d = valuePtr->internalRep.doubleValue;
- if (opCode == INST_UMINUS) {
+ if (*pc == INST_UMINUS) {
objPtr = Tcl_NewDoubleObj(-d);
} else {
/*
@@ -2429,8 +2363,7 @@ TclExecuteByteCode(interp, codePtr)
*/
objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
}
- TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
- objPtr); /* NB: stack top is off by 1 */
+ TRACE_WITH_OBJ(("%.6g => ", d), objPtr);
}
PUSH_OBJECT(objPtr);
TclDecrRefCount(valuePtr);
@@ -2441,12 +2374,11 @@ TclExecuteByteCode(interp, codePtr)
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
Tcl_SetLongObj(valuePtr,
- (opCode == INST_UMINUS)? -i : !i);
- TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
- valuePtr); /* NB: stack top is off by 1 */
+ (*pc == INST_UMINUS)? -i : !i);
+ TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
} else {
d = valuePtr->internalRep.doubleValue;
- if (opCode == INST_UMINUS) {
+ if (*pc == INST_UMINUS) {
Tcl_SetDoubleObj(valuePtr, -d);
} else {
/*
@@ -2455,8 +2387,7 @@ TclExecuteByteCode(interp, codePtr)
*/
Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
}
- TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
- valuePtr); /* NB: stack top is off by 1 */
+ TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
}
++stackTop; /* valuePtr now on stk top has right r.c. */
}
@@ -2480,9 +2411,9 @@ TclExecuteByteCode(interp, codePtr)
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
valuePtr, &i);
if (result != TCL_OK) { /* try to convert to double */
- TRACE(("bitnot \"%.20s\" => ILLEGAL TYPE %s\n",
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
O2S(valuePtr), (tPtr? tPtr->name : "null")));
- IllegalExprOperandType(interp, opCode, valuePtr);
+ IllegalExprOperandType(interp, pc, valuePtr);
Tcl_DecrRefCount(valuePtr);
goto checkForCatch;
}
@@ -2491,7 +2422,7 @@ TclExecuteByteCode(interp, codePtr)
i = valuePtr->internalRep.longValue;
if (Tcl_IsShared(valuePtr)) {
PUSH_OBJECT(Tcl_NewLongObj(~i));
- TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
+ TRACE(("0x%lx => (%lu)\n", i, ~i));
TclDecrRefCount(valuePtr);
} else {
/*
@@ -2499,7 +2430,7 @@ TclExecuteByteCode(interp, codePtr)
*/
Tcl_SetLongObj(valuePtr, ~i);
++stackTop; /* valuePtr now on stk top has right r.c. */
- TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
+ TRACE(("0x%lx => (%lu)\n", i, ~i));
}
}
ADJUST_PC(1);
@@ -2512,6 +2443,7 @@ TclExecuteByteCode(interp, codePtr)
*/
BuiltinFunc *mathFuncPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
@@ -2519,16 +2451,15 @@ TclExecuteByteCode(interp, codePtr)
}
mathFuncPtr = &(builtinFuncTable[opnd]);
DECACHE_STACK_INFO();
- tcl_MathInProgress++;
+ tsdPtr->mathInProgress++;
result = (*mathFuncPtr->proc)(interp, eePtr,
mathFuncPtr->clientData);
- tcl_MathInProgress--;
+ tsdPtr->mathInProgress--;
CACHE_STACK_INFO();
if (result != TCL_OK) {
goto checkForCatch;
}
- TRACE_WITH_OBJ(("callBuiltinFunc1 %d => ", opnd),
- stackPtr[stackTop].o);
+ TRACE_WITH_OBJ(("%d => ", opnd), stackPtr[stackTop]);
}
ADJUST_PC(2);
@@ -2544,18 +2475,18 @@ TclExecuteByteCode(interp, codePtr)
* is the 0-th argument. */
Tcl_Obj **objv; /* The array of arguments. The function
* name is objv[0]. */
-
- objv = &(stackPtr[stackTop - (objc-1)].o); /* "objv[0]" */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ objv = &(stackPtr[stackTop - (objc-1)]); /* "objv[0]" */
DECACHE_STACK_INFO();
- tcl_MathInProgress++;
+ tsdPtr->mathInProgress++;
result = ExprCallMathFunc(interp, eePtr, objc, objv);
- tcl_MathInProgress--;
+ tsdPtr->mathInProgress--;
CACHE_STACK_INFO();
if (result != TCL_OK) {
goto checkForCatch;
}
- TRACE_WITH_OBJ(("callFunc1 %d => ", objc),
- stackPtr[stackTop].o);
+ TRACE_WITH_OBJ(("%d => ", objc), stackPtr[stackTop]);
ADJUST_PC(2);
}
@@ -2573,22 +2504,29 @@ TclExecuteByteCode(interp, codePtr)
Tcl_ObjType *tPtr;
int converted, shared;
- valuePtr = stackPtr[stackTop].o;
+ valuePtr = stackPtr[stackTop];
tPtr = valuePtr->typePtr;
converted = 0;
- if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
- s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
- if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d);
- }
- if (result == TCL_OK) {
+ if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
+ || (valuePtr->bytes != NULL))) {
+ if ((tPtr == &tclBooleanType)
+ && (valuePtr->bytes == NULL)) {
+ valuePtr->typePtr = &tclIntType;
converted = 1;
+ } else {
+ s = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s, length)) {
+ result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+ valuePtr, &i);
+ } else {
+ result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+ valuePtr, &d);
+ }
+ if (result == TCL_OK) {
+ converted = 1;
+ }
+ result = TCL_OK; /* reset the result variable */
}
- result = TCL_OK; /* reset the result variable */
tPtr = valuePtr->typePtr;
}
@@ -2607,41 +2545,45 @@ TclExecuteByteCode(interp, codePtr)
shared = 0;
if (Tcl_IsShared(valuePtr)) {
shared = 1;
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- objPtr = Tcl_NewLongObj(i);
- } else {
- d = valuePtr->internalRep.doubleValue;
- objPtr = Tcl_NewDoubleObj(d);
+ if (valuePtr->bytes != NULL) {
+ /*
+ * We only need to make a copy of the object
+ * when it already had a string rep
+ */
+ if (tPtr == &tclIntType) {
+ i = valuePtr->internalRep.longValue;
+ objPtr = Tcl_NewLongObj(i);
+ } else {
+ d = valuePtr->internalRep.doubleValue;
+ objPtr = Tcl_NewDoubleObj(d);
+ }
+ Tcl_IncrRefCount(objPtr);
+ TclDecrRefCount(valuePtr);
+ valuePtr = objPtr;
+ stackPtr[stackTop] = valuePtr;
+ tPtr = valuePtr->typePtr;
}
- Tcl_IncrRefCount(objPtr);
- TclDecrRefCount(valuePtr);
- valuePtr = objPtr;
- tPtr = valuePtr->typePtr;
} else {
Tcl_InvalidateStringRep(valuePtr);
}
- stackPtr[stackTop].o = valuePtr;
if (tPtr == &tclDoubleType) {
d = valuePtr->internalRep.doubleValue;
if (IS_NAN(d) || IS_INF(d)) {
- TRACE(("tryCvtToNumeric \"%.20s\" => IEEE FLOATING PT ERROR\n",
+ TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
O2S(valuePtr)));
TclExprFloatError(interp, d);
result = TCL_ERROR;
goto checkForCatch;
}
}
- shared = shared; /* lint, shared not used. */
- converted = converted; /* lint, converted not used. */
- TRACE(("tryCvtToNumeric \"%.20s\" => numeric, %s, %s\n",
- O2S(valuePtr),
+ shared = shared; /* lint, shared not used. */
+ converted = converted; /* lint, converted not used. */
+ TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr),
(converted? "converted" : "not converted"),
(shared? "shared" : "not shared")));
} else {
- TRACE(("tryCvtToNumeric \"%.20s\" => not numeric\n",
- O2S(valuePtr)));
+ TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
}
}
ADJUST_PC(1);
@@ -2656,22 +2598,21 @@ TclExecuteByteCode(interp, codePtr)
*/
Tcl_ResetResult(interp);
- rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
- codePtr);
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
if (rangePtr == NULL) {
- TRACE(("break => no encl. loop or catch, returning TCL_BREAK\n"));
+ TRACE(("=> no encl. loop or catch, returning TCL_BREAK\n"));
result = TCL_BREAK;
goto abnormalReturn; /* no catch exists to check */
}
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
result = TCL_OK;
- TRACE(("break => range at %d, new pc %d\n",
+ TRACE(("=> range at %d, new pc %d\n",
rangePtr->codeOffset, rangePtr->breakOffset));
break;
case CATCH_EXCEPTION_RANGE:
result = TCL_BREAK;
- TRACE(("break => ...\n"));
+ TRACE(("=> ...\n"));
goto processCatch; /* it will use rangePtr */
default:
panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
@@ -2689,27 +2630,26 @@ TclExecuteByteCode(interp, codePtr)
*/
Tcl_ResetResult(interp);
- rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
- codePtr);
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
if (rangePtr == NULL) {
- TRACE(("continue => no encl. loop or catch, returning TCL_CONTINUE\n"));
+ TRACE(("=> no encl. loop or catch, returning TCL_CONTINUE\n"));
result = TCL_CONTINUE;
goto abnormalReturn;
}
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
if (rangePtr->continueOffset == -1) {
- TRACE(("continue => loop w/o continue, checking for catch\n"));
+ TRACE(("=> loop w/o continue, checking for catch\n"));
goto checkForCatch;
} else {
result = TCL_OK;
- TRACE(("continue => range at %d, new pc %d\n",
+ TRACE(("=> range at %d, new pc %d\n",
rangePtr->codeOffset, rangePtr->continueOffset));
}
break;
case CATCH_EXCEPTION_RANGE:
result = TCL_CONTINUE;
- TRACE(("continue => ...\n"));
+ TRACE(("=> ...\n"));
goto processCatch; /* it will use rangePtr */
default:
panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
@@ -2727,14 +2667,11 @@ TclExecuteByteCode(interp, codePtr)
ForeachInfo *infoPtr = (ForeachInfo *)
codePtr->auxDataArrayPtr[opnd].clientData;
- int iterTmpIndex = infoPtr->loopIterNumTmp;
- CallFrame *varFramePtr = iPtr->varFramePtr;
- Var *compiledLocals = varFramePtr->compiledLocals;
- Var *iterVarPtr;
- Tcl_Obj *oldValuePtr;
-
- iterVarPtr = &(compiledLocals[iterTmpIndex]);
- oldValuePtr = iterVarPtr->value.objPtr;
+ int iterTmpIndex = infoPtr->loopCtTemp;
+ Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
+ Var *iterVarPtr = &(compiledLocals[iterTmpIndex]);
+ Tcl_Obj *oldValuePtr = iterVarPtr->value.objPtr;
+
if (oldValuePtr == NULL) {
iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
Tcl_IncrRefCount(iterVarPtr->value.objPtr);
@@ -2743,7 +2680,7 @@ TclExecuteByteCode(interp, codePtr)
}
TclSetVarScalar(iterVarPtr);
TclClearVarUndefined(iterVarPtr);
- TRACE(("foreach_start4 %u => loop iter count temp %d\n",
+ TRACE(("%u => loop iter count temp %d\n",
opnd, iterTmpIndex));
}
ADJUST_PC(5);
@@ -2757,43 +2694,41 @@ TclExecuteByteCode(interp, codePtr)
*/
ForeachInfo *infoPtr = (ForeachInfo *)
- codePtr->auxDataArrayPtr[opnd].clientData;
+ codePtr->auxDataArrayPtr[opnd].clientData;
ForeachVarList *varListPtr;
int numLists = infoPtr->numLists;
- int iterTmpIndex = infoPtr->loopIterNumTmp;
- CallFrame *varFramePtr = iPtr->varFramePtr;
- Var *compiledLocals = varFramePtr->compiledLocals;
- int iterNum, listTmpIndex, listLen, numVars;
- int varIndex, valIndex, j;
- Tcl_Obj *listPtr, *elemPtr, *oldValuePtr;
+ Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
+ Tcl_Obj *listPtr;
List *listRepPtr;
Var *iterVarPtr, *listVarPtr;
- int continueLoop = 0;
+ int iterNum, listTmpIndex, listLen, numVars;
+ int varIndex, valIndex, continueLoop, j;
/*
* Increment the temp holding the loop iteration number.
*/
- iterVarPtr = &(compiledLocals[iterTmpIndex]);
- oldValuePtr = iterVarPtr->value.objPtr;
- iterNum = (oldValuePtr->internalRep.longValue + 1);
- Tcl_SetLongObj(oldValuePtr, iterNum);
+ iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
+ valuePtr = iterVarPtr->value.objPtr;
+ iterNum = (valuePtr->internalRep.longValue + 1);
+ Tcl_SetLongObj(valuePtr, iterNum);
/*
* Check whether all value lists are exhausted and we should
* stop the loop.
*/
- listTmpIndex = infoPtr->firstListTmp;
+ continueLoop = 0;
+ listTmpIndex = infoPtr->firstValueTemp;
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
-
+
listVarPtr = &(compiledLocals[listTmpIndex]);
listPtr = listVarPtr->value.objPtr;
result = Tcl_ListObjLength(interp, listPtr, &listLen);
if (result != TCL_OK) {
- TRACE_WITH_OBJ(("foreach_step4 %u => ERROR converting list %ld, \"%s\": ",
+ TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
opnd, i, O2S(listPtr)),
Tcl_GetObjResult(interp));
goto checkForCatch;
@@ -2812,15 +2747,14 @@ TclExecuteByteCode(interp, codePtr)
*/
if (continueLoop) {
- listTmpIndex = infoPtr->firstListTmp;
+ listTmpIndex = infoPtr->firstValueTemp;
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
listVarPtr = &(compiledLocals[listTmpIndex]);
listPtr = listVarPtr->value.objPtr;
- listRepPtr = (List *)
- listPtr->internalRep.otherValuePtr;
+ listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
listLen = listRepPtr->elemCount;
valIndex = (iterNum * numVars);
@@ -2828,22 +2762,22 @@ TclExecuteByteCode(interp, codePtr)
int setEmptyStr = 0;
if (valIndex >= listLen) {
setEmptyStr = 1;
- elemPtr = Tcl_NewObj();
+ valuePtr = Tcl_NewObj();
} else {
- elemPtr = listRepPtr->elements[valIndex];
+ valuePtr = listRepPtr->elements[valIndex];
}
varIndex = varListPtr->varIndexes[j];
DECACHE_STACK_INFO();
value2Ptr = TclSetIndexedScalar(interp,
- varIndex, elemPtr, /*leaveErrorMsg*/ 1);
+ varIndex, valuePtr, /*leaveErrorMsg*/ 1);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("foreach_step4 %u => ERROR init. index temp %d: ",
+ TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
opnd, varIndex),
Tcl_GetObjResult(interp));
if (setEmptyStr) {
- Tcl_DecrRefCount(elemPtr); /* unneeded */
+ Tcl_DecrRefCount(valuePtr);
}
result = TCL_ERROR;
goto checkForCatch;
@@ -2855,13 +2789,12 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Now push a "1" object if at least one value list had a
- * remaining element and the loop should continue.
- * Otherwise push "0".
+ * Push 1 if at least one value list had a remaining element
+ * and the loop should continue. Otherwise push 0.
*/
PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
- TRACE(("foreach_step4 %u => %d lists, iter %d, %s loop\n",
+ TRACE(("%u => %d lists, iter %d, %s loop\n",
opnd, numLists, iterNum,
(continueLoop? "continue" : "exit")));
}
@@ -2874,29 +2807,28 @@ TclExecuteByteCode(interp, codePtr)
* special catch stack.
*/
catchStackPtr[++catchTop] = stackTop;
- TRACE(("beginCatch4 %u => catchTop=%d, stackTop=%d\n",
+ TRACE(("%u => catchTop=%d, stackTop=%d\n",
TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
ADJUST_PC(5);
case INST_END_CATCH:
catchTop--;
result = TCL_OK;
- TRACE(("endCatch => catchTop=%d\n", catchTop));
+ TRACE(("=> catchTop=%d\n", catchTop));
ADJUST_PC(1);
case INST_PUSH_RESULT:
PUSH_OBJECT(Tcl_GetObjResult(interp));
- TRACE_WITH_OBJ(("pushResult => "), Tcl_GetObjResult(interp));
+ TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp));
ADJUST_PC(1);
case INST_PUSH_RETURN_CODE:
PUSH_OBJECT(Tcl_NewLongObj(result));
- TRACE(("pushReturnCode => %u\n", result));
+ TRACE(("=> %u\n", result));
ADJUST_PC(1);
default:
- TRACE(("UNRECOGNIZED INSTRUCTION %u\n", opCode));
- panic("TclExecuteByteCode: unrecognized opCode %u", opCode);
+ panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
} /* end of switch on opCode */
/*
@@ -2921,12 +2853,20 @@ TclExecuteByteCode(interp, codePtr)
checkForCatch:
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- RecordTracebackInfo(interp, pc, codePtr);
+ bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ if (bytes != NULL) {
+ Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
}
- rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
if (rangePtr == NULL) {
- TRACE((" ... no enclosing catch, returning %s\n",
- StringForResultCode(result)));
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " ... no enclosing catch, returning %s\n",
+ StringForResultCode(result));
+ }
+#endif
goto abnormalReturn;
}
@@ -2944,9 +2884,13 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
- TRACE((" ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
rangePtr->codeOffset, catchTop, catchStackPtr[catchTop],
- (unsigned int)(rangePtr->catchOffset)));
+ (unsigned int)(rangePtr->catchOffset));
+ }
+#endif
pc = (codePtr->codeStart + rangePtr->catchOffset);
continue; /* restart the execution loop at pc */
} /* end of infinite loop dispatching on instructions */
@@ -2975,6 +2919,7 @@ TclExecuteByteCode(interp, codePtr)
#undef STATIC_CATCH_STACK_SIZE
}
+#ifdef TCL_COMPILE_DEBUG
/*
*----------------------------------------------------------------------
*
@@ -2999,45 +2944,44 @@ PrintByteCodeInfo(codePtr)
* to stdout. */
{
Proc *procPtr = codePtr->procPtr;
- int numCmds = codePtr->numCommands;
- int numObjs = codePtr->numObjects;
- int objBytes, i;
-
- objBytes = (numObjs * sizeof(Tcl_Obj));
- for (i = 0; i < numObjs; i++) {
- Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
- if (litObjPtr->bytes != NULL) {
- objBytes += litObjPtr->length;
- }
- }
-
- fprintf(stdout, "\nExecuting ByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
+ Interp *iPtr = (Interp *) *codePtr->interpHandle;
+
+ fprintf(stdout, "\nExecuting ByteCode 0x%x, refCt %u, epoch %u, interp 0x%x (epoch %u)\n",
(unsigned int) codePtr, codePtr->refCount,
- codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
- codePtr->iPtr->compileEpoch);
+ codePtr->compileEpoch, (unsigned int) iPtr,
+ iPtr->compileEpoch);
fprintf(stdout, " Source: ");
- TclPrintSource(stdout, codePtr->source, 70);
+ TclPrintSource(stdout, codePtr->source, 60);
- fprintf(stdout, "\n Cmds %d, chars %d, inst %u, objs %u, aux %d, stk depth %u, code/src %.2fn",
- numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
+ fprintf(stdout, "\n Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
+ codePtr->numCommands, codePtr->numSrcBytes,
+ codePtr->numCodeBytes, codePtr->numLitObjects,
codePtr->numAuxDataItems, codePtr->maxStackDepth,
- (codePtr->numSrcChars?
- ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
-
- fprintf(stdout, " Code %d = %d(header)+%d(inst)+%d(objs)+%d(exc)+%d(aux)+%d(cmd map)\n",
- codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
- objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
+#ifdef TCL_COMPILE_STATS
+ (codePtr->numSrcBytes?
+ ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
+#else
+ 0.0);
+#endif
+#ifdef TCL_COMPILE_STATS
+ fprintf(stdout, " Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
+ codePtr->structureSize,
+ (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
+ codePtr->numCodeBytes,
+ (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+ (codePtr->numExceptRanges * sizeof(ExceptionRange)),
(codePtr->numAuxDataItems * sizeof(AuxData)),
codePtr->numCmdLocBytes);
-
+#endif /* TCL_COMPILE_STATS */
if (procPtr != NULL) {
fprintf(stdout,
- " Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
+ " Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
(unsigned int) procPtr, procPtr->refCount,
procPtr->numArgs, procPtr->numCompiledLocals);
}
}
+#endif /* TCL_COMPILE_DEBUG */
/*
*----------------------------------------------------------------------
@@ -3060,7 +3004,8 @@ PrintByteCodeInfo(codePtr)
#ifdef TCL_COMPILE_DEBUG
static void
-ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, stackUpperBound)
+ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
+ stackUpperBound)
register ByteCode *codePtr; /* The bytecode whose summary is printed
* to stdout. */
unsigned char *pc; /* Points to first byte of a bytecode
@@ -3116,8 +3061,7 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, stackUpperBound)
*
* Used by TclExecuteByteCode to add an error message to errorInfo
* when an illegal operand type is detected by an expression
- * instruction. The argument opCode holds the failing instruction's
- * opcode and opndPtr holds the operand object in error.
+ * instruction. The argument opndPtr holds the operand object in error.
*
* Results:
* None.
@@ -3129,24 +3073,46 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, stackUpperBound)
*/
static void
-IllegalExprOperandType(interp, opCode, opndPtr)
+IllegalExprOperandType(interp, pc, opndPtr)
Tcl_Interp *interp; /* Interpreter to which error information
* pertains. */
- unsigned int opCode; /* The instruction opcode being executed
+ unsigned char *pc; /* Points to the instruction being executed
* when the illegal type was found. */
Tcl_Obj *opndPtr; /* Points to the operand holding the value
* with the illegal type. */
{
+ unsigned char opCode = *pc;
+
Tcl_ResetResult(interp);
if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"can't use empty string as operand of \"",
operatorStrings[opCode - INST_LOR], "\"", (char *) NULL);
} else {
+ char *msg = "non-numeric string";
+ if (opndPtr->typePtr != &tclDoubleType) {
+ /*
+ * See if the operand can be interpreted as a double in order to
+ * improve the error message.
+ */
+
+ char *s = Tcl_GetString(opndPtr);
+ double d;
+
+ if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) == TCL_OK) {
+ /*
+ * Make sure that what appears to be a double
+ * (ie 08) isn't really a bad octal
+ */
+ if (TclCheckBadOctal(NULL, Tcl_GetString(opndPtr))) {
+ msg = "invalid octal number";
+ } else {
+ msg = "floating-point value";
+ }
+ }
+ }
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
- ((opndPtr->typePtr == &tclDoubleType) ?
- "floating-point value" : "non-numeric string"),
- " as operand of \"", operatorStrings[opCode - INST_LOR],
+ msg, " as operand of \"", operatorStrings[opCode - INST_LOR],
"\"", (char *) NULL);
}
}
@@ -3192,7 +3158,6 @@ CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
* Get the string rep from the objv argument objects and place their
* pointers in argv. First make sure argv is large enough to hold the
* objc args plus 1 extra word for the zero end-of-argv word.
- * THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
*/
argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
@@ -3223,76 +3188,6 @@ CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
/*
*----------------------------------------------------------------------
*
- * RecordTracebackInfo --
- *
- * Procedure called by TclExecuteByteCode to record information
- * about what was being executed when the error occurred.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Appends information about the command being executed to the
- * "errorInfo" variable. Sets the errorLine field in the interpreter
- * to the line number of that command. Sets the ERR_ALREADY_LOGGED
- * bit in the interpreter's execution flags.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-RecordTracebackInfo(interp, pc, codePtr)
- Tcl_Interp *interp; /* The interpreter in which the error
- * occurred. */
- unsigned char *pc; /* The program counter value where the error * occurred. This points to a bytecode
- * instruction in codePtr's code. */
- ByteCode *codePtr; /* The bytecode sequence being executed. */
-{
- register Interp *iPtr = (Interp *) interp;
- char *cmd, *ellipsis;
- char buf[200];
- register char *p;
- int numChars;
-
- /*
- * Record the command in errorInfo (up to a certain number of
- * characters, or up to the first newline).
- */
-
- iPtr->errorLine = 1;
- cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
- if (cmd != NULL) {
- for (p = codePtr->source; p != cmd; p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
- }
- }
- for ( ; (isspace(UCHAR(*p)) || (*p == ';')); p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
- }
- }
-
- ellipsis = "";
- if (numChars > 150) {
- numChars = 150;
- ellipsis = "...";
- }
- if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- sprintf(buf, "\n while executing\n\"%.*s%s\"",
- numChars, cmd, ellipsis);
- } else {
- sprintf(buf, "\n invoked from within\n\"%.*s%s\"",
- numChars, cmd, ellipsis);
- }
- Tcl_AddObjErrorInfo(interp, buf, -1);
- iPtr->flags |= ERR_ALREADY_LOGGED;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* GetSrcInfoForPc --
*
* Given a program counter value, finds the closest command in the
@@ -3415,10 +3310,10 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
/*
*----------------------------------------------------------------------
*
- * TclGetExceptionRangeForPc --
+ * GetExceptRangeForPc --
*
- * Procedure that given a program counter value, returns the closest
- * enclosing ExceptionRange that matches the kind requested.
+ * Given a program counter value, return the closest enclosing
+ * ExceptionRange.
*
* Results:
* In the normal case, catchOnly is 0 (false) and this procedure
@@ -3426,7 +3321,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
* 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 (true), this
+ * 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 ExceptionRange is found that
* encloses pc, a NULL is returned.
@@ -3437,32 +3332,37 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
*----------------------------------------------------------------------
*/
-ExceptionRange *
-TclGetExceptionRangeForPc(pc, catchOnly, codePtr)
+static ExceptionRange *
+GetExceptRangeForPc(pc, catchOnly, codePtr)
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. Otherwise
+ * ExceptionRanges in search. If nonzero
* consider only catch ranges (and ignore
* any closer loop ranges). */
ByteCode* codePtr; /* Points to the ByteCode in which to search
* for the enclosing ExceptionRange. */
{
- ExceptionRange *rangeArrayPtr = codePtr->excRangeArrayPtr;
- int numRanges = codePtr->numExcRanges;
+ ExceptionRange *rangeArrayPtr;
+ int numRanges = codePtr->numExceptRanges;
register ExceptionRange *rangePtr;
- int codeOffset = (pc - codePtr->codeStart);
+ int pcOffset = (pc - codePtr->codeStart);
register int i, level;
- for (level = codePtr->maxExcRangeDepth; level >= 0; level--) {
+ if (numRanges == 0) {
+ return NULL;
+ }
+ rangeArrayPtr = codePtr->exceptArrayPtr;
+
+ for (level = codePtr->maxExceptDepth; level >= 0; level--) {
for (i = 0; i < numRanges; i++) {
rangePtr = &(rangeArrayPtr[i]);
if (rangePtr->nestingLevel == level) {
int start = rangePtr->codeOffset;
int end = (start + rangePtr->numCodeBytes);
- if ((start <= codeOffset) && (codeOffset < end)) {
+ if ((start <= pcOffset) && (pcOffset < end)) {
if ((!catchOnly)
|| (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
return rangePtr;
@@ -3477,6 +3377,91 @@ TclGetExceptionRangeForPc(pc, catchOnly, codePtr)
/*
*----------------------------------------------------------------------
*
+ * GetOpcodeName --
+ *
+ * This procedure is called by the TRACE and TRACE_WITH_OBJ macros
+ * used in TclExecuteByteCode when debugging. It returns the name of
+ * the bytecode instruction at a specified instruction pc.
+ *
+ * Results:
+ * A character string for the instruction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static char *
+GetOpcodeName(pc)
+ unsigned char *pc; /* Points to the instruction whose name
+ * should be returned. */
+{
+ unsigned char opCode = *pc;
+
+ return instructionTable[opCode].name;
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * VerifyExprObjType --
+ *
+ * This procedure is called by the math functions to verify that
+ * the object is either an int or double, coercing it if necessary.
+ * If an error occurs during conversion, an error message is left
+ * in the interpreter's result unless "interp" is NULL.
+ *
+ * Results:
+ * TCL_OK if it was int or double, TCL_ERROR otherwise
+ *
+ * Side effects:
+ * objPtr is ensured to be either tclIntType of tclDoubleType.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+VerifyExprObjType(interp, objPtr)
+ Tcl_Interp *interp; /* The interpreter in which to execute the
+ * function. */
+ Tcl_Obj *objPtr; /* Points to the object to type check. */
+{
+ if ((objPtr->typePtr == &tclIntType) ||
+ (objPtr->typePtr == &tclDoubleType)) {
+ return TCL_OK;
+ } else {
+ int length, result = TCL_OK;
+ char *s = Tcl_GetStringFromObj(objPtr, &length);
+
+ if (TclLooksLikeInt(s, length)) {
+ long i;
+ result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, objPtr, &i);
+ } else {
+ double d;
+ result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d);
+ }
+ if ((result != TCL_OK) && (interp != NULL)) {
+ Tcl_ResetResult(interp);
+ if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "argument to math function was an invalid octal number",
+ -1);
+ } else {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "argument to math function didn't have numeric value",
+ -1);
+ }
+ }
+ return result;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Math Functions --
*
* This page contains the procedures that implement all of the
@@ -3503,13 +3488,11 @@ ExprUnaryFunc(interp, eePtr, clientData)
* takes one double argument and returns a
* double result. */
{
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
register Tcl_Obj *valuePtr;
- Tcl_ObjType *tPtr;
double d, dResult;
- long i;
- int result = TCL_OK;
+ int result;
double (*func) _ANSI_ARGS_((double)) =
(double (*)_ANSI_ARGS_((double))) clientData;
@@ -3517,7 +3500,8 @@ ExprUnaryFunc(interp, eePtr, clientData)
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3526,27 +3510,16 @@ ExprUnaryFunc(interp, eePtr, clientData)
*/
valuePtr = POP_OBJECT();
- tPtr = valuePtr->typePtr;
+
+ if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
- if (tPtr == &tclIntType) {
+ if (valuePtr->typePtr == &tclIntType) {
d = (double) valuePtr->internalRep.longValue;
- } else if (tPtr == &tclDoubleType) {
+ } else {
d = valuePtr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
-
- if (TclLooksLikeInt(s)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
- d = (double) valuePtr->internalRep.longValue;
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
- }
- if (result != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "argument to math function didn't have numeric value", -1);
- goto done;
- }
}
errno = 0;
@@ -3583,14 +3556,11 @@ ExprBinaryFunc(interp, eePtr, clientData)
* takes two double arguments and
* returns a double result. */
{
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
register Tcl_Obj *valuePtr, *value2Ptr;
- Tcl_ObjType *tPtr;
double d1, d2, dResult;
- long i;
- char *s;
- int result = TCL_OK;
+ int result;
double (*func) _ANSI_ARGS_((double, double))
= (double (*)_ANSI_ARGS_((double, double))) clientData;
@@ -3598,7 +3568,8 @@ ExprBinaryFunc(interp, eePtr, clientData)
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3609,44 +3580,22 @@ ExprBinaryFunc(interp, eePtr, clientData)
value2Ptr = POP_OBJECT();
valuePtr = POP_OBJECT();
- tPtr = valuePtr->typePtr;
- if (tPtr == &tclIntType) {
+ if ((VerifyExprObjType(interp, valuePtr) != TCL_OK) ||
+ (VerifyExprObjType(interp, value2Ptr) != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ if (valuePtr->typePtr == &tclIntType) {
d1 = (double) valuePtr->internalRep.longValue;
- } else if (tPtr == &tclDoubleType) {
+ } else {
d1 = valuePtr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
- if (TclLooksLikeInt(s)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
- d1 = (double) valuePtr->internalRep.longValue;
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1);
- }
- if (result != TCL_OK) {
- badArg:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "argument to math function didn't have numeric value", -1);
- goto done;
- }
}
- tPtr = value2Ptr->typePtr;
- if (tPtr == &tclIntType) {
- d2 = value2Ptr->internalRep.longValue;
- } else if (tPtr == &tclDoubleType) {
+ if (value2Ptr->typePtr == &tclIntType) {
+ d2 = (double) value2Ptr->internalRep.longValue;
+ } else {
d2 = value2Ptr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
- if (TclLooksLikeInt(s)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i);
- d2 = (double) value2Ptr->internalRep.longValue;
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2);
- }
- if (result != TCL_OK) {
- goto badArg;
- }
}
errno = 0;
@@ -3682,18 +3631,18 @@ ExprAbsFunc(interp, eePtr, clientData)
* the function. */
ClientData clientData; /* Ignored. */
{
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
register Tcl_Obj *valuePtr;
- Tcl_ObjType *tPtr;
long i, iResult;
double d, dResult;
- int result = TCL_OK;
+ int result;
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3701,34 +3650,17 @@ ExprAbsFunc(interp, eePtr, clientData)
*/
valuePtr = POP_OBJECT();
- tPtr = valuePtr->typePtr;
-
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- } else if (tPtr == &tclDoubleType) {
- d = valuePtr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
-
- if (TclLooksLikeInt(s)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
- }
- if (result != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "argument to math function didn't have numeric value", -1);
- goto done;
- }
- tPtr = valuePtr->typePtr;
+
+ if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
}
/*
* Push a Tcl object with the result.
*/
-
- if (tPtr == &tclIntType) {
+ if (valuePtr->typePtr == &tclIntType) {
+ i = valuePtr->internalRep.longValue;
if (i < 0) {
iResult = -i;
if (iResult < 0) {
@@ -3745,6 +3677,7 @@ ExprAbsFunc(interp, eePtr, clientData)
}
PUSH_OBJECT(Tcl_NewLongObj(iResult));
} else {
+ d = valuePtr->internalRep.doubleValue;
if (d < 0.0) {
dResult = -d;
} else {
@@ -3757,7 +3690,7 @@ ExprAbsFunc(interp, eePtr, clientData)
}
PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
}
-
+
/*
* Reflect the change to stackTop back in eePtr.
*/
@@ -3776,17 +3709,17 @@ ExprDoubleFunc(interp, eePtr, clientData)
* the function. */
ClientData clientData; /* Ignored. */
{
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
register Tcl_Obj *valuePtr;
double dResult;
- long i;
- int result = TCL_OK;
+ int result;
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3794,26 +3727,16 @@ ExprDoubleFunc(interp, eePtr, clientData)
*/
valuePtr = POP_OBJECT();
+
+ if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
if (valuePtr->typePtr == &tclIntType) {
dResult = (double) valuePtr->internalRep.longValue;
- } else if (valuePtr->typePtr == &tclDoubleType) {
+ } else {
dResult = valuePtr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
-
- if (TclLooksLikeInt(s)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
- dResult = (double) valuePtr->internalRep.longValue;
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr,
- &dResult);
- }
- if (result != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "argument to math function didn't have numeric value", -1);
- goto done;
- }
}
/*
@@ -3840,19 +3763,18 @@ ExprIntFunc(interp, eePtr, clientData)
* the function. */
ClientData clientData; /* Ignored. */
{
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
register Tcl_Obj *valuePtr;
- Tcl_ObjType *tPtr;
- long i = 0; /* Initialized to avoid compiler warning. */
long iResult;
double d;
- int result = TCL_OK;
+ int result;
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3860,36 +3782,16 @@ ExprIntFunc(interp, eePtr, clientData)
*/
valuePtr = POP_OBJECT();
- tPtr = valuePtr->typePtr;
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- } else if (tPtr == &tclDoubleType) {
- d = valuePtr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
-
- if (TclLooksLikeInt(s)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
- }
- if (result != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "argument to math function didn't have numeric value", -1);
- goto done;
- }
- tPtr = valuePtr->typePtr;
+ if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
}
-
- /*
- * Push a Tcl object with the result.
- */
- if (tPtr == &tclIntType) {
- iResult = i;
+ if (valuePtr->typePtr == &tclIntType) {
+ iResult = valuePtr->internalRep.longValue;
} else {
+ d = valuePtr->internalRep.doubleValue;
if (d < 0.0) {
if (d < (double) (long) LONG_MIN) {
tooLarge:
@@ -3913,6 +3815,11 @@ ExprIntFunc(interp, eePtr, clientData)
}
iResult = (long) d;
}
+
+ /*
+ * Push a Tcl object with the result.
+ */
+
PUSH_OBJECT(Tcl_NewLongObj(iResult));
/*
@@ -3933,7 +3840,7 @@ ExprRandFunc(interp, eePtr, clientData)
* the function. */
ClientData clientData; /* Ignored. */
{
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
Interp *iPtr = (Interp *) interp;
double dResult;
@@ -4021,19 +3928,18 @@ ExprRoundFunc(interp, eePtr, clientData)
* the function. */
ClientData clientData; /* Ignored. */
{
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
Tcl_Obj *valuePtr;
- Tcl_ObjType *tPtr;
- long i = 0; /* Initialized to avoid compiler warning. */
long iResult;
double d, temp;
- int result = TCL_OK;
+ int result;
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -4041,36 +3947,16 @@ ExprRoundFunc(interp, eePtr, clientData)
*/
valuePtr = POP_OBJECT();
- tPtr = valuePtr->typePtr;
-
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- } else if (tPtr == &tclDoubleType) {
- d = valuePtr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
-
- if (TclLooksLikeInt(s)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
- }
- if (result != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "argument to math function didn't have numeric value", -1);
- goto done;
- }
- tPtr = valuePtr->typePtr;
- }
- /*
- * Push a Tcl object with the result.
- */
+ if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
- if (tPtr == &tclIntType) {
- iResult = i;
+ if (valuePtr->typePtr == &tclIntType) {
+ iResult = valuePtr->internalRep.longValue;
} else {
+ d = valuePtr->internalRep.doubleValue;
if (d < 0.0) {
if (d <= (((double) (long) LONG_MIN) - 0.5)) {
tooLarge:
@@ -4097,6 +3983,11 @@ ExprRoundFunc(interp, eePtr, clientData)
}
iResult = (long) temp;
}
+
+ /*
+ * Push a Tcl object with the result.
+ */
+
PUSH_OBJECT(Tcl_NewLongObj(iResult));
/*
@@ -4117,11 +4008,10 @@ ExprSrandFunc(interp, eePtr, clientData)
* the function. */
ClientData clientData; /* Ignored. */
{
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
Interp *iPtr = (Interp *) interp;
Tcl_Obj *valuePtr;
- Tcl_ObjType *tPtr;
long i = 0; /* Initialized to avoid compiler warning. */
int result;
@@ -4137,21 +4027,26 @@ ExprSrandFunc(interp, eePtr, clientData)
*/
valuePtr = POP_OBJECT();
- tPtr = valuePtr->typePtr;
-
- if (tPtr == &tclIntType) {
+
+ if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = TCL_ERROR;
+ goto badValue;
+ }
+
+ if (valuePtr->typePtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
- if (result != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
- ((tPtr == &tclDoubleType)? "floating-point value" : "non-numeric string"),
- " as argument to srand", (char *) NULL);
- Tcl_DecrRefCount(valuePtr);
- DECACHE_STACK_INFO();
- return result;
- }
+ } else {
+ /*
+ * At this point, the only other possible type is double
+ */
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't use floating-point value as argument to srand",
+ (char *) NULL);
+ badValue:
+ Tcl_DecrRefCount(valuePtr);
+ DECACHE_STACK_INFO();
+ return TCL_ERROR;
}
/*
@@ -4207,7 +4102,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
* is objv[0]. */
{
Interp *iPtr = (Interp *) interp;
- StackItem *stackPtr; /* Cached evaluation stack base pointer. */
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
register int stackTop; /* Cached top index of evaluation stack. */
char *funcName;
Tcl_HashEntry *hPtr;
@@ -4215,13 +4110,13 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */
Tcl_Value funcResult; /* Result of function call as Tcl_Value. */
register Tcl_Obj *valuePtr;
- Tcl_ObjType *tPtr;
long i;
double d;
int j, k, result;
-
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
Tcl_ResetResult(interp);
-
+
/*
* Set stackPtr and stackTop from eePtr.
*/
@@ -4230,10 +4125,9 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
/*
* Look up the MathFunc record for the function.
- * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
*/
- funcName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+ funcName = Tcl_GetString(objv[0]);
hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
if (hPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -4257,40 +4151,19 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
for (j = 1, k = 0; j < objc; j++, k++) {
valuePtr = objv[j];
- tPtr = valuePtr->typePtr;
-
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- } else if (tPtr == &tclDoubleType) {
- d = valuePtr->internalRep.doubleValue;
- } else {
- /*
- * Try to convert to int first then double.
- * FAILS IF STRING REP HAS NULLS.
- */
-
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
-
- if (TclLooksLikeInt(s)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d);
- }
- if (result != TCL_OK) {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "argument to math function didn't have numeric value", -1);
- goto done;
- }
- tPtr = valuePtr->typePtr;
+
+ if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
}
/*
* Copy the object's numeric value to the argument record,
* converting it if necessary.
*/
-
- if (tPtr == &tclIntType) {
+
+ if (valuePtr->typePtr == &tclIntType) {
+ i = valuePtr->internalRep.longValue;
if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
args[k].type = TCL_DOUBLE;
args[k].doubleValue = i;
@@ -4299,6 +4172,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
args[k].intValue = i;
}
} else {
+ d = valuePtr->internalRep.doubleValue;
if (mathFuncPtr->argTypes[k] == TCL_INT) {
args[k].type = TCL_INT;
args[k].intValue = (long) d;
@@ -4313,10 +4187,10 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
* Invoke the function and copy its result back into valuePtr.
*/
- tcl_MathInProgress++;
+ tsdPtr->mathInProgress++;
result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
&funcResult);
- tcl_MathInProgress--;
+ tsdPtr->mathInProgress--;
if (result != TCL_OK) {
goto done;
}
@@ -4327,7 +4201,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
i = (stackTop - (objc-1));
while (i <= stackTop) {
- valuePtr = stackPtr[i].o;
+ valuePtr = stackPtr[i];
Tcl_DecrRefCount(valuePtr);
i++;
}
@@ -4399,8 +4273,8 @@ TclExprFloatError(interp, value)
Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
}
- } else { /* FAILS IF STRING REP CONTAINS NULLS */
- char msg[100];
+ } else {
+ char msg[64 + TCL_INTEGER_SPACE];
sprintf(msg, "unknown floating-point error, errno = %d", errno);
Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1);
@@ -4408,6 +4282,30 @@ TclExprFloatError(interp, value)
}
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMathInProgress --
+ *
+ * This procedure is called to find out if Tcl is doing math
+ * in this thread.
+ *
+ * Results:
+ * 0 or 1.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMathInProgress()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ return tsdPtr->mathInProgress;
+}
+
#ifdef TCL_COMPILE_STATS
/*
*----------------------------------------------------------------------
@@ -4466,120 +4364,355 @@ EvalStatsCmd(unused, interp, argc, argv)
int argc; /* The number of arguments. */
char **argv; /* The argument strings. */
{
- register double total = 0.0;
- register int i;
- int maxSizeDecade = 0;
- double totalHeaderBytes = (tclNumCompilations * sizeof(ByteCode));
-
+ Interp *iPtr = (Interp *) interp;
+ LiteralTable *globalTablePtr = &(iPtr->literalTable);
+ ByteCodeStats *statsPtr = &(iPtr->stats);
+ double totalCodeBytes, currentCodeBytes;
+ double totalLiteralBytes, currentLiteralBytes;
+ double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
+ double strBytesSharedMultX, strBytesSharedOnce;
+ double numInstructions, currentHeaderBytes;
+ long numCurrentByteCodes, numByteCodeLits;
+ long refCountSum, literalMgmtBytes, sum;
+ int numSharedMultX, numSharedOnce;
+ int decadeHigh, minSizeDecade, maxSizeDecade, length, i;
+ char *litTableStats;
+ LiteralEntry *entryPtr;
+
+ numInstructions = 0.0;
for (i = 0; i < 256; i++) {
- if (instructionCount[i] != 0) {
- total += instructionCount[i];
+ if (statsPtr->instructionCount[i] != 0) {
+ numInstructions += statsPtr->instructionCount[i];
}
}
- for (i = 31; i >= 0; i--) {
- if ((tclSourceCount[i] > 0) && (tclByteCodeCount[i] > 0)) {
- maxSizeDecade = i;
- break;
- }
- }
-
- fprintf(stdout, "\nNumber of compilations %ld\n",
- tclNumCompilations);
- fprintf(stdout, "Number of executions %ld\n",
- numExecutions);
- fprintf(stdout, "Average executions/compilation %.0f\n",
- ((float) numExecutions/tclNumCompilations));
+ totalLiteralBytes = sizeof(LiteralTable)
+ + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)
+ + (statsPtr->numLiteralsCreated * sizeof(LiteralEntry))
+ + (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj))
+ + statsPtr->totalLitStringBytes;
+ totalCodeBytes = statsPtr->totalByteCodeBytes + totalLiteralBytes;
+
+ numCurrentByteCodes =
+ statsPtr->numCompilations - statsPtr->numByteCodesFreed;
+ currentHeaderBytes = numCurrentByteCodes
+ * (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time)));
+ literalMgmtBytes = sizeof(LiteralTable)
+ + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *))
+ + (iPtr->literalTable.numEntries * sizeof(LiteralEntry));
+ currentLiteralBytes = literalMgmtBytes
+ + iPtr->literalTable.numEntries * sizeof(Tcl_Obj)
+ + statsPtr->currentLitStringBytes;
+ currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes;
- fprintf(stdout, "\nInstructions executed %.0f\n",
- total);
- fprintf(stdout, "Average instructions/compile %.0f\n",
- total/tclNumCompilations);
- fprintf(stdout, "Average instructions/execution %.0f\n",
- total/numExecutions);
-
- fprintf(stdout, "\nTotal source bytes %.6g\n",
- tclTotalSourceBytes);
- fprintf(stdout, "Total code bytes %.6g\n",
- tclTotalCodeBytes);
- fprintf(stdout, "Average code/compilation %.0f\n",
- tclTotalCodeBytes/tclNumCompilations);
- fprintf(stdout, "Average code/source %.2f\n",
- tclTotalCodeBytes/tclTotalSourceBytes);
- fprintf(stdout, "Current source bytes %.6g\n",
- tclCurrentSourceBytes);
- fprintf(stdout, "Current code bytes %.6g\n",
- tclCurrentCodeBytes);
- fprintf(stdout, "Current code/source %.2f\n",
- tclCurrentCodeBytes/tclCurrentSourceBytes);
+ /*
+ * Summary statistics, total and current source and ByteCode sizes.
+ */
+
+ fprintf(stdout, "\n----------------------------------------------------------------\n");
+ fprintf(stdout,
+ "Compilation and execution statistics for interpreter 0x%x\n",
+ (unsigned int) iPtr);
+
+ fprintf(stdout, "\nNumber ByteCodes executed %ld\n",
+ statsPtr->numExecutions);
+ fprintf(stdout, "Number ByteCodes compiled %ld\n",
+ statsPtr->numCompilations);
+ fprintf(stdout, " Mean executions/compile %.1f\n",
+ ((float)statsPtr->numExecutions) / ((float)statsPtr->numCompilations));
- fprintf(stdout, "\nTotal objects allocated %ld\n",
+ fprintf(stdout, "\nInstructions executed %.0f\n",
+ numInstructions);
+ fprintf(stdout, " Mean inst/compile %.0f\n",
+ numInstructions / statsPtr->numCompilations);
+ fprintf(stdout, " Mean inst/execution %.0f\n",
+ numInstructions / statsPtr->numExecutions);
+
+ fprintf(stdout, "\nTotal ByteCodes %ld\n",
+ statsPtr->numCompilations);
+ fprintf(stdout, " Source bytes %.6g\n",
+ statsPtr->totalSrcBytes);
+ fprintf(stdout, " Code bytes %.6g\n",
+ totalCodeBytes);
+ fprintf(stdout, " ByteCode bytes %.6g\n",
+ statsPtr->totalByteCodeBytes);
+ fprintf(stdout, " Literal bytes %.6g\n",
+ totalLiteralBytes);
+ fprintf(stdout, " table %d + bkts %d + entries %ld + objects %ld + strings %.6g\n",
+ sizeof(LiteralTable),
+ iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
+ statsPtr->numLiteralsCreated * sizeof(LiteralEntry),
+ statsPtr->numLiteralsCreated * sizeof(Tcl_Obj),
+ statsPtr->totalLitStringBytes);
+ fprintf(stdout, " Mean code/compile %.1f\n",
+ totalCodeBytes / statsPtr->numCompilations);
+ fprintf(stdout, " Mean code/source %.1f\n",
+ totalCodeBytes / statsPtr->totalSrcBytes);
+
+ fprintf(stdout, "\nCurrent ByteCodes %ld\n",
+ numCurrentByteCodes);
+ fprintf(stdout, " Source bytes %.6g\n",
+ statsPtr->currentSrcBytes);
+ fprintf(stdout, " Code bytes %.6g\n",
+ currentCodeBytes);
+ fprintf(stdout, " ByteCode bytes %.6g\n",
+ statsPtr->currentByteCodeBytes);
+ fprintf(stdout, " Literal bytes %.6g\n",
+ currentLiteralBytes);
+ fprintf(stdout, " table %d + bkts %d + entries %d + objects %d + strings %.6g\n",
+ sizeof(LiteralTable),
+ iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
+ iPtr->literalTable.numEntries * sizeof(LiteralEntry),
+ iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
+ statsPtr->currentLitStringBytes);
+ fprintf(stdout, " Mean code/source %.1f\n",
+ currentCodeBytes / statsPtr->currentSrcBytes);
+ fprintf(stdout, " Code + source bytes %.6g (%0.1f mean code/src)\n",
+ (currentCodeBytes + statsPtr->currentSrcBytes),
+ (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
+
+ /*
+ * Literal table statistics.
+ */
+
+ numByteCodeLits = 0;
+ refCountSum = 0;
+ numSharedMultX = 0;
+ numSharedOnce = 0;
+ objBytesIfUnshared = 0.0;
+ strBytesIfUnshared = 0.0;
+ strBytesSharedMultX = 0.0;
+ strBytesSharedOnce = 0.0;
+ for (i = 0; i < globalTablePtr->numBuckets; i++) {
+ for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
+ entryPtr = entryPtr->nextPtr) {
+ if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
+ numByteCodeLits++;
+ }
+ (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+ refCountSum += entryPtr->refCount;
+ objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
+ strBytesIfUnshared += (entryPtr->refCount * (length+1));
+ if (entryPtr->refCount > 1) {
+ numSharedMultX++;
+ strBytesSharedMultX += (length+1);
+ } else {
+ numSharedOnce++;
+ strBytesSharedOnce += (length+1);
+ }
+ }
+ }
+ sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
+ - currentLiteralBytes;
+
+ fprintf(stdout, "\nTotal objects (all interps) %ld\n",
tclObjsAlloced);
- fprintf(stdout, "Total objects freed %ld\n",
- tclObjsFreed);
- fprintf(stdout, "Current objects: %ld\n",
+ fprintf(stdout, "Current objects %ld\n",
(tclObjsAlloced - tclObjsFreed));
+ fprintf(stdout, "Total literal objects %ld\n",
+ statsPtr->numLiteralsCreated);
+
+ fprintf(stdout, "\nCurrent literal objects %d (%0.1f%% of current objects)\n",
+ globalTablePtr->numEntries,
+ (globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed));
+ fprintf(stdout, " ByteCode literals %ld (%0.1f%% of current literals)\n",
+ numByteCodeLits,
+ (numByteCodeLits * 100.0) / globalTablePtr->numEntries);
+ fprintf(stdout, " Literals reused > 1x %d\n",
+ numSharedMultX);
+ fprintf(stdout, " Mean reference count %.2f\n",
+ ((double) refCountSum) / globalTablePtr->numEntries);
+ fprintf(stdout, " Mean len, str reused >1x %.2f\n",
+ (numSharedMultX? (strBytesSharedMultX/numSharedMultX) : 0.0));
+ fprintf(stdout, " Mean len, str used 1x %.2f\n",
+ (numSharedOnce? (strBytesSharedOnce/numSharedOnce) : 0.0));
+ fprintf(stdout, " Total sharing savings %.6g (%0.1f%% of bytes if no sharing)\n",
+ sharingBytesSaved,
+ (sharingBytesSaved * 100.0) / (objBytesIfUnshared + strBytesIfUnshared));
+ fprintf(stdout, " Bytes with sharing %.6g\n",
+ currentLiteralBytes);
+ fprintf(stdout, " table %d + bkts %d + entries %d + objects %d + strings %.6g\n",
+ sizeof(LiteralTable),
+ iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
+ iPtr->literalTable.numEntries * sizeof(LiteralEntry),
+ iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
+ statsPtr->currentLitStringBytes);
+ fprintf(stdout, " Bytes if no sharing %.6g = objects %.6g + strings %.6g\n",
+ (objBytesIfUnshared + strBytesIfUnshared),
+ objBytesIfUnshared, strBytesIfUnshared);
+ fprintf(stdout, " String sharing savings %.6g = unshared %.6g - shared %.6g\n",
+ (strBytesIfUnshared - statsPtr->currentLitStringBytes),
+ strBytesIfUnshared, statsPtr->currentLitStringBytes);
+ fprintf(stdout, " Literal mgmt overhead %ld (%0.1f%% of bytes with sharing)\n",
+ literalMgmtBytes,
+ (literalMgmtBytes * 100.0) / currentLiteralBytes);
+ fprintf(stdout, " table %d + buckets %d + entries %d\n",
+ sizeof(LiteralTable),
+ iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
+ iPtr->literalTable.numEntries * sizeof(LiteralEntry));
- fprintf(stdout, "\nBreakdown of code byte requirements:\n");
- fprintf(stdout, " Total bytes Pct of Avg per\n");
- fprintf(stdout, " all code compile\n");
- fprintf(stdout, "Total code %12.6g 100%% %8.2f\n",
- tclTotalCodeBytes, tclTotalCodeBytes/tclNumCompilations);
- fprintf(stdout, "Header %12.6g %8.2f%% %8.2f\n",
- totalHeaderBytes,
- ((totalHeaderBytes * 100.0) / tclTotalCodeBytes),
- totalHeaderBytes/tclNumCompilations);
- fprintf(stdout, "Instructions %12.6g %8.2f%% %8.2f\n",
- tclTotalInstBytes,
- ((tclTotalInstBytes * 100.0) / tclTotalCodeBytes),
- tclTotalInstBytes/tclNumCompilations);
- fprintf(stdout, "Objects %12.6g %8.2f%% %8.2f\n",
- tclTotalObjBytes,
- ((tclTotalObjBytes * 100.0) / tclTotalCodeBytes),
- tclTotalObjBytes/tclNumCompilations);
- fprintf(stdout, "Exception table %12.6g %8.2f%% %8.2f\n",
- tclTotalExceptBytes,
- ((tclTotalExceptBytes * 100.0) / tclTotalCodeBytes),
- tclTotalExceptBytes/tclNumCompilations);
- fprintf(stdout, "Auxiliary data %12.6g %8.2f%% %8.2f\n",
- tclTotalAuxBytes,
- ((tclTotalAuxBytes * 100.0) / tclTotalCodeBytes),
- tclTotalAuxBytes/tclNumCompilations);
- fprintf(stdout, "Command map %12.6g %8.2f%% %8.2f\n",
- tclTotalCmdMapBytes,
- ((tclTotalCmdMapBytes * 100.0) / tclTotalCodeBytes),
- tclTotalCmdMapBytes/tclNumCompilations);
+ /*
+ * Breakdown of current ByteCode space requirements.
+ */
+
+ fprintf(stdout, "\nBreakdown of current ByteCode requirements:\n");
+ fprintf(stdout, " Bytes Pct of Avg per\n");
+ fprintf(stdout, " total ByteCode\n");
+ fprintf(stdout, "Total %12.6g 100.00%% %8.1f\n",
+ statsPtr->currentByteCodeBytes,
+ statsPtr->currentByteCodeBytes / numCurrentByteCodes);
+ fprintf(stdout, "Header %12.6g %8.1f%% %8.1f\n",
+ currentHeaderBytes,
+ ((currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ currentHeaderBytes / numCurrentByteCodes);
+ fprintf(stdout, "Instructions %12.6g %8.1f%% %8.1f\n",
+ statsPtr->currentInstBytes,
+ ((statsPtr->currentInstBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ statsPtr->currentInstBytes / numCurrentByteCodes);
+ fprintf(stdout, "Literal ptr array %12.6g %8.1f%% %8.1f\n",
+ statsPtr->currentLitBytes,
+ ((statsPtr->currentLitBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ statsPtr->currentLitBytes / numCurrentByteCodes);
+ fprintf(stdout, "Exception table %12.6g %8.1f%% %8.1f\n",
+ statsPtr->currentExceptBytes,
+ ((statsPtr->currentExceptBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ statsPtr->currentExceptBytes / numCurrentByteCodes);
+ fprintf(stdout, "Auxiliary data %12.6g %8.1f%% %8.1f\n",
+ statsPtr->currentAuxBytes,
+ ((statsPtr->currentAuxBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ statsPtr->currentAuxBytes / numCurrentByteCodes);
+ fprintf(stdout, "Command map %12.6g %8.1f%% %8.1f\n",
+ statsPtr->currentCmdMapBytes,
+ ((statsPtr->currentCmdMapBytes * 100.0) / statsPtr->currentByteCodeBytes),
+ statsPtr->currentCmdMapBytes / numCurrentByteCodes);
+
+ /*
+ * Detailed literal statistics.
+ */
- fprintf(stdout, "\nSource and ByteCode size distributions:\n");
- fprintf(stdout, " binary decade source code\n");
+ fprintf(stdout, "\nLiteral string sizes:\n");
+ fprintf(stdout, " Up to length Percentage\n");
+ maxSizeDecade = 0;
+ for (i = 31; i >= 0; i--) {
+ if (statsPtr->literalCount[i] > 0) {
+ maxSizeDecade = i;
+ break;
+ }
+ }
+ sum = 0;
for (i = 0; i <= maxSizeDecade; i++) {
- int decadeLow, decadeHigh;
+ decadeHigh = (1 << (i+1)) - 1;
+ sum += statsPtr->literalCount[i];
+ fprintf(stdout, " %10d %8.0f%%\n",
+ decadeHigh, (sum * 100.0) / statsPtr->numLiteralsCreated);
+ }
- if (i == 0) {
- decadeLow = 0;
- } else {
- decadeLow = 1 << i;
- }
+ litTableStats = TclLiteralStats(globalTablePtr);
+ fprintf(stdout, "\nCurrent literal table statistics:\n%s\n",
+ litTableStats);
+ ckfree((char *) litTableStats);
+
+ /*
+ * Source and ByteCode size distributions.
+ */
+
+ fprintf(stdout, "\nSource sizes:\n");
+ fprintf(stdout, " Up to size Percentage\n");
+ minSizeDecade = maxSizeDecade = 0;
+ for (i = 0; i < 31; i++) {
+ if (statsPtr->srcCount[i] > 0) {
+ minSizeDecade = i;
+ break;
+ }
+ }
+ for (i = 31; i >= 0; i--) {
+ if (statsPtr->srcCount[i] > 0) {
+ maxSizeDecade = i;
+ break;
+ }
+ }
+ sum = 0;
+ for (i = minSizeDecade; i <= maxSizeDecade; i++) {
+ decadeHigh = (1 << (i+1)) - 1;
+ sum += statsPtr->srcCount[i];
+ fprintf(stdout, " %10d %8.0f%%\n",
+ decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
+ }
+
+ fprintf(stdout, "\nByteCode sizes:\n");
+ fprintf(stdout, " Up to size Percentage\n");
+ minSizeDecade = maxSizeDecade = 0;
+ for (i = 0; i < 31; i++) {
+ if (statsPtr->byteCodeCount[i] > 0) {
+ minSizeDecade = i;
+ break;
+ }
+ }
+ for (i = 31; i >= 0; i--) {
+ if (statsPtr->byteCodeCount[i] > 0) {
+ maxSizeDecade = i;
+ break;
+ }
+ }
+ sum = 0;
+ for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
- fprintf(stdout, " %6d -%6d %6d %6d\n",
- decadeLow, decadeHigh,
- tclSourceCount[i], tclByteCodeCount[i]);
+ sum += statsPtr->byteCodeCount[i];
+ fprintf(stdout, " %10d %8.0f%%\n",
+ decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
}
+ fprintf(stdout, "\nByteCode longevity (excludes current ByteCodes):\n");
+ fprintf(stdout, " Up to ms Percentage\n");
+ minSizeDecade = maxSizeDecade = 0;
+ for (i = 0; i < 31; i++) {
+ if (statsPtr->lifetimeCount[i] > 0) {
+ minSizeDecade = i;
+ break;
+ }
+ }
+ for (i = 31; i >= 0; i--) {
+ if (statsPtr->lifetimeCount[i] > 0) {
+ maxSizeDecade = i;
+ break;
+ }
+ }
+ sum = 0;
+ for (i = minSizeDecade; i <= maxSizeDecade; i++) {
+ decadeHigh = (1 << (i+1)) - 1;
+ sum += statsPtr->lifetimeCount[i];
+ fprintf(stdout, " %12.3f %8.0f%%\n",
+ decadeHigh / 1000.0,
+ (sum * 100.0) / statsPtr->numByteCodesFreed);
+ }
+
+ /*
+ * Instruction counts.
+ */
+
fprintf(stdout, "\nInstruction counts:\n");
- for (i = 0; i < 256; i++) {
- if (instructionCount[i]) {
- fprintf(stdout, "%20s %8d %6.2f%%\n",
- opName[i], instructionCount[i],
- (instructionCount[i] * 100.0)/total);
+ for (i = 0; i <= LAST_INST_OPCODE; i++) {
+ if (statsPtr->instructionCount[i]) {
+ fprintf(stdout, "%20s %8ld %6.1f%%\n",
+ instructionTable[i].name,
+ statsPtr->instructionCount[i],
+ (statsPtr->instructionCount[i]*100.0) / numInstructions);
+ }
+ }
+
+ fprintf(stdout, "\nInstructions NEVER executed:\n");
+ for (i = 0; i <= LAST_INST_OPCODE; i++) {
+ if (statsPtr->instructionCount[i] == 0) {
+ fprintf(stdout, "%20s\n",
+ instructionTable[i].name);
}
}
#ifdef TCL_MEM_DEBUG
fprintf(stdout, "\nHeap Statistics:\n");
TclDumpMemoryInfo(stdout);
-#endif /* TCL_MEM_DEBUG */
-
+#endif
+ fprintf(stdout, "\n----------------------------------------------------------------\n");
return TCL_OK;
}
#endif /* TCL_COMPILE_STATS */
@@ -4675,11 +4808,72 @@ Tcl_GetCommandFromObj(interp, objPtr)
cmdPtr = resPtr->cmdPtr;
}
}
+ return (Tcl_Command) cmdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetCmdNameObj --
+ *
+ * Modify an object to be an CmdName object that refers to the argument
+ * Command structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's old internal rep is freed. It's string rep is not
+ * changed. The refcount in the Command structure is incremented to
+ * keep it from being freed if the command is later deleted until
+ * TclExecuteByteCode has a chance to recognize that it was deleted.
+ *
+ *----------------------------------------------------------------------
+ */
- if (cmdPtr == NULL) {
- return (Tcl_Command) NULL;
+void
+TclSetCmdNameObj(interp, objPtr, cmdPtr)
+ Tcl_Interp *interp; /* Points to interpreter containing command
+ * that should be cached in objPtr. */
+ register Tcl_Obj *objPtr; /* Points to Tcl object to be changed to
+ * a CmdName object. */
+ Command *cmdPtr; /* Points to Command structure that the
+ * CmdName object should refer to. */
+{
+ Interp *iPtr = (Interp *) interp;
+ register ResolvedCmdName *resPtr;
+ Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+ register Namespace *currNsPtr;
+
+ if (oldTypePtr == &tclCmdNameType) {
+ return;
}
- return (Tcl_Command) cmdPtr;
+
+ /*
+ * Get the current namespace.
+ */
+
+ if (iPtr->varFramePtr != NULL) {
+ currNsPtr = iPtr->varFramePtr->nsPtr;
+ } else {
+ currNsPtr = iPtr->globalNsPtr;
+ }
+
+ cmdPtr->refCount++;
+ resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+ resPtr->cmdPtr = cmdPtr;
+ resPtr->refNsPtr = currNsPtr;
+ resPtr->refNsId = currNsPtr->nsId;
+ resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ resPtr->cmdEpoch = cmdPtr->cmdEpoch;
+ resPtr->refCount = 1;
+
+ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+ oldTypePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->typePtr = &tclCmdNameType;
}
/*
@@ -4807,7 +5001,7 @@ SetCmdNameFromAny(interp, objPtr)
name = objPtr->bytes;
if (name == NULL) {
- name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+ name = Tcl_GetString(objPtr);
}
/*
@@ -4862,34 +5056,6 @@ SetCmdNameFromAny(interp, objPtr)
return TCL_OK;
}
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfCmdName --
- *
- * Update the string representation for an cmdName object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Generates a panic.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfCmdName(objPtr)
- Tcl_Obj *objPtr; /* CmdName obj to update string rep. */
-{
- /*
- * This procedure is never invoked since the internal representation of
- * a cmdName object is never modified.
- */
-
- panic("UpdateStringOfCmdName should never be invoked");
-}
-
#ifdef TCL_COMPILE_DEBUG
/*
*----------------------------------------------------------------------
@@ -4917,7 +5083,7 @@ StringForResultCode(result)
int result; /* The Tcl result code for which to
* generate a string. */
{
- static char buf[20];
+ static char buf[TCL_INTEGER_SPACE];
if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
return resultStrings[result];
@@ -4926,3 +5092,4 @@ StringForResultCode(result)
return buf;
}
#endif /* TCL_COMPILE_DEBUG */
+
diff --git a/tcl/generic/tclExpr.c b/tcl/generic/tclExpr.c
new file mode 100644
index 00000000000..c11bb3f97a5
--- /dev/null
+++ b/tcl/generic/tclExpr.c
@@ -0,0 +1,2061 @@
+/*
+ * tclExpr.c --
+ *
+ * This file contains the code to evaluate expressions for
+ * Tcl.
+ *
+ * This implementation of floating-point support was modelled
+ * after an initial implementation by Bill Carpenter.
+ *
+ * Copyright (c) 1987-1994 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.
+ *
+ * SCCS: @(#) tclExpr.c 1.92 96/09/06 13:22:44
+ */
+
+#include "tclInt.h"
+#ifdef NO_FLOAT_H
+# include "../compat/float.h"
+#else
+# include <float.h>
+#endif
+#ifndef TCL_NO_MATH
+#include <math.h>
+#endif
+
+/*
+ * The stuff below is a bit of a hack so that this file can be used
+ * in environments that include no UNIX, i.e. no errno. Just define
+ * errno here.
+ */
+
+#ifndef TCL_GENERIC_ONLY
+#include "tclPort.h"
+#else
+#define NO_ERRNO_H
+#endif
+
+#ifdef NO_ERRNO_H
+int errno;
+#define EDOM 33
+#define ERANGE 34
+#endif
+
+/*
+ * The data structure below is used to describe an expression value,
+ * which can be either an integer (the usual case), a double-precision
+ * floating-point value, or a string. A given number has only one
+ * value at a time.
+ */
+
+#define STATIC_STRING_SPACE 150
+
+typedef struct {
+ long intValue; /* Integer value, if any. */
+ double doubleValue; /* Floating-point value, if any. */
+ ParseValue pv; /* Used to hold a string value, if any. */
+ char staticSpace[STATIC_STRING_SPACE];
+ /* Storage for small strings; large ones
+ * are malloc-ed. */
+ int type; /* Type of value: TYPE_INT, TYPE_DOUBLE,
+ * or TYPE_STRING. */
+} Value;
+
+/*
+ * Valid values for type:
+ */
+
+#define TYPE_INT 0
+#define TYPE_DOUBLE 1
+#define TYPE_STRING 2
+
+/*
+ * The data structure below describes the state of parsing an expression.
+ * It's passed among the routines in this module.
+ */
+
+typedef struct {
+ char *originalExpr; /* The entire expression, as originally
+ * passed to Tcl_ExprString et al. */
+ char *expr; /* Position to the next character to be
+ * scanned from the expression string. */
+ int token; /* Type of the last token to be parsed from
+ * expr. See below for definitions.
+ * Corresponds to the characters just
+ * before expr. */
+} ExprInfo;
+
+/*
+ * The token types are defined below. In addition, there is a table
+ * associating a precedence with each operator. The order of types
+ * is important. Consult the code before changing it.
+ */
+
+#define VALUE 0
+#define OPEN_PAREN 1
+#define CLOSE_PAREN 2
+#define COMMA 3
+#define END 4
+#define UNKNOWN 5
+
+/*
+ * Binary operators:
+ */
+
+#define MULT 8
+#define DIVIDE 9
+#define MOD 10
+#define PLUS 11
+#define MINUS 12
+#define LEFT_SHIFT 13
+#define RIGHT_SHIFT 14
+#define LESS 15
+#define GREATER 16
+#define LEQ 17
+#define GEQ 18
+#define EQUAL 19
+#define NEQ 20
+#define BIT_AND 21
+#define BIT_XOR 22
+#define BIT_OR 23
+#define AND 24
+#define OR 25
+#define QUESTY 26
+#define COLON 27
+
+/*
+ * Unary operators:
+ */
+
+#define UNARY_MINUS 28
+#define UNARY_PLUS 29
+#define NOT 30
+#define BIT_NOT 31
+
+/*
+ * Precedence table. The values for non-operator token types are ignored.
+ */
+
+static int precTable[] = {
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 12, 12, 12, /* MULT, DIVIDE, MOD */
+ 11, 11, /* PLUS, MINUS */
+ 10, 10, /* LEFT_SHIFT, RIGHT_SHIFT */
+ 9, 9, 9, 9, /* LESS, GREATER, LEQ, GEQ */
+ 8, 8, /* EQUAL, NEQ */
+ 7, /* BIT_AND */
+ 6, /* BIT_XOR */
+ 5, /* BIT_OR */
+ 4, /* AND */
+ 3, /* OR */
+ 2, /* QUESTY */
+ 1, /* COLON */
+ 13, 13, 13, 13 /* UNARY_MINUS, UNARY_PLUS, NOT,
+ * BIT_NOT */
+};
+
+/*
+ * Mapping from operator numbers to strings; used for error messages.
+ */
+
+static char *operatorStrings[] = {
+ "VALUE", "(", ")", ",", "END", "UNKNOWN", "6", "7",
+ "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
+ ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
+ "-", "+", "!", "~"
+};
+
+/*
+ * The following slight modification to DBL_MAX is needed because of
+ * a compiler bug on Sprite (4/15/93).
+ */
+
+#ifdef sprite
+#undef DBL_MAX
+#define DBL_MAX 1.797693134862316e+307
+#endif
+
+/*
+ * Macros for testing floating-point values for certain special
+ * cases. Test for not-a-number by comparing a value against
+ * itself; test for infinity by comparing against the largest
+ * floating-point value.
+ */
+
+#define IS_NAN(v) ((v) != (v))
+#ifdef DBL_MAX
+# define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
+#else
+# define IS_INF(v) 0
+#endif
+
+/*
+ * The following global variable is use to signal matherr that Tcl
+ * is responsible for the arithmetic, so errors can be handled in a
+ * fashion appropriate for Tcl. Zero means no Tcl math is in
+ * progress; non-zero means Tcl is doing math.
+ */
+
+int tcl_MathInProgress = 0;
+
+/*
+ * The variable below serves no useful purpose except to generate
+ * a reference to matherr, so that the Tcl version of matherr is
+ * linked in rather than the system version. Without this reference
+ * the need for matherr won't be discovered during linking until after
+ * libtcl.a has been processed, so Tcl's version won't be used.
+ */
+
+#ifdef NEED_MATHERR
+extern int matherr();
+int (*tclMatherrPtr)() = matherr;
+#endif
+
+/*
+ * Declarations for local procedures to this file:
+ */
+
+static int ExprAbsFunc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tcl_Value *args,
+ Tcl_Value *resultPtr));
+static int ExprBinaryFunc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tcl_Value *args,
+ Tcl_Value *resultPtr));
+static int ExprDoubleFunc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tcl_Value *args,
+ Tcl_Value *resultPtr));
+static int ExprGetValue _ANSI_ARGS_((Tcl_Interp *interp,
+ ExprInfo *infoPtr, int prec, Value *valuePtr));
+static int ExprIntFunc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tcl_Value *args,
+ Tcl_Value *resultPtr));
+static int ExprLex _ANSI_ARGS_((Tcl_Interp *interp,
+ ExprInfo *infoPtr, Value *valuePtr));
+static int ExprLooksLikeInt _ANSI_ARGS_((char *p));
+static void ExprMakeString _ANSI_ARGS_((Tcl_Interp *interp,
+ Value *valuePtr));
+static int ExprMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
+ ExprInfo *infoPtr, Value *valuePtr));
+static int ExprParseString _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, Value *valuePtr));
+static int ExprRoundFunc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tcl_Value *args,
+ Tcl_Value *resultPtr));
+static int ExprTopLevel _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, Value *valuePtr));
+static int ExprUnaryFunc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tcl_Value *args,
+ Tcl_Value *resultPtr));
+
+/*
+ * Built-in math functions:
+ */
+
+typedef struct {
+ char *name; /* Name of function. */
+ int numArgs; /* Number of arguments for function. */
+ Tcl_ValueType argTypes[MAX_MATH_ARGS];
+ /* Acceptable types for each argument. */
+ Tcl_MathProc *proc; /* Procedure that implements this function. */
+ ClientData clientData; /* Additional argument to pass to the function
+ * when invoking it. */
+} BuiltinFunc;
+
+static BuiltinFunc funcTable[] = {
+#ifndef TCL_NO_MATH
+ {"acos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) acos},
+ {"asin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) asin},
+ {"atan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) atan},
+ {"atan2", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) atan2},
+ {"ceil", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) ceil},
+ {"cos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cos},
+ {"cosh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cosh},
+ {"exp", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) exp},
+ {"floor", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) floor},
+ {"fmod", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) fmod},
+ {"hypot", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) hypot},
+ {"log", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log},
+ {"log10", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log10},
+ {"pow", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) pow},
+ {"sin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sin},
+ {"sinh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sinh},
+ {"sqrt", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sqrt},
+ {"tan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tan},
+ {"tanh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tanh},
+#endif
+ {"abs", 1, {TCL_EITHER}, ExprAbsFunc, 0},
+ {"double", 1, {TCL_EITHER}, ExprDoubleFunc, 0},
+ {"int", 1, {TCL_EITHER}, ExprIntFunc, 0},
+ {"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
+
+ {0},
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExprParseString --
+ *
+ * Given a string (such as one coming from command or variable
+ * substitution), make a Value based on the string. The value
+ * will be a floating-point or integer, if possible, or else it
+ * will just be a copy of the string.
+ *
+ * Results:
+ * TCL_OK is returned under normal circumstances, and TCL_ERROR
+ * is returned if a floating-point overflow or underflow occurred
+ * while reading in a number. The value at *valuePtr is modified
+ * to hold a number, if possible.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ExprParseString(interp, string, valuePtr)
+ Tcl_Interp *interp; /* Where to store error message. */
+ char *string; /* String to turn into value. */
+ Value *valuePtr; /* Where to store value information.
+ * Caller must have initialized pv field. */
+{
+ char *term, *p, *start;
+
+ if (*string != 0) {
+ if (ExprLooksLikeInt(string)) {
+ valuePtr->type = TYPE_INT;
+ errno = 0;
+
+ /*
+ * Note: use strtoul instead of strtol for integer conversions
+ * to allow full-size unsigned numbers, but don't depend on
+ * strtoul to handle sign characters; it won't in some
+ * implementations.
+ */
+
+ for (p = string; isspace(UCHAR(*p)); p++) {
+ /* Empty loop body. */
+ }
+ if (*p == '-') {
+ start = p+1;
+ valuePtr->intValue = -((int)strtoul(start, &term, 0));
+ } else if (*p == '+') {
+ start = p+1;
+ valuePtr->intValue = strtoul(start, &term, 0);
+ } else {
+ start = p;
+ valuePtr->intValue = strtoul(start, &term, 0);
+ }
+ if (*term == 0) {
+ if (errno == ERANGE) {
+ /*
+ * This procedure is sometimes called with string in
+ * interp->result, so we have to clear the result before
+ * logging an error message.
+ */
+
+ Tcl_ResetResult(interp);
+ interp->result = "integer value too large to represent";
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+ interp->result, (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+ }
+ } else {
+ errno = 0;
+ valuePtr->doubleValue = strtod(string, &term);
+ if ((term != string) && (*term == 0)) {
+ if (errno != 0) {
+ Tcl_ResetResult(interp);
+ TclExprFloatError(interp, valuePtr->doubleValue);
+ return TCL_ERROR;
+ }
+ valuePtr->type = TYPE_DOUBLE;
+ return TCL_OK;
+ }
+ }
+ }
+
+ /*
+ * Not a valid number. Save a string value (but don't do anything
+ * if it's already the value).
+ */
+
+ valuePtr->type = TYPE_STRING;
+ if (string != valuePtr->pv.buffer) {
+ int length, shortfall;
+
+ length = strlen(string);
+ valuePtr->pv.next = valuePtr->pv.buffer;
+ shortfall = length - (valuePtr->pv.end - valuePtr->pv.buffer);
+ if (shortfall > 0) {
+ (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
+ }
+ strcpy(valuePtr->pv.buffer, string);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExprLex --
+ *
+ * Lexical analyzer for expression parser: parses a single value,
+ * operator, or other syntactic element from an expression string.
+ *
+ * Results:
+ * TCL_OK is returned unless an error occurred while doing lexical
+ * analysis or executing an embedded command. In that case a
+ * standard Tcl error is returned, using interp->result to hold
+ * an error message. In the event of a successful return, the token
+ * and field in infoPtr is updated to refer to the next symbol in
+ * the expression string, and the expr field is advanced past that
+ * token; if the token is a value, then the value is stored at
+ * valuePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprLex(interp, infoPtr, valuePtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ register ExprInfo *infoPtr; /* Describes the state of the parse. */
+ register Value *valuePtr; /* Where to store value, if that is
+ * what's parsed from string. Caller
+ * must have initialized pv field
+ * correctly. */
+{
+ register char *p;
+ char *var, *term;
+ int result;
+
+ p = infoPtr->expr;
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == 0) {
+ infoPtr->token = END;
+ infoPtr->expr = p;
+ return TCL_OK;
+ }
+
+ /*
+ * First try to parse the token as an integer or floating-point number.
+ * Don't want to check for a number if the first character is "+"
+ * or "-". If we do, we might treat a binary operator as unary by
+ * mistake, which will eventually cause a syntax error.
+ */
+
+ if ((*p != '+') && (*p != '-')) {
+ if (ExprLooksLikeInt(p)) {
+ errno = 0;
+ valuePtr->intValue = strtoul(p, &term, 0);
+ if (errno == ERANGE) {
+ interp->result = "integer value too large to represent";
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+ interp->result, (char *) NULL);
+ return TCL_ERROR;
+ }
+ infoPtr->token = VALUE;
+ infoPtr->expr = term;
+ valuePtr->type = TYPE_INT;
+ return TCL_OK;
+ } else {
+ errno = 0;
+ valuePtr->doubleValue = strtod(p, &term);
+ if (term != p) {
+ if (errno != 0) {
+ TclExprFloatError(interp, valuePtr->doubleValue);
+ return TCL_ERROR;
+ }
+ infoPtr->token = VALUE;
+ infoPtr->expr = term;
+ valuePtr->type = TYPE_DOUBLE;
+ return TCL_OK;
+ }
+ }
+ }
+
+ infoPtr->expr = p+1;
+ switch (*p) {
+ case '$':
+
+ /*
+ * Variable. Fetch its value, then see if it makes sense
+ * as an integer or floating-point number.
+ */
+
+ infoPtr->token = VALUE;
+ var = Tcl_ParseVar(interp, p, &infoPtr->expr);
+ if (var == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
+ if (((Interp *) interp)->noEval) {
+ valuePtr->type = TYPE_INT;
+ valuePtr->intValue = 0;
+ return TCL_OK;
+ }
+ return ExprParseString(interp, var, valuePtr);
+
+ case '[':
+ infoPtr->token = VALUE;
+ ((Interp *) interp)->evalFlags = TCL_BRACKET_TERM;
+ result = Tcl_Eval(interp, p+1);
+ infoPtr->expr = ((Interp *) interp)->termPtr;
+ if (result != TCL_OK) {
+ return result;
+ }
+ infoPtr->expr++;
+ if (((Interp *) interp)->noEval) {
+ valuePtr->type = TYPE_INT;
+ valuePtr->intValue = 0;
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+ result = ExprParseString(interp, interp->result, valuePtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+
+ case '"':
+ infoPtr->token = VALUE;
+ result = TclParseQuotes(interp, infoPtr->expr, '"', 0,
+ &infoPtr->expr, &valuePtr->pv);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_ResetResult(interp);
+ return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
+
+ case '{':
+ infoPtr->token = VALUE;
+ result = TclParseBraces(interp, infoPtr->expr, &infoPtr->expr,
+ &valuePtr->pv);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_ResetResult(interp);
+ return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
+
+ case '(':
+ infoPtr->token = OPEN_PAREN;
+ return TCL_OK;
+
+ case ')':
+ infoPtr->token = CLOSE_PAREN;
+ return TCL_OK;
+
+ case ',':
+ infoPtr->token = COMMA;
+ return TCL_OK;
+
+ case '*':
+ infoPtr->token = MULT;
+ return TCL_OK;
+
+ case '/':
+ infoPtr->token = DIVIDE;
+ return TCL_OK;
+
+ case '%':
+ infoPtr->token = MOD;
+ return TCL_OK;
+
+ case '+':
+ infoPtr->token = PLUS;
+ return TCL_OK;
+
+ case '-':
+ infoPtr->token = MINUS;
+ return TCL_OK;
+
+ case '?':
+ infoPtr->token = QUESTY;
+ return TCL_OK;
+
+ case ':':
+ infoPtr->token = COLON;
+ return TCL_OK;
+
+ case '<':
+ switch (p[1]) {
+ case '<':
+ infoPtr->expr = p+2;
+ infoPtr->token = LEFT_SHIFT;
+ break;
+ case '=':
+ infoPtr->expr = p+2;
+ infoPtr->token = LEQ;
+ break;
+ default:
+ infoPtr->token = LESS;
+ break;
+ }
+ return TCL_OK;
+
+ case '>':
+ switch (p[1]) {
+ case '>':
+ infoPtr->expr = p+2;
+ infoPtr->token = RIGHT_SHIFT;
+ break;
+ case '=':
+ infoPtr->expr = p+2;
+ infoPtr->token = GEQ;
+ break;
+ default:
+ infoPtr->token = GREATER;
+ break;
+ }
+ return TCL_OK;
+
+ case '=':
+ if (p[1] == '=') {
+ infoPtr->expr = p+2;
+ infoPtr->token = EQUAL;
+ } else {
+ infoPtr->token = UNKNOWN;
+ }
+ return TCL_OK;
+
+ case '!':
+ if (p[1] == '=') {
+ infoPtr->expr = p+2;
+ infoPtr->token = NEQ;
+ } else {
+ infoPtr->token = NOT;
+ }
+ return TCL_OK;
+
+ case '&':
+ if (p[1] == '&') {
+ infoPtr->expr = p+2;
+ infoPtr->token = AND;
+ } else {
+ infoPtr->token = BIT_AND;
+ }
+ return TCL_OK;
+
+ case '^':
+ infoPtr->token = BIT_XOR;
+ return TCL_OK;
+
+ case '|':
+ if (p[1] == '|') {
+ infoPtr->expr = p+2;
+ infoPtr->token = OR;
+ } else {
+ infoPtr->token = BIT_OR;
+ }
+ return TCL_OK;
+
+ case '~':
+ infoPtr->token = BIT_NOT;
+ return TCL_OK;
+
+ default:
+ if (isalpha(UCHAR(*p))) {
+ infoPtr->expr = p;
+ return ExprMathFunc(interp, infoPtr, valuePtr);
+ }
+ infoPtr->expr = p+1;
+ infoPtr->token = UNKNOWN;
+ return TCL_OK;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExprGetValue --
+ *
+ * Parse a "value" from the remainder of the expression in infoPtr.
+ *
+ * Results:
+ * Normally TCL_OK is returned. The value of the expression is
+ * returned in *valuePtr. If an error occurred, then interp->result
+ * contains an error message and TCL_ERROR is returned.
+ * InfoPtr->token will be left pointing to the token AFTER the
+ * expression, and infoPtr->expr will point to the character just
+ * after the terminating token.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprGetValue(interp, infoPtr, prec, valuePtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ register ExprInfo *infoPtr; /* Describes the state of the parse
+ * just before the value (i.e. ExprLex
+ * will be called to get first token
+ * of value). */
+ int prec; /* Treat any un-parenthesized operator
+ * with precedence <= this as the end
+ * of the expression. */
+ Value *valuePtr; /* Where to store the value of the
+ * expression. Caller must have
+ * initialized pv field. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Value value2; /* Second operand for current
+ * operator. */
+ int operator; /* Current operator (either unary
+ * or binary). */
+ int badType; /* Type of offending argument; used
+ * for error messages. */
+ int gotOp; /* Non-zero means already lexed the
+ * operator (while picking up value
+ * for unary operator). Don't lex
+ * again. */
+ int result;
+
+ /*
+ * There are two phases to this procedure. First, pick off an initial
+ * value. Then, parse (binary operator, value) pairs until done.
+ */
+
+ gotOp = 0;
+ value2.pv.buffer = value2.pv.next = value2.staticSpace;
+ value2.pv.end = value2.pv.buffer + STATIC_STRING_SPACE - 1;
+ value2.pv.expandProc = TclExpandParseValue;
+ value2.pv.clientData = (ClientData) NULL;
+ result = ExprLex(interp, infoPtr, valuePtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (infoPtr->token == OPEN_PAREN) {
+
+ /*
+ * Parenthesized sub-expression.
+ */
+
+ result = ExprGetValue(interp, infoPtr, -1, valuePtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (infoPtr->token != CLOSE_PAREN) {
+ Tcl_AppendResult(interp, "unmatched parentheses in expression \"",
+ infoPtr->originalExpr, "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ if (infoPtr->token == MINUS) {
+ infoPtr->token = UNARY_MINUS;
+ }
+ if (infoPtr->token == PLUS) {
+ infoPtr->token = UNARY_PLUS;
+ }
+ if (infoPtr->token >= UNARY_MINUS) {
+
+ /*
+ * Process unary operators.
+ */
+
+ operator = infoPtr->token;
+ result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token],
+ valuePtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (!iPtr->noEval) {
+ switch (operator) {
+ case UNARY_MINUS:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue = -valuePtr->intValue;
+ } else if (valuePtr->type == TYPE_DOUBLE){
+ valuePtr->doubleValue = -valuePtr->doubleValue;
+ } else {
+ badType = valuePtr->type;
+ goto illegalType;
+ }
+ break;
+ case UNARY_PLUS:
+ if ((valuePtr->type != TYPE_INT)
+ && (valuePtr->type != TYPE_DOUBLE)) {
+ badType = valuePtr->type;
+ goto illegalType;
+ }
+ break;
+ case NOT:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue = !valuePtr->intValue;
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ /*
+ * Theoretically, should be able to use
+ * "!valuePtr->intValue", but apparently some
+ * compilers can't handle it.
+ */
+ if (valuePtr->doubleValue == 0.0) {
+ valuePtr->intValue = 1;
+ } else {
+ valuePtr->intValue = 0;
+ }
+ valuePtr->type = TYPE_INT;
+ } else {
+ badType = valuePtr->type;
+ goto illegalType;
+ }
+ break;
+ case BIT_NOT:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue = ~valuePtr->intValue;
+ } else {
+ badType = valuePtr->type;
+ goto illegalType;
+ }
+ break;
+ }
+ }
+ gotOp = 1;
+ } else if (infoPtr->token != VALUE) {
+ goto syntaxError;
+ }
+ }
+
+ /*
+ * Got the first operand. Now fetch (operator, operand) pairs.
+ */
+
+ if (!gotOp) {
+ result = ExprLex(interp, infoPtr, &value2);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ }
+ while (1) {
+ operator = infoPtr->token;
+ value2.pv.next = value2.pv.buffer;
+ if ((operator < MULT) || (operator >= UNARY_MINUS)) {
+ if ((operator == END) || (operator == CLOSE_PAREN)
+ || (operator == COMMA)) {
+ result = TCL_OK;
+ goto done;
+ } else {
+ goto syntaxError;
+ }
+ }
+ if (precTable[operator] <= prec) {
+ result = TCL_OK;
+ goto done;
+ }
+
+ /*
+ * If we're doing an AND or OR and the first operand already
+ * determines the result, don't execute anything in the
+ * second operand: just parse. Same style for ?: pairs.
+ */
+
+ if ((operator == AND) || (operator == OR) || (operator == QUESTY)) {
+ if (valuePtr->type == TYPE_DOUBLE) {
+ valuePtr->intValue = valuePtr->doubleValue != 0;
+ valuePtr->type = TYPE_INT;
+ } else if (valuePtr->type == TYPE_STRING) {
+ if (!iPtr->noEval) {
+ badType = TYPE_STRING;
+ goto illegalType;
+ }
+
+ /*
+ * Must set valuePtr->intValue to avoid referencing
+ * uninitialized memory in the "if" below; the actual
+ * value doesn't matter, since it will be ignored.
+ */
+
+ valuePtr->intValue = 0;
+ }
+ if (((operator == AND) && !valuePtr->intValue)
+ || ((operator == OR) && valuePtr->intValue)) {
+ iPtr->noEval++;
+ result = ExprGetValue(interp, infoPtr, precTable[operator],
+ &value2);
+ iPtr->noEval--;
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (operator == OR) {
+ valuePtr->intValue = 1;
+ }
+ continue;
+ } else if (operator == QUESTY) {
+ /*
+ * Special note: ?: operators must associate right to
+ * left. To make this happen, use a precedence one lower
+ * than QUESTY when calling ExprGetValue recursively.
+ */
+
+ if (valuePtr->intValue != 0) {
+ valuePtr->pv.next = valuePtr->pv.buffer;
+ result = ExprGetValue(interp, infoPtr,
+ precTable[QUESTY] - 1, valuePtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (infoPtr->token != COLON) {
+ goto syntaxError;
+ }
+ value2.pv.next = value2.pv.buffer;
+ iPtr->noEval++;
+ result = ExprGetValue(interp, infoPtr,
+ precTable[QUESTY] - 1, &value2);
+ iPtr->noEval--;
+ } else {
+ iPtr->noEval++;
+ result = ExprGetValue(interp, infoPtr,
+ precTable[QUESTY] - 1, &value2);
+ iPtr->noEval--;
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if (infoPtr->token != COLON) {
+ goto syntaxError;
+ }
+ valuePtr->pv.next = valuePtr->pv.buffer;
+ result = ExprGetValue(interp, infoPtr,
+ precTable[QUESTY] - 1, valuePtr);
+ if (result != TCL_OK) {
+ goto done;
+ }
+ }
+ continue;
+ } else {
+ result = ExprGetValue(interp, infoPtr, precTable[operator],
+ &value2);
+ }
+ } else {
+ result = ExprGetValue(interp, infoPtr, precTable[operator],
+ &value2);
+ }
+ if (result != TCL_OK) {
+ goto done;
+ }
+ if ((infoPtr->token < MULT) && (infoPtr->token != VALUE)
+ && (infoPtr->token != END) && (infoPtr->token != COMMA)
+ && (infoPtr->token != CLOSE_PAREN)) {
+ goto syntaxError;
+ }
+
+ if (iPtr->noEval) {
+ continue;
+ }
+
+ /*
+ * At this point we've got two values and an operator. Check
+ * to make sure that the particular data types are appropriate
+ * for the particular operator, and perform type conversion
+ * if necessary.
+ */
+
+ switch (operator) {
+
+ /*
+ * For the operators below, no strings are allowed and
+ * ints get converted to floats if necessary.
+ */
+
+ case MULT: case DIVIDE: case PLUS: case MINUS:
+ if ((valuePtr->type == TYPE_STRING)
+ || (value2.type == TYPE_STRING)) {
+ badType = TYPE_STRING;
+ goto illegalType;
+ }
+ if (valuePtr->type == TYPE_DOUBLE) {
+ if (value2.type == TYPE_INT) {
+ value2.doubleValue = value2.intValue;
+ value2.type = TYPE_DOUBLE;
+ }
+ } else if (value2.type == TYPE_DOUBLE) {
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->doubleValue = valuePtr->intValue;
+ valuePtr->type = TYPE_DOUBLE;
+ }
+ }
+ break;
+
+ /*
+ * For the operators below, only integers are allowed.
+ */
+
+ case MOD: case LEFT_SHIFT: case RIGHT_SHIFT:
+ case BIT_AND: case BIT_XOR: case BIT_OR:
+ if (valuePtr->type != TYPE_INT) {
+ badType = valuePtr->type;
+ goto illegalType;
+ } else if (value2.type != TYPE_INT) {
+ badType = value2.type;
+ goto illegalType;
+ }
+ break;
+
+ /*
+ * For the operators below, any type is allowed but the
+ * two operands must have the same type. Convert integers
+ * to floats and either to strings, if necessary.
+ */
+
+ case LESS: case GREATER: case LEQ: case GEQ:
+ case EQUAL: case NEQ:
+ if (valuePtr->type == TYPE_STRING) {
+ if (value2.type != TYPE_STRING) {
+ ExprMakeString(interp, &value2);
+ }
+ } else if (value2.type == TYPE_STRING) {
+ if (valuePtr->type != TYPE_STRING) {
+ ExprMakeString(interp, valuePtr);
+ }
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ if (value2.type == TYPE_INT) {
+ value2.doubleValue = value2.intValue;
+ value2.type = TYPE_DOUBLE;
+ }
+ } else if (value2.type == TYPE_DOUBLE) {
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->doubleValue = valuePtr->intValue;
+ valuePtr->type = TYPE_DOUBLE;
+ }
+ }
+ break;
+
+ /*
+ * For the operators below, no strings are allowed, but
+ * no int->double conversions are performed.
+ */
+
+ case AND: case OR:
+ if (valuePtr->type == TYPE_STRING) {
+ badType = valuePtr->type;
+ goto illegalType;
+ }
+ if (value2.type == TYPE_STRING) {
+ badType = value2.type;
+ goto illegalType;
+ }
+ break;
+
+ /*
+ * For the operators below, type and conversions are
+ * irrelevant: they're handled elsewhere.
+ */
+
+ case QUESTY: case COLON:
+ break;
+
+ /*
+ * Any other operator is an error.
+ */
+
+ default:
+ interp->result = "unknown operator in expression";
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Carry out the function of the specified operator.
+ */
+
+ switch (operator) {
+ case MULT:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue = valuePtr->intValue * value2.intValue;
+ } else {
+ valuePtr->doubleValue *= value2.doubleValue;
+ }
+ break;
+ case DIVIDE:
+ case MOD:
+ if (valuePtr->type == TYPE_INT) {
+ long divisor, quot, rem;
+ int negative;
+
+ if (value2.intValue == 0) {
+ divideByZero:
+ interp->result = "divide by zero";
+ Tcl_SetErrorCode(interp, "ARITH", "DIVZERO",
+ interp->result, (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * The code below is tricky because C doesn't guarantee
+ * much about the properties of the quotient or
+ * remainder, but Tcl does: the remainder always has
+ * the same sign as the divisor and a smaller absolute
+ * value.
+ */
+
+ divisor = value2.intValue;
+ negative = 0;
+ if (divisor < 0) {
+ divisor = -divisor;
+ valuePtr->intValue = -valuePtr->intValue;
+ negative = 1;
+ }
+ quot = valuePtr->intValue / divisor;
+ rem = valuePtr->intValue % divisor;
+ if (rem < 0) {
+ rem += divisor;
+ quot -= 1;
+ }
+ if (negative) {
+ rem = -rem;
+ }
+ valuePtr->intValue = (operator == DIVIDE) ? quot : rem;
+ } else {
+ if (value2.doubleValue == 0.0) {
+ goto divideByZero;
+ }
+ valuePtr->doubleValue /= value2.doubleValue;
+ }
+ break;
+ case PLUS:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue = valuePtr->intValue + value2.intValue;
+ } else {
+ valuePtr->doubleValue += value2.doubleValue;
+ }
+ break;
+ case MINUS:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue = valuePtr->intValue - value2.intValue;
+ } else {
+ valuePtr->doubleValue -= value2.doubleValue;
+ }
+ break;
+ case LEFT_SHIFT:
+ valuePtr->intValue <<= value2.intValue;
+ break;
+ case RIGHT_SHIFT:
+ /*
+ * The following code is a bit tricky: it ensures that
+ * right shifts propagate the sign bit even on machines
+ * where ">>" won't do it by default.
+ */
+
+ if (valuePtr->intValue < 0) {
+ valuePtr->intValue =
+ ~((~valuePtr->intValue) >> value2.intValue);
+ } else {
+ valuePtr->intValue >>= value2.intValue;
+ }
+ break;
+ case LESS:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue =
+ valuePtr->intValue < value2.intValue;
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ valuePtr->intValue =
+ valuePtr->doubleValue < value2.doubleValue;
+ } else {
+ valuePtr->intValue =
+ strcmp(valuePtr->pv.buffer, value2.pv.buffer) < 0;
+ }
+ valuePtr->type = TYPE_INT;
+ break;
+ case GREATER:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue =
+ valuePtr->intValue > value2.intValue;
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ valuePtr->intValue =
+ valuePtr->doubleValue > value2.doubleValue;
+ } else {
+ valuePtr->intValue =
+ strcmp(valuePtr->pv.buffer, value2.pv.buffer) > 0;
+ }
+ valuePtr->type = TYPE_INT;
+ break;
+ case LEQ:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue =
+ valuePtr->intValue <= value2.intValue;
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ valuePtr->intValue =
+ valuePtr->doubleValue <= value2.doubleValue;
+ } else {
+ valuePtr->intValue =
+ strcmp(valuePtr->pv.buffer, value2.pv.buffer) <= 0;
+ }
+ valuePtr->type = TYPE_INT;
+ break;
+ case GEQ:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue =
+ valuePtr->intValue >= value2.intValue;
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ valuePtr->intValue =
+ valuePtr->doubleValue >= value2.doubleValue;
+ } else {
+ valuePtr->intValue =
+ strcmp(valuePtr->pv.buffer, value2.pv.buffer) >= 0;
+ }
+ valuePtr->type = TYPE_INT;
+ break;
+ case EQUAL:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue =
+ valuePtr->intValue == value2.intValue;
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ valuePtr->intValue =
+ valuePtr->doubleValue == value2.doubleValue;
+ } else {
+ valuePtr->intValue =
+ strcmp(valuePtr->pv.buffer, value2.pv.buffer) == 0;
+ }
+ valuePtr->type = TYPE_INT;
+ break;
+ case NEQ:
+ if (valuePtr->type == TYPE_INT) {
+ valuePtr->intValue =
+ valuePtr->intValue != value2.intValue;
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ valuePtr->intValue =
+ valuePtr->doubleValue != value2.doubleValue;
+ } else {
+ valuePtr->intValue =
+ strcmp(valuePtr->pv.buffer, value2.pv.buffer) != 0;
+ }
+ valuePtr->type = TYPE_INT;
+ break;
+ case BIT_AND:
+ valuePtr->intValue &= value2.intValue;
+ break;
+ case BIT_XOR:
+ valuePtr->intValue ^= value2.intValue;
+ break;
+ case BIT_OR:
+ valuePtr->intValue |= value2.intValue;
+ break;
+
+ /*
+ * For AND and OR, we know that the first value has already
+ * been converted to an integer. Thus we need only consider
+ * the possibility of int vs. double for the second value.
+ */
+
+ case AND:
+ if (value2.type == TYPE_DOUBLE) {
+ value2.intValue = value2.doubleValue != 0;
+ value2.type = TYPE_INT;
+ }
+ valuePtr->intValue = valuePtr->intValue && value2.intValue;
+ break;
+ case OR:
+ if (value2.type == TYPE_DOUBLE) {
+ value2.intValue = value2.doubleValue != 0;
+ value2.type = TYPE_INT;
+ }
+ valuePtr->intValue = valuePtr->intValue || value2.intValue;
+ break;
+
+ case COLON:
+ interp->result = "can't have : operator without ? first";
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ done:
+ if (value2.pv.buffer != value2.staticSpace) {
+ ckfree(value2.pv.buffer);
+ }
+ return result;
+
+ syntaxError:
+ Tcl_AppendResult(interp, "syntax error in expression \"",
+ infoPtr->originalExpr, "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+
+ illegalType:
+ Tcl_AppendResult(interp, "can't use ", (badType == TYPE_DOUBLE) ?
+ "floating-point value" : "non-numeric string",
+ " as operand of \"", operatorStrings[operator], "\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExprMakeString --
+ *
+ * Convert a value from int or double representation to
+ * a string.
+ *
+ * Results:
+ * The information at *valuePtr gets converted to string
+ * format, if it wasn't that way already.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExprMakeString(interp, valuePtr)
+ Tcl_Interp *interp; /* Interpreter to use for precision
+ * information. */
+ register Value *valuePtr; /* Value to be converted. */
+{
+ int shortfall;
+
+ shortfall = 150 - (valuePtr->pv.end - valuePtr->pv.buffer);
+ if (shortfall > 0) {
+ (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
+ }
+ if (valuePtr->type == TYPE_INT) {
+ sprintf(valuePtr->pv.buffer, "%ld", valuePtr->intValue);
+ } else if (valuePtr->type == TYPE_DOUBLE) {
+ Tcl_PrintDouble(interp, valuePtr->doubleValue, valuePtr->pv.buffer);
+ }
+ valuePtr->type = TYPE_STRING;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExprTopLevel --
+ *
+ * This procedure provides top-level functionality shared by
+ * procedures like Tcl_ExprInt, Tcl_ExprDouble, etc.
+ *
+ * Results:
+ * The result is a standard Tcl return value. If an error
+ * occurs then an error message is left in interp->result.
+ * The value of the expression is returned in *valuePtr, in
+ * whatever form it ends up in (could be string or integer
+ * or double). Caller may need to convert result. Caller
+ * is also responsible for freeing string memory in *valuePtr,
+ * if any was allocated.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ExprTopLevel(interp, string, valuePtr)
+ Tcl_Interp *interp; /* Context in which to evaluate the
+ * expression. */
+ char *string; /* Expression to evaluate. */
+ Value *valuePtr; /* Where to store result. Should
+ * not be initialized by caller. */
+{
+ ExprInfo info;
+ int result;
+
+ /*
+ * Create the math functions the first time an expression is
+ * evaluated.
+ */
+
+ if (!(((Interp *) interp)->flags & EXPR_INITIALIZED)) {
+ BuiltinFunc *funcPtr;
+
+ ((Interp *) interp)->flags |= EXPR_INITIALIZED;
+ for (funcPtr = funcTable; funcPtr->name != NULL;
+ funcPtr++) {
+ Tcl_CreateMathFunc(interp, funcPtr->name, funcPtr->numArgs,
+ funcPtr->argTypes, funcPtr->proc, funcPtr->clientData);
+ }
+ }
+
+ info.originalExpr = string;
+ info.expr = string;
+ valuePtr->pv.buffer = valuePtr->pv.next = valuePtr->staticSpace;
+ valuePtr->pv.end = valuePtr->pv.buffer + STATIC_STRING_SPACE - 1;
+ valuePtr->pv.expandProc = TclExpandParseValue;
+ valuePtr->pv.clientData = (ClientData) NULL;
+
+ result = ExprGetValue(interp, &info, -1, valuePtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (info.token != END) {
+ Tcl_AppendResult(interp, "syntax error in expression \"",
+ string, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((valuePtr->type == TYPE_DOUBLE) && (IS_NAN(valuePtr->doubleValue)
+ || IS_INF(valuePtr->doubleValue))) {
+ /*
+ * IEEE floating-point error.
+ */
+
+ TclExprFloatError(interp, valuePtr->doubleValue);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
+ *
+ * Procedures to evaluate an expression and return its value
+ * in a particular form.
+ *
+ * Results:
+ * Each of the procedures below returns a standard Tcl result.
+ * If an error occurs then an error message is left in
+ * interp->result. Otherwise the value of the expression,
+ * in the appropriate form, is stored at *resultPtr. If
+ * the expression had a result that was incompatible with the
+ * desired form then an error is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprLong(interp, string, ptr)
+ Tcl_Interp *interp; /* Context in which to evaluate the
+ * expression. */
+ char *string; /* Expression to evaluate. */
+ long *ptr; /* Where to store result. */
+{
+ Value value;
+ int result;
+
+ result = ExprTopLevel(interp, string, &value);
+ if (result == TCL_OK) {
+ if (value.type == TYPE_INT) {
+ *ptr = value.intValue;
+ } else if (value.type == TYPE_DOUBLE) {
+ *ptr = (long) value.doubleValue;
+ } else {
+ interp->result = "expression didn't have numeric value";
+ result = TCL_ERROR;
+ }
+ }
+ if (value.pv.buffer != value.staticSpace) {
+ ckfree(value.pv.buffer);
+ }
+ return result;
+}
+
+int
+Tcl_ExprDouble(interp, string, ptr)
+ Tcl_Interp *interp; /* Context in which to evaluate the
+ * expression. */
+ char *string; /* Expression to evaluate. */
+ double *ptr; /* Where to store result. */
+{
+ Value value;
+ int result;
+
+ result = ExprTopLevel(interp, string, &value);
+ if (result == TCL_OK) {
+ if (value.type == TYPE_INT) {
+ *ptr = value.intValue;
+ } else if (value.type == TYPE_DOUBLE) {
+ *ptr = value.doubleValue;
+ } else {
+ interp->result = "expression didn't have numeric value";
+ result = TCL_ERROR;
+ }
+ }
+ if (value.pv.buffer != value.staticSpace) {
+ ckfree(value.pv.buffer);
+ }
+ return result;
+}
+
+int
+Tcl_ExprBoolean(interp, string, ptr)
+ Tcl_Interp *interp; /* Context in which to evaluate the
+ * expression. */
+ char *string; /* Expression to evaluate. */
+ int *ptr; /* Where to store 0/1 result. */
+{
+ Value value;
+ int result;
+
+ result = ExprTopLevel(interp, string, &value);
+ if (result == TCL_OK) {
+ if (value.type == TYPE_INT) {
+ *ptr = value.intValue != 0;
+ } else if (value.type == TYPE_DOUBLE) {
+ *ptr = value.doubleValue != 0.0;
+ } else {
+ result = Tcl_GetBoolean(interp, value.pv.buffer, ptr);
+ }
+ }
+ if (value.pv.buffer != value.staticSpace) {
+ ckfree(value.pv.buffer);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprString --
+ *
+ * Evaluate an expression and return its value in string form.
+ *
+ * Results:
+ * A standard Tcl result. If the result is TCL_OK, then the
+ * interpreter's result is set to the string value of the
+ * expression. If the result is TCL_OK, then interp->result
+ * contains an error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprString(interp, string)
+ Tcl_Interp *interp; /* Context in which to evaluate the
+ * expression. */
+ char *string; /* Expression to evaluate. */
+{
+ Value value;
+ int result;
+
+ result = ExprTopLevel(interp, string, &value);
+ if (result == TCL_OK) {
+ if (value.type == TYPE_INT) {
+ sprintf(interp->result, "%ld", value.intValue);
+ } else if (value.type == TYPE_DOUBLE) {
+ Tcl_PrintDouble(interp, value.doubleValue, interp->result);
+ } else {
+ if (value.pv.buffer != value.staticSpace) {
+ interp->result = value.pv.buffer;
+ interp->freeProc = TCL_DYNAMIC;
+ value.pv.buffer = value.staticSpace;
+ } else {
+ Tcl_SetResult(interp, value.pv.buffer, TCL_VOLATILE);
+ }
+ }
+ }
+ if (value.pv.buffer != value.staticSpace) {
+ ckfree(value.pv.buffer);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateMathFunc --
+ *
+ * Creates a new math function for expressions in a given
+ * interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The function defined by "name" is created; if such a function
+ * already existed then its definition is overriden.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
+ Tcl_Interp *interp; /* Interpreter in which function is
+ * to be available. */
+ char *name; /* Name of function (e.g. "sin"). */
+ int numArgs; /* Nnumber of arguments required by
+ * function. */
+ Tcl_ValueType *argTypes; /* Array of types acceptable for
+ * each argument. */
+ Tcl_MathProc *proc; /* Procedure that implements the
+ * math function. */
+ ClientData clientData; /* Additional value to pass to the
+ * function. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+ MathFunc *mathFuncPtr;
+ int new, i;
+
+ hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
+ if (new) {
+ Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
+ }
+ mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+ if (numArgs > MAX_MATH_ARGS) {
+ numArgs = MAX_MATH_ARGS;
+ }
+ mathFuncPtr->numArgs = numArgs;
+ for (i = 0; i < numArgs; i++) {
+ mathFuncPtr->argTypes[i] = argTypes[i];
+ }
+ mathFuncPtr->proc = proc;
+ mathFuncPtr->clientData = clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExprMathFunc --
+ *
+ * This procedure is invoked to parse a math function from an
+ * expression string, carry out the function, and return the
+ * value computed.
+ *
+ * Results:
+ * TCL_OK is returned if all went well and the function's value
+ * was computed successfully. If an error occurred, TCL_ERROR
+ * is returned and an error message is left in interp->result.
+ * After a successful return infoPtr has been updated to refer
+ * to the character just after the function call, the token is
+ * set to VALUE, and the value is stored in valuePtr.
+ *
+ * Side effects:
+ * Embedded commands could have arbitrary side-effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprMathFunc(interp, infoPtr, valuePtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ register ExprInfo *infoPtr; /* Describes the state of the parse.
+ * infoPtr->expr must point to the
+ * first character of the function's
+ * name. */
+ register Value *valuePtr; /* Where to store value, if that is
+ * what's parsed from string. Caller
+ * must have initialized pv field
+ * correctly. */
+{
+ Interp *iPtr = (Interp *) interp;
+ MathFunc *mathFuncPtr; /* Info about math function. */
+ Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */
+ Tcl_Value funcResult; /* Result of function call. */
+ Tcl_HashEntry *hPtr;
+ char *p, *funcName, savedChar;
+ int i, result;
+
+ /*
+ * Find the end of the math function's name and lookup the MathFunc
+ * record for the function.
+ */
+
+ p = funcName = infoPtr->expr;
+ while (isalnum(UCHAR(*p)) || (*p == '_')) {
+ p++;
+ }
+ infoPtr->expr = p;
+ result = ExprLex(interp, infoPtr, valuePtr);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (infoPtr->token != OPEN_PAREN) {
+ goto syntaxError;
+ }
+ savedChar = *p;
+ *p = 0;
+ hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "unknown math function \"", funcName,
+ "\"", (char *) NULL);
+ *p = savedChar;
+ return TCL_ERROR;
+ }
+ *p = savedChar;
+ mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+
+ /*
+ * Scan off the arguments for the function, if there are any.
+ */
+
+ if (mathFuncPtr->numArgs == 0) {
+ result = ExprLex(interp, infoPtr, valuePtr);
+ if ((result != TCL_OK) || (infoPtr->token != CLOSE_PAREN)) {
+ goto syntaxError;
+ }
+ } else {
+ for (i = 0; ; i++) {
+ valuePtr->pv.next = valuePtr->pv.buffer;
+ result = ExprGetValue(interp, infoPtr, -1, valuePtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (valuePtr->type == TYPE_STRING) {
+ interp->result =
+ "argument to math function didn't have numeric value";
+ return TCL_ERROR;
+ }
+
+ /*
+ * Copy the value to the argument record, converting it if
+ * necessary.
+ */
+
+ if (valuePtr->type == TYPE_INT) {
+ if (mathFuncPtr->argTypes[i] == TCL_DOUBLE) {
+ args[i].type = TCL_DOUBLE;
+ args[i].doubleValue = valuePtr->intValue;
+ } else {
+ args[i].type = TCL_INT;
+ args[i].intValue = valuePtr->intValue;
+ }
+ } else {
+ if (mathFuncPtr->argTypes[i] == TCL_INT) {
+ args[i].type = TCL_INT;
+ args[i].intValue = (long) valuePtr->doubleValue;
+ } else {
+ args[i].type = TCL_DOUBLE;
+ args[i].doubleValue = valuePtr->doubleValue;
+ }
+ }
+
+ /*
+ * Check for a comma separator between arguments or a close-paren
+ * to end the argument list.
+ */
+
+ if (i == (mathFuncPtr->numArgs-1)) {
+ if (infoPtr->token == CLOSE_PAREN) {
+ break;
+ }
+ if (infoPtr->token == COMMA) {
+ interp->result = "too many arguments for math function";
+ return TCL_ERROR;
+ } else {
+ goto syntaxError;
+ }
+ }
+ if (infoPtr->token != COMMA) {
+ if (infoPtr->token == CLOSE_PAREN) {
+ interp->result = "too few arguments for math function";
+ return TCL_ERROR;
+ } else {
+ goto syntaxError;
+ }
+ }
+ }
+ }
+ if (iPtr->noEval) {
+ valuePtr->type = TYPE_INT;
+ valuePtr->intValue = 0;
+ infoPtr->token = VALUE;
+ return TCL_OK;
+ }
+
+ /*
+ * Invoke the function and copy its result back into valuePtr.
+ */
+
+ tcl_MathInProgress++;
+ result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
+ &funcResult);
+ tcl_MathInProgress--;
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (funcResult.type == TCL_INT) {
+ valuePtr->type = TYPE_INT;
+ valuePtr->intValue = funcResult.intValue;
+ } else {
+ valuePtr->type = TYPE_DOUBLE;
+ valuePtr->doubleValue = funcResult.doubleValue;
+ }
+ infoPtr->token = VALUE;
+ return TCL_OK;
+
+ syntaxError:
+ Tcl_AppendResult(interp, "syntax error in expression \"",
+ infoPtr->originalExpr, "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExprFloatError --
+ *
+ * This procedure is called when an error occurs during a
+ * floating-point operation. It reads errno and sets
+ * interp->result accordingly.
+ *
+ * Results:
+ * Interp->result is set to hold an error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclExprFloatError(interp, value)
+ Tcl_Interp *interp; /* Where to store error message. */
+ double value; /* Value returned after error; used to
+ * distinguish underflows from overflows. */
+{
+ char buf[20];
+
+ if ((errno == EDOM) || (value != value)) {
+ interp->result = "domain error: argument not in valid range";
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", interp->result,
+ (char *) NULL);
+ } else if ((errno == ERANGE) || IS_INF(value)) {
+ if (value == 0.0) {
+ interp->result = "floating-point value too small to represent";
+ Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", interp->result,
+ (char *) NULL);
+ } else {
+ interp->result = "floating-point value too large to represent";
+ Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", interp->result,
+ (char *) NULL);
+ }
+ } else {
+ sprintf(buf, "%d", errno);
+ Tcl_AppendResult(interp, "unknown floating-point error, ",
+ "errno = ", buf, (char *) NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", interp->result,
+ (char *) NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Math Functions --
+ *
+ * This page contains the procedures that implement all of the
+ * built-in math functions for expressions.
+ *
+ * Results:
+ * Each procedure returns TCL_OK if it succeeds and places result
+ * information at *resultPtr. If it fails it returns TCL_ERROR
+ * and leaves an error message in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprUnaryFunc(clientData, interp, args, resultPtr)
+ ClientData clientData; /* Contains address of procedure that
+ * takes one double argument and
+ * returns a double result. */
+ Tcl_Interp *interp;
+ Tcl_Value *args;
+ Tcl_Value *resultPtr;
+{
+ double (*func) _ANSI_ARGS_((double)) = (double (*)_ANSI_ARGS_((double))) clientData;
+
+ errno = 0;
+ resultPtr->type = TCL_DOUBLE;
+ resultPtr->doubleValue = (*func)(args[0].doubleValue);
+ if (errno != 0) {
+ TclExprFloatError(interp, resultPtr->doubleValue);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+static int
+ExprBinaryFunc(clientData, interp, args, resultPtr)
+ ClientData clientData; /* Contains address of procedure that
+ * takes two double arguments and
+ * returns a double result. */
+ Tcl_Interp *interp;
+ Tcl_Value *args;
+ Tcl_Value *resultPtr;
+{
+ double (*func) _ANSI_ARGS_((double, double))
+ = (double (*)_ANSI_ARGS_((double, double))) clientData;
+
+ errno = 0;
+ resultPtr->type = TCL_DOUBLE;
+ resultPtr->doubleValue = (*func)(args[0].doubleValue, args[1].doubleValue);
+ if (errno != 0) {
+ TclExprFloatError(interp, resultPtr->doubleValue);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+ /* ARGSUSED */
+static int
+ExprAbsFunc(clientData, interp, args, resultPtr)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tcl_Value *args;
+ Tcl_Value *resultPtr;
+{
+ resultPtr->type = TCL_DOUBLE;
+ if (args[0].type == TCL_DOUBLE) {
+ resultPtr->type = TCL_DOUBLE;
+ if (args[0].doubleValue < 0) {
+ resultPtr->doubleValue = -args[0].doubleValue;
+ } else {
+ resultPtr->doubleValue = args[0].doubleValue;
+ }
+ } else {
+ resultPtr->type = TCL_INT;
+ if (args[0].intValue < 0) {
+ resultPtr->intValue = -args[0].intValue;
+ if (resultPtr->intValue < 0) {
+ interp->result = "integer value too large to represent";
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", interp->result,
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ resultPtr->intValue = args[0].intValue;
+ }
+ }
+ return TCL_OK;
+}
+
+ /* ARGSUSED */
+static int
+ExprDoubleFunc(clientData, interp, args, resultPtr)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tcl_Value *args;
+ Tcl_Value *resultPtr;
+{
+ resultPtr->type = TCL_DOUBLE;
+ if (args[0].type == TCL_DOUBLE) {
+ resultPtr->doubleValue = args[0].doubleValue;
+ } else {
+ resultPtr->doubleValue = args[0].intValue;
+ }
+ return TCL_OK;
+}
+
+ /* ARGSUSED */
+static int
+ExprIntFunc(clientData, interp, args, resultPtr)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tcl_Value *args;
+ Tcl_Value *resultPtr;
+{
+ resultPtr->type = TCL_INT;
+ if (args[0].type == TCL_INT) {
+ resultPtr->intValue = args[0].intValue;
+ } else {
+ if (args[0].doubleValue < 0) {
+ if (args[0].doubleValue < (double) (long) LONG_MIN) {
+ tooLarge:
+ interp->result = "integer value too large to represent";
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+ interp->result, (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ if (args[0].doubleValue > (double) LONG_MAX) {
+ goto tooLarge;
+ }
+ }
+ resultPtr->intValue = (long) args[0].doubleValue;
+ }
+ return TCL_OK;
+}
+
+ /* ARGSUSED */
+static int
+ExprRoundFunc(clientData, interp, args, resultPtr)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tcl_Value *args;
+ Tcl_Value *resultPtr;
+{
+ resultPtr->type = TCL_INT;
+ if (args[0].type == TCL_INT) {
+ resultPtr->intValue = args[0].intValue;
+ } else {
+ if (args[0].doubleValue < 0) {
+ if (args[0].doubleValue <= (((double) (long) LONG_MIN) - 0.5)) {
+ tooLarge:
+ interp->result = "integer value too large to represent";
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+ interp->result, (char *) NULL);
+ return TCL_ERROR;
+ }
+ resultPtr->intValue = (long) (args[0].doubleValue - 0.5);
+ } else {
+ if (args[0].doubleValue >= (((double) LONG_MAX + 0.5))) {
+ goto tooLarge;
+ }
+ resultPtr->intValue = (long) (args[0].doubleValue + 0.5);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExprLooksLikeInt --
+ *
+ * This procedure decides whether the leading characters of a
+ * string look like an integer or something else (such as a
+ * floating-point number or string).
+ *
+ * Results:
+ * The return value is 1 if the leading characters of p look
+ * like a valid Tcl integer. If they look like a floating-point
+ * number (e.g. "e01" or "2.4"), or if they don't look like a
+ * number at all, then 0 is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ExprLooksLikeInt(p)
+ char *p; /* Pointer to string. */
+{
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if ((*p == '+') || (*p == '-')) {
+ p++;
+ }
+ if (!isdigit(UCHAR(*p))) {
+ return 0;
+ }
+ p++;
+ while (isdigit(UCHAR(*p))) {
+ p++;
+ }
+ if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
+ return 1;
+ }
+ return 0;
+}
diff --git a/tcl/generic/tclFCmd.c b/tcl/generic/tclFCmd.c
index 1260cda4f05..8e1d84a838a 100644
--- a/tcl/generic/tclFCmd.c
+++ b/tcl/generic/tclFCmd.c
@@ -4,7 +4,7 @@
* This file implements the generic portion of file manipulation
* subcommands of the "file" command.
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -172,7 +172,7 @@ FileCopyRename(interp, argc, argv, copyFlag)
* Move each source file into target directory. Extract the basename
* from each source, and append it to the end of the target path.
*/
-
+
for ( ; i < argc - 1; i++) {
char *jargv[2];
char *source, *newFileName;
@@ -350,7 +350,7 @@ TclFileDeleteCmd(interp, argc, argv)
* Call lstat() to get info so can delete symbolic link itself.
*/
- if (lstat(name, &statBuf) != 0) {
+ if (TclpLstat(name, &statBuf) != 0) {
/*
* Trying to delete a file that does not exist is not
* considered an error, just a no-op
@@ -432,7 +432,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
Tcl_DString sourcePath, targetPath, errorBuffer;
char *targetName, *sourceName, *errfile;
struct stat sourceStatBuf, targetStatBuf;
-
+
sourceName = Tcl_TranslateFileName(interp, source, &sourcePath);
if (sourceName == NULL) {
return TCL_ERROR;
@@ -454,11 +454,11 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
* target.
*/
- if (lstat(sourceName, &sourceStatBuf) != 0) {
+ if (TclpLstat(sourceName, &sourceStatBuf) != 0) {
errfile = source;
goto done;
}
- if (lstat(targetName, &targetStatBuf) != 0) {
+ if (TclpLstat(targetName, &targetStatBuf) != 0) {
if (errno != ENOENT) {
errfile = target;
goto done;
@@ -606,8 +606,8 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
* Results:
* The return value is how many arguments from argv were consumed
* by this function, or -1 if there was an error parsing the
- * options. If an error occurred, an error message is left in
- * interp->result.
+ * options. If an error occurred, an error message is left in the
+ * interp's result.
*
* Side effects:
* None.
@@ -620,7 +620,7 @@ FileForceOption(interp, argc, argv, forcePtr)
Tcl_Interp *interp; /* Interp, for error return. */
int argc; /* Number of arguments. */
char **argv; /* Argument strings. First command line
- option, if it exists, begins at */
+ * option, if it exists, begins at 0. */
int *forcePtr; /* If the "-force" was specified, *forcePtr
* is filled with 1, otherwise with 0. */
{
@@ -751,66 +751,91 @@ TclFileAttrsCmd(interp, objc, objv)
int objc; /* Number of command line arguments. */
Tcl_Obj *CONST objv[]; /* The command line objects. */
{
- Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *fileName;
- int length, index;
- Tcl_Obj *listObjPtr;
- Tcl_Obj *elementObjPtr;
+ int result;
Tcl_DString buffer;
- if ((objc > 2) && ((objc % 2) == 0)) {
- Tcl_AppendStringsToObj(resultPtr,
- "wrong # args: must be \"file attributes name ?option? ?value? ?option value? ...\"",
- (char *) NULL);
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "name ?option? ?value? ?option value ...?");
return TCL_ERROR;
}
- fileName = Tcl_GetStringFromObj(objv[0], &length);
- if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
+ fileName = Tcl_GetString(objv[2]);
+ fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
+ if (fileName == NULL) {
return TCL_ERROR;
}
- fileName = Tcl_DStringValue(&buffer);
- if (objc == 1) {
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-
+ objc -= 3;
+ objv += 3;
+ result = TCL_ERROR;
+
+ if (objc == 0) {
+ /*
+ * Get all attributes.
+ */
+
+ int index;
+ Tcl_Obj *listPtr, *objPtr;
+
+ listPtr = Tcl_NewListObj(0, NULL);
for (index = 0; tclpFileAttrStrings[index] != NULL; index++) {
- elementObjPtr = Tcl_NewStringObj(tclpFileAttrStrings[index], -1);
- Tcl_ListObjAppendElement(interp, listObjPtr, elementObjPtr);
+ objPtr = Tcl_NewStringObj(tclpFileAttrStrings[index], -1);
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+
if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
- &elementObjPtr) != TCL_OK) {
- Tcl_DecrRefCount(listObjPtr);
- return TCL_ERROR;
+ &objPtr) != TCL_OK) {
+ Tcl_DecrRefCount(listPtr);
+ goto end;
}
- Tcl_ListObjAppendElement(interp, listObjPtr, elementObjPtr);
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
}
- Tcl_SetObjResult(interp, listObjPtr);
- } else if (objc == 2) {
- if (Tcl_GetIndexFromObj(interp, objv[1], tclpFileAttrStrings, "option",
- 0, &index) != TCL_OK) {
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, listPtr);
+ } else if (objc == 1) {
+ /*
+ * Get one attribute.
+ */
+
+ int index;
+ Tcl_Obj *objPtr;
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], tclpFileAttrStrings,
+ "option", 0, &index) != TCL_OK) {
+ goto end;
}
if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
- &elementObjPtr) != TCL_OK) {
- return TCL_ERROR;
+ &objPtr) != TCL_OK) {
+ goto end;
}
- Tcl_SetObjResult(interp, elementObjPtr);
+ Tcl_SetObjResult(interp, objPtr);
} else {
- int i;
+ /*
+ * Set option/value pairs.
+ */
+
+ int i, index;
- for (i = 1; i < objc ; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], tclpFileAttrStrings, "option",
- 0, &index) != TCL_OK) {
- return TCL_ERROR;
+ for (i = 0; i < objc ; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], tclpFileAttrStrings,
+ "option", 0, &index) != TCL_OK) {
+ goto end;
}
+ if (i + 1 == objc) {
+ Tcl_AppendResult(interp, "value for \"",
+ Tcl_GetString(objv[i]), "\" missing",
+ (char *) NULL);
+ goto end;
+ }
if ((*tclpFileAttrProcs[index].setProc)(interp, index, fileName,
objv[i + 1]) != TCL_OK) {
- return TCL_ERROR;
+ goto end;
}
}
}
-
+ result = TCL_OK;
+
+ end:
Tcl_DStringFree(&buffer);
-
- return TCL_OK;
+ return result;
}
diff --git a/tcl/generic/tclFHandle.c b/tcl/generic/tclFHandle.c
new file mode 100644
index 00000000000..2b9ca6420d5
--- /dev/null
+++ b/tcl/generic/tclFHandle.c
@@ -0,0 +1,259 @@
+/*
+ * tclFHandle.c --
+ *
+ * This file contains functions for manipulating Tcl file handles.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclFHandle.c 1.9 96/07/01 15:41:26
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * The FileHashKey structure is used to associate the OS file handle and type
+ * with the corresponding notifier data in a FileHandle.
+ */
+
+typedef struct FileHashKey {
+ int type; /* File handle type. */
+ ClientData osHandle; /* Platform specific OS file handle. */
+} FileHashKey;
+
+typedef struct FileHandle {
+ FileHashKey key; /* Hash key for a given file. */
+ ClientData data; /* Platform specific notifier data. */
+ Tcl_FileFreeProc *proc; /* Callback to invoke when file is freed. */
+} FileHandle;
+
+/*
+ * Static variables used in this file:
+ */
+
+static Tcl_HashTable fileTable; /* Hash table containing file handles. */
+static int initialized = 0; /* 1 if this module has been initialized. */
+
+/*
+ * Static procedures used in this file:
+ */
+
+static void FileExitProc _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetFile --
+ *
+ * This function retrieves the file handle associated with a
+ * platform specific file handle of the given type. It creates
+ * a new file handle if needed.
+ *
+ * Results:
+ * Returns the file handle associated with the file descriptor.
+ *
+ * Side effects:
+ * Initializes the file handle table if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_File
+Tcl_GetFile(osHandle, type)
+ ClientData osHandle; /* Platform specific file handle. */
+ int type; /* Type of file handle. */
+{
+ FileHashKey key;
+ Tcl_HashEntry *entryPtr;
+ int new;
+
+ if (!initialized) {
+ Tcl_InitHashTable(&fileTable, sizeof(FileHashKey)/sizeof(int));
+ Tcl_CreateExitHandler(FileExitProc, 0);
+ initialized = 1;
+ }
+ key.osHandle = osHandle;
+ key.type = type;
+ entryPtr = Tcl_CreateHashEntry(&fileTable, (char *) &key, &new);
+ if (new) {
+ FileHandle *newHandlePtr;
+ newHandlePtr = (FileHandle *) ckalloc(sizeof(FileHandle));
+ newHandlePtr->key = key;
+ newHandlePtr->data = NULL;
+ newHandlePtr->proc = NULL;
+ Tcl_SetHashValue(entryPtr, newHandlePtr);
+ }
+
+ return (Tcl_File) Tcl_GetHashValue(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FreeFile --
+ *
+ * Deallocates an entry in the file handle table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FreeFile(handle)
+ Tcl_File handle;
+{
+ Tcl_HashEntry *entryPtr;
+ FileHandle *handlePtr = (FileHandle *) handle;
+
+ /*
+ * Invoke free procedure, then delete the handle.
+ */
+
+ if (handlePtr->proc) {
+ (*handlePtr->proc)(handlePtr->data);
+ }
+
+ /*
+ * Tcl_File structures may be freed as a result of running the
+ * channel table exit handler. The file table is freed by the file
+ * table exit handler, which may run before the channel table exit
+ * handler. The file table exit handler sets the "initialized"
+ * variable back to zero, so that the Tcl_FreeFile (when invoked
+ * from the channel table exit handler) can notice that the file
+ * table has already been destroyed. Otherwise, accessing a
+ * deleted hash table would cause a panic.
+ */
+
+ if (initialized) {
+ entryPtr = Tcl_FindHashEntry(&fileTable, (char *) &handlePtr->key);
+ if (entryPtr) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ ckfree((char *) handlePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetFileInfo --
+ *
+ * This function retrieves the platform specific file data and
+ * type from the file handle.
+ *
+ * Results:
+ * If typePtr is not NULL, sets *typePtr to the type of the file.
+ * Returns the platform specific file data.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_GetFileInfo(handle, typePtr)
+ Tcl_File handle;
+ int *typePtr;
+{
+ FileHandle *handlePtr = (FileHandle *) handle;
+
+ if (typePtr) {
+ *typePtr = handlePtr->key.type;
+ }
+ return handlePtr->key.osHandle;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetNotifierData --
+ *
+ * This function is used by the notifier to associate platform
+ * specific notifier information and a deletion procedure with
+ * a file handle.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the data and delProc slots in the file handle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetNotifierData(handle, proc, data)
+ Tcl_File handle;
+ Tcl_FileFreeProc *proc;
+ ClientData data;
+{
+ FileHandle *handlePtr = (FileHandle *) handle;
+ handlePtr->proc = proc;
+ handlePtr->data = data;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetNotifierData --
+ *
+ * This function is used by the notifier to retrieve the platform
+ * specific notifier information associated with a file handle.
+ *
+ * Results:
+ * Returns the data stored in a file handle by a previous call to
+ * Tcl_SetNotifierData, and places a pointer to the free proc
+ * in the location referred to by procPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_GetNotifierData(handle, procPtr)
+ Tcl_File handle;
+ Tcl_FileFreeProc **procPtr;
+{
+ FileHandle *handlePtr = (FileHandle *) handle;
+ if (procPtr != NULL) {
+ *procPtr = handlePtr->proc;
+ }
+ return handlePtr->data;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileExitProc --
+ *
+ * This function an exit handler that frees any memory allocated
+ * for the file handle table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Cleans up the file handle table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileExitProc(clientData)
+ ClientData clientData; /* Not used. */
+{
+ Tcl_DeleteHashTable(&fileTable);
+ initialized = 0;
+}
diff --git a/tcl/generic/tclFileName.c b/tcl/generic/tclFileName.c
index d57aaedefdb..32e9495c6df 100644
--- a/tcl/generic/tclFileName.c
+++ b/tcl/generic/tclFileName.c
@@ -4,7 +4,8 @@
* This file contains routines for converting file names betwen
* native and network form.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,19 +18,12 @@
#include "tclRegexp.h"
/*
- * This variable indicates whether the cleanup procedure has been
- * registered for this file yet.
- */
-
-static int initialized = 0;
-
-/*
* The following regular expression matches the root portion of a Windows
* absolute or volume relative path. It will match both UNC and drive relative
* paths.
*/
-#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\][/\\]+([^/\\]+)[/\\]+([^/\\]+)|([/\\]))([/\\])*"
+#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*"
/*
* The following regular expression matches the root portion of a Macintosh
@@ -44,8 +38,12 @@ static int initialized = 0;
* for use in filename matching.
*/
-static regexp *winRootPatternPtr = NULL;
-static regexp *macRootPatternPtr = NULL;
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_Obj *macRootPatternPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
/*
* The following variable is set in the TclPlatformInit call to one
@@ -55,26 +53,63 @@ static regexp *macRootPatternPtr = NULL;
TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
/*
+ * The "globParameters" argument of the globbing functions is an
+ * or'ed combination of the following values:
+ */
+
+#define GLOBMODE_NO_COMPLAIN 1
+#define GLOBMODE_JOIN 2
+#define GLOBMODE_DIR 4
+
+/*
* Prototypes for local procedures defined in this file:
*/
static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
- char *user, Tcl_DString *resultPtr));
-static char * ExtractWinRoot _ANSI_ARGS_((char *path,
- Tcl_DString *resultPtr, int offset));
+ CONST char *user, Tcl_DString *resultPtr));
+static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path,
+ Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr));
static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
+static void FileNameInit _ANSI_ARGS_((void));
static int SkipToChar _ANSI_ARGS_((char **stringPtr,
char *match));
-static char * SplitMacPath _ANSI_ARGS_((char *path,
+static char * SplitMacPath _ANSI_ARGS_((CONST char *path,
Tcl_DString *bufPtr));
-static char * SplitWinPath _ANSI_ARGS_((char *path,
+static char * SplitWinPath _ANSI_ARGS_((CONST char *path,
Tcl_DString *bufPtr));
-static char * SplitUnixPath _ANSI_ARGS_((char *path,
+static char * SplitUnixPath _ANSI_ARGS_((CONST char *path,
Tcl_DString *bufPtr));
/*
*----------------------------------------------------------------------
*
+ * FileNameInit --
+ *
+ * This procedure initializes the patterns used by this module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Compiles the regular expressions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileNameInit()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1);
+ Tcl_CreateThreadExitHandler(FileNameCleanup, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* FileNameCleanup --
*
* This procedure is a Tcl_ExitProc used to clean up the static
@@ -93,15 +128,9 @@ static void
FileNameCleanup(clientData)
ClientData clientData; /* Not used. */
{
- if (winRootPatternPtr != NULL) {
- ckfree((char *)winRootPatternPtr);
- winRootPatternPtr = (regexp *) NULL;
- }
- if (macRootPatternPtr != NULL) {
- ckfree((char *)macRootPatternPtr);
- macRootPatternPtr = (regexp *) NULL;
- }
- initialized = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
+ tsdPtr->initialized = 0;
}
/*
@@ -124,55 +153,87 @@ FileNameCleanup(clientData)
*----------------------------------------------------------------------
*/
-static char *
-ExtractWinRoot(path, resultPtr, offset)
- char *path; /* Path to parse. */
+static CONST char *
+ExtractWinRoot(path, resultPtr, offset, typePtr)
+ CONST char *path; /* Path to parse. */
Tcl_DString *resultPtr; /* Buffer to hold result. */
int offset; /* Offset in buffer where result should be
* stored. */
+ Tcl_PathType *typePtr; /* Where to store pathType result */
{
- int length;
+ FileNameInit();
- /*
- * Initialize the path name parser for Windows path names.
- */
- if (winRootPatternPtr == NULL) {
- winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
- if (!initialized) {
- Tcl_CreateExitHandler(FileNameCleanup, NULL);
- initialized = 1;
- }
+ if (path[0] == '/' || path[0] == '\\') {
+ /* Might be a UNC or Vol-Relative path */
+ char *host, *share, *tail;
+ int hlen, slen;
+ if (path[1] != '/' && path[1] != '\\') {
+ Tcl_DStringSetLength(resultPtr, offset);
+ *typePtr = TCL_PATH_VOLUME_RELATIVE;
+ Tcl_DStringAppend(resultPtr, "/", 1);
+ return &path[1];
}
+ host = (char *)&path[2];
- /*
- * Match the root portion of a Windows path name.
- */
+ /* Skip seperators */
+ while (host[0] == '/' || host[0] == '\\') host++;
- if (!TclRegExec(winRootPatternPtr, path, path)) {
- return path;
- }
+ for (hlen = 0; host[hlen];hlen++) {
+ if (host[hlen] == '/' || host[hlen] == '\\')
+ break;
+ }
+ if (host[hlen] == 0 || host[hlen+1] == 0) {
+ *typePtr = TCL_PATH_VOLUME_RELATIVE;
+ Tcl_DStringAppend(resultPtr, "/", 1);
+ return &path[2];
+ }
+ Tcl_DStringSetLength(resultPtr, offset);
+ share = &host[hlen];
- Tcl_DStringSetLength(resultPtr, offset);
+ /* Skip seperators */
+ while (share[0] == '/' || share[0] == '\\') share++;
- if (winRootPatternPtr->startp[2] != NULL) {
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
- if (winRootPatternPtr->startp[6] != NULL) {
- Tcl_DStringAppend(resultPtr, "/", 1);
+ for (slen = 0; share[slen];slen++) {
+ if (share[slen] == '/' || share[slen] == '\\')
+ break;
}
- } else if (winRootPatternPtr->startp[4] != NULL) {
Tcl_DStringAppend(resultPtr, "//", 2);
- length = winRootPatternPtr->endp[3]
- - winRootPatternPtr->startp[3];
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
+ Tcl_DStringAppend(resultPtr, host, hlen);
Tcl_DStringAppend(resultPtr, "/", 1);
- length = winRootPatternPtr->endp[4]
- - winRootPatternPtr->startp[4];
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
+ Tcl_DStringAppend(resultPtr, share, slen);
+
+ tail = &share[slen];
+
+ /* Skip seperators */
+ while (tail[0] == '/' || tail[0] == '\\') tail++;
+
+ *typePtr = TCL_PATH_ABSOLUTE;
+ return tail;
+ } else if (path[1] == ':') {
+ /* Might be a drive sep */
+ Tcl_DStringSetLength(resultPtr, offset);
+
+ if (path[2] != '/' && path[2] != '\\') {
+ *typePtr = TCL_PATH_VOLUME_RELATIVE;
+ Tcl_DStringAppend(resultPtr, path, 2);
+ return &path[2];
} else {
+ char *tail = (char*)&path[3];
+
+ /* Skip seperators */
+ while (tail[0] == '/' || tail[0] == '\\') tail++;
+
+ *typePtr = TCL_PATH_ABSOLUTE;
+ Tcl_DStringAppend(resultPtr, path, 2);
Tcl_DStringAppend(resultPtr, "/", 1);
+
+ return tail;
+ }
+ } else {
+ *typePtr = TCL_PATH_RELATIVE;
+ return path;
}
- return winRootPatternPtr->endp[0];
}
/*
@@ -197,7 +258,9 @@ Tcl_PathType
Tcl_GetPathType(path)
char *path;
{
+ ThreadSpecificData *tsdPtr;
Tcl_PathType type = TCL_PATH_ABSOLUTE;
+ Tcl_RegExp re;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
@@ -214,50 +277,37 @@ Tcl_GetPathType(path)
if (path[0] == ':') {
type = TCL_PATH_RELATIVE;
} else if (path[0] != '~') {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Since we have eliminated the easy cases, use the
* root pattern to look for the other types.
*/
- if (!macRootPatternPtr) {
- macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
- if (!initialized) {
- Tcl_CreateExitHandler(FileNameCleanup, NULL);
- initialized = 1;
- }
- }
- if (!TclRegExec(macRootPatternPtr, path, path)
- || (macRootPatternPtr->startp[2] != NULL)) {
+ FileNameInit();
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr,
+ REG_ADVANCED);
+
+ if (!Tcl_RegExpExec(NULL, re, path, path)) {
type = TCL_PATH_RELATIVE;
+ } else {
+ char *unixRoot, *dummy;
+
+ Tcl_RegExpRange(re, 2, &unixRoot, &dummy);
+ if (unixRoot) {
+ type = TCL_PATH_RELATIVE;
+ }
}
}
break;
case TCL_PLATFORM_WINDOWS:
if (path[0] != '~') {
+ Tcl_DString ds;
- /*
- * Since we have eliminated the easy cases, check for
- * drive relative paths using the regular expression.
- */
-
- if (!winRootPatternPtr) {
- winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
- if (!initialized) {
- Tcl_CreateExitHandler(FileNameCleanup, NULL);
- initialized = 1;
- }
- }
- if (TclRegExec(winRootPatternPtr, path, path)) {
- if (winRootPatternPtr->startp[5]
- || (winRootPatternPtr->startp[2]
- && !(winRootPatternPtr->startp[6]))) {
- type = TCL_PATH_VOLUME_RELATIVE;
- }
- } else {
- type = TCL_PATH_RELATIVE;
- }
+ Tcl_DStringInit(&ds);
+ (VOID)ExtractWinRoot(path, &ds, 0, &type);
+ Tcl_DStringFree(&ds);
}
break;
}
@@ -292,7 +342,7 @@ Tcl_GetPathType(path)
void
Tcl_SplitPath(path, argcPtr, argvPtr)
- char *path; /* Pointer to string containing a path. */
+ CONST char *path; /* Pointer to string containing a path. */
int *argcPtr; /* Pointer to location to fill in with
* the number of elements in the path. */
char ***argvPtr; /* Pointer to place to store pointer to array
@@ -301,6 +351,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
int i, size;
char *p;
Tcl_DString buffer;
+
Tcl_DStringInit(&buffer);
/*
@@ -385,16 +436,29 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
static char *
SplitUnixPath(path, bufPtr)
- char *path; /* Pointer to string containing a path. */
+ CONST char *path; /* Pointer to string containing a path. */
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int length;
- char *p, *elementStart;
+ CONST char *p, *elementStart;
/*
* Deal with the root directory as a special case.
*/
+#ifdef __QNX__
+ /*
+ * Check for QNX //<node id> prefix
+ */
+ if ((path[0] == '/') && (path[1] == '/')
+ && isdigit(UCHAR(path[2]))) { /* INTL: digit */
+ path += 3;
+ while (isdigit(UCHAR(*path))) { /* INTL: digit */
+ ++path;
+ }
+ }
+#endif
+
if (path[0] == '/') {
Tcl_DStringAppend(bufPtr, "/", 2);
p = path+1;
@@ -447,13 +511,14 @@ SplitUnixPath(path, bufPtr)
static char *
SplitWinPath(path, bufPtr)
- char *path; /* Pointer to string containing a path. */
+ CONST char *path; /* Pointer to string containing a path. */
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int length;
- char *p, *elementStart;
+ CONST char *p, *elementStart;
+ Tcl_PathType type = TCL_PATH_ABSOLUTE;
- p = ExtractWinRoot(path, bufPtr, 0);
+ p = ExtractWinRoot(path, bufPtr, 0, &type);
/*
* Terminate the root portion, if we matched something.
@@ -505,88 +570,98 @@ SplitWinPath(path, bufPtr)
static char *
SplitMacPath(path, bufPtr)
- char *path; /* Pointer to string containing a path. */
+ CONST char *path; /* Pointer to string containing a path. */
Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */
int i, length;
- char *p, *elementStart;
+ CONST char *p, *elementStart;
+ Tcl_RegExp re;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Initialize the path name parser for Macintosh path names.
*/
- if (macRootPatternPtr == NULL) {
- macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
- if (!initialized) {
- Tcl_CreateExitHandler(FileNameCleanup, NULL);
- initialized = 1;
- }
- }
+ FileNameInit();
/*
* Match the root portion of a Mac path name.
*/
i = 0; /* Needed only to prevent gcc warnings. */
- if (TclRegExec(macRootPatternPtr, path, path) == 1) {
+
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, REG_ADVANCED);
+
+ if (Tcl_RegExpExec(NULL, re, path, path) == 1) {
+ char *start, *end;
+
/*
* Treat degenerate absolute paths like / and /../.. as
* Mac relative file names for lack of anything else to do.
*/
- if (macRootPatternPtr->startp[2] != NULL) {
+ Tcl_RegExpRange(re, 2, &start, &end);
+ if (start) {
Tcl_DStringAppend(bufPtr, ":", 1);
- Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0]
- - macRootPatternPtr->startp[0] + 1);
+ Tcl_RegExpRange(re, 0, &start, &end);
+ Tcl_DStringAppend(bufPtr, path, end - start + 1);
return Tcl_DStringValue(bufPtr);
}
- if (macRootPatternPtr->startp[5] != NULL) {
-
+ Tcl_RegExpRange(re, 5, &start, &end);
+ if (start) {
/*
* Unix-style tilde prefixed paths.
*/
isMac = 0;
i = 5;
- } else if (macRootPatternPtr->startp[7] != NULL) {
-
- /*
- * Mac-style tilde prefixed paths.
- */
+ } else {
+ Tcl_RegExpRange(re, 7, &start, &end);
+ if (start) {
+ /*
+ * Mac-style tilde prefixed paths.
+ */
- isMac = 1;
- i = 7;
- } else if (macRootPatternPtr->startp[10] != NULL) {
+ isMac = 1;
+ i = 7;
+ } else {
+ Tcl_RegExpRange(re, 10, &start, &end);
+ if (start) {
- /*
- * Normal Unix style paths.
- */
+ /*
+ * Normal Unix style paths.
+ */
- isMac = 0;
- i = 10;
- } else if (macRootPatternPtr->startp[12] != NULL) {
+ isMac = 0;
+ i = 10;
+ } else {
+ Tcl_RegExpRange(re, 12, &start, &end);
+ if (start) {
- /*
- * Normal Mac style paths.
- */
+ /*
+ * Normal Mac style paths.
+ */
- isMac = 1;
- i = 12;
+ isMac = 1;
+ i = 12;
+ }
+ }
+ }
}
- length = macRootPatternPtr->endp[i]
- - macRootPatternPtr->startp[i];
+ Tcl_RegExpRange(re, i, &start, &end);
+ length = end - start;
/*
* Append the element and terminate it with a : and a null. Note that
* we are forcing the DString to contain an extra null at the end.
*/
- Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length);
+ Tcl_DStringAppend(bufPtr, start, length);
Tcl_DStringAppend(bufPtr, ":", 2);
- p = macRootPatternPtr->endp[i];
+ p = end;
} else {
isMac = (strchr(path, ':') != NULL);
p = path;
@@ -690,7 +765,9 @@ Tcl_JoinPath(argc, argv, resultPtr)
{
int oldLength, length, i, needsSep;
Tcl_DString buffer;
- char *p, c, *dest;
+ char c, *dest;
+ CONST char *p;
+ Tcl_PathType type = TCL_PATH_ABSOLUTE;
Tcl_DStringInit(&buffer);
oldLength = Tcl_DStringLength(resultPtr);
@@ -706,6 +783,18 @@ Tcl_JoinPath(argc, argv, resultPtr)
* beginning of the path.
*/
+#ifdef __QNX__
+ /*
+ * Check for QNX //<node id> prefix
+ */
+ if (*p && (strlen(p) > 3) && (p[0] == '/') && (p[1] == '/')
+ && isdigit(UCHAR(p[2]))) { /* INTL: digit */
+ p += 3;
+ while (isdigit(UCHAR(*p))) { /* INTL: digit */
+ ++p;
+ }
+ }
+#endif
if (*p == '/') {
Tcl_DStringSetLength(resultPtr, oldLength);
Tcl_DStringAppend(resultPtr, "/", 1);
@@ -767,7 +856,7 @@ Tcl_JoinPath(argc, argv, resultPtr)
*/
for (i = 0; i < argc; i++) {
- p = ExtractWinRoot(argv[i], resultPtr, oldLength);
+ p = ExtractWinRoot(argv[i], resultPtr, oldLength, &type);
length = Tcl_DStringLength(resultPtr);
/*
@@ -884,25 +973,27 @@ Tcl_JoinPath(argc, argv, resultPtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_TranslateFileName --
*
* Converts a file name into a form usable by the native system
- * interfaces. If the name starts with a tilde, it will produce
- * a name where the tilde and following characters have been
- * replaced by the home directory location for the named user.
+ * interfaces. If the name starts with a tilde, it will produce a
+ * name where the tilde and following characters have been replaced
+ * by the home directory location for the named user.
*
* Results:
- * The result is a pointer to a static string containing
- * the new name. If there was an error in processing the
- * name, then an error message is left in interp->result
- * and the return value is NULL. The result will be stored
- * in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
- * to free the name if the return value was not NULL.
+ * The return value is a pointer to a string containing the name
+ * after tilde substitution. If there was no tilde substitution,
+ * the return value is a pointer to a copy of the original string.
+ * If there was an error in processing the name, then an error
+ * message is left in the interp's result (if interp was not NULL)
+ * and the return value is NULL. Space for the return value is
+ * allocated in bufferPtr; the caller must call Tcl_DStringFree()
+ * to free the space if the return value was not NULL.
*
* Side effects:
- * Information may be left in bufferPtr.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -911,13 +1002,12 @@ char *
Tcl_TranslateFileName(interp, name, bufferPtr)
Tcl_Interp *interp; /* Interpreter in which to store error
* message (if necessary). */
- char *name; /* File name, which may begin with "~"
- * (to indicate current user's home directory)
- * or "~<user>" (to indicate any user's
- * home directory). */
- Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold
- * anything at the time of the call, and need
- * not even be initialized. */
+ char *name; /* File name, which may begin with "~" (to
+ * indicate current user's home directory) or
+ * "~<user>" (to indicate any user's home
+ * directory). */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name after tilde substitution. */
{
register char *p;
@@ -930,11 +1020,11 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
char **argv;
Tcl_DString temp;
- Tcl_SplitPath(name, &argc, &argv);
+ Tcl_SplitPath(name, &argc, (char ***) &argv);
/*
- * Strip the trailing ':' off of a Mac path
- * before passing the user name to DoTildeSubst.
+ * Strip the trailing ':' off of a Mac path before passing the user
+ * name to DoTildeSubst.
*/
if (tclPlatform == TCL_PLATFORM_MAC) {
@@ -950,12 +1040,12 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
return NULL;
}
Tcl_DStringInit(bufferPtr);
- Tcl_JoinPath(argc, argv, bufferPtr);
+ Tcl_JoinPath(argc, (char **) argv, bufferPtr);
Tcl_DStringFree(&temp);
ckfree((char*)argv);
} else {
Tcl_DStringInit(bufferPtr);
- Tcl_JoinPath(1, &name, bufferPtr);
+ Tcl_JoinPath(1, (char **) &name, bufferPtr);
}
/*
@@ -1031,15 +1121,12 @@ TclGetExtension(name)
}
/*
- * Back up to the first period in a series of contiguous dots.
- * This is needed so foo..o will be split on the first dot.
+ * In earlier versions, we used to back up to the first period in a series
+ * so that "foo..o" would be split into "foo" and "..o". This is a
+ * confusing and usually incorrect behavior, so now we split at the last
+ * period in the name.
*/
- if (p != NULL) {
- while ((p > name) && *(p-1) == '.') {
- p--;
- }
- }
return p;
}
@@ -1054,9 +1141,10 @@ TclGetExtension(name)
* Results:
* The result is a pointer to a static string containing the home
* directory in native format. If there was an error in processing
- * the substitution, then an error message is left in interp->result
- * and the return value is NULL. On success, the results are appended
- * to resultPtr, and the contents of resultPtr are returned.
+ * the substitution, then an error message is left in the interp's
+ * result and the return value is NULL. On success, the results
+ * are appended to resultPtr, and the contents of resultPtr are
+ * returned.
*
* Side effects:
* Information may be left in resultPtr.
@@ -1068,16 +1156,17 @@ static char *
DoTildeSubst(interp, user, resultPtr)
Tcl_Interp *interp; /* Interpreter in which to store error
* message (if necessary). */
- char *user; /* Name of user whose home directory should be
+ CONST char *user; /* Name of user whose home directory should be
* substituted, or "" for current user. */
- Tcl_DString *resultPtr; /* May be used to hold result. Must not hold
- * anything at the time of the call, and need
- * not even be initialized. */
+ Tcl_DString *resultPtr; /* Initialized DString filled with name
+ * after tilde substitution. */
{
char *dir;
if (*user == '\0') {
- dir = TclGetEnv("HOME");
+ Tcl_DString dirString;
+
+ dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
Tcl_ResetResult(interp);
@@ -1087,10 +1176,9 @@ DoTildeSubst(interp, user, resultPtr)
return NULL;
}
Tcl_JoinPath(1, &dir, resultPtr);
+ Tcl_DStringFree(&dirString);
} else {
-
- /* lint, TclGetuserHome() always NULL under windows. */
- if (TclGetUserHome(user, resultPtr) == NULL) {
+ if (TclpGetUserHome(user, resultPtr) == NULL) {
if (interp) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
@@ -1105,7 +1193,7 @@ DoTildeSubst(interp, user, resultPtr)
/*
*----------------------------------------------------------------------
*
- * Tcl_GlobCmd --
+ * Tcl_GlobObjCmd --
*
* This procedure is invoked to process the "glob" Tcl command.
* See the user documentation for details on what it does.
@@ -1121,42 +1209,116 @@ DoTildeSubst(interp, user, resultPtr)
/* ARGSUSED */
int
-Tcl_GlobCmd(dummy, interp, argc, argv)
+Tcl_GlobObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int i, noComplain, firstArg;
- char c;
- int result = TCL_OK;
- Tcl_DString buffer;
- char *separators, *head, *tail;
-
- noComplain = 0;
- for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
- firstArg++) {
- if (strcmp(argv[firstArg], "-nocomplain") == 0) {
- noComplain = 1;
- } else if (strcmp(argv[firstArg], "--") == 0) {
- firstArg++;
- break;
- } else {
- Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
- "\": must be -nocomplain or --", (char *) NULL);
- return TCL_ERROR;
+ int index, i, globFlags, pathlength, length, join, dir, result;
+ char *string, *pathOrDir, *separators;
+ Tcl_Obj *typePtr, *resultPtr, *look;
+ Tcl_DString prefix, directory;
+ static char *options[] = {
+ "-directory", "-join", "-nocomplain", "-path", "-types", "--", NULL
+ };
+ enum options {
+ GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TYPE, GLOB_LAST
+ };
+ enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
+ GlobTypeData *globTypes = NULL;
+
+ globFlags = 0;
+ join = 0;
+ dir = PATH_NONE;
+ pathOrDir = NULL;
+ typePtr = NULL;
+ resultPtr = Tcl_GetObjResult(interp);
+ for (i = 1; i < objc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
+ != TCL_OK) {
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ if (string[0] == '-') {
+ /*
+ * It looks like the command contains an option so signal
+ * an error
+ */
+ return TCL_ERROR;
+ } else {
+ /*
+ * This clearly isn't an option; assume it's the first
+ * glob pattern. We must clear the error
+ */
+ Tcl_ResetResult(interp);
+ break;
+ }
+ }
+ switch (index) {
+ case GLOB_NOCOMPLAIN: /* -nocomplain */
+ globFlags |= GLOBMODE_NO_COMPLAIN;
+ break;
+ case GLOB_DIR: /* -dir */
+ if (i == (objc-1)) {
+ Tcl_AppendToObj(resultPtr,
+ "missing argument to \"-directory\"", -1);
+ return TCL_ERROR;
+ }
+ if (dir != -1) {
+ Tcl_AppendToObj(resultPtr,
+ "\"-directory\" cannot be used with \"-path\"",
+ -1);
+ return TCL_ERROR;
+ }
+ dir = PATH_DIR;
+ globFlags |= GLOBMODE_DIR;
+ pathOrDir = Tcl_GetStringFromObj(objv[i+1], &pathlength);
+ i++;
+ break;
+ case GLOB_JOIN: /* -join */
+ join = 1;
+ break;
+ case GLOB_PATH: /* -path */
+ if (i == (objc-1)) {
+ Tcl_AppendToObj(resultPtr,
+ "missing argument to \"-path\"", -1);
+ return TCL_ERROR;
+ }
+ if (dir != -1) {
+ Tcl_AppendToObj(resultPtr,
+ "\"-path\" cannot be used with \"-directory\"",
+ -1);
+ return TCL_ERROR;
+ }
+ dir = PATH_GENERAL;
+ pathOrDir = Tcl_GetStringFromObj(objv[i+1], &pathlength);
+ i++;
+ break;
+ case GLOB_TYPE: /* -types */
+ if (i == (objc-1)) {
+ Tcl_AppendToObj(resultPtr,
+ "missing argument to \"-types\"", -1);
+ return TCL_ERROR;
+ }
+ typePtr = objv[i+1];
+ if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ i++;
+ break;
+ case GLOB_LAST: /* -- */
+ i++;
+ goto endOfForLoop;
+ break;
}
}
- if (firstArg >= argc) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ?switches? name ?name ...?\"", (char *) NULL);
+ endOfForLoop:
+ if (objc - i < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
return TCL_ERROR;
}
- Tcl_DStringInit(&buffer);
- separators = NULL; /* Needed only to prevent gcc warnings. */
- for (i = firstArg; i < argc; i++) {
- switch (tclPlatform) {
+ separators = NULL; /* lint. */
+ switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
break;
@@ -1164,102 +1326,430 @@ Tcl_GlobCmd(dummy, interp, argc, argv)
separators = "/\\:";
break;
case TCL_PLATFORM_MAC:
- separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
+ separators = ":";
break;
- }
-
- Tcl_DStringSetLength(&buffer, 0);
+ }
+ if (dir == PATH_GENERAL) {
+ char *last;
/*
- * Perform tilde substitution, if needed.
+ * Find the last path separator in the path
*/
+ last = pathOrDir + pathlength;
+ for (; last != pathOrDir; last--) {
+ if (strchr(separators, *(last-1)) != NULL) {
+ break;
+ }
+ }
+ if (last == pathOrDir + pathlength) {
+ /* It's really a directory */
+ dir = 1;
+ } else {
+ Tcl_DString pref;
+ char *search, *find;
+ Tcl_DStringInit(&pref);
+ Tcl_DStringInit(&directory);
+ if (last == pathOrDir) {
+ /* The whole thing is a prefix */
+ Tcl_DStringAppend(&pref, pathOrDir, -1);
+ pathOrDir = NULL;
+ } else {
+ /* Have to split off the end */
+ Tcl_DStringAppend(&pref, last, pathOrDir+pathlength-last);
+ Tcl_DStringAppend(&directory, pathOrDir, last-pathOrDir-1);
+ pathOrDir = Tcl_DStringValue(&directory);
+ }
+ /* Need to quote 'prefix' */
+ Tcl_DStringInit(&prefix);
+ search = Tcl_DStringValue(&pref);
+ while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
+ Tcl_DStringAppend(&prefix, search, find-search);
+ Tcl_DStringAppend(&prefix, "\\", 1);
+ Tcl_DStringAppend(&prefix, find, 1);
+ search = find+1;
+ if (*search == '\0') {
+ break;
+ }
+ }
+ if (*search != '\0') {
+ Tcl_DStringAppend(&prefix, search, -1);
+ }
+ Tcl_DStringFree(&pref);
+ }
+ }
- if (argv[i][0] == '~') {
- char *p;
-
- /*
- * Find the first path separator after the tilde.
- */
-
- for (tail = argv[i]; *tail != '\0'; tail++) {
- if (*tail == '\\') {
- if (strchr(separators, tail[1]) != NULL) {
- break;
- }
- } else if (strchr(separators, *tail) != NULL) {
+ if (typePtr != NULL) {
+ /*
+ * The rest of the possible type arguments (except 'd') are
+ * platform specific. We don't complain when they are used
+ * on an incompatible platform.
+ */
+ Tcl_ListObjLength(interp, typePtr, &length);
+ globTypes = (GlobTypeData*) ckalloc(sizeof(GlobTypeData));
+ globTypes->type = 0;
+ globTypes->perm = 0;
+ globTypes->macType = NULL;
+ globTypes->macCreator = NULL;
+ while(--length >= 0) {
+ int len;
+ char *str;
+ Tcl_ListObjIndex(interp, typePtr, length, &look);
+ str = Tcl_GetStringFromObj(look, &len);
+ if (strcmp("readonly", str) == 0) {
+ globTypes->perm |= TCL_GLOB_PERM_RONLY;
+ } else if (strcmp("hidden", str) == 0) {
+ globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
+ } else if (len == 1) {
+ switch (str[0]) {
+ case 'r':
+ globTypes->perm |= TCL_GLOB_PERM_R;
+ break;
+ case 'w':
+ globTypes->perm |= TCL_GLOB_PERM_W;
+ break;
+ case 'x':
+ globTypes->perm |= TCL_GLOB_PERM_X;
+ break;
+ case 'b':
+ globTypes->type |= TCL_GLOB_TYPE_BLOCK;
+ break;
+ case 'c':
+ globTypes->type |= TCL_GLOB_TYPE_CHAR;
+ break;
+ case 'd':
+ globTypes->type |= TCL_GLOB_TYPE_DIR;
+ break;
+ case 'p':
+ globTypes->type |= TCL_GLOB_TYPE_PIPE;
+ break;
+ case 'f':
+ globTypes->type |= TCL_GLOB_TYPE_FILE;
break;
+ case 'l':
+ globTypes->type |= TCL_GLOB_TYPE_LINK;
+ break;
+ case 's':
+ globTypes->type |= TCL_GLOB_TYPE_SOCK;
+ break;
+ default:
+ goto badTypesArg;
+ }
+ } else if (len == 4) {
+ /* This is assumed to be a MacOS file type */
+ if (globTypes->macType != NULL) {
+ goto badMacTypesArg;
+ }
+ globTypes->macType = look;
+ Tcl_IncrRefCount(look);
+ } else {
+ Tcl_Obj* item;
+ if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
+ (len == 3)) {
+ Tcl_ListObjIndex(interp, look, 0, &item);
+ if (!strcmp("macintosh", Tcl_GetString(item))) {
+ Tcl_ListObjIndex(interp, look, 1, &item);
+ if (!strcmp("type", Tcl_GetString(item))) {
+ Tcl_ListObjIndex(interp, look, 2, &item);
+ if (globTypes->macType != NULL) {
+ goto badMacTypesArg;
+ }
+ globTypes->macType = item;
+ Tcl_IncrRefCount(item);
+ continue;
+ } else if (!strcmp("creator", Tcl_GetString(item))) {
+ Tcl_ListObjIndex(interp, look, 2, &item);
+ if (globTypes->macCreator != NULL) {
+ goto badMacTypesArg;
+ }
+ globTypes->macCreator = item;
+ Tcl_IncrRefCount(item);
+ continue;
+ }
+ }
}
+ /*
+ * Error cases
+ */
+ badTypesArg:
+ Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
+ Tcl_AppendObjToObj(resultPtr, look);
+ result = TCL_ERROR;
+ goto endOfGlob;
+ badMacTypesArg:
+ Tcl_AppendToObj(resultPtr,
+ "only one MacOS type or creator argument to \"-types\" allowed", -1);
+ result = TCL_ERROR;
+ goto endOfGlob;
}
+ }
+ }
- /*
- * Determine the home directory for the specified user. Note that
- * we don't allow special characters in the user name.
- */
-
- c = *tail;
- *tail = '\0';
- p = strpbrk(argv[i]+1, "\\[]*?{}");
- if (p == NULL) {
- head = DoTildeSubst(interp, argv[i]+1, &buffer);
- } else {
- if (!noComplain) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "globbing characters not ",
- "supported in user names", (char *) NULL);
+ /*
+ * Now we perform the actual glob below. This may involve joining
+ * together the pattern arguments, dealing with particular file types
+ * etc. We use a 'goto' to ensure we free any memory allocated along
+ * the way.
+ */
+ objc -= i;
+ objv += i;
+ /*
+ * We re-retrieve this, in case it was changed in
+ * the Tcl_ResetResult above
+ */
+ resultPtr = Tcl_GetObjResult(interp);
+ result = TCL_OK;
+ if (join) {
+ if (dir != PATH_GENERAL) {
+ Tcl_DStringInit(&prefix);
+ }
+ for (i = 0; i < objc; i++) {
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_DStringAppend(&prefix, string, length);
+ if (i != objc -1) {
+ Tcl_DStringAppend(&prefix, separators, 1);
+ }
+ }
+ if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir,
+ globFlags, globTypes) != TCL_OK) {
+ result = TCL_ERROR;
+ goto endOfGlob;
+ }
+ } else {
+ if (dir == PATH_GENERAL) {
+ Tcl_DString str;
+ for (i = 0; i < objc; i++) {
+ Tcl_DStringInit(&str);
+ if (dir == PATH_GENERAL) {
+ Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
+ Tcl_DStringLength(&prefix));
+ }
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_DStringAppend(&str, string, length);
+ if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir,
+ globFlags, globTypes) != TCL_OK) {
+ result = TCL_ERROR;
+ Tcl_DStringFree(&str);
+ goto endOfGlob;
}
- head = NULL;
}
- *tail = c;
- if (head == NULL) {
- if (noComplain) {
- Tcl_ResetResult(interp);
- continue;
- } else {
+ Tcl_DStringFree(&str);
+ } else {
+ for (i = 0; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ if (TclGlob(interp, string, pathOrDir,
+ globFlags, globTypes) != TCL_OK) {
result = TCL_ERROR;
- goto done;
+ goto endOfGlob;
}
}
- if (head != Tcl_DStringValue(&buffer)) {
- Tcl_DStringAppend(&buffer, head, -1);
+ }
+ }
+ if ((globFlags & GLOBMODE_NO_COMPLAIN) == 0) {
+ if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
+ &length) != TCL_OK) {
+ /* This should never happen. Maybe we should be more dramatic */
+ result = TCL_ERROR;
+ goto endOfGlob;
+ }
+ if (length == 0) {
+ Tcl_AppendResult(interp, "no files matched glob pattern",
+ (join || (objc == 1)) ? " \"" : "s \"", (char *) NULL);
+ if (join) {
+ Tcl_AppendResult(interp, Tcl_DStringValue(&prefix),
+ (char *) NULL);
+ } else {
+ char *sep = "";
+ for (i = 0; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ Tcl_AppendResult(interp, sep, string, (char *) NULL);
+ sep = " ";
+ }
}
- } else {
- tail = argv[i];
+ Tcl_AppendResult(interp, "\"", (char *) NULL);
+ result = TCL_ERROR;
}
+ }
+ endOfGlob:
+ if (join || (dir == PATH_GENERAL)) {
+ Tcl_DStringFree(&prefix);
+ if (dir == PATH_GENERAL) {
+ Tcl_DStringFree(&directory);
+ }
+ }
+ if (globTypes != NULL) {
+ if (globTypes->macType != NULL) {
+ Tcl_DecrRefCount(globTypes->macType);
+ }
+ if (globTypes->macCreator != NULL) {
+ Tcl_DecrRefCount(globTypes->macCreator);
+ }
+ ckfree((char *) globTypes);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGlob --
+ *
+ * This procedure prepares arguments for the TclDoGlob call.
+ * It sets the separator string based on the platform, performs
+ * tilde substitution, and calls TclDoGlob.
+ *
+ * Results:
+ * The return value is a standard Tcl result indicating whether
+ * an error occurred in globbing. After a normal return the
+ * result in interp (set by TclDoGlob) holds all of the file names
+ * given by the dir and rem arguments. After an error the
+ * result in interp will hold an error message.
+ *
+ * Side effects:
+ * The currentArgString is written to.
+ *
+ *----------------------------------------------------------------------
+ */
- result = TclDoGlob(interp, separators, &buffer, tail);
- if (result != TCL_OK) {
- if (noComplain) {
+ /* ARGSUSED */
+int
+TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
+ Tcl_Interp *interp; /* Interpreter for returning error message
+ * or appending list of matching file names. */
+ char *pattern; /* Glob pattern to match. Must not refer
+ * to a static string. */
+ char *unquotedPrefix; /* Prefix to glob pattern, if non-null, which
+ * is considered literally. May be static. */
+ int globFlags; /* Stores or'ed combination of flags */
+ GlobTypeData *types; /* Struct containing acceptable types.
+ * May be NULL. */
+{
+ char *separators;
+ char *head, *tail, *start;
+ char c;
+ int result;
+ Tcl_DString buffer;
+
+ separators = NULL; /* lint. */
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ separators = "/";
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ separators = "/\\:";
+ break;
+ case TCL_PLATFORM_MAC:
+ if (unquotedPrefix == NULL) {
+ separators = (strchr(pattern, ':') == NULL) ? "/" : ":";
+ } else {
+ separators = ":";
+ }
+ break;
+ }
+
+ Tcl_DStringInit(&buffer);
+ if (unquotedPrefix != NULL) {
+ start = unquotedPrefix;
+ } else {
+ start = pattern;
+ }
+
+ /*
+ * Perform tilde substitution, if needed.
+ */
+
+ if (start[0] == '~') {
+
+ /*
+ * Find the first path separator after the tilde.
+ */
+ for (tail = start; *tail != '\0'; tail++) {
+ if (*tail == '\\') {
+ if (strchr(separators, tail[1]) != NULL) {
+ break;
+ }
+ } else if (strchr(separators, *tail) != NULL) {
+ break;
+ }
+ }
+
+ /*
+ * Determine the home directory for the specified user. Note that
+ * we don't allow special characters in the user name.
+ */
+
+ c = *tail;
+ *tail = '\0';
+ /*
+ * I don't think we need to worry about special characters in
+ * the user name anymore (Vince Darley, June 1999), since the
+ * new code is designed to handle special chars.
+ */
+#ifndef NOT_NEEDED_ANYMORE
+ head = DoTildeSubst(interp, start+1, &buffer);
+#else
+
+ if (strpbrk(start+1, "\\[]*?{}") == NULL) {
+ head = DoTildeSubst(interp, start+1, &buffer);
+ } else {
+ if (!(globFlags & GLOBMODE_NO_COMPLAIN)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "globbing characters not ",
+ "supported in user names", (char *) NULL);
+ }
+ head = NULL;
+ }
+#endif
+ *tail = c;
+ if (head == NULL) {
+ if (globFlags & GLOBMODE_NO_COMPLAIN) {
/*
* We should in fact pass down the nocomplain flag
- * or save the interp result or use another mecanism
+ * or save the interp result or use another mechanism
* so the interp result is not mangled on errors in that case.
* but that would a bigger change than reasonable for a patch
* release.
* (see fileName.test 15.2-15.4 for expected behaviour)
*/
Tcl_ResetResult(interp);
- result = TCL_OK;
- continue;
+ return TCL_OK;
} else {
- goto done;
+ return TCL_ERROR;
}
}
+ if (head != Tcl_DStringValue(&buffer)) {
+ Tcl_DStringAppend(&buffer, head, -1);
+ }
+ if (unquotedPrefix != NULL) {
+ Tcl_DStringAppend(&buffer, tail, -1);
+ tail = pattern;
+ }
+ } else {
+ tail = pattern;
+ if (unquotedPrefix != NULL) {
+ Tcl_DStringAppend(&buffer,unquotedPrefix,-1);
+ }
}
-
- if ((*interp->result == 0) && !noComplain) {
- char *sep = "";
-
- Tcl_AppendResult(interp, "no files matched glob pattern",
- (argc == 2) ? " \"" : "s \"", (char *) NULL);
- for (i = firstArg; i < argc; i++) {
- Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
- sep = " ";
+ /*
+ * If the prefix is a directory, make sure it ends in a directory
+ * separator.
+ */
+ if (unquotedPrefix != NULL) {
+ if (globFlags & GLOBMODE_DIR) {
+ c = Tcl_DStringValue(&buffer)[Tcl_DStringLength(&buffer)-1];
+ if (strchr(separators, c) == NULL) {
+ Tcl_DStringAppend(&buffer,separators,1);
+ }
}
- Tcl_AppendResult(interp, "\"", (char *) NULL);
- result = TCL_ERROR;
}
-done:
+
+ result = TclDoGlob(interp, separators, &buffer, tail, types);
Tcl_DStringFree(&buffer);
+ if (result != TCL_OK) {
+ if (globFlags & GLOBMODE_NO_COMPLAIN) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+ }
return result;
}
@@ -1323,7 +1813,11 @@ SkipToChar(stringPtr, match)
* This recursive procedure forms the heart of the globbing
* code. It performs a depth-first traversal of the tree
* given by the path name to be globbed. The directory and
- * remainder are assumed to be native format paths.
+ * remainder are assumed to be native format paths. The prefix
+ * contained in 'headPtr' is not used as a glob pattern, simply
+ * as a path specifier, so it can contain unquoted glob-sensitive
+ * characters (if the directories to which it points contain
+ * such strange characters).
*
* Results:
* The return value is a standard Tcl result indicating whether
@@ -1339,19 +1833,23 @@ SkipToChar(stringPtr, match)
*/
int
-TclDoGlob(interp, separators, headPtr, tail)
+TclDoGlob(interp, separators, headPtr, tail, types)
Tcl_Interp *interp; /* Interpreter to use for error reporting
* (e.g. unmatched brace). */
char *separators; /* String containing separator characters
* that should be used to identify globbing
* boundaries. */
Tcl_DString *headPtr; /* Completely expanded prefix. */
- char *tail; /* The unexpanded remainder of the path. */
+ char *tail; /* The unexpanded remainder of the path.
+ * Must not be a pointer to a static string. */
+ GlobTypeData *types; /* List object containing list of acceptable types.
+ * May be NULL. */
{
int baseLength, quoted, count;
int result = TCL_OK;
- char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar;
+ char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar;
char lastChar = 0;
+
int length = Tcl_DStringLength(headPtr);
if (length > 0) {
@@ -1503,7 +2001,7 @@ TclDoGlob(interp, separators, headPtr, tail)
Tcl_DStringAppend(&newName, element, p-element);
Tcl_DStringAppend(&newName, closeBrace+1, -1);
result = TclDoGlob(interp, separators,
- headPtr, Tcl_DStringValue(&newName));
+ headPtr, Tcl_DStringValue(&newName), types);
if (result != TCL_OK) {
break;
}
@@ -1522,6 +2020,12 @@ TclDoGlob(interp, separators, headPtr, tail)
*/
if (*p != '\0') {
+
+ /*
+ * Note that we are modifying the string in place. This won't work
+ * if the string is a static.
+ */
+
savedChar = *p;
*p = '\0';
firstSpecialChar = strpbrk(tail, "*[]?\\");
@@ -1535,15 +2039,15 @@ TclDoGlob(interp, separators, headPtr, tail)
* Look for matching files in the current directory. The
* implementation of this function is platform specific, but may
* recursively call TclDoGlob. For each file that matches, it will
- * add the match onto the interp->result, or call TclDoGlob if there
+ * add the match onto the interp's result, or call TclDoGlob if there
* are more characters to be processed.
*/
- return TclMatchFiles(interp, separators, headPtr, tail, p);
+ return TclpMatchFilesTypes(interp, separators, headPtr, tail, p, types);
}
Tcl_DStringAppend(headPtr, tail, p-tail);
if (*p != '\0') {
- return TclDoGlob(interp, separators, headPtr, p);
+ return TclDoGlob(interp, separators, headPtr, p, types);
}
/*
@@ -1553,21 +2057,25 @@ TclDoGlob(interp, separators, headPtr, tail)
*/
switch (tclPlatform) {
- case TCL_PLATFORM_MAC:
+ case TCL_PLATFORM_MAC: {
if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
Tcl_DStringAppend(headPtr, ":", 1);
}
name = Tcl_DStringValue(headPtr);
- if (TclAccess(name, F_OK) == 0) {
+ if (TclpAccess(name, F_OK) == 0) {
if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
- Tcl_AppendElement(interp, name+1);
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(name + 1,-1));
} else {
- Tcl_AppendElement(interp, name);
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(name,-1));
}
}
break;
+ }
case TCL_PLATFORM_WINDOWS: {
int exists;
+
/*
* We need to convert slashes to backslashes before checking
* for the existence of the file. Once we are done, we need
@@ -1589,18 +2097,20 @@ TclDoGlob(interp, separators, headPtr, tail)
}
}
name = Tcl_DStringValue(headPtr);
- exists = (TclAccess(name, F_OK) == 0);
+ exists = (TclpAccess(name, F_OK) == 0);
+
for (p = name; *p != '\0'; p++) {
if (*p == '\\') {
*p = '/';
}
}
if (exists) {
- Tcl_AppendElement(interp, name);
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(name,-1));
}
break;
}
- case TCL_PLATFORM_UNIX:
+ case TCL_PLATFORM_UNIX: {
if (Tcl_DStringLength(headPtr) == 0) {
if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
Tcl_DStringAppend(headPtr, "/", 1);
@@ -1609,11 +2119,14 @@ TclDoGlob(interp, separators, headPtr, tail)
}
}
name = Tcl_DStringValue(headPtr);
- if (TclAccess(name, F_OK) == 0) {
- Tcl_AppendElement(interp, name);
+ if (TclpAccess(name, F_OK) == 0) {
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ Tcl_NewStringObj(name,-1));
}
break;
+ }
}
return TCL_OK;
}
+
diff --git a/tcl/generic/tclGet.c b/tcl/generic/tclGet.c
index e426cf59df9..72edad8d981 100644
--- a/tcl/generic/tclGet.c
+++ b/tcl/generic/tclGet.c
@@ -6,7 +6,7 @@
* booleans, doing syntax checking along the way.
*
* Copyright (c) 1990-1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -16,6 +16,7 @@
#include "tclInt.h"
#include "tclPort.h"
+#include "tclMath.h"
/*
@@ -29,7 +30,7 @@
* The return value is normally TCL_OK; in this case *intPtr
* will be set to the integer value equivalent to string. If
* string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in interp->result.
+ * an error message will be left in the interp's result.
*
* Side effects:
* None.
@@ -54,23 +55,24 @@ Tcl_GetInt(interp, string, intPtr)
*/
errno = 0;
- for (p = string; isspace(UCHAR(*p)); p++) {
+ for (p = string; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
/* Empty loop body. */
}
if (*p == '-') {
p++;
- i = -((long)strtoul(p, &end, 0));
+ i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */
} else if (*p == '+') {
p++;
- i = strtoul(p, &end, 0);
+ i = strtoul(p, &end, 0); /* INTL: Tcl source. */
} else {
- i = strtoul(p, &end, 0);
+ i = strtoul(p, &end, 0); /* INTL: Tcl source. */
}
if (end == p) {
badInteger:
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "expected integer but got \"", string,
- "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "expected integer but got \"", string,
+ "\"", (char *) NULL);
+ TclCheckBadOctal(interp, string);
}
return TCL_ERROR;
}
@@ -86,11 +88,11 @@ Tcl_GetInt(interp, string, intPtr)
Tcl_SetResult(interp, "integer value too large to represent",
TCL_STATIC);
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- interp->result, (char *) NULL);
+ Tcl_GetStringResult(interp), (char *) NULL);
}
return TCL_ERROR;
}
- while ((*end != '\0') && isspace(UCHAR(*end))) {
+ while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
end++;
}
if (*end != 0) {
@@ -113,7 +115,8 @@ Tcl_GetInt(interp, string, intPtr)
* The return value is normally TCL_OK; in this case *longPtr
* will be set to the long integer value equivalent to string. If
* string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in interp->result.
+ * an error message will be left in the interp's result if interp
+ * is non-NULL.
*
* Side effects:
* None.
@@ -123,7 +126,8 @@ Tcl_GetInt(interp, string, intPtr)
int
TclGetLong(interp, string, longPtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting. */
+ Tcl_Interp *interp; /* Interpreter used for error reporting
+ * if not NULL. */
char *string; /* String containing a (possibly signed)
* long integer in a form acceptable to
* strtoul. */
@@ -138,23 +142,24 @@ TclGetLong(interp, string, longPtr)
*/
errno = 0;
- for (p = string; isspace(UCHAR(*p)); p++) {
+ for (p = string; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
/* Empty loop body. */
}
if (*p == '-') {
p++;
- i = -(int)strtoul(p, &end, 0);
+ i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */
} else if (*p == '+') {
p++;
- i = strtoul(p, &end, 0);
+ i = strtoul(p, &end, 0); /* INTL: Tcl source. */
} else {
- i = strtoul(p, &end, 0);
+ i = strtoul(p, &end, 0); /* INTL: Tcl source. */
}
if (end == p) {
badInteger:
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "expected integer but got \"", string,
- "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "expected integer but got \"", string,
+ "\"", (char *) NULL);
+ TclCheckBadOctal(interp, string);
}
return TCL_ERROR;
}
@@ -163,11 +168,11 @@ TclGetLong(interp, string, longPtr)
Tcl_SetResult(interp, "integer value too large to represent",
TCL_STATIC);
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- interp->result, (char *) NULL);
+ Tcl_GetStringResult(interp), (char *) NULL);
}
return TCL_ERROR;
}
- while ((*end != '\0') && isspace(UCHAR(*end))) {
+ while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
end++;
}
if (*end != 0) {
@@ -189,7 +194,7 @@ TclGetLong(interp, string, longPtr)
* The return value is normally TCL_OK; in this case *doublePtr
* will be set to the double-precision value equivalent to string.
* If string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in interp->result.
+ * an error message will be left in the interp's result.
*
* Side effects:
* None.
@@ -208,7 +213,7 @@ Tcl_GetDouble(interp, string, doublePtr)
double d;
errno = 0;
- d = strtod(string, &end);
+ d = strtod(string, &end); /* INTL: Tcl source. */
if (end == string) {
badDouble:
if (interp != (Tcl_Interp *) NULL) {
@@ -218,24 +223,13 @@ Tcl_GetDouble(interp, string, doublePtr)
}
return TCL_ERROR;
}
- if (errno != 0) {
+ if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) {
if (interp != (Tcl_Interp *) NULL) {
- TclExprFloatError(interp, d); /* sets interp->objResult */
-
- /*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
- */
-
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp),
- (int *) NULL),
- TCL_VOLATILE);
+ TclExprFloatError(interp, d);
}
return TCL_ERROR;
}
- while ((*end != 0) && isspace(UCHAR(*end))) {
+ while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */
end++;
}
if (*end != 0) {
@@ -257,7 +251,7 @@ Tcl_GetDouble(interp, string, doublePtr)
* The return value is normally TCL_OK; in this case *boolPtr
* will be set to the 0/1 value equivalent to string. If
* string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in interp->result.
+ * an error message will be left in the interp's result.
*
* Side effects:
* None.
@@ -279,7 +273,8 @@ Tcl_GetBoolean(interp, string, boolPtr)
size_t length;
/*
- * Convert the input string to all lower-case.
+ * Convert the input string to all lower-case.
+ * INTL: This code will work on UTF strings.
*/
for (i = 0; i < 9; i++) {
@@ -326,3 +321,4 @@ Tcl_GetBoolean(interp, string, boolPtr)
}
return TCL_OK;
}
+
diff --git a/tcl/generic/tclGetDate.y b/tcl/generic/tclGetDate.y
index f8b6ca29eab..33eff627aad 100644
--- a/tcl/generic/tclGetDate.y
+++ b/tcl/generic/tclGetDate.y
@@ -54,7 +54,7 @@
#define HOUR(x) ((int) (60 * x))
#define SECSPERDAY (24L * 60L * 60L)
-
+#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
/*
* An entry in the lexical lookup table.
@@ -91,8 +91,10 @@ static char *yyInput;
static DSTMODE yyDSTmode;
static time_t yyDayOrdinal;
static time_t yyDayNumber;
+static time_t yyMonthOrdinal;
static int yyHaveDate;
static int yyHaveDay;
+static int yyHaveOrdinalMonth;
static int yyHaveRel;
static int yyHaveTime;
static int yyHaveZone;
@@ -105,8 +107,9 @@ static time_t yySeconds;
static time_t yyYear;
static MERIDIAN yyMeridian;
static time_t yyRelMonth;
+static time_t yyRelDay;
static time_t yyRelSeconds;
-
+static time_t *yyRelPointer;
/*
* Prototypes of internal functions.
@@ -118,10 +121,14 @@ static int Convert _ANSI_ARGS_((time_t Month, time_t Day, time_t Year,
time_t Hours, time_t Minutes, time_t Seconds,
MERIDIAN Meridia, DSTMODE DSTmode, time_t *TimePtr));
static time_t DSTcorrect _ANSI_ARGS_((time_t Start, time_t Future));
-static time_t RelativeDate _ANSI_ARGS_((time_t Start, time_t DayOrdinal,
+static time_t NamedDay _ANSI_ARGS_((time_t Start, time_t DayOrdinal,
time_t DayNumber));
+static time_t NamedMonth _ANSI_ARGS_((time_t Start, time_t MonthOrdinal,
+ time_t MonthNumber));
static int RelativeMonth _ANSI_ARGS_((time_t Start, time_t RelMonth,
time_t *TimePtr));
+static int RelativeDay _ANSI_ARGS_((time_t Start, time_t RelDay,
+ time_t *TimePtr));
static int LookupWord _ANSI_ARGS_((char *buff));
static int yylex _ANSI_ARGS_((void));
@@ -135,10 +142,12 @@ yyparse _ANSI_ARGS_((void));
}
%token tAGO tDAY tDAYZONE tID tMERIDIAN tMINUTE_UNIT tMONTH tMONTH_UNIT
-%token tSEC_UNIT tSNUMBER tUNUMBER tZONE tEPOCH tDST
+%token tSTARDATE tSEC_UNIT tSNUMBER tUNUMBER tZONE tEPOCH tDST tISOBASE
+%token tDAY_UNIT tNEXT
%type <Number> tDAY tDAYZONE tMINUTE_UNIT tMONTH tMONTH_UNIT tDST
-%type <Number> tSEC_UNIT tSNUMBER tUNUMBER tZONE
+%type <Number> tSEC_UNIT tSNUMBER tUNUMBER tZONE tISOBASE tDAY_UNIT
+%type <Number> unit sign tNEXT tSTARDATE
%type <Meridian> tMERIDIAN o_merid
%%
@@ -156,12 +165,24 @@ item : time {
| date {
yyHaveDate++;
}
+ | ordMonth {
+ yyHaveOrdinalMonth++;
+ }
| day {
yyHaveDay++;
}
- | rel {
+ | relspec {
yyHaveRel++;
}
+ | iso {
+ yyHaveTime++;
+ yyHaveDate++;
+ }
+ | trek {
+ yyHaveTime++;
+ yyHaveDate++;
+ yyHaveRel++;
+ }
| number
;
@@ -177,12 +198,12 @@ time : tUNUMBER tMERIDIAN {
yySeconds = 0;
yyMeridian = $4;
}
- | tUNUMBER ':' tUNUMBER tSNUMBER {
+ | tUNUMBER ':' tUNUMBER '-' tUNUMBER {
yyHour = $1;
yyMinutes = $3;
yyMeridian = MER24;
yyDSTmode = DSToff;
- yyTimezone = - ($4 % 100 + ($4 / 100) * 60);
+ yyTimezone = ($5 % 100 + ($5 / 100) * 60);
}
| tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
yyHour = $1;
@@ -190,13 +211,13 @@ time : tUNUMBER tMERIDIAN {
yySeconds = $5;
yyMeridian = $6;
}
- | tUNUMBER ':' tUNUMBER ':' tUNUMBER tSNUMBER {
+ | tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER {
yyHour = $1;
yyMinutes = $3;
yySeconds = $5;
yyMeridian = MER24;
yyDSTmode = DSToff;
- yyTimezone = - ($6 % 100 + ($6 / 100) * 60);
+ yyTimezone = ($7 % 100 + ($7 / 100) * 60);
}
;
@@ -226,6 +247,14 @@ day : tDAY {
yyDayOrdinal = $1;
yyDayNumber = $2;
}
+ | sign tUNUMBER tDAY {
+ yyDayOrdinal = $1 * $2;
+ yyDayNumber = $3;
+ }
+ | tNEXT tDAY {
+ yyDayOrdinal = 2;
+ yyDayNumber = $2;
+ }
;
date : tUNUMBER '/' tUNUMBER {
@@ -237,6 +266,21 @@ date : tUNUMBER '/' tUNUMBER {
yyDay = $3;
yyYear = $5;
}
+ | tISOBASE {
+ yyYear = $1 / 10000;
+ yyMonth = ($1 % 10000)/100;
+ yyDay = $1 % 100;
+ }
+ | tUNUMBER '-' tMONTH '-' tUNUMBER {
+ yyDay = $1;
+ yyMonth = $3;
+ yyYear = $5;
+ }
+ | tUNUMBER '-' tUNUMBER '-' tUNUMBER {
+ yyMonth = $3;
+ yyDay = $5;
+ yyYear = $1;
+ }
| tMONTH tUNUMBER {
yyMonth = $1;
yyDay = $2;
@@ -250,11 +294,11 @@ date : tUNUMBER '/' tUNUMBER {
yyMonth = $2;
yyDay = $1;
}
- | tEPOCH {
- yyMonth = 1;
- yyDay = 1;
- yyYear = EPOCH;
- }
+ | tEPOCH {
+ yyMonth = 1;
+ yyDay = 1;
+ yyYear = EPOCH;
+ }
| tUNUMBER tMONTH tUNUMBER {
yyMonth = $2;
yyDay = $1;
@@ -262,42 +306,78 @@ date : tUNUMBER '/' tUNUMBER {
}
;
-rel : relunit tAGO {
- yyRelSeconds = -yyRelSeconds;
- yyRelMonth = -yyRelMonth;
- }
- | relunit
+ordMonth: tNEXT tMONTH {
+ yyMonthOrdinal = 1;
+ yyMonth = $2;
+ }
+ | tNEXT tUNUMBER tMONTH {
+ yyMonthOrdinal = $2;
+ yyMonth = $3;
+ }
;
-relunit : tUNUMBER tMINUTE_UNIT {
- yyRelSeconds += $1 * $2 * 60L;
- }
- | tSNUMBER tMINUTE_UNIT {
- yyRelSeconds += $1 * $2 * 60L;
- }
- | tMINUTE_UNIT {
- yyRelSeconds += $1 * 60L;
- }
- | tSNUMBER tSEC_UNIT {
- yyRelSeconds += $1;
- }
- | tUNUMBER tSEC_UNIT {
- yyRelSeconds += $1;
+iso : tISOBASE tZONE tISOBASE {
+ if ($2 != HOUR(- 7)) YYABORT;
+ yyYear = $1 / 10000;
+ yyMonth = ($1 % 10000)/100;
+ yyDay = $1 % 100;
+ yyHour = $3 / 10000;
+ yyMinutes = ($3 % 10000)/100;
+ yySeconds = $3 % 100;
}
- | tSEC_UNIT {
- yyRelSeconds++;
+ | tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
+ if ($2 != HOUR(- 7)) YYABORT;
+ yyYear = $1 / 10000;
+ yyMonth = ($1 % 10000)/100;
+ yyDay = $1 % 100;
+ yyHour = $3;
+ yyMinutes = $5;
+ yySeconds = $7;
}
- | tSNUMBER tMONTH_UNIT {
- yyRelMonth += $1 * $2;
+ | tISOBASE tISOBASE {
+ yyYear = $1 / 10000;
+ yyMonth = ($1 % 10000)/100;
+ yyDay = $1 % 100;
+ yyHour = $2 / 10000;
+ yyMinutes = ($2 % 10000)/100;
+ yySeconds = $2 % 100;
}
- | tUNUMBER tMONTH_UNIT {
- yyRelMonth += $1 * $2;
- }
- | tMONTH_UNIT {
- yyRelMonth += $1;
+ ;
+
+trek : tSTARDATE tUNUMBER '.' tUNUMBER {
+ /*
+ * Offset computed year by -377 so that the returned years will
+ * be in a range accessible with a 32 bit clock seconds value
+ */
+ yyYear = $2/1000 + 2323 - 377;
+ yyDay = 1;
+ yyMonth = 1;
+ yyRelDay += (($2%1000)*(365 + IsLeapYear(yyYear)))/1000;
+ yyRelSeconds += $4 * 144 * 60;
}
;
+relspec : relunits tAGO {
+ yyRelSeconds *= -1;
+ yyRelMonth *= -1;
+ yyRelDay *= -1;
+ }
+ | relunits
+ ;
+relunits : sign tUNUMBER unit { *yyRelPointer += $1 * $2 * $3; }
+ | tUNUMBER unit { *yyRelPointer += $1 * $2; }
+ | tNEXT unit { *yyRelPointer += $2; }
+ | tNEXT tUNUMBER unit { *yyRelPointer += $2 * $3; }
+ | unit { *yyRelPointer += $1; }
+ ;
+sign : '-' { $$ = -1; }
+ | '+' { $$ = 1; }
+ ;
+unit : tSEC_UNIT { $$ = $1; yyRelPointer = &yyRelSeconds; }
+ | tDAY_UNIT { $$ = $1; yyRelPointer = &yyRelDay; }
+ | tMONTH_UNIT { $$ = $1; yyRelPointer = &yyRelMonth; }
+ ;
+
number : tUNUMBER
{
if (yyHaveTime && yyHaveDate && !yyHaveRel) {
@@ -305,8 +385,8 @@ number : tUNUMBER
} else {
yyHaveTime++;
if ($1 < 100) {
- yyHour = 0;
- yyMinutes = $1;
+ yyHour = $1;
+ yyMinutes = 0;
} else {
yyHour = $1 / 100;
yyMinutes = $1 % 100;
@@ -363,15 +443,15 @@ static TABLE MonthDayTable[] = {
*/
static TABLE UnitsTable[] = {
{ "year", tMONTH_UNIT, 12 },
- { "month", tMONTH_UNIT, 1 },
- { "fortnight", tMINUTE_UNIT, 14 * 24 * 60 },
- { "week", tMINUTE_UNIT, 7 * 24 * 60 },
- { "day", tMINUTE_UNIT, 1 * 24 * 60 },
- { "hour", tMINUTE_UNIT, 60 },
- { "minute", tMINUTE_UNIT, 1 },
- { "min", tMINUTE_UNIT, 1 },
- { "second", tSEC_UNIT, 1 },
- { "sec", tSEC_UNIT, 1 },
+ { "month", tMONTH_UNIT, 1 },
+ { "fortnight", tDAY_UNIT, 14 },
+ { "week", tDAY_UNIT, 7 },
+ { "day", tDAY_UNIT, 1 },
+ { "hour", tSEC_UNIT, 60 * 60 },
+ { "minute", tSEC_UNIT, 60 },
+ { "min", tSEC_UNIT, 60 },
+ { "second", tSEC_UNIT, 1 },
+ { "sec", tSEC_UNIT, 1 },
{ NULL }
};
@@ -379,16 +459,16 @@ static TABLE UnitsTable[] = {
* Assorted relative-time words.
*/
static TABLE OtherTable[] = {
- { "tomorrow", tMINUTE_UNIT, 1 * 24 * 60 },
- { "yesterday", tMINUTE_UNIT, -1 * 24 * 60 },
- { "today", tMINUTE_UNIT, 0 },
- { "now", tMINUTE_UNIT, 0 },
- { "last", tUNUMBER, -1 },
- { "this", tMINUTE_UNIT, 0 },
- { "next", tUNUMBER, 2 },
+ { "tomorrow", tDAY_UNIT, 1 },
+ { "yesterday", tDAY_UNIT, -1 },
+ { "today", tDAY_UNIT, 0 },
+ { "now", tSEC_UNIT, 0 },
+ { "last", tUNUMBER, -1 },
+ { "this", tSEC_UNIT, 0 },
+ { "next", tNEXT, 1 },
#if 0
{ "first", tUNUMBER, 1 },
-/* { "second", tUNUMBER, 2 }, */
+ { "second", tUNUMBER, 2 },
{ "third", tUNUMBER, 3 },
{ "fourth", tUNUMBER, 4 },
{ "fifth", tUNUMBER, 5 },
@@ -402,6 +482,7 @@ static TABLE OtherTable[] = {
#endif
{ "ago", tAGO, 1 },
{ "epoch", tEPOCH, 0 },
+ { "stardate", tSTARDATE, 0},
{ NULL }
};
@@ -413,7 +494,8 @@ static TABLE TimezoneTable[] = {
{ "gmt", tZONE, HOUR( 0) }, /* Greenwich Mean */
{ "ut", tZONE, HOUR( 0) }, /* Universal (Coordinated) */
{ "utc", tZONE, HOUR( 0) },
- { "wet", tZONE, HOUR( 0) } , /* Western European */
+ { "uct", tZONE, HOUR( 0) }, /* Universal Coordinated Time */
+ { "wet", tZONE, HOUR( 0) }, /* Western European */
{ "bst", tDAYZONE, HOUR( 0) }, /* British Summer */
{ "wat", tZONE, HOUR( 1) }, /* West Africa */
{ "at", tZONE, HOUR( 2) }, /* Azores */
@@ -445,6 +527,7 @@ static TABLE TimezoneTable[] = {
{ "nt", tZONE, HOUR(11) }, /* Nome */
{ "idlw", tZONE, HOUR(12) }, /* International Date Line West */
{ "cet", tZONE, -HOUR( 1) }, /* Central European */
+ { "cest", tDAYZONE, -HOUR( 1) }, /* Central European Summer */
{ "met", tZONE, -HOUR( 1) }, /* Middle European */
{ "mewt", tZONE, -HOUR( 1) }, /* Middle European Winter */
{ "mest", tDAYZONE, -HOUR( 1) }, /* Middle European Summer */
@@ -554,7 +637,22 @@ ToSeconds(Hours, Minutes, Seconds, Meridian)
return -1; /* Should never be reached */
}
-
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Convert --
+ *
+ * Convert a {month, day, year, hours, minutes, seconds, meridian, dst}
+ * tuple into a clock seconds value.
+ *
+ * Results:
+ * 0 or -1 indicating success or failure.
+ *
+ * Side effects:
+ * Fills TimePtr with the computed value.
+ *
+ *-----------------------------------------------------------------------------
+ */
static int
Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
time_t Month;
@@ -574,29 +672,44 @@ Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
time_t Julian;
int i;
- DaysInMonth[1] = Year % 4 == 0 && (Year % 100 != 0 || Year % 400 == 0)
- ? 29 : 28;
+ /* Figure out how many days are in February for the given year.
+ * Every year divisible by 4 is a leap year.
+ * But, every year divisible by 100 is not a leap year.
+ * But, every year divisible by 400 is a leap year after all.
+ */
+ DaysInMonth[1] = IsLeapYear(Year) ? 29 : 28;
+
+ /* Check the inputs for validity */
if (Month < 1 || Month > 12
- || Year < START_OF_TIME || Year > END_OF_TIME
- || Day < 1 || Day > DaysInMonth[(int)--Month])
+ || Year < START_OF_TIME || Year > END_OF_TIME
+ || Day < 1 || Day > DaysInMonth[(int)--Month])
return -1;
+ /* Start computing the value. First determine the number of days
+ * represented by the date, then multiply by the number of seconds/day.
+ */
for (Julian = Day - 1, i = 0; i < Month; i++)
Julian += DaysInMonth[i];
if (Year >= EPOCH) {
for (i = EPOCH; i < Year; i++)
- Julian += 365 + (i % 4 == 0);
+ Julian += 365 + IsLeapYear(i);
} else {
for (i = Year; i < EPOCH; i++)
- Julian -= 365 + (i % 4 == 0);
+ Julian -= 365 + IsLeapYear(i);
}
Julian *= SECSPERDAY;
+
+ /* Add the timezone offset ?? */
Julian += yyTimezone * 60L;
+
+ /* Add the number of seconds represented by the time component */
if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
return -1;
Julian += tod;
+
+ /* Perform a preliminary DST compensation ?? */
if (DSTmode == DSTon
- || (DSTmode == DSTmaybe && TclpGetDate(&Julian, 0)->tm_isdst))
+ || (DSTmode == DSTmaybe && TclpGetDate((TclpTime_t)&Julian, 0)->tm_isdst))
Julian -= 60 * 60;
*TimePtr = Julian;
return 0;
@@ -610,15 +723,14 @@ DSTcorrect(Start, Future)
{
time_t StartDay;
time_t FutureDay;
-
- StartDay = (TclpGetDate(&Start, 0)->tm_hour + 1) % 24;
- FutureDay = (TclpGetDate(&Future, 0)->tm_hour + 1) % 24;
+ StartDay = (TclpGetDate((TclpTime_t)&Start, 0)->tm_hour + 1) % 24;
+ FutureDay = (TclpGetDate((TclpTime_t)&Future, 0)->tm_hour + 1) % 24;
return (Future - Start) + (StartDay - FutureDay) * 60L * 60L;
}
static time_t
-RelativeDate(Start, DayOrdinal, DayNumber)
+NamedDay(Start, DayOrdinal, DayNumber)
time_t Start;
time_t DayOrdinal;
time_t DayNumber;
@@ -627,12 +739,41 @@ RelativeDate(Start, DayOrdinal, DayNumber)
time_t now;
now = Start;
- tm = TclpGetDate(&now, 0);
+ tm = TclpGetDate((TclpTime_t)&now, 0);
now += SECSPERDAY * ((DayNumber - tm->tm_wday + 7) % 7);
now += 7 * SECSPERDAY * (DayOrdinal <= 0 ? DayOrdinal : DayOrdinal - 1);
return DSTcorrect(Start, now);
}
+static time_t
+NamedMonth(Start, MonthOrdinal, MonthNumber)
+ time_t Start;
+ time_t MonthOrdinal;
+ time_t MonthNumber;
+{
+ struct tm *tm;
+ time_t now;
+ int result;
+
+ now = Start;
+ tm = TclpGetDate((TclpTime_t)&now, 0);
+ /* To compute the next n'th month, we use this alg:
+ * add n to year value
+ * if currentMonth < requestedMonth decrement year value by 1 (so that
+ * doing next february from january gives us february of the current year)
+ * set day to 1, time to 0
+ */
+ tm->tm_year += MonthOrdinal;
+ if (tm->tm_mon < MonthNumber - 1) {
+ tm->tm_year--;
+ }
+ result = Convert(MonthNumber, (time_t) 1, tm->tm_year + TM_YEAR_BASE,
+ (time_t) 0, (time_t) 0, (time_t) 0, MER24, DSTmaybe, &now);
+ if (result < 0) {
+ return 0;
+ }
+ return DSTcorrect(Start, now);
+}
static int
RelativeMonth(Start, RelMonth, TimePtr)
@@ -650,7 +791,7 @@ RelativeMonth(Start, RelMonth, TimePtr)
*TimePtr = 0;
return 0;
}
- tm = TclpGetDate(&Start, 0);
+ tm = TclpGetDate((TclpTime_t)&Start, 0);
Month = 12 * (tm->tm_year + TM_YEAR_BASE) + tm->tm_mon + RelMonth;
Year = Month / 12;
Month = Month % 12 + 1;
@@ -679,6 +820,36 @@ RelativeMonth(Start, RelMonth, TimePtr)
}
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * RelativeDay --
+ *
+ * Given a starting time and a number of days before or after, compute the
+ * DST corrected difference between those dates.
+ *
+ * Results:
+ * 1 or -1 indicating success or failure.
+ *
+ * Side effects:
+ * Fills TimePtr with the computed value.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+RelativeDay(Start, RelDay, TimePtr)
+ time_t Start;
+ time_t RelDay;
+ time_t *TimePtr;
+{
+ time_t new;
+
+ new = Start + (RelDay * 60 * 60 * 24);
+ *TimePtr = DSTcorrect(Start, new);
+ return 1;
+}
+
static int
LookupWord(buff)
char *buff;
@@ -692,11 +863,8 @@ LookupWord(buff)
/*
* Make it lowercase.
*/
- for (p = buff; *p; p++) {
- if (isupper(UCHAR(*p))) {
- *p = (char) tolower(UCHAR(*p));
- }
- }
+
+ Tcl_UtfToLower(buff);
if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
yylval.Meridian = MERam;
@@ -769,7 +937,8 @@ LookupWord(buff)
/*
* Military timezones.
*/
- if (buff[1] == '\0' && isalpha(UCHAR(*buff))) {
+ if (buff[1] == '\0' && !(*buff & 0x80)
+ && isalpha(UCHAR(*buff))) { /* INTL: ISO only */
for (tp = MilitaryTable; tp->name; tp++) {
if (strcmp(buff, tp->name) == 0) {
yylval.Number = tp->value;
@@ -808,36 +977,31 @@ yylex()
register char *p;
char buff[20];
int Count;
- int sign;
for ( ; ; ) {
- while (isspace((unsigned char) (*yyInput))) {
+ while (isspace(UCHAR(*yyInput))) {
yyInput++;
}
- if (isdigit(c = *yyInput) || c == '-' || c == '+') {
- if (c == '-' || c == '+') {
- sign = c == '-' ? -1 : 1;
- if (!isdigit(*++yyInput)) {
- /*
- * skip the '-' sign
- */
- continue;
- }
- } else {
- sign = 0;
- }
- for (yylval.Number = 0; isdigit(c = *yyInput++); ) {
+ if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
+ /* convert the string into a number; count the number of digits */
+ Count = 0;
+ for (yylval.Number = 0;
+ isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
yylval.Number = 10 * yylval.Number + c - '0';
+ Count++;
}
yyInput--;
- if (sign < 0) {
- yylval.Number = -yylval.Number;
+ /* A number with 6 or more digits is considered an ISO 8601 base */
+ if (Count >= 6) {
+ return tISOBASE;
+ } else {
+ return tUNUMBER;
}
- return sign ? tSNUMBER : tUNUMBER;
}
- if (isalpha(UCHAR(c))) {
- for (p = buff; isalpha(c = *yyInput++) || c == '.'; ) {
+ if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */
+ for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
+ || c == '.'; ) {
if (p < &buff[sizeof buff - 1]) {
*p++ = c;
}
@@ -881,7 +1045,9 @@ TclGetDate(p, now, zone, timePtr)
int thisyear;
yyInput = p;
- tm = TclpGetDate((time_t *) &now, 0);
+ /* now has to be cast to a time_t for 64bit compliance */
+ Start = now;
+ tm = TclpGetDate((TclpTime_t) &Start, 0);
thisyear = tm->tm_year + TM_YEAR_BASE;
yyYear = thisyear;
yyMonth = tm->tm_mon + 1;
@@ -899,14 +1065,18 @@ TclGetDate(p, now, zone, timePtr)
yyMeridian = MER24;
yyRelSeconds = 0;
yyRelMonth = 0;
+ yyRelDay = 0;
+ yyRelPointer = NULL;
+
yyHaveDate = 0;
yyHaveDay = 0;
+ yyHaveOrdinalMonth = 0;
yyHaveRel = 0;
yyHaveTime = 0;
yyHaveZone = 0;
if (yyparse() || yyHaveTime > 1 || yyHaveZone > 1 || yyHaveDate > 1 ||
- yyHaveDay > 1) {
+ yyHaveDay > 1 || yyHaveOrdinalMonth > 1) {
return -1;
}
@@ -938,7 +1108,8 @@ TclGetDate(p, now, zone, timePtr)
} else {
Start = now;
if (!yyHaveRel) {
- Start -= ((tm->tm_hour * 60L) + tm->tm_min * 60L) + tm->tm_sec;
+ Start -= ((tm->tm_hour * 60L * 60L) +
+ tm->tm_min * 60L) + tm->tm_sec;
}
}
@@ -948,11 +1119,22 @@ TclGetDate(p, now, zone, timePtr)
}
Start += Time;
+ if (RelativeDay(Start, yyRelDay, &Time) < 0) {
+ return -1;
+ }
+ Start += Time;
+
if (yyHaveDay && !yyHaveDate) {
- tod = RelativeDate(Start, yyDayOrdinal, yyDayNumber);
+ tod = NamedDay(Start, yyDayOrdinal, yyDayNumber);
Start += tod;
}
+ if (yyHaveOrdinalMonth) {
+ tod = NamedMonth(Start, yyMonthOrdinal, yyMonth);
+ Start += tod;
+ }
+
*timePtr = Start;
return 0;
}
+
diff --git a/tcl/generic/tclHash.c b/tcl/generic/tclHash.c
index b38a2b1ce52..cc1dcf2e627 100644
--- a/tcl/generic/tclHash.c
+++ b/tcl/generic/tclHash.c
@@ -83,6 +83,11 @@ Tcl_InitHashTable(tablePtr, keyType)
* TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
* or an integer >= 2. */
{
+#if (TCL_SMALL_HASH_TABLE != 4)
+ panic("Tcl_InitHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+ TCL_SMALL_HASH_TABLE);
+#endif
+
tablePtr->buckets = tablePtr->staticBuckets;
tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
diff --git a/tcl/generic/tclHistory.c b/tcl/generic/tclHistory.c
index 99f9ebeb243..e69f8ca28e7 100644
--- a/tcl/generic/tclHistory.c
+++ b/tcl/generic/tclHistory.c
@@ -57,20 +57,16 @@ Tcl_RecordAndEval(interp, cmd, flags)
* Call Tcl_RecordAndEvalObj to do the actual work.
*/
- TclNewObj(cmdPtr);
- TclInitStringRep(cmdPtr, cmd, length);
+ cmdPtr = Tcl_NewStringObj(cmd, length);
Tcl_IncrRefCount(cmdPtr);
-
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
/*
@@ -116,11 +112,10 @@ Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
* record and execute. */
int flags; /* Additional flags. TCL_NO_EVAL means
* record only: don't execute the command.
- * TCL_EVAL_GLOBAL means use
- * Tcl_GlobalEvalObj instead of
- * Tcl_EvalObj. */
+ * TCL_EVAL_GLOBAL means evaluate the
+ * script in global variable context instead
+ * of the current procedure. */
{
- Interp *iPtr = (Interp *) interp;
int result;
Tcl_Obj *list[3];
register Tcl_Obj *objPtr;
@@ -135,7 +130,7 @@ Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
objPtr = Tcl_NewListObj(3, list);
Tcl_IncrRefCount(objPtr);
- (void) Tcl_GlobalEvalObj(interp, objPtr);
+ (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objPtr);
/*
@@ -144,12 +139,7 @@ Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
result = TCL_OK;
if (!(flags & TCL_NO_EVAL)) {
- iPtr->evalFlags = (flags & ~TCL_EVAL_GLOBAL);
- if (flags & TCL_EVAL_GLOBAL) {
- result = Tcl_GlobalEvalObj(interp, cmdPtr);
- } else {
- result = Tcl_EvalObj(interp, cmdPtr);
- }
+ result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
}
return result;
}
diff --git a/tcl/generic/tclIO.c b/tcl/generic/tclIO.c
index f3e080e7189..ab37a1b003d 100644
--- a/tcl/generic/tclIO.c
+++ b/tcl/generic/tclIO.c
@@ -4,7 +4,7 @@
* This file provides the generic portions (those that are the same on
* all platforms and for all channel types) of Tcl's IO facilities.
*
- * Copyright (c) 1998 Scriptics Corporation
+ * Copyright (c) 1998-2000 Ajuba Solutions
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
@@ -13,397 +13,262 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
-
-/*
- * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
- * compile on systems where neither is defined. We want both defined so
- * that we can test safely for both. In the code we still have to test for
- * both because there may be systems on which both are defined and have
- * different values.
- */
-
-#if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
-# define EWOULDBLOCK EAGAIN
-#endif
-#if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
-# define EAGAIN EWOULDBLOCK
-#endif
-#if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
- error one of EWOULDBLOCK or EAGAIN must be defined
-#endif
-
-/*
- * The following structure encapsulates the state for a background channel
- * copy. Note that the data buffer for the copy will be appended to this
- * structure.
- */
-
-typedef struct CopyState {
- struct Channel *readPtr; /* Pointer to input channel. */
- struct Channel *writePtr; /* Pointer to output channel. */
- int readFlags; /* Original read channel flags. */
- int writeFlags; /* Original write channel flags. */
- int toRead; /* Number of bytes to copy, or -1. */
- int total; /* Total bytes transferred (written). */
- Tcl_Interp *interp; /* Interp that started the copy. */
- Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
- int bufSize; /* Size of appended buffer. */
- char buffer[1]; /* Copy buffer, this must be the last
- * field. */
-} CopyState;
-
-/*
- * struct ChannelBuffer:
- *
- * Buffers data being sent to or from a channel.
- */
-
-typedef struct ChannelBuffer {
- int nextAdded; /* The next position into which a character
- * will be put in the buffer. */
- int nextRemoved; /* Position of next byte to be removed
- * from the buffer. */
- int bufSize; /* How big is the buffer? */
- struct ChannelBuffer *nextPtr;
- /* Next buffer in chain. */
- char buf[4]; /* Placeholder for real buffer. The real
- * buffer occuppies this space + bufSize-4
- * bytes. This must be the last field in
- * the structure. */
-} ChannelBuffer;
-
-#define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
-
-/*
- * The following defines the *default* buffer size for channels.
- */
-
-#define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
-
-/*
- * Structure to record a close callback. One such record exists for
- * each close callback registered for a channel.
- */
-
-typedef struct CloseCallback {
- Tcl_CloseProc *proc; /* The procedure to call. */
- ClientData clientData; /* Arbitrary one-word data to pass
- * to the callback. */
- struct CloseCallback *nextPtr; /* For chaining close callbacks. */
-} CloseCallback;
-
-/*
- * The following structure describes the information saved from a call to
- * "fileevent". This is used later when the event being waited for to
- * invoke the saved script in the interpreter designed in this record.
- */
-
-typedef struct EventScriptRecord {
- struct Channel *chanPtr; /* The channel for which this script is
- * registered. This is used only when an
- * error occurs during evaluation of the
- * script, to delete the handler. */
- char *script; /* Script to invoke. */
- Tcl_Interp *interp; /* In what interpreter to invoke script? */
- int mask; /* Events must overlap current mask for the
- * stored script to be invoked. */
- struct EventScriptRecord *nextPtr;
- /* Next in chain of records. */
-} EventScriptRecord;
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclIO.h"
+#include <assert.h>
+
/*
- * struct Channel:
+ * All static variables used in this file are collected into a single
+ * instance of the following structure. For multi-threaded implementations,
+ * there is one instance of this structure for each thread.
*
- * One of these structures is allocated for each open channel. It contains data
- * specific to the channel but which belongs to the generic part of the Tcl
- * channel mechanism, and it points at an instance specific (and type
- * specific) * instance data, and at a channel type structure.
+ * Notice that different structures with the same name appear in other
+ * files. The structure defined below is used in this file only.
*/
-typedef struct Channel {
- 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
- * below. */
- Tcl_EolTranslation inputTranslation;
- /* What translation to apply for end of line
- * sequences on input? */
- Tcl_EolTranslation outputTranslation;
- /* What translation to use for generating
- * end of line sequences in output? */
- int inEofChar; /* If nonzero, use this as a signal of EOF
- * on input. */
- int outEofChar; /* If nonzero, append this to the channel
- * when it is closed if it is open for
- * writing. */
- int unreportedError; /* Non-zero if an error report was deferred
- * because it happened in the background. The
- * value is the POSIX error code. */
- ClientData instanceData; /* Instance specific data. */
- Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
- int refCount; /* How many interpreters hold references to
- * this IO channel? */
- CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
- * channel is closed. */
- ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
- ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
- ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
-
- ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
- * need to allocate a new buffer for "gets"
- * that crosses buffer boundaries. */
- ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
- ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
-
- struct ChannelHandler *chPtr;/* List of channel handlers registered
- * for this channel. */
- int interestMask; /* Mask of all events this channel has
- * handlers for. */
- struct Channel *nextChanPtr;/* Next in list of channels currently open. */
- EventScriptRecord *scriptRecordPtr;
- /* Chain of all scripts registered for
- * event handlers ("fileevent") on this
- * channel. */
- int bufSize; /* What size buffers to allocate? */
- Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
- CopyState *csPtr; /* State of background copy, or NULL. */
-} Channel;
-
-/*
- * Values for the flags field in Channel. Any ORed combination of the
- * following flags can be stored in the field. These flags record various
- * options and state bits about the channel. In addition to the flags below,
- * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
- */
+typedef struct ThreadSpecificData {
-#define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
- * nonblocking mode. */
-#define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
- * 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. */
-#define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
- * further Tcl-level IO on the
- * channel is allowed. */
-#define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
- * This bit is cleared before every
- * input operation. */
-#define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
- * we saw the input eofChar. This bit
- * prevents clearing of the EOF bit
- * before every input operation. */
-#define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
- * on this channel. This bit is
- * cleared before every input or
- * output operation. */
-#define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
- * translation mode and the last
- * byte seen was a "\r". */
-#define CHANNEL_DEAD (1<<13) /* The channel has been closed by
- * the exit handler (on exit) but
- * not deallocated. When any IO
- * operation sees this flag on a
- * channel, it does not call driver
- * level functions to avoid referring
- * to deallocated data. */
-#define CHANNEL_GETS_BLOCKED (1<<14) /* The last input operation was a gets
- * that failed to get a comlete line.
- * When set, file events will not be
- * delivered for buffered data unless
- * an EOL is present. */
-
-/*
- * For each channel handler registered in a call to Tcl_CreateChannelHandler,
- * there is one record of the following type. All of records for a specific
- * channel are chained together in a singly linked list which is stored in
- * the channel structure.
- */
-
-typedef struct ChannelHandler {
- Channel *chanPtr; /* The channel structure for this channel. */
- int mask; /* Mask of desired events. */
- Tcl_ChannelProc *proc; /* Procedure to call in the type of
- * Tcl_CreateChannelHandler. */
- ClientData clientData; /* Argument to pass to procedure. */
- struct ChannelHandler *nextPtr;
- /* Next one in list of registered handlers. */
-} ChannelHandler;
-
-/*
- * This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of ChannelHandlerEventProc. There is a potential
- * problem if a ChannelHandler is deleted while it is the current one, since
- * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
- * problem, structures of the type below indicate the next handler to be
- * processed for any (recursively nested) dispatches in progress. The
- * nextHandlerPtr field is updated if the handler being pointed to is deleted.
- * The nextPtr field is used to chain together all recursive invocations, so
- * that Tcl_DeleteChannelHandler can find all the recursively nested
- * invocations of ChannelHandlerEventProc and compare the handler being
- * deleted against the NEXT handler to be invoked in that invocation; when it
- * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
- * field of the structure to the next handler.
- */
-
-typedef struct NextChannelHandler {
- ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
- * this invocation. */
- struct NextChannelHandler *nestedHandlerPtr;
- /* Next nested invocation of
- * ChannelHandlerEventProc. */
-} NextChannelHandler;
-
-/*
- * This variable holds the list of nested ChannelHandlerEventProc invocations.
- */
-
-static NextChannelHandler *nestedHandlerPtr = (NextChannelHandler *) NULL;
-
-/*
- * List of all channels currently open.
- */
-
-static Channel *firstChanPtr = (Channel *) NULL;
-
-/*
- * Has a channel exit handler been created yet?
- */
-
-static int channelExitHandlerCreated = 0;
+ /*
+ * This variable holds the list of nested ChannelHandlerEventProc
+ * invocations.
+ */
+ NextChannelHandler *nestedHandlerPtr;
-/*
- * The following structure describes the event that is added to the Tcl
- * event queue by the channel handler check procedure.
- */
+ /*
+ * List of all channels currently open, indexed by ChannelState,
+ * as only one ChannelState exists per set of stacked channels.
+ */
+ ChannelState *firstCSPtr;
+#ifdef oldcode
+ /*
+ * Has a channel exit handler been created yet?
+ */
+ int channelExitHandlerCreated;
-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;
+ /*
+ * Has the channel event source been created and registered with the
+ * notifier?
+ */
+ int channelEventSourceCreated;
+#endif
+ /*
+ * Static variables to hold channels for stdin, stdout and stderr.
+ */
+ Tcl_Channel stdinChannel;
+ int stdinInitialized;
+ Tcl_Channel stdoutChannel;
+ int stdoutInitialized;
+ Tcl_Channel stderrChannel;
+ int stderrInitialized;
-/*
- * Static variables to hold channels for stdin, stdout and stderr.
- */
+} ThreadSpecificData;
-static Tcl_Channel stdinChannel = NULL;
-static int stdinInitialized = 0;
-static Tcl_Channel stdoutChannel = NULL;
-static int stdoutInitialized = 0;
-static Tcl_Channel stderrChannel = NULL;
-static int stderrInitialized = 0;
+static Tcl_ThreadDataKey dataKey;
/*
* Static functions in this file:
*/
-static void ChannelEventScriptInvoker _ANSI_ARGS_((
- ClientData clientData, int flags));
+static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
static void ChannelTimerProc _ANSI_ARGS_((
- ClientData clientData));
+ ClientData clientData));
+static int CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,
+ int direction));
+static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
+ ChannelBuffer *bufPtr, int newlineFlag));
+static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
+ ChannelState *statePtr));
static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
- Tcl_Channel chan));
+ Tcl_Channel chan));
static void CleanupChannelHandlers _ANSI_ARGS_((
- Tcl_Interp *interp, Channel *chanPtr));
+ Tcl_Interp *interp, Channel *chanPtr));
static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int errorCode));
-static void CloseChannelsOnExit _ANSI_ARGS_((ClientData data));
+ Channel *chanPtr, int errorCode));
+static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
+ Tcl_Encoding encoding));
static int CopyAndTranslateBuffer _ANSI_ARGS_((
- Channel *chanPtr, char *result, int space));
+ ChannelState *statePtr, char *result,
+ int space));
+static int CopyBuffer _ANSI_ARGS_((
+ Channel *chanPtr, char *result,
+ int space));
static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
- int mask));
+ int mask));
static void CreateScriptRecord _ANSI_ARGS_((
- Tcl_Interp *interp, Channel *chanPtr,
- int mask, char *script));
+ Tcl_Interp *interp, Channel *chanPtr,
+ int mask, Tcl_Obj *scriptPtr));
static void DeleteChannelTable _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
+ ClientData clientData, Tcl_Interp *interp));
static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mask));
-static void DiscardInputQueued _ANSI_ARGS_((
- Channel *chanPtr, int discardSavedBuffers));
+ Channel *chanPtr, int mask));
+static void DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
+ int discardSavedBuffers));
static void DiscardOutputQueued _ANSI_ARGS_((
- Channel *chanPtr));
+ ChannelState *chanPtr));
static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
- int slen));
-static int DoWrite _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
- int slen));
+ int slen));
+static int DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,
+ int srcLen));
+static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
+ GetsState *statePtr));
static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int calledFromAsyncFlush));
-static Tcl_HashTable *GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
-static int GetEOL _ANSI_ARGS_((Channel *chanPtr));
+ Channel *chanPtr, int calledFromAsyncFlush));
+static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
static int GetInput _ANSI_ARGS_((Channel *chanPtr));
-static void RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
- ChannelBuffer *bufPtr, int mustDiscard));
-static int ScanBufferForEOL _ANSI_ARGS_((Channel *chanPtr,
- ChannelBuffer *bufPtr,
- Tcl_EolTranslation translation, int eofChar,
- int *bytesToEOLPtr, int *crSeenPtr));
-static int ScanInputForEOL _ANSI_ARGS_((Channel *chanPtr,
- int *bytesQueuedPtr));
+static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
+ char **dstEndPtr, GetsState *gsPtr));
+static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
+ Tcl_Obj *objPtr, int charsLeft,
+ int *offsetPtr));
+static int ReadChars _ANSI_ARGS_((ChannelState *statePtr,
+ Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
+ int *factorPtr));
+static void RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,
+ ChannelBuffer *bufPtr, int mustDiscard));
+static int StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,
+ int mode));
static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mode));
+ Channel *chanPtr, int mode));
static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
+static int TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,
+ char *dst, CONST char *src, int *dstLenPtr,
+ int *srcLenPtr));
+static int TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,
+ char *dst, CONST char *src, int *dstLenPtr,
+ int *srcLenPtr));
static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
-static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chan));
+static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
+ CONST char *src, int srcLen));
+static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
+ CONST char *src, int srcLen));
+
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * SetBlockMode --
+ * TclInitIOSubsystem --
*
- * This function sets the blocking mode for a channel and updates
- * the state flags.
+ * Initialize all resources used by this subsystem on a per-process
+ * basis.
*
* Results:
- * A standard Tcl result.
+ * None.
*
* Side effects:
- * Modifies the blocking mode of the channel and possibly generates
- * an error.
+ * Depends on the memory subsystems.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-static int
-SetBlockMode(interp, chanPtr, mode)
- Tcl_Interp *interp; /* Interp for error reporting. */
- Channel *chanPtr; /* Channel to modify. */
- int mode; /* One of TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+void
+TclInitIOSubsystem()
{
- int result = 0;
- if (chanPtr->typePtr->blockModeProc != NULL) {
- result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
- mode);
- }
- if (result != 0) {
- Tcl_SetErrno(result);
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "error setting blocking mode: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- return TCL_ERROR;
- }
- if (mode == TCL_MODE_BLOCKING) {
- chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
- } else {
- chanPtr->flags |= CHANNEL_NONBLOCKING;
+ /*
+ * By fetching thread local storage we take care of
+ * allocating it for each thread.
+ */
+ (void) TCL_TSD_INIT(&dataKey);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclFinalizeIOSubsystem --
+ *
+ * Releases all resources used by this subsystem on a per-process
+ * basis. Closes all extant channels that have not already been
+ * closed because they were not owned by any interp.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on encoding and memory subsystems.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TclFinalizeIOSubsystem()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Channel *chanPtr; /* Iterates over open channels. */
+ ChannelState *nextCSPtr; /* Iterates over open channels. */
+ ChannelState *statePtr; /* state of channel stack */
+
+ for (statePtr = tsdPtr->firstCSPtr; statePtr != (ChannelState *) NULL;
+ statePtr = nextCSPtr) {
+ chanPtr = statePtr->topChanPtr;
+ nextCSPtr = statePtr->nextCSPtr;
+
+ /*
+ * 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");
+
+ if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
+ (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
+ (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
+
+ /*
+ * Decrement the refcount which was earlier artificially bumped
+ * up to keep the channel from being closed.
+ */
+
+ statePtr->refCount--;
+ }
+
+ if (statePtr->refCount <= 0) {
+
+ /*
+ * Close it only if the refcount indicates that the channel is not
+ * referenced from any interpreter. If it is, that interpreter will
+ * close the channel when it gets destroyed.
+ */
+
+ (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
+
+ } else {
+
+ /*
+ * The refcount is greater than zero, so flush the channel.
+ */
+
+ Tcl_Flush((Tcl_Channel) chanPtr);
+
+ /*
+ * Call the device driver to actually close the underlying
+ * device for this channel.
+ */
+
+ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+ (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
+ (Tcl_Interp *) NULL);
+ } else {
+ (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
+ (Tcl_Interp *) NULL, 0);
+ }
+
+ /*
+ * Finally, we clean up the fields in the channel data structure
+ * since all of them have been deleted already. We mark the
+ * channel with CHANNEL_DEAD to prevent any further IO operations
+ * on it.
+ */
+
+ chanPtr->instanceData = (ClientData) NULL;
+ statePtr->flags |= CHANNEL_DEAD;
+ }
}
- return TCL_OK;
}
+
/*
*----------------------------------------------------------------------
@@ -427,18 +292,19 @@ Tcl_SetStdChannel(channel, type)
Tcl_Channel channel;
int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
switch (type) {
case TCL_STDIN:
- stdinInitialized = 1;
- stdinChannel = channel;
+ tsdPtr->stdinInitialized = 1;
+ tsdPtr->stdinChannel = channel;
break;
case TCL_STDOUT:
- stdoutInitialized = 1;
- stdoutChannel = channel;
+ tsdPtr->stdoutInitialized = 1;
+ tsdPtr->stdoutChannel = channel;
break;
case TCL_STDERR:
- stderrInitialized = 1;
- stderrChannel = channel;
+ tsdPtr->stderrInitialized = 1;
+ tsdPtr->stderrChannel = channel;
break;
}
}
@@ -459,28 +325,25 @@ Tcl_SetStdChannel(channel, type)
*
*----------------------------------------------------------------------
*/
-
Tcl_Channel
Tcl_GetStdChannel(type)
int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel = NULL;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* If the channels were not created yet, create them now and
- * store them in the static variables. Note that we need to set
- * stdinInitialized before calling TclGetDefaultStdChannel in order
- * to avoid recursive loops when TclGetDefaultStdChannel calls
- * Tcl_CreateChannel.
+ * store them in the static variables.
*/
switch (type) {
case TCL_STDIN:
- if (!stdinInitialized) {
- stdinChannel = TclGetDefaultStdChannel(TCL_STDIN);
- stdinInitialized = 1;
+ if (!tsdPtr->stdinInitialized) {
+ tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
+ tsdPtr->stdinInitialized = 1;
- /*
+ /*
* Artificially bump the refcount to ensure that the channel
* is only closed on exit.
*
@@ -489,58 +352,39 @@ Tcl_GetStdChannel(type)
* to the standard input.
*/
- if (stdinChannel != (Tcl_Channel) NULL) {
+ if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
(void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- stdinChannel);
+ tsdPtr->stdinChannel);
}
}
- channel = stdinChannel;
+ channel = tsdPtr->stdinChannel;
break;
case TCL_STDOUT:
- if (!stdoutInitialized) {
- stdoutChannel = TclGetDefaultStdChannel(TCL_STDOUT);
- stdoutInitialized = 1;
-
- /*
- * Artificially bump the refcount to ensure that the channel
- * is only closed on exit.
- *
- * NOTE: Must only do this if stdoutChannel is not NULL. It
- * can be NULL in situations where Tcl is unable to connect
- * to the standard output.
- */
-
- if (stdoutChannel != (Tcl_Channel) NULL) {
+ if (!tsdPtr->stdoutInitialized) {
+ tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
+ tsdPtr->stdoutInitialized = 1;
+ if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
(void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- stdoutChannel);
+ tsdPtr->stdoutChannel);
}
}
- channel = stdoutChannel;
+ channel = tsdPtr->stdoutChannel;
break;
case TCL_STDERR:
- if (!stderrInitialized) {
- stderrChannel = TclGetDefaultStdChannel(TCL_STDERR);
- stderrInitialized = 1;
-
- /*
- * Artificially bump the refcount to ensure that the channel
- * is only closed on exit.
- *
- * NOTE: Must only do this if stderrChannel is not NULL. It
- * can be NULL in situations where Tcl is unable to connect
- * to the standard error.
- */
-
- if (stderrChannel != (Tcl_Channel) NULL) {
+ if (!tsdPtr->stderrInitialized) {
+ tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
+ tsdPtr->stderrInitialized = 1;
+ if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
(void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- stderrChannel);
+ tsdPtr->stderrChannel);
}
}
- channel = stderrChannel;
+ channel = tsdPtr->stderrChannel;
break;
}
return channel;
}
+
/*
*----------------------------------------------------------------------
@@ -569,17 +413,17 @@ Tcl_CreateCloseHandler(chan, proc, clientData)
ClientData clientData; /* Arbitrary data to pass to the
* close callback. */
{
- Channel *chanPtr;
+ ChannelState *statePtr;
CloseCallback *cbPtr;
- chanPtr = (Channel *) chan;
+ statePtr = ((Channel *) chan)->state;
cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
cbPtr->proc = proc;
cbPtr->clientData = clientData;
- cbPtr->nextPtr = chanPtr->closeCbPtr;
- chanPtr->closeCbPtr = cbPtr;
+ cbPtr->nextPtr = statePtr->closeCbPtr;
+ statePtr->closeCbPtr = cbPtr;
}
/*
@@ -610,16 +454,16 @@ Tcl_DeleteCloseHandler(chan, proc, clientData)
ClientData clientData; /* The callback data for the callback
* to remove. */
{
- Channel *chanPtr;
+ ChannelState *statePtr;
CloseCallback *cbPtr, *cbPrevPtr;
- chanPtr = (Channel *) chan;
- for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
- cbPtr != (CloseCallback *) NULL;
- cbPtr = cbPtr->nextPtr) {
+ statePtr = ((Channel *) chan)->state;
+ for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
+ cbPtr != (CloseCallback *) NULL;
+ cbPtr = cbPtr->nextPtr) {
if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
if (cbPrevPtr == (CloseCallback *) NULL) {
- chanPtr->closeCbPtr = cbPtr->nextPtr;
+ statePtr->closeCbPtr = cbPtr->nextPtr;
}
ckfree((char *) cbPtr);
break;
@@ -632,109 +476,6 @@ Tcl_DeleteCloseHandler(chan, proc, clientData)
/*
*----------------------------------------------------------------------
*
- * CloseChannelsOnExit --
- *
- * Closes all the existing channels, on exit. This routine is called
- * during exit processing.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Closes all channels.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static void
-CloseChannelsOnExit(clientData)
- ClientData clientData; /* NULL - unused. */
-{
- Channel *chanPtr; /* Iterates over open channels. */
- Channel *nextChanPtr; /* Iterates over open channels. */
-
-
- for (chanPtr = firstChanPtr; chanPtr != (Channel *) NULL;
- chanPtr = nextChanPtr) {
- nextChanPtr = chanPtr->nextChanPtr;
-
- /*
- * 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");
-
- if ((chanPtr == (Channel *) stdinChannel) ||
- (chanPtr == (Channel *) stdoutChannel) ||
- (chanPtr == (Channel *) stderrChannel)) {
-
- /*
- * Decrement the refcount which was earlier artificially bumped
- * up to keep the channel from being closed.
- */
-
- chanPtr->refCount--;
- }
-
- if (chanPtr->refCount <= 0) {
-
- /*
- * Close it only if the refcount indicates that the channel is not
- * referenced from any interpreter. If it is, that interpreter will
- * close the channel when it gets destroyed.
- */
-
- (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
-
- } else {
-
- /*
- * The refcount is greater than zero, so flush the channel.
- */
-
- Tcl_Flush((Tcl_Channel) chanPtr);
-
- /*
- * Call the device driver to actually close the underlying
- * device for this channel.
- */
-
- (chanPtr->typePtr->closeProc) (chanPtr->instanceData,
- (Tcl_Interp *) NULL);
-
- /*
- * Finally, we clean up the fields in the channel data structure
- * since all of them have been deleted already. We mark the
- * channel with CHANNEL_DEAD to prevent any further IO operations
- * on it.
- */
-
- chanPtr->instanceData = (ClientData) NULL;
- chanPtr->flags |= CHANNEL_DEAD;
- }
- }
-
- /*
- * Reinitialize all the variables to the initial state:
- */
-
- firstChanPtr = (Channel *) NULL;
- nestedHandlerPtr = (NextChannelHandler *) NULL;
- channelExitHandlerCreated = 0;
- stdinChannel = NULL;
- stdinInitialized = 0;
- stdoutChannel = NULL;
- stdoutInitialized = 0;
- stderrChannel = NULL;
- stderrInitialized = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* GetChannelTable --
*
* Gets and potentially initializes the channel table for an
@@ -822,12 +563,13 @@ DeleteChannelTable(clientData, interp)
Tcl_HashTable *hTblPtr; /* The hash table. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
- Channel *chanPtr; /* Channel being deleted. */
+ Channel *chanPtr; /* Channel being deleted. */
+ ChannelState *statePtr; /* State of Channel being deleted. */
EventScriptRecord *sPtr, *prevPtr, *nextPtr;
/* Variables to loop over all channel events
* registered, to delete the ones that refer
* to the interpreter being deleted. */
-
+
/*
* Delete all the registered channels - this will close channels whose
* refcount reaches zero.
@@ -835,31 +577,32 @@ DeleteChannelTable(clientData, interp)
hTblPtr = (Tcl_HashTable *) clientData;
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
+ hPtr != (Tcl_HashEntry *) NULL;
+ hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ statePtr = chanPtr->state;
/*
* Remove any fileevents registered in this interpreter.
*/
- for (sPtr = chanPtr->scriptRecordPtr,
+ for (sPtr = statePtr->scriptRecordPtr,
prevPtr = (EventScriptRecord *) NULL;
- sPtr != (EventScriptRecord *) NULL;
- sPtr = nextPtr) {
+ sPtr != (EventScriptRecord *) NULL;
+ sPtr = nextPtr) {
nextPtr = sPtr->nextPtr;
if (sPtr->interp == interp) {
if (prevPtr == (EventScriptRecord *) NULL) {
- chanPtr->scriptRecordPtr = nextPtr;
+ statePtr->scriptRecordPtr = nextPtr;
} else {
prevPtr->nextPtr = nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) sPtr);
+ TclChannelEventScriptInvoker, (ClientData) sPtr);
- ckfree(sPtr->script);
+ Tcl_DecrRefCount(sPtr->scriptPtr);
ckfree((char *) sPtr);
} else {
prevPtr = sPtr;
@@ -874,9 +617,9 @@ DeleteChannelTable(clientData, interp)
*/
Tcl_DeleteHashEntry(hPtr);
- chanPtr->refCount--;
- if (chanPtr->refCount <= 0) {
- if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+ statePtr->refCount--;
+ if (statePtr->refCount <= 0) {
+ if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
}
@@ -911,24 +654,27 @@ static void
CheckForStdChannelsBeingClosed(chan)
Tcl_Channel chan;
{
- Channel *chanPtr = (Channel *) chan;
-
- if ((chan == stdinChannel) && (stdinInitialized)) {
- if (chanPtr->refCount < 2) {
- chanPtr->refCount = 0;
- stdinChannel = NULL;
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
+ if (statePtr->refCount < 2) {
+ statePtr->refCount = 0;
+ tsdPtr->stdinChannel = NULL;
return;
}
- } else if ((chan == stdoutChannel) && (stdoutInitialized)) {
- if (chanPtr->refCount < 2) {
- chanPtr->refCount = 0;
- stdoutChannel = NULL;
+ } else if ((chan == tsdPtr->stdoutChannel)
+ && (tsdPtr->stdoutInitialized)) {
+ if (statePtr->refCount < 2) {
+ statePtr->refCount = 0;
+ tsdPtr->stdoutChannel = NULL;
return;
}
- } else if ((chan == stderrChannel) && (stderrInitialized)) {
- if (chanPtr->refCount < 2) {
- chanPtr->refCount = 0;
- stderrChannel = NULL;
+ } else if ((chan == tsdPtr->stderrChannel)
+ && (tsdPtr->stderrInitialized)) {
+ if (statePtr->refCount < 2) {
+ statePtr->refCount = 0;
+ tsdPtr->stderrChannel = NULL;
return;
}
}
@@ -937,6 +683,62 @@ CheckForStdChannelsBeingClosed(chan)
/*
*----------------------------------------------------------------------
*
+ * Tcl_RegisterChannel --
+ *
+ * Adds an already-open channel to the channel table of an interpreter.
+ * If the interpreter passed as argument is NULL, it only increments
+ * the channel refCount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May increment the reference count of a channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_RegisterChannel(interp, chan)
+ Tcl_Interp *interp; /* Interpreter in which to add the channel. */
+ Tcl_Channel chan; /* The channel to add to this interpreter
+ * channel table. */
+{
+ Tcl_HashTable *hTblPtr; /* Hash table of channels. */
+ Tcl_HashEntry *hPtr; /* Search variable. */
+ int new; /* Is the hash entry new or does it exist? */
+ Channel *chanPtr; /* The actual channel. */
+ ChannelState *statePtr; /* State of the actual channel. */
+
+ /*
+ * Always (un)register bottom-most channel in the stack. This makes
+ * management of the channel list easier because no manipulation is
+ * necessary during (un)stack operation.
+ */
+ chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+ statePtr = chanPtr->state;
+
+ if (statePtr->channelName == (char *) NULL) {
+ panic("Tcl_RegisterChannel: channel without name");
+ }
+ if (interp != (Tcl_Interp *) NULL) {
+ hTblPtr = GetChannelTable(interp);
+ hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
+ if (new == 0) {
+ if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
+ return;
+ }
+
+ panic("Tcl_RegisterChannel: duplicate channel names");
+ }
+ Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
+ }
+ statePtr->refCount++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_UnregisterChannel --
*
* Deletes the hash entry for a channel associated with an interpreter.
@@ -960,15 +762,22 @@ Tcl_UnregisterChannel(interp, chan)
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of the real channel. */
+
+ /*
+ * Always (un)register bottom-most channel in the stack. This makes
+ * management of the channel list easier because no manipulation is
+ * necessary during (un)stack operation.
+ */
+ chanPtr = ((Channel *) chan)->state->bottomChanPtr;
+ statePtr = chanPtr->state;
- chanPtr = (Channel *) chan;
-
if (interp != (Tcl_Interp *) NULL) {
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
if (hTblPtr == (Tcl_HashTable *) NULL) {
return TCL_OK;
}
- hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
+ hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
if (hPtr == (Tcl_HashEntry *) NULL) {
return TCL_OK;
}
@@ -988,7 +797,7 @@ Tcl_UnregisterChannel(interp, chan)
CleanupChannelHandlers(interp, chanPtr);
}
- chanPtr->refCount--;
+ statePtr->refCount--;
/*
* Perform special handling for standard channels being closed. If the
@@ -1004,20 +813,20 @@ Tcl_UnregisterChannel(interp, chan)
* If the refCount reached zero, close the actual channel.
*/
- if (chanPtr->refCount <= 0) {
+ if (statePtr->refCount <= 0) {
/*
* Ensure that if there is another buffer, it gets flushed
* whether or not we are doing a background flush.
*/
- if ((chanPtr->curOutPtr != NULL) &&
- (chanPtr->curOutPtr->nextAdded >
- chanPtr->curOutPtr->nextRemoved)) {
- chanPtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != NULL) &&
+ (statePtr->curOutPtr->nextAdded >
+ statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= BUFFER_READY;
}
- chanPtr->flags |= CHANNEL_CLOSED;
- if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+ statePtr->flags |= CHANNEL_CLOSED;
+ if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
if (Tcl_Close(interp, chan) != TCL_OK) {
return TCL_ERROR;
}
@@ -1027,55 +836,7 @@ Tcl_UnregisterChannel(interp, chan)
}
/*
- *----------------------------------------------------------------------
- *
- * Tcl_RegisterChannel --
- *
- * Adds an already-open channel to the channel table of an interpreter.
- * If the interpreter passed as argument is NULL, it only increments
- * the channel refCount.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May increment the reference count of a channel.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_RegisterChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which to add the channel. */
- Tcl_Channel chan; /* The channel to add to this interpreter
- * channel table. */
-{
- Tcl_HashTable *hTblPtr; /* Hash table of channels. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- int new; /* Is the hash entry new or does it exist? */
- Channel *chanPtr; /* The actual channel. */
-
- chanPtr = (Channel *) chan;
-
- if (chanPtr->channelName == (char *) NULL) {
- panic("Tcl_RegisterChannel: channel without name");
- }
- if (interp != (Tcl_Interp *) NULL) {
- hTblPtr = GetChannelTable(interp);
- hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
- if (new == 0) {
- if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
- return;
- }
- panic("Tcl_RegisterChannel: duplicate channel names");
- }
- Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
- }
- chanPtr->refCount++;
-}
-
-/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_GetChannel --
*
@@ -1084,14 +845,14 @@ Tcl_RegisterChannel(interp, chan)
* channel-type-specific functions.
*
* Results:
- * A Tcl_Channel or NULL on failure. If failed, interp->result
- * contains an error message. It also returns, in modePtr, the
- * modes in which the channel is opened.
+ * A Tcl_Channel or NULL on failure. If failed, interp's result
+ * object contains an error message. *modePtr is filled with the
+ * modes in which the channel was opened.
*
* Side effects:
* None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
Tcl_Channel
@@ -1121,17 +882,17 @@ Tcl_GetChannel(interp, chanName, modePtr)
if ((chanName[0] == 's') && (chanName[1] == 't')) {
chanPtr = NULL;
if (strcmp(chanName, "stdin") == 0) {
- chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
+ chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN);
} else if (strcmp(chanName, "stdout") == 0) {
- chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
+ chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT);
} else if (strcmp(chanName, "stderr") == 0) {
- chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
+ chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR);
}
if (chanPtr != NULL) {
- name = chanPtr->channelName;
+ name = chanPtr->state->channelName;
}
}
-
+
hTblPtr = GetChannelTable(interp);
hPtr = Tcl_FindHashEntry(hTblPtr, name);
if (hPtr == (Tcl_HashEntry *) NULL) {
@@ -1140,9 +901,16 @@ Tcl_GetChannel(interp, chanName, modePtr)
return NULL;
}
+ /*
+ * Always return bottom-most channel in the stack. This one lives
+ * the longest - other channels may go away unnoticed.
+ * The other APIs compensate where necessary to retrieve the
+ * topmost channel again.
+ */
chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ chanPtr = chanPtr->state->bottomChanPtr;
if (modePtr != NULL) {
- *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
+ *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
}
return (Tcl_Channel) chanPtr;
@@ -1175,17 +943,57 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* if the channel is readable, writable. */
{
Channel *chanPtr; /* The channel structure newly created. */
+ ChannelState *statePtr; /* The stack-level independent state info
+ * for the channel. */
+ CONST char *name;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * With the change of the Tcl_ChannelType structure to use a version in
+ * 8.3.2+, we have to make sure that our assumption that the structure
+ * remains a binary compatible size is true.
+ *
+ * If this assertion fails on some system, then it can be removed
+ * only if the user recompiles code with older channel drivers in
+ * the new system as well.
+ */
+
+ assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
+
+ chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
+ statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));
+ chanPtr->state = statePtr;
+
+ chanPtr->instanceData = instanceData;
+ chanPtr->typePtr = typePtr;
+
+ /*
+ * Set all the bits that are part of the stack-independent state
+ * information for the channel.
+ */
- chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
-
if (chanName != (char *) NULL) {
- chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
- strcpy(chanPtr->channelName, chanName);
+ statePtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
+ strcpy(statePtr->channelName, chanName);
} else {
panic("Tcl_CreateChannel: NULL channel name");
}
- chanPtr->flags = mask;
+ statePtr->flags = mask;
+
+ /*
+ * Set the channel to system default encoding.
+ */
+
+ statePtr->encoding = NULL;
+ name = Tcl_GetEncodingName(NULL);
+ if (strcmp(name, "binary") != 0) {
+ statePtr->encoding = Tcl_GetEncoding(NULL, name);
+ }
+ statePtr->inputEncodingState = NULL;
+ statePtr->inputEncodingFlags = TCL_ENCODING_START;
+ statePtr->outputEncodingState = NULL;
+ statePtr->outputEncodingFlags = TCL_ENCODING_START;
/*
* Set the channel up initially in AUTO input translation mode to
@@ -1195,28 +1003,42 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* indicator (e.g. ^Z) and does not append an EOF indicator to files.
*/
- chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
- chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
- chanPtr->inEofChar = 0;
- chanPtr->outEofChar = 0;
-
- chanPtr->unreportedError = 0;
- chanPtr->instanceData = instanceData;
- chanPtr->typePtr = typePtr;
- chanPtr->refCount = 0;
- chanPtr->closeCbPtr = (CloseCallback *) NULL;
- chanPtr->curOutPtr = (ChannelBuffer *) NULL;
- chanPtr->outQueueHead = (ChannelBuffer *) NULL;
- chanPtr->outQueueTail = (ChannelBuffer *) NULL;
- chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
- chanPtr->chPtr = (ChannelHandler *) NULL;
- chanPtr->interestMask = 0;
- chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
- chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
- chanPtr->timer = NULL;
- chanPtr->csPtr = NULL;
+ statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
+ statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+ statePtr->inEofChar = 0;
+ statePtr->outEofChar = 0;
+
+ statePtr->unreportedError = 0;
+ statePtr->refCount = 0;
+ statePtr->closeCbPtr = (CloseCallback *) NULL;
+ statePtr->curOutPtr = (ChannelBuffer *) NULL;
+ statePtr->outQueueHead = (ChannelBuffer *) NULL;
+ statePtr->outQueueTail = (ChannelBuffer *) NULL;
+ statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
+ statePtr->inQueueHead = (ChannelBuffer *) NULL;
+ statePtr->inQueueTail = (ChannelBuffer *) NULL;
+ statePtr->chPtr = (ChannelHandler *) NULL;
+ statePtr->interestMask = 0;
+ statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+ statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
+ statePtr->timer = NULL;
+ statePtr->csPtr = NULL;
+
+ statePtr->outputStage = NULL;
+ if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+ statePtr->outputStage = (char *)
+ ckalloc((unsigned) (statePtr->bufSize + 2));
+ }
+
+ /*
+ * As we are creating the channel, it is obviously the top for now
+ */
+ statePtr->topChanPtr = chanPtr;
+ statePtr->bottomChanPtr = chanPtr;
+ chanPtr->downChanPtr = (Channel *) NULL;
+ chanPtr->upChanPtr = (Channel *) NULL;
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
/*
* Link the channel into the list of all channels; create an on-exit
@@ -1224,27 +1046,25 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* in the list on exit.
*/
- chanPtr->nextChanPtr = firstChanPtr;
- firstChanPtr = chanPtr;
+ statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+ tsdPtr->firstCSPtr = statePtr;
- if (!channelExitHandlerCreated) {
- channelExitHandlerCreated = 1;
- Tcl_CreateExitHandler(CloseChannelsOnExit, (ClientData) NULL);
- }
-
/*
* Install this channel in the first empty standard channel slot, if
* the channel was previously closed explicitly.
*/
- if ((stdinChannel == NULL) && (stdinInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
+ if ((tsdPtr->stdinChannel == NULL) &&
+ (tsdPtr->stdinInitialized == 1)) {
+ Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
- } else if ((stdoutChannel == NULL) && (stdoutInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
+ } else if ((tsdPtr->stdoutChannel == NULL) &&
+ (tsdPtr->stdoutInitialized == 1)) {
+ Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
- } else if ((stderrChannel == NULL) && (stderrInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
+ } else if ((tsdPtr->stderrChannel == NULL) &&
+ (tsdPtr->stderrInitialized == 1)) {
+ Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
}
return (Tcl_Channel) chanPtr;
@@ -1253,42 +1073,327 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
/*
*----------------------------------------------------------------------
*
- * Tcl_GetChannelMode --
+ * Tcl_StackChannel --
*
- * Computes a mask indicating whether the channel is open for
- * reading and writing.
+ * Replaces an entry in the hash table for a Tcl_Channel
+ * record. The replacement is a new channel with same name,
+ * it supercedes the replaced channel. Input and output of
+ * the superceded channel is now going through the newly
+ * created channel and allows the arbitrary filtering/manipulation
+ * of the dataflow.
+ *
+ * Andreas Kupries <a.kupries@westend.com>, 12/13/1998
+ * "Trf-Patch for filtering channels"
*
* Results:
- * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
+ * Returns the new Tcl_Channel, which actually contains the
+ * saved information about prevChan.
*
* Side effects:
- * None.
+ * A new channel structure is allocated and linked below
+ * the existing channel. The channel operations and client
+ * data of the existing channel are copied down to the newly
+ * created channel, and the current channel has its operations
+ * replaced by the new typePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
+ Tcl_Interp *interp; /* The interpreter we are working in */
+ Tcl_ChannelType *typePtr; /* The channel type record for the new
+ * channel. */
+ ClientData instanceData; /* Instance specific data for the new
+ * channel. */
+ int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
+ * if the channel is readable, writable. */
+ Tcl_Channel prevChan; /* The channel structure to replace */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Channel *chanPtr, *prevChanPtr;
+ ChannelState *statePtr;
+
+ /*
+ * Find the given channel in the list of all channels.
+ * If we don't find it, then it was never registered correctly.
+ *
+ * This operation should occur at the top of a channel stack.
+ */
+
+ statePtr = (ChannelState *) tsdPtr->firstCSPtr;
+ prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
+
+ while (statePtr->topChanPtr != prevChanPtr) {
+ statePtr = statePtr->nextCSPtr;
+ }
+
+ if (statePtr == NULL) {
+ Tcl_AppendResult(interp, "couldn't find state for channel \"",
+ Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
+ return (Tcl_Channel) NULL;
+ }
+
+ /*
+ * Here we check if the given "mask" matches the "flags"
+ * of the already existing channel.
+ *
+ * | - | R | W | RW |
+ * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask)
+ * - | | | | |
+ * R | | + | | + | The superceding channel is allowed to
+ * W | | | + | + | restrict the capabilities of the
+ * RW| | + | + | + | superceded one !
+ * --+---+---+---+----+
+ */
+
+ if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
+ Tcl_AppendResult(interp,
+ "reading and writing both disallowed for channel \"",
+ Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
+ return (Tcl_Channel) NULL;
+ }
+
+ /*
+ * Flush the buffers. This ensures that any data still in them
+ * at this time is not handled by the new transformation. Restrict
+ * this to writable channels. Take care to hide a possible bg-copy
+ * in progress from Tcl_Flush and the CheckForChannelErrors inside.
+ */
+
+ if ((mask & TCL_WRITABLE) != 0) {
+ CopyState *csPtr;
+
+ csPtr = statePtr->csPtr;
+ statePtr->csPtr = (CopyState*) NULL;
+
+ if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
+ statePtr->csPtr = csPtr;
+ Tcl_AppendResult(interp, "could not flush channel \"",
+ Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
+ return (Tcl_Channel) NULL;
+ }
+
+ statePtr->csPtr = csPtr;
+ }
+ /*
+ * Discard any input in the buffers. They are not yet read by the
+ * user of the channel, so they have to go through the new
+ * transformation before reading. As the buffers contain the
+ * untransformed form their contents are not only useless but actually
+ * distorts our view of the system.
+ *
+ * To preserve the information without having to read them again and
+ * to avoid problems with the location in the channel (seeking might
+ * be impossible) we move the buffers from the common state structure
+ * into the channel itself. We use the buffers in the channel below
+ * the new transformation to hold the data. In the future this allows
+ * us to write transformations which pre-read data and push the unused
+ * part back when they are going away.
+ */
+
+ if (((mask & TCL_READABLE) != 0) &&
+ (statePtr->inQueueHead != (ChannelBuffer*) NULL)) {
+ /*
+ * Remark: It is possible that the channel buffers contain data from
+ * some earlier push-backs.
+ */
+
+ statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
+ prevChanPtr->inQueueHead = statePtr->inQueueHead;
+
+ if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {
+ prevChanPtr->inQueueTail = statePtr->inQueueTail;
+ }
+
+ statePtr->inQueueHead = (ChannelBuffer*) NULL;
+ statePtr->inQueueTail = (ChannelBuffer*) NULL;
+ }
+
+ chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
+
+ /*
+ * Save some of the current state into the new structure,
+ * reinitialize the parts which will stay with the transformation.
+ *
+ * Remarks:
+ */
+
+ chanPtr->state = statePtr;
+ chanPtr->instanceData = instanceData;
+ chanPtr->typePtr = typePtr;
+ chanPtr->downChanPtr = prevChanPtr;
+ chanPtr->upChanPtr = (Channel *) NULL;
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+
+ /*
+ * Place new block at the head of a possibly existing list of previously
+ * stacked channels.
+ */
+
+ prevChanPtr->upChanPtr = chanPtr;
+ statePtr->topChanPtr = chanPtr;
+
+ return (Tcl_Channel) chanPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UnstackChannel --
+ *
+ * Unstacks an entry in the hash table for a Tcl_Channel
+ * record. This is the reverse to 'Tcl_StackChannel'.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * If TCL_ERROR is returned, the posix error code will be set
+ * with Tcl_SetErrno.
*
*----------------------------------------------------------------------
*/
int
-Tcl_GetChannelMode(chan)
- Tcl_Channel chan; /* The channel for which the mode is
- * being computed. */
+Tcl_UnstackChannel (interp, chan)
+ Tcl_Interp *interp; /* The interpreter we are working in */
+ Tcl_Channel chan; /* The channel to unstack */
{
- Channel *chanPtr; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state;
+ int result = 0;
- chanPtr = (Channel *) chan;
- return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
+ if (chanPtr->downChanPtr != (Channel *) NULL) {
+ /*
+ * Instead of manipulating the per-thread / per-interp list/hashtable
+ * of registered channels we wind down the state of the transformation,
+ * and then restore the state of underlying channel into the old
+ * structure.
+ */
+ Channel *downChanPtr = chanPtr->downChanPtr;
+
+ /*
+ * Flush the buffers. This ensures that any data still in them
+ * at this time _is_ handled by the transformation we are unstacking
+ * right now. Restrict this to writable channels. Take care to hide
+ * a possible bg-copy in progress from Tcl_Flush and the
+ * CheckForChannelErrors inside.
+ */
+
+ if (statePtr->flags & TCL_WRITABLE) {
+ CopyState* csPtr;
+
+ csPtr = statePtr->csPtr;
+ statePtr->csPtr = (CopyState*) NULL;
+
+ if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
+ statePtr->csPtr = csPtr;
+ Tcl_AppendResult(interp, "could not flush channel \"",
+ Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ statePtr->csPtr = csPtr;
+ }
+
+ /*
+ * Anything in the input queue and the push-back buffers of
+ * the transformation going away is transformed data, but not
+ * yet read. As unstacking means that the caller does not want
+ * to see transformed data any more we have to discard these
+ * bytes. To avoid writing an analogue to 'DiscardInputQueued'
+ * we move the information in the push back buffers to the
+ * input queue and then call 'DiscardInputQueued' on that.
+ */
+
+ if (((statePtr->flags & TCL_READABLE) != 0) &&
+ ((statePtr->inQueueHead != (ChannelBuffer*) NULL) ||
+ (chanPtr->inQueueHead != (ChannelBuffer*) NULL))) {
+
+ if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&
+ (chanPtr->inQueueHead != (ChannelBuffer*) NULL)) {
+ statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
+ statePtr->inQueueTail = chanPtr->inQueueTail;
+ statePtr->inQueueHead = statePtr->inQueueTail;
+
+ } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
+ statePtr->inQueueHead = chanPtr->inQueueHead;
+ statePtr->inQueueTail = chanPtr->inQueueTail;
+ }
+
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+
+ DiscardInputQueued (statePtr, 0);
+ }
+
+ statePtr->topChanPtr = downChanPtr;
+ downChanPtr->upChanPtr = (Channel *) NULL;
+
+ /*
+ * Leave this link intact for closeproc
+ * chanPtr->downChanPtr = (Channel *) NULL;
+ */
+
+ /*
+ * Close and free the channel driver state.
+ */
+
+ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+ result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
+ interp);
+ } else {
+ result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
+ interp, 0);
+ }
+
+ chanPtr->typePtr = NULL;
+ /*
+ * AK: Tcl_NotifyChannel may hold a reference to this block of memory
+ */
+ Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+ UpdateInterest(downChanPtr);
+
+ if (result != 0) {
+ Tcl_SetErrno(result);
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * This channel does not cover another one.
+ * Simply do a close, if necessary.
+ */
+
+ if (statePtr->refCount <= 0) {
+ if (Tcl_Close(interp, chan) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetChannelName --
+ * Tcl_GetStackedChannel --
*
- * Returns the string identifying the channel name.
+ * Determines whether the specified channel is stacked upon another.
*
* Results:
- * The string containing the channel name. This memory is
- * owned by the generic layer and should not be modified by
- * the caller.
+ * NULL if the channel is not stacked upon another one, or a reference
+ * to the channel it is stacked upon. This reference can be used in
+ * queries, but modification is not allowed.
*
* Side effects:
* None.
@@ -1296,14 +1401,65 @@ Tcl_GetChannelMode(chan)
*----------------------------------------------------------------------
*/
-char *
-Tcl_GetChannelName(chan)
- Tcl_Channel chan; /* The channel for which to return the name. */
+Tcl_Channel
+Tcl_GetStackedChannel(chan)
+ Tcl_Channel chan;
{
- Channel *chanPtr; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- chanPtr = (Channel *) chan;
- return chanPtr->channelName;
+ return (Tcl_Channel) chanPtr->downChanPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetTopChannel --
+ *
+ * Returns the top channel of a channel stack.
+ *
+ * Results:
+ * NULL if the channel is not stacked upon another one, or a reference
+ * to the channel it is stacked upon. This reference can be used in
+ * queries, but modification is not allowed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_GetTopChannel(chan)
+ Tcl_Channel chan;
+{
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+
+ return (Tcl_Channel) chanPtr->state->topChanPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelInstanceData --
+ *
+ * Returns the client data associated with a channel.
+ *
+ * Results:
+ * The client data.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_GetChannelInstanceData(chan)
+ Tcl_Channel chan; /* Channel for which to return client data. */
+{
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+
+ return chanPtr->instanceData;
}
/*
@@ -1326,15 +1482,70 @@ Tcl_ChannelType *
Tcl_GetChannelType(chan)
Tcl_Channel chan; /* The channel to return type for. */
{
- Channel *chanPtr; /* The actual channel. */
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- chanPtr = (Channel *) chan;
return chanPtr->typePtr;
}
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetChannelMode --
+ *
+ * Computes a mask indicating whether the channel is open for
+ * reading and writing.
+ *
+ * Results:
+ * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetChannelMode(chan)
+ Tcl_Channel chan; /* The channel for which the mode is
+ * being computed. */
+{
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of actual channel. */
+
+ return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelName --
+ *
+ * Returns the string identifying the channel name.
+ *
+ * Results:
+ * The string containing the channel name. This memory is
+ * owned by the generic layer and should not be modified by
+ * the caller.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetChannelName(chan)
+ Tcl_Channel chan; /* The channel for which to return the name. */
+{
+ ChannelState *statePtr; /* State of actual channel. */
+
+ statePtr = ((Channel *) chan)->state;
+ return statePtr->channelName;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetChannelHandle --
*
* Returns an OS handle associated with a channel.
@@ -1359,7 +1570,7 @@ Tcl_GetChannelHandle(chan, direction, handlePtr)
ClientData handle;
int result;
- chanPtr = (Channel *) chan;
+ chanPtr = ((Channel *) chan)->state->bottomChanPtr;
result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
direction, &handle);
if (handlePtr) {
@@ -1369,29 +1580,44 @@ Tcl_GetChannelHandle(chan, direction, handlePtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_GetChannelInstanceData --
+ * AllocChannelBuffer --
*
- * Returns the client data associated with a channel.
+ * A channel buffer has BUFFER_PADDING bytes extra at beginning to
+ * hold any bytes of a native-encoding character that got split by
+ * the end of the previous buffer and need to be moved to the
+ * beginning of the next buffer to make a contiguous string so it
+ * can be converted to UTF-8.
+ *
+ * A channel buffer has BUFFER_PADDING bytes extra at the end to
+ * hold any bytes of a native-encoding character (generated from a
+ * UTF-8 character) that overflow past the end of the buffer and
+ * need to be moved to the next buffer.
*
* Results:
- * The client data.
+ * A newly allocated channel buffer.
*
* Side effects:
* None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-ClientData
-Tcl_GetChannelInstanceData(chan)
- Tcl_Channel chan; /* Channel for which to return client data. */
+static ChannelBuffer *
+AllocChannelBuffer(length)
+ int length; /* Desired length of channel buffer. */
{
- Channel *chanPtr; /* The actual channel. */
-
- chanPtr = (Channel *) chan;
- return chanPtr->instanceData;
+ ChannelBuffer *bufPtr;
+ int n;
+
+ n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
+ bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
+ bufPtr->nextAdded = BUFFER_PADDING;
+ bufPtr->nextRemoved = BUFFER_PADDING;
+ bufPtr->bufLength = length + BUFFER_PADDING;
+ bufPtr->nextPtr = (ChannelBuffer *) NULL;
+ return bufPtr;
}
/*
@@ -1415,8 +1641,8 @@ Tcl_GetChannelInstanceData(chan)
*/
static void
-RecycleBuffer(chanPtr, bufPtr, mustDiscard)
- Channel *chanPtr; /* Channel for which to recycle buffers. */
+RecycleBuffer(statePtr, bufPtr, mustDiscard)
+ ChannelState *statePtr; /* ChannelState in which to recycle buffers. */
ChannelBuffer *bufPtr; /* The buffer to recycle. */
int mustDiscard; /* If nonzero, free the buffer to the
* OS, always. */
@@ -1429,19 +1655,19 @@ RecycleBuffer(chanPtr, bufPtr, mustDiscard)
ckfree((char *) bufPtr);
return;
}
-
+
/*
* Only save buffers for the input queue if the channel is readable.
*/
- if (chanPtr->flags & TCL_READABLE) {
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->inQueueHead = bufPtr;
- chanPtr->inQueueTail = bufPtr;
+ if (statePtr->flags & TCL_READABLE) {
+ if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->inQueueHead = bufPtr;
+ statePtr->inQueueTail = bufPtr;
goto keepit;
}
- if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
- chanPtr->saveInBufPtr = bufPtr;
+ if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {
+ statePtr->saveInBufPtr = bufPtr;
goto keepit;
}
}
@@ -1450,9 +1676,9 @@ RecycleBuffer(chanPtr, bufPtr, mustDiscard)
* Only save buffers for the output queue if the channel is writable.
*/
- if (chanPtr->flags & TCL_WRITABLE) {
- if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
- chanPtr->curOutPtr = bufPtr;
+ if (statePtr->flags & TCL_WRITABLE) {
+ if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
+ statePtr->curOutPtr = bufPtr;
goto keepit;
}
}
@@ -1464,9 +1690,9 @@ RecycleBuffer(chanPtr, bufPtr, mustDiscard)
ckfree((char *) bufPtr);
return;
-keepit:
- bufPtr->nextRemoved = 0;
- bufPtr->nextAdded = 0;
+ keepit:
+ bufPtr->nextRemoved = BUFFER_PADDING;
+ bufPtr->nextAdded = BUFFER_PADDING;
bufPtr->nextPtr = (ChannelBuffer *) NULL;
}
@@ -1487,18 +1713,18 @@ keepit:
*/
static void
-DiscardOutputQueued(chanPtr)
- Channel *chanPtr; /* The channel for which to discard output. */
+DiscardOutputQueued(statePtr)
+ ChannelState *statePtr; /* ChannelState for which to discard output. */
{
ChannelBuffer *bufPtr;
- while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
- bufPtr = chanPtr->outQueueHead;
- chanPtr->outQueueHead = bufPtr->nextPtr;
- RecycleBuffer(chanPtr, bufPtr, 0);
+ while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
+ bufPtr = statePtr->outQueueHead;
+ statePtr->outQueueHead = bufPtr->nextPtr;
+ RecycleBuffer(statePtr, bufPtr, 0);
}
- chanPtr->outQueueHead = (ChannelBuffer *) NULL;
- chanPtr->outQueueTail = (ChannelBuffer *) NULL;
+ statePtr->outQueueHead = (ChannelBuffer *) NULL;
+ statePtr->outQueueTail = (ChannelBuffer *) NULL;
}
/*
@@ -1519,16 +1745,16 @@ DiscardOutputQueued(chanPtr)
*/
static int
-CheckForDeadChannel(interp, chanPtr)
+CheckForDeadChannel(interp, statePtr)
Tcl_Interp *interp; /* For error reporting (can be NULL) */
- Channel *chanPtr; /* The channel to check. */
+ ChannelState *statePtr; /* The channel state to check. */
{
- if (chanPtr->flags & CHANNEL_DEAD) {
+ if (statePtr->flags & CHANNEL_DEAD) {
Tcl_SetErrno(EINVAL);
if (interp) {
Tcl_AppendResult(interp,
- "unable to access channel: invalid channel",
- (char *) NULL);
+ "unable to access channel: invalid channel",
+ (char *) NULL);
}
return 1;
}
@@ -1564,15 +1790,18 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* called from an asynchronous
* flush callback. */
{
+ 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; /* Stores POSIX error codes from
+ int errorCode = 0; /* Stores POSIX error codes from
* channel driver operations. */
- errorCode = 0;
+ int wroteSome = 0; /* Set to one if any data was
+ * written to the driver. */
/*
* Prevent writing on a dead channel -- a channel that has been closed
@@ -1581,7 +1810,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* all interpreters.
*/
- if (CheckForDeadChannel(interp,chanPtr)) return -1;
+ if (CheckForDeadChannel(interp, statePtr)) return -1;
/*
* Loop over the queued buffers and attempt to flush as
@@ -1595,22 +1824,22 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* the current buffer is full, then move the current buffer to the
* queue.
*/
-
- if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufSize))
- || ((chanPtr->flags & BUFFER_READY) &&
- (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
- chanPtr->flags &= (~(BUFFER_READY));
- chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
- if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->outQueueHead = chanPtr->curOutPtr;
+
+ if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))
+ || ((statePtr->flags & BUFFER_READY) &&
+ (statePtr->outQueueHead == (ChannelBuffer *) NULL))) {
+ statePtr->flags &= (~(BUFFER_READY));
+ statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
+ if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->outQueueHead = statePtr->curOutPtr;
} else {
- chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
+ statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
}
- chanPtr->outQueueTail = chanPtr->curOutPtr;
- chanPtr->curOutPtr = (ChannelBuffer *) NULL;
+ statePtr->outQueueTail = statePtr->curOutPtr;
+ statePtr->curOutPtr = (ChannelBuffer *) NULL;
}
- bufPtr = chanPtr->outQueueHead;
+ bufPtr = statePtr->outQueueHead;
/*
* If we are not being called from an async flush and an async
@@ -1618,7 +1847,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if ((!calledFromAsyncFlush) &&
- (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
+ (statePtr->flags & BG_FLUSH_SCHEDULED)) {
return 0;
}
@@ -1633,11 +1862,12 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
/*
* Produce the output on the channel.
*/
-
+
toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
- bufPtr->buf + bufPtr->nextRemoved, toWrite, &errorCode);
-
+ (char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,
+ &errorCode);
+
/*
* If the write failed completely attempt to start the asynchronous
* flush mechanism and break out of this loop - do not attempt to
@@ -1661,16 +1891,18 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
- if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
- chanPtr->flags |= BG_FLUSH_SCHEDULED;
- UpdateInterest(chanPtr);
- }
- errorCode = 0;
- break;
- } else {
- panic("Blocking channel driver did not block on output");
- }
+ /*
+ * This used to check for CHANNEL_NONBLOCKING, and panic
+ * if the channel was blocking. However, it appears
+ * that setting stdin to -blocking 0 has some effect on
+ * the stdout when it's a tty channel (dup'ed underneath)
+ */
+ if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ statePtr->flags |= BG_FLUSH_SCHEDULED;
+ UpdateInterest(chanPtr);
+ }
+ errorCode = 0;
+ break;
}
/*
@@ -1678,8 +1910,8 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if (calledFromAsyncFlush) {
- if (chanPtr->unreportedError == 0) {
- chanPtr->unreportedError = errorCode;
+ if (statePtr->unreportedError == 0) {
+ statePtr->unreportedError = errorCode;
}
} else {
Tcl_SetErrno(errorCode);
@@ -1694,9 +1926,11 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* currently queued.
*/
- DiscardOutputQueued(chanPtr);
+ DiscardOutputQueued(statePtr);
continue;
- }
+ } else {
+ wroteSome = 1;
+ }
bufPtr->nextRemoved += written;
@@ -1705,24 +1939,29 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if (bufPtr->nextRemoved == bufPtr->nextAdded) {
- chanPtr->outQueueHead = bufPtr->nextPtr;
- if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->outQueueTail = (ChannelBuffer *) NULL;
+ statePtr->outQueueHead = bufPtr->nextPtr;
+ if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->outQueueTail = (ChannelBuffer *) NULL;
}
- RecycleBuffer(chanPtr, bufPtr, 0);
+ RecycleBuffer(statePtr, bufPtr, 0);
}
} /* Closes "while (1)". */
-
+
/*
- * If the queue became empty and we have the asynchronous flushing
- * mechanism active, cancel the asynchronous flushing.
+ * If we wrote some data while flushing in the background, we are done.
+ * We can't finish the background flush until we run out of data and
+ * the channel becomes writable again. This ensures that all of the
+ * pending data has been flushed at the system level.
*/
- if ((chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
- (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
- chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
- (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
- chanPtr->interestMask);
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (wroteSome) {
+ return errorCode;
+ } else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
+ (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
+ statePtr->interestMask);
+ }
}
/*
@@ -1731,12 +1970,12 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* in the current output buffer.
*/
- if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
- (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
- ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
- (chanPtr->curOutPtr->nextAdded ==
- chanPtr->curOutPtr->nextRemoved))) {
- return CloseChannel(interp, chanPtr, errorCode);
+ if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
+ (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
+ ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||
+ (statePtr->curOutPtr->nextAdded ==
+ statePtr->curOutPtr->nextRemoved))) {
+ return CloseChannel(interp, chanPtr, errorCode);
}
return errorCode;
}
@@ -1746,14 +1985,21 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*
* CloseChannel --
*
- * Utility procedure to close a channel and free its associated
- * resources.
+ * Utility procedure to close a channel and free associated resources.
+ *
+ * If the channel was stacked, then the it will copy the necessary
+ * elements of the NEXT channel into the TOP channel, in essence
+ * unstacking the channel. The NEXT channel will then be freed.
+ *
+ * If the channel was not stacked, then we will free all the bits
+ * for the TOP channel, including the data structure itself.
*
* Results:
- * 0 on success or a POSIX error code if the operation failed.
+ * 1 if the channel was stacked, 0 otherwise.
*
* Side effects:
* May close the actual channel; may free memory.
+ * May change the value of errno.
*
*----------------------------------------------------------------------
*/
@@ -1766,27 +2012,30 @@ CloseChannel(interp, chanPtr, errorCode)
{
int result = 0; /* Of calling driver close
* operation. */
- Channel *prevChanPtr; /* Preceding channel in list of
- * all channels - used to splice a
+ ChannelState *prevCSPtr; /* Preceding channel state in list of
+ * all states - used to splice a
* channel out of the list on close. */
-
+ ChannelState *statePtr; /* state of the channel stack. */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
if (chanPtr == NULL) {
return result;
}
-
+ statePtr = chanPtr->state;
+
/*
* No more input can be consumed so discard any leftover input.
*/
- DiscardInputQueued(chanPtr, 1);
+ DiscardInputQueued(statePtr, 1);
/*
* Discard a leftover buffer in the current output buffer field.
*/
- if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
- ckfree((char *) chanPtr->curOutPtr);
- chanPtr->curOutPtr = (ChannelBuffer *) NULL;
+ if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
+ ckfree((char *) statePtr->curOutPtr);
+ statePtr->curOutPtr = (ChannelBuffer *) NULL;
}
/*
@@ -1794,7 +2043,7 @@ CloseChannel(interp, chanPtr, errorCode)
* queued for output.
*/
- if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
+ if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
panic("TclFlush, closed channel: queued output left");
}
@@ -1803,60 +2052,83 @@ CloseChannel(interp, chanPtr, errorCode)
* output device.
*/
- if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
+ if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
int dummy;
char c;
- c = (char) chanPtr->outEofChar;
+ c = (char) statePtr->outEofChar;
(chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
}
-
+#if 0
/*
- * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
+ * Remove TCL_READABLE and TCL_WRITABLE from statePtr->flags, so
* that close callbacks can not do input or output (assuming they
* squirreled the channel away in their clientData). This also
* prevents infinite loops if the callback calls any C API that
* could call FlushChannel.
*/
- chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
-
+ /*
+ * This prevents any data from being flushed from stacked channels.
+ */
+ statePtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
+#endif
+
/*
* Splice this channel out of the list of all channels.
*/
- if (chanPtr == firstChanPtr) {
- firstChanPtr = chanPtr->nextChanPtr;
+ if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
+ tsdPtr->firstCSPtr = statePtr->nextCSPtr;
} else {
- for (prevChanPtr = firstChanPtr;
- (prevChanPtr != (Channel *) NULL) &&
- (prevChanPtr->nextChanPtr != chanPtr);
- prevChanPtr = prevChanPtr->nextChanPtr) {
+ for (prevCSPtr = tsdPtr->firstCSPtr;
+ prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
+ prevCSPtr = prevCSPtr->nextCSPtr) {
/* Empty loop body. */
}
- if (prevChanPtr == (Channel *) NULL) {
+ if (prevCSPtr == (ChannelState *) NULL) {
panic("FlushChannel: damaged channel list");
}
- prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
+ prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
}
/*
- * OK, close the channel itself.
+ * Close and free the channel driver state.
*/
-
- result = (chanPtr->typePtr->closeProc) (chanPtr->instanceData, interp);
-
- if (chanPtr->channelName != (char *) NULL) {
- ckfree(chanPtr->channelName);
+
+ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+ result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
+ } else {
+ result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
+ 0);
}
-
+
+ /*
+ * Some resources can be cleared only if the bottom channel
+ * in a stack is closed. All the other channels in the stack
+ * are not allowed to remove.
+ */
+
+ if (chanPtr == statePtr->bottomChanPtr) {
+ if (statePtr->channelName != (char *) NULL) {
+ ckfree(statePtr->channelName);
+ statePtr->channelName = NULL;
+ }
+
+ Tcl_FreeEncoding(statePtr->encoding);
+ if (statePtr->outputStage != NULL) {
+ ckfree((char *) statePtr->outputStage);
+ statePtr->outputStage = (char *) NULL;
+ }
+ }
+
/*
* If we are being called synchronously, report either
* any latent error on the channel or the current error.
*/
-
- if (chanPtr->unreportedError != 0) {
- errorCode = chanPtr->unreportedError;
+
+ if (statePtr->unreportedError != 0) {
+ errorCode = statePtr->unreportedError;
}
if (errorCode == 0) {
errorCode = result;
@@ -1869,12 +2141,48 @@ CloseChannel(interp, chanPtr, errorCode)
* Cancel any outstanding timer.
*/
- Tcl_DeleteTimerHandler(chanPtr->timer);
+ Tcl_DeleteTimerHandler(statePtr->timer);
/*
* Mark the channel as deleted by clearing the type structure.
*/
+ if (chanPtr->downChanPtr != (Channel *) NULL) {
+#if 0
+ int code = TCL_OK;
+
+ while (chanPtr->downChanPtr != (Channel *) NULL) {
+ /*
+ * Unwind the state of the transformation, and then restore the
+ * state of (unstack) the underlying channel into the TOP channel
+ * structure.
+ */
+ code = Tcl_UnstackChannel(interp, (Tcl_Channel) chanPtr);
+ if (code == TCL_ERROR) {
+ errorCode = Tcl_GetErrno();
+ break;
+ }
+ chanPtr = chanPtr->downChanPtr;
+ }
+#else
+ Channel *downChanPtr = chanPtr->downChanPtr;
+
+ statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+ tsdPtr->firstCSPtr = statePtr;
+
+ statePtr->topChanPtr = downChanPtr;
+ downChanPtr->upChanPtr = (Channel *) NULL;
+ chanPtr->typePtr = NULL;
+
+ Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
+ return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
+#endif
+ }
+
+ /*
+ * There is only the TOP Channel, so we free the remaining
+ * pointers we have and then ourselves.
+ */
chanPtr->typePtr = NULL;
Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
@@ -1917,13 +2225,15 @@ Tcl_Close(interp, chan)
* for this channel. */
EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of real IO channel. */
int result; /* Of calling FlushChannel. */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler *nhPtr;
if (chan == (Tcl_Channel) NULL) {
return TCL_OK;
}
-
+
/*
* Perform special handling for standard channels being closed. If the
* refCount is now 1 it means that the last reference to the standard
@@ -1934,8 +2244,15 @@ Tcl_Close(interp, chan)
CheckForStdChannelsBeingClosed(chan);
- chanPtr = (Channel *) chan;
- if (chanPtr->refCount > 0) {
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+ chanPtr = statePtr->topChanPtr;
+
+ if (statePtr->refCount > 0) {
panic("called Tcl_Close on channel with refCount > 0");
}
@@ -1944,9 +2261,9 @@ Tcl_Close(interp, chan)
* may be about to be invoked.
*/
- for (nhPtr = nestedHandlerPtr;
- nhPtr != (NextChannelHandler *) NULL;
- nhPtr = nhPtr->nestedHandlerPtr) {
+ for (nhPtr = tsdPtr->nestedHandlerPtr;
+ nhPtr != (NextChannelHandler *) NULL;
+ nhPtr = nhPtr->nestedHandlerPtr) {
if (nhPtr->nextHandlerPtr &&
(nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
nhPtr->nextHandlerPtr = NULL;
@@ -1957,21 +2274,20 @@ Tcl_Close(interp, chan)
* Remove all the channel handler records attached to the channel
* itself.
*/
-
- for (chPtr = chanPtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chNext) {
+
+ for (chPtr = statePtr->chPtr;
+ chPtr != (ChannelHandler *) NULL;
+ chPtr = chNext) {
chNext = chPtr->nextPtr;
ckfree((char *) chPtr);
}
- chanPtr->chPtr = (ChannelHandler *) NULL;
-
-
+ statePtr->chPtr = (ChannelHandler *) NULL;
+
/*
* Cancel any pending copy operation.
*/
- StopCopy(chanPtr->csPtr);
+ StopCopy(statePtr->csPtr);
/*
* Must set the interest mask now to 0, otherwise infinite loops
@@ -1980,28 +2296,28 @@ Tcl_Close(interp, chan)
* has a background flush active.
*/
- chanPtr->interestMask = 0;
+ statePtr->interestMask = 0;
/*
* Remove any EventScript records for this channel.
*/
- for (ePtr = chanPtr->scriptRecordPtr;
- ePtr != (EventScriptRecord *) NULL;
- ePtr = eNextPtr) {
+ for (ePtr = statePtr->scriptRecordPtr;
+ ePtr != (EventScriptRecord *) NULL;
+ ePtr = eNextPtr) {
eNextPtr = ePtr->nextPtr;
- ckfree(ePtr->script);
+ Tcl_DecrRefCount(ePtr->scriptPtr);
ckfree((char *) ePtr);
}
- chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+ statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
/*
* Invoke the registered close callbacks and delete their records.
*/
- while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
- cbPtr = chanPtr->closeCbPtr;
- chanPtr->closeCbPtr = cbPtr->nextPtr;
+ while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
+ cbPtr = statePtr->closeCbPtr;
+ statePtr->closeCbPtr = cbPtr->nextPtr;
(cbPtr->proc) (cbPtr->clientData);
ckfree((char *) cbPtr);
}
@@ -2010,9 +2326,21 @@ Tcl_Close(interp, chan)
* Ensure that the last output buffer will be flushed.
*/
- if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
- chanPtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= 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.
+ */
+
+ if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
+ result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
+ TCL_CLOSE_READ);
+ } else {
+ result = 0;
}
/*
@@ -2020,13 +2348,11 @@ Tcl_Close(interp, chan)
* the close function of the channel driver, or it will set up the
* channel to be flushed and closed asynchronously.
*/
-
- chanPtr->flags |= CHANNEL_CLOSED;
- result = FlushChannel(interp, chanPtr, 0);
- if (result != 0) {
+
+ statePtr->flags |= CHANNEL_CLOSED;
+ if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
return TCL_ERROR;
}
-
return TCL_OK;
}
@@ -2035,7 +2361,7 @@ Tcl_Close(interp, chan)
*
* Tcl_Write --
*
- * Puts a sequence of characters into an output buffer, may queue the
+ * Puts 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.
@@ -2052,61 +2378,37 @@ Tcl_Close(interp, chan)
*/
int
-Tcl_Write(chan, srcPtr, slen)
+Tcl_Write(chan, src, srcLen)
Tcl_Channel chan; /* The channel to buffer output for. */
- char *srcPtr; /* Output to buffer. */
- int slen; /* Its length. Negative means
- * the output is null terminated
- * and we must compute its length. */
+ char *src; /* Data to queue in output buffer. */
+ int srcLen; /* Length of data in bytes, or < 0 for
+ * strlen(). */
{
- Channel *chanPtr = (Channel *) chan;
-
/*
- * Check for unreported error.
+ * Always use the topmost channel of the stack
*/
+ Channel *chanPtr;
+ ChannelState *statePtr; /* state info for channel */
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
- }
-
- /*
- * If the channel is not open for writing punt.
- */
+ statePtr = ((Channel *) chan)->state;
+ chanPtr = statePtr->topChanPtr;
- if (!(chanPtr->flags & TCL_WRITABLE)) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
-
- /*
- * If the channel is in the middle of a background copy, fail.
- */
-
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
- /*
- * If length passed is negative, assume that the output is null terminated
- * and compute its length.
- */
-
- if (slen < 0) {
- slen = strlen(srcPtr);
+ if (srcLen < 0) {
+ srcLen = strlen(src);
}
-
- return DoWrite(chanPtr, srcPtr, slen);
+ return DoWrite(chanPtr, src, srcLen);
}
/*
*----------------------------------------------------------------------
*
- * DoWrite --
+ * Tcl_WriteRaw --
*
- * Puts a sequence of characters into an output buffer, may queue the
+ * Puts 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.
@@ -2122,906 +2424,931 @@ Tcl_Write(chan, srcPtr, slen)
*----------------------------------------------------------------------
*/
-static int
-DoWrite(chanPtr, srcPtr, slen)
- Channel *chanPtr; /* The channel to buffer output for. */
- char *srcPtr; /* Data to write. */
- int slen; /* Number of bytes to write. */
+int
+Tcl_WriteRaw(chan, src, srcLen)
+ Tcl_Channel chan; /* The channel to buffer output for. */
+ char *src; /* Data to queue in output buffer. */
+ int srcLen; /* Length of data in bytes, or < 0 for
+ * strlen(). */
{
- ChannelBuffer *outBufPtr; /* Current output buffer. */
- int foundNewline; /* Did we find a newline in output? */
- char *dPtr, *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? */
+ Channel *chanPtr = ((Channel *) chan);
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ int errorCode, written;
- /*
- * If we are in network (or windows) translation mode, record the fact
- * that we have not yet sent a CR to the channel.
- */
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
+ return -1;
+ }
+
+ if (srcLen < 0) {
+ srcLen = strlen(src);
+ }
- crsent = 0;
-
/*
- * Loop filling buffers and flushing them until all output has been
- * consumed.
+ * Go immediately to the driver, do all the error handling by ourselves.
+ * The code was stolen from 'FlushChannel'.
*/
- srcCopied = 0;
- totalDestCopied = 0;
-
- while (slen > 0) {
-
- /*
- * Make sure there is a current output buffer to accept output.
- */
-
- if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
- chanPtr->curOutPtr = (ChannelBuffer *) ckalloc((unsigned)
- (CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
- chanPtr->curOutPtr->nextAdded = 0;
- chanPtr->curOutPtr->nextRemoved = 0;
- chanPtr->curOutPtr->bufSize = chanPtr->bufSize;
- chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
- }
-
- outBufPtr = chanPtr->curOutPtr;
-
- destCopied = outBufPtr->bufSize - outBufPtr->nextAdded;
- if (destCopied > slen) {
- destCopied = slen;
- }
-
- destPtr = outBufPtr->buf + outBufPtr->nextAdded;
- switch (chanPtr->outputTranslation) {
- case TCL_TRANSLATE_LF:
- srcCopied = destCopied;
- memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
- break;
- case TCL_TRANSLATE_CR:
- srcCopied = destCopied;
- memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
- for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
- if (*dPtr == '\n') {
- *dPtr = '\r';
- }
- }
- break;
- case TCL_TRANSLATE_CRLF:
- for (srcCopied = 0, dPtr = destPtr, sPtr = srcPtr;
- 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:
- panic("Tcl_Write: AUTO output translation mode not supported");
- default:
- 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.
- */
+ written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
+ src, srcLen, &errorCode);
- outBufPtr->nextAdded += destCopied;
- if (!(chanPtr->flags & BUFFER_READY)) {
- if (outBufPtr->nextAdded == outBufPtr->bufSize) {
- chanPtr->flags |= BUFFER_READY;
- } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
- for (sPtr = srcPtr, i = 0, foundNewline = 0;
- (i < srcCopied) && (!foundNewline);
- i++, sPtr++) {
- if (*sPtr == '\n') {
- foundNewline = 1;
- break;
- }
- }
- if (foundNewline) {
- chanPtr->flags |= BUFFER_READY;
- }
- } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
- chanPtr->flags |= BUFFER_READY;
- }
- }
-
- totalDestCopied += srcCopied;
- srcPtr += srcCopied;
- slen -= srcCopied;
-
- if (chanPtr->flags & BUFFER_READY) {
- if (FlushChannel(NULL, chanPtr, 0) != 0) {
- return -1;
- }
- }
- } /* Closes "while" */
+ if (written < 0) {
+ Tcl_SetErrno(errorCode);
+ }
- return totalDestCopied;
+ return written;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_Flush --
+ * Tcl_WriteChars --
*
- * Flushes output data on a channel.
+ * 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.
*
* Results:
- * A standard Tcl result.
+ * The number of bytes written or -1 in case of error. If -1,
+ * Tcl_GetErrno will return the error code.
*
* Side effects:
- * May flush output queued on this channel.
+ * May buffer up output and may cause output to be produced on the
+ * channel.
*
*----------------------------------------------------------------------
*/
int
-Tcl_Flush(chan)
- Tcl_Channel chan; /* The Channel to flush. */
+Tcl_WriteChars(chan, src, len)
+ Tcl_Channel chan; /* 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(). */
{
- int result; /* Of calling FlushChannel. */
- Channel *chanPtr; /* The actual channel. */
-
- chanPtr = (Channel *) chan;
-
- /*
- * Check for unreported error.
- */
-
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return TCL_ERROR;
- }
-
/*
- * If the channel is not open for writing punt.
+ * Always use the topmost channel of the stack
*/
+ Channel *chanPtr;
+ ChannelState *statePtr; /* state info for channel */
- if (!(chanPtr->flags & TCL_WRITABLE)) {
- Tcl_SetErrno(EACCES);
- return TCL_ERROR;
- }
-
- /*
- * If the channel is in the middle of a background copy, fail.
- */
+ statePtr = ((Channel *) chan)->state;
+ chanPtr = statePtr->topChanPtr;
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
return -1;
}
-
- /*
- * Force current output buffer to be output also.
- */
-
- if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded > 0)) {
- chanPtr->flags |= BUFFER_READY;
- }
-
- result = FlushChannel(NULL, chanPtr, 0);
- if (result != 0) {
- return TCL_ERROR;
+ 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.
+ */
- return TCL_OK;
+ Tcl_Obj *objPtr;
+ int result;
+
+ objPtr = Tcl_NewStringObj(src, len);
+ src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
+ result = WriteBytes(chanPtr, src, len);
+ Tcl_DecrRefCount(objPtr);
+ return result;
+ }
+ return WriteChars(chanPtr, src, len);
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * DiscardInputQueued --
+ * Tcl_WriteObj --
*
- * Discards any input read from the channel but not yet consumed
- * by Tcl reading commands.
+ * Takes the Tcl object and queues its contents for output. If the
+ * encoding of the channel is NULL, takes the byte-array representation
+ * of the object and queues those bytes for output. Otherwise, takes
+ * the characters in the UTF-8 (string) representation of the object
+ * and converts them for output using the channel's current encoding.
+ * May flush internal buffers to output if one becomes full or is ready
+ * for some other reason, e.g. if it contains a newline and the channel
+ * is in line buffering mode.
*
* Results:
- * None.
+ * The number of bytes written or -1 in case of error. If -1,
+ * Tcl_GetErrno() will return the error code.
*
* Side effects:
- * May discard input from the channel. If discardLastBuffer is zero,
- * leaves one buffer in place for back-filling.
+ * May buffer up output and may cause output to be produced on the
+ * channel.
*
*----------------------------------------------------------------------
*/
-static void
-DiscardInputQueued(chanPtr, discardSavedBuffers)
- Channel *chanPtr; /* Channel on which to discard
- * the queued input. */
- int discardSavedBuffers; /* If non-zero, discard all buffers including
- * last one. */
+int
+Tcl_WriteObj(chan, objPtr)
+ Tcl_Channel chan; /* The channel to buffer output for. */
+ Tcl_Obj *objPtr; /* The object to write. */
{
- ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */
-
- bufPtr = chanPtr->inQueueHead;
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
- for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
- nxtPtr = bufPtr->nextPtr;
- RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
- }
-
/*
- * If discardSavedBuffers is nonzero, must also discard any previously
- * saved buffer in the saveInBufPtr field.
+ * Always use the topmost channel of the stack
*/
-
- if (discardSavedBuffers) {
- if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
- ckfree((char *) chanPtr->saveInBufPtr);
- chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
- }
+ Channel *chanPtr;
+ ChannelState *statePtr; /* state info for channel */
+ char *src;
+ int srcLen;
+
+ statePtr = ((Channel *) chan)->state;
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
+ return -1;
+ }
+ if (statePtr->encoding == NULL) {
+ src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
+ return WriteBytes(chanPtr, src, srcLen);
+ } else {
+ src = Tcl_GetStringFromObj(objPtr, &srcLen);
+ return WriteChars(chanPtr, src, srcLen);
}
}
/*
*----------------------------------------------------------------------
*
- * GetInput --
+ * WriteBytes --
*
- * Reads input data from a device or file into an input buffer.
+ * 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:
- * A Posix error code or 0.
+ * The number of bytes written or -1 in case of error. If -1,
+ * Tcl_GetErrno will return the error code.
*
* Side effects:
- * Reads from the underlying device.
+ * May buffer up output and may cause output to be produced on the
+ * channel.
*
*----------------------------------------------------------------------
*/
static int
-GetInput(chanPtr)
- Channel *chanPtr; /* Channel to read input from. */
+WriteBytes(chanPtr, src, srcLen)
+ Channel *chanPtr; /* The channel to buffer output for. */
+ CONST char *src; /* Bytes to write. */
+ int srcLen; /* Number of bytes to write. */
{
- int toRead; /* How much to read? */
- int result; /* Of calling driver. */
- int nread; /* How much was read from channel? */
- ChannelBuffer *bufPtr; /* New buffer to add to input queue. */
-
- /*
- * 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
- * interpreter.
- */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelBuffer *bufPtr;
+ char *dst;
+ int dstLen, dstMax, sawLF, savedLF, total, toWrite;
- if (CheckForDeadChannel(NULL,chanPtr)) return EINVAL;
+ total = 0;
+ sawLF = 0;
+ savedLF = 0;
/*
- * See if we can fill an existing buffer. If we can, read only
- * as much as will fit in it. Otherwise allocate a new buffer,
- * add it to the input queue and attempt to fill it to the max.
+ * Loop over all bytes in src, storing them in output buffer with
+ * proper EOL translation.
*/
- if ((chanPtr->inQueueTail != (ChannelBuffer *) NULL) &&
- (chanPtr->inQueueTail->nextAdded < chanPtr->inQueueTail->bufSize)) {
- bufPtr = chanPtr->inQueueTail;
- toRead = bufPtr->bufSize - bufPtr->nextAdded;
- } else {
- if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
- bufPtr = chanPtr->saveInBufPtr;
- chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
- } else {
- bufPtr = (ChannelBuffer *) ckalloc(
- ((unsigned) CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
- bufPtr->bufSize = chanPtr->bufSize;
+ while (srcLen + savedLF > 0) {
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ statePtr->curOutPtr = bufPtr;
}
- bufPtr->nextRemoved = 0;
- bufPtr->nextAdded = 0;
- toRead = bufPtr->bufSize;
- if (chanPtr->inQueueTail == (ChannelBuffer *) NULL) {
- chanPtr->inQueueHead = bufPtr;
- } else {
- chanPtr->inQueueTail->nextPtr = bufPtr;
- }
- chanPtr->inQueueTail = bufPtr;
- bufPtr->nextPtr = (ChannelBuffer *) NULL;
- }
-
- /*
- * If EOF is set, we should avoid calling the driver because on some
- * platforms it is impossible to read from a device after EOF.
- */
+ dst = bufPtr->buf + bufPtr->nextAdded;
+ dstMax = bufPtr->bufLength - bufPtr->nextAdded;
+ dstLen = dstMax;
- if (chanPtr->flags & CHANNEL_EOF) {
- return 0;
- }
+ toWrite = dstLen;
+ if (toWrite > srcLen) {
+ toWrite = srcLen;
+ }
- nread = (chanPtr->typePtr->inputProc) (chanPtr->instanceData,
- bufPtr->buf + bufPtr->nextAdded, toRead, &result);
+ 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.
+ */
- if (nread == 0) {
- chanPtr->flags |= CHANNEL_EOF;
- } else if (nread < 0) {
- if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- chanPtr->flags |= CHANNEL_BLOCKED;
- result = EAGAIN;
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
- Tcl_SetErrno(result);
- } else {
- panic("Blocking channel driver did not block on input");
- }
- } else {
- Tcl_SetErrno(result);
+ *dst++ = '\n';
+ dstLen--;
+ sawLF++;
}
- return result;
- } else {
- bufPtr->nextAdded += nread;
+ sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite);
+ dstLen += savedLF;
+ savedLF = 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 < toRead) {
- chanPtr->flags |= CHANNEL_BLOCKED;
+ if (dstLen > dstMax) {
+ savedLF = 1;
+ dstLen = dstMax;
+ }
+ bufPtr->nextAdded += dstLen;
+ if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
+ return -1;
}
+ total += dstLen;
+ src += toWrite;
+ srcLen -= toWrite;
+ sawLF = 0;
}
- return 0;
+ return total;
}
/*
*----------------------------------------------------------------------
*
- * CopyAndTranslateBuffer --
+ * WriteChars --
*
- * Copy at most one buffer of input to the result space, doing
- * eol translations according to mode in effect currently.
+ * Convert UTF-8 bytes to the channel's external encoding and
+ * write the 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.
*
* Results:
- * Number of characters (as opposed to bytes) copied. May return
- * zero if no input is available to be translated.
+ * The number of bytes written or -1 in case of error. If -1,
+ * Tcl_GetErrno will return the error code.
*
* Side effects:
- * Consumes buffered input. May deallocate one buffer.
+ * May buffer up output and may cause output to be produced on the
+ * channel.
*
*----------------------------------------------------------------------
*/
static int
-CopyAndTranslateBuffer(chanPtr, result, space)
- Channel *chanPtr; /* The 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? */
+WriteChars(chanPtr, src, srcLen)
+ 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 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? */
- ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
- char curByte; /* The byte we are currently translating. */
- int i; /* Iterates over the copied input looking
- * for the input eofChar. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelBuffer *bufPtr;
+ char *dst, *stage;
+ int saved, savedLF, sawLF, total, toWrite, flags;
+ int dstWrote, dstLen, stageLen, stageMax, stageRead;
+ Tcl_Encoding encoding;
+ char safe[BUFFER_PADDING];
+ total = 0;
+ sawLF = 0;
+ savedLF = 0;
+ saved = 0;
+ encoding = statePtr->encoding;
+
/*
- * 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.
+ * Loop over all UTF-8 characters in src, storing them in staging buffer
+ * with proper EOL translation.
*/
-
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
- return 0;
- }
- bufPtr = chanPtr->inQueueHead;
- bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- copied = 0;
- switch (chanPtr->inputTranslation) {
- case TCL_TRANSLATE_LF:
- if (space == 0) {
- return 0;
- }
-
- /*
- * Copy the current chunk into the result buffer.
- */
-
- memcpy((VOID *) result,
- (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
- (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
- break;
-
- case TCL_TRANSLATE_CR:
+ while (srcLen + savedLF > 0) {
+ stage = statePtr->outputStage;
+ stageMax = statePtr->bufSize;
+ stageLen = stageMax;
- if (space == 0) {
- return 0;
- }
+ toWrite = stageLen;
+ if (toWrite > srcLen) {
+ toWrite = srcLen;
+ }
+ if (savedLF) {
/*
- * Copy the current chunk into the result buffer, then
- * replace all \r with \n.
- */
-
- memcpy((VOID *) result,
- (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
- (size_t) space);
- bufPtr->nextRemoved += space;
- for (copied = 0; copied < space; copied++) {
- if (result[copied] == '\r') {
- result[copied] = '\n';
- }
- }
- break;
-
- case TCL_TRANSLATE_CRLF:
-
- /*
- * If there is a held-back "\r" at EOF, produce it now.
- */
-
- if (space == 0) {
- if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
- (INPUT_SAW_CR | CHANNEL_EOF)) {
- result[0] = '\r';
- chanPtr->flags &= (~(INPUT_SAW_CR));
- return 1;
- }
- return 0;
- }
+ * A '\n' was left over from last call to TranslateOutputEOL()
+ * and we need to store it in the staging buffer. If the
+ * channel is line-based, we will need to flush the output
+ * buffer (after translating the staging buffer).
+ */
+
+ *stage++ = '\n';
+ stageLen--;
+ sawLF++;
+ }
+ sawLF += TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite);
- /*
- * Copy the current chunk and replace "\r\n" with "\n"
- * (but not standalone "\r"!).
- */
+ stage -= savedLF;
+ stageLen += savedLF;
+ savedLF = 0;
- for (copied = 0;
- (copied < space) &&
- (bufPtr->nextRemoved < bufPtr->nextAdded);
- copied++) {
- curByte = bufPtr->buf[bufPtr->nextRemoved];
- bufPtr->nextRemoved++;
- if (curByte == '\r') {
- if (chanPtr->flags & INPUT_SAW_CR) {
- result[copied] = '\r';
- } else {
- chanPtr->flags |= INPUT_SAW_CR;
- copied--;
- }
- } else if (curByte == '\n') {
- chanPtr->flags &= (~(INPUT_SAW_CR));
- result[copied] = '\n';
- } else {
- if (chanPtr->flags & INPUT_SAW_CR) {
- chanPtr->flags &= (~(INPUT_SAW_CR));
- result[copied] = '\r';
- bufPtr->nextRemoved--;
- } else {
- result[copied] = curByte;
- }
- }
- }
- break;
-
- case TCL_TRANSLATE_AUTO:
-
- if (space == 0) {
- return 0;
- }
+ if (stageLen > stageMax) {
+ savedLF = 1;
+ stageLen = stageMax;
+ }
+ src += toWrite;
+ srcLen -= toWrite;
- /*
- * Loop over the current buffer, converting "\r" and "\r\n"
- * to "\n".
- */
+ flags = statePtr->outputEncodingFlags;
+ if (srcLen == 0) {
+ flags |= TCL_ENCODING_END;
+ }
- for (copied = 0;
- (copied < space) &&
- (bufPtr->nextRemoved < bufPtr->nextAdded); ) {
- curByte = bufPtr->buf[bufPtr->nextRemoved];
- bufPtr->nextRemoved++;
- if (curByte == '\r') {
- result[copied] = '\n';
- copied++;
- if (bufPtr->nextRemoved < bufPtr->nextAdded) {
- if (bufPtr->buf[bufPtr->nextRemoved] == '\n') {
- bufPtr->nextRemoved++;
- }
- chanPtr->flags &= (~(INPUT_SAW_CR));
- } else {
- chanPtr->flags |= INPUT_SAW_CR;
- }
- } else {
- if (curByte == '\n') {
- if (!(chanPtr->flags & INPUT_SAW_CR)) {
- result[copied] = '\n';
- copied++;
- }
- } else {
- result[copied] = curByte;
- copied++;
- }
- chanPtr->flags &= (~(INPUT_SAW_CR));
- }
- }
- break;
+ /*
+ * Loop over all UTF-8 characters in staging buffer, converting them
+ * to external encoding, storing them in output buffer.
+ */
- default:
- panic("unknown eol translation mode");
- }
+ while (stageLen + saved > 0) {
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ statePtr->curOutPtr = bufPtr;
+ }
+ dst = bufPtr->buf + bufPtr->nextAdded;
+ dstLen = bufPtr->bufLength - bufPtr->nextAdded;
- /*
- * 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.
- */
-
- if (chanPtr->inEofChar != 0) {
- for (i = 0; i < copied; i++) {
- if (result[i] == (char) chanPtr->inEofChar) {
- break;
- }
- }
- if (i < copied) {
+ 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((VOID *) dst, (VOID *) safe, (size_t) saved);
+ bufPtr->nextAdded += saved;
+ dst += saved;
+ dstLen -= saved;
+ saved = 0;
+ }
- /*
- * Set sticky EOF so that no further input is presented
- * to the caller.
- */
-
- chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
+ if (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.
+ */
- /*
- * Reset the start of valid data in the input buffer to the
- * position of the eofChar, so that subsequent reads will
- * encounter it immediately. First we set it to the position
- * of the last byte consumed if all result bytes were the
- * product of one input byte; since it is possible that "\r\n"
- * contracted to "\n" in the result, we have to search back
- * from that position until we find the eofChar, because it
- * is possible that its actual position in the buffer is n
- * bytes further back (n is the number of "\r\n" sequences
- * that were contracted to "\n" in the result).
- */
-
- bufPtr->nextRemoved -= (copied - i);
- while ((bufPtr->nextRemoved > 0) &&
- (bufPtr->buf[bufPtr->nextRemoved] !=
- (char) chanPtr->inEofChar)) {
- bufPtr->nextRemoved--;
- }
- copied = i;
- }
- }
+ src -= stageLen;
+ srcLen += stageLen;
+ stageLen = 0;
+ savedLF = 0;
+ break;
+ }
+ bufPtr->nextAdded += dstWrote;
+ if (bufPtr->nextAdded > bufPtr->bufLength) {
+ /*
+ * 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 the current buffer is empty recycle it.
- */
+ saved = bufPtr->nextAdded - bufPtr->bufLength;
+ memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
+ bufPtr->nextAdded = bufPtr->bufLength;
+ }
+ if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
+ return -1;
+ }
- if (bufPtr->nextRemoved == bufPtr->nextAdded) {
- chanPtr->inQueueHead = bufPtr->nextPtr;
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
- }
- RecycleBuffer(chanPtr, bufPtr, 0);
+ total += dstWrote;
+ stage += stageRead;
+ stageLen -= stageRead;
+ sawLF = 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;
+ 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.
*
- * ScanBufferForEOL --
+ * EOL translation stops either when the source buffer is empty
+ * or the output buffer is full.
*
- * Scans one buffer for EOL according to the specified EOL
- * translation mode. If it sees the input eofChar for the channel
- * it stops also.
+ * 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:
- * TRUE if EOL is found, FALSE otherwise. Also sets output parameter
- * bytesToEOLPtr to the number of bytes so far to EOL, and crSeenPtr
- * to whether a "\r" was seen.
+ * 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:
- * None.
+ * 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
-ScanBufferForEOL(chanPtr, bufPtr, translation, eofChar, bytesToEOLPtr,
- crSeenPtr)
- Channel *chanPtr;
- ChannelBuffer *bufPtr; /* Buffer to scan for EOL. */
- Tcl_EolTranslation translation; /* Translation mode to use. */
- int eofChar; /* EOF char to look for. */
- int *bytesToEOLPtr; /* Running counter. */
- int *crSeenPtr; /* Has "\r" been seen? */
+TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr)
+ 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 *rPtr; /* Iterates over input string. */
- char *sPtr; /* Where to stop search? */
- int EOLFound;
- int bytesToEOL;
+ char *dstEnd;
+ int srcLen, newlineFound;
- for (EOLFound = 0, rPtr = bufPtr->buf + bufPtr->nextRemoved,
- sPtr = bufPtr->buf + bufPtr->nextAdded,
- bytesToEOL = *bytesToEOLPtr;
- (!EOLFound) && (rPtr < sPtr);
- rPtr++) {
- switch (translation) {
- case TCL_TRANSLATE_AUTO:
- if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
- chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
- EOLFound = 1;
- } else if (*rPtr == '\n') {
-
- /*
- * CopyAndTranslateBuffer wants to know the length
- * of the result, not the input. The input is one
- * larger because "\r\n" shrinks to "\n".
- */
-
- if (!(*crSeenPtr)) {
- bytesToEOL++;
- EOLFound = 1;
- } else {
+ newlineFound = 0;
+ srcLen = *srcLenPtr;
+
+ switch (statePtr->outputTranslation) {
+ case TCL_TRANSLATE_LF: {
+ for (dstEnd = dst + srcLen; dst < dstEnd; ) {
+ if (*src == '\n') {
+ newlineFound = 1;
+ }
+ *dst++ = *src++;
+ }
+ *dstLenPtr = srcLen;
+ break;
+ }
+ case TCL_TRANSLATE_CR: {
+ for (dstEnd = dst + srcLen; dst < dstEnd;) {
+ if (*src == '\n') {
+ *dst++ = '\r';
+ newlineFound = 1;
+ src++;
+ } else {
+ *dst++ = *src++;
+ }
+ }
+ *dstLenPtr = srcLen;
+ break;
+ }
+ case TCL_TRANSLATE_CRLF: {
+ /*
+ * Since this causes the number of bytes to grow, we
+ * start off trying to put 'srcLen' bytes into the
+ * output buffer, but allow it to store more bytes, as
+ * long as there's still source bytes and room in the
+ * output buffer.
+ */
- /*
- * This is a lf at the begining of a buffer
- * where the previous buffer ended in a cr.
- * Consume this lf because we've already emitted
- * the newline for this crlf sequence. ALSO, if
- * bytesToEOL is 0 (which means that we are at the
- * first character of the scan), unset the
- * INPUT_SAW_CR flag in the channel, because we
- * already handled it; leaving it set would cause
- * CopyAndTranslateBuffer to potentially consume
- * another lf if one follows the current byte.
- */
+ char *dstStart, *dstMax;
+ CONST char *srcStart;
+
+ dstStart = dst;
+ dstMax = dst + *dstLenPtr;
- bufPtr->nextRemoved++;
- *crSeenPtr = 0;
- chanPtr->flags &= (~(INPUT_SAW_CR));
+ srcStart = src;
+
+ if (srcLen < *dstLenPtr) {
+ dstEnd = dst + srcLen;
+ } else {
+ dstEnd = dst + *dstLenPtr;
+ }
+ while (dst < dstEnd) {
+ if (*src == '\n') {
+ if (dstEnd < dstMax) {
+ dstEnd++;
}
- } else if (*rPtr == '\r') {
- bytesToEOL++;
- EOLFound = 1;
- } else {
- *crSeenPtr = 0;
- bytesToEOL++;
- }
- break;
- case TCL_TRANSLATE_LF:
- if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
- chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
- EOLFound = 1;
- } else {
- if (*rPtr == '\n') {
- EOLFound = 1;
- }
- bytesToEOL++;
- }
- break;
- case TCL_TRANSLATE_CR:
- if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
- chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
- EOLFound = 1;
- } else {
- if (*rPtr == '\r') {
- EOLFound = 1;
- }
- bytesToEOL++;
- }
- break;
- case TCL_TRANSLATE_CRLF:
- if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
- chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
- EOLFound = 1;
- } else if (*rPtr == '\n') {
-
- /*
- * CopyAndTranslateBuffer wants to know the length
- * of the result, not the input. The input is one
- * larger because crlf shrinks to lf.
- */
-
- if (*crSeenPtr) {
- EOLFound = 1;
- } else {
- bytesToEOL++;
- }
- } else {
- if (*rPtr == '\r') {
- *crSeenPtr = 1;
- } else {
- *crSeenPtr = 0;
- }
- bytesToEOL++;
- }
- break;
- default:
- panic("unknown eol translation mode");
- }
+ *dst++ = '\r';
+ newlineFound = 1;
+ }
+ *dst++ = *src++;
+ }
+ *srcLenPtr = src - srcStart;
+ *dstLenPtr = dst - dstStart;
+ break;
+ }
+ default: {
+ break;
+ }
}
-
- *bytesToEOLPtr = bytesToEOL;
- return EOLFound;
+ return newlineFound;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * ScanInputForEOL --
+ * CheckFlush --
*
- * Scans queued input for chanPtr for an end of line (according to the
- * current EOL translation mode) and returns the number of bytes
- * upto and including the end of line, or -1 if none was found.
+ * Helper function for WriteBytes() and WriteChars(). If the
+ * channel buffer is ready to be flushed, flush it.
*
* Results:
- * Count of bytes upto and including the end of line if one is present
- * or -1 if none was found. Also returns in an output parameter the
- * number of bytes queued if no end of line was found.
+ * The return value is -1 if there was a problem flushing the
+ * channel buffer, or 0 otherwise.
*
* Side effects:
- * None.
+ * The buffer will be recycled if it is flushed.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
static int
-ScanInputForEOL(chanPtr, bytesQueuedPtr)
- Channel *chanPtr; /* Channel for which to scan queued
- * input for end of line. */
- int *bytesQueuedPtr; /* Where to store the number of bytes
- * currently queued if no end of line
- * was found. */
+CheckFlush(chanPtr, bufPtr, newlineFlag)
+ 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. */
{
- ChannelBuffer *bufPtr; /* Iterates over queued buffers. */
- int bytesToEOL; /* How many bytes to end of line? */
- int EOLFound; /* Did we find an end of line? */
- int crSeen; /* Did we see a "\r" in CRLF mode? */
-
- *bytesQueuedPtr = 0;
- bytesToEOL = 0;
- EOLFound = 0;
- for (bufPtr = chanPtr->inQueueHead,
- crSeen = (chanPtr->flags & INPUT_SAW_CR) ? 1 : 0;
- (!EOLFound) && (bufPtr != (ChannelBuffer *) NULL);
- bufPtr = bufPtr->nextPtr) {
- EOLFound = ScanBufferForEOL(chanPtr, bufPtr, chanPtr->inputTranslation,
- chanPtr->inEofChar, &bytesToEOL, &crSeen);
- }
-
- if (EOLFound == 0) {
- *bytesQueuedPtr = bytesToEOL;
- return -1;
+ 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 ((statePtr->flags & BUFFER_READY) == 0) {
+ if (bufPtr->nextAdded == bufPtr->bufLength) {
+ statePtr->flags |= BUFFER_READY;
+ } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
+ if (newlineFlag != 0) {
+ statePtr->flags |= BUFFER_READY;
+ }
+ } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+ statePtr->flags |= BUFFER_READY;
+ }
+ }
+ if (statePtr->flags & BUFFER_READY) {
+ if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ return -1;
+ }
}
- return bytesToEOL;
+ return 0;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * GetEOL --
+ * Tcl_Gets --
*
- * Accumulate input into the channel input buffer queue until an
- * end of line has been seen.
+ * Reads a complete line of input from the channel into a Tcl_DString.
*
* Results:
- * Number of bytes buffered (at least 1) or -1 on failure.
+ * Length of line read (in characters) or -1 if error, EOF, or blocked.
+ * If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the
+ * error or condition that occurred.
+ *
+ * Side effects:
+ * May flush output on the channel. May cause input to be consumed
+ * from the channel.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_Gets(chan, lineRead)
+ Tcl_Channel chan; /* Channel from which to read. */
+ Tcl_DString *lineRead; /* The line read will be appended to this
+ * DString as UTF-8 characters. The caller
+ * must have initialized it and is responsible
+ * for managing the storage. */
+{
+ Tcl_Obj *objPtr;
+ int charsStored, length;
+ char *string;
+
+ objPtr = Tcl_NewObj();
+ charsStored = Tcl_GetsObj(chan, objPtr);
+ if (charsStored > 0) {
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_DStringAppend(lineRead, string, length);
+ }
+ Tcl_DecrRefCount(objPtr);
+ return charsStored;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_GetsObj --
+ *
+ * Accumulate input from the input channel until end-of-line or
+ * end-of-file has been seen. Bytes read from the input channel
+ * are converted to UTF-8 using the encoding specified by 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 code for the error or condition that occurred.
*
* Side effects:
* Consumes input from the channel.
*
- *----------------------------------------------------------------------
+ * On reading EOF, leave channel pointing at EOF char.
+ * On reading EOL, leave channel pointing after EOL, but don't
+ * return EOL in dst buffer.
+ *
+ *---------------------------------------------------------------------------
*/
-static int
-GetEOL(chanPtr)
- Channel *chanPtr; /* Channel to queue input on. */
+int
+Tcl_GetsObj(chan, objPtr)
+ Tcl_Channel chan; /* Channel from which to read. */
+ Tcl_Obj *objPtr; /* The line read will be appended to this
+ * object as UTF-8 characters. */
{
- int bytesToEOL; /* How many bytes in buffer up to and
- * including the end of line? */
- int bytesQueued; /* How many bytes are queued currently
- * in the input chain of the channel? */
+ GetsState gs;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelBuffer *bufPtr;
+ int inEofChar, skip, copiedTotal;
+ Tcl_Encoding encoding;
+ char *dst, *dstEnd, *eol, *eof;
+ Tcl_EncodingState oldState;
+ int oldLength, oldFlags, oldRemoved;
/*
- * Check for unreported error.
+ * This operation should occur at the top of a channel stack.
*/
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
+ copiedTotal = -1;
+ goto done;
}
+ bufPtr = statePtr->inQueueHead;
+ encoding = statePtr->encoding;
+
/*
- * Punt if the channel is not opened for reading.
+ * Preserved so we can restore the channel's state in case we don't
+ * find a newline in the available input.
*/
- if (!(chanPtr->flags & TCL_READABLE)) {
- Tcl_SetErrno(EACCES);
- return -1;
+ Tcl_GetStringFromObj(objPtr, &oldLength);
+ oldFlags = statePtr->inputEncodingFlags;
+ oldState = statePtr->inputEncodingState;
+ oldRemoved = BUFFER_PADDING;
+ if (bufPtr != NULL) {
+ oldRemoved = bufPtr->nextRemoved;
}
/*
- * If the channel is in the middle of a background copy, fail.
+ * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
+ * produce ByteArray objects. To avoid circularity problems,
+ * "iso8859-1" is builtin to Tcl.
*/
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
- return -1;
+ if (encoding == NULL) {
+ encoding = Tcl_GetEncoding(NULL, "iso8859-1");
}
/*
- * 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.
+ * Object used by FilterInputBytes to keep track of how much data has
+ * been consumed from the channel buffers.
*/
-
- if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
- chanPtr->flags &= (~(CHANNEL_EOF));
- }
- chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_GETS_BLOCKED));
+
+ gs.objPtr = objPtr;
+ gs.dstPtr = &dst;
+ gs.encoding = encoding;
+ gs.bufPtr = bufPtr;
+ gs.state = oldState;
+ gs.rawRead = 0;
+ gs.bytesWrote = 0;
+ gs.charsWrote = 0;
+ gs.totalChars = 0;
+
+ dst = objPtr->bytes + oldLength;
+ dstEnd = dst;
+
+ skip = 0;
+ eof = NULL;
+ inEofChar = statePtr->inEofChar;
while (1) {
- bytesToEOL = ScanInputForEOL(chanPtr, &bytesQueued);
- if (bytesToEOL > 0) {
- chanPtr->flags &= (~(CHANNEL_BLOCKED));
- return bytesToEOL;
- }
- if (chanPtr->flags & CHANNEL_EOF) {
+ if (dst >= dstEnd) {
+ if (FilterInputBytes(chanPtr, &gs) != 0) {
+ goto restore;
+ }
+ dstEnd = dst + gs.bytesWrote;
+ }
+
+ /*
+ * Remember if EOF char is seen, then look for EOL anyhow, because
+ * the EOL might be before the EOF char.
+ */
+
+ if (inEofChar != '\0') {
+ for (eol = dst; eol < dstEnd; eol++) {
+ if (*eol == inEofChar) {
+ dstEnd = eol;
+ eof = eol;
+ break;
+ }
+ }
+ }
+
+ /*
+ * On EOL, leave current file position pointing after the EOL, but
+ * don't store the EOL in the output string.
+ */
+
+ eol = dst;
+ switch (statePtr->inputTranslation) {
+ case TCL_TRANSLATE_LF: {
+ for (eol = dst; eol < dstEnd; eol++) {
+ if (*eol == '\n') {
+ skip = 1;
+ goto goteol;
+ }
+ }
+ break;
+ }
+ case TCL_TRANSLATE_CR: {
+ for (eol = dst; eol < dstEnd; eol++) {
+ if (*eol == '\r') {
+ skip = 1;
+ goto goteol;
+ }
+ }
+ break;
+ }
+ case TCL_TRANSLATE_CRLF: {
+ for (eol = dst; eol < dstEnd; eol++) {
+ if (*eol == '\r') {
+ eol++;
+ if (eol >= dstEnd) {
+ int offset;
+
+ offset = eol - objPtr->bytes;
+ dst = dstEnd;
+ if (FilterInputBytes(chanPtr, &gs) != 0) {
+ goto restore;
+ }
+ dstEnd = dst + gs.bytesWrote;
+ eol = objPtr->bytes + offset;
+ if (eol >= dstEnd) {
+ skip = 0;
+ goto goteol;
+ }
+ }
+ if (*eol == '\n') {
+ eol--;
+ skip = 2;
+ goto goteol;
+ }
+ }
+ }
+ break;
+ }
+ case TCL_TRANSLATE_AUTO: {
+ skip = 1;
+ if (statePtr->flags & INPUT_SAW_CR) {
+ statePtr->flags &= ~INPUT_SAW_CR;
+ if (*eol == '\n') {
+ /*
+ * Skip the raw bytes that make up the '\n'.
+ */
+
+ char tmp[1 + TCL_UTF_MAX];
+ int rawRead;
+
+ bufPtr = gs.bufPtr;
+ Tcl_ExternalToUtf(NULL, gs.encoding,
+ bufPtr->buf + bufPtr->nextRemoved,
+ gs.rawRead, statePtr->inputEncodingFlags,
+ &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
+ NULL, NULL);
+ bufPtr->nextRemoved += rawRead;
+ gs.rawRead -= rawRead;
+ gs.bytesWrote--;
+ gs.charsWrote--;
+ memmove(dst, dst + 1, (size_t) (dstEnd - dst));
+ dstEnd--;
+ }
+ }
+ for (eol = dst; eol < dstEnd; eol++) {
+ if (*eol == '\r') {
+ eol++;
+ if (eol == dstEnd) {
+ /*
+ * If buffer ended on \r, peek ahead to see if a
+ * \n is available.
+ */
+
+ int offset;
+
+ offset = eol - objPtr->bytes;
+ dst = dstEnd;
+ PeekAhead(chanPtr, &dstEnd, &gs);
+ eol = objPtr->bytes + offset;
+ if (eol >= dstEnd) {
+ eol--;
+ statePtr->flags |= INPUT_SAW_CR;
+ goto goteol;
+ }
+ }
+ if (*eol == '\n') {
+ skip++;
+ }
+ eol--;
+ goto goteol;
+ } else if (*eol == '\n') {
+ goto goteol;
+ }
+ }
+ }
+ }
+ if (eof != NULL) {
/*
- * Boundary case where cr was at the end of the previous buffer
- * and this buffer just has a newline. At EOF our caller wants
- * to see -1 for the line length.
+ * EOF character was seen. On EOF, leave current file position
+ * pointing at the EOF character, but don't store the EOF
+ * character in the output string.
*/
- return (bytesQueued == 0) ? -1 : bytesQueued ;
- }
- if (chanPtr->flags & CHANNEL_BLOCKED) {
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
- goto blocked;
- }
- chanPtr->flags &= (~(CHANNEL_BLOCKED));
- }
- if (GetInput(chanPtr) != 0) {
- goto blocked;
- }
+
+ dstEnd = eof;
+ statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ }
+ if (statePtr->flags & CHANNEL_EOF) {
+ skip = 0;
+ eol = dstEnd;
+ if (eol == objPtr->bytes) {
+ /*
+ * If we didn't produce any bytes before encountering EOF,
+ * caller needs to see -1.
+ */
+
+ Tcl_SetObjLength(objPtr, 0);
+ CommonGetsCleanup(chanPtr, encoding);
+ copiedTotal = -1;
+ goto done;
+ }
+ goto goteol;
+ }
+ dst = dstEnd;
+ }
+
+ /*
+ * Found EOL or EOF, but the output buffer may now contain too many
+ * UTF-8 characters. We need to know how many raw bytes correspond to
+ * the number of UTF-8 characters we want, plus how many raw bytes
+ * correspond to the character(s) making up EOL (if any), so we can
+ * remove the correct number of bytes from the channel buffer.
+ */
+
+ goteol:
+ bufPtr = gs.bufPtr;
+ statePtr->inputEncodingState = gs.state;
+ Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
+ gs.rawRead, statePtr->inputEncodingFlags,
+ &statePtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
+ &gs.rawRead, NULL, &gs.charsWrote);
+ bufPtr->nextRemoved += gs.rawRead;
+
+ /*
+ * Recycle all the emptied buffers.
+ */
+
+ Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
+ CommonGetsCleanup(chanPtr, encoding);
+ statePtr->flags &= ~CHANNEL_BLOCKED;
+ copiedTotal = gs.totalChars + gs.charsWrote - skip;
+ goto done;
+
+ /*
+ * Couldn't get a complete line. This only happens if we get a error
+ * reading from the channel or we are non-blocking and there wasn't
+ * an EOL or EOF in the data available.
+ */
+
+ restore:
+ bufPtr = statePtr->inQueueHead;
+ bufPtr->nextRemoved = oldRemoved;
+
+ for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ bufPtr->nextRemoved = BUFFER_PADDING;
}
+ CommonGetsCleanup(chanPtr, encoding);
- blocked:
+ statePtr->inputEncodingState = oldState;
+ statePtr->inputEncodingFlags = oldFlags;
+ Tcl_SetObjLength(objPtr, oldLength);
/*
* We didn't get a complete line so we need to indicate to UpdateInterest
@@ -3034,77 +3361,396 @@ GetEOL(chanPtr)
* though a read would be able to consume the buffered data.
*/
- chanPtr->flags |= CHANNEL_GETS_BLOCKED;
- return -1;
+ statePtr->flags |= CHANNEL_NEED_MORE_DATA;
+ copiedTotal = -1;
+
+ done:
+ /*
+ * Update the notifier state so we don't block while there is still
+ * data in the buffers.
+ */
+
+ UpdateInterest(chanPtr);
+ return copiedTotal;
}
-
+
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_Read --
+ * FilterInputBytes --
+ *
+ * Helper function for Tcl_GetsObj. Produces UTF-8 characters from
+ * raw bytes read from the channel.
*
- * Reads a given number of characters from a channel.
+ * Consumes available bytes from channel buffers. When channel
+ * buffers are exhausted, reads more bytes from channel device into
+ * a new channel buffer. It is the caller's responsibility to
+ * free the channel buffers that have been exhausted.
*
* Results:
- * The number of characters read, or -1 on error. Use Tcl_GetErrno()
- * to retrieve the error code for the error that occurred.
+ * The return value is -1 if there was an error reading from the
+ * channel, 0 otherwise.
*
* Side effects:
- * May cause input to be buffered.
+ * Status object keeps track of how much data from channel buffers
+ * has been consumed and where UTF-8 bytes should be stored.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-
-int
-Tcl_Read(chan, bufPtr, toRead)
- Tcl_Channel chan; /* The channel from which to read. */
- char *bufPtr; /* Where to store input read. */
- int toRead; /* Maximum number of characters to read. */
+
+static int
+FilterInputBytes(chanPtr, gsPtr)
+ Channel *chanPtr; /* Channel to read. */
+ GetsState *gsPtr; /* Current state of gets operation. */
{
- Channel *chanPtr; /* The real IO channel. */
-
- chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelBuffer *bufPtr;
+ char *raw, *rawStart, *rawEnd;
+ char *dst;
+ int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
+ Tcl_Obj *objPtr;
+#define ENCODING_LINESIZE 30 /* Lower bound on how many bytes to convert
+ * at a time. Since we don't know a priori
+ * how many bytes of storage this many source
+ * bytes will use, we actually need at least
+ * ENCODING_LINESIZE * TCL_MAX_UTF bytes of
+ * room. */
+
+ objPtr = gsPtr->objPtr;
/*
- * Check for unreported error.
+ * Subtract the number of bytes that were removed from channel buffer
+ * during last call.
*/
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
+ bufPtr = gsPtr->bufPtr;
+ if (bufPtr != NULL) {
+ bufPtr->nextRemoved += gsPtr->rawRead;
+ if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
+ bufPtr = bufPtr->nextPtr;
+ }
+ }
+ gsPtr->totalChars += gsPtr->charsWrote;
+
+ if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
+ /*
+ * All channel buffers were exhausted and the caller still hasn't
+ * seen EOL. Need to read more bytes from the channel device.
+ * Side effect is to allocate another channel buffer.
+ */
+
+ read:
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
+ statePtr->flags &= ~CHANNEL_BLOCKED;
+ }
+ if (GetInput(chanPtr) != 0) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
+ bufPtr = statePtr->inQueueTail;
+ gsPtr->bufPtr = bufPtr;
}
/*
- * Punt if the channel is not opened for reading.
+ * Convert some of the bytes from the channel buffer to UTF-8. Space in
+ * objPtr's string rep is used to hold the UTF-8 characters. Grow the
+ * string rep if we need more space.
*/
- if (!(chanPtr->flags & TCL_READABLE)) {
- Tcl_SetErrno(EACCES);
- return -1;
+ rawStart = bufPtr->buf + bufPtr->nextRemoved;
+ raw = rawStart;
+ rawEnd = bufPtr->buf + bufPtr->nextAdded;
+ rawLen = rawEnd - rawStart;
+
+ dst = *gsPtr->dstPtr;
+ offset = dst - objPtr->bytes;
+ toRead = ENCODING_LINESIZE;
+ if (toRead > rawLen) {
+ toRead = rawLen;
+ }
+ dstNeeded = toRead * TCL_UTF_MAX + 1;
+ spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
+ if (dstNeeded > spaceLeft) {
+ length = offset * 2;
+ if (offset < dstNeeded) {
+ length = offset + dstNeeded;
+ }
+ length += TCL_UTF_MAX + 1;
+ Tcl_SetObjLength(objPtr, length);
+ spaceLeft = length - offset;
+ dst = objPtr->bytes + offset;
+ *gsPtr->dstPtr = dst;
+ }
+ gsPtr->state = statePtr->inputEncodingState;
+ result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
+ statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
+ dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
+ &gsPtr->charsWrote);
+ if (result == TCL_CONVERT_MULTIBYTE) {
+ /*
+ * The last few bytes in this channel buffer were the start of a
+ * multibyte sequence. If this buffer was full, then move them to
+ * the next buffer so the bytes will be contiguous.
+ */
+
+ ChannelBuffer *nextPtr;
+ int extra;
+
+ nextPtr = bufPtr->nextPtr;
+ if (bufPtr->nextAdded < bufPtr->bufLength) {
+ if (gsPtr->rawRead > 0) {
+ /*
+ * Some raw bytes were converted to UTF-8. Fall through,
+ * returning those UTF-8 characters because a EOL might be
+ * present in them.
+ */
+ } else if (statePtr->flags & CHANNEL_EOF) {
+ /*
+ * There was a partial character followed by EOF on the
+ * device. Fall through, returning that nothing was found.
+ */
+
+ bufPtr->nextRemoved = bufPtr->nextAdded;
+ } else {
+ /*
+ * There are no more cached raw bytes left. See if we can
+ * get some more.
+ */
+
+ goto read;
+ }
+ } else {
+ if (nextPtr == NULL) {
+ nextPtr = AllocChannelBuffer(statePtr->bufSize);
+ bufPtr->nextPtr = nextPtr;
+ statePtr->inQueueTail = nextPtr;
+ }
+ extra = rawLen - gsPtr->rawRead;
+ memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
+ (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
+ nextPtr->nextRemoved -= extra;
+ bufPtr->nextAdded -= extra;
+ }
+ }
+
+ gsPtr->bufPtr = bufPtr;
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * PeekAhead --
+ *
+ * Helper function used by Tcl_GetsObj(). Called when we've seen a
+ * \r at the end of the UTF-8 string and want to look ahead one
+ * character to see if it is a \n.
+ *
+ * Results:
+ * *gsPtr->dstPtr is filled with a pointer to the start of the range of
+ * UTF-8 characters that were found by peeking and *dstEndPtr is filled
+ * with a pointer to the bytes just after the end of the range.
+ *
+ * Side effects:
+ * If no more raw bytes were available in one of the channel buffers,
+ * tries to perform a non-blocking read to get more bytes from the
+ * channel device.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+PeekAhead(chanPtr, dstEndPtr, gsPtr)
+ Channel *chanPtr; /* The channel to read. */
+ char **dstEndPtr; /* Filled with pointer to end of new range
+ * of UTF-8 characters. */
+ GetsState *gsPtr; /* Current state of gets operation. */
+{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelBuffer *bufPtr;
+ Tcl_DriverBlockModeProc *blockModeProc;
+ int bytesLeft;
+
+ bufPtr = gsPtr->bufPtr;
+
+ /*
+ * If there's any more raw input that's still buffered, we'll peek into
+ * that. Otherwise, only get more data from the channel driver if it
+ * looks like there might actually be more data. The assumption is that
+ * if the channel buffer is filled right up to the end, then there
+ * might be more data to read.
+ */
+
+ blockModeProc = NULL;
+ if (bufPtr->nextPtr == NULL) {
+ bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
+ if (bytesLeft == 0) {
+ if (bufPtr->nextAdded < bufPtr->bufLength) {
+ /*
+ * Don't peek ahead if last read was short read.
+ */
+
+ goto cleanup;
+ }
+ if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
+ blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
+ if (blockModeProc == NULL) {
+ /*
+ * Don't peek ahead if cannot set non-blocking mode.
+ */
+
+ goto cleanup;
+ }
+ StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
+ }
+ }
+ }
+ if (FilterInputBytes(chanPtr, gsPtr) == 0) {
+ *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;
+ }
+ if (blockModeProc != NULL) {
+ StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
}
+ return;
+
+ cleanup:
+ bufPtr->nextRemoved += gsPtr->rawRead;
+ gsPtr->rawRead = 0;
+ gsPtr->totalChars += gsPtr->charsWrote;
+ gsPtr->bytesWrote = 0;
+ gsPtr->charsWrote = 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CommonGetsCleanup --
+ *
+ * Helper function for Tcl_GetsObj() to restore the channel after
+ * a "gets" operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Encoding may be freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+CommonGetsCleanup(chanPtr, encoding)
+ Channel *chanPtr;
+ Tcl_Encoding encoding;
+{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelBuffer *bufPtr, *nextPtr;
+ bufPtr = statePtr->inQueueHead;
+ for ( ; bufPtr != NULL; bufPtr = nextPtr) {
+ nextPtr = bufPtr->nextPtr;
+ if (bufPtr->nextRemoved < bufPtr->nextAdded) {
+ break;
+ }
+ RecycleBuffer(statePtr, bufPtr, 0);
+ }
+ statePtr->inQueueHead = bufPtr;
+ if (bufPtr == NULL) {
+ statePtr->inQueueTail = NULL;
+ } else {
+ /*
+ * If any multi-byte characters were split across channel buffer
+ * boundaries, the split-up bytes were moved to the next channel
+ * buffer by FilterInputBytes(). Move the bytes back to their
+ * original buffer because the caller could change the channel's
+ * encoding which could change the interpretation of whether those
+ * bytes really made up multi-byte characters after all.
+ */
+
+ nextPtr = bufPtr->nextPtr;
+ for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
+ int extra;
+
+ extra = bufPtr->bufLength - bufPtr->nextAdded;
+ if (extra > 0) {
+ memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
+ (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
+ (size_t) extra);
+ bufPtr->nextAdded += extra;
+ nextPtr->nextRemoved = BUFFER_PADDING;
+ }
+ bufPtr = nextPtr;
+ }
+ }
+ if (statePtr->encoding == NULL) {
+ Tcl_FreeEncoding(encoding);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Read --
+ *
+ * Reads a given number of bytes from a channel. EOL and EOF
+ * translation is done on the bytes being read, so the the number
+ * of bytes consumed from the channel may not be equal to the
+ * number of bytes stored in the destination buffer.
+ *
+ * No encoding conversions are applied to the bytes being read.
+ *
+ * Results:
+ * The number of bytes read, or -1 on error. Use Tcl_GetErrno()
+ * to retrieve the error code for the error that occurred.
+ *
+ * Side effects:
+ * May cause input to be buffered.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Read(chan, dst, bytesToRead)
+ Tcl_Channel chan; /* The channel from which to read. */
+ char *dst; /* 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 */
+
/*
- * If the channel is in the middle of a background copy, fail.
+ * This operation should occur at the top of a channel stack.
*/
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
return -1;
}
- return DoRead(chanPtr, bufPtr, toRead);
+ return DoRead(chanPtr, dst, bytesToRead);
}
/*
*----------------------------------------------------------------------
*
- * DoRead --
+ * Tcl_ReadRaw --
*
- * Reads a given number of characters from a channel.
+ * Reads a given number of bytes from a channel. EOL and EOF
+ * translation is done on the bytes being read, so the the number
+ * of bytes consumed from the channel may not be equal to the
+ * number of bytes stored in the destination buffer.
+ *
+ * No encoding conversions are applied to the bytes being read.
*
* Results:
- * The number of characters read, or -1 on error. Use Tcl_GetErrno()
+ * The number of bytes read, or -1 on error. Use Tcl_GetErrno()
* to retrieve the error code for the error that occurred.
*
* Side effects:
@@ -3113,126 +3759,231 @@ Tcl_Read(chan, bufPtr, toRead)
*----------------------------------------------------------------------
*/
-static int
-DoRead(chanPtr, bufPtr, toRead)
- Channel *chanPtr; /* The channel from which to read. */
- char *bufPtr; /* Where to store input read. */
- int toRead; /* Maximum number of characters to read. */
+int
+Tcl_ReadRaw(chan, bufPtr, bytesToRead)
+ Tcl_Channel chan; /* The channel from which to read. */
+ char *bufPtr; /* Where to store input read. */
+ int bytesToRead; /* Maximum number of bytes to read. */
{
- 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. */
-
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ int nread, result;
+ int copied, copiedNow;
+
/*
- * 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.
+ * 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.
*/
- if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
- chanPtr->flags &= (~(CHANNEL_EOF));
+ if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
+ return -1;
}
- chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_GETS_BLOCKED));
-
- for (copied = 0; copied < toRead; copied += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
- toRead - copied);
+
+ /*
+ * 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.
+ */
+
+ for (copied = 0; copied < bytesToRead; copied += copiedNow) {
+ copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
+ bytesToRead - copied);
if (copiedNow == 0) {
- if (chanPtr->flags & CHANNEL_EOF) {
+ if (statePtr->flags & CHANNEL_EOF) {
goto done;
}
- if (chanPtr->flags & CHANNEL_BLOCKED) {
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
goto done;
}
- chanPtr->flags &= (~(CHANNEL_BLOCKED));
- }
- result = GetInput(chanPtr);
- if (result != 0) {
- if (result != EAGAIN) {
- copied = -1;
- }
- goto done;
+ statePtr->flags &= (~(CHANNEL_BLOCKED));
}
- }
- }
- chanPtr->flags &= (~(CHANNEL_BLOCKED));
+ /*
+ * 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.
+ */
+
+ nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+ bufPtr + copied, bytesToRead - copied, &result);
+ 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)) {
+ statePtr->flags |= CHANNEL_BLOCKED;
+ }
+ } else if (nread == 0) {
+ statePtr->flags |= 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.
+ */
+ return copied;
+ }
- done:
- /*
- * Update the notifier state so we don't block while there is still
- * data in the buffers.
- */
+ statePtr->flags |= CHANNEL_BLOCKED;
+ result = EAGAIN;
+ }
- UpdateInterest(chanPtr);
+ Tcl_SetErrno(result);
+ return -1;
+ }
+
+ return copied + nread;
+ }
+ }
+
+done:
return copied;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_Gets --
+ * Tcl_ReadChars --
*
- * Reads a complete line of input from the channel into a
- * Tcl_DString.
+ * Reads from the channel until the requested number of characters
+ * have been seen, EOF is seen, or the channel would block. EOL
+ * and EOF translation is done. If reading binary data, the raw
+ * bytes are wrapped in a Tcl byte array object. Otherwise, the raw
+ * bytes are converted to UTF-8 using the channel's current encoding
+ * and stored in a Tcl string object.
*
* Results:
- * Length of line read or -1 if error, EOF or blocked. If -1, use
- * Tcl_GetErrno() to retrieve the POSIX error code for the
- * error or condition that occurred.
+ * The number of characters read, or -1 on error. Use Tcl_GetErrno()
+ * to retrieve the error code for the error that occurred.
*
* Side effects:
- * May flush output on the channel. May cause input to be
- * consumed from the channel.
+ * May cause input to be buffered.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-
+
int
-Tcl_Gets(chan, lineRead)
- Tcl_Channel chan; /* Channel from which to read. */
- Tcl_DString *lineRead; /* The characters of the line read
- * (excluding the terminating newline if
- * present) will be appended to this
- * DString. The caller must have initialized
- * it and is responsible for managing the
- * storage. */
+Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
+ Tcl_Channel chan; /* The channel to read. */
+ Tcl_Obj *objPtr; /* Input data is stored in this object. */
+ int toRead; /* Maximum number of characters to store,
+ * or -1 to read all available data (up to EOF
+ * or when channel blocks). */
+ int appendFlag; /* If non-zero, data read from the channel
+ * will be appended to the object. Otherwise,
+ * the data will replace the existing contents
+ * of the object. */
+
{
- Channel *chanPtr; /* The channel to read from. */
- char *buf; /* Points into DString where data
- * will be stored. */
- int offset; /* Offset from start of DString at
- * which to append the line just read. */
- int copiedTotal; /* Accumulates total length of input copied. */
- int copiedNow; /* How many bytes were copied from the
- * current input buffer? */
- int lineLen; /* Length of line read, including the
- * translated newline. If this is zero
- * and neither EOF nor BLOCKED is set,
- * the current line is empty. */
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelBuffer *bufPtr;
+ int offset, factor, copied, copiedNow, result;
+ Tcl_Encoding encoding;
+#define UTF_EXPANSION_FACTOR 1024
- chanPtr = (Channel *) chan;
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
- lineLen = GetEOL(chanPtr);
- if (lineLen < 0) {
- copiedTotal = -1;
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
+ copied = -1;
goto done;
}
- offset = Tcl_DStringLength(lineRead);
- Tcl_DStringSetLength(lineRead, lineLen + offset);
- buf = Tcl_DStringValue(lineRead) + offset;
- for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
- lineLen - copiedTotal);
+ encoding = statePtr->encoding;
+ factor = UTF_EXPANSION_FACTOR;
+
+ if (appendFlag == 0) {
+ if (encoding == NULL) {
+ Tcl_SetByteArrayLength(objPtr, 0);
+ } else {
+ Tcl_SetObjLength(objPtr, 0);
+ }
+ offset = 0;
+ } else {
+ if (encoding == NULL) {
+ Tcl_GetByteArrayFromObj(objPtr, &offset);
+ } else {
+ Tcl_GetStringFromObj(objPtr, &offset);
+ }
}
- if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
- copiedTotal--;
+
+ for (copied = 0; (unsigned) toRead > 0; ) {
+ copiedNow = -1;
+ if (statePtr->inQueueHead != NULL) {
+ if (encoding == NULL) {
+ copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
+ } else {
+ copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
+ &factor);
+ }
+
+ /*
+ * If the current buffer is empty recycle it.
+ */
+
+ bufPtr = statePtr->inQueueHead;
+ if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+ ChannelBuffer *nextPtr;
+
+ nextPtr = bufPtr->nextPtr;
+ RecycleBuffer(statePtr, bufPtr, 0);
+ statePtr->inQueueHead = nextPtr;
+ if (nextPtr == NULL) {
+ statePtr->inQueueTail = nextPtr;
+ }
+ }
+ }
+ if (copiedNow < 0) {
+ if (statePtr->flags & CHANNEL_EOF) {
+ break;
+ }
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ break;
+ }
+ statePtr->flags &= ~CHANNEL_BLOCKED;
+ }
+ result = GetInput(chanPtr);
+ if (result != 0) {
+ if (result == EAGAIN) {
+ break;
+ }
+ copied = -1;
+ goto done;
+ }
+ } else {
+ copied += copiedNow;
+ toRead -= copiedNow;
+ }
+ }
+ statePtr->flags &= ~CHANNEL_BLOCKED;
+ if (encoding == NULL) {
+ Tcl_SetByteArrayLength(objPtr, offset);
+ } else {
+ Tcl_SetObjLength(objPtr, offset);
}
- Tcl_DStringSetLength(lineRead, copiedTotal + offset);
done:
/*
@@ -3241,81 +3992,497 @@ Tcl_Gets(chan, lineRead)
*/
UpdateInterest(chanPtr);
- return copiedTotal;
+ return copied;
+}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ReadBytes --
+ *
+ * Reads from the channel until the requested number of bytes have
+ * been seen, EOF is seen, or the channel would block. Bytes from
+ * the channel are stored in objPtr as a ByteArray object. EOL
+ * and EOF translation are done.
+ *
+ * 'bytesToRead' can safely be a very large number because
+ * space is only 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).
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
+ ChannelState *statePtr; /* State of the channel to read. */
+ int bytesToRead; /* Maximum number of characters to store,
+ * or < 0 to get all available characters.
+ * Characters are obtained from the first
+ * buffer in the queue -- even if this number
+ * is larger than the number of characters
+ * available in the first buffer, only the
+ * characters from the first buffer are
+ * returned. */
+ Tcl_Obj *objPtr; /* Input data is appended to this ByteArray
+ * object. Its length is how much space
+ * has been allocated to hold data, not how
+ * many bytes of data have been stored in the
+ * object. */
+ 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, srcRead, dstWrote, offset, length;
+ ChannelBuffer *bufPtr;
+ char *src, *dst;
+
+ offset = *offsetPtr;
+
+ bufPtr = statePtr->inQueueHead;
+ src = bufPtr->buf + bufPtr->nextRemoved;
+ srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
+
+ 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 (statePtr->flags & INPUT_NEED_NL) {
+ statePtr->flags &= ~INPUT_NEED_NL;
+ if ((srcLen == 0) || (*src != '\n')) {
+ *dst = '\r';
+ *offsetPtr += 1;
+ return 1;
+ }
+ *dst++ = '\n';
+ src++;
+ srcLen--;
+ toRead--;
+ }
+
+ srcRead = srcLen;
+ dstWrote = toRead;
+ if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
+ if (dstWrote == 0) {
+ return -1;
+ }
+ }
+ bufPtr->nextRemoved += srcRead;
+ *offsetPtr += dstWrote;
+ return dstWrote;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_GetsObj --
+ * ReadChars --
+ *
+ * Reads from the channel until the requested number of UTF-8
+ * characters have been seen, EOF is seen, or the channel would
+ * block. Raw bytes from the channel are converted to UTF-8
+ * and stored in objPtr. EOL and EOF translation is done.
*
- * Reads a complete line of input from the channel into a
- * string object.
+ * 'charsToRead' can safely be a very large number because
+ * space is only allocated to hold data read from the channel
+ * as needed.
*
* Results:
- * Length of line read or -1 if error, EOF or blocked. If -1, use
- * Tcl_GetErrno() to retrieve the POSIX error code for the
- * error or condition that occurred.
+ * The return value is the number of characters appended to
+ * the object, *offsetPtr is filled with the number of bytes that
+ * were appended, and *factorPtr is filled with the expansion
+ * factor used to guess how many bytes of UTF-8 to allocate to
+ * hold N source bytes.
*
* Side effects:
- * May flush output on the channel. May cause input to be
- * consumed from the channel.
+ * None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-int
-Tcl_GetsObj(chan, objPtr)
- Tcl_Channel chan; /* Channel from which to read. */
- Tcl_Obj *objPtr; /* The characters of the line read
- * (excluding the terminating newline if
- * present) will be appended to this
- * object. The caller must have initialized
- * it and is responsible for managing the
- * storage. */
+static int
+ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
+ ChannelState *statePtr; /* State of channel to read. */
+ int charsToRead; /* Maximum number of characters to store,
+ * or -1 to get all available characters.
+ * Characters are obtained from the first
+ * buffer in the queue -- even if this number
+ * is larger than the number of characters
+ * available in the first buffer, only the
+ * characters from the first buffer are
+ * returned. */
+ Tcl_Obj *objPtr; /* Input data is appended to this object.
+ * objPtr->length is how much space has been
+ * allocated to hold data, not how many bytes
+ * of data have been stored in the object. */
+ 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 *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. */
{
- Channel *chanPtr; /* The channel to read from. */
- char *buf; /* Points into DString where data
- * will be stored. */
- int offset; /* Offset from start of DString at
- * which to append the line just read. */
- int copiedTotal; /* Accumulates total length of input copied. */
- int copiedNow; /* How many bytes were copied from the
- * current input buffer? */
- int lineLen; /* Length of line read, including the
- * translated newline. If this is zero
- * and neither EOF nor BLOCKED is set,
- * the current line is empty. */
-
- chanPtr = (Channel *) chan;
+ int toRead, factor, offset, spaceLeft, length;
+ int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars;
+ ChannelBuffer *bufPtr;
+ char *src, *dst;
+ Tcl_EncodingState oldState;
- lineLen = GetEOL(chanPtr);
- if (lineLen < 0) {
- copiedTotal = -1;
- goto done;
+ factor = *factorPtr;
+ offset = *offsetPtr;
+
+ bufPtr = statePtr->inQueueHead;
+ src = bufPtr->buf + bufPtr->nextRemoved;
+ srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
+
+ toRead = charsToRead;
+ if ((unsigned) toRead > (unsigned) srcLen) {
+ toRead = srcLen;
}
- (void) Tcl_GetStringFromObj(objPtr, &offset);
- Tcl_SetObjLength(objPtr, lineLen + offset);
- buf = Tcl_GetStringFromObj(objPtr, NULL) + offset;
+ /*
+ * 'factor' is how much we guess that the bytes in the source buffer
+ * will expand when converted to UTF-8 chars. This guess comes from
+ * analyzing how many characters were produced by the previous
+ * pass.
+ */
+
+ dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
+ spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
+
+ 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.
+ */
- for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
- lineLen - copiedTotal);
+ length = offset * 2;
+ if (offset < dstNeeded) {
+ length = offset + dstNeeded;
+ }
+ spaceLeft = length - offset;
+ length += TCL_UTF_MAX + 1;
+ Tcl_SetObjLength(objPtr, length);
}
- if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
- copiedTotal--;
+ 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;
}
- Tcl_SetObjLength(objPtr, copiedTotal + offset);
+ dst = objPtr->bytes + offset;
+
+ oldState = statePtr->inputEncodingState;
+ if (statePtr->flags & INPUT_NEED_NL) {
+ /*
+ * We want a '\n' because the last character we saw was '\r'.
+ */
+
+ statePtr->flags &= ~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')) {
+ /*
+ * The next char was a '\n'. Consume it and produce a '\n'.
+ */
+
+ bufPtr->nextRemoved += srcRead;
+ } else {
+ /*
+ * The next char was not a '\n'. Produce a '\r'.
+ */
+
+ *dst = '\r';
+ }
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+ *offsetPtr += 1;
+ return 1;
+ }
+
+ Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+ statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
+ dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
+ 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.
+ */
+
+ ChannelBuffer *nextPtr;
+
+ nextPtr = bufPtr->nextPtr;
+ if (nextPtr == NULL) {
+ /*
+ * 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.
+ */
+
+ statePtr->flags |= CHANNEL_NEED_MORE_DATA;
+ return -1;
+ }
+ nextPtr->nextRemoved -= srcLen;
+ memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
+ (size_t) srcLen);
+ RecycleBuffer(statePtr, bufPtr, 0);
+ statePtr->inQueueHead = nextPtr;
+ return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
+ }
+
+ 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?
+ */
+
+ if (dstWrote == 0) {
+ return -1;
+ }
+ 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);
+ }
- done:
/*
- * Update the notifier state so we don't block while there is still
- * data in the buffers.
+ * 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.
*/
- UpdateInterest(chanPtr);
- return copiedTotal;
+ numChars -= (dstRead - dstWrote);
+
+ if ((unsigned) numChars > (unsigned) toRead) {
+ /*
+ * Got too many chars.
+ */
+
+ char *eof;
+
+ eof = Tcl_UtfAtIndex(dst, toRead);
+ 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;
+
+ bufPtr->nextRemoved += srcRead;
+ if (dstWrote > srcRead + 1) {
+ *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
+ }
+ *offsetPtr += dstWrote;
+ return numChars;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TranslateInputEOL --
+ *
+ * Perform input EOL and EOF translation on the source buffer,
+ * leaving the translated result in the destination buffer.
+ *
+ * Results:
+ * The return value is 1 if the EOF character was found when copying
+ * bytes to the destination buffer, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
+ ChannelState *statePtr; /* Channel being read, for EOL translation
+ * and EOF character. */
+ char *dstStart; /* Output buffer filled with chars by
+ * applying appropriate EOL translation to
+ * source 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. */
+ 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;
+
+ dstLen = *dstLenPtr;
+
+ 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.
+ */
+
+ CONST char *src, *srcMax;
+
+ 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;
+ }
+ }
+ }
+ switch (statePtr->inputTranslation) {
+ case TCL_TRANSLATE_LF: {
+ if (dstStart != srcStart) {
+ memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
+ }
+ srcLen = dstLen;
+ break;
+ }
+ case TCL_TRANSLATE_CR: {
+ char *dst, *dstEnd;
+
+ if (dstStart != srcStart) {
+ memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
+ }
+ dstEnd = dstStart + dstLen;
+ for (dst = dstStart; dst < dstEnd; dst++) {
+ if (*dst == '\r') {
+ *dst = '\n';
+ }
+ }
+ srcLen = dstLen;
+ 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) {
+ statePtr->flags |= INPUT_NEED_NL;
+ } else if (*src == '\n') {
+ *dst++ = *src++;
+ } else {
+ *dst++ = '\r';
+ }
+ } else {
+ *dst++ = *src++;
+ }
+ }
+ srcLen = src - srcStart;
+ dstLen = dst - dstStart;
+ break;
+ }
+ case TCL_TRANSLATE_AUTO: {
+ char *dst;
+ CONST char *src, *srcEnd, *srcMax;
+
+ dst = dstStart;
+ src = srcStart;
+ srcEnd = srcStart + dstLen;
+ srcMax = srcStart + *srcLenPtr;
+
+ if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+ if (*src == '\n') {
+ src++;
+ }
+ statePtr->flags &= ~INPUT_SAW_CR;
+ }
+ for ( ; src < srcEnd; ) {
+ if (*src == '\r') {
+ src++;
+ if (src >= srcMax) {
+ statePtr->flags |= INPUT_SAW_CR;
+ } else if (*src == '\n') {
+ if (srcEnd < srcMax) {
+ srcEnd++;
+ }
+ src++;
+ }
+ *dst++ = '\n';
+ } else {
+ *dst++ = *src++;
+ }
+ }
+ srcLen = src - srcStart;
+ dstLen = dst - dstStart;
+ break;
+ }
+ default: { /* lint. */
+ return 0;
+ }
+ }
+ *dstLenPtr = dstLen;
+
+ if ((eof != NULL) && (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 character in the output string.
+ */
+
+ statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
+ return 1;
+ }
+
+ *srcLenPtr = srcLen;
+ return 0;
}
/*
@@ -3344,38 +4511,29 @@ Tcl_Ungets(chan, str, len, atEnd)
* add at head of queue. */
{
Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of actual channel. */
ChannelBuffer *bufPtr; /* Buffer to contain the data. */
- int i;
+ int i, flags;
chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
/*
- * Check for unreported error.
+ * This operation should occur at the top of a channel stack.
*/
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
- }
+ chanPtr = statePtr->topChanPtr;
/*
- * Punt if the channel is not opened for reading.
+ * CheckChannelErrors clears too many flag bits in this one case.
*/
-
- if (!(chanPtr->flags & TCL_READABLE)) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
-
- /*
- * If the channel is in the middle of a background copy, fail.
- */
-
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
- return -1;
+
+ flags = statePtr->flags;
+ if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
+ len = -1;
+ goto done;
}
+ statePtr->flags = flags;
/*
* If we have encountered a sticky EOF, just punt without storing.
@@ -3385,33 +4543,31 @@ Tcl_Ungets(chan, str, len, atEnd)
* in each operation.
*/
- if (chanPtr->flags & CHANNEL_STICKY_EOF) {
- return len;
+ if (statePtr->flags & CHANNEL_STICKY_EOF) {
+ goto done;
}
- chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
+ statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
- bufPtr = (ChannelBuffer *) ckalloc((unsigned)
- (CHANNELBUFFER_HEADER_SIZE + len));
+ bufPtr = AllocChannelBuffer(len);
for (i = 0; i < len; i++) {
bufPtr->buf[i] = str[i];
}
- bufPtr->bufSize = len;
- bufPtr->nextAdded = len;
- bufPtr->nextRemoved = 0;
+ bufPtr->nextAdded += len;
- if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+ if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
bufPtr->nextPtr = (ChannelBuffer *) NULL;
- chanPtr->inQueueHead = bufPtr;
- chanPtr->inQueueTail = bufPtr;
+ statePtr->inQueueHead = bufPtr;
+ statePtr->inQueueTail = bufPtr;
} else if (atEnd) {
bufPtr->nextPtr = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail->nextPtr = bufPtr;
- chanPtr->inQueueTail = bufPtr;
+ statePtr->inQueueTail->nextPtr = bufPtr;
+ statePtr->inQueueTail = bufPtr;
} else {
- bufPtr->nextPtr = chanPtr->inQueueHead;
- chanPtr->inQueueHead = bufPtr;
+ bufPtr->nextPtr = statePtr->inQueueHead;
+ statePtr->inQueueHead = bufPtr;
}
+ done:
/*
* Update the notifier state so we don't block while there is still
* data in the buffers.
@@ -3424,6 +4580,236 @@ Tcl_Ungets(chan, str, len, atEnd)
/*
*----------------------------------------------------------------------
*
+ * Tcl_Flush --
+ *
+ * Flushes output data on a channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May flush output queued on this channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Flush(chan)
+ Tcl_Channel chan; /* The Channel to flush. */
+{
+ int result; /* Of calling FlushChannel. */
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+ ChannelState *statePtr = chanPtr->state; /* State of actual channel. */
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
+ return -1;
+ }
+
+ /*
+ * Force current output buffer to be output also.
+ */
+
+ if ((statePtr->curOutPtr != NULL)
+ && (statePtr->curOutPtr->nextAdded > 0)) {
+ statePtr->flags |= BUFFER_READY;
+ }
+
+ result = FlushChannel(NULL, chanPtr, 0);
+ if (result != 0) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DiscardInputQueued --
+ *
+ * Discards any input read from the channel but not yet consumed
+ * by Tcl reading commands.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May discard input from the channel. If discardLastBuffer is zero,
+ * leaves one buffer in place for back-filling.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DiscardInputQueued(statePtr, discardSavedBuffers)
+ ChannelState *statePtr; /* Channel on which to discard
+ * the queued input. */
+ int discardSavedBuffers; /* If non-zero, discard all buffers including
+ * last one. */
+{
+ ChannelBuffer *bufPtr, *nxtPtr; /* Loop variables. */
+
+ bufPtr = statePtr->inQueueHead;
+ statePtr->inQueueHead = (ChannelBuffer *) NULL;
+ statePtr->inQueueTail = (ChannelBuffer *) NULL;
+ for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
+ nxtPtr = bufPtr->nextPtr;
+ RecycleBuffer(statePtr, bufPtr, discardSavedBuffers);
+ }
+
+ /*
+ * If discardSavedBuffers is nonzero, must also discard any previously
+ * saved buffer in the saveInBufPtr field.
+ */
+
+ if (discardSavedBuffers) {
+ if (statePtr->saveInBufPtr != (ChannelBuffer *) NULL) {
+ ckfree((char *) statePtr->saveInBufPtr);
+ statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetInput --
+ *
+ * Reads input data from a device into a channel buffer.
+ *
+ * Results:
+ * The return value is the Posix error code if an error occurred while
+ * reading from the file, or 0 otherwise.
+ *
+ * Side effects:
+ * Reads from the underlying device.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetInput(chanPtr)
+ Channel *chanPtr; /* Channel to read input from. */
+{
+ int toRead; /* How much to read? */
+ int result; /* Of calling driver. */
+ int nread; /* How much was read from channel? */
+ ChannelBuffer *bufPtr; /* New buffer to add to input queue. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+
+ /*
+ * 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
+ * interpreter.
+ */
+
+ if (CheckForDeadChannel(NULL, statePtr)) {
+ return EINVAL;
+ }
+
+ /*
+ * 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 != (ChannelBuffer*) NULL) {
+ if (statePtr->inQueueHead != (ChannelBuffer*) NULL) {
+ RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
+ statePtr->inQueueHead = (ChannelBuffer*) NULL;
+ }
+
+ statePtr->inQueueHead = chanPtr->inQueueHead;
+ statePtr->inQueueTail = chanPtr->inQueueTail;
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+ return 0;
+ }
+
+ /*
+ * Nothing in the pushback area, fall back to the usual handling
+ * (driver, etc.)
+ */
+
+ /*
+ * See if we can fill an existing buffer. If we can, read only
+ * as much as will fit in it. Otherwise allocate a new buffer,
+ * add it to the input queue and attempt to fill it to the max.
+ */
+
+ bufPtr = statePtr->inQueueTail;
+ if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
+ toRead = bufPtr->bufLength - bufPtr->nextAdded;
+ } else {
+ bufPtr = statePtr->saveInBufPtr;
+ statePtr->saveInBufPtr = NULL;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(statePtr->bufSize);
+ }
+ bufPtr->nextPtr = (ChannelBuffer *) NULL;
+
+ toRead = statePtr->bufSize;
+ if (statePtr->inQueueTail == NULL) {
+ statePtr->inQueueHead = bufPtr;
+ } else {
+ statePtr->inQueueTail->nextPtr = bufPtr;
+ }
+ statePtr->inQueueTail = 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 (statePtr->flags & CHANNEL_EOF) {
+ return 0;
+ }
+
+ nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+ bufPtr->buf + bufPtr->nextAdded, toRead, &result);
+
+ if (nread > 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) {
+ statePtr->flags |= CHANNEL_BLOCKED;
+ }
+ } else if (nread == 0) {
+ statePtr->flags |= CHANNEL_EOF;
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ } else if (nread < 0) {
+ if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+ statePtr->flags |= CHANNEL_BLOCKED;
+ result = EAGAIN;
+ }
+ Tcl_SetErrno(result);
+ return result;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_Seek --
*
* Implements seeking on Tcl Channels. This is a public function
@@ -3445,7 +4831,8 @@ Tcl_Seek(chan, offset, mode)
int offset; /* Offset to seek to. */
int mode; /* Relative to which location to seek? */
{
- Channel *chanPtr; /* The real IO channel. */
+ Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
int inputBuffered, outputBuffered;
int result; /* Of device driver operations. */
@@ -3454,34 +4841,7 @@ Tcl_Seek(chan, offset, mode)
* seek operation? If so, must restore to
* nonblocking mode after the seek. */
- chanPtr = (Channel *) chan;
-
- /*
- * Check for unreported error.
- */
-
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
- }
-
- /*
- * Disallow seek on channels that are open for neither writing nor
- * reading (e.g. socket server channels).
- */
-
- if (!(chanPtr->flags & (TCL_WRITABLE|TCL_READABLE))) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
-
- /*
- * If the channel is in the middle of a background copy, fail.
- */
-
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
return -1;
}
@@ -3492,7 +4852,13 @@ Tcl_Seek(chan, offset, mode)
* registered in an interpreter.
*/
- if (CheckForDeadChannel(NULL,chanPtr)) return -1;
+ if (CheckForDeadChannel(NULL, statePtr)) return -1;
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
/*
* Disallow seek on channels whose type does not have a seek procedure
@@ -3509,21 +4875,32 @@ Tcl_Seek(chan, offset, mode)
* output is buffered, cannot compute the current position.
*/
- for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
+ for (bufPtr = statePtr->inQueueHead, inputBuffered = 0;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
+
+ /*
+ * Don't forget the bytes in the topmost pushback area.
+ */
+
+ for (bufPtr = statePtr->topChanPtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+
+ for (bufPtr = statePtr->outQueueHead, outputBuffered = 0;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
- chanPtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= BUFFER_READY;
outputBuffered +=
- (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
+ (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
}
if ((inputBuffered != 0) && (outputBuffered != 0)) {
@@ -3545,14 +4922,14 @@ Tcl_Seek(chan, offset, mode)
* the seek.
*/
- DiscardInputQueued(chanPtr, 0);
+ DiscardInputQueued(statePtr, 0);
/*
* Reset EOF and BLOCKED flags. We invalidate them by moving the
* access point. Also clear CR related flags.
*/
- chanPtr->flags &=
+ statePtr->flags &=
(~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
/*
@@ -3563,20 +4940,15 @@ Tcl_Seek(chan, offset, mode)
*/
wasAsync = 0;
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
wasAsync = 1;
- result = 0;
- if (chanPtr->typePtr->blockModeProc != NULL) {
- result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
- TCL_MODE_BLOCKING);
- }
- if (result != 0) {
- Tcl_SetErrno(result);
- return -1;
- }
- chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
- if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
- chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
+ result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
+ if (result != 0) {
+ return -1;
+ }
+ statePtr->flags &= (~(CHANNEL_NONBLOCKING));
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
}
}
@@ -3612,16 +4984,11 @@ Tcl_Seek(chan, offset, mode)
*/
if (wasAsync) {
- chanPtr->flags |= CHANNEL_NONBLOCKING;
- result = 0;
- if (chanPtr->typePtr->blockModeProc != NULL) {
- result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
- TCL_MODE_NONBLOCKING);
- }
- if (result != 0) {
- Tcl_SetErrno(result);
- return -1;
- }
+ statePtr->flags |= CHANNEL_NONBLOCKING;
+ result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
+ if (result != 0) {
+ return -1;
+ }
}
return curPos;
@@ -3650,22 +5017,15 @@ int
Tcl_Tell(chan)
Tcl_Channel chan; /* The channel to return pos for. */
{
- Channel *chanPtr; /* The actual channel to tell on. */
+ Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
int inputBuffered, outputBuffered;
int result; /* Of calling device driver. */
int curPos; /* Position on device. */
- chanPtr = (Channel *) chan;
-
- /*
- * Check for unreported error.
- */
-
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
+ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
+ return -1;
}
/*
@@ -3675,26 +5035,15 @@ Tcl_Tell(chan)
* registered in an interpreter.
*/
- if (CheckForDeadChannel(NULL,chanPtr)) return -1;
-
- /*
- * Disallow tell on channels that are open for neither
- * writing nor reading (e.g. socket server channels).
- */
-
- if (!(chanPtr->flags & (TCL_WRITABLE|TCL_READABLE))) {
- Tcl_SetErrno(EACCES);
- return -1;
+ if (CheckForDeadChannel(NULL, statePtr)) {
+ return -1;
}
/*
- * If the channel is in the middle of a background copy, fail.
+ * This operation should occur at the top of a channel stack.
*/
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
- return -1;
- }
+ chanPtr = statePtr->topChanPtr;
/*
* Disallow tell on channels whose type does not have a seek procedure
@@ -3711,21 +5060,21 @@ Tcl_Tell(chan)
* output is buffered, cannot compute the current position.
*/
- for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
+ for (bufPtr = statePtr->inQueueHead, inputBuffered = 0;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
+ for (bufPtr = statePtr->outQueueHead, outputBuffered = 0;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
- chanPtr->flags |= BUFFER_READY;
+ if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= BUFFER_READY;
outputBuffered +=
- (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
+ (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
}
if ((inputBuffered != 0) && (outputBuffered != 0)) {
@@ -3751,6 +5100,94 @@ Tcl_Tell(chan)
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * CheckChannelErrors --
+ *
+ * See if the channel is in an ready state and can perform the
+ * desired operation.
+ *
+ * Results:
+ * The return value is 0 if the channel is OK, otherwise the
+ * return value is -1 and errno is set to indicate the error.
+ *
+ * Side effects:
+ * May clear the EOF and/or BLOCKED bits if reading from channel.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+CheckChannelErrors(statePtr, flags)
+ ChannelState *statePtr; /* Channel to check. */
+ int flags; /* Test if channel supports desired operation:
+ * TCL_READABLE, TCL_WRITABLE. Also indicates
+ * Raw read or write for special close
+ * processing*/
+{
+ int direction = flags & (TCL_READABLE|TCL_WRITABLE);
+
+ /*
+ * Check for unreported error.
+ */
+
+ if (statePtr->unreportedError != 0) {
+ Tcl_SetErrno(statePtr->unreportedError);
+ statePtr->unreportedError = 0;
+ return -1;
+ }
+
+ /*
+ * Only the raw read and write operations are allowed during close
+ * in order to drain data from stacked channels.
+ */
+
+ if ((statePtr->flags & CHANNEL_CLOSED) &&
+ ((flags & CHANNEL_RAW_MODE) == 0)) {
+ Tcl_SetErrno(EACCES);
+ return -1;
+ }
+
+ /*
+ * Fail if the channel is not opened for desired operation.
+ */
+
+ if ((statePtr->flags & direction) == 0) {
+ Tcl_SetErrno(EACCES);
+ return -1;
+ }
+
+ /*
+ * Fail if the channel is in the middle of a background copy.
+ *
+ * Don't do this tests for raw channels here or else the chaining in the
+ * transformation drivers will fail with 'file busy' error instead of
+ * retrieving and transforming the data to copy.
+ */
+
+ if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) {
+ Tcl_SetErrno(EBUSY);
+ return -1;
+ }
+
+ 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 ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
+ statePtr->flags &= ~CHANNEL_EOF;
+ }
+ statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ }
+
+ return 0;
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_Eof --
@@ -3770,12 +5207,12 @@ int
Tcl_Eof(chan)
Tcl_Channel chan; /* Does this channel have EOF? */
{
- Channel *chanPtr; /* The real channel structure. */
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
- chanPtr = (Channel *) chan;
- return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
- ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
- ? 1 : 0;
+ return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
+ ((statePtr->flags & CHANNEL_EOF) &&
+ (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
}
/*
@@ -3798,10 +5235,10 @@ int
Tcl_InputBlocked(chan)
Tcl_Channel chan; /* Is this channel blocked? */
{
- Channel *chanPtr; /* The real channel structure. */
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
- chanPtr = (Channel *) chan;
- return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
+ return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
}
/*
@@ -3810,7 +5247,7 @@ Tcl_InputBlocked(chan)
* Tcl_InputBuffered --
*
* Returns the number of bytes of input currently buffered in the
- * internal buffer of a channel.
+ * common internal buffer of a channel.
*
* Results:
* The number of input bytes buffered, or zero if the channel is not
@@ -3826,16 +5263,63 @@ int
Tcl_InputBuffered(chan)
Tcl_Channel chan; /* The channel to query. */
{
- Channel *chanPtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
+ ChannelBuffer *bufPtr;
int bytesBuffered;
+
+ for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+
+ /*
+ * Don't forget the bytes in the topmost pushback area.
+ */
+
+ for (bufPtr = statePtr->topChanPtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+
+ return bytesBuffered;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelBuffered --
+ *
+ * Returns the number of bytes of input currently buffered in the
+ * internal buffer (push back area) of a channel.
+ *
+ * Results:
+ * The number of input bytes buffered, or zero if the channel is not
+ * open for reading.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ChannelBuffered(chan)
+ Tcl_Channel chan; /* The channel to query. */
+{
+ Channel *chanPtr = (Channel *) chan;
+ /* real channel structure. */
ChannelBuffer *bufPtr;
+ int bytesBuffered;
- chanPtr = (Channel *) chan;
for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
+
return bytesBuffered;
}
@@ -3862,7 +5346,7 @@ Tcl_SetChannelBufferSize(chan, sz)
* to set. */
int sz; /* The size to set. */
{
- Channel *chanPtr;
+ ChannelState *statePtr; /* State of real channel structure. */
/*
* If the buffer size is smaller than 10 bytes or larger than one MByte,
@@ -3876,8 +5360,17 @@ Tcl_SetChannelBufferSize(chan, sz)
return;
}
- chanPtr = (Channel *) chan;
- chanPtr->bufSize = sz;
+ statePtr = ((Channel *) chan)->state;
+ statePtr->bufSize = sz;
+
+ if (statePtr->outputStage != NULL) {
+ ckfree((char *) statePtr->outputStage);
+ statePtr->outputStage = NULL;
+ }
+ if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+ statePtr->outputStage = (char *)
+ ckalloc((unsigned) (statePtr->bufSize + 2));
+ }
}
/*
@@ -3901,10 +5394,10 @@ Tcl_GetChannelBufferSize(chan)
Tcl_Channel chan; /* The channel for which to find the
* buffer size. */
{
- Channel *chanPtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
- chanPtr = (Channel *) chan;
- return chanPtr->bufSize;
+ return statePtr->bufSize;
}
/*
@@ -3947,7 +5440,7 @@ Tcl_BadChannelOption(interp, optionName, optionList)
{
if (interp) {
CONST char *genericopt =
- "blocking buffering buffersize eofchar translation";
+ "blocking buffering buffersize encoding eofchar translation";
char **argv;
int argc, i;
Tcl_DString ds;
@@ -3959,12 +5452,12 @@ Tcl_BadChannelOption(interp, optionName, optionList)
Tcl_DStringAppend(&ds, optionList, -1);
}
if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
- &argc, &argv) != TCL_OK) {
+ &argc, &argv) != TCL_OK) {
panic("malformed option list in channel driver");
}
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad option \"", optionName,
- "\": should be one of ", (char *) NULL);
+ "\": should be one of ", (char *) NULL);
argc--;
for (i = 0; i < argc; i++) {
Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
@@ -4007,30 +5500,39 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
size_t len; /* Length of optionName string. */
char optionVal[128]; /* Buffer for sprintf. */
Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
int flags;
/*
- * If we are in the middle of a background copy, use the saved flags.
+ * Disallow options on dead channels -- channels that have been closed but
+ * not yet been deallocated. Such channels can be found if the exit
+ * handler for channel cleanup has run but the channel is still
+ * registered in an interpreter.
*/
- if (chanPtr->csPtr) {
- if (chanPtr == chanPtr->csPtr->readPtr) {
- flags = chanPtr->csPtr->readFlags;
- } else {
- flags = chanPtr->csPtr->writeFlags;
- }
- } else {
- flags = chanPtr->flags;
+ if (CheckForDeadChannel(interp, statePtr)) {
+ return TCL_ERROR;
}
/*
- * Disallow options on dead channels -- channels that have been closed but
- * not yet been deallocated. Such channels can be found if the exit
- * handler for channel cleanup has run but the channel is still
- * registered in an interpreter.
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
+ /*
+ * If we are in the middle of a background copy, use the saved flags.
*/
- if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
+ if (statePtr->csPtr) {
+ if (chanPtr == statePtr->csPtr->readPtr) {
+ flags = statePtr->csPtr->readFlags;
+ } else {
+ flags = statePtr->csPtr->writeFlags;
+ }
+ } else {
+ flags = statePtr->flags;
+ }
/*
* If the optionName is NULL it means that we want a list of all
@@ -4075,14 +5577,30 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-buffersize");
}
- TclFormatInt(optionVal, chanPtr->bufSize);
+ TclFormatInt(optionVal, statePtr->bufSize);
Tcl_DStringAppendElement(dsPtr, optionVal);
if (len > 0) {
return TCL_OK;
}
}
if ((len == 0) ||
- ((len > 1) && (optionName[1] == 'e') &&
+ ((len > 2) && (optionName[1] == 'e') &&
+ (strncmp(optionName, "-encoding", len) == 0))) {
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-encoding");
+ }
+ if (statePtr->encoding == NULL) {
+ Tcl_DStringAppendElement(dsPtr, "binary");
+ } else {
+ Tcl_DStringAppendElement(dsPtr,
+ Tcl_GetEncodingName(statePtr->encoding));
+ }
+ if (len > 0) {
+ return TCL_OK;
+ }
+ }
+ if ((len == 0) ||
+ ((len > 2) && (optionName[1] == 'e') &&
(strncmp(optionName, "-eofchar", len) == 0))) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-eofchar");
@@ -4092,22 +5610,22 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
Tcl_DStringStartSublist(dsPtr);
}
if (flags & TCL_READABLE) {
- if (chanPtr->inEofChar == 0) {
+ if (statePtr->inEofChar == 0) {
Tcl_DStringAppendElement(dsPtr, "");
} else {
char buf[4];
- sprintf(buf, "%c", chanPtr->inEofChar);
+ sprintf(buf, "%c", statePtr->inEofChar);
Tcl_DStringAppendElement(dsPtr, buf);
}
}
if (flags & TCL_WRITABLE) {
- if (chanPtr->outEofChar == 0) {
+ if (statePtr->outEofChar == 0) {
Tcl_DStringAppendElement(dsPtr, "");
} else {
char buf[4];
- sprintf(buf, "%c", chanPtr->outEofChar);
+ sprintf(buf, "%c", statePtr->outEofChar);
Tcl_DStringAppendElement(dsPtr, buf);
}
}
@@ -4130,22 +5648,22 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
Tcl_DStringStartSublist(dsPtr);
}
if (flags & TCL_READABLE) {
- if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+ if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
Tcl_DStringAppendElement(dsPtr, "auto");
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
Tcl_DStringAppendElement(dsPtr, "cr");
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
Tcl_DStringAppendElement(dsPtr, "crlf");
} else {
Tcl_DStringAppendElement(dsPtr, "lf");
}
}
if (flags & TCL_WRITABLE) {
- if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+ if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
Tcl_DStringAppendElement(dsPtr, "auto");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
Tcl_DStringAppendElement(dsPtr, "cr");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
Tcl_DStringAppendElement(dsPtr, "crlf");
} else {
Tcl_DStringAppendElement(dsPtr, "lf");
@@ -4166,7 +5684,7 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
*/
return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
- interp, optionName, dsPtr);
+ interp, optionName, dsPtr);
} else {
/*
* no driver specific options case.
@@ -4180,20 +5698,20 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_SetChannelOption --
*
* Sets an option on a channel.
*
* Results:
- * A standard Tcl result. Also sets interp->result on error if
- * interp is not NULL.
+ * A standard Tcl result. On error, sets interp's result object
+ * if interp is not NULL.
*
* Side effects:
* May modify an option on a device.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -4204,27 +5722,25 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
char *newValue; /* New value for option. */
{
int newMode; /* New (numeric) mode to sert. */
- Channel *chanPtr; /* The real IO channel. */
+ Channel *chanPtr = (Channel *) chan; /* The real IO channel. */
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
size_t len; /* Length of optionName string. */
int argc;
char **argv;
-
- chanPtr = (Channel *) chan;
/*
* If the channel is in the middle of a background copy, fail.
*/
- if (chanPtr->csPtr) {
+ if (statePtr->csPtr) {
if (interp) {
Tcl_AppendResult(interp,
- "unable to set channel options: background copy in progress",
- (char *) NULL);
+ "unable to set channel options: background copy in progress",
+ (char *) NULL);
}
return TCL_ERROR;
}
-
/*
* Disallow options on dead channels -- channels that have been closed but
* not yet been deallocated. Such channels can be found if the exit
@@ -4232,8 +5748,16 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* registered in an interpreter.
*/
- if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
-
+ if (CheckForDeadChannel(NULL, statePtr)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
+
len = strlen(optionName);
if ((len > 2) && (optionName[1] == 'b') &&
@@ -4247,22 +5771,20 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
newMode = TCL_MODE_NONBLOCKING;
}
return SetBlockMode(interp, chanPtr, newMode);
- }
-
- if ((len > 7) && (optionName[1] == 'b') &&
+ } else if ((len > 7) && (optionName[1] == 'b') &&
(strncmp(optionName, "-buffering", len) == 0)) {
len = strlen(newValue);
if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
- chanPtr->flags &=
+ statePtr->flags &=
(~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
} else if ((newValue[0] == 'l') &&
(strncmp(newValue, "line", len) == 0)) {
- chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
- chanPtr->flags |= CHANNEL_LINEBUFFERED;
+ statePtr->flags &= (~(CHANNEL_UNBUFFERED));
+ statePtr->flags |= CHANNEL_LINEBUFFERED;
} else if ((newValue[0] == 'n') &&
(strncmp(newValue, "none", len) == 0)) {
- chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
- chanPtr->flags |= CHANNEL_UNBUFFERED;
+ statePtr->flags &= (~(CHANNEL_LINEBUFFERED));
+ statePtr->flags |= CHANNEL_UNBUFFERED;
} else {
if (interp) {
Tcl_AppendResult(interp, "bad value for -buffering: ",
@@ -4271,32 +5793,47 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
return TCL_ERROR;
}
}
- return TCL_OK;
- }
-
- if ((len > 7) && (optionName[1] == 'b') &&
+ return TCL_OK;
+ } else if ((len > 7) && (optionName[1] == 'b') &&
(strncmp(optionName, "-buffersize", len) == 0)) {
- chanPtr->bufSize = atoi(newValue);
- if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
- chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
+ statePtr->bufSize = atoi(newValue); /* INTL: "C", UTF safe. */
+ if ((statePtr->bufSize < 10) || (statePtr->bufSize > (1024 * 1024))) {
+ statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
}
- return TCL_OK;
- }
-
- if ((len > 1) && (optionName[1] == 'e') &&
+ } else if ((len > 2) && (optionName[1] == 'e') &&
+ (strncmp(optionName, "-encoding", len) == 0)) {
+ Tcl_Encoding encoding;
+
+ if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
+ encoding = NULL;
+ } else {
+ encoding = Tcl_GetEncoding(interp, newValue);
+ if (encoding == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ Tcl_FreeEncoding(statePtr->encoding);
+ statePtr->encoding = encoding;
+ statePtr->inputEncodingState = NULL;
+ statePtr->inputEncodingFlags = TCL_ENCODING_START;
+ statePtr->outputEncodingState = NULL;
+ statePtr->outputEncodingFlags = TCL_ENCODING_START;
+ statePtr->flags &= ~CHANNEL_NEED_MORE_DATA;
+ UpdateInterest(chanPtr);
+ } else if ((len > 2) && (optionName[1] == 'e') &&
(strncmp(optionName, "-eofchar", len) == 0)) {
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if (argc == 0) {
- chanPtr->inEofChar = 0;
- chanPtr->outEofChar = 0;
+ statePtr->inEofChar = 0;
+ statePtr->outEofChar = 0;
} else if (argc == 1) {
- if (chanPtr->flags & TCL_WRITABLE) {
- chanPtr->outEofChar = (int) argv[0][0];
+ if (statePtr->flags & TCL_WRITABLE) {
+ statePtr->outEofChar = (int) argv[0][0];
}
- if (chanPtr->flags & TCL_READABLE) {
- chanPtr->inEofChar = (int) argv[0][0];
+ if (statePtr->flags & TCL_READABLE) {
+ statePtr->inEofChar = (int) argv[0][0];
}
} else if (argc != 2) {
if (interp) {
@@ -4307,20 +5844,18 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
ckfree((char *) argv);
return TCL_ERROR;
} else {
- if (chanPtr->flags & TCL_READABLE) {
- chanPtr->inEofChar = (int) argv[0][0];
+ if (statePtr->flags & TCL_READABLE) {
+ statePtr->inEofChar = (int) argv[0][0];
}
- if (chanPtr->flags & TCL_WRITABLE) {
- chanPtr->outEofChar = (int) argv[1][0];
+ if (statePtr->flags & TCL_WRITABLE) {
+ statePtr->outEofChar = (int) argv[1][0];
}
}
if (argv != (char **) NULL) {
ckfree((char *) argv);
}
- return TCL_OK;
- }
-
- if ((len > 1) && (optionName[1] == 't') &&
+ return TCL_OK;
+ } else if ((len > 1) && (optionName[1] == 't') &&
(strncmp(optionName, "-translation", len) == 0)) {
char *readMode, *writeMode;
@@ -4329,11 +5864,11 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
}
if (argc == 1) {
- readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
+ readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
+ writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
} else if (argc == 2) {
- readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
+ readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
+ writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
} else {
if (interp) {
Tcl_AppendResult(interp,
@@ -4346,12 +5881,14 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
if (readMode) {
if (*readMode == '\0') {
- newMode = chanPtr->inputTranslation;
+ newMode = statePtr->inputTranslation;
} else if (strcmp(readMode, "auto") == 0) {
newMode = TCL_TRANSLATE_AUTO;
} else if (strcmp(readMode, "binary") == 0) {
- chanPtr->inEofChar = 0;
newMode = TCL_TRANSLATE_LF;
+ statePtr->inEofChar = 0;
+ Tcl_FreeEncoding(statePtr->encoding);
+ statePtr->encoding = NULL;
} else if (strcmp(readMode, "lf") == 0) {
newMode = TCL_TRANSLATE_LF;
} else if (strcmp(readMode, "cr") == 0) {
@@ -4377,10 +5914,10 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* complete the line.
*/
- if (newMode != chanPtr->inputTranslation) {
- chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
- chanPtr->flags &= ~(INPUT_SAW_CR);
- chanPtr->flags &= ~(CHANNEL_GETS_BLOCKED);
+ if (newMode != statePtr->inputTranslation) {
+ statePtr->inputTranslation = (Tcl_EolTranslation) newMode;
+ statePtr->flags &= ~(INPUT_SAW_CR);
+ statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
}
}
@@ -4396,21 +5933,23 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
*/
if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
- chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
+ statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else {
- chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+ statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
}
} else if (strcmp(writeMode, "binary") == 0) {
- chanPtr->outEofChar = 0;
- chanPtr->outputTranslation = TCL_TRANSLATE_LF;
+ statePtr->outEofChar = 0;
+ statePtr->outputTranslation = TCL_TRANSLATE_LF;
+ Tcl_FreeEncoding(statePtr->encoding);
+ statePtr->encoding = NULL;
} else if (strcmp(writeMode, "lf") == 0) {
- chanPtr->outputTranslation = TCL_TRANSLATE_LF;
+ statePtr->outputTranslation = TCL_TRANSLATE_LF;
} else if (strcmp(writeMode, "cr") == 0) {
- chanPtr->outputTranslation = TCL_TRANSLATE_CR;
+ statePtr->outputTranslation = TCL_TRANSLATE_CR;
} else if (strcmp(writeMode, "crlf") == 0) {
- chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
+ statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else if (strcmp(writeMode, "platform") == 0) {
- chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
+ statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
Tcl_AppendResult(interp,
@@ -4424,14 +5963,44 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
}
ckfree((char *) argv);
return TCL_OK;
+ } else if (chanPtr->typePtr->setOptionProc != NULL) {
+ return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
+ interp, optionName, newValue);
+ } else {
+ return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
}
- if (chanPtr->typePtr->setOptionProc != (Tcl_DriverSetOptionProc *) NULL) {
- return (chanPtr->typePtr->setOptionProc) (chanPtr->instanceData,
- interp, optionName, newValue);
+ /*
+ * 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) {
+ if ((statePtr->inQueueHead->nextPtr == NULL)
+ && (statePtr->inQueueHead->nextAdded ==
+ statePtr->inQueueHead->nextRemoved)) {
+ RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
+ }
}
-
- return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
+
+ /*
+ * If encoding or bufsize changes, need to update output staging buffer.
+ */
+
+ if (statePtr->outputStage != NULL) {
+ ckfree((char *) statePtr->outputStage);
+ statePtr->outputStage = NULL;
+ }
+ if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+ statePtr->outputStage = (char *)
+ ckalloc((unsigned) (statePtr->bufSize + 2));
+ }
+ return TCL_OK;
}
/*
@@ -4459,6 +6028,7 @@ CleanupChannelHandlers(interp, chanPtr)
Tcl_Interp *interp;
Channel *chanPtr;
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *sPtr, *prevPtr, *nextPtr;
/*
@@ -4466,22 +6036,22 @@ CleanupChannelHandlers(interp, chanPtr)
* given interpreter.
*/
- for (sPtr = chanPtr->scriptRecordPtr,
+ for (sPtr = statePtr->scriptRecordPtr,
prevPtr = (EventScriptRecord *) NULL;
- sPtr != (EventScriptRecord *) NULL;
- sPtr = nextPtr) {
+ sPtr != (EventScriptRecord *) NULL;
+ sPtr = nextPtr) {
nextPtr = sPtr->nextPtr;
if (sPtr->interp == interp) {
if (prevPtr == (EventScriptRecord *) NULL) {
- chanPtr->scriptRecordPtr = nextPtr;
+ statePtr->scriptRecordPtr = nextPtr;
} else {
prevPtr->nextPtr = nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) sPtr);
+ TclChannelEventScriptInvoker, (ClientData) sPtr);
- ckfree(sPtr->script);
+ Tcl_DecrRefCount(sPtr->scriptPtr);
ckfree((char *) sPtr);
} else {
prevPtr = sPtr;
@@ -4516,10 +6086,64 @@ Tcl_NotifyChannel(channel, mask)
* which events were detected. */
{
Channel *chanPtr = (Channel *) channel;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelHandler *chPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler nh;
+#ifdef TCL_CHANNEL_VERSION_2
+ Channel* upChanPtr;
+ Tcl_ChannelType* upTypePtr;
/*
+ * In contrast to the other API functions this procedure walks towards
+ * the top of a stack and not down from it.
+ *
+ * The channel calling this procedure is the one who generated the event,
+ * and thus does not take part in handling it. IOW, its HandlerProc is
+ * not called, instead we begin with the channel above it.
+ *
+ * This behaviour also allows the transformation channels to
+ * generate their own events and pass them upward.
+ */
+
+ while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) {
+ upChanPtr = chanPtr->upChanPtr;
+ upTypePtr = upChanPtr->typePtr;
+
+ if ((Tcl_ChannelVersion(upTypePtr) == TCL_CHANNEL_VERSION_2) &&
+ (Tcl_ChannelHandlerProc(upTypePtr) !=
+ ((Tcl_DriverHandlerProc *) NULL))) {
+
+ Tcl_DriverHandlerProc* handlerProc =
+ Tcl_ChannelHandlerProc(upTypePtr);
+
+ mask = (*handlerProc) (upChanPtr->instanceData, mask);
+ }
+
+ /* ELSE:
+ * Ignore transformations which are unable to handle the event
+ * coming from below. Assume that they don't change the mask and
+ * pass it on.
+ */
+
+ chanPtr = upChanPtr;
+ }
+
+ channel = (Tcl_Channel) chanPtr;
+
+ /*
+ * Here we have either reached the top of the stack or the mask is
+ * empty. We break out of the procedure if it is the latter.
+ */
+
+ if (!mask) {
+ return;
+ }
+
+ /*
+ * We are now above the topmost channel in a stack and have events
+ * left. Now call the channel handlers as usual.
+ *
* Preserve the channel struct in case the script closes it.
*/
@@ -4532,9 +6156,9 @@ Tcl_NotifyChannel(channel, mask)
* complete.
*/
- if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
- FlushChannel(NULL, chanPtr, 1);
- mask &= ~TCL_WRITABLE;
+ if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+ FlushChannel(NULL, chanPtr, 1);
+ mask &= ~TCL_WRITABLE;
}
/*
@@ -4543,37 +6167,111 @@ Tcl_NotifyChannel(channel, mask)
*/
nh.nextHandlerPtr = (ChannelHandler *) NULL;
- nh.nestedHandlerPtr = nestedHandlerPtr;
- nestedHandlerPtr = &nh;
-
- for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+ nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
+ tsdPtr->nestedHandlerPtr = &nh;
- /*
- * If this channel handler is interested in any of the events that
- * have occurred on the channel, invoke its procedure.
- */
+ for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+
+ /*
+ * If this channel handler is interested in any of the events that
+ * have occurred on the channel, invoke its procedure.
+ */
- if ((chPtr->mask & mask) != 0) {
- nh.nextHandlerPtr = chPtr->nextPtr;
- (*(chPtr->proc))(chPtr->clientData, mask);
- chPtr = nh.nextHandlerPtr;
- } else {
- chPtr = chPtr->nextPtr;
- }
+ if ((chPtr->mask & mask) != 0) {
+ nh.nextHandlerPtr = chPtr->nextPtr;
+ (*(chPtr->proc))(chPtr->clientData, mask);
+ chPtr = nh.nextHandlerPtr;
+ } else {
+ chPtr = chPtr->nextPtr;
+ }
}
/*
* Update the notifier interest, since it may have changed after
- * invoking event handlers.
+ * invoking event handlers. Skip that if the channel was deleted
+ * in the call to the channel handler.
*/
if (chanPtr->typePtr != NULL) {
- UpdateInterest(chanPtr);
+ UpdateInterest(chanPtr);
}
Tcl_Release((ClientData) channel);
- nestedHandlerPtr = nh.nestedHandlerPtr;
+ tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
+#else
+ /* Walk all channels in a stack ! and notify them in order.
+ */
+
+ while (chanPtr != (Channel *) NULL) {
+ /*
+ * Preserve the channel struct in case the script closes it.
+ */
+
+ Tcl_Preserve((ClientData) channel);
+
+ /*
+ * If we are flushing in the background, be sure to call FlushChannel
+ * for writable events. Note that we have to discard the writable
+ * event so we don't call any write handlers before the flush is
+ * complete.
+ */
+
+ if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+ FlushChannel(NULL, chanPtr, 1);
+ mask &= ~TCL_WRITABLE;
+ }
+
+ /*
+ * Add this invocation to the list of recursive invocations of
+ * ChannelHandlerEventProc.
+ */
+
+ nh.nextHandlerPtr = (ChannelHandler *) NULL;
+ nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
+ tsdPtr->nestedHandlerPtr = &nh;
+
+ for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+
+ /*
+ * If this channel handler is interested in any of the events that
+ * have occurred on the channel, invoke its procedure.
+ */
+
+ if ((chPtr->mask & mask) != 0) {
+ nh.nextHandlerPtr = chPtr->nextPtr;
+ (*(chPtr->proc))(chPtr->clientData, mask);
+ chPtr = nh.nextHandlerPtr;
+ } else {
+ chPtr = chPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Update the notifier interest, since it may have changed after
+ * invoking event handlers. Skip that if the channel was deleted
+ * in the call to the channel handler.
+ */
+
+ if (chanPtr->typePtr != NULL) {
+ UpdateInterest(chanPtr);
+
+ /* Walk down the stack.
+ */
+ chanPtr = chanPtr->downChanPtr;
+ } else {
+ /* Stop walking the chain, the whole stack was destroyed!
+ */
+ chanPtr = (Channel *) NULL;
+ }
+
+ Tcl_Release((ClientData) channel);
+
+ tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
+
+ channel = (Tcl_Channel) chanPtr;
+ }
+#endif
}
/*
@@ -4597,32 +6295,33 @@ static void
UpdateInterest(chanPtr)
Channel *chanPtr; /* Channel to update. */
{
- int mask = chanPtr->interestMask;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ int mask = statePtr->interestMask;
/*
* If there are flushed buffers waiting to be written, then
* we need to watch for the channel to become writable.
*/
- if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
mask |= TCL_WRITABLE;
}
/*
- * If there is data in the input queue, and we aren't blocked waiting for
- * an EOL, then we need to schedule a timer so we don't block in the
+ * If there is data in the input queue, and we aren't waiting for more
+ * data, then we need to schedule a timer so we don't block in the
* notifier. Also, cancel the read interest so we don't get duplicate
* events.
*/
if (mask & TCL_READABLE) {
- if (!(chanPtr->flags & CHANNEL_GETS_BLOCKED)
- && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
- && (chanPtr->inQueueHead->nextRemoved <
- chanPtr->inQueueHead->nextAdded)) {
+ if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
+ && (statePtr->inQueueHead->nextRemoved <
+ statePtr->inQueueHead->nextAdded)) {
mask &= ~TCL_READABLE;
- if (!chanPtr->timer) {
- chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
+ if (!statePtr->timer) {
+ statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
(ClientData) chanPtr);
}
}
@@ -4652,23 +6351,24 @@ ChannelTimerProc(clientData)
ClientData clientData;
{
Channel *chanPtr = (Channel *) clientData;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
- if (!(chanPtr->flags & CHANNEL_GETS_BLOCKED)
- && (chanPtr->interestMask & TCL_READABLE)
- && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
- && (chanPtr->inQueueHead->nextRemoved <
- chanPtr->inQueueHead->nextAdded)) {
+ if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ && (statePtr->interestMask & TCL_READABLE)
+ && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
+ && (statePtr->inQueueHead->nextRemoved <
+ statePtr->inQueueHead->nextAdded)) {
/*
* Restart the timer in case a channel handler reenters the
* event loop before UpdateInterest gets called by Tcl_NotifyChannel.
*/
- chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
- (ClientData) chanPtr);
+ statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
+ (ClientData) chanPtr);
Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
- } else {
- chanPtr->timer = NULL;
+ } else {
+ statePtr->timer = NULL;
UpdateInterest(chanPtr);
}
}
@@ -4708,19 +6408,18 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
ClientData clientData; /* Arbitrary data to pass to proc. */
{
ChannelHandler *chPtr;
- Channel *chanPtr;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
- chanPtr = (Channel *) chan;
-
/*
* Check whether this channel handler is not already registered. If
* it is not, create a new record, else reuse existing record (smash
* current values).
*/
- for (chPtr = chanPtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chPtr->nextPtr) {
+ for (chPtr = statePtr->chPtr;
+ chPtr != (ChannelHandler *) NULL;
+ chPtr = chPtr->nextPtr) {
if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
(chPtr->clientData == clientData)) {
break;
@@ -4732,8 +6431,8 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
chPtr->proc = proc;
chPtr->clientData = clientData;
chPtr->chanPtr = chanPtr;
- chPtr->nextPtr = chanPtr->chPtr;
- chanPtr->chPtr = chPtr;
+ chPtr->nextPtr = statePtr->chPtr;
+ statePtr->chPtr = chPtr;
}
/*
@@ -4749,14 +6448,14 @@ Tcl_CreateChannelHandler(chan, mask, proc, clientData)
* be disabling an existing handler.
*/
- chanPtr->interestMask = 0;
- for (chPtr = chanPtr->chPtr;
+ statePtr->interestMask = 0;
+ for (chPtr = statePtr->chPtr;
chPtr != (ChannelHandler *) NULL;
chPtr = chPtr->nextPtr) {
- chanPtr->interestMask |= chPtr->mask;
+ statePtr->interestMask |= chPtr->mask;
}
- UpdateInterest(chanPtr);
+ UpdateInterest(statePtr->topChanPtr);
}
/*
@@ -4787,26 +6486,26 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
* to delete. */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ChannelHandler *chPtr, *prevChPtr;
- Channel *chanPtr;
+ Channel *chanPtr = (Channel *) chan;
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
NextChannelHandler *nhPtr;
- chanPtr = (Channel *) chan;
-
/*
* Find the entry and the previous one in the list.
*/
- for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chPtr->nextPtr) {
+ for (prevChPtr = (ChannelHandler *) NULL, chPtr = statePtr->chPtr;
+ chPtr != (ChannelHandler *) NULL;
+ chPtr = chPtr->nextPtr) {
if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
&& (chPtr->proc == proc)) {
break;
}
prevChPtr = chPtr;
}
-
+
/*
* If not found, return without doing anything.
*/
@@ -4820,9 +6519,9 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
* process the next one instead - we are going to delete *this* one.
*/
- for (nhPtr = nestedHandlerPtr;
- nhPtr != (NextChannelHandler *) NULL;
- nhPtr = nhPtr->nestedHandlerPtr) {
+ for (nhPtr = tsdPtr->nestedHandlerPtr;
+ nhPtr != (NextChannelHandler *) NULL;
+ nhPtr = nhPtr->nestedHandlerPtr) {
if (nhPtr->nextHandlerPtr == chPtr) {
nhPtr->nextHandlerPtr = chPtr->nextPtr;
}
@@ -4833,7 +6532,7 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
*/
if (prevChPtr == (ChannelHandler *) NULL) {
- chanPtr->chPtr = chPtr->nextPtr;
+ statePtr->chPtr = chPtr->nextPtr;
} else {
prevChPtr->nextPtr = chPtr->nextPtr;
}
@@ -4841,17 +6540,18 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
/*
* Recompute the interest list for the channel, so that infinite loops
- * will not result if Tcl_DeleteChanelHandler is called inside an event.
+ * will not result if Tcl_DeleteChannelHandler is called inside an
+ * event.
*/
- chanPtr->interestMask = 0;
- for (chPtr = chanPtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chPtr->nextPtr) {
- chanPtr->interestMask |= chPtr->mask;
+ statePtr->interestMask = 0;
+ for (chPtr = statePtr->chPtr;
+ chPtr != (ChannelHandler *) NULL;
+ chPtr = chPtr->nextPtr) {
+ statePtr->interestMask |= chPtr->mask;
}
- UpdateInterest(chanPtr);
+ UpdateInterest(statePtr->topChanPtr);
}
/*
@@ -4880,23 +6580,24 @@ DeleteScriptRecord(interp, chanPtr, mask)
int mask; /* Events in mask must exactly match mask
* of script to delete. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *esPtr, *prevEsPtr;
- for (esPtr = chanPtr->scriptRecordPtr,
+ for (esPtr = statePtr->scriptRecordPtr,
prevEsPtr = (EventScriptRecord *) NULL;
- esPtr != (EventScriptRecord *) NULL;
- prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
+ esPtr != (EventScriptRecord *) NULL;
+ prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
- if (esPtr == chanPtr->scriptRecordPtr) {
- chanPtr->scriptRecordPtr = esPtr->nextPtr;
+ if (esPtr == statePtr->scriptRecordPtr) {
+ statePtr->scriptRecordPtr = esPtr->nextPtr;
} else {
prevEsPtr->nextPtr = esPtr->nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) esPtr);
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
- ckfree(esPtr->script);
+ Tcl_DecrRefCount(esPtr->scriptPtr);
ckfree((char *) esPtr);
break;
@@ -4922,24 +6623,24 @@ DeleteScriptRecord(interp, chanPtr, mask)
*/
static void
-CreateScriptRecord(interp, chanPtr, mask, script)
+CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
Tcl_Interp *interp; /* Interpreter in which to execute
* the stored script. */
Channel *chanPtr; /* Channel for which script is to
* be stored. */
int mask; /* Set of events for which script
* will be invoked. */
- char *script; /* A copy of this script is stored
- * in the newly created record. */
+ Tcl_Obj *scriptPtr; /* Pointer to script object. */
{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
EventScriptRecord *esPtr;
- for (esPtr = chanPtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
- esPtr = esPtr->nextPtr) {
+ for (esPtr = statePtr->scriptRecordPtr;
+ esPtr != (EventScriptRecord *) NULL;
+ esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
- ckfree(esPtr->script);
- esPtr->script = (char *) NULL;
+ Tcl_DecrRefCount(esPtr->scriptPtr);
+ esPtr->scriptPtr = (Tcl_Obj *) NULL;
break;
}
}
@@ -4947,21 +6648,21 @@ CreateScriptRecord(interp, chanPtr, mask, script)
esPtr = (EventScriptRecord *) ckalloc((unsigned)
sizeof(EventScriptRecord));
Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- ChannelEventScriptInvoker, (ClientData) esPtr);
- esPtr->nextPtr = chanPtr->scriptRecordPtr;
- chanPtr->scriptRecordPtr = esPtr;
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+ esPtr->nextPtr = statePtr->scriptRecordPtr;
+ statePtr->scriptRecordPtr = esPtr;
}
esPtr->chanPtr = chanPtr;
esPtr->interp = interp;
esPtr->mask = mask;
- esPtr->script = ckalloc((unsigned) (strlen(script) + 1));
- strcpy(esPtr->script, script);
+ Tcl_IncrRefCount(scriptPtr);
+ esPtr->scriptPtr = scriptPtr;
}
/*
*----------------------------------------------------------------------
*
- * ChannelEventScriptInvoker --
+ * TclChannelEventScriptInvoker --
*
* Invokes a script scheduled by "fileevent" for when the channel
* becomes ready for IO. This function is invoked by the channel
@@ -4976,25 +6677,22 @@ CreateScriptRecord(interp, chanPtr, mask, script)
*----------------------------------------------------------------------
*/
-static void
-ChannelEventScriptInvoker(clientData, mask)
+void
+TclChannelEventScriptInvoker(clientData, mask)
ClientData clientData; /* The script+interp record. */
int mask; /* Not used. */
{
Tcl_Interp *interp; /* Interpreter in which to eval the script. */
Channel *chanPtr; /* The channel for which this handler is
* registered. */
- char *script; /* Script to eval. */
EventScriptRecord *esPtr; /* The event script + interpreter to eval it
* in. */
int result; /* Result of call to eval script. */
- esPtr = (EventScriptRecord *) clientData;
-
- chanPtr = esPtr->chanPtr;
- mask = esPtr->mask;
- interp = esPtr->interp;
- script = esPtr->script;
+ esPtr = (EventScriptRecord *) clientData;
+ chanPtr = esPtr->chanPtr;
+ mask = esPtr->mask;
+ interp = esPtr->interp;
/*
* We must preserve the interpreter so we can report errors on it
@@ -5003,7 +6701,7 @@ ChannelEventScriptInvoker(clientData, mask)
*/
Tcl_Preserve((ClientData) interp);
- result = Tcl_GlobalEval(interp, script);
+ result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
/*
* On error, cause a background error and remove the channel handler
@@ -5025,7 +6723,7 @@ ChannelEventScriptInvoker(clientData, mask)
/*
*----------------------------------------------------------------------
*
- * Tcl_FileEventCmd --
+ * Tcl_FileEventObjCmd --
*
* This procedure implements the "fileevent" Tcl command. See the
* user documentation for details on what it does. This command is
@@ -5043,48 +6741,42 @@ ChannelEventScriptInvoker(clientData, mask)
/* ARGSUSED */
int
-Tcl_FileEventCmd(clientData, interp, argc, argv)
+Tcl_FileEventObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter in which the channel
* for which to create the handler
* is found. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Channel *chanPtr; /* The channel to create
* the handler for. */
+ ChannelState *statePtr; /* state info for channel */
Tcl_Channel chan; /* The opaque type for the channel. */
- int c; /* First char of mode argument. */
- int mask; /* Mask for events of interest. */
- size_t length; /* Length of mode argument. */
-
- /*
- * Parse arguments.
- */
+ char *chanName;
+ int modeIndex; /* Index of mode argument. */
+ int mask;
+ static char *modeOptions[] = {"readable", "writable", NULL};
+ static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
- " channelId event ?script?", (char *) NULL);
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
return TCL_ERROR;
}
- c = argv[2][0];
- length = strlen(argv[2]);
- if ((c == 'r') && (strncmp(argv[2], "readable", length) == 0)) {
- mask = TCL_READABLE;
- } else if ((c == 'w') && (strncmp(argv[2], "writable", length) == 0)) {
- mask = TCL_WRITABLE;
- } else {
- Tcl_AppendResult(interp, "bad event name \"", argv[2],
- "\": must be readable or writable", (char *) NULL);
+ if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
+ &modeIndex) != TCL_OK) {
return TCL_ERROR;
}
- chan = Tcl_GetChannel(interp, argv[1], NULL);
+ mask = maskArray[modeIndex];
+
+ chanName = Tcl_GetString(objv[1]);
+ chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
-
- chanPtr = (Channel *) chan;
- if ((chanPtr->flags & mask) == 0) {
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+ if ((statePtr->flags & mask) == 0) {
Tcl_AppendResult(interp, "channel is not ",
(mask == TCL_READABLE) ? "readable" : "writable",
(char *) NULL);
@@ -5095,13 +6787,13 @@ Tcl_FileEventCmd(clientData, interp, argc, argv)
* If we are supposed to return the script, do so.
*/
- if (argc == 3) {
+ if (objc == 3) {
EventScriptRecord *esPtr;
- for (esPtr = chanPtr->scriptRecordPtr;
+ for (esPtr = statePtr->scriptRecordPtr;
esPtr != (EventScriptRecord *) NULL;
esPtr = esPtr->nextPtr) {
if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
- Tcl_SetResult(interp, esPtr->script, TCL_STATIC);
+ Tcl_SetObjResult(interp, esPtr->scriptPtr);
break;
}
}
@@ -5112,7 +6804,7 @@ Tcl_FileEventCmd(clientData, interp, argc, argv)
* If we are supposed to delete a stored script, do so.
*/
- if (argv[3][0] == 0) {
+ if (*(Tcl_GetString(objv[3])) == '\0') {
DeleteScriptRecord(interp, chanPtr, mask);
return TCL_OK;
}
@@ -5123,7 +6815,7 @@ Tcl_FileEventCmd(clientData, interp, argc, argv)
* will evaluate the script in the supplied interpreter.
*/
- CreateScriptRecord(interp, chanPtr, mask, argv[3]);
+ CreateScriptRecord(interp, chanPtr, mask, objv[3]);
return TCL_OK;
}
@@ -5131,536 +6823,6 @@ Tcl_FileEventCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * TclTestChannelCmd --
- *
- * Implements the Tcl "testchannel" debugging command and its
- * subcommands. This is part of the testing environment but must be
- * in this file instead of tclTest.c because it needs access to the
- * fields of struct Channel.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-int
-TclTestChannelCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter for result. */
- int argc; /* Count of additional args. */
- char **argv; /* Additional arg strings. */
-{
- char *cmdName; /* Sub command. */
- Tcl_HashTable *hTblPtr; /* Hash table of channels. */
- Tcl_HashSearch hSearch; /* Search variable. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- Channel *chanPtr; /* The actual channel. */
- Tcl_Channel chan; /* The opaque type. */
- size_t len; /* Length of subcommand string. */
- int IOQueued; /* How much IO is queued inside channel? */
- ChannelBuffer *bufPtr; /* For iterating over queued IO. */
- char buf[128]; /* For sprintf. */
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " subcommand ?additional args..?\"", (char *) NULL);
- return TCL_ERROR;
- }
- cmdName = argv[1];
- len = strlen(cmdName);
-
- chanPtr = (Channel *) NULL;
- if (argc > 2) {
- chan = Tcl_GetChannel(interp, argv[2], NULL);
- if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
- }
- chanPtr = (Channel *) chan;
- }
-
- if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " info channelName\"", (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendElement(interp, argv[2]);
- Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
- if (chanPtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, "read");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, "write");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
- Tcl_AppendElement(interp, "nonblocking");
- } else {
- Tcl_AppendElement(interp, "blocking");
- }
- if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
- Tcl_AppendElement(interp, "line");
- } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
- Tcl_AppendElement(interp, "none");
- } else {
- Tcl_AppendElement(interp, "full");
- }
- if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
- Tcl_AppendElement(interp, "async_flush");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & CHANNEL_EOF) {
- Tcl_AppendElement(interp, "eof");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & CHANNEL_BLOCKED) {
- Tcl_AppendElement(interp, "blocked");
- } else {
- Tcl_AppendElement(interp, "unblocked");
- }
- if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
- Tcl_AppendElement(interp, "auto");
- if (chanPtr->flags & INPUT_SAW_CR) {
- Tcl_AppendElement(interp, "saw_cr");
- } else {
- Tcl_AppendElement(interp, "");
- }
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
- Tcl_AppendElement(interp, "lf");
- Tcl_AppendElement(interp, "");
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
- Tcl_AppendElement(interp, "cr");
- Tcl_AppendElement(interp, "");
- } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
- Tcl_AppendElement(interp, "crlf");
- if (chanPtr->flags & INPUT_SAW_CR) {
- Tcl_AppendElement(interp, "queued_cr");
- } else {
- Tcl_AppendElement(interp, "");
- }
- }
- if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
- Tcl_AppendElement(interp, "auto");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
- Tcl_AppendElement(interp, "lf");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
- Tcl_AppendElement(interp, "cr");
- } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
- Tcl_AppendElement(interp, "crlf");
- }
- for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
- }
- TclFormatInt(buf, IOQueued);
- Tcl_AppendElement(interp, buf);
-
- IOQueued = 0;
- if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
- IOQueued = chanPtr->curOutPtr->nextAdded -
- chanPtr->curOutPtr->nextRemoved;
- }
- for (bufPtr = chanPtr->outQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
- TclFormatInt(buf, IOQueued);
- Tcl_AppendElement(interp, buf);
-
- TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
- Tcl_AppendElement(interp, buf);
-
- TclFormatInt(buf, chanPtr->refCount);
- Tcl_AppendElement(interp, buf);
-
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'i') &&
- (strncmp(cmdName, "inputbuffered", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
- }
- sprintf(buf, "%d", IOQueued);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- if (chanPtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, "read");
- } else {
- Tcl_AppendElement(interp, "");
- }
- if (chanPtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, "write");
- } else {
- Tcl_AppendElement(interp, "");
- }
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'o') &&
- (strncmp(cmdName, "outputbuffered", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- IOQueued = 0;
- if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
- IOQueued = chanPtr->curOutPtr->nextAdded -
- chanPtr->curOutPtr->nextRemoved;
- }
- for (bufPtr = chanPtr->outQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
- sprintf(buf, "%d", IOQueued);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'q') &&
- (strncmp(cmdName, "queuedcr", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- Tcl_AppendResult(interp,
- (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
- (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
- if (chanPtr->flags & TCL_READABLE) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- }
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- sprintf(buf, "%d", chanPtr->refCount);
- Tcl_AppendResult(interp, buf, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "channel name required",
- (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
- return TCL_OK;
- }
-
- if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_OK;
- }
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
- if (chanPtr->flags & TCL_WRITABLE) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
- }
- }
- return TCL_OK;
- }
-
- Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
- "info, open, readable, or writable",
- (char *) NULL);
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclTestChannelEventCmd --
- *
- * This procedure implements the "testchannelevent" command. It is
- * used to test the Tcl channel event mechanism. It is present in
- * this file instead of tclTest.c because it needs access to the
- * internal structure of the channel.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Creates, deletes and returns channel event handlers.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-int
-TclTestChannelEventCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
-{
- Channel *chanPtr;
- EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
- char *cmd;
- int index, i, mask, len;
-
- if ((argc < 3) || (argc > 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
- return TCL_ERROR;
- }
- chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
- if (chanPtr == (Channel *) NULL) {
- return TCL_ERROR;
- }
- cmd = argv[2];
- len = strlen(cmd);
- if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName add eventSpec script\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (strcmp(argv[3], "readable") == 0) {
- mask = TCL_READABLE;
- } else if (strcmp(argv[3], "writable") == 0) {
- mask = TCL_WRITABLE;
- } else if (strcmp(argv[3], "none") == 0) {
- mask = 0;
- } else {
- Tcl_AppendResult(interp, "bad event name \"", argv[3],
- "\": must be readable, writable, or none", (char *) NULL);
- return TCL_ERROR;
- }
-
- esPtr = (EventScriptRecord *) ckalloc((unsigned)
- sizeof(EventScriptRecord));
- esPtr->nextPtr = chanPtr->scriptRecordPtr;
- chanPtr->scriptRecordPtr = esPtr;
-
- esPtr->chanPtr = chanPtr;
- esPtr->interp = interp;
- esPtr->mask = mask;
- esPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
- strcpy(esPtr->script, argv[4]);
-
- Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- ChannelEventScriptInvoker, (ClientData) esPtr);
-
- return TCL_OK;
- }
-
- if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName delete index\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if (index < 0) {
- Tcl_AppendResult(interp, "bad event index: ", argv[3],
- ": must be nonnegative", (char *) NULL);
- return TCL_ERROR;
- }
- for (i = 0, esPtr = chanPtr->scriptRecordPtr;
- (i < index) && (esPtr != (EventScriptRecord *) NULL);
- i++, esPtr = esPtr->nextPtr) {
- /* Empty loop body. */
- }
- if (esPtr == (EventScriptRecord *) NULL) {
- Tcl_AppendResult(interp, "bad event index ", argv[3],
- ": out of range", (char *) NULL);
- return TCL_ERROR;
- }
- if (esPtr == chanPtr->scriptRecordPtr) {
- chanPtr->scriptRecordPtr = esPtr->nextPtr;
- } else {
- for (prevEsPtr = chanPtr->scriptRecordPtr;
- (prevEsPtr != (EventScriptRecord *) NULL) &&
- (prevEsPtr->nextPtr != esPtr);
- prevEsPtr = prevEsPtr->nextPtr) {
- /* Empty loop body. */
- }
- if (prevEsPtr == (EventScriptRecord *) NULL) {
- panic("TclTestChannelEventCmd: damaged event script list");
- }
- prevEsPtr->nextPtr = esPtr->nextPtr;
- }
- Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) esPtr);
- ckfree(esPtr->script);
- ckfree((char *) esPtr);
-
- return TCL_OK;
- }
-
- if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName list\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (esPtr = chanPtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
- esPtr = esPtr->nextPtr) {
- char *event;
- if (esPtr->mask) {
- event = ((esPtr->mask == TCL_READABLE)
- ? "readable" : "writable");
- } else {
- event = "none";
- }
- Tcl_AppendElement(interp, event);
- Tcl_AppendElement(interp, esPtr->script);
- }
- return TCL_OK;
- }
-
- if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName removeall\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (esPtr = chanPtr->scriptRecordPtr;
- esPtr != (EventScriptRecord *) NULL;
- esPtr = nextEsPtr) {
- nextEsPtr = esPtr->nextPtr;
- Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- ChannelEventScriptInvoker, (ClientData) esPtr);
- ckfree(esPtr->script);
- ckfree((char *) esPtr);
- }
- chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
- return TCL_OK;
- }
-
- if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelName delete index event\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if (index < 0) {
- Tcl_AppendResult(interp, "bad event index: ", argv[3],
- ": must be nonnegative", (char *) NULL);
- return TCL_ERROR;
- }
- for (i = 0, esPtr = chanPtr->scriptRecordPtr;
- (i < index) && (esPtr != (EventScriptRecord *) NULL);
- i++, esPtr = esPtr->nextPtr) {
- /* Empty loop body. */
- }
- if (esPtr == (EventScriptRecord *) NULL) {
- Tcl_AppendResult(interp, "bad event index ", argv[3],
- ": out of range", (char *) NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[4], "readable") == 0) {
- mask = TCL_READABLE;
- } else if (strcmp(argv[4], "writable") == 0) {
- mask = TCL_WRITABLE;
- } else if (strcmp(argv[4], "none") == 0) {
- mask = 0;
- } else {
- Tcl_AppendResult(interp, "bad event name \"", argv[4],
- "\": must be readable, writable, or none", (char *) NULL);
- return TCL_ERROR;
- }
- esPtr->mask = mask;
- Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- ChannelEventScriptInvoker, (ClientData) esPtr);
- return TCL_OK;
- }
- Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
- "add, delete, list, set, or removeall", (char *) NULL);
- return TCL_ERROR;
-
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclCopyChannel --
*
* This routine copies data from one channel to another, either
@@ -5689,23 +6851,27 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
{
Channel *inPtr = (Channel *) inChan;
Channel *outPtr = (Channel *) outChan;
+ ChannelState *inStatePtr, *outStatePtr;
int readFlags, writeFlags;
CopyState *csPtr;
int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
- if (inPtr->csPtr) {
+ inStatePtr = inPtr->state;
+ outStatePtr = outPtr->state;
+
+ if (inStatePtr->csPtr) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
Tcl_GetChannelName(inChan), "\" is busy", NULL);
return TCL_ERROR;
}
- if (outPtr->csPtr) {
+ if (outStatePtr->csPtr) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
Tcl_GetChannelName(outChan), "\" is busy", NULL);
return TCL_ERROR;
}
- readFlags = inPtr->flags;
- writeFlags = outPtr->flags;
+ readFlags = inStatePtr->flags;
+ writeFlags = outStatePtr->flags;
/*
* Set up the blocking mode appropriately. Background copies need
@@ -5739,7 +6905,7 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
* Make sure the output side is unbuffered.
*/
- outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))
+ outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
| CHANNEL_UNBUFFERED;
/*
@@ -5748,21 +6914,21 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
* completed.
*/
- csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);
- csPtr->bufSize = inPtr->bufSize;
- csPtr->readPtr = inPtr;
- csPtr->writePtr = outPtr;
- csPtr->readFlags = readFlags;
+ csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
+ csPtr->bufSize = inStatePtr->bufSize;
+ csPtr->readPtr = inPtr;
+ csPtr->writePtr = outPtr;
+ csPtr->readFlags = readFlags;
csPtr->writeFlags = writeFlags;
- csPtr->toRead = toRead;
- csPtr->total = 0;
- csPtr->interp = interp;
+ csPtr->toRead = toRead;
+ csPtr->total = 0;
+ csPtr->interp = interp;
if (cmdPtr) {
Tcl_IncrRefCount(cmdPtr);
}
csPtr->cmdPtr = cmdPtr;
- inPtr->csPtr = csPtr;
- outPtr->csPtr = csPtr;
+ inStatePtr->csPtr = csPtr;
+ outStatePtr->csPtr = csPtr;
/*
* Start copying data between the channels.
@@ -5796,17 +6962,24 @@ CopyData(csPtr, mask)
Tcl_Interp *interp;
Tcl_Obj *cmdPtr, *errObj = NULL;
Tcl_Channel inChan, outChan;
+ ChannelState *inStatePtr, *outStatePtr;
int result = TCL_OK;
int size;
int total;
- inChan = (Tcl_Channel)csPtr->readPtr;
- outChan = (Tcl_Channel)csPtr->writePtr;
- interp = csPtr->interp;
- cmdPtr = csPtr->cmdPtr;
+ inChan = (Tcl_Channel) csPtr->readPtr;
+ outChan = (Tcl_Channel) csPtr->writePtr;
+ inStatePtr = csPtr->readPtr->state;
+ outStatePtr = csPtr->writePtr->state;
+ interp = csPtr->interp;
+ cmdPtr = csPtr->cmdPtr;
/*
* Copy the data the slow way, using the translation mechanism.
+ *
+ * Note: We have make sure that we use the topmost channel in a stack
+ * for the copying. The caller uses Tcl_GetChannel to access it, and
+ * thus gets the bottom of the stack.
*/
while (csPtr->toRead != 0) {
@@ -5815,14 +6988,14 @@ CopyData(csPtr, mask)
* Check for unreported background errors.
*/
- if (csPtr->readPtr->unreportedError != 0) {
- Tcl_SetErrno(csPtr->readPtr->unreportedError);
- csPtr->readPtr->unreportedError = 0;
+ if (inStatePtr->unreportedError != 0) {
+ Tcl_SetErrno(inStatePtr->unreportedError);
+ inStatePtr->unreportedError = 0;
goto readError;
}
- if (csPtr->writePtr->unreportedError != 0) {
- Tcl_SetErrno(csPtr->writePtr->unreportedError);
- csPtr->writePtr->unreportedError = 0;
+ if (outStatePtr->unreportedError != 0) {
+ Tcl_SetErrno(outStatePtr->unreportedError);
+ outStatePtr->unreportedError = 0;
goto writeError;
}
@@ -5830,13 +7003,12 @@ CopyData(csPtr, mask)
* Read up to bufSize bytes.
*/
- if ((csPtr->toRead == -1)
- || (csPtr->toRead > csPtr->bufSize)) {
+ if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
size = csPtr->bufSize;
} else {
size = csPtr->toRead;
}
- size = DoRead(csPtr->readPtr, csPtr->buffer, size);
+ size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, size);
if (size < 0) {
readError:
@@ -5869,7 +7041,7 @@ CopyData(csPtr, mask)
* Now write the buffer out.
*/
- size = DoWrite(csPtr->writePtr, csPtr->buffer, size);
+ size = DoWrite(outStatePtr->topChanPtr, csPtr->buffer, size);
if (size < 0) {
writeError:
errObj = Tcl_NewObj();
@@ -5884,7 +7056,7 @@ CopyData(csPtr, mask)
* stop copying and wait for the channel to become writable again.
*/
- if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (outStatePtr->flags & BG_FLUSH_SCHEDULED) {
if (!(mask & TCL_WRITABLE)) {
if (mask & TCL_READABLE) {
Tcl_DeleteChannelHandler(outChan, CopyEventProc,
@@ -5946,7 +7118,7 @@ CopyData(csPtr, mask)
if (errObj) {
Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
}
- if (Tcl_GlobalEvalObj(interp, cmdPtr) != TCL_OK) {
+ if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
Tcl_BackgroundError(interp);
result = TCL_ERROR;
}
@@ -5968,6 +7140,571 @@ CopyData(csPtr, mask)
/*
*----------------------------------------------------------------------
*
+ * DoRead --
+ *
+ * Reads a given number of bytes from a channel.
+ *
+ * Results:
+ * The number of characters read, or -1 on error. Use Tcl_GetErrno()
+ * to retrieve the error code for the error that occurred.
+ *
+ * Side effects:
+ * May cause input to be buffered.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DoRead(chanPtr, bufPtr, toRead)
+ Channel *chanPtr; /* The channel from which to read. */
+ char *bufPtr; /* Where to store input read. */
+ int toRead; /* Maximum number of bytes to read. */
+{
+ 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. */
+
+ /*
+ * 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 (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
+ statePtr->flags &= ~CHANNEL_EOF;
+ }
+ statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+
+ for (copied = 0; copied < toRead; copied += copiedNow) {
+ copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
+ toRead - copied);
+ if (copiedNow == 0) {
+ if (statePtr->flags & CHANNEL_EOF) {
+ goto done;
+ }
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ goto done;
+ }
+ statePtr->flags &= (~(CHANNEL_BLOCKED));
+ }
+ result = GetInput(chanPtr);
+ if (result != 0) {
+ if (result != EAGAIN) {
+ copied = -1;
+ }
+ goto done;
+ }
+ }
+ }
+
+ statePtr->flags &= (~(CHANNEL_BLOCKED));
+
+ done:
+ /*
+ * Update the notifier state so we don't block while there is still
+ * data in the buffers.
+ */
+
+ 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(statePtr, result, space)
+ 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 (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+ return 0;
+ }
+ bufPtr = statePtr->inQueueHead;
+ bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+
+ copied = 0;
+ switch (statePtr->inputTranslation) {
+ case TCL_TRANSLATE_LF: {
+ if (bytesInBuffer == 0) {
+ return 0;
+ }
+
+ /*
+ * Copy the current chunk into the result buffer.
+ */
+
+ if (bytesInBuffer < space) {
+ space = bytesInBuffer;
+ }
+ memcpy((VOID *) result,
+ (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
+ (size_t) space);
+ bufPtr->nextRemoved += space;
+ copied = space;
+ break;
+ }
+ case TCL_TRANSLATE_CR: {
+ char *end;
+
+ if (bytesInBuffer == 0) {
+ return 0;
+ }
+
+ /*
+ * Copy the current chunk into the result buffer, then
+ * replace all \r with \n.
+ */
+
+ if (bytesInBuffer < space) {
+ space = bytesInBuffer;
+ }
+ memcpy((VOID *) result,
+ (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
+ (size_t) space);
+ bufPtr->nextRemoved += space;
+ copied = space;
+
+ for (end = result + copied; result < end; result++) {
+ if (*result == '\r') {
+ *result = '\n';
+ }
+ }
+ break;
+ }
+ case TCL_TRANSLATE_CRLF: {
+ char *src, *end, *dst;
+ int curByte;
+
+ /*
+ * If there is a held-back "\r" at EOF, produce it now.
+ */
+
+ if (bytesInBuffer == 0) {
+ if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
+ (INPUT_SAW_CR | CHANNEL_EOF)) {
+ result[0] = '\r';
+ statePtr->flags &= ~INPUT_SAW_CR;
+ return 1;
+ }
+ return 0;
+ }
+
+ /*
+ * Copy the current chunk and replace "\r\n" with "\n"
+ * (but not standalone "\r"!).
+ */
+
+ if (bytesInBuffer < space) {
+ space = bytesInBuffer;
+ }
+ memcpy((VOID *) result,
+ (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
+ (size_t) space);
+ bufPtr->nextRemoved += space;
+ copied = space;
+
+ end = result + copied;
+ dst = result;
+ for (src = result; src < end; src++) {
+ curByte = *src;
+ if (curByte == '\n') {
+ statePtr->flags &= ~INPUT_SAW_CR;
+ } else if (statePtr->flags & INPUT_SAW_CR) {
+ statePtr->flags &= ~INPUT_SAW_CR;
+ *dst = '\r';
+ dst++;
+ }
+ if (curByte == '\r') {
+ statePtr->flags |= INPUT_SAW_CR;
+ } else {
+ *dst = (char) curByte;
+ dst++;
+ }
+ }
+ copied = dst - result;
+ break;
+ }
+ case TCL_TRANSLATE_AUTO: {
+ char *src, *end, *dst;
+ int curByte;
+
+ if (bytesInBuffer == 0) {
+ return 0;
+ }
+
+ /*
+ * Loop over the current buffer, converting "\r" and "\r\n"
+ * to "\n".
+ */
+
+ if (bytesInBuffer < space) {
+ space = bytesInBuffer;
+ }
+ memcpy((VOID *) result,
+ (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
+ (size_t) space);
+ bufPtr->nextRemoved += space;
+ copied = space;
+
+ end = result + copied;
+ dst = result;
+ for (src = result; src < end; src++) {
+ curByte = *src;
+ if (curByte == '\r') {
+ statePtr->flags |= INPUT_SAW_CR;
+ *dst = '\n';
+ dst++;
+ } else {
+ if ((curByte != '\n') ||
+ !(statePtr->flags & INPUT_SAW_CR)) {
+ *dst = (char) curByte;
+ dst++;
+ }
+ statePtr->flags &= ~INPUT_SAW_CR;
+ }
+ }
+ copied = dst - result;
+ break;
+ }
+ default: {
+ 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.
+ */
+
+ 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.
+ */
+
+ statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ statePtr->inputEncodingFlags |= TCL_ENCODING_END;
+ copied = i;
+ break;
+ }
+ }
+ }
+
+ /*
+ * If the current buffer is empty recycle it.
+ */
+
+ if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+ statePtr->inQueueHead = bufPtr->nextPtr;
+ if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+ statePtr->inQueueTail = (ChannelBuffer *) 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(chanPtr, result, space)
+ 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 == (ChannelBuffer *) NULL) {
+ return 0;
+ }
+ bufPtr = chanPtr->inQueueHead;
+ bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+
+ copied = 0;
+
+ if (bytesInBuffer == 0) {
+ RecycleBuffer(chanPtr->state, bufPtr, 0);
+ chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+ chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+ return 0;
+ }
+
+ /*
+ * Copy the current chunk into the result buffer.
+ */
+
+ if (bytesInBuffer < space) {
+ space = bytesInBuffer;
+ }
+
+ memcpy((VOID *) result,
+ (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
+ (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 (bufPtr->nextRemoved == bufPtr->nextAdded) {
+ chanPtr->inQueueHead = bufPtr->nextPtr;
+ if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+ chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+ }
+ RecycleBuffer(chanPtr->state, bufPtr, 0);
+ }
+
+ /*
+ * Return the number of characters copied into the result buffer.
+ */
+
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DoWrite(chanPtr, src, srcLen)
+ Channel *chanPtr; /* The channel to buffer output for. */
+ 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;
+ char *sPtr; /* Search variables for newline. */
+ int crsent; /* In CRLF eol translation mode,
+ * remember the fact that a CR was
+ * output to the channel without
+ * its following NL. */
+ int i; /* Loop index for newline search. */
+ int destCopied; /* How many bytes were used in this
+ * destination buffer to hold the
+ * output? */
+ int totalDestCopied; /* How many bytes total were
+ * copied to the channel buffer? */
+ int srcCopied; /* How many bytes were copied from
+ * the source string? */
+ char *destPtr; /* Where in line to copy to? */
+
+ /*
+ * If we are in network (or windows) translation mode, record the fact
+ * that we have not yet sent a CR to the channel.
+ */
+
+ crsent = 0;
+
+ /*
+ * Loop filling buffers and flushing them until all output has been
+ * consumed.
+ */
+
+ srcCopied = 0;
+ totalDestCopied = 0;
+
+ while (srcLen > 0) {
+
+ /*
+ * Make sure there is a current output buffer to accept output.
+ */
+
+ if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
+ statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
+ }
+
+ outBufPtr = statePtr->curOutPtr;
+
+ destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
+ if (destCopied > srcLen) {
+ destCopied = srcLen;
+ }
+
+ destPtr = outBufPtr->buf + outBufPtr->nextAdded;
+ switch (statePtr->outputTranslation) {
+ case TCL_TRANSLATE_LF:
+ srcCopied = destCopied;
+ memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
+ break;
+ case TCL_TRANSLATE_CR:
+ srcCopied = destCopied;
+ memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
+ for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
+ if (*dPtr == '\n') {
+ *dPtr = '\r';
+ }
+ }
+ break;
+ case TCL_TRANSLATE_CRLF:
+ for (srcCopied = 0, dPtr = destPtr, sPtr = src;
+ dPtr < destPtr + destCopied;
+ dPtr++, sPtr++, srcCopied++) {
+ if (*sPtr == '\n') {
+ if (crsent) {
+ *dPtr = '\n';
+ crsent = 0;
+ } else {
+ *dPtr = '\r';
+ crsent = 1;
+ sPtr--, srcCopied--;
+ }
+ } else {
+ *dPtr = *sPtr;
+ }
+ }
+ break;
+ case TCL_TRANSLATE_AUTO:
+ panic("Tcl_Write: AUTO output translation mode not supported");
+ default:
+ panic("Tcl_Write: unknown output translation mode");
+ }
+
+ /*
+ * The current buffer is ready for output if it is full, or if it
+ * contains a newline and this channel is line-buffered, or if it
+ * contains any output and this channel is unbuffered.
+ */
+
+ outBufPtr->nextAdded += destCopied;
+ if (!(statePtr->flags & BUFFER_READY)) {
+ if (outBufPtr->nextAdded == outBufPtr->bufLength) {
+ statePtr->flags |= BUFFER_READY;
+ } else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
+ for (sPtr = src, i = 0, foundNewline = 0;
+ (i < srcCopied) && (!foundNewline);
+ i++, sPtr++) {
+ if (*sPtr == '\n') {
+ foundNewline = 1;
+ break;
+ }
+ }
+ if (foundNewline) {
+ statePtr->flags |= BUFFER_READY;
+ }
+ } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+ statePtr->flags |= BUFFER_READY;
+ }
+ }
+
+ totalDestCopied += srcCopied;
+ src += srcCopied;
+ srcLen -= srcCopied;
+
+ if (statePtr->flags & BUFFER_READY) {
+ if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ return -1;
+ }
+ }
+ } /* Closes "while" */
+
+ return totalDestCopied;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* CopyEventProc --
*
* This routine is invoked as a channel event handler for
@@ -6012,42 +7749,543 @@ static void
StopCopy(csPtr)
CopyState *csPtr; /* State for bg copy to stop . */
{
+ ChannelState *inStatePtr, *outStatePtr;
int nonBlocking;
if (!csPtr) {
return;
}
+ inStatePtr = csPtr->readPtr->state;
+ outStatePtr = csPtr->writePtr->state;
+
/*
* Restore the old blocking mode and output buffering mode.
*/
nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
- if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {
+ if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->readPtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
- if (csPtr->writePtr != csPtr->writePtr) {
- if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {
+ if (csPtr->readPtr != csPtr->writePtr) {
+ if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->writePtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
}
- csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
- csPtr->writePtr->flags |=
+ outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+ outStatePtr->flags |=
csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
-
if (csPtr->cmdPtr) {
Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
- (ClientData)csPtr);
+ (ClientData)csPtr);
if (csPtr->readPtr != csPtr->writePtr) {
Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
CopyEventProc, (ClientData)csPtr);
}
Tcl_DecrRefCount(csPtr->cmdPtr);
}
- csPtr->readPtr->csPtr = NULL;
- csPtr->writePtr->csPtr = NULL;
+ inStatePtr->csPtr = NULL;
+ outStatePtr->csPtr = NULL;
ckfree((char*) csPtr);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StackSetBlockMode --
+ *
+ * This function sets the blocking mode for a channel, iterating
+ * through each channel in a stack and updates the state flags.
+ *
+ * Results:
+ * 0 if OK, result code from failed blockModeProc otherwise.
+ *
+ * Side effects:
+ * Modifies the blocking mode of the channel and possibly generates
+ * an error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StackSetBlockMode(chanPtr, mode)
+ Channel *chanPtr; /* Channel to modify. */
+ int mode; /* One of TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ int result = 0;
+ Tcl_DriverBlockModeProc *blockModeProc;
+
+ /*
+ * Start at the top of the channel stack
+ */
+
+ chanPtr = chanPtr->state->topChanPtr;
+ while (chanPtr != (Channel *) NULL) {
+ blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
+ if (blockModeProc != NULL) {
+ result = (*blockModeProc) (chanPtr->instanceData, mode);
+ if (result != 0) {
+ Tcl_SetErrno(result);
+ return result;
+ }
+ }
+ chanPtr = chanPtr->downChanPtr;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetBlockMode --
+ *
+ * This function sets the blocking mode for a channel and updates
+ * the state flags.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Modifies the blocking mode of the channel and possibly generates
+ * an error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetBlockMode(interp, chanPtr, mode)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+ Channel *chanPtr; /* Channel to modify. */
+ int mode; /* One of TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ int result = 0;
+
+ result = StackSetBlockMode(chanPtr, mode);
+ if (result != 0) {
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "error setting blocking mode: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (mode == TCL_MODE_BLOCKING) {
+ statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
+ } else {
+ statePtr->flags |= CHANNEL_NONBLOCKING;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelNames --
+ *
+ * Return the names of all open channels in the interp.
+ *
+ * Results:
+ * TCL_OK or TCL_ERROR.
+ *
+ * Side effects:
+ * Interp result modified with list of channel names.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetChannelNames(interp)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+{
+ return Tcl_GetChannelNamesEx(interp, (char *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelNamesEx --
+ *
+ * Return the names of open channels in the interp filtered
+ * filtered through a pattern. If pattern is NULL, it returns
+ * all the open channels.
+ *
+ * Results:
+ * TCL_OK or TCL_ERROR.
+ *
+ * Side effects:
+ * Interp result modified with list of channel names.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetChannelNamesEx(interp, pattern)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+ char *pattern; /* pattern to filter on. */
+{
+ ChannelState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ char *name;
+ Tcl_Obj *resultPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ for (statePtr = tsdPtr->firstCSPtr;
+ statePtr != NULL;
+ statePtr = statePtr->nextCSPtr) {
+ if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
+ name = "stdin";
+ } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
+ name = "stdout";
+ } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
+ name = "stderr";
+ } else {
+ name = statePtr->channelName;
+ }
+ if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
+ (Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(name, -1)) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelName --
+ *
+ * Return the name of the channel type.
+ *
+ * Results:
+ * A pointer the name of the channel type.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_ChannelName(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->typeName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelVersion --
+ *
+ * Return the of version of the channel type.
+ *
+ * Results:
+ * TCL_CHANNEL_VERSION_2 or TCL_CHANNEL_VERSION_1.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ChannelTypeVersion
+Tcl_ChannelVersion(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
+ return TCL_CHANNEL_VERSION_2;
+ } else {
+ /*
+ * In <v2 channel versions, the version field is occupied
+ * by the Tcl_DriverBlockModeProc
+ */
+ return TCL_CHANNEL_VERSION_1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelBlockModeProc --
+ *
+ * Return the Tcl_DriverBlockModeProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverBlockModeProc *
+Tcl_ChannelBlockModeProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
+ return (chanTypePtr->blockModeProc);
+ } else {
+ return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelCloseProc --
+ *
+ * Return the Tcl_DriverCloseProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverCloseProc *
+Tcl_ChannelCloseProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->closeProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelClose2Proc --
+ *
+ * Return the Tcl_DriverClose2Proc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverClose2Proc *
+Tcl_ChannelClose2Proc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->close2Proc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelInputProc --
+ *
+ * Return the Tcl_DriverInputProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverInputProc *
+Tcl_ChannelInputProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->inputProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelOutputProc --
+ *
+ * Return the Tcl_DriverOutputProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverOutputProc *
+Tcl_ChannelOutputProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->outputProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelSeekProc --
+ *
+ * Return the Tcl_DriverSeekProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverSeekProc *
+Tcl_ChannelSeekProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->seekProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelSetOptionProc --
+ *
+ * Return the Tcl_DriverSetOptionProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverSetOptionProc *
+Tcl_ChannelSetOptionProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->setOptionProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelGetOptionProc --
+ *
+ * Return the Tcl_DriverGetOptionProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverGetOptionProc *
+Tcl_ChannelGetOptionProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->getOptionProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelWatchProc --
+ *
+ * Return the Tcl_DriverWatchProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverWatchProc *
+Tcl_ChannelWatchProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->watchProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelGetHandleProc --
+ *
+ * Return the Tcl_DriverGetHandleProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverGetHandleProc *
+Tcl_ChannelGetHandleProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->getHandleProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelFlushProc --
+ *
+ * Return the Tcl_DriverFlushProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverFlushProc *
+Tcl_ChannelFlushProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->flushProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelHandlerProc --
+ *
+ * Return the Tcl_DriverHandlerProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_DriverHandlerProc *
+Tcl_ChannelHandlerProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ return (chanTypePtr->handlerProc);
+}
+
diff --git a/tcl/generic/tclIO.h b/tcl/generic/tclIO.h
new file mode 100644
index 00000000000..6d93a9c290a
--- /dev/null
+++ b/tcl/generic/tclIO.h
@@ -0,0 +1,379 @@
+/*
+ * tclIO.h --
+ *
+ * This file provides the generic portions (those that are the same on
+ * all platforms and for all channel types) of Tcl's IO facilities.
+ *
+ * Copyright (c) 1998-2000 Ajuba Solutions
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
+ * compile on systems where neither is defined. We want both defined so
+ * that we can test safely for both. In the code we still have to test for
+ * both because there may be systems on which both are defined and have
+ * different values.
+ */
+
+#if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
+# define EWOULDBLOCK EAGAIN
+#endif
+#if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
+# define EAGAIN EWOULDBLOCK
+#endif
+#if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
+error one of EWOULDBLOCK or EAGAIN must be defined
+#endif
+
+/*
+ * The following structure encapsulates the state for a background channel
+ * copy. Note that the data buffer for the copy will be appended to this
+ * structure.
+ */
+
+typedef struct CopyState {
+ struct Channel *readPtr; /* Pointer to input channel. */
+ struct Channel *writePtr; /* Pointer to output channel. */
+ int readFlags; /* Original read channel flags. */
+ int writeFlags; /* Original write channel flags. */
+ int toRead; /* Number of bytes to copy, or -1. */
+ int total; /* Total bytes transferred (written). */
+ Tcl_Interp *interp; /* Interp that started the copy. */
+ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */
+ int bufSize; /* Size of appended buffer. */
+ char buffer[1]; /* Copy buffer, this must be the last
+ * field. */
+} CopyState;
+
+/*
+ * struct ChannelBuffer:
+ *
+ * Buffers data being sent to or from a channel.
+ */
+
+typedef struct ChannelBuffer {
+ int nextAdded; /* The next position into which a character
+ * will be put in the buffer. */
+ int nextRemoved; /* Position of next byte to be removed
+ * from the buffer. */
+ int bufLength; /* How big is the buffer? */
+ struct ChannelBuffer *nextPtr;
+ /* Next buffer in chain. */
+ char buf[4]; /* Placeholder for real buffer. The real
+ * buffer occuppies this space + bufSize-4
+ * bytes. This must be the last field in
+ * the structure. */
+} ChannelBuffer;
+
+#define CHANNELBUFFER_HEADER_SIZE (sizeof(ChannelBuffer) - 4)
+
+/*
+ * How much extra space to allocate in buffer to hold bytes from previous
+ * buffer (when converting to UTF-8) or to hold bytes that will go to
+ * next buffer (when converting from UTF-8).
+ */
+
+#define BUFFER_PADDING 16
+
+/*
+ * The following defines the *default* buffer size for channels.
+ */
+
+#define CHANNELBUFFER_DEFAULT_SIZE (1024 * 4)
+
+/*
+ * Structure to record a close callback. One such record exists for
+ * each close callback registered for a channel.
+ */
+
+typedef struct CloseCallback {
+ Tcl_CloseProc *proc; /* The procedure to call. */
+ ClientData clientData; /* Arbitrary one-word data to pass
+ * to the callback. */
+ struct CloseCallback *nextPtr; /* For chaining close callbacks. */
+} CloseCallback;
+
+/*
+ * The following structure describes the information saved from a call to
+ * "fileevent". This is used later when the event being waited for to
+ * invoke the saved script in the interpreter designed in this record.
+ */
+
+typedef struct EventScriptRecord {
+ struct Channel *chanPtr; /* The channel for which this script is
+ * registered. This is used only when an
+ * error occurs during evaluation of the
+ * script, to delete the handler. */
+ Tcl_Obj *scriptPtr; /* Script to invoke. */
+ Tcl_Interp *interp; /* In what interpreter to invoke script? */
+ int mask; /* Events must overlap current mask for the
+ * stored script to be invoked. */
+ struct EventScriptRecord *nextPtr;
+ /* Next in chain of records. */
+} EventScriptRecord;
+
+/*
+ * struct Channel:
+ *
+ * One of these structures is allocated for each open channel. It contains data
+ * specific to the channel but which belongs to the generic part of the Tcl
+ * channel mechanism, and it points at an instance specific (and type
+ * specific) * instance data, and at a channel type structure.
+ */
+
+typedef struct Channel {
+ struct ChannelState *state; /* Split out state information */
+
+ ClientData instanceData; /* Instance-specific data provided by
+ * creator of channel. */
+ Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
+
+ struct Channel *downChanPtr;/* Refers to channel this one was stacked
+ * upon. This reference is NULL for normal
+ * channels. See Tcl_StackChannel. */
+ struct Channel *upChanPtr; /* Refers to the channel above stacked this
+ * one. NULL for the top most channel. */
+
+ /*
+ * Intermediate buffers to hold pre-read data for consumption by a
+ * newly stacked transformation. See 'Tcl_StackChannel'.
+ */
+ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
+ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
+} Channel;
+
+/*
+ * struct ChannelState:
+ *
+ * One of these structures is allocated for each open channel. It contains data
+ * specific to the channel but which belongs to the generic part of the Tcl
+ * channel mechanism, and it points at an instance specific (and type
+ * specific) * instance data, and at a channel type structure.
+ */
+
+typedef struct ChannelState {
+ 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
+ * below. */
+ Tcl_Encoding encoding; /* Encoding to apply when reading or writing
+ * data on this channel. NULL means no
+ * encoding is applied to data. */
+ Tcl_EncodingState inputEncodingState;
+ /* Current encoding state, used when converting
+ * input data bytes to UTF-8. */
+ int inputEncodingFlags; /* Encoding flags to pass to conversion
+ * routine when converting input data bytes to
+ * UTF-8. May be TCL_ENCODING_START before
+ * converting first byte and TCL_ENCODING_END
+ * when EOF is seen. */
+ Tcl_EncodingState outputEncodingState;
+ /* Current encoding state, used when converting
+ * UTF-8 to output data bytes. */
+ int outputEncodingFlags; /* Encoding flags to pass to conversion
+ * routine when converting UTF-8 to output
+ * data bytes. May be TCL_ENCODING_START
+ * before converting first byte and
+ * TCL_ENCODING_END when EOF is seen. */
+ Tcl_EolTranslation inputTranslation;
+ /* What translation to apply for end of line
+ * sequences on input? */
+ Tcl_EolTranslation outputTranslation;
+ /* What translation to use for generating
+ * end of line sequences in output? */
+ int inEofChar; /* If nonzero, use this as a signal of EOF
+ * on input. */
+ int outEofChar; /* If nonzero, append this to the channel
+ * when it is closed if it is open for
+ * writing. */
+ int unreportedError; /* Non-zero if an error report was deferred
+ * because it happened in the background. The
+ * value is the POSIX error code. */
+ int refCount; /* How many interpreters hold references to
+ * this IO channel? */
+
+ CloseCallback *closeCbPtr; /* Callbacks registered to be called when the
+ * channel is closed. */
+ char *outputStage; /* Temporary staging buffer used when
+ * translating EOL before converting from
+ * UTF-8 to external form. */
+ ChannelBuffer *curOutPtr; /* Current output buffer being filled. */
+ ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
+ ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
+
+ ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
+ * need to allocate a new buffer for "gets"
+ * that crosses buffer boundaries. */
+ ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
+ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
+
+ struct ChannelHandler *chPtr;/* List of channel handlers registered
+ * for this channel. */
+ int interestMask; /* Mask of all events this channel has
+ * handlers for. */
+ EventScriptRecord *scriptRecordPtr;
+ /* Chain of all scripts registered for
+ * event handlers ("fileevent") on this
+ * channel. */
+
+ int bufSize; /* What size buffers to allocate? */
+ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */
+ CopyState *csPtr; /* State of background copy, or NULL. */
+ Channel *topChanPtr; /* Refers to topmost channel in a stack.
+ * Never NULL. */
+ Channel *bottomChanPtr; /* Refers to bottommost channel in a stack.
+ * This channel can be relied on to live as
+ * long as the channel state. Never NULL. */
+ struct ChannelState *nextCSPtr;
+ /* Next in list of channels currently open. */
+} ChannelState;
+
+/*
+ * Values for the flags field in Channel. Any ORed combination of the
+ * following flags can be stored in the field. These flags record various
+ * options and state bits about the channel. In addition to the flags below,
+ * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
+ */
+
+#define CHANNEL_NONBLOCKING (1<<3) /* Channel is currently in
+ * nonblocking mode. */
+#define CHANNEL_LINEBUFFERED (1<<4) /* Output to the channel must be
+ * 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. */
+#define CHANNEL_CLOSED (1<<8) /* Channel has been closed. No
+ * further Tcl-level IO on the
+ * channel is allowed. */
+#define CHANNEL_EOF (1<<9) /* EOF occurred on this channel.
+ * This bit is cleared before every
+ * input operation. */
+#define CHANNEL_STICKY_EOF (1<<10) /* EOF occurred on this channel because
+ * we saw the input eofChar. This bit
+ * prevents clearing of the EOF bit
+ * before every input operation. */
+#define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
+ * on this channel. This bit is
+ * cleared before every input or
+ * output operation. */
+#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 sees this flag on a
+ * channel, it does not call driver
+ * level functions to avoid referring
+ * to deallocated data. */
+#define CHANNEL_NEED_MORE_DATA (1<<14) /* The last input operation failed
+ * because there was not enough data
+ * to complete the operation. This
+ * flag is set when gets fails to
+ * get a complete line or when read
+ * fails to get a complete character.
+ * When set, file events will not be
+ * delivered for buffered data until
+ * the state of the channel changes. */
+#define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is
+ * being used. */
+
+/*
+ * For each channel handler registered in a call to Tcl_CreateChannelHandler,
+ * there is one record of the following type. All of records for a specific
+ * channel are chained together in a singly linked list which is stored in
+ * the channel structure.
+ */
+
+typedef struct ChannelHandler {
+ Channel *chanPtr; /* The channel structure for this channel. */
+ int mask; /* Mask of desired events. */
+ Tcl_ChannelProc *proc; /* Procedure to call in the type of
+ * Tcl_CreateChannelHandler. */
+ ClientData clientData; /* Argument to pass to procedure. */
+ struct ChannelHandler *nextPtr;
+ /* Next one in list of registered handlers. */
+} ChannelHandler;
+
+/*
+ * This structure keeps track of the current ChannelHandler being invoked in
+ * the current invocation of ChannelHandlerEventProc. There is a potential
+ * problem if a ChannelHandler is deleted while it is the current one, since
+ * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
+ * problem, structures of the type below indicate the next handler to be
+ * processed for any (recursively nested) dispatches in progress. The
+ * nextHandlerPtr field is updated if the handler being pointed to is deleted.
+ * The nextPtr field is used to chain together all recursive invocations, so
+ * that Tcl_DeleteChannelHandler can find all the recursively nested
+ * invocations of ChannelHandlerEventProc and compare the handler being
+ * deleted against the NEXT handler to be invoked in that invocation; when it
+ * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
+ * field of the structure to the next handler.
+ */
+
+typedef struct NextChannelHandler {
+ ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in
+ * this invocation. */
+ struct NextChannelHandler *nestedHandlerPtr;
+ /* Next nested invocation of
+ * ChannelHandlerEventProc. */
+} NextChannelHandler;
+
+
+/*
+ * The following structure describes the event that is added to the Tcl
+ * event queue by the channel handler check procedure.
+ */
+
+typedef struct ChannelHandlerEvent {
+ Tcl_Event header; /* Standard header for all events. */
+ Channel *chanPtr; /* The channel that is ready. */
+ int readyMask; /* Events that have occurred. */
+} ChannelHandlerEvent;
+
+/*
+ * The following structure is used by Tcl_GetsObj() to encapsulates the
+ * state for a "gets" operation.
+ */
+
+typedef struct GetsState {
+ Tcl_Obj *objPtr; /* The object to which UTF-8 characters
+ * will be appended. */
+ char **dstPtr; /* Pointer into objPtr's string rep where
+ * next character should be stored. */
+ Tcl_Encoding encoding; /* The encoding to use to convert raw bytes
+ * to UTF-8. */
+ ChannelBuffer *bufPtr; /* The current buffer of raw bytes being
+ * emptied. */
+ Tcl_EncodingState state; /* The encoding state just before the last
+ * external to UTF-8 conversion in
+ * FilterInputBytes(). */
+ int rawRead; /* The number of bytes removed from bufPtr
+ * in the last call to FilterInputBytes(). */
+ int bytesWrote; /* The number of bytes of UTF-8 data
+ * appended to objPtr during the last call to
+ * FilterInputBytes(). */
+ int charsWrote; /* The corresponding number of UTF-8
+ * characters appended to objPtr during the
+ * last call to FilterInputBytes(). */
+ int totalChars; /* The total number of UTF-8 characters
+ * appended to objPtr so far, just before the
+ * last call to FilterInputBytes(). */
+} GetsState;
diff --git a/tcl/generic/tclIOCmd.c b/tcl/generic/tclIOCmd.c
index 5e6eb3de36d..0e6b7bf81a3 100644
--- a/tcl/generic/tclIOCmd.c
+++ b/tcl/generic/tclIOCmd.c
@@ -3,7 +3,7 @@
*
* Contains the definitions of most of the Tcl commands relating to IO.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -11,14 +11,8 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
-
-/*
- * Return at most this number of bytes in one call to Tcl_Read:
- */
-
-#define TCL_READ_CHUNK_SIZE 4096
+#include "tclInt.h"
+#include "tclPort.h"
/*
* Callback structure for accept callback in a TCP server.
@@ -76,12 +70,10 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
int mode; /* Mode in which channel is opened. */
char *arg;
int length;
- Tcl_Obj *resultPtr;
i = 1;
newline = 1;
- if ((objc >= 2) && (strcmp(Tcl_GetStringFromObj(objv[1], NULL),
- "-nonewline") == 0)) {
+ if ((objc >= 2) && (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0)) {
newline = 0;
i++;
}
@@ -95,53 +87,46 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
* form of the command that is no longer recommended or documented.
*/
- resultPtr = Tcl_NewObj();
if (i == (objc-3)) {
- arg = Tcl_GetStringFromObj(objv[i+2], &length);
+ arg = Tcl_GetStringFromObj(objv[i + 2], &length);
if (strncmp(arg, "nonewline", (size_t) length) != 0) {
- Tcl_AppendStringsToObj(resultPtr, "bad argument \"", arg,
+ Tcl_AppendResult(interp, "bad argument \"", arg,
"\": should be \"nonewline\"", (char *) NULL);
- Tcl_SetObjResult(interp, resultPtr);
return TCL_ERROR;
}
newline = 0;
}
- if (i == (objc-1)) {
+ if (i == (objc - 1)) {
channelId = "stdout";
} else {
- channelId = Tcl_GetStringFromObj(objv[i], NULL);
+ channelId = Tcl_GetString(objv[i]);
i++;
}
chan = Tcl_GetChannel(interp, channelId, &mode);
if (chan == (Tcl_Channel) NULL) {
- Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendStringsToObj(resultPtr, "channel \"", channelId,
+ Tcl_AppendResult(interp, "channel \"", channelId,
"\" wasn't opened for writing", (char *) NULL);
- Tcl_SetObjResult(interp, resultPtr);
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[i], &length);
- result = Tcl_Write(chan, arg, length);
+ result = Tcl_WriteObj(chan, objv[i]);
if (result < 0) {
goto error;
}
if (newline != 0) {
- result = Tcl_Write(chan, "\n", 1);
+ result = Tcl_WriteChars(chan, "\n", 1);
if (result < 0) {
goto error;
}
}
- Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
-error:
- Tcl_AppendStringsToObj(resultPtr, "error writing \"",
- Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
- Tcl_SetObjResult(interp, resultPtr);
+
+ error:
+ Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -171,31 +156,27 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to flush on. */
- char *arg;
- Tcl_Obj *resultPtr;
+ char *channelId;
int mode;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[1], NULL);
- chan = Tcl_GetChannel(interp, arg, &mode);
+ channelId = Tcl_GetString(objv[1]);
+ chan = Tcl_GetChannel(interp, channelId, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendStringsToObj(resultPtr, "channel \"",
- Tcl_GetStringFromObj(objv[1], NULL),
- "\" wasn't opened for writing", (char *) NULL);
+ Tcl_AppendResult(interp, "channel \"", channelId,
+ "\" wasn't opened for writing", (char *) NULL);
return TCL_ERROR;
}
if (Tcl_Flush(chan) != TCL_OK) {
- Tcl_AppendStringsToObj(resultPtr, "error flushing \"",
- Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -229,51 +210,56 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
Tcl_Channel chan; /* The channel to read from. */
int lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
- char *arg;
- Tcl_Obj *resultPtr, *objPtr;
+ char *name;
+ Tcl_Obj *resultPtr, *linePtr;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[1], NULL);
- chan = Tcl_GetChannel(interp, arg, &mode);
+ name = Tcl_GetString(objv[1]);
+ chan = Tcl_GetChannel(interp, name, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- resultPtr = Tcl_NewObj();
if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendStringsToObj(resultPtr, "channel \"", arg,
- "\" wasn't opened for reading", (char *) NULL);
- Tcl_SetObjResult(interp, resultPtr);
+ Tcl_AppendResult(interp, "channel \"", name,
+ "\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
- lineLen = Tcl_GetsObj(chan, resultPtr);
+ resultPtr = Tcl_GetObjResult(interp);
+ linePtr = resultPtr;
+ if (objc == 3) {
+ /*
+ * Variable gets line, interp get bytecount.
+ */
+
+ linePtr = Tcl_NewObj();
+ }
+
+ lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
- Tcl_SetObjLength(resultPtr, 0);
- Tcl_AppendStringsToObj(resultPtr, "error reading \"",
- Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
- Tcl_SetObjResult(interp, resultPtr);
+ if (linePtr != resultPtr) {
+ Tcl_DecrRefCount(linePtr);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
lineLen = -1;
}
if (objc == 3) {
- Tcl_ResetResult(interp);
- objPtr = Tcl_ObjSetVar2(interp, objv[2], NULL,
- resultPtr, TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
- if (objPtr == NULL) {
- Tcl_DecrRefCount(resultPtr);
+ if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_DecrRefCount(linePtr);
return TCL_ERROR;
}
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), lineLen);
+ Tcl_SetIntObj(resultPtr, lineLen);
return TCL_OK;
}
- Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
@@ -302,32 +288,25 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to read from. */
- int newline, i; /* Discard newline at end? */
- int toRead; /* How many bytes to read? */
- int toReadNow; /* How many bytes to attempt to
- * read in the current iteration? */
- int charactersRead; /* How many characters were read? */
- int charactersReadNow; /* How many characters were read
- * in this iteration? */
- int mode; /* Mode in which channel is opened. */
- int bufSize; /* Channel buffer size; used to decide
- * in what chunk sizes to read from
- * the channel. */
- char *arg;
+ Tcl_Channel chan; /* The channel to read from. */
+ int newline, i; /* Discard newline at end? */
+ int toRead; /* How many bytes to read? */
+ int charactersRead; /* How many characters were read? */
+ int mode; /* Mode in which channel is opened. */
+ char *name;
Tcl_Obj *resultPtr;
if ((objc != 2) && (objc != 3)) {
-argerror:
- Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numBytes?");
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), " or \"",
- Tcl_GetStringFromObj(objv[0], NULL),
+ argerror:
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?");
+ Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
" ?-nonewline? channelId\"", (char *) NULL);
return TCL_ERROR;
}
+
i = 1;
newline = 0;
- if (strcmp(Tcl_GetStringFromObj(objv[1], NULL), "-nonewline") == 0) {
+ if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
newline = 1;
i++;
}
@@ -336,18 +315,16 @@ argerror:
goto argerror;
}
- arg = Tcl_GetStringFromObj(objv[i], NULL);
- chan = Tcl_GetChannel(interp, arg, &mode);
+ name = Tcl_GetString(objv[i]);
+ chan = Tcl_GetChannel(interp, name, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
- resultPtr = Tcl_GetObjResult(interp);
- Tcl_AppendStringsToObj(resultPtr, "channel \"", arg,
+ Tcl_AppendResult(interp, "channel \"", name,
"\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
-
i++; /* Consumed channel name. */
/*
@@ -355,112 +332,57 @@ argerror:
* newline should be dropped.
*/
- toRead = INT_MAX;
+ toRead = -1;
if (i < objc) {
- arg = Tcl_GetStringFromObj(objv[i], NULL);
- if (isdigit((unsigned char) (arg[0]))) {
+ char *arg;
+
+ arg = Tcl_GetString(objv[i]);
+ if (isdigit(UCHAR(arg[0]))) { /* INTL: digit */
if (Tcl_GetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_ResetResult(interp);
} else if (strcmp(arg, "nonewline") == 0) {
newline = 1;
} else {
- resultPtr = Tcl_GetObjResult(interp);
- Tcl_AppendStringsToObj(resultPtr, "bad argument \"", arg,
+ Tcl_AppendResult(interp, "bad argument \"", arg,
"\": should be \"nonewline\"", (char *) NULL);
return TCL_ERROR;
}
}
- /*
- * Create a new object and use that instead of the interpreter
- * result. We cannot use the interpreter's result object because
- * it may get smashed at any time by recursive calls.
- */
-
resultPtr = Tcl_NewObj();
-
- bufSize = Tcl_GetChannelBufferSize(chan);
-
- /*
- * If the caller specified a maximum length to read, then that is
- * a good size to preallocate.
- */
-
- if ((toRead != INT_MAX) && (toRead > bufSize)) {
- Tcl_SetObjLength(resultPtr, toRead);
- }
-
- for (charactersRead = 0; charactersRead < toRead; ) {
- toReadNow = toRead - charactersRead;
- if (toReadNow > bufSize) {
- toReadNow = bufSize;
- }
-
- /*
- * NOTE: This is a NOOP if we set the size (above) to the
- * number of bytes we expect to read. In the degenerate
- * case, however, it will grow the buffer by the channel
- * buffersize, which is 4K in most cases. This will result
- * in inefficient copying for large files. This will be
- * fixed in a future release.
- */
-
- Tcl_SetObjLength(resultPtr, charactersRead + toReadNow);
- charactersReadNow =
- Tcl_Read(chan, Tcl_GetStringFromObj(resultPtr, NULL)
- + charactersRead, toReadNow);
- if (charactersReadNow < 0) {
- Tcl_SetObjLength(resultPtr, 0);
- Tcl_AppendStringsToObj(resultPtr, "error reading \"",
- Tcl_GetChannelName(chan), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- Tcl_SetObjResult(interp, resultPtr);
-
- return TCL_ERROR;
- }
-
- /*
- * If we had a short read it means that we have either EOF
- * or BLOCKED on the channel, so break out.
- */
-
- charactersRead += charactersReadNow;
-
- /*
- * Do not call the driver again if we got a short read
- */
-
- if (charactersReadNow < toReadNow) {
- break; /* Out of "for" loop. */
- }
+ Tcl_IncrRefCount(resultPtr);
+ charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
+ if (charactersRead < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ Tcl_DecrRefCount(resultPtr);
+ return TCL_ERROR;
}
/*
* If requested, remove the last newline in the channel if at EOF.
*/
- if ((charactersRead > 0) && (newline) &&
- (Tcl_GetStringFromObj(resultPtr, NULL)[charactersRead-1] == '\n')) {
- charactersRead--;
- }
- Tcl_SetObjLength(resultPtr, charactersRead);
-
- /*
- * Now set the object into the interpreter result and release our
- * hold on it by decrrefing it.
- */
+ if ((charactersRead > 0) && (newline != 0)) {
+ char *result;
+ int length;
+ result = Tcl_GetStringFromObj(resultPtr, &length);
+ if (result[length - 1] == '\n') {
+ Tcl_SetObjLength(resultPtr, length - 1);
+ }
+ }
Tcl_SetObjResult(interp, resultPtr);
-
+ Tcl_DecrRefCount(resultPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_SeekCmd --
+ * Tcl_SeekObjCmd --
*
* This procedure is invoked to process the Tcl "seek" command. See
* the user documentation for details on what it does.
@@ -477,53 +399,45 @@ argerror:
/* ARGSUSED */
int
-Tcl_SeekCmd(clientData, interp, argc, argv)
+Tcl_SeekObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to tell on. */
int offset, mode; /* Where to seek? */
int result; /* Of calling Tcl_Seek. */
+ char *chanName;
+ int optionIndex;
+ static char *originOptions[] = {"start", "current", "end", (char *) NULL};
+ static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelId offset ?origin?\"", (char *) NULL);
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
return TCL_ERROR;
}
- chan = Tcl_GetChannel(interp, argv[1], NULL);
+ chanName = Tcl_GetString(objv[1]);
+ chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- if (Tcl_GetInt(interp, argv[2], &offset) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &offset) != TCL_OK) {
return TCL_ERROR;
}
mode = SEEK_SET;
- if (argc == 4) {
- size_t length;
- int c;
-
- length = strlen(argv[3]);
- c = argv[3][0];
- if ((c == 's') && (strncmp(argv[3], "start", length) == 0)) {
- mode = SEEK_SET;
- } else if ((c == 'c') && (strncmp(argv[3], "current", length) == 0)) {
- mode = SEEK_CUR;
- } else if ((c == 'e') && (strncmp(argv[3], "end", length) == 0)) {
- mode = SEEK_END;
- } else {
- Tcl_AppendResult(interp, "bad origin \"", argv[3],
- "\": should be start, current, or end", (char *) NULL);
+ if (objc == 4) {
+ if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0,
+ &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
+ mode = modeArray[optionIndex];
}
result = Tcl_Seek(chan, offset, mode);
if (result == -1) {
Tcl_AppendResult(interp, "error during seek on \"",
- Tcl_GetChannelName(chan), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -532,7 +446,7 @@ Tcl_SeekCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * Tcl_TellCmd --
+ * Tcl_TellObjCmd --
*
* This procedure is invoked to process the Tcl "tell" command.
* See the user documentation for details on what it does.
@@ -548,18 +462,17 @@ Tcl_SeekCmd(clientData, interp, argc, argv)
/* ARGSUSED */
int
-Tcl_TellCmd(clientData, interp, argc, argv)
+Tcl_TellObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to tell on. */
- char buf[40];
+ char *chanName;
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelId\"", (char *) NULL);
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
/*
@@ -567,12 +480,12 @@ Tcl_TellCmd(clientData, interp, argc, argv)
* the IO channel table of this interpreter.
*/
- chan = Tcl_GetChannel(interp, argv[1], NULL);
+ chanName = Tcl_GetString(objv[1]);
+ chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- TclFormatInt(buf, Tcl_Tell(chan));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
return TCL_OK;
}
@@ -602,7 +515,6 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to close. */
- int len; /* Length of error output. */
char *arg;
if (objc != 2) {
@@ -610,7 +522,7 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[1], NULL);
+ arg = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, arg, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -620,7 +532,7 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
/*
* If there is an error message and it ends with a newline, remove
* the newline. This is done for command pipeline channels where the
- * error output from the subprocesses is stored in interp->result.
+ * error output from the subprocesses is stored in interp's result.
*
* NOTE: This is likely to not have any effect on regular error
* messages produced by drivers during the closing of a channel,
@@ -628,11 +540,15 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
* have a terminating newline.
*/
- len = strlen(interp->result);
- if ((len > 0) && (interp->result[len - 1] == '\n')) {
- interp->result[len - 1] = '\0';
+ Tcl_Obj *resultPtr;
+ char *string;
+ int len;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ string = Tcl_GetStringFromObj(resultPtr, &len);
+ if ((len > 0) && (string[len - 1] == '\n')) {
+ Tcl_SetObjLength(resultPtr, len - 1);
}
-
return TCL_ERROR;
}
@@ -642,7 +558,7 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * Tcl_FconfigureCmd --
+ * Tcl_FconfigureObjCmd --
*
* This procedure is invoked to process the Tcl "fconfigure" command.
* See the user documentation for details on what it does.
@@ -658,28 +574,29 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_FconfigureCmd(clientData, interp, argc, argv)
+Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ char *chanName, *optionName, *valueName;
Tcl_Channel chan; /* The channel to set a mode on. */
int i; /* Iterate over arg-value pairs. */
Tcl_DString ds; /* DString to hold result of
* calling Tcl_GetChannelOption. */
- if ((argc < 2) || (((argc % 2) == 1) && (argc != 3))) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " channelId ?optionName? ?value? ?optionName value?...\"",
- (char *) NULL);
+ if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "channelId ?optionName? ?value? ?optionName value?...");
return TCL_ERROR;
}
- chan = Tcl_GetChannel(interp, argv[1], NULL);
+ chanName = Tcl_GetString(objv[1]);
+ chan = Tcl_GetChannel(interp, chanName, NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- if (argc == 2) {
+ if (objc == 2) {
Tcl_DStringInit(&ds);
if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
@@ -688,17 +605,21 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv)
Tcl_DStringResult(interp, &ds);
return TCL_OK;
}
- if (argc == 3) {
+ if (objc == 3) {
Tcl_DStringInit(&ds);
- if (Tcl_GetChannelOption(interp, chan, argv[2], &ds) != TCL_OK) {
+ optionName = Tcl_GetString(objv[2]);
+ if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringResult(interp, &ds);
return TCL_OK;
}
- for (i = 3; i < argc; i += 2) {
- if (Tcl_SetChannelOption(interp, chan, argv[i-1], argv[i]) != TCL_OK) {
+ for (i = 3; i < objc; i += 2) {
+ optionName = Tcl_GetString(objv[i-1]);
+ valueName = Tcl_GetString(objv[i]);
+ if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
+ != TCL_OK) {
return TCL_ERROR;
}
}
@@ -706,7 +627,7 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_EofObjCmd --
*
@@ -717,10 +638,10 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv)
* A standard Tcl result.
*
* Side effects:
- * Sets interp->result to "0" or "1" depending on whether the
- * specified channel has an EOF condition.
+ * Sets interp's result to boolean true or false depending on whether
+ * the specified channel has an EOF condition.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
/* ARGSUSED */
@@ -731,9 +652,8 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to query for EOF. */
- int mode; /* Mode in which channel is opened. */
- char buf[40];
+ Tcl_Channel chan;
+ int dummy;
char *arg;
if (objc != 2) {
@@ -741,21 +661,20 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[1], NULL);
- chan = Tcl_GetChannel(interp, arg, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ arg = Tcl_GetString(objv[1]);
+ chan = Tcl_GetChannel(interp, arg, &dummy);
+ if (chan == NULL) {
return TCL_ERROR;
}
- TclFormatInt(buf, Tcl_Eof(chan) ? 1 : 0);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_Eof(chan));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_ExecCmd --
+ * Tcl_ExecObjCmd --
*
* This procedure is invoked to process the "exec" Tcl command.
* See the user documentation for details on what it does.
@@ -771,44 +690,63 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ExecCmd(dummy, interp, argc, argv)
+Tcl_ExecObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
#ifdef MAC_TCL
+
Tcl_AppendResult(interp, "exec not implemented under Mac OS",
(char *)NULL);
return TCL_ERROR;
+
#else /* !MAC_TCL */
- int keepNewline, firstWord, background, length, result;
+
+ /*
+ * This procedure generates an argv array for the string arguments. It
+ * starts out with stack-allocated space but uses dynamically-allocated
+ * storage if needed.
+ */
+
+#define NUM_ARGS 20
+ Tcl_Obj *resultPtr;
+ char **argv;
+ char *string;
Tcl_Channel chan;
- Tcl_DString ds;
- int readSoFar, readNow, bufSize;
+ char *argStorage[NUM_ARGS];
+ int argc, background, i, index, keepNewline, result, skip, length;
+ static char *options[] = {
+ "-keepnewline", "--", NULL
+ };
+ enum options {
+ EXEC_KEEPNEWLINE, EXEC_LAST
+ };
/*
* Check for a leading "-keepnewline" argument.
*/
keepNewline = 0;
- for (firstWord = 1; (firstWord < argc) && (argv[firstWord][0] == '-');
- firstWord++) {
- if (strcmp(argv[firstWord], "-keepnewline") == 0) {
- keepNewline = 1;
- } else if (strcmp(argv[firstWord], "--") == 0) {
- firstWord++;
+ for (skip = 1; skip < objc; skip++) {
+ string = Tcl_GetString(objv[skip]);
+ if (string[0] != '-') {
break;
- } else {
- Tcl_AppendResult(interp, "bad switch \"", argv[firstWord],
- "\": must be -keepnewline or --", (char *) NULL);
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
+ TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
+ if (index == EXEC_KEEPNEWLINE) {
+ keepNewline = 1;
+ } else {
+ skip++;
+ break;
+ }
}
-
- if (argc <= firstWord) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ?switches? arg ?arg ...?\"", (char *) NULL);
+ if (objc <= skip) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?switches? arg ?arg ...?");
return TCL_ERROR;
}
@@ -817,84 +755,100 @@ Tcl_ExecCmd(dummy, interp, argc, argv)
*/
background = 0;
- if ((argv[argc-1][0] == '&') && (argv[argc-1][1] == 0)) {
- argc--;
- argv[argc] = NULL;
+ string = Tcl_GetString(objv[objc - 1]);
+ if ((string[0] == '&') && (string[1] == '\0')) {
+ objc--;
background = 1;
}
-
- chan = Tcl_OpenCommandChannel(interp, argc-firstWord,
- argv+firstWord,
- (background ? 0 : TCL_STDOUT | TCL_STDERR));
+
+ /*
+ * Create the string argument array "argv". Make sure argv is large
+ * enough to hold the argc arguments plus 1 extra for the zero
+ * end-of-argv word.
+ */
+
+ argv = argStorage;
+ argc = objc - skip;
+ if ((argc + 1) > sizeof(argv) / sizeof(argv[0])) {
+ argv = (char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
+ }
+
+ /*
+ * Copy the string conversions of each (post option) object into the
+ * argument vector.
+ */
+
+ for (i = 0; i < argc; i++) {
+ argv[i] = Tcl_GetString(objv[i + skip]);
+ }
+ argv[argc] = NULL;
+ chan = Tcl_OpenCommandChannel(interp, argc, argv,
+ (background ? 0 : TCL_STDOUT | TCL_STDERR));
+
+ /*
+ * Free the argv array if malloc'ed storage was used.
+ */
+
+ if (argv != argStorage) {
+ ckfree((char *)argv);
+ }
if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
if (background) {
-
/*
- * Get the list of PIDs from the pipeline into interp->result and
- * detach the PIDs (instead of waiting for them).
- */
+ * Store the list of PIDs from the pipeline in interp's result and
+ * detach the PIDs (instead of waiting for them).
+ */
TclGetAndDetachPids(interp, chan);
-
if (Tcl_Close(interp, chan) != TCL_OK) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
- return TCL_OK;
+ return TCL_OK;
}
+ resultPtr = Tcl_NewObj();
if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
-#define EXEC_BUFFER_SIZE 4096
-
- Tcl_DStringInit(&ds);
- readSoFar = 0; bufSize = 0;
- while (1) {
- bufSize += EXEC_BUFFER_SIZE;
- Tcl_DStringSetLength(&ds, bufSize);
- readNow = Tcl_Read(chan, Tcl_DStringValue(&ds) + readSoFar,
- EXEC_BUFFER_SIZE);
- if (readNow < 0) {
- Tcl_DStringFree(&ds);
- Tcl_AppendResult(interp,
- "error reading output from command: ",
- Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
- }
- readSoFar += readNow;
- if (readNow < EXEC_BUFFER_SIZE) {
- break; /* Out of "while (1)" loop. */
- }
- }
- Tcl_DStringSetLength(&ds, readSoFar);
- Tcl_DStringResult(interp, &ds);
+ if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "error reading output from command: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ Tcl_DecrRefCount(resultPtr);
+ return TCL_ERROR;
+ }
}
+ /*
+ * If the process produced anything on stderr, it will have been
+ * returned in the interpreter result. It needs to be appended to
+ * the result string.
+ */
result = Tcl_Close(interp, chan);
+ string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+ Tcl_AppendToObj(resultPtr, string, length);
/*
- * If the last character of interp->result is a newline, then remove
- * the newline character (the newline would just confuse things).
- * Special hack: must replace the old terminating null character
- * as a signal to Tcl_AppendResult et al. that we've mucked with
- * the string.
+ * If the last character of the result is a newline, then remove
+ * the newline character.
*/
- length = strlen(interp->result);
- if (!keepNewline && (length > 0) &&
- (interp->result[length-1] == '\n')) {
- interp->result[length-1] = '\0';
- interp->result[length] = 'x';
+ if (keepNewline == 0) {
+ string = Tcl_GetStringFromObj(resultPtr, &length);
+ if ((length > 0) && (string[length - 1] == '\n')) {
+ Tcl_SetObjLength(resultPtr, length - 1);
+ }
}
+ Tcl_SetObjResult(interp, resultPtr);
return result;
#endif /* !MAC_TCL */
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_FblockedObjCmd --
*
@@ -905,10 +859,10 @@ Tcl_ExecCmd(dummy, interp, argc, argv)
* A standard Tcl result.
*
* Side effects:
- * Sets interp->result to "0" or "1" depending on whether the
- * a preceding input operation on the channel would have blocked.
+ * Sets interp's result to boolean true or false depending on whether
+ * the preceeding input operation on the channel would have blocked.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
/* ARGSUSED */
@@ -919,9 +873,8 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to query for blocked. */
- int mode; /* Mode in which channel was opened. */
- char buf[40];
+ Tcl_Channel chan;
+ int mode;
char *arg;
if (objc != 2) {
@@ -929,27 +882,25 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[1], NULL);
+ arg = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, arg, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
- Tcl_GetStringFromObj(objv[1], NULL),
- "\" wasn't opened for reading", (char *) NULL);
+ arg, "\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
- TclFormatInt(buf, Tcl_InputBlocked(chan) ? 1 : 0);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_InputBlocked(chan));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_OpenCmd --
+ * Tcl_OpenObjCmd --
*
* This procedure is invoked to process the "open" Tcl command.
* See the user documentation for details on what it does.
@@ -965,35 +916,35 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_OpenCmd(notUsed, interp, argc, argv)
+Tcl_OpenObjCmd(notUsed, interp, objc, objv)
ClientData notUsed; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int pipeline, prot;
- char *modeString;
+ char *modeString, *what;
Tcl_Channel chan;
- if ((argc < 2) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " fileName ?access? ?permissions?\"", (char *) NULL);
+ if ((objc < 2) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "fileName ?access? ?permissions?");
return TCL_ERROR;
}
prot = 0666;
- if (argc == 2) {
+ if (objc == 2) {
modeString = "r";
} else {
- modeString = argv[2];
- if (argc == 4) {
- if (Tcl_GetInt(interp, argv[3], &prot) != TCL_OK) {
+ modeString = Tcl_GetString(objv[2]);
+ if (objc == 4) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
return TCL_ERROR;
}
}
}
pipeline = 0;
- if (argv[1][0] == '|') {
+ what = Tcl_GetString(objv[1]);
+ if (what[0] == '|') {
pipeline = 1;
}
@@ -1002,7 +953,7 @@ Tcl_OpenCmd(notUsed, interp, argc, argv)
*/
if (!pipeline) {
- chan = Tcl_OpenFileChannel(interp, argv[1], modeString, prot);
+ chan = Tcl_OpenFileChannel(interp, what, modeString, prot);
} else {
#ifdef MAC_TCL
Tcl_AppendResult(interp,
@@ -1010,10 +961,10 @@ Tcl_OpenCmd(notUsed, interp, argc, argv)
(char *)NULL);
return TCL_ERROR;
#else
- int mode, seekFlag, cmdArgc;
+ int mode, seekFlag, cmdObjc;
char **cmdArgv;
- if (Tcl_SplitList(interp, argv[1]+1, &cmdArgc, &cmdArgv) != TCL_OK) {
+ if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
}
@@ -1036,7 +987,7 @@ Tcl_OpenCmd(notUsed, interp, argc, argv)
panic("Tcl_OpenCmd: invalid mode value");
break;
}
- chan = Tcl_OpenCommandChannel(interp, cmdArgc, cmdArgv, flags);
+ chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
}
ckfree((char *) cmdArgv);
#endif
@@ -1217,7 +1168,7 @@ AcceptCallbackProc(callbackData, chan, address, port)
AcceptCallback *acceptCallbackPtr;
Tcl_Interp *interp;
char *script;
- char portBuf[10];
+ char portBuf[TCL_INTEGER_SPACE];
int result;
acceptCallbackPtr = (AcceptCallback *) callbackData;
@@ -1314,7 +1265,7 @@ TcpServerCloseProc(callbackData)
/*
*----------------------------------------------------------------------
*
- * Tcl_SocketCmd --
+ * Tcl_SocketObjCmd --
*
* This procedure is invoked to process the "socket" Tcl command.
* See the user documentation for details on what it does.
@@ -1329,13 +1280,19 @@ TcpServerCloseProc(callbackData)
*/
int
-Tcl_SocketCmd(notUsed, interp, argc, argv)
+Tcl_SocketObjCmd(notUsed, interp, objc, objv)
ClientData notUsed; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int a, server, port;
+ static char *socketOptions[] = {
+ "-async", "-myaddr", "-myport","-server", (char *) NULL
+ };
+ enum socketOptions {
+ SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
+ };
+ int optionIndex, a, server, port;
char *arg, *copyScript, *host, *script;
char *myaddr = NULL;
int myport = 0;
@@ -1346,66 +1303,78 @@ Tcl_SocketCmd(notUsed, interp, argc, argv)
server = 0;
script = NULL;
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return TCL_ERROR;
}
- for (a = 1; a < argc; a++) {
- arg = argv[a];
- if (arg[0] == '-') {
- if (strcmp(arg, "-server") == 0) {
- if (async == 1) {
+ for (a = 1; a < objc; a++) {
+ arg = Tcl_GetString(objv[a]);
+ if (arg[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions,
+ "option", TCL_EXACT, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum socketOptions) optionIndex) {
+ case SKT_ASYNC: {
+ if (server == 1) {
Tcl_AppendResult(interp,
"cannot set -async option for server sockets",
(char *) NULL);
return TCL_ERROR;
}
- server = 1;
- a++;
- if (a >= argc) {
- Tcl_AppendResult(interp,
- "no argument given for -server option",
- (char *) NULL);
- return TCL_ERROR;
- }
- script = argv[a];
- } else if (strcmp(arg, "-myaddr") == 0) {
+ async = 1;
+ break;
+ }
+ case SKT_MYADDR: {
a++;
- if (a >= argc) {
+ if (a >= objc) {
Tcl_AppendResult(interp,
"no argument given for -myaddr option",
(char *) NULL);
return TCL_ERROR;
}
- myaddr = argv[a];
- } else if (strcmp(arg, "-myport") == 0) {
+ myaddr = Tcl_GetString(objv[a]);
+ break;
+ }
+ case SKT_MYPORT: {
+ char *myPortName;
a++;
- if (a >= argc) {
+ if (a >= objc) {
Tcl_AppendResult(interp,
"no argument given for -myport option",
(char *) NULL);
return TCL_ERROR;
}
- if (TclSockGetPort(interp, argv[a], "tcp", &myport)
- != TCL_OK) {
+ myPortName = Tcl_GetString(objv[a]);
+ if (TclSockGetPort(interp, myPortName, "tcp", &myport)
+ != TCL_OK) {
return TCL_ERROR;
}
- } else if (strcmp(arg, "-async") == 0) {
- if (server == 1) {
+ break;
+ }
+ case SKT_SERVER: {
+ if (async == 1) {
Tcl_AppendResult(interp,
"cannot set -async option for server sockets",
(char *) NULL);
return TCL_ERROR;
}
- async = 1;
- } else {
- Tcl_AppendResult(interp, "bad option \"", arg,
- "\", must be -async, -myaddr, -myport, or -server",
- (char *) NULL);
- return TCL_ERROR;
+ server = 1;
+ a++;
+ if (a >= objc) {
+ Tcl_AppendResult(interp,
+ "no argument given for -server option",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ script = Tcl_GetString(objv[a]);
+ break;
+ }
+ default: {
+ panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
}
- } else {
- break;
}
}
if (server) {
@@ -1415,22 +1384,23 @@ Tcl_SocketCmd(notUsed, interp, argc, argv)
NULL);
return TCL_ERROR;
}
- } else if (a < argc) {
- host = argv[a];
+ } else if (a < objc) {
+ host = Tcl_GetString(objv[a]);
a++;
} else {
wrongNumArgs:
Tcl_AppendResult(interp, "wrong # args: should be either:\n",
- argv[0],
+ Tcl_GetString(objv[0]),
" ?-myaddr addr? ?-myport myport? ?-async? host port\n",
- argv[0],
+ Tcl_GetString(objv[0]),
" -server command ?-myaddr addr? port",
(char *) NULL);
return TCL_ERROR;
}
- if (a == argc-1) {
- if (TclSockGetPort(interp, argv[a], "tcp", &port) != TCL_OK) {
+ if (a == objc-1) {
+ if (TclSockGetPort(interp, Tcl_GetString(objv[a]),
+ "tcp", &port) != TCL_OK) {
return TCL_ERROR;
}
} else {
@@ -1509,10 +1479,10 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
Tcl_Channel inChan, outChan;
char *arg;
int mode, i;
- int toRead;
+ int toRead, index;
Tcl_Obj *cmdPtr;
static char* switches[] = { "-size", "-command", NULL };
- enum { FcopySize, FcopyCommand } index;
+ enum { FcopySize, FcopyCommand };
if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -1525,25 +1495,25 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
* or writable, as appropriate.
*/
- arg = Tcl_GetStringFromObj(objv[1], NULL);
+ arg = Tcl_GetString(objv[1]);
inChan = Tcl_GetChannel(interp, arg, &mode);
if (inChan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
- Tcl_GetStringFromObj(objv[1], NULL),
+ Tcl_GetString(objv[1]),
"\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[2], NULL);
+ arg = Tcl_GetString(objv[2]);
outChan = Tcl_GetChannel(interp, arg, &mode);
if (outChan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
- Tcl_GetStringFromObj(objv[1], NULL),
+ Tcl_GetString(objv[1]),
"\" wasn't opened for writing", (char *) NULL);
return TCL_ERROR;
}
diff --git a/tcl/generic/tclIOGT.c b/tcl/generic/tclIOGT.c
new file mode 100644
index 00000000000..73a902221f4
--- /dev/null
+++ b/tcl/generic/tclIOGT.c
@@ -0,0 +1,1359 @@
+/*
+ * tclIOGT.c --
+ *
+ * Implements a generic transformation exposing the underlying API
+ * at the script level. Contributed by Andreas Kupries.
+ *
+ * Copyright (c) 2000 Ajuba Solutions
+ * Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com)
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * CVS: $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclIO.h"
+
+
+/*
+ * Forward declarations of internal procedures.
+ * First the driver procedures of the transformation.
+ */
+
+static int TransformBlockModeProc _ANSI_ARGS_ ((
+ ClientData instanceData, int mode));
+static int TransformCloseProc _ANSI_ARGS_ ((
+ ClientData instanceData, Tcl_Interp* interp));
+static int TransformInputProc _ANSI_ARGS_ ((
+ ClientData instanceData,
+ char* buf, int toRead, int* errorCodePtr));
+static int TransformOutputProc _ANSI_ARGS_ ((
+ ClientData instanceData,
+ char* buf, int toWrite, int* errorCodePtr));
+static int TransformSeekProc _ANSI_ARGS_ ((
+ ClientData instanceData, long offset,
+ int mode, int* errorCodePtr));
+static int TransformSetOptionProc _ANSI_ARGS_((
+ ClientData instanceData, Tcl_Interp *interp,
+ char *optionName, char *value));
+static int TransformGetOptionProc _ANSI_ARGS_((
+ ClientData instanceData, Tcl_Interp *interp,
+ char *optionName, Tcl_DString *dsPtr));
+static void TransformWatchProc _ANSI_ARGS_ ((
+ ClientData instanceData, int mask));
+static int TransformGetFileHandleProc _ANSI_ARGS_ ((
+ ClientData instanceData, int direction,
+ ClientData* handlePtr));
+static int TransformNotifyProc _ANSI_ARGS_ ((
+ ClientData instanceData, int mask));
+
+/*
+ * Forward declarations of internal procedures.
+ * Secondly the procedures for handling and generating fileeevents.
+ */
+
+static void TransformChannelHandlerTimer _ANSI_ARGS_ ((
+ ClientData clientData));
+
+/*
+ * Forward declarations of internal procedures.
+ * Third, helper procedures encapsulating essential tasks.
+ */
+
+typedef struct TransformChannelData TransformChannelData;
+
+static int ExecuteCallback _ANSI_ARGS_ ((
+ TransformChannelData* ctrl, Tcl_Interp* interp,
+ unsigned char* op, unsigned char* buf,
+ int bufLen, int transmit, int preserve));
+
+/*
+ * Action codes to give to 'ExecuteCallback' (argument 'transmit')
+ * confering to the procedure what to do with the result of the script
+ * it calls.
+ */
+
+#define TRANSMIT_DONT (0) /* No transfer to do */
+#define TRANSMIT_DOWN (1) /* Transfer to the underlying channel */
+#define TRANSMIT_SELF (2) /* Transfer into our channel. */
+#define TRANSMIT_IBUF (3) /* Transfer to internal input buffer */
+#define TRANSMIT_NUM (4) /* Transfer number to 'maxRead' */
+
+/*
+ * Codes for 'preserve' of 'ExecuteCallback'
+ */
+
+#define P_PRESERVE (1)
+#define P_NO_PRESERVE (0)
+
+/*
+ * Strings for the action codes delivered to the script implementing
+ * a transformation. Argument 'op' of 'ExecuteCallback'.
+ */
+
+#define A_CREATE_WRITE (UCHARP ("create/write"))
+#define A_DELETE_WRITE (UCHARP ("delete/write"))
+#define A_FLUSH_WRITE (UCHARP ("flush/write"))
+#define A_WRITE (UCHARP ("write"))
+
+#define A_CREATE_READ (UCHARP ("create/read"))
+#define A_DELETE_READ (UCHARP ("delete/read"))
+#define A_FLUSH_READ (UCHARP ("flush/read"))
+#define A_READ (UCHARP ("read"))
+
+#define A_QUERY_MAXREAD (UCHARP ("query/maxRead"))
+#define A_CLEAR_READ (UCHARP ("clear/read"))
+
+/*
+ * Management of a simple buffer.
+ */
+
+typedef struct ResultBuffer ResultBuffer;
+
+static void ResultClear _ANSI_ARGS_ ((ResultBuffer* r));
+static void ResultInit _ANSI_ARGS_ ((ResultBuffer* r));
+static int ResultLength _ANSI_ARGS_ ((ResultBuffer* r));
+static int ResultCopy _ANSI_ARGS_ ((ResultBuffer* r,
+ unsigned char* buf, int toRead));
+static void ResultAdd _ANSI_ARGS_ ((ResultBuffer* r,
+ unsigned char* buf, int toWrite));
+
+/*
+ * This structure describes the channel type structure for tcl based
+ * transformations.
+ */
+
+static Tcl_ChannelType transformChannelType = {
+ "transform", /* Type name. */
+ TCL_CHANNEL_VERSION_2,
+ TransformCloseProc, /* Close proc. */
+ TransformInputProc, /* Input proc. */
+ TransformOutputProc, /* Output proc. */
+ TransformSeekProc, /* Seek proc. */
+ TransformSetOptionProc, /* Set option proc. */
+ TransformGetOptionProc, /* Get option proc. */
+ TransformWatchProc, /* Initialize notifier. */
+ TransformGetFileHandleProc, /* Get OS handles out of channel. */
+ NULL, /* close2proc */
+ TransformBlockModeProc, /* Set blocking/nonblocking mode.*/
+ NULL, /* Flush proc. */
+ TransformNotifyProc, /* Handling of events bubbling up */
+};
+
+/*
+ * Possible values for 'flags' field in control structure, see below.
+ */
+
+#define CHANNEL_ASYNC (1<<0) /* non-blocking mode */
+
+/*
+ * Definition of the structure containing the information about the
+ * internal input buffer.
+ */
+
+struct ResultBuffer {
+ unsigned char* buf; /* Reference to the buffer area */
+ int allocated; /* Allocated size of the buffer area */
+ int used; /* Number of bytes in the buffer, <= allocated */
+};
+
+/*
+ * Additional bytes to allocate during buffer expansion
+ */
+
+#define INCREMENT (512)
+
+/*
+ * Number of milliseconds to wait before firing an event to flush
+ * out information waiting in buffers (fileevent support).
+ */
+
+#define DELAY (5)
+
+/*
+ * Convenience macro to make some casts easier to use.
+ */
+
+#define UCHARP(x) ((unsigned char*) (x))
+#define NO_INTERP ((Tcl_Interp*) NULL)
+
+/*
+ * Definition of a structure used by all transformations generated here to
+ * maintain their local state.
+ */
+
+struct TransformChannelData {
+
+ /*
+ * General section. Data to integrate the transformation into the channel
+ * system.
+ */
+
+ Tcl_Channel self; /* Our own Channel handle */
+ int readIsFlushed; /* Flag to note wether in.flushProc was called or not
+ */
+ int flags; /* Currently CHANNEL_ASYNC or zero */
+ int watchMask; /* Current watch/event/interest mask */
+ int mode; /* mode of parent channel, OR'ed combination of
+ * TCL_READABLE, TCL_WRITABLE */
+ Tcl_TimerToken timer; /* Timer for automatic flushing of information
+ * sitting in an internal buffer. Required for full
+ * fileevent support */
+ /*
+ * Transformation specific data.
+ */
+
+ int maxRead; /* Maximum allowed number of bytes to read, as
+ * given to us by the tcl script implementing the
+ * transformation. */
+ Tcl_Interp* interp; /* Reference to the interpreter which created the
+ * transformation. Used to execute the code
+ * below. */
+ Tcl_Obj* command; /* Tcl code to execute for a buffer */
+ ResultBuffer result; /* Internal buffer used to store the result of a
+ * transformation of incoming data. Additionally
+ * serves as buffer of all data not yet consumed by
+ * the reader. */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChannelTransform --
+ *
+ * Implements the Tcl "testchannel transform" debugging command.
+ * This is part of the testing environment. This sets up a tcl
+ * script (cmdObjPtr) to be used as a transform on the channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TclChannelTransform(interp, chan, cmdObjPtr)
+ Tcl_Interp *interp; /* Interpreter for result. */
+ Tcl_Channel chan; /* Channel to transform. */
+ Tcl_Obj *cmdObjPtr; /* Script to use for transform. */
+{
+ Channel *chanPtr; /* The actual channel. */
+ ChannelState *statePtr; /* state info for channel */
+ int mode; /* rw mode of the channel */
+ TransformChannelData *dataPtr;
+ int res;
+ Tcl_DString ds;
+
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+ chanPtr = statePtr->topChanPtr;
+ chan = (Tcl_Channel) chanPtr;
+ mode = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+
+ /*
+ * Now initialize the transformation state and stack it upon the
+ * specified channel. One of the necessary things to do is to
+ * retrieve the blocking regime of the underlying channel and to
+ * use the same for us too.
+ */
+
+ dataPtr = (TransformChannelData*) ckalloc(sizeof(TransformChannelData));
+
+ Tcl_DStringInit (&ds);
+ Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
+
+ dataPtr->readIsFlushed = 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 = (Tcl_TimerToken) NULL;
+ dataPtr->maxRead = 4096; /* Initial value not relevant */
+ dataPtr->interp = interp;
+ dataPtr->command = cmdObjPtr;
+
+ Tcl_IncrRefCount(dataPtr->command);
+
+ ResultInit(&dataPtr->result);
+
+ dataPtr->self = Tcl_StackChannel(interp, &transformChannelType,
+ (ClientData) dataPtr, mode, chan);
+ if (dataPtr->self == (Tcl_Channel) NULL) {
+ Tcl_AppendResult(interp, "\nfailed to stack channel \"",
+ Tcl_GetChannelName(chan), "\"", (char *) NULL);
+
+ Tcl_DecrRefCount(dataPtr->command);
+ ResultClear(&dataPtr->result);
+ ckfree((VOID *) dataPtr);
+ return TCL_ERROR;
+ }
+
+ /*
+ * At last initialize the transformation at the script level.
+ */
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_WRITE,
+ NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+
+ if (res != TCL_OK) {
+ Tcl_UnstackChannel(interp, chan);
+ return TCL_ERROR;
+ }
+ }
+
+ if (dataPtr->mode & TCL_READABLE) {
+ res = ExecuteCallback (dataPtr, NO_INTERP, A_CREATE_READ,
+ NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+
+ if (res != TCL_OK) {
+ ExecuteCallback (dataPtr, NO_INTERP, A_DELETE_WRITE,
+ NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+
+ Tcl_UnstackChannel(interp, chan);
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ExecuteCallback --
+ *
+ * Executes the defined callback for buffer and
+ * operation.
+ *
+ * Sideeffects:
+ * As of the executed tcl script.
+ *
+ * Result:
+ * A standard TCL error code. In case of an
+ * error a message is left in the result area
+ * of the specified interpreter.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve)
+ TransformChannelData* dataPtr; /* Transformation with the callback */
+ Tcl_Interp* interp; /* Current interpreter, possibly NULL */
+ unsigned char* op; /* Operation invoking the callback */
+ unsigned char* buf; /* Buffer to give to the script. */
+ int bufLen; /* Ands its length */
+ int transmit; /* Flag, determines whether the result
+ * of the callback is sent to the
+ * underlying channel or not. */
+ int preserve; /* Flag. If true the procedure will
+ * preserver the result state of all
+ * accessed interpreters. */
+{
+ /*
+ * Step 1, create the complete command to execute. Do this by appending
+ * operation and buffer to operate upon to a copy of the callback
+ * definition. We *cannot* create a list containing 3 objects and then use
+ * 'Tcl_EvalObjv', because the command may contain additional prefixed
+ * arguments. Feather's curried commands would come in handy here.
+ */
+
+ Tcl_Obj* resObj; /* See below, switch (transmit) */
+ int resLen;
+ unsigned char* resBuf;
+ Tcl_SavedResult ciSave;
+
+ int res = TCL_OK;
+ Tcl_Obj* command = Tcl_DuplicateObj (dataPtr->command);
+ Tcl_Obj* temp;
+
+
+ if (preserve) {
+ Tcl_SaveResult (dataPtr->interp, &ciSave);
+ }
+
+ if (command == (Tcl_Obj*) NULL) {
+ /* Memory allocation problem */
+ res = TCL_ERROR;
+ goto cleanup;
+ }
+
+ Tcl_IncrRefCount(command);
+
+ temp = Tcl_NewStringObj((char*) op, -1);
+
+ if (temp == (Tcl_Obj*) NULL) {
+ /* Memory allocation problem */
+ res = TCL_ERROR;
+ goto cleanup;
+ }
+
+ res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);
+
+ if (res != TCL_OK)
+ goto cleanup;
+
+ /*
+ * Use a byte-array to prevent the misinterpretation of binary data
+ * coming through as UTF while at the tcl level.
+ */
+
+ temp = Tcl_NewByteArrayObj(buf, bufLen);
+
+ if (temp == (Tcl_Obj*) NULL) {
+ /* Memory allocation problem */
+ res = TCL_ERROR;
+ goto cleanup;
+ }
+
+ res = Tcl_ListObjAppendElement (dataPtr->interp, command, temp);
+
+ if (res != TCL_OK)
+ goto cleanup;
+
+ /*
+ * Step 2, execute the command at the global level of the interpreter
+ * used to create the transformation. Destroy the command afterward.
+ * If an error occured and the current interpreter is defined and not
+ * equal to the interpreter for the callback, then copy the error
+ * message into current interpreter. Don't copy if in preservation mode.
+ */
+
+ res = Tcl_GlobalEvalObj (dataPtr->interp, command);
+ Tcl_DecrRefCount (command);
+ command = (Tcl_Obj*) NULL;
+
+ if ((res != TCL_OK) && (interp != NO_INTERP) &&
+ (dataPtr->interp != interp) && !preserve) {
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+ return res;
+ }
+
+ /*
+ * Step 3, transmit a possible conversion result to the underlying
+ * channel, or ourselves.
+ */
+
+ switch (transmit) {
+ case TRANSMIT_DONT:
+ /* nothing to do */
+ break;
+
+ case TRANSMIT_DOWN:
+ resObj = Tcl_GetObjResult(dataPtr->interp);
+ resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self),
+ (char*) resBuf, resLen);
+ break;
+
+ case TRANSMIT_SELF:
+ resObj = Tcl_GetObjResult (dataPtr->interp);
+ resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ Tcl_WriteRaw(dataPtr->self, (char*) resBuf, resLen);
+ break;
+
+ case TRANSMIT_IBUF:
+ resObj = Tcl_GetObjResult (dataPtr->interp);
+ resBuf = (unsigned char*) Tcl_GetByteArrayFromObj(resObj, &resLen);
+ ResultAdd(&dataPtr->result, resBuf, resLen);
+ break;
+
+ case TRANSMIT_NUM:
+ /* Interpret result as integer number */
+ resObj = Tcl_GetObjResult (dataPtr->interp);
+ Tcl_GetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+ break;
+ }
+
+ Tcl_ResetResult(dataPtr->interp);
+
+ if (preserve) {
+ Tcl_RestoreResult(dataPtr->interp, &ciSave);
+ }
+
+ return res;
+
+ cleanup:
+ if (preserve) {
+ Tcl_RestoreResult(dataPtr->interp, &ciSave);
+ }
+
+ if (command != (Tcl_Obj*) NULL) {
+ Tcl_DecrRefCount(command);
+ }
+
+ return res;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformBlockModeProc --
+ *
+ * Trap handler. Called by the generic IO system
+ * during option processing to change the blocking
+ * mode of the channel.
+ *
+ * Sideeffects:
+ * Forwards the request to the underlying
+ * channel.
+ *
+ * Result:
+ * 0 if successful, errno when failed.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformBlockModeProc (instanceData, mode)
+ ClientData instanceData; /* State of transformation */
+ int mode; /* New blocking mode */
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ dataPtr->flags |= CHANNEL_ASYNC;
+ } else {
+ dataPtr->flags &= ~(CHANNEL_ASYNC);
+ }
+ return 0;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformCloseProc --
+ *
+ * Trap handler. Called by the generic IO system
+ * during destruction of the transformation channel.
+ *
+ * Sideeffects:
+ * Releases the memory allocated in
+ * 'Tcl_TransformObjCmd'.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformCloseProc (instanceData, interp)
+ ClientData instanceData;
+ Tcl_Interp* interp;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+
+ /*
+ * Important: In this procedure 'dataPtr->self' already points to
+ * the underlying channel.
+ */
+
+ /*
+ * There is no need to cancel an existing channel handler, this is already
+ * done. Either by 'Tcl_UnstackChannel' or by the general cleanup in
+ * 'Tcl_Close'.
+ *
+ * But we have to cancel an active timer to prevent it from firing on the
+ * removed channel.
+ */
+
+ if (dataPtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler (dataPtr->timer);
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ /*
+ * Now flush data waiting in internal buffers to output and input. The
+ * input must be done despite the fact that there is no real receiver
+ * for it anymore. But the scripts might have sideeffects other parts
+ * of the system rely on (f.e. signaling the close to interested parties).
+ */
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback (dataPtr, interp, A_FLUSH_WRITE,
+ NULL, 0, TRANSMIT_DOWN, 1);
+ }
+
+ if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
+ dataPtr->readIsFlushed = 1;
+ ExecuteCallback (dataPtr, interp, A_FLUSH_READ,
+ NULL, 0, TRANSMIT_IBUF, 1);
+ }
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback (dataPtr, interp, A_DELETE_WRITE,
+ NULL, 0, TRANSMIT_DONT, 1);
+ }
+
+ if (dataPtr->mode & TCL_READABLE) {
+ ExecuteCallback (dataPtr, interp, A_DELETE_READ,
+ NULL, 0, TRANSMIT_DONT, 1);
+ }
+
+ /*
+ * General cleanup
+ */
+
+ ResultClear(&dataPtr->result);
+ Tcl_DecrRefCount(dataPtr->command);
+ ckfree((VOID*) dataPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformInputProc --
+ *
+ * Called by the generic IO system to convert read data.
+ *
+ * Sideeffects:
+ * As defined by the conversion.
+ *
+ * Result:
+ * A transformed buffer.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformInputProc (instanceData, buf, toRead, errorCodePtr)
+ ClientData instanceData;
+ char* buf;
+ int toRead;
+ int* errorCodePtr;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ int gotBytes, read, res, copied;
+ Tcl_Channel downChan;
+
+ /* should assert (dataPtr->mode & TCL_READABLE) */
+
+ if (toRead == 0) {
+ /* Catch a no-op.
+ */
+ return 0;
+ }
+
+ gotBytes = 0;
+ downChan = Tcl_GetStackedChannel(dataPtr->self);
+
+ while (toRead > 0) {
+ /*
+ * Loop until the request is satisfied (or no data is available from
+ * below, possibly EOF).
+ */
+
+ copied = ResultCopy (&dataPtr->result, UCHARP (buf), toRead);
+
+ toRead -= copied;
+ buf += copied;
+ gotBytes += copied;
+
+ if (toRead == 0) {
+ /* The request was completely satisfied from our buffers.
+ * We can break out of the loop and return to the caller.
+ */
+ return gotBytes;
+ }
+
+ /*
+ * Length (dataPtr->result) == 0, toRead > 0 here . Use the incoming
+ * 'buf'! as target to store the intermediary information read
+ * from the underlying channel.
+ *
+ * Ask the tcl level how much data it allows us to read from
+ * the underlying channel. This feature allows the transform to
+ * signal EOF upstream although there is none downstream. Useful
+ * to control an unbounded 'fcopy', either through counting bytes,
+ * or by pattern matching.
+ */
+
+ ExecuteCallback (dataPtr, NO_INTERP, A_QUERY_MAXREAD,
+ NULL, 0, TRANSMIT_NUM /* -> maxRead */, 1);
+
+ if (dataPtr->maxRead >= 0) {
+ if (dataPtr->maxRead < toRead) {
+ toRead = dataPtr->maxRead;
+ }
+ } /* else: 'maxRead < 0' == Accept the current value of toRead */
+
+ if (toRead <= 0) {
+ return gotBytes;
+ }
+
+ 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_GetErrno() == EAGAIN) && (gotBytes > 0)) {
+ return gotBytes;
+ }
+
+ *errorCodePtr = Tcl_GetErrno();
+ return -1;
+ }
+
+ 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.
+ */
+
+ if (! Tcl_Eof (downChan)) {
+ if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
+ *errorCodePtr = EWOULDBLOCK;
+ return -1;
+ } else {
+ return gotBytes;
+ }
+ } else {
+ if (dataPtr->readIsFlushed) {
+ /* Already flushed, nothing to do anymore
+ */
+ return gotBytes;
+ }
+
+ dataPtr->readIsFlushed = 1;
+
+ ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_READ,
+ NULL, 0, TRANSMIT_IBUF, P_PRESERVE);
+
+ if (ResultLength (&dataPtr->result) == 0) {
+ /* we had nothing to flush */
+ return gotBytes;
+ }
+
+ continue; /* at: while (toRead > 0) */
+ }
+ } /* read == 0 */
+
+ /* Transform the read chunk and add the result to our
+ * read buffer (dataPtr->result)
+ */
+
+ res = ExecuteCallback (dataPtr, NO_INTERP, A_READ,
+ UCHARP (buf), read, TRANSMIT_IBUF,
+ P_PRESERVE);
+
+ if (res != TCL_OK) {
+ *errorCodePtr = EINVAL;
+ return -1;
+ }
+ } /* while toRead > 0 */
+
+ return gotBytes;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformOutputProc --
+ *
+ * Called by the generic IO system to convert data
+ * waiting to be written.
+ *
+ * Sideeffects:
+ * As defined by the transformation.
+ *
+ * Result:
+ * A transformed buffer.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformOutputProc (instanceData, buf, toWrite, errorCodePtr)
+ ClientData instanceData;
+ char* buf;
+ int toWrite;
+ int* errorCodePtr;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ int res;
+
+ /* should assert (dataPtr->mode & TCL_WRITABLE) */
+
+ if (toWrite == 0) {
+ /* Catch a no-op.
+ */
+ return 0;
+ }
+
+ res = ExecuteCallback (dataPtr, NO_INTERP, A_WRITE,
+ UCHARP (buf), toWrite,
+ TRANSMIT_DOWN, P_NO_PRESERVE);
+
+ if (res != TCL_OK) {
+ *errorCodePtr = EINVAL;
+ return -1;
+ }
+
+ return toWrite;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformSeekProc --
+ *
+ * This procedure is called by the generic IO level
+ * to move the access point in a channel.
+ *
+ * Sideeffects:
+ * Moves the location at which the channel
+ * will be accessed in future operations.
+ * Flushes all transformation buffers, then
+ * forwards it to the underlying channel.
+ *
+ * Result:
+ * -1 if failed, the new position if
+ * successful. An output argument contains
+ * the POSIX error code if an error
+ * occurred, or zero.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformSeekProc (instanceData, offset, mode, errorCodePtr)
+ ClientData instanceData; /* The channel to manipulate */
+ long offset; /* Size of movement. */
+ int mode; /* How to move */
+ int* errorCodePtr; /* Location of error flag. */
+{
+ int result;
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
+ Tcl_ChannelType* parentType = Tcl_GetChannelType(parent);
+ Tcl_DriverSeekProc* parentSeekProc = Tcl_ChannelSeekProc(parentType);
+
+ if ((offset == 0) && (mode == SEEK_CUR)) {
+ /* This is no seek but a request to tell the caller the current
+ * location. Simply pass the request down.
+ */
+
+ result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
+ offset, mode, errorCodePtr);
+ return result;
+ }
+
+ /*
+ * It is a real request to change the position. Flush all data waiting
+ * for output and discard everything in the input buffers. Then pass
+ * the request down, unchanged.
+ */
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,
+ NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);
+ }
+
+ if (dataPtr->mode & TCL_READABLE) {
+ ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,
+ NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
+ ResultClear(&dataPtr->result);
+ dataPtr->readIsFlushed = 0;
+ }
+
+ result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
+ offset, mode, errorCodePtr);
+ return result;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformSetOptionProc --
+ *
+ * Called by generic layer to handle the reconfi-
+ * guration of channel specific options. As this
+ * channel type does not have such, it simply passes
+ * all requests downstream.
+ *
+ * Sideeffects:
+ * As defined by the channel downstream.
+ *
+ * Result:
+ * A standard TCL error code.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformSetOptionProc (instanceData, interp, optionName, value)
+ ClientData instanceData;
+ Tcl_Interp *interp;
+ char *optionName;
+ char *value;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
+ Tcl_DriverSetOptionProc *setOptionProc;
+
+ setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
+ if (setOptionProc != NULL) {
+ return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan),
+ interp, optionName, value);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformGetOptionProc --
+ *
+ * Called by generic layer to handle requests for
+ * the values of channel specific options. As this
+ * channel type does not have such, it simply passes
+ * all requests downstream.
+ *
+ * Sideeffects:
+ * As defined by the channel downstream.
+ *
+ * Result:
+ * A standard TCL error code.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformGetOptionProc (instanceData, interp, optionName, dsPtr)
+ ClientData instanceData;
+ Tcl_Interp* interp;
+ char* optionName;
+ Tcl_DString* dsPtr;
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
+ Tcl_DriverGetOptionProc *getOptionProc;
+
+ getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
+ if (getOptionProc != NULL) {
+ return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
+ interp, optionName, dsPtr);
+ } else if (optionName == (char*) NULL) {
+ /*
+ * Request is query for all options, this is ok.
+ */
+ return TCL_OK;
+ }
+ /*
+ * Request for a specific option has to fail, we don't have any.
+ */
+ return TCL_ERROR;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformWatchProc --
+ *
+ * Initialize the notifier to watch for events from
+ * this channel.
+ *
+ * Sideeffects:
+ * Sets up the notifier so that a future
+ * event on the channel will be seen by Tcl.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+ /* ARGSUSED */
+static void
+TransformWatchProc (instanceData, mask)
+ ClientData instanceData; /* Channel to watch */
+ int mask; /* Events of interest */
+{
+ /* The caller expressed interest in events occuring for this
+ * channel. We are forwarding the call to the underlying
+ * channel now.
+ */
+
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+ Tcl_Channel downChan;
+
+ dataPtr->watchMask = mask;
+
+ /* No channel handlers any more. We will be notified automatically
+ * about events on the channel below via a call to our
+ * 'TransformNotifyProc'. But we have to pass the interest down now.
+ * We are allowed to add additional 'interest' to the mask if we want
+ * to. But this transformation has no such interest. It just passes
+ * the request down, unchanged.
+ */
+
+ downChan = Tcl_GetStackedChannel(dataPtr->self);
+
+ (Tcl_GetChannelType(downChan))
+ ->watchProc(Tcl_GetChannelInstanceData(downChan), mask);
+
+ /*
+ * Management of the internal timer.
+ */
+
+ if ((dataPtr->timer != (Tcl_TimerToken) NULL) &&
+ (!(mask & TCL_READABLE) || (ResultLength(&dataPtr->result) == 0))) {
+
+ /* A pending timer exists, but either is there no (more)
+ * interest in the events it generates or nothing is availablee
+ * for reading, so remove it.
+ */
+
+ Tcl_DeleteTimerHandler (dataPtr->timer);
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ if ((dataPtr->timer == (Tcl_TimerToken) NULL) &&
+ (mask & TCL_READABLE) && (ResultLength (&dataPtr->result) > 0)) {
+
+ /* There is no pending timer, but there is interest in readable
+ * events and we actually have data waiting, so generate a timer
+ * to flush that.
+ */
+
+ dataPtr->timer = Tcl_CreateTimerHandler (DELAY,
+ TransformChannelHandlerTimer, (ClientData) dataPtr);
+ }
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformGetFileHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve
+ * OS specific file handle from inside this channel.
+ *
+ * Sideeffects:
+ * None.
+ *
+ * Result:
+ * The appropriate Tcl_File or NULL if not
+ * present.
+ *
+ *------------------------------------------------------*
+ */
+static int
+TransformGetFileHandleProc (instanceData, direction, handlePtr)
+ ClientData instanceData; /* Channel to query */
+ int direction; /* Direction of interest */
+ ClientData* handlePtr; /* Place to store the handle into */
+{
+ /*
+ * Return the handle belonging to parent channel.
+ * IOW, pass the request down and the result up.
+ */
+
+ TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+
+ return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self),
+ direction, handlePtr);
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformNotifyProc --
+ *
+ * ------------------------------------------------*
+ * Handler called by Tcl to inform us of activity
+ * on the underlying channel.
+ * ------------------------------------------------*
+ *
+ * Sideeffects:
+ * May process the incoming event by itself.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+TransformNotifyProc (clientData, mask)
+ ClientData clientData; /* The state of the notified transformation */
+ int mask; /* The mask of occuring events */
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) clientData;
+
+ /*
+ * An event occured in the underlying channel. This
+ * transformation doesn't process such events thus returns the
+ * incoming mask unchanged.
+ */
+
+ if (dataPtr->timer != (Tcl_TimerToken) NULL) {
+ /*
+ * Delete an existing timer. It was not fired, yet we are
+ * here, so the channel below generated such an event and we
+ * don't have to. The renewal of the interest after the
+ * execution of channel handlers will eventually cause us to
+ * recreate the timer (in TransformWatchProc).
+ */
+
+ Tcl_DeleteTimerHandler (dataPtr->timer);
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ return mask;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * TransformChannelHandlerTimer --
+ *
+ * Called by the notifier (-> timer) to flush out
+ * information waiting in the input buffer.
+ *
+ * Sideeffects:
+ * As of 'Tcl_NotifyChannel'.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static void
+TransformChannelHandlerTimer (clientData)
+ ClientData clientData; /* Transformation to query */
+{
+ TransformChannelData* dataPtr = (TransformChannelData*) clientData;
+
+ dataPtr->timer = (Tcl_TimerToken) NULL;
+
+ if (!(dataPtr->watchMask & TCL_READABLE) ||
+ (ResultLength (&dataPtr->result) == 0)) {
+ /* The timer fired, but either is there no (more)
+ * interest in the events it generates or nothing is available
+ * for reading, so ignore it and don't recreate it.
+ */
+
+ return;
+ }
+
+ Tcl_NotifyChannel(dataPtr->self, TCL_READABLE);
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultClear --
+ *
+ * Deallocates any memory allocated by 'ResultAdd'.
+ *
+ * Sideeffects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static void
+ResultClear (r)
+ ResultBuffer* r; /* Reference to the buffer to clear out */
+{
+ r->used = 0;
+
+ if (r->allocated) {
+ ckfree((char*) r->buf);
+ r->buf = UCHARP (NULL);
+ r->allocated = 0;
+ }
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultInit --
+ *
+ * Initializes the specified buffer structure. The
+ * structure will contain valid information for an
+ * emtpy buffer.
+ *
+ * Sideeffects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static void
+ResultInit (r)
+ ResultBuffer* r; /* Reference to the structure to initialize */
+{
+ r->used = 0;
+ r->allocated = 0;
+ r->buf = UCHARP (NULL);
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultLength --
+ *
+ * Returns the number of bytes stored in the buffer.
+ *
+ * Sideeffects:
+ * None.
+ *
+ * Result:
+ * An integer, see above too.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+ResultLength (r)
+ ResultBuffer* r; /* The structure to query */
+{
+ return r->used;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultCopy --
+ *
+ * Copies the requested number of bytes from the
+ * buffer into the specified array and removes them
+ * from the buffer afterward. Copies less if there
+ * is not enough data in the buffer.
+ *
+ * Sideeffects:
+ * See above.
+ *
+ * Result:
+ * The number of actually copied bytes,
+ * possibly less than 'toRead'.
+ *
+ *------------------------------------------------------*
+ */
+
+static int
+ResultCopy (r, buf, toRead)
+ ResultBuffer* r; /* The buffer to read from */
+ unsigned char* buf; /* The buffer to copy into */
+ int toRead; /* Number of requested bytes */
+{
+ if (r->used == 0) {
+ /* Nothing to copy in the case of an empty buffer.
+ */
+
+ return 0;
+ }
+
+ if (r->used == toRead) {
+ /* We have just enough. Copy everything to the caller.
+ */
+
+ memcpy ((VOID*) buf, (VOID*) r->buf, (size_t) toRead);
+ r->used = 0;
+ return toRead;
+ }
+
+ if (r->used > toRead) {
+ /* The internal buffer contains more than requested.
+ * Copy the requested subset to the caller, and shift
+ * the remaining bytes down.
+ */
+
+ memcpy ((VOID*) buf, (VOID*) r->buf, (size_t) toRead);
+ memmove ((VOID*) r->buf, (VOID*) (r->buf + toRead),
+ (size_t) r->used - toRead);
+
+ r->used -= toRead;
+ return toRead;
+ }
+
+ /* There is not enough in the buffer to satisfy the caller, so
+ * take everything.
+ */
+
+ memcpy((VOID*) buf, (VOID*) r->buf, (size_t) r->used);
+ toRead = r->used;
+ r->used = 0;
+ return toRead;
+}
+
+/*
+ *------------------------------------------------------*
+ *
+ * ResultAdd --
+ *
+ * Adds the bytes in the specified array to the
+ * buffer, by appending it.
+ *
+ * Sideeffects:
+ * See above.
+ *
+ * Result:
+ * None.
+ *
+ *------------------------------------------------------*
+ */
+
+static void
+ResultAdd (r, buf, toWrite)
+ ResultBuffer* r; /* The buffer to extend */
+ unsigned char* buf; /* The buffer to read from */
+ int toWrite; /* The number of bytes in 'buf' */
+{
+ if ((r->used + toWrite) > r->allocated) {
+ /* Extension of the internal buffer is required.
+ */
+
+ if (r->allocated == 0) {
+ r->allocated = toWrite + INCREMENT;
+ r->buf = UCHARP (ckalloc((unsigned) r->allocated));
+ } else {
+ r->allocated += toWrite + INCREMENT;
+ r->buf = UCHARP (ckrealloc((char*) r->buf,
+ (unsigned) r->allocated));
+ }
+ }
+
+ /* now copy data */
+ memcpy(r->buf + r->used, buf, (size_t) toWrite);
+ r->used += toWrite;
+}
diff --git a/tcl/generic/tclIOSock.c b/tcl/generic/tclIOSock.c
index c3947804465..031db7856dc 100644
--- a/tcl/generic/tclIOSock.c
+++ b/tcl/generic/tclIOSock.c
@@ -3,7 +3,7 @@
*
* Common routines used by all socket based channel types.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -15,7 +15,7 @@
#include "tclPort.h"
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TclSockGetPort --
*
@@ -24,14 +24,14 @@
* registered service names to port numbers.
*
* Results:
- * A standard Tcl result. On success, the port number is
- * returned in portPtr. On failure, an error message is left in
- * interp->result.
+ * A standard Tcl result. On success, the port number is returned
+ * in portPtr. On failure, an error message is left in the interp's
+ * result.
*
* Side effects:
* None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -42,14 +42,21 @@ TclSockGetPort(interp, string, proto, portPtr)
int *portPtr; /* Return port number */
{
struct servent *sp; /* Protocol info for named services */
- if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
- sp = getservbyname(string, proto);
+ Tcl_DString ds;
+ char *native;
+
+ if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
+ /*
+ * Don't bother translating 'proto' to native.
+ */
+
+ native = Tcl_UtfToExternalDString(NULL, string, -1, &ds);
+ sp = getservbyname(native, proto); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
if (sp != NULL) {
*portPtr = ntohs((unsigned short) sp->s_port);
- Tcl_ResetResult(interp); /* clear error message */
return TCL_OK;
}
- return TCL_ERROR;
}
if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
return TCL_ERROR;
@@ -84,8 +91,11 @@ TclSockMinimumBuffers(sock, size)
int size; /* Minimum buffer size */
{
int current;
- int len;
-
+ /*
+ * Should be socklen_t, but HP10.20 (g)cc chokes
+ */
+ size_t len;
+
len = sizeof(int);
getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
if (current < size) {
@@ -100,3 +110,4 @@ TclSockMinimumBuffers(sock, size)
}
return TCL_OK;
}
+
diff --git a/tcl/generic/tclIOUtil.c b/tcl/generic/tclIOUtil.c
index 21268b29cd0..445a29d7108 100644
--- a/tcl/generic/tclIOUtil.c
+++ b/tcl/generic/tclIOUtil.c
@@ -8,7 +8,7 @@
* Lehenbauer, Mark Diekhans and Peter da Silva.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -54,7 +54,9 @@ typedef struct OpenFileChannelProc {
* these statically declared list entry cannot be inadvertently removed.
*
* This method avoids the need to call any sort of "initialization"
- * function
+ * function.
+ *
+ * All three lists are protected by a global hookMutex.
*/
static StatProc defaultStatProc = {
@@ -72,9 +74,11 @@ static OpenFileChannelProc defaultOpenFileChannelProc = {
};
static OpenFileChannelProc *openFileChannelProcList =
&defaultOpenFileChannelProc;
+
+TCL_DECLARE_MUTEX(hookMutex)
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TclGetOpenMode --
*
@@ -85,8 +89,8 @@ static OpenFileChannelProc *openFileChannelProcList =
*
* Results:
* On success, returns mode to pass to "open". If an error occurs, the
- * returns -1 and if interp is not NULL, sets interp->result to an
- * error message.
+ * return value is -1 and if interp is not NULL, sets interp's result
+ * object to an error message.
*
* Side effects:
* Sets the integer referenced by seekFlagPtr to 1 to tell the caller
@@ -96,7 +100,7 @@ static OpenFileChannelProc *openFileChannelProcList =
* This code is based on a prototype implementation contributed
* by Mark Diekhans.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -121,7 +125,14 @@ TclGetOpenMode(interp, string, seekFlagPtr)
*seekFlagPtr = 0;
mode = 0;
- if (islower(UCHAR(string[0]))) {
+
+ /*
+ * Guard against international characters before using byte oriented
+ * routines.
+ */
+
+ if (!(string[0] & 0x80)
+ && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
switch (string[0]) {
case 'r':
mode = O_RDONLY;
@@ -265,82 +276,57 @@ Tcl_EvalFile(interp, fileName)
char *fileName; /* Name of file to process. Tilde-substitution
* will be performed on this name. */
{
- int result;
+ int result, length;
struct stat statBuf;
- char *cmdBuffer = (char *) NULL;
char *oldScriptFile;
- Interp *iPtr = (Interp *) interp;
- Tcl_DString buffer;
- char *nativeName;
+ Interp *iPtr;
+ Tcl_DString nameString;
+ char *name, *string;
Tcl_Channel chan;
- Tcl_Obj *cmdObjPtr;
+ Tcl_Obj *objPtr;
- Tcl_ResetResult(interp);
- oldScriptFile = iPtr->scriptFile;
- iPtr->scriptFile = fileName;
- Tcl_DStringInit(&buffer);
- nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (nativeName == NULL) {
- goto error;
+ name = Tcl_TranslateFileName(interp, fileName, &nameString);
+ if (name == NULL) {
+ return TCL_ERROR;
}
- /*
- * If Tcl_TranslateFileName didn't already copy the file name, do it
- * here. This way we don't depend on fileName staying constant
- * throughout the execution of the script (e.g., what if it happens
- * to point to a Tcl variable that the script could change?).
- */
+ result = TCL_ERROR;
+ objPtr = Tcl_NewObj();
- if (nativeName != Tcl_DStringValue(&buffer)) {
- Tcl_DStringSetLength(&buffer, 0);
- Tcl_DStringAppend(&buffer, nativeName, -1);
- nativeName = Tcl_DStringValue(&buffer);
- }
- if (TclStat(nativeName, &statBuf) == -1) {
+ if (TclStat(name, &statBuf) == -1) {
Tcl_SetErrno(errno);
Tcl_AppendResult(interp, "couldn't read file \"", fileName,
"\": ", Tcl_PosixError(interp), (char *) NULL);
- goto error;
+ goto end;
}
- chan = Tcl_OpenFileChannel(interp, nativeName, "r", 0644);
+ chan = Tcl_OpenFileChannel(interp, name, "r", 0644);
if (chan == (Tcl_Channel) NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't read file \"", fileName,
"\": ", Tcl_PosixError(interp), (char *) NULL);
- goto error;
+ goto end;
}
- cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
- result = Tcl_Read(chan, cmdBuffer, statBuf.st_size);
- if (result < 0) {
+ if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
Tcl_Close(interp, chan);
Tcl_AppendResult(interp, "couldn't read file \"", fileName,
"\": ", Tcl_PosixError(interp), (char *) NULL);
- goto error;
+ goto end;
}
- cmdBuffer[result] = 0;
if (Tcl_Close(interp, chan) != TCL_OK) {
- goto error;
+ goto end;
}
- /*
- * Transfer the buffer memory allocated above to the object system.
- * Tcl_EvalObj will own this new string object if needed,
- * so past the Tcl_EvalObj point, we must not ckfree(cmdBuffer)
- * but rather use the reference counting mechanism.
- * (Nb: and we must not thus not use goto error after this point)
- */
- cmdObjPtr = Tcl_NewObj();
- cmdObjPtr->bytes = cmdBuffer;
- cmdObjPtr->length = result;
-
- Tcl_IncrRefCount(cmdObjPtr);
- result = Tcl_EvalObj(interp, cmdObjPtr);
- Tcl_DecrRefCount(cmdObjPtr);
+ iPtr = (Interp *) interp;
+ oldScriptFile = iPtr->scriptFile;
+ iPtr->scriptFile = fileName;
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ result = Tcl_EvalEx(interp, string, length, 0);
+ iPtr->scriptFile = oldScriptFile;
if (result == TCL_RETURN) {
result = TclUpdateReturnInfo(iPtr);
} else if (result == TCL_ERROR) {
- char msg[200];
+ char msg[200 + TCL_INTEGER_SPACE];
/*
* Record information telling where the error occurred.
@@ -350,17 +336,11 @@ Tcl_EvalFile(interp, fileName)
interp->errorLine);
Tcl_AddErrorInfo(interp, msg);
}
- iPtr->scriptFile = oldScriptFile;
- Tcl_DStringFree(&buffer);
- return result;
-error:
- if (cmdBuffer != (char *) NULL) {
- ckfree(cmdBuffer);
- }
- iPtr->scriptFile = oldScriptFile;
- Tcl_DStringFree(&buffer);
- return TCL_ERROR;
+ end:
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DStringFree(&nameString);
+ return result;
}
/*
@@ -466,9 +446,9 @@ Tcl_PosixError(interp)
int
TclStat(path, buf)
CONST char *path; /* Path of file to stat (in current CP). */
- TclStat_ *buf; /* Filled with results of stat call. */
+ struct stat *buf; /* Filled with results of stat call. */
{
- StatProc *statProcPtr = statProcList;
+ StatProc *statProcPtr;
int retVal = -1;
/*
@@ -476,10 +456,13 @@ TclStat(path, buf)
* value of -1 indicates the particular function has succeeded.
*/
+ Tcl_MutexLock(&hookMutex);
+ statProcPtr = statProcList;
while ((retVal == -1) && (statProcPtr != NULL)) {
retVal = (*statProcPtr->proc)(path, buf);
statProcPtr = statProcPtr->nextPtr;
}
+ Tcl_MutexUnlock(&hookMutex);
return (retVal);
}
@@ -508,7 +491,7 @@ TclAccess(path, mode)
CONST char *path; /* Path of file to access (in current CP). */
int mode; /* Permission setting. */
{
- AccessProc *accessProcPtr = accessProcList;
+ AccessProc *accessProcPtr;
int retVal = -1;
/*
@@ -516,10 +499,13 @@ TclAccess(path, mode)
* value of -1 indicates the particular function has succeeded.
*/
+ Tcl_MutexLock(&hookMutex);
+ accessProcPtr = accessProcList;
while ((retVal == -1) && (accessProcPtr != NULL)) {
retVal = (*accessProcPtr->proc)(path, mode);
accessProcPtr = accessProcPtr->nextPtr;
}
+ Tcl_MutexUnlock(&hookMutex);
return (retVal);
}
@@ -555,7 +541,7 @@ Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
* file, with what modes to create
* it? */
{
- OpenFileChannelProc *openFileChannelProcPtr = openFileChannelProcList;
+ OpenFileChannelProc *openFileChannelProcPtr;
Tcl_Channel retVal = NULL;
/*
@@ -564,11 +550,14 @@ Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
* succeeded.
*/
+ Tcl_MutexLock(&hookMutex);
+ openFileChannelProcPtr = openFileChannelProcList;
while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
retVal = (*openFileChannelProcPtr->proc)(interp, fileName,
modeString, permissions);
openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
}
+ Tcl_MutexUnlock(&hookMutex);
return (retVal);
}
@@ -604,12 +593,14 @@ TclStatInsertProc (proc)
if (proc != NULL) {
StatProc *newStatProcPtr;
- newStatProcPtr = (StatProc *)Tcl_Alloc(sizeof(StatProc));;
+ newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc));
if (newStatProcPtr != NULL) {
newStatProcPtr->proc = proc;
+ Tcl_MutexLock(&hookMutex);
newStatProcPtr->nextPtr = statProcList;
statProcList = newStatProcPtr;
+ Tcl_MutexUnlock(&hookMutex);
retVal = TCL_OK;
}
@@ -642,9 +633,11 @@ TclStatDeleteProc (proc)
TclStatProc_ *proc;
{
int retVal = TCL_ERROR;
- StatProc *tmpStatProcPtr = statProcList;
+ StatProc *tmpStatProcPtr;
StatProc *prevStatProcPtr = NULL;
+ Tcl_MutexLock(&hookMutex);
+ tmpStatProcPtr = statProcList;
/*
* Traverse the 'statProcList' looking for the particular node
* whose 'proc' member matches 'proc' and remove that one from
@@ -668,6 +661,7 @@ TclStatDeleteProc (proc)
}
}
+ Tcl_MutexUnlock(&hookMutex);
return (retVal);
}
@@ -702,12 +696,14 @@ TclAccessInsertProc(proc)
if (proc != NULL) {
AccessProc *newAccessProcPtr;
- newAccessProcPtr = (AccessProc *)Tcl_Alloc(sizeof(AccessProc));;
+ newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc));
if (newAccessProcPtr != NULL) {
newAccessProcPtr->proc = proc;
+ Tcl_MutexLock(&hookMutex);
newAccessProcPtr->nextPtr = accessProcList;
accessProcList = newAccessProcPtr;
+ Tcl_MutexUnlock(&hookMutex);
retVal = TCL_OK;
}
@@ -740,7 +736,7 @@ TclAccessDeleteProc(proc)
TclAccessProc_ *proc;
{
int retVal = TCL_ERROR;
- AccessProc *tmpAccessProcPtr = accessProcList;
+ AccessProc *tmpAccessProcPtr;
AccessProc *prevAccessProcPtr = NULL;
/*
@@ -749,6 +745,8 @@ TclAccessDeleteProc(proc)
* the list. Ensure that the "default" node cannot be removed.
*/
+ Tcl_MutexLock(&hookMutex);
+ tmpAccessProcPtr = accessProcList;
while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != &defaultAccessProc)) {
if (tmpAccessProcPtr->proc == proc) {
if (prevAccessProcPtr == NULL) {
@@ -765,6 +763,7 @@ TclAccessDeleteProc(proc)
tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
}
}
+ Tcl_MutexUnlock(&hookMutex);
return (retVal);
}
@@ -802,12 +801,14 @@ TclOpenFileChannelInsertProc(proc)
OpenFileChannelProc *newOpenFileChannelProcPtr;
newOpenFileChannelProcPtr =
- (OpenFileChannelProc *)Tcl_Alloc(sizeof(OpenFileChannelProc));;
+ (OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc));
if (newOpenFileChannelProcPtr != NULL) {
newOpenFileChannelProcPtr->proc = proc;
+ Tcl_MutexLock(&hookMutex);
newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
openFileChannelProcList = newOpenFileChannelProcPtr;
+ Tcl_MutexUnlock(&hookMutex);
retVal = TCL_OK;
}
@@ -849,6 +850,8 @@ TclOpenFileChannelDeleteProc(proc)
* the list. Ensure that the "default" node cannot be removed.
*/
+ Tcl_MutexLock(&hookMutex);
+ tmpOpenFileChannelProcPtr = openFileChannelProcList;
while ((retVal == TCL_ERROR) &&
(tmpOpenFileChannelProcPtr != &defaultOpenFileChannelProc)) {
if (tmpOpenFileChannelProcPtr->proc == proc) {
@@ -867,6 +870,7 @@ TclOpenFileChannelDeleteProc(proc)
tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
}
}
+ Tcl_MutexUnlock(&hookMutex);
return (retVal);
}
diff --git a/tcl/generic/tclIndexObj.c b/tcl/generic/tclIndexObj.c
index f88d216e751..3187de62c0a 100644
--- a/tcl/generic/tclIndexObj.c
+++ b/tcl/generic/tclIndexObj.c
@@ -19,11 +19,8 @@
* Prototypes for procedures defined later in this file:
*/
-static void DupIndexInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
static int SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
-static void UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *listPtr));
/*
* The structure below defines the index Tcl object type by means of
@@ -33,10 +30,17 @@ static void UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *listPtr));
Tcl_ObjType tclIndexType = {
"index", /* name */
(Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- DupIndexInternalRep, /* dupIntRepProc */
- UpdateStringOfIndex, /* updateStringProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
SetIndexFromAny /* setFromAnyProc */
};
+
+/*
+ * Boolean flag indicating whether or not the tclIndexType object
+ * type has been registered with the Tcl compiler.
+ */
+
+static int indexTypeInitialized = 0;
/*
*----------------------------------------------------------------------
@@ -47,7 +51,7 @@ Tcl_ObjType tclIndexType = {
* and returns the index of the matching string, if any.
*
* Results:
-
+ *
* If the value of objPtr is identical to or a unique abbreviation
* for one of the entries in objPtr, then the return value is
* TCL_OK and the index of the matching entry is stored at
@@ -76,6 +80,67 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
int flags; /* 0 or TCL_EXACT */
int *indexPtr; /* Place to store resulting integer index. */
{
+
+ /*
+ * See if there is a valid cached result from a previous lookup
+ * (doing the check here saves the overhead of calling
+ * Tcl_GetIndexFromObjStruct in the common case where the result
+ * is cached).
+ */
+
+ if ((objPtr->typePtr == &tclIndexType)
+ && (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr)) {
+ *indexPtr = (int) objPtr->internalRep.twoPtrValue.ptr2;
+ return TCL_OK;
+ }
+ return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
+ msg, flags, indexPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetIndexFromObjStruct --
+ *
+ * This procedure looks up an object's value given a starting
+ * string and an offset for the amount of space between strings.
+ * This is useful when the strings are embedded in some other
+ * kind of array.
+ *
+ * Results:
+ *
+ * If the value of objPtr is identical to or a unique abbreviation
+ * for one of the entries in objPtr, then the return value is
+ * TCL_OK and the index of the matching entry is stored at
+ * *indexPtr. If there isn't a proper match, then TCL_ERROR is
+ * returned and an error message is left in interp's result (unless
+ * interp is NULL). The msg argument is used in the error
+ * message; for example, if msg has the value "option" then the
+ * error message will say something flag 'bad option "foo": must be
+ * ...'
+ *
+ * Side effects:
+ * The result of the lookup is cached as the internal rep of
+ * objPtr, so that repeated lookups can be done quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
+ indexPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* Object containing the string to lookup. */
+ char **tablePtr; /* The first string in the table. The second
+ * string will be at this address plus the
+ * offset, the third plus the offset again,
+ * etc. The last entry must be NULL
+ * and there must not be duplicate entries. */
+ int offset; /* The number of bytes between entries */
+ char *msg; /* Identifying word to use in error messages. */
+ int flags; /* 0 or TCL_EXACT */
+ int *indexPtr; /* Place to store resulting integer index. */
+{
int index, length, i, numAbbrev;
char *key, *p1, *p2, **entryPtr;
Tcl_Obj *resultPtr;
@@ -95,10 +160,30 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
* abbreviations unless TCL_EXACT is set in flags.
*/
+ if (!indexTypeInitialized) {
+ /*
+ * This is the first time we've done a lookup. Register the
+ * tclIndexType.
+ */
+
+ Tcl_RegisterObjType(&tclIndexType);
+ indexTypeInitialized = 1;
+ }
+
key = Tcl_GetStringFromObj(objPtr, &length);
index = -1;
numAbbrev = 0;
- for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
+
+ /*
+ * The key should not be empty, otherwise it's not a match.
+ */
+
+ if (key[0] == '\0') {
+ goto error;
+ }
+
+ for (entryPtr = tablePtr, i = 0; *entryPtr != NULL;
+ entryPtr = (char **) ((long) entryPtr + offset), i++) {
for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
if (*p1 == 0) {
index = i;
@@ -128,20 +213,28 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
objPtr->typePtr->freeIntRepProc(objPtr);
}
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) index;
+ /*
+ * Make sure to account for offsets != sizeof(char *). [Bug 5153]
+ */
+ objPtr->internalRep.twoPtrValue.ptr2 =
+ (VOID *) (index * (offset / sizeof(char *)));
objPtr->typePtr = &tclIndexType;
*indexPtr = index;
return TCL_OK;
error:
if (interp != NULL) {
+ int count;
resultPtr = Tcl_GetObjResult(interp);
Tcl_AppendStringsToObj(resultPtr,
(numAbbrev > 1) ? "ambiguous " : "bad ", msg, " \"",
key, "\": must be ", *tablePtr, (char *) NULL);
- for (entryPtr = tablePtr+1; *entryPtr != NULL; entryPtr++) {
- if (entryPtr[1] == NULL) {
- Tcl_AppendStringsToObj(resultPtr, ", or ", *entryPtr,
+ for (entryPtr = (char **) ((long) tablePtr + offset), count = 0;
+ *entryPtr != NULL;
+ entryPtr = (char **) ((long) entryPtr + offset), count++) {
+ if ((*((char **) ((long) entryPtr + offset))) == NULL) {
+ Tcl_AppendStringsToObj(resultPtr,
+ (count > 0) ? ", or " : " or ", *entryPtr,
(char *) NULL);
} else {
Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
@@ -155,36 +248,6 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
/*
*----------------------------------------------------------------------
*
- * DupIndexInternalRep --
- *
- * Copy the internal representation of an index Tcl_Obj from one
- * object to another.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to same value as "srcPtr"s
- * internal rep.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupIndexInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- copyPtr->internalRep.twoPtrValue.ptr1
- = srcPtr->internalRep.twoPtrValue.ptr1;
- copyPtr->internalRep.twoPtrValue.ptr2
- = srcPtr->internalRep.twoPtrValue.ptr2;
- copyPtr->typePtr = &tclIndexType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetIndexFromAny --
*
* This procedure is called to convert a Tcl object to index
@@ -216,31 +279,6 @@ SetIndexFromAny(interp, objPtr)
/*
*----------------------------------------------------------------------
*
- * UpdateStringOfIndex --
- *
- * This procedure is called to update the string representation for
- * an index object. It should never be called, because we never
- * invalidate the string representation for an index object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * A panic is added
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfIndex(objPtr)
- register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
-{
- panic("UpdateStringOfIndex should never be invoked");
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_WrongNumArgs --
*
* This procedure generates a "wrong # args" error message in an
@@ -293,8 +331,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
tablePtr[(int) objv[i]->internalRep.twoPtrValue.ptr2],
(char *) NULL);
} else {
- Tcl_AppendStringsToObj(objPtr,
- Tcl_GetStringFromObj(objv[i], (int *) NULL),
+ Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]),
(char *) NULL);
}
if (i < (objc - 1)) {
@@ -306,3 +343,4 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
}
Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
}
+
diff --git a/tcl/generic/tclInitScript.h b/tcl/generic/tclInitScript.h
index 975edeab3cf..749492361b9 100644
--- a/tcl/generic/tclInitScript.h
+++ b/tcl/generic/tclInitScript.h
@@ -3,16 +3,10 @@
*
* This file contains Unix & Windows common init script
* It is not used on the Mac. (the mac init script is in tclMacInit.c)
- * This file should only be included once in the entire set of C
- * source files for Tcl (by the respective platform initialization
- * C source file, tclUnixInit.c and tclWinInit.c) and thus the
- * presence of the routine, TclSetPreInitScript, below, should be
- * harmless.
*
* Copyright (c) 1998 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ * All rights reserved.
*
* RCS: @(#) $Id$
*/
@@ -32,28 +26,8 @@
* from a static C variable that was set at
* compile time
*
- * <executable directory>/../lib/tcl$tcl_version
- * - look for a lib/tcl<ver> in a sibling of
- * the bin directory (e.g. install hierarchy)
- *
- * <executable directory>/../../lib/tcl$tcl_version
- * - look for a lib/tcl<ver> in a sibling of
- * the bin/arch directory
- *
- * <executable directory>/../library
- * - look in build directory
- *
- * <executable directory>/../../library
- * - look in build directory from unix/arch
- *
- * <executable directory>/../../tcl$tcl_patchLevel/library
- * - look for tcl build directory relative
- * to a parallel build directory (e.g. Tk)
- *
- * <executable directory>/../../../tcl$tcl_patchLevel/library
- * - look for tcl build directory relative
- * to a parallel build directory from
- * down inside unix/arch directory
+ * $tcl_libPath - this value is initialized by a call to
+ * TclGetLibraryPath called from Tcl_Init.
*
* The first directory on this path that contains a valid init.tcl script
* will be set as the value of tcl_library.
@@ -64,9 +38,8 @@
static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
proc tclInit {} {\n\
- global tcl_library tcl_version tcl_patchLevel errorInfo\n\
- global tcl_pkgPath env tclDefaultLibrary\n\
- global tcl_platform\n\
+ global tcl_libPath tcl_library errorInfo\n\
+ global env tclDefaultLibrary\n\
rename tclInit {}\n\
set errors {}\n\
set dirs {}\n\
@@ -76,61 +49,16 @@ static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
if {[info exists env(TCL_LIBRARY)]} {\n\
lappend dirs $env(TCL_LIBRARY)\n\
}\n\
- # CYGNUS LOCAL: I've changed this alot. Basically we only care about two cases,\n\
- # if we are installed, and if we are in the devo tree...\n\
- # The next few are for if we are installed:\n\
- set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
- lappend dirs [file join $parentDir share tcl$tcl_version]\n\
- lappend dirs [file join [file dirname $parentDir] share tcl$tcl_version]\n\
- # NOW, let's try to find it in the build tree...\n\
- # Rather than play all the games Scriptics does, if we are in the build\n\
- # tree there will be a tclConfig.sh relative to the executible's directory, and we \n\
- # can read it and get the source dir from there...\n\
- #\n\
- # We duplicate all the directories in the search, one w/o the version and one with.\n\
- # Most modules use ../../tcl/{unix,win}\n\
- lappend configDirs [file join [file dirname $parentDir] tcl$tcl_version $tcl_platform(platform)]\n\
- lappend configDirs [file join [file dirname $parentDir] tcl $tcl_platform(platform)]\n\
- # This one gets tclsh...\n\
- lappend configDirs [info nameofexecutable]\n\
- # This one is for gdb, and any other app which has its executible in the top directory.\n\
- lappend configDirs [file join $parentDir tcl$tcl_version $tcl_platform(platform)]\n\
- lappend configDirs [file join $parentDir tcl $tcl_platform(platform)]\n\
- # This last will handle itclsh & itkwish (../../../tcl/{unix,win}):\n\
- lappend configDirs [file join [file dirname [file dirname $parentDir]] tcl$tcl_version $tcl_platform(platform)]\n\
- lappend configDirs [file join [file dirname [file dirname $parentDir]] tcl $tcl_platform(platform)]\n\
- \n\
- foreach i $configDirs {\n\
- set configFile [file join $i tclConfig.sh]\n\
- if {[file exists $configFile]} {\n\
- if {![catch {open $configFile r} fileH]} {\n\
- set srcDir {}\n\
- while {[gets $fileH line] >= 0} {\n\
- if {[regexp {^TCL_SRC_DIR='([^']*)'} $line dummy srcDir]} {\n\
- break\n\
- }\n\
- }\n\
- close $fileH\n\
- if {$srcDir != \"\"} {\n\
- lappend dirs [file join $srcDir library]\n\
- break\n\
- }\n\
- }\n\
- }\n\
- }\n\
+ lappend dirs $tclDefaultLibrary\n\
+ unset tclDefaultLibrary\n\
+ set dirs [concat $dirs $tcl_libPath]\n\
}\n\
- # I also moved this from just after TCL_LIBRARY to last.\n\
- # I only want to use the compiled in library if I am really lost, because\n\
- # otherwise if I have installed once, but am working in the build directory,\n\
- # I will always pick up the installed files, which will be very confusing...\n\
- lappend dirs $tclDefaultLibrary\n\
- unset tclDefaultLibrary\n\
foreach i $dirs {\n\
set tcl_library $i\n\
set tclfile [file join $i init.tcl]\n\
if {[file exists $tclfile]} {\n\
if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\
- return\n\
+ return\n\
} else {\n\
append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
}\n\
@@ -146,6 +74,7 @@ static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
}\n\
tclInit";
+
/*
* A pointer to a string that holds an initialization script that if non-NULL
* is evaluated in Tcl_Init() prior to the the built-in initialization script
diff --git a/tcl/generic/tclInt.decls b/tcl/generic/tclInt.decls
new file mode 100644
index 00000000000..71903e72fe9
--- /dev/null
+++ b/tcl/generic/tclInt.decls
@@ -0,0 +1,870 @@
+# tclInt.decls --
+#
+# 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
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+library tcl
+
+# Define the unsupported generic interfaces.
+
+interface tclInt
+
+# Declare each of the functions in the unsupported internal Tcl
+# interface. These interfaces are allowed to changed between versions.
+# Use at your own risk. Note that the position of functions should not
+# be changed between versions to avoid gratuitous incompatibilities.
+
+declare 0 generic {
+ int TclAccess(CONST char *path, int mode)
+}
+declare 1 generic {
+ int TclAccessDeleteProc(TclAccessProc_ *proc)
+}
+declare 2 generic {
+ int TclAccessInsertProc(TclAccessProc_ *proc)
+}
+declare 3 generic {
+ void TclAllocateFreeObjects(void)
+}
+# Replaced by TclpChdir in 8.1:
+# declare 4 generic {
+# int TclChdir(Tcl_Interp *interp, char *dirName)
+# }
+declare 5 {unix win} {
+ int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, \
+ Tcl_Channel errorChan)
+}
+declare 6 generic {
+ void TclCleanupCommand(Command *cmdPtr)
+}
+declare 7 generic {
+ int TclCopyAndCollapse(int count, CONST char *src, char *dst)
+}
+declare 8 generic {
+ int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, \
+ Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
+}
+
+# TclCreatePipeline unofficially exported for use by BLT.
+
+declare 9 {unix win} {
+ int TclCreatePipeline(Tcl_Interp *interp, int argc, char **argv, \
+ Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, \
+ TclFile *errFilePtr)
+}
+declare 10 generic {
+ int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, char *procName, \
+ Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr)
+}
+declare 11 generic {
+ void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
+}
+declare 12 generic {
+ void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr)
+}
+declare 13 generic {
+ int TclDoGlob(Tcl_Interp *interp, char *separators, \
+ Tcl_DString *headPtr, char *tail, GlobTypeData *types)
+}
+declare 14 generic {
+ void TclDumpMemoryInfo(FILE *outFile)
+}
+# Removed in 8.1:
+# declare 15 generic {
+# void TclExpandParseValue(ParseValue *pvPtr, int needed)
+# }
+declare 16 generic {
+ void TclExprFloatError(Tcl_Interp *interp, double value)
+}
+declare 17 generic {
+ int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+}
+declare 18 generic {
+ int TclFileCopyCmd(Tcl_Interp *interp, int argc, char **argv)
+}
+declare 19 generic {
+ int TclFileDeleteCmd(Tcl_Interp *interp, int argc, char **argv)
+}
+declare 20 generic {
+ int TclFileMakeDirsCmd(Tcl_Interp *interp, int argc, char **argv)
+}
+declare 21 generic {
+ int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
+}
+declare 22 generic {
+ int TclFindElement(Tcl_Interp *interp, CONST char *listStr, \
+ int listLength, CONST char **elementPtr, CONST char **nextPtr, \
+ int *sizePtr, int *bracePtr)
+}
+declare 23 generic {
+ Proc * TclFindProc(Interp *iPtr, char *procName)
+}
+declare 24 generic {
+ int TclFormatInt(char *buffer, long n)
+}
+declare 25 generic {
+ void TclFreePackageInfo(Interp *iPtr)
+}
+# Removed in 8.1:
+# declare 26 generic {
+# char * TclGetCwd(Tcl_Interp *interp)
+# }
+declare 27 generic {
+ int TclGetDate(char *p, unsigned long now, long zone, \
+ unsigned long *timePtr)
+}
+declare 28 generic {
+ Tcl_Channel TclpGetDefaultStdChannel(int type)
+}
+declare 29 generic {
+ Tcl_Obj * TclGetElementOfIndexedArray(Tcl_Interp *interp, \
+ int localIndex, Tcl_Obj *elemPtr, int leaveErrorMsg)
+}
+# Replaced by char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) in 8.1:
+# declare 30 generic {
+# char * TclGetEnv(CONST char *name)
+# }
+declare 31 generic {
+ char * TclGetExtension(char *name)
+}
+declare 32 generic {
+ int TclGetFrame(Tcl_Interp *interp, char *str, CallFrame **framePtrPtr)
+}
+declare 33 generic {
+ TclCmdProcType TclGetInterpProc(void)
+}
+declare 34 generic {
+ int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int endValue, int *indexPtr)
+}
+declare 35 generic {
+ Tcl_Obj * TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, \
+ int leaveErrorMsg)
+}
+declare 36 generic {
+ int TclGetLong(Tcl_Interp *interp, char *str, long *longPtr)
+}
+declare 37 generic {
+ int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
+}
+declare 38 generic {
+ int TclGetNamespaceForQualName(Tcl_Interp *interp, char *qualName, \
+ Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, \
+ Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, \
+ char **simpleNamePtr)
+}
+declare 39 generic {
+ TclObjCmdProcType TclGetObjInterpProc(void)
+}
+declare 40 generic {
+ int TclGetOpenMode(Tcl_Interp *interp, char *str, int *seekFlagPtr)
+}
+declare 41 generic {
+ Tcl_Command TclGetOriginalCommand(Tcl_Command command)
+}
+declare 42 generic {
+ char * TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr)
+}
+declare 43 generic {
+ int TclGlobalInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
+}
+declare 44 generic {
+ int TclGuessPackageName(char *fileName, Tcl_DString *bufPtr)
+}
+declare 45 generic {
+ int TclHideUnsafeCommands(Tcl_Interp *interp)
+}
+declare 46 generic {
+ int TclInExit(void)
+}
+declare 47 generic {
+ Tcl_Obj * TclIncrElementOfIndexedArray(Tcl_Interp *interp, \
+ int localIndex, Tcl_Obj *elemPtr, long incrAmount)
+}
+declare 48 generic {
+ Tcl_Obj * TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex, \
+ long incrAmount)
+}
+declare 49 generic {
+ Tcl_Obj * TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \
+ Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
+}
+declare 50 generic {
+ void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, \
+ Namespace *nsPtr)
+}
+declare 51 generic {
+ int TclInterpInit(Tcl_Interp *interp)
+}
+declare 52 generic {
+ int TclInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
+}
+declare 53 generic {
+ int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, \
+ int argc, char **argv)
+}
+declare 54 generic {
+ int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, \
+ int objc, Tcl_Obj *CONST objv[])
+}
+declare 55 generic {
+ Proc * TclIsProc(Command *cmdPtr)
+}
+# Replaced with TclpLoadFile in 8.1:
+# declare 56 generic {
+# int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \
+# char *sym2, Tcl_PackageInitProc **proc1Ptr, \
+# Tcl_PackageInitProc **proc2Ptr)
+# }
+# Signature changed to take a length in 8.1:
+# declare 57 generic {
+# int TclLooksLikeInt(char *p)
+# }
+declare 58 generic {
+ Var * TclLookupVar(Tcl_Interp *interp, char *part1, char *part2, \
+ int flags, char *msg, int createPart1, int createPart2, \
+ Var **arrayPtrPtr)
+}
+declare 59 generic {
+ int TclpMatchFiles(Tcl_Interp *interp, char *separators, \
+ Tcl_DString *dirPtr, char *pattern, char *tail)
+}
+declare 60 generic {
+ int TclNeedSpace(char *start, char *end)
+}
+declare 61 generic {
+ Tcl_Obj * TclNewProcBodyObj(Proc *procPtr)
+}
+declare 62 generic {
+ int TclObjCommandComplete(Tcl_Obj *cmdPtr)
+}
+declare 63 generic {
+ int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, \
+ int objc, Tcl_Obj *CONST objv[])
+}
+declare 64 generic {
+ int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \
+ int flags)
+}
+declare 65 generic {
+ int TclObjInvokeGlobal(Tcl_Interp *interp, int objc, \
+ Tcl_Obj *CONST objv[], int flags)
+}
+declare 66 generic {
+ int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
+}
+declare 67 generic {
+ int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
+}
+declare 68 generic {
+ int TclpAccess(CONST char *path, int mode)
+}
+declare 69 generic {
+ char * TclpAlloc(unsigned int size)
+}
+declare 70 generic {
+ int TclpCopyFile(CONST char *source, CONST char *dest)
+}
+declare 71 generic {
+ int TclpCopyDirectory(CONST char *source, CONST char *dest, \
+ Tcl_DString *errorPtr)
+}
+declare 72 generic {
+ int TclpCreateDirectory(CONST char *path)
+}
+declare 73 generic {
+ int TclpDeleteFile(CONST char *path)
+}
+declare 74 generic {
+ void TclpFree(char *ptr)
+}
+declare 75 generic {
+ unsigned long TclpGetClicks(void)
+}
+declare 76 generic {
+ unsigned long TclpGetSeconds(void)
+}
+declare 77 generic {
+ void TclpGetTime(Tcl_Time *time)
+}
+declare 78 generic {
+ int TclpGetTimeZone(unsigned long time)
+}
+declare 79 generic {
+ int TclpListVolumes(Tcl_Interp *interp)
+}
+declare 80 generic {
+ Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, \
+ char *modeString, int permissions)
+}
+declare 81 generic {
+ char * TclpRealloc(char *ptr, unsigned int size)
+}
+declare 82 generic {
+ int TclpRemoveDirectory(CONST char *path, int recursive, \
+ Tcl_DString *errorPtr)
+}
+declare 83 generic {
+ int TclpRenameFile(CONST char *source, CONST char *dest)
+}
+# Removed in 8.1:
+# declare 84 generic {
+# int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr, \
+# ParseValue *pvPtr)
+# }
+# declare 85 generic {
+# int TclParseNestedCmd(Tcl_Interp *interp, char *str, int flags, \
+# char **termPtr, ParseValue *pvPtr)
+# }
+# declare 86 generic {
+# int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar, \
+# int flags, char **termPtr, ParseValue *pvPtr)
+# }
+# declare 87 generic {
+# void TclPlatformInit(Tcl_Interp *interp)
+# }
+declare 88 generic {
+ char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, \
+ char *name1, char *name2, int flags)
+}
+declare 89 generic {
+ int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, \
+ Tcl_Command cmd)
+}
+# Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG):
+# declare 90 generic {
+# void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+# }
+declare 91 generic {
+ void TclProcCleanupProc(Proc *procPtr)
+}
+declare 92 generic {
+ int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, \
+ Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, \
+ CONST char *procName)
+}
+declare 93 generic {
+ void TclProcDeleteProc(ClientData clientData)
+}
+declare 94 generic {
+ int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, \
+ int argc, char **argv)
+}
+declare 95 generic {
+ int TclpStat(CONST char *path, struct stat *buf)
+}
+declare 96 generic {
+ int TclRenameCommand(Tcl_Interp *interp, char *oldName, char *newName)
+}
+declare 97 generic {
+ void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr)
+}
+declare 98 generic {
+ int TclServiceIdle(void)
+}
+declare 99 generic {
+ Tcl_Obj * TclSetElementOfIndexedArray(Tcl_Interp *interp, \
+ int localIndex, Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int leaveErrorMsg)
+}
+declare 100 generic {
+ Tcl_Obj * TclSetIndexedScalar(Tcl_Interp *interp, int localIndex, \
+ Tcl_Obj *objPtr, int leaveErrorMsg)
+}
+declare 101 {unix win} {
+ char * TclSetPreInitScript(char *string)
+}
+declare 102 generic {
+ void TclSetupEnv(Tcl_Interp *interp)
+}
+declare 103 generic {
+ int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto, \
+ int *portPtr)
+}
+declare 104 {unix win} {
+ int TclSockMinimumBuffers(int sock, int size)
+}
+declare 105 generic {
+ int TclStat(CONST char *path, struct stat *buf)
+}
+declare 106 generic {
+ int TclStatDeleteProc(TclStatProc_ *proc)
+}
+declare 107 generic {
+ int TclStatInsertProc(TclStatProc_ *proc)
+}
+declare 108 generic {
+ void TclTeardownNamespace(Namespace *nsPtr)
+}
+declare 109 generic {
+ int TclUpdateReturnInfo(Interp *iPtr)
+}
+# Removed in 8.1:
+# declare 110 generic {
+# char * TclWordEnd(char *start, char *lastChar, int nested, int *semiPtr)
+# }
+
+# Procedures used in conjunction with Tcl namespaces. They are
+# defined here instead of in tcl.decls since they are not stable yet.
+
+declare 111 generic {
+ void Tcl_AddInterpResolvers(Tcl_Interp *interp, char *name, \
+ Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, \
+ Tcl_ResolveCompiledVarProc *compiledVarProc)
+}
+declare 112 generic {
+ int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \
+ Tcl_Obj *objPtr)
+}
+declare 113 generic {
+ Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, char *name, \
+ ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
+}
+declare 114 generic {
+ void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
+}
+declare 115 generic {
+ int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, char *pattern, \
+ int resetListFirst)
+}
+declare 116 generic {
+ Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, char *name, \
+ Tcl_Namespace *contextNsPtr, int flags)
+}
+declare 117 generic {
+ Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, char *name, \
+ Tcl_Namespace *contextNsPtr, int flags)
+}
+declare 118 generic {
+ int Tcl_GetInterpResolvers(Tcl_Interp *interp, char *name, \
+ Tcl_ResolverInfo *resInfo)
+}
+declare 119 generic {
+ int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr, \
+ Tcl_ResolverInfo *resInfo)
+}
+declare 120 generic {
+ Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, char *name, \
+ Tcl_Namespace *contextNsPtr, int flags)
+}
+declare 121 generic {
+ int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \
+ char *pattern)
+}
+declare 122 generic {
+ Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 123 generic {
+ void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, \
+ Tcl_Obj *objPtr)
+}
+declare 124 generic {
+ Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp)
+}
+declare 125 generic {
+ Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp)
+}
+declare 126 generic {
+ void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, \
+ Tcl_Obj *objPtr)
+}
+declare 127 generic {
+ int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \
+ char *pattern, int allowOverwrite)
+}
+declare 128 generic {
+ void Tcl_PopCallFrame(Tcl_Interp* interp)
+}
+declare 129 generic {
+ int Tcl_PushCallFrame(Tcl_Interp* interp, Tcl_CallFrame *framePtr, \
+ Tcl_Namespace *nsPtr, int isProcCallFrame)
+}
+declare 130 generic {
+ int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, char *name)
+}
+declare 131 generic {
+ void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr, \
+ Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, \
+ Tcl_ResolveCompiledVarProc *compiledVarProc)
+}
+declare 132 generic {
+ int TclpHasSockets(Tcl_Interp *interp)
+}
+declare 133 generic {
+ struct tm * TclpGetDate(TclpTime_t time, int useGMT)
+}
+declare 134 generic {
+ size_t TclpStrftime(char *s, size_t maxsize, CONST char *format, \
+ CONST struct tm *t)
+}
+declare 135 generic {
+ int TclpCheckStackSpace(void)
+}
+
+# Added in 8.1:
+
+declare 137 generic {
+ int TclpChdir(CONST char *dirName)
+}
+declare 138 generic {
+ char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr)
+}
+declare 139 generic {
+ int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \
+ char *sym2, Tcl_PackageInitProc **proc1Ptr, \
+ Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
+}
+declare 140 generic {
+ int TclLooksLikeInt(char *bytes, int length)
+}
+declare 141 generic {
+ char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
+}
+declare 142 generic {
+ int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ CompileHookProc *hookProc, ClientData clientData)
+}
+declare 143 generic {
+ int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, \
+ LiteralEntry **litPtrPtr)
+}
+declare 144 generic {
+ void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr, \
+ int index)
+}
+declare 145 generic {
+ struct AuxDataType *TclGetAuxDataType(char *typeName)
+}
+
+declare 146 generic {
+ TclHandle TclHandleCreate(VOID *ptr)
+}
+
+declare 147 generic {
+ void TclHandleFree(TclHandle handle)
+}
+
+declare 148 generic {
+ TclHandle TclHandlePreserve(TclHandle handle)
+}
+
+declare 149 generic {
+ void TclHandleRelease(TclHandle handle)
+}
+
+# Added for Tcl 8.2
+
+declare 150 generic {
+ int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
+}
+declare 151 generic {
+ void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, \
+ int *endPtr)
+}
+
+declare 152 generic {
+ void TclSetLibraryPath(Tcl_Obj *pathPtr)
+}
+declare 153 generic {
+ Tcl_Obj *TclGetLibraryPath(void)
+}
+
+# moved to tclTest.c in 8.3.2/8.4a2
+#declare 154 generic {
+# int TclTestChannelCmd(ClientData clientData,
+# Tcl_Interp *interp, int argc, char **argv)
+#}
+#declare 155 generic {
+# int TclTestChannelEventCmd(ClientData clientData, \
+# Tcl_Interp *interp, int argc, char **argv)
+#}
+
+declare 156 generic {
+ void TclRegError (Tcl_Interp *interp, char *msg, \
+ int status)
+}
+declare 157 generic {
+ Var * TclVarTraceExists (Tcl_Interp *interp, char *varName)
+}
+declare 158 generic {
+ void TclSetStartupScriptFileName(char *filename)
+}
+declare 159 generic {
+ char *TclGetStartupScriptFileName(void)
+}
+declare 160 generic {
+ int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, \
+ Tcl_DString *dirPtr, char *pattern, char *tail, GlobTypeData *types)
+}
+
+# new in 8.3.2/8.4a2
+declare 161 generic {
+ int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, \
+ Tcl_Obj *cmdObjPtr)
+}
+declare 162 generic {
+ void TclChannelEventScriptInvoker(ClientData clientData, int flags)
+}
+
+##############################################################################
+
+# Define the platform specific internal Tcl interface. These functions are
+# only available on the designated platform.
+
+interface tclIntPlat
+
+########################
+# Mac specific internals
+
+declare 0 mac {
+ VOID * TclpSysAlloc(long size, int isBin)
+}
+declare 1 mac {
+ void TclpSysFree(VOID *ptr)
+}
+declare 2 mac {
+ VOID * TclpSysRealloc(VOID *cp, unsigned int size)
+}
+declare 3 mac {
+ void TclpExit(int status)
+}
+
+# Prototypes for functions found in the tclMacUtil.c compatability library.
+
+declare 4 mac {
+ int FSpGetDefaultDir(FSSpecPtr theSpec)
+}
+declare 5 mac {
+ int FSpSetDefaultDir(FSSpecPtr theSpec)
+}
+declare 6 mac {
+ OSErr FSpFindFolder(short vRefNum, OSType folderType, \
+ Boolean createFolder, FSSpec *spec)
+}
+declare 7 mac {
+ void GetGlobalMouse(Point *mouse)
+}
+
+# The following routines are utility functions in Tcl. They are exported
+# here because they are needed in Tk. They are not officially supported,
+# however. The first set are from the MoreFiles package.
+
+declare 8 mac {
+ pascal OSErr FSpGetDirectoryID(CONST FSSpec *spec, long *theDirID, \
+ Boolean *isDirectory)
+}
+declare 9 mac {
+ pascal short FSpOpenResFileCompat(CONST FSSpec *spec, \
+ SignedByte permission)
+}
+declare 10 mac {
+ pascal void FSpCreateResFileCompat(CONST FSSpec *spec, OSType creator, \
+ OSType fileType, ScriptCode scriptTag)
+}
+
+# Like the MoreFiles routines these fix problems in the standard
+# Mac calls. These routines are from tclMacUtils.h.
+
+declare 11 mac {
+ int FSpLocationFromPath(int length, CONST char *path, FSSpecPtr theSpec)
+}
+declare 12 mac {
+ OSErr FSpPathFromLocation(FSSpecPtr theSpec, int *length, \
+ Handle *fullPath)
+}
+
+# Prototypes of Mac only internal functions.
+
+declare 13 mac {
+ void TclMacExitHandler(void)
+}
+declare 14 mac {
+ void TclMacInitExitToShell(int usePatch)
+}
+declare 15 mac {
+ OSErr TclMacInstallExitToShellPatch(ExitToShellProcPtr newProc)
+}
+declare 16 mac {
+ int TclMacOSErrorToPosixError(int error)
+}
+declare 17 mac {
+ void TclMacRemoveTimer(void *timerToken)
+}
+declare 18 mac {
+ void * TclMacStartTimer(long ms)
+}
+declare 19 mac {
+ int TclMacTimerExpired(void *timerToken)
+}
+declare 20 mac {
+ int TclMacRegisterResourceFork(short fileRef, Tcl_Obj *tokenPtr, \
+ int insert)
+}
+declare 21 mac {
+ short TclMacUnRegisterResourceFork(char *tokenPtr, Tcl_Obj *resultPtr)
+}
+declare 22 mac {
+ int TclMacCreateEnv(void)
+}
+declare 23 mac {
+ FILE * TclMacFOpenHack(CONST char *path, CONST char *mode)
+}
+# Replaced in 8.1 by TclpReadLink:
+# declare 24 mac {
+# int TclMacReadlink(char *path, char *buf, int size)
+# }
+declare 25 mac {
+ int TclMacChmod(char *path, int mode)
+}
+
+############################
+# Windows specific internals
+
+declare 0 win {
+ void TclWinConvertError(DWORD errCode)
+}
+declare 1 win {
+ void TclWinConvertWSAError(DWORD errCode)
+}
+declare 2 win {
+ struct servent * TclWinGetServByName(CONST char *nm, \
+ CONST char *proto)
+}
+declare 3 win {
+ int TclWinGetSockOpt(SOCKET s, int level, int optname, \
+ char FAR * optval, int FAR *optlen)
+}
+declare 4 win {
+ HINSTANCE TclWinGetTclInstance(void)
+}
+# Removed in 8.1:
+# declare 5 win {
+# HINSTANCE TclWinLoadLibrary(char *name)
+# }
+declare 6 win {
+ u_short TclWinNToHS(u_short ns)
+}
+declare 7 win {
+ int TclWinSetSockOpt(SOCKET s, int level, int optname, \
+ CONST char FAR * optval, int optlen)
+}
+declare 8 win {
+ unsigned long TclpGetPid(Tcl_Pid pid)
+}
+declare 9 win {
+ int TclWinGetPlatformId(void)
+}
+# Removed in 8.3.1 (for Win32s only)
+#declare 10 win {
+# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
+#}
+
+# Pipe channel functions
+
+declare 11 win {
+ void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
+}
+declare 12 win {
+ int TclpCloseFile(TclFile file)
+}
+declare 13 win {
+ Tcl_Channel TclpCreateCommandChannel(TclFile readFile, \
+ TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
+}
+declare 14 win {
+ int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
+}
+declare 15 win {
+ int TclpCreateProcess(Tcl_Interp *interp, int argc, char **argv, \
+ TclFile inputFile, TclFile outputFile, TclFile errorFile, \
+ Tcl_Pid *pidPtr)
+}
+# Signature changed in 8.1:
+# declare 16 win {
+# TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
+# }
+# declare 17 win {
+# char * TclpGetTZName(void)
+# }
+declare 18 win {
+ TclFile TclpMakeFile(Tcl_Channel channel, int direction)
+}
+declare 19 win {
+ TclFile TclpOpenFile(CONST char *fname, int mode)
+}
+declare 20 win {
+ void TclWinAddProcess(HANDLE hProcess, DWORD id)
+}
+declare 21 win {
+ void TclpAsyncMark(Tcl_AsyncHandler async)
+}
+
+# Added in 8.1:
+declare 22 win {
+ TclFile TclpCreateTempFile(CONST char *contents)
+}
+declare 23 win {
+ char * TclpGetTZName(int isdst)
+}
+declare 24 win {
+ char * TclWinNoBackslash(char *path)
+}
+declare 25 win {
+ TclPlatformType *TclWinGetPlatform(void)
+}
+declare 26 win {
+ void TclWinSetInterfaces(int wide)
+}
+
+#########################
+# Unix specific internals
+
+# Pipe channel functions
+
+declare 0 unix {
+ void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
+}
+declare 1 unix {
+ int TclpCloseFile(TclFile file)
+}
+declare 2 unix {
+ Tcl_Channel TclpCreateCommandChannel(TclFile readFile, \
+ TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
+}
+declare 3 unix {
+ int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
+}
+declare 4 unix {
+ int TclpCreateProcess(Tcl_Interp *interp, int argc, char **argv, \
+ TclFile inputFile, TclFile outputFile, TclFile errorFile, \
+ Tcl_Pid *pidPtr)
+}
+# Signature changed in 8.1:
+# declare 5 unix {
+# TclFile TclpCreateTempFile(char *contents,
+# Tcl_DString *namePtr)
+# }
+declare 6 unix {
+ TclFile TclpMakeFile(Tcl_Channel channel, int direction)
+}
+declare 7 unix {
+ TclFile TclpOpenFile(CONST char *fname, int mode)
+}
+declare 8 unix {
+ int TclUnixWaitForFile(int fd, int mask, int timeout)
+}
+
+# Added in 8.1:
+
+declare 9 unix {
+ TclFile TclpCreateTempFile(CONST char *contents)
+}
+
diff --git a/tcl/generic/tclInt.h b/tcl/generic/tclInt.h
index d4b43489fe4..641e9d665a9 100644
--- a/tcl/generic/tclInt.h
+++ b/tcl/generic/tclInt.h
@@ -4,9 +4,9 @@
* Declarations of things used internally by the Tcl interpreter.
*
* Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1993-1997 Lucent Technologies.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -22,7 +22,7 @@
* included here, so that system-dependent personalizations for the
* include files only have to be made in once place. This results
* in a few extra includes, but greater modularity. The order of
- * the three groups of #includes is important. For example, stdio.h
+ * the three groups of #includes is important. For example, stdio.h
* is needed by tcl.h, and the _ANSI_ARGS_ declaration in tcl.h is
* needed by stdlib.h in some configurations.
*/
@@ -32,9 +32,6 @@
#ifndef _TCL
#include "tcl.h"
#endif
-#ifndef _REGEXP
-#include "tclRegexp.h"
-#endif
#include <ctype.h>
#ifdef NO_LIMITS_H
@@ -52,15 +49,16 @@
#else
#include <string.h>
#endif
-#if defined(__STDC__) || defined(HAS_STDARG)
-# include <stdarg.h>
-#else
-# include <varargs.h>
-#endif
+#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
-# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
+#else
+# ifdef USE_TCL_STUBS
+# define TCL_STORAGE_CLASS
+# else
+# define TCL_STORAGE_CLASS DLLIMPORT
+# endif
#endif
/*
@@ -100,18 +98,18 @@ typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
int flags, Tcl_Var *rPtr));
typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp,
- char* name, Tcl_Namespace *context, int flags,
- Tcl_Command *rPtr));
+ char* name, Tcl_Namespace *context, int flags,
+ Tcl_Command *rPtr));
typedef struct Tcl_ResolverInfo {
Tcl_ResolveCmdProc *cmdResProc; /* Procedure handling command name
- * resolution. */
+ * resolution. */
Tcl_ResolveVarProc *varResProc; /* Procedure handling variable name
- * resolution for variables that
- * can only be handled at runtime. */
+ * resolution for variables that
+ * can only be handled at runtime. */
Tcl_ResolveCompiledVarProc *compiledVarResProc;
- /* Procedure handling variable name
- * resolution at compile time. */
+ /* Procedure handling variable name
+ * resolution at compile time. */
} Tcl_ResolverInfo;
/*
@@ -143,7 +141,7 @@ typedef struct Namespace {
* this one. NULL if this is the global
* namespace. */
Tcl_HashTable childTable; /* Contains any child namespaces. Indexed
- * by strings; values have type
+ * by strings; values have type
* (Namespace *). */
long nsId; /* Unique id for the namespace. */
Tcl_Interp *interp; /* The interpreter containing this
@@ -160,8 +158,8 @@ typedef struct Namespace {
* objects. The namespace can't be freed
* until refCount becomes zero. */
Tcl_HashTable cmdTable; /* Contains all the commands currently
- * registered in the namespace. Indexed by
- * strings; values have type (Command *).
+ * registered in the namespace. Indexed by
+ * strings; values have type (Command *).
* Commands imported by Tcl_Import have
* Command structures that point (via an
* ImportedCmdRef structure) to the
@@ -169,7 +167,7 @@ typedef struct Namespace {
* namespace's command table. */
Tcl_HashTable varTable; /* Contains all the (global) variables
* currently in this namespace. Indexed
- * by strings; values have type (Var *). */
+ * by strings; values have type (Var *). */
char **exportArrayPtr; /* Points to an array of string patterns
* specifying which commands are exported.
* A pattern may include "string match"
@@ -232,8 +230,8 @@ typedef struct Namespace {
* namespace's storage will be freed.
*/
-#define NS_DYING 0x01
-#define NS_DEAD 0x02
+#define NS_DYING 0x01
+#define NS_DEAD 0x02
/*
* Flag passed to TclGetNamespaceForQualName to have it create all namespace
@@ -265,8 +263,8 @@ typedef struct VarTrace {
ClientData clientData; /* Argument to pass to proc. */
int flags; /* What events the trace procedure is
* interested in: OR-ed combination of
- * TCL_TRACE_READS, TCL_TRACE_WRITES, and
- * TCL_TRACE_UNSETS. */
+ * TCL_TRACE_READS, TCL_TRACE_WRITES,
+ * TCL_TRACE_UNSETS and TCL_TRACE_ARRAY. */
struct VarTrace *nextPtr; /* Next in list of traces associated with
* a particular variable. */
} VarTrace;
@@ -274,7 +272,7 @@ typedef struct VarTrace {
/*
* When a variable trace is active (i.e. its associated procedure is
* executing), one of the following structures is linked into a list
- * associated with the variable's interpreter. The information in
+ * associated with the variable's interpreter. The information in
* the structure is needed in order for Tcl to behave reasonably
* if traces are deleted while traces are active.
*/
@@ -306,9 +304,9 @@ typedef struct ArraySearch {
Tcl_HashSearch search; /* Info kept by the hash module about
* progress through the array. */
Tcl_HashEntry *nextEntry; /* Non-null means this is the next element
- * to be enumerated (it's leftover from
+ * to be enumerated (it's leftover from
* the Tcl_FirstHashEntry call or from
- * an "array anymore" command). NULL
+ * an "array anymore" command). NULL
* means must call Tcl_NextHashEntry
* to get value to return. */
struct ArraySearch *nextPtr;/* Next in list of all active searches
@@ -386,7 +384,7 @@ typedef struct Var {
* than a scalar variable or link. The
* "tablePtr" field points to the array's
* hashtable for its elements.
- * VAR_LINK - 1 means this Var structure contains a
+ * VAR_LINK - 1 means this Var structure contains a
* pointer to another Var structure that
* either has the real value or is itself
* another VAR_LINK pointer. Variables like
@@ -437,7 +435,7 @@ typedef struct Var {
#define VAR_SCALAR 0x1
#define VAR_ARRAY 0x2
#define VAR_LINK 0x4
-#define VAR_UNDEFINED 0x8
+#define VAR_UNDEFINED 0x8
#define VAR_IN_HASHTABLE 0x10
#define VAR_TRACE_ACTIVE 0x20
#define VAR_ARRAY_ELEMENT 0x40
@@ -609,7 +607,7 @@ typedef struct Proc {
} Proc;
/*
- * The structure below defines a command trace. This is used to allow Tcl
+ * The structure below defines a command trace. This is used to allow Tcl
* clients to find out whenever a command is about to be executed.
*/
@@ -631,7 +629,7 @@ typedef struct Trace {
typedef struct AssocData {
Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */
ClientData clientData; /* Value to pass to proc. */
-} AssocData;
+} AssocData;
/*
* The structure below defines a call frame. A call frame defines a naming
@@ -695,7 +693,22 @@ typedef struct CallFrame {
/*
*----------------------------------------------------------------
- * Data structures related to history. These are used primarily
+ * Data structures and procedures related to TclHandles, which
+ * are a very lightweight method of preserving enough information
+ * to determine if an arbitrary malloc'd block has been deleted.
+ *----------------------------------------------------------------
+ */
+
+typedef VOID **TclHandle;
+
+EXTERN TclHandle TclHandleCreate _ANSI_ARGS_((VOID *ptr));
+EXTERN void TclHandleFree _ANSI_ARGS_((TclHandle handle));
+EXTERN TclHandle TclHandlePreserve _ANSI_ARGS_((TclHandle handle));
+EXTERN void TclHandleRelease _ANSI_ARGS_((TclHandle handle));
+
+/*
+ *----------------------------------------------------------------
+ * Data structures related to history. These are used primarily
* in tclHistory.c
*----------------------------------------------------------------
*/
@@ -763,6 +776,21 @@ typedef struct MathFunc {
} MathFunc;
/*
+ * These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet
+ * when threads are used, or an emulation if there are no threads. These
+ * are really internal and Tcl clients should use Tcl_GetThreadData.
+ */
+
+EXTERN VOID *TclThreadDataKeyGet _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr));
+EXTERN void TclThreadDataKeySet _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr, VOID *data));
+
+/*
+ * This is a convenience macro used to initialize a thread local storage ptr.
+ */
+#define TCL_TSD_INIT(keyPtr) (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
+
+
+/*
*----------------------------------------------------------------
* Data structures related to bytecode compilation and execution.
* These are used primarily in tclCompile.c, tclExecute.c, and
@@ -771,9 +799,9 @@ typedef struct MathFunc {
*/
/*
- * Forward declaration to prevent an error when the forward reference to
- * CompileEnv is encountered in the procedure type CompileProc declared
- * below.
+ * Forward declaration to prevent errors when the forward references to
+ * Tcl_Parse and CompileEnv are encountered in the procedure type
+ * CompileProc declared below.
*/
struct CompileEnv;
@@ -797,8 +825,16 @@ struct CompileEnv;
#define TCL_OUT_LINE_COMPILE (TCL_CONTINUE + 1)
-typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp, char *string,
- char *lastChar, int compileFlags, struct CompileEnv *compEnvPtr));
+typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr));
+
+/*
+ * The type of procedure called from the compilation hook point in
+ * SetByteCodeFromAny.
+ */
+
+typedef int (CompileHookProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ struct CompileEnv *compEnvPtr, ClientData clientData));
/*
* The data structure defining the execution environment for ByteCode's.
@@ -810,14 +846,8 @@ typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp, char *string,
* returns.
*/
-typedef union StackItem {
- Tcl_Obj *o; /* Stack item as a pointer to a Tcl_Obj. */
- int i; /* Stack item as an integer. */
- VOID *p; /* Stack item as an arbitrary pointer. */
-} StackItem;
-
typedef struct ExecEnv {
- StackItem *stackPtr; /* Points to the first item in the
+ Tcl_Obj **stackPtr; /* Points to the first item in the
* evaluation stack on the heap. */
int stackTop; /* Index of current top of stack; -1 when
* the stack is empty. */
@@ -825,6 +855,93 @@ typedef struct ExecEnv {
} ExecEnv;
/*
+ * The definitions for the LiteralTable and LiteralEntry structures. Each
+ * interpreter contains a LiteralTable. It is used to reduce the storage
+ * needed for all the Tcl objects that hold the literals of scripts compiled
+ * by the interpreter. A literal's object is shared by all the ByteCodes
+ * that refer to the literal. Each distinct literal has one LiteralEntry
+ * entry in the LiteralTable. A literal table is a specialized hash table
+ * that is indexed by the literal's string representation, which may contain
+ * null characters.
+ *
+ * Note that we reduce the space needed for literals by sharing literal
+ * objects both within a ByteCode (each ByteCode contains a local
+ * LiteralTable) and across all an interpreter's ByteCodes (with the
+ * interpreter's global LiteralTable).
+ */
+
+typedef struct LiteralEntry {
+ struct LiteralEntry *nextPtr; /* Points to next entry in this
+ * hash bucket or NULL if end of
+ * chain. */
+ Tcl_Obj *objPtr; /* Points to Tcl object that
+ * holds the literal's bytes and
+ * length. */
+ int refCount; /* If in an interpreter's global
+ * literal table, the number of
+ * ByteCode structures that share
+ * the literal object; the literal
+ * entry can be freed when refCount
+ * drops to 0. If in a local literal
+ * table, -1. */
+} LiteralEntry;
+
+typedef struct LiteralTable {
+ LiteralEntry **buckets; /* Pointer to bucket array. Each
+ * element points to first entry in
+ * bucket's hash chain, or NULL. */
+ LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
+ /* Bucket array used for small
+ * tables to avoid mallocs and
+ * frees. */
+ int numBuckets; /* Total number of buckets allocated
+ * at **buckets. */
+ int numEntries; /* Total number of entries present
+ * in table. */
+ int rebuildSize; /* Enlarge table when numEntries
+ * gets to be this large. */
+ int mask; /* Mask value used in hashing
+ * function. */
+} LiteralTable;
+
+/*
+ * The following structure defines for each Tcl interpreter various
+ * statistics-related information about the bytecode compiler and
+ * interpreter's operation in that interpreter.
+ */
+
+#ifdef TCL_COMPILE_STATS
+typedef struct ByteCodeStats {
+ long numExecutions; /* Number of ByteCodes executed. */
+ long numCompilations; /* Number of ByteCodes created. */
+ long numByteCodesFreed; /* Number of ByteCodes destroyed. */
+ long instructionCount[256]; /* Number of times each instruction was
+ * executed. */
+
+ double totalSrcBytes; /* Total source bytes ever compiled. */
+ double totalByteCodeBytes; /* Total bytes for all ByteCodes. */
+ double currentSrcBytes; /* Src bytes for all current ByteCodes. */
+ double currentByteCodeBytes; /* Code bytes in all current ByteCodes. */
+
+ long srcCount[32]; /* Source size distribution: # of srcs of
+ * size [2**(n-1)..2**n), n in [0..32). */
+ long byteCodeCount[32]; /* ByteCode size distribution. */
+ long lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */
+
+ double currentInstBytes; /* Instruction bytes-current ByteCodes. */
+ double currentLitBytes; /* Current literal bytes. */
+ double currentExceptBytes; /* Current exception table bytes. */
+ double currentAuxBytes; /* Current auxiliary information bytes. */
+ double currentCmdMapBytes; /* Current src<->code map bytes. */
+
+ long numLiteralsCreated; /* Total literal objects ever compiled. */
+ double totalLitStringBytes; /* Total string bytes in all literals. */
+ double currentLitStringBytes; /* String bytes in current literals. */
+ long literalCount[32]; /* Distribution of literal string sizes. */
+} ByteCodeStats;
+#endif /* TCL_COMPILE_STATS */
+
+/*
*----------------------------------------------------------------
* Data structures related to commands.
*----------------------------------------------------------------
@@ -840,7 +957,7 @@ typedef struct ExecEnv {
typedef struct ImportRef {
struct Command *importedCmdPtr;
- /* Points to the imported command created in
+ /* Points to the imported command created in
* an importing namespace; this command
* redirects its invocations to the "real"
* command. */
@@ -859,7 +976,7 @@ typedef struct ImportRef {
typedef struct ImportedCmdData {
struct Command *realCmdPtr; /* "Real" command that this imported command
- * refers to. */
+ * refers to. */
struct Command *selfPtr; /* Pointer to this imported command. Needed
* only when deleting it in order to remove
* it from the real command's linked list of
@@ -891,9 +1008,9 @@ typedef struct Command {
* structure can be freed when refCount
* becomes zero. */
int cmdEpoch; /* Incremented to invalidate any references
- * that point to this command when it is
+ * that point to this command when it is
* renamed, deleted, hidden, or exposed. */
- CompileProc *compileProc; /* Procedure called to compile command. NULL
+ CompileProc *compileProc; /* Procedure called to compile command. NULL
* if no compile proc exists for command. */
Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */
ClientData objClientData; /* Arbitrary value passed to object proc. */
@@ -962,7 +1079,7 @@ typedef struct Interp {
/*
* Note: the first three fields must match exactly the fields in
- * a Tcl_Interp struct (see tcl.h). If you change one, be sure to
+ * a Tcl_Interp struct (see tcl.h). If you change one, be sure to
* change the other.
*
* The interpreter's result is held in both the string and the
@@ -976,28 +1093,45 @@ typedef struct Interp {
* and Tcl_GetStringResult. See the SetResult man page for details.
*/
- char *result; /* If the last command returned a string
+ char *result; /* If the last command returned a string
* result, this points to it. Should not be
* accessed directly; see comment above. */
- Tcl_FreeProc *freeProc; /* Zero means a string result is statically
- * allocated. TCL_DYNAMIC means string
- * result was allocated with ckalloc and
- * should be freed with ckfree. Other values
- * give address of procedure to invoke to
- * free the string result. Tcl_Eval must
- * free it before executing next command. */
+ Tcl_FreeProc *freeProc; /* Zero means a string result is statically
+ * allocated. TCL_DYNAMIC means string
+ * result was allocated with ckalloc and
+ * should be freed with ckfree. Other values
+ * give address of procedure to invoke to
+ * free the string result. Tcl_Eval must
+ * free it before executing next command. */
int errorLine; /* When TCL_ERROR is returned, this gives
* the line number in the command where the
* error occurred (1 means first line). */
- Tcl_Obj *objResultPtr; /* If the last command returned an object
- * result, this points to it. Should not be
- * accessed directly; see comment above. */
- Namespace *globalNsPtr; /* The interpreter's global namespace. */
+ struct TclStubs *stubTable;
+ /* Pointer to the exported Tcl stub table.
+ * On previous versions of Tcl this is a
+ * pointer to the objResultPtr or a pointer
+ * to a buckets array in a hash table. We
+ * therefore have to do some careful checking
+ * before we can use this. */
+
+ TclHandle handle; /* Handle used to keep track of when this
+ * interp is deleted. */
+
+ Namespace *globalNsPtr; /* The interpreter's global namespace. */
+ Tcl_HashTable *hiddenCmdTablePtr;
+ /* Hash table used by tclBasic.c to keep
+ * track of hidden commands on a per-interp
+ * basis. */
+ ClientData interpInfo; /* Information used by tclInterp.c to keep
+ * track of master/slave interps on
+ * a per-interp basis. */
Tcl_HashTable mathFuncTable;/* Contains all the math functions currently
- * defined for the interpreter. Indexed by
+ * defined for the interpreter. Indexed by
* strings (function names); values have
* type (MathFunc *). */
+
+
/*
* Information related to procedures and variables. See tclProc.c
* and tclvar.c for usage.
@@ -1005,7 +1139,7 @@ typedef struct Interp {
int numLevels; /* Keeps track of how many nested calls to
* Tcl_Eval are in progress for this
- * interpreter. It's used to delay deletion
+ * interpreter. It's used to delay deletion
* of the table until all Tcl_Eval
* invocations are completed. */
int maxNestingDepth; /* If numLevels exceeds this value then Tcl
@@ -1031,11 +1165,11 @@ typedef struct Interp {
/*
* Information used by Tcl_AppendResult to keep track of partial
- * results. See Tcl_AppendResult code for details.
+ * results. See Tcl_AppendResult code for details.
*/
char *appendResult; /* Storage space for results generated
- * by Tcl_AppendResult. Malloc-ed. NULL
+ * by Tcl_AppendResult. Malloc-ed. NULL
* means not yet allocated. */
int appendAvl; /* Total amount of space available at
* partialResult. */
@@ -1043,23 +1177,6 @@ typedef struct Interp {
* stored at partialResult. */
/*
- * A cache of compiled regular expressions. See Tcl_RegExpCompile
- * in tclUtil.c for details.
- */
-
-#define NUM_REGEXPS 5
- char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled
- * regular expression patterns. NULL
- * means that this slot isn't used.
- * Malloc-ed. */
- int patLengths[NUM_REGEXPS];/* Number of non-null characters in
- * corresponding entry in patterns.
- * -1 means entry isn't used. */
- regexp *regexps[NUM_REGEXPS];
- /* Compiled forms of above strings. Also
- * malloc-ed, or NULL if not in use yet. */
-
- /*
* Information about packages. Used only in tclPkg.c.
*/
@@ -1084,6 +1201,12 @@ typedef struct Interp {
* values. */
int termOffset; /* Offset of character just after last one
* compiled or executed by Tcl_EvalObj. */
+ LiteralTable literalTable; /* Contains LiteralEntry's describing all
+ * Tcl objects holding literals of scripts
+ * compiled by the interpreter. Indexed by
+ * the string representations of literals.
+ * Used to avoid creating duplicate
+ * objects. */
int compileEpoch; /* Holds the current "compilation epoch"
* for this interpreter. This is
* incremented to invalidate existing
@@ -1098,7 +1221,7 @@ typedef struct Interp {
/* Linked list of name resolution schemes
* added to this interpreter. Schemes
* are added/removed by calling
- * Tcl_AddInterpResolver and
+ * Tcl_AddInterpResolvers and
* Tcl_RemoveInterpResolver. */
char *scriptFile; /* NULL means there is no nested source
* command active; otherwise this points to
@@ -1109,10 +1232,10 @@ typedef struct Interp {
long randSeed; /* Seed used for rand() function. */
Trace *tracePtr; /* List of traces for this interpreter. */
Tcl_HashTable *assocData; /* Hash table for associating data with
- * this interpreter. Cleaned up when
- * this interpreter is deleted. */
+ * this interpreter. Cleaned up when
+ * this interpreter is deleted. */
struct ExecEnv *execEnvPtr; /* Execution environment for Tcl bytecode
- * execution. Contains a pointer to the
+ * execution. Contains a pointer to the
* Tcl evaluation stack. */
Tcl_Obj *emptyObjPtr; /* Points to an object holding an empty
* string. Returned by Tcl_ObjSetVar2 when
@@ -1120,6 +1243,20 @@ typedef struct Interp {
* gross way. */
char resultSpace[TCL_RESULT_SIZE+1];
/* Static space holding small results. */
+ Tcl_Obj *objResultPtr; /* If the last command returned an object
+ * result, this points to it. Should not be
+ * accessed directly; see comment above. */
+ Tcl_ThreadId threadId; /* ID of thread that owns the interpreter */
+
+ /*
+ * Statistical information about the bytecode compiler and interpreter's
+ * operation.
+ */
+
+#ifdef TCL_COMPILE_STATS
+ ByteCodeStats stats; /* Holds compilation and execution
+ * statistics for this interpreter. */
+#endif /* TCL_COMPILE_STATS */
} Interp;
/*
@@ -1128,7 +1265,7 @@ typedef struct Interp {
* TCL_BRACKET_TERM 1 means that the current script is terminated by
* a close bracket rather than the end of the string.
* TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with
- * a code other than TCL_OK or TCL_ERROR; 0 means
+ * a code other than TCL_OK or TCL_ERROR; 0 means
* codes other than these should be turned into errors.
*/
@@ -1151,7 +1288,7 @@ typedef struct Interp {
* "error message log" command).
* ERROR_CODE_SET: Non-zero means that Tcl_SetErrorCode has been
* called to record information for the current
- * error. Zero means Tcl_Eval must clear the
+ * error. Zero means Tcl_Eval must clear the
* errorCode variable if an error is returned.
* EXPR_INITIALIZED: Non-zero means initialization specific to
* expressions has been carried out.
@@ -1160,21 +1297,26 @@ typedef struct Interp {
* sequence of instructions. This is set 1, for
* example, when command traces are requested.
* RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the
- * interp has not be initialized. This is set 1
+ * interp has not be initialized. This is set 1
* when we first use the rand() or srand() functions.
- * SAFE_INTERP: Non zero means that the current interp is a
- * safe interp (ie it has only the safe commands
- * installed, less priviledge than a regular interp).
- */
-
-#define DELETED 1
-#define ERR_IN_PROGRESS 2
-#define ERR_ALREADY_LOGGED 4
-#define ERROR_CODE_SET 8
-#define EXPR_INITIALIZED 0x10
-#define DONT_COMPILE_CMDS_INLINE 0x20
-#define RAND_SEED_INITIALIZED 0x40
-#define SAFE_INTERP 0x80
+ * SAFE_INTERP: Non zero means that the current interp is a
+ * safe interp (ie it has only the safe commands
+ * installed, less priviledge than a regular interp).
+ * USE_EVAL_DIRECT: Non-zero means don't use the compiler or byte-code
+ * interpreter; instead, have Tcl_EvalObj call
+ * Tcl_EvalEx. Used primarily for testing the
+ * new parser.
+ */
+
+#define DELETED 1
+#define ERR_IN_PROGRESS 2
+#define ERR_ALREADY_LOGGED 4
+#define ERROR_CODE_SET 8
+#define EXPR_INITIALIZED 0x10
+#define DONT_COMPILE_CMDS_INLINE 0x20
+#define RAND_SEED_INITIALIZED 0x40
+#define SAFE_INTERP 0x80
+#define USE_EVAL_DIRECT 0x100
/*
*----------------------------------------------------------------
@@ -1206,48 +1348,6 @@ typedef struct ParseValue {
* expandProc. */
} ParseValue;
-/*
- * A table used to classify input characters to assist in parsing
- * Tcl commands. The table should be indexed with a signed character
- * using the CHAR_TYPE macro. The character may have a negative
- * value. The CHAR_TYPE macro takes a pointer to a signed character
- * and a pointer to the last character in the source string. If the
- * src pointer is pointing at the terminating null of the string,
- * CHAR_TYPE returns TCL_COMMAND_END.
- */
-
-extern unsigned char tclTypeTable[];
-#define CHAR_TYPE(src,last) \
- (((src)==(last))?TCL_COMMAND_END:(tclTypeTable)[(int)(*(src) + 128)])
-
-/*
- * Possible values returned by CHAR_TYPE. Note that except for TCL_DOLLAR,
- * these are all one byte values with a single bit set 1. This means these
- * values may be bit-or'ed together (except for TCL_DOLLAR) to quickly test
- * whether a character is one of several different kinds of characters.
- *
- * TCL_NORMAL - All characters that don't have special significance
- * to the Tcl language.
- * TCL_SPACE - Character is space, tab, or return.
- * TCL_COMMAND_END - Character is newline or semicolon or close-bracket
- * or terminating null.
- * TCL_QUOTE - Character is a double-quote.
- * TCL_OPEN_BRACKET - Character is a "[".
- * TCL_OPEN_BRACE - Character is a "{".
- * TCL_CLOSE_BRACE - Character is a "}".
- * TCL_BACKSLASH - Character is a "\".
- * TCL_DOLLAR - Character is a "$".
- */
-
-#define TCL_NORMAL 0x01
-#define TCL_SPACE 0x02
-#define TCL_COMMAND_END 0x04
-#define TCL_QUOTE 0x08
-#define TCL_OPEN_BRACKET 0x10
-#define TCL_OPEN_BRACE 0x20
-#define TCL_CLOSE_BRACE 0x40
-#define TCL_BACKSLASH 0x80
-#define TCL_DOLLAR 0x00
/*
* Maximum number of levels of nesting permitted in Tcl commands (used
@@ -1299,10 +1399,15 @@ typedef enum {
* Only has an effect if invoking an exposed
* command, i.e. if TCL_INVOKE_HIDDEN is not
* also set.
+ * TCL_INVOKE_NO_TRACEBACK Does not record traceback information if
+ * the invoked command returns an error. Used
+ * if the caller plans on recording its own
+ * traceback information.
*/
#define TCL_INVOKE_HIDDEN (1<<0)
#define TCL_INVOKE_NO_UNKNOWN (1<<1)
+#define TCL_INVOKE_NO_TRACEBACK (1<<2)
/*
* The structure used as the internal representation of Tcl list
@@ -1319,6 +1424,7 @@ typedef struct List {
Tcl_Obj **elements; /* Array of pointers to element objects. */
} List;
+
/*
* The following types are used for getting and storing platform-specific
* file attributes in tclFCmd.c and the various platform-versions of
@@ -1328,14 +1434,12 @@ typedef struct List {
*/
typedef int (TclGetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
- Tcl_Obj **attrObjPtrPtr));
+ int objIndex, CONST char *fileName, Tcl_Obj **attrObjPtrPtr));
typedef int (TclSetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
- Tcl_Obj *attrObjPtr));
+ int objIndex, CONST char *fileName, Tcl_Obj *attrObjPtr));
typedef struct TclFileAttrProcs {
- TclGetFileAttrProc *getProc; /* The procedure for getting attrs. */
+ TclGetFileAttrProc *getProc; /* The procedure for getting attrs. */
TclSetFileAttrProc *setProc; /* The procedure for setting attrs. */
} TclFileAttrProcs;
@@ -1353,8 +1457,7 @@ typedef struct TclFile_ *TclFile;
*----------------------------------------------------------------
*/
-typedef struct stat TclStat_;
-typedef int (TclStatProc_) _ANSI_ARGS_((CONST char *path, TclStat_ *buf));
+typedef int (TclStatProc_) _ANSI_ARGS_((CONST char *path, struct stat *buf));
typedef int (TclAccessProc_) _ANSI_ARGS_((CONST char *path, int mode));
typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp,
char *fileName, char *modeString,
@@ -1366,6 +1469,47 @@ typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
/*
+ * Opaque names for platform specific types.
+ */
+
+typedef struct TclpTime_t_ *TclpTime_t;
+
+/*
+ * The following structure is used to pass glob type data amongst
+ * the various glob routines and TclpMatchFilesTypes. Currently
+ * most of the fields are ignored. However they will be used in
+ * a future release to implement glob's ability to find files
+ * of particular types/permissions/etc only.
+ */
+typedef struct GlobTypeData {
+ /* Corresponds to bcdpfls as in 'find -t' */
+ int type;
+ /* Corresponds to file permissions */
+ int perm;
+ /* Acceptable mac type */
+ Tcl_Obj* macType;
+ /* Acceptable mac creator */
+ Tcl_Obj* macCreator;
+} GlobTypeData;
+
+/*
+ * type and permission definitions for glob command
+ */
+#define TCL_GLOB_TYPE_BLOCK (1<<0)
+#define TCL_GLOB_TYPE_CHAR (1<<1)
+#define TCL_GLOB_TYPE_DIR (1<<2)
+#define TCL_GLOB_TYPE_PIPE (1<<3)
+#define TCL_GLOB_TYPE_FILE (1<<4)
+#define TCL_GLOB_TYPE_LINK (1<<5)
+#define TCL_GLOB_TYPE_SOCK (1<<6)
+
+#define TCL_GLOB_PERM_RONLY (1<<0)
+#define TCL_GLOB_PERM_HIDDEN (1<<1)
+#define TCL_GLOB_PERM_R (1<<2)
+#define TCL_GLOB_PERM_W (1<<3)
+#define TCL_GLOB_PERM_X (1<<4)
+
+/*
*----------------------------------------------------------------
* Variables shared among Tcl modules but not used by the outside world.
*----------------------------------------------------------------
@@ -1374,17 +1518,20 @@ typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData,
extern Tcl_Time tclBlockTime;
extern int tclBlockTimeSet;
extern char * tclExecutableName;
-extern Tcl_ChannelType tclFileChannelType;
+extern char * tclNativeExecutableName;
+extern char * tclDefaultEncodingDir;
+extern Tcl_ChannelType tclFileChannelType;
extern char * tclMemDumpFileName;
extern TclPlatformType tclPlatform;
extern char * tclpFileAttrStrings[];
-extern CONST TclFileAttrProcs tclpFileAttrProcs[];
+extern CONST TclFileAttrProcs tclpFileAttrProcs[];
/*
* Variables denoting the Tcl object types defined in the core.
*/
extern Tcl_ObjType tclBooleanType;
+extern Tcl_ObjType tclByteArrayType;
extern Tcl_ObjType tclByteCodeType;
extern Tcl_ObjType tclDoubleType;
extern Tcl_ObjType tclIntType;
@@ -1400,8 +1547,8 @@ extern Tcl_ObjType tclStringType;
extern Tcl_Obj * tclFreeObjList;
#ifdef TCL_COMPILE_STATS
-extern long tclObjsAlloced;
-extern long tclObjsFreed;
+extern long tclObjsAlloced;
+extern long tclObjsFreed;
#endif /* TCL_COMPILE_STATS */
/*
@@ -1419,20 +1566,19 @@ extern char * tclEmptyStringRep;
*----------------------------------------------------------------
*/
-EXTERN void panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
EXTERN int TclAccess _ANSI_ARGS_((CONST char *path,
int mode));
EXTERN int TclAccessDeleteProc _ANSI_ARGS_((TclAccessProc_ *proc));
EXTERN int TclAccessInsertProc _ANSI_ARGS_((TclAccessProc_ *proc));
EXTERN void TclAllocateFreeObjects _ANSI_ARGS_((void));
-EXTERN int TclChdir _ANSI_ARGS_((Tcl_Interp *interp,
- char *dirName));
+EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
+EXTERN int TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
+ char *value));
EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
- int numPids, Tcl_Pid *pidPtr,
+ int numPids, Tcl_Pid *pidPtr,
Tcl_Channel errorChan));
EXTERN void TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr));
-EXTERN int TclCopyAndCollapse _ANSI_ARGS_((int count,
- char *src, char *dst));
EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Channel inChan, Tcl_Channel outChan,
int toRead, Tcl_Obj *cmdPtr));
@@ -1448,48 +1594,50 @@ EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr,
Proc **procPtrPtr));
EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_((
- Interp *iPtr, CallFrame *framePtr));
+ Interp *iPtr, CallFrame *framePtr));
EXTERN void TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
Tcl_HashTable *tablePtr));
EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp *interp,
char *separators, Tcl_DString *headPtr,
- char *tail));
+ char *tail, GlobTypeData *types));
EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
-EXTERN void TclExpandParseValue _ANSI_ARGS_((ParseValue *pvPtr,
- int needed));
+EXTERN void TclExpandTokenArray _ANSI_ARGS_((
+ Tcl_Parse *parsePtr));
EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
double value));
EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv)) ;
-EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv));
EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv)) ;
EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv)) ;
+EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeCompExecEnv _ANSI_ARGS_((void));
+EXTERN void TclFinalizeCompilation _ANSI_ARGS_((void));
+EXTERN void TclFinalizeEncodingSubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeEnvironment _ANSI_ARGS_((void));
-EXTERN void TclFinalizeExecEnv _ANSI_ARGS_((void));
-EXTERN int TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
- char *list, int listLength, char **elementPtr,
- char **nextPtr, int *sizePtr, int *bracePtr));
+EXTERN void TclFinalizeExecution _ANSI_ARGS_((void));
+EXTERN void TclFinalizeIOSubsystem _ANSI_ARGS_((void));
+EXTERN void TclFinalizeLoad _ANSI_ARGS_((void));
+EXTERN void TclFinalizeMemorySubsystem _ANSI_ARGS_((void));
+EXTERN void TclFinalizeNotifier _ANSI_ARGS_((void));
+EXTERN void TclFinalizeSynchronization _ANSI_ARGS_((void));
+EXTERN void TclFinalizeThreadData _ANSI_ARGS_((void));
+EXTERN void TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp *iPtr,
char *procName));
EXTERN int TclFormatInt _ANSI_ARGS_((char *buffer, long n));
EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp *iPtr));
-EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel chan));
-EXTERN char * TclGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int TclGetDate _ANSI_ARGS_((char *p,
unsigned long now, long zone,
unsigned long *timePtr));
-EXTERN Tcl_Channel TclGetDefaultStdChannel _ANSI_ARGS_((int type));
EXTERN Tcl_Obj * TclGetElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
+ Tcl_Interp *interp, int localIndex,
Tcl_Obj *elemPtr, int leaveErrorMsg));
-EXTERN char * TclGetEnv _ANSI_ARGS_((CONST char *name));
EXTERN char * TclGetExtension _ANSI_ARGS_((char *name));
EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
char *string, CallFrame **framePtrPtr));
@@ -1510,157 +1658,158 @@ EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
char **simpleNamePtr));
EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *seekFlagPtr));
+ char *string, int *seekFlagPtr));
EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
Tcl_Command command));
-EXTERN char * TclGetUserHome _ANSI_ARGS_((char *name,
- Tcl_DString *bufferPtr));
+EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
+ char *pattern, char *unquotedPrefix,
+ int globFlags, GlobTypeData* types));
EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, int flags));
+ int argc, char **argv, int flags));
EXTERN int TclGuessPackageName _ANSI_ARGS_((char *fileName,
Tcl_DString *bufPtr));
-EXTERN int TclHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int TclHideUnsafeCommands _ANSI_ARGS_((
- Tcl_Interp *interp));
+ Tcl_Interp *interp));
EXTERN int TclInExit _ANSI_ARGS_((void));
EXTERN Tcl_Obj * TclIncrElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
+ Tcl_Interp *interp, int localIndex,
Tcl_Obj *elemPtr, long incrAmount));
EXTERN Tcl_Obj * TclIncrIndexedScalar _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
+ Tcl_Interp *interp, int localIndex,
long incrAmount));
EXTERN Tcl_Obj * TclIncrVar2 _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
- long incrAmount, int part1NotParsed));
+ long incrAmount, int flags));
+EXTERN void TclInitAlloc _ANSI_ARGS_((void));
EXTERN void TclInitCompiledLocals _ANSI_ARGS_((
Tcl_Interp *interp, CallFrame *framePtr,
Namespace *nsPtr));
-EXTERN void TclInitNamespaces _ANSI_ARGS_((void));
-EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void TclInitDbCkalloc _ANSI_ARGS_((void));
+EXTERN void TclInitEncodingSubsystem _ANSI_ARGS_((void));
+EXTERN void TclInitIOSubsystem _ANSI_ARGS_((void));
+EXTERN void TclInitNamespaceSubsystem _ANSI_ARGS_((void));
+EXTERN void TclInitNotifier _ANSI_ARGS_((void));
+EXTERN void TclInitObjSubsystem _ANSI_ARGS_((void));
+EXTERN void TclInitSubsystems _ANSI_ARGS_((CONST char *argv0));
EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, int flags));
+ int argc, char **argv, int flags));
EXTERN int TclInvokeObjectCommand _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv));
+ ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv));
EXTERN int TclInvokeStringCommand _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]));
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+EXTERN int TclIsLocalScalar _ANSI_ARGS_((CONST char *src,
+ int len));
EXTERN Proc * TclIsProc _ANSI_ARGS_((Command *cmdPtr));
-EXTERN int TclLoadFile _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName, char *sym1, char *sym2,
- Tcl_PackageInitProc **proc1Ptr,
- Tcl_PackageInitProc **proc2Ptr));
-EXTERN int TclLooksLikeInt _ANSI_ARGS_((char *p));
EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
char *part1, char *part2, int flags, char *msg,
int createPart1, int createPart2,
Var **arrayPtrPtr));
-EXTERN int TclMatchFiles _ANSI_ARGS_((Tcl_Interp *interp,
- char *separators, Tcl_DString *dirPtr,
- char *pattern, char *tail));
+EXTERN int TclMathInProgress _ANSI_ARGS_((void));
EXTERN int TclNeedSpace _ANSI_ARGS_((char *start, char *end));
EXTERN Tcl_Obj * TclNewProcBodyObj _ANSI_ARGS_((Proc *procPtr));
EXTERN int TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj *cmdPtr));
EXTERN int TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
+ Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int flags));
+ int objc, Tcl_Obj *CONST objv[], int flags));
EXTERN int TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int flags));
+ int objc, Tcl_Obj *CONST objv[], int flags));
EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_((
TclOpenFileChannelProc_ *proc));
EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_((
TclOpenFileChannelProc_ *proc));
+EXTERN int TclpAccess _ANSI_ARGS_((CONST char *filename,
+ int mode));
EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size));
-
-/*
- * On a Mac, we can exit gracefully if the stack gets too small.
- */
-
-#ifdef MAC_TCL
EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void));
-#else
-#define TclpCheckStackSpace() (1)
-#endif
-
-EXTERN int TclpCloseFile _ANSI_ARGS_((TclFile file));
-EXTERN int TclpCopyFile _ANSI_ARGS_((char *source, char *dest));
-EXTERN int TclpCopyDirectory _ANSI_ARGS_((char *source,
- char *dest, Tcl_DString *errorPtr));
-EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_((
- TclFile readFile, TclFile writeFile,
- TclFile errorFile, int numPids, Tcl_Pid *pidPtr));
-EXTERN int TclpCreateDirectory _ANSI_ARGS_((char *path));
-EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe,
- TclFile *writePipe));
-EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, TclFile inputFile,
- TclFile outputFile, TclFile errorFile,
- Tcl_Pid *pidPtr));
-EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((char *contents,
- Tcl_DString *namePtr));
-EXTERN int TclpDeleteFile _ANSI_ARGS_((char *path));
-EXTERN void TclpFinalize _ANSI_ARGS_((void));
+EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char *source,
+ CONST char *dest));
+EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char *source,
+ CONST char *dest, Tcl_DString *errorPtr));
+EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char *path));
+EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path));
+EXTERN void TclpExit _ANSI_ARGS_((int status));
+EXTERN void TclpFinalizeCondition _ANSI_ARGS_((
+ Tcl_Condition *condPtr));
+EXTERN void TclpFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
+EXTERN void TclpFinalizeThreadData _ANSI_ARGS_((
+ Tcl_ThreadDataKey *keyPtr));
+EXTERN void TclpFinalizeThreadDataKey _ANSI_ARGS_((
+ Tcl_ThreadDataKey *keyPtr));
+EXTERN char * TclpFindExecutable _ANSI_ARGS_((
+ CONST char *argv0));
+EXTERN int TclpFindVariable _ANSI_ARGS_((CONST char *name,
+ int *lengthPtr));
EXTERN void TclpFree _ANSI_ARGS_((char *ptr));
EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void));
+EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void));
EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
-EXTERN char * TclpGetTZName _ANSI_ARGS_((void));
+EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char *name,
+ Tcl_DString *bufferPtr));
+EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0));
+EXTERN void TclpInitLock _ANSI_ARGS_((void));
+EXTERN void TclpInitPlatform _ANSI_ARGS_((void));
+EXTERN void TclpInitUnlock _ANSI_ARGS_((void));
EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
- int direction));
-EXTERN TclFile TclpOpenFile _ANSI_ARGS_((char *fname, int mode));
+EXTERN void TclpMasterLock _ANSI_ARGS_((void));
+EXTERN void TclpMasterUnlock _ANSI_ARGS_((void));
+EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp *interp,
+ char *separators, Tcl_DString *dirPtr,
+ char *pattern, char *tail));
EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
char *fileName, char *modeString,
int permissions));
+EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName,
+ Tcl_DString *linkPtr));
EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr,
unsigned int size));
-EXTERN int TclpRemoveDirectory _ANSI_ARGS_((char *path,
+EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file));
+EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char *path,
int recursive, Tcl_DString *errorPtr));
-EXTERN int TclpRenameFile _ANSI_ARGS_((char *source, char *dest));
-#ifndef TclpSysAlloc
-EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin));
-#endif
-#ifndef TclpSysFree
-EXTERN void TclpSysFree _ANSI_ARGS_((VOID *ptr));
-#endif
-#ifndef TclpSysRealloc
-EXTERN VOID * TclpSysRealloc _ANSI_ARGS_((VOID *cp,
+EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char *source,
+ CONST char *dest));
+EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void));
+EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin));
+EXTERN void TclpSysFree _ANSI_ARGS_((VOID *ptr));
+EXTERN VOID * TclpSysRealloc _ANSI_ARGS_((VOID *cp,
unsigned int size));
-#endif
-EXTERN int TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char **termPtr, ParseValue *pvPtr));
-EXTERN int TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int flags, char **termPtr,
- ParseValue *pvPtr));
-EXTERN int TclParseQuotes _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int termChar, int flags,
- char **termPtr, ParseValue *pvPtr));
-EXTERN void TclPlatformExit _ANSI_ARGS_((int status));
-EXTERN void TclPlatformInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void TclpUnloadFile _ANSI_ARGS_((ClientData clientData));
EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *cmdInterp, Tcl_Command cmd));
-EXTERN void TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
+ Tcl_Interp *cmdInterp, Tcl_Command cmd));
EXTERN void TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
- Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr,
- CONST char *description, CONST char *procName));
+ Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr,
+ CONST char *description, CONST char *procName));
EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN VOID * TclpThreadDataKeyGet _ANSI_ARGS_((
+ Tcl_ThreadDataKey *keyPtr));
+EXTERN void TclpThreadDataKeyInit _ANSI_ARGS_((
+ Tcl_ThreadDataKey *keyPtr));
+EXTERN void TclpThreadDataKeySet _ANSI_ARGS_((
+ Tcl_ThreadDataKey *keyPtr, VOID *data));
+EXTERN void TclpThreadExit _ANSI_ARGS_((int status));
+EXTERN void TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex));
+EXTERN void TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex));
+EXTERN void TclRememberMutex _ANSI_ARGS_((Tcl_Mutex *mutex));
EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp,
char *oldName, char *newName)) ;
EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_((
Tcl_Interp *interp, Command *newCmdPtr));
EXTERN int TclServiceIdle _ANSI_ARGS_((void));
EXTERN Tcl_Obj * TclSetElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
+ Tcl_Interp *interp, int localIndex,
Tcl_Obj *elemPtr, Tcl_Obj *objPtr,
int leaveErrorMsg));
EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
@@ -1669,22 +1818,17 @@ EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char *string));
EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *proto, int *portPtr));
+ char *string, char *proto, int *portPtr));
EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
- int size));
+ int size));
EXTERN int TclStat _ANSI_ARGS_((CONST char *path,
- TclStat_ *buf));
+ struct stat *buf));
EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ *proc));
EXTERN int TclStatInsertProc _ANSI_ARGS_((TclStatProc_ *proc));
EXTERN void TclTeardownNamespace _ANSI_ARGS_((Namespace *nsPtr));
-EXTERN int TclTestChannelCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int TclTestChannelEventCmd _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv));
+EXTERN void TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
+ int result, Tcl_Interp *targetInterp));
EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
-EXTERN char * TclWordEnd _ANSI_ARGS_((char *start, char *lastChar,
- int nested, int *semiPtr));
/*
*----------------------------------------------------------------
@@ -1700,8 +1844,8 @@ EXTERN int Tcl_ArrayObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_BinaryObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_BreakCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_BreakObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_CaseObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_CatchObjCmd _ANSI_ARGS_((ClientData clientData,
@@ -1714,34 +1858,36 @@ EXTERN int Tcl_CloseObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ConcatObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_ContinueCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_ContinueObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_EncodingObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_EofObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ErrorObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_EvalObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_ExecCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_ExecObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ExitObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ExprObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_FblockedObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_FconfigureCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_FconfigureObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_FcopyObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_FileObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_FileEventCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_FileEventObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_FlushObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_ForCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_ForObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ForeachObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_FormatObjCmd _ANSI_ARGS_((ClientData dummy,
@@ -1750,12 +1896,12 @@ EXTERN int Tcl_GetsObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_GlobalObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_GlobCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_IfCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_IncrCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_GlobObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_IfObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_IncrObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_InfoObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_InterpObjCmd _ANSI_ARGS_((ClientData clientData,
@@ -1772,8 +1918,8 @@ EXTERN int Tcl_LlengthObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ListObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_LoadCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_LoadObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LrangeObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LreplaceObjCmd _ANSI_ARGS_((ClientData clientData,
@@ -1784,66 +1930,64 @@ EXTERN int Tcl_LsortObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_OpenCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_PackageCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_PidObjCmd _ANSI_ARGS_((ClientData clientData,
+EXTERN int Tcl_OpenObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData,
+EXTERN int Tcl_PackageObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_PidObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_PutsObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_PwdCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_PwdObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ReadObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_RegexpCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_RegsubCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_RegexpObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_RegsubObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_RenameObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ReturnObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_ScanCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_SeekCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_SetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_ScanObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_SeekObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_SetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_SplitObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_SocketCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_SocketObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_SourceObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_StringObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_SubstCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_SubstObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_SwitchObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_TellCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_TellObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_TimeObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_TraceCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_TraceObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_UnsetObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_UpdateCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_UpdateObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_UplevelObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_UpvarObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_VariableObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_VwaitCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_WhileCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tcl_VwaitObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_WhileObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
/*
*----------------------------------------------------------------
@@ -1852,13 +1996,13 @@ EXTERN int Tcl_WhileCmd _ANSI_ARGS_((ClientData clientData,
*/
#ifdef MAC_TCL
-EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_LsCmd _ANSI_ARGS_((ClientData clientData,
+EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData,
+EXTERN int Tcl_LsObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_MacSourceObjCmd _ANSI_ARGS_((ClientData clientData,
+EXTERN int Tcl_MacSourceObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_ResourceObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
@@ -1871,35 +2015,25 @@ EXTERN int Tcl_ResourceObjCmd _ANSI_ARGS_((ClientData clientData,
*/
EXTERN int TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
/*
*----------------------------------------------------------------
@@ -1931,12 +2065,14 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
#ifdef TCL_MEM_DEBUG
# define TclNewObj(objPtr) \
- (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \
+ (objPtr) = (Tcl_Obj *) \
+ Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = tclEmptyStringRep; \
(objPtr)->length = 0; \
(objPtr)->typePtr = NULL; \
TclIncrObjsAllocated()
+
# define TclDbNewObj(objPtr, file, line) \
(objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
(objPtr)->refCount = 0; \
@@ -1944,24 +2080,32 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
(objPtr)->length = 0; \
(objPtr)->typePtr = NULL; \
TclIncrObjsAllocated()
+
# define TclDecrRefCount(objPtr) \
if (--(objPtr)->refCount <= 0) { \
- if ((objPtr)->refCount < -1) \
- panic("Reference count for %lx was negative: %s line %d", \
+ if ((objPtr)->refCount < -1) \
+ panic("Reference count for %lx was negative: %s line %d", \
(objPtr), __FILE__, __LINE__); \
- if (((objPtr)->bytes != NULL) \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
+ if (((objPtr)->bytes != NULL) \
+ && ((objPtr)->bytes != tclEmptyStringRep)) { \
ckfree((char *) (objPtr)->bytes); \
- } \
- if (((objPtr)->typePtr != NULL) \
- && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
+ } \
+ if (((objPtr)->typePtr != NULL) \
+ && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
(objPtr)->typePtr->freeIntRepProc(objPtr); \
- } \
- ckfree((char *) (objPtr)); \
- TclIncrObjsFreed(); \
+ } \
+ ckfree((char *) (objPtr)); \
+ TclIncrObjsFreed(); \
}
+
#else /* not TCL_MEM_DEBUG */
+
+#ifdef TCL_THREADS
+extern Tcl_Mutex tclObjMutex;
+#endif
+
# define TclNewObj(objPtr) \
+ Tcl_MutexLock(&tclObjMutex); \
if (tclFreeObjList == NULL) { \
TclAllocateFreeObjects(); \
} \
@@ -1972,20 +2116,24 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
(objPtr)->bytes = tclEmptyStringRep; \
(objPtr)->length = 0; \
(objPtr)->typePtr = NULL; \
- TclIncrObjsAllocated()
+ TclIncrObjsAllocated(); \
+ Tcl_MutexUnlock(&tclObjMutex)
+
# define TclDecrRefCount(objPtr) \
if (--(objPtr)->refCount <= 0) { \
- if (((objPtr)->bytes != NULL) \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
+ if (((objPtr)->bytes != NULL) \
+ && ((objPtr)->bytes != tclEmptyStringRep)) { \
ckfree((char *) (objPtr)->bytes); \
- } \
- if (((objPtr)->typePtr != NULL) \
- && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
+ } \
+ if (((objPtr)->typePtr != NULL) \
+ && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
(objPtr)->typePtr->freeIntRepProc(objPtr); \
- } \
- (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
- tclFreeObjList = (objPtr); \
- TclIncrObjsFreed(); \
+ } \
+ Tcl_MutexLock(&tclObjMutex); \
+ (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
+ tclFreeObjList = (objPtr); \
+ TclIncrObjsFreed(); \
+ Tcl_MutexUnlock(&tclObjMutex); \
}
#endif /* TCL_MEM_DEBUG */
@@ -2005,12 +2153,12 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
#define TclInitStringRep(objPtr, bytePtr, len) \
if ((len) == 0) { \
- (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->bytes = tclEmptyStringRep; \
(objPtr)->length = 0; \
} else { \
(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
memcpy((VOID *) (objPtr)->bytes, (VOID *) (bytePtr), \
- (unsigned) (len)); \
+ (unsigned) (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
}
@@ -2018,130 +2166,24 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to get the string representation's
- * byte array pointer and length from a Tcl_Obj. This is an inline
- * version of Tcl_GetStringFromObj(). "lengthPtr" must be the
- * address of an integer variable or NULL; If non-NULL, that variable
- * will be set to the string rep's length. The macro's expression
- * result is the string rep's byte pointer which might be NULL.
- * Note that the bytes referenced by this pointer must not be modified
- * by the caller. The ANSI C "prototype" for this macro is:
- *
- * EXTERN char * TclGetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- * int *lengthPtr));
- *----------------------------------------------------------------
- */
-
-#define TclGetStringFromObj(objPtr, lengthPtr) \
- ((objPtr)->bytes? \
- ((lengthPtr)? \
- ((*(lengthPtr) = (objPtr)->length), (objPtr)->bytes) : \
- (objPtr)->bytes) : \
- Tcl_GetStringFromObj((objPtr), (lengthPtr)))
-
-/*
- *----------------------------------------------------------------
- * Macro used by the Tcl core to reset an interpreter's Tcl object
- * result to an unshared empty string object with ref count one.
- * This does not clear any error information for the interpreter.
+ * byte array pointer from a Tcl_Obj. This is an inline version
+ * of Tcl_GetString(). The macro's expression result is the string
+ * rep's byte pointer which might be NULL. The bytes referenced by
+ * this pointer must not be modified by the caller.
* The ANSI C "prototype" for this macro is:
*
- * EXTERN void TclResetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
- *---------------------------------------------------------------
- */
-
-#define TclResetObjResult(interp) \
- { \
- register Tcl_Obj *objResultPtr = ((Interp *) interp)->objResultPtr; \
- if (Tcl_IsShared(objResultPtr)) { \
- TclDecrRefCount(objResultPtr); \
- TclNewObj(objResultPtr); \
- Tcl_IncrRefCount(objResultPtr); \
- ((Interp *) interp)->objResultPtr = objResultPtr; \
- } else { \
- if ((objResultPtr->bytes != NULL) \
- && (objResultPtr->bytes != tclEmptyStringRep)) { \
- ckfree((char *) objResultPtr->bytes); \
- } \
- objResultPtr->bytes = tclEmptyStringRep; \
- objResultPtr->length = 0; \
- if ((objResultPtr->typePtr != NULL) \
- && (objResultPtr->typePtr->freeIntRepProc != NULL)) { \
- objResultPtr->typePtr->freeIntRepProc(objResultPtr); \
- } \
- objResultPtr->typePtr = (Tcl_ObjType *) NULL; \
- } \
- }
-
-/*
- *----------------------------------------------------------------
- * Procedures used in conjunction with Tcl namespaces. They are
- * defined here instead of in tcl.h since they are not stable yet.
+ * EXTERN char * TclGetString _ANSI_ARGS_((Tcl_Obj *objPtr));
*----------------------------------------------------------------
*/
-EXTERN void Tcl_AddInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, Tcl_ResolveCmdProc *cmdProc,
- Tcl_ResolveVarProc *varProc,
- Tcl_ResolveCompiledVarProc *compiledVarProc));
-EXTERN int Tcl_AppendExportList _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Namespace *nsPtr,
- Tcl_Obj *objPtr));
-EXTERN Tcl_Namespace * Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, ClientData clientData,
- Tcl_NamespaceDeleteProc *deleteProc));
-EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_((
- Tcl_Namespace *nsPtr));
-EXTERN int Tcl_Export _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Namespace *nsPtr, char *pattern,
- int resetListFirst));
-EXTERN Tcl_Command Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, Tcl_Namespace *contextNsPtr,
- int flags));
-EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, Tcl_Namespace *contextNsPtr,
- int flags));
-EXTERN int Tcl_GetInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, Tcl_ResolverInfo *resInfo));
-EXTERN int Tcl_GetNamespaceResolvers _ANSI_ARGS_((
- Tcl_Namespace *namespacePtr,
- Tcl_ResolverInfo *resInfo));
-EXTERN void Tcl_GetVariableFullName _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Var variable,
- Tcl_Obj *objPtr));
-EXTERN Tcl_Var Tcl_FindNamespaceVar _ANSI_ARGS_((
- Tcl_Interp *interp, char *name,
- Tcl_Namespace *contextNsPtr, int flags));
-EXTERN int Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Namespace *nsPtr, char *pattern));
-EXTERN Tcl_Command Tcl_GetCommandFromObj _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *objPtr));
-EXTERN void Tcl_GetCommandFullName _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Command command,
- Tcl_Obj *objPtr));
-EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace _ANSI_ARGS_((
- Tcl_Interp *interp));
-EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_((
- Tcl_Interp *interp));
-EXTERN void Tcl_GetVariableFullName _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Var variable,
- Tcl_Obj *objPtr));
-EXTERN int Tcl_Import _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Namespace *nsPtr, char *pattern,
- int allowOverwrite));
-EXTERN void Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp* interp));
-EXTERN int Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp* interp,
- Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr,
- int isProcCallFrame));
-EXTERN int Tcl_RemoveInterpResolvers _ANSI_ARGS_((
- Tcl_Interp *interp, char *name));
-EXTERN void Tcl_SetNamespaceResolvers _ANSI_ARGS_((
- Tcl_Namespace *namespacePtr,
- Tcl_ResolveCmdProc *cmdProc,
- Tcl_ResolveVarProc *varProc,
- Tcl_ResolveCompiledVarProc *compiledVarProc));
+#define TclGetString(objPtr) \
+ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
+
+#include "tclIntDecls.h"
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLINT */
+
diff --git a/tcl/generic/tclIntDecls.h b/tcl/generic/tclIntDecls.h
new file mode 100644
index 00000000000..900fc2e9f00
--- /dev/null
+++ b/tcl/generic/tclIntDecls.h
@@ -0,0 +1,1394 @@
+/*
+ * tclIntDecls.h --
+ *
+ * This file contains the declarations for all unsupported
+ * functions that are exported by the Tcl library. These
+ * interfaces are not guaranteed to remain the same between
+ * versions. Use at your own risk.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLINTDECLS
+#define _TCLINTDECLS
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tclInt.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+EXTERN int TclAccess _ANSI_ARGS_((CONST char * path, int mode));
+/* 1 */
+EXTERN int TclAccessDeleteProc _ANSI_ARGS_((
+ TclAccessProc_ * proc));
+/* 2 */
+EXTERN int TclAccessInsertProc _ANSI_ARGS_((
+ TclAccessProc_ * proc));
+/* 3 */
+EXTERN void TclAllocateFreeObjects _ANSI_ARGS_((void));
+/* Slot 4 is reserved */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 5 */
+EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp * interp,
+ int numPids, Tcl_Pid * pidPtr,
+ Tcl_Channel errorChan));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 5 */
+EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp * interp,
+ int numPids, Tcl_Pid * pidPtr,
+ Tcl_Channel errorChan));
+#endif /* __WIN32__ */
+/* 6 */
+EXTERN void TclCleanupCommand _ANSI_ARGS_((Command * cmdPtr));
+/* 7 */
+EXTERN int TclCopyAndCollapse _ANSI_ARGS_((int count,
+ CONST char * src, char * dst));
+/* 8 */
+EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Channel inChan, Tcl_Channel outChan,
+ int toRead, Tcl_Obj * cmdPtr));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 9 */
+EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv,
+ Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr,
+ TclFile * outPipePtr, TclFile * errFilePtr));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 9 */
+EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv,
+ Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr,
+ TclFile * outPipePtr, TclFile * errFilePtr));
+#endif /* __WIN32__ */
+/* 10 */
+EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp * interp,
+ Namespace * nsPtr, char * procName,
+ Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr,
+ Proc ** procPtrPtr));
+/* 11 */
+EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_((
+ Interp * iPtr, CallFrame * framePtr));
+/* 12 */
+EXTERN void TclDeleteVars _ANSI_ARGS_((Interp * iPtr,
+ Tcl_HashTable * tablePtr));
+/* 13 */
+EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp * interp,
+ char * separators, Tcl_DString * headPtr,
+ char * tail, GlobTypeData * types));
+/* 14 */
+EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE * outFile));
+/* Slot 15 is reserved */
+/* 16 */
+EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp * interp,
+ double value));
+/* 17 */
+EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[]));
+/* 18 */
+EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv));
+/* 19 */
+EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv));
+/* 20 */
+EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv));
+/* 21 */
+EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv));
+/* 22 */
+EXTERN int TclFindElement _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * listStr, int listLength,
+ CONST char ** elementPtr,
+ CONST char ** nextPtr, int * sizePtr,
+ int * bracePtr));
+/* 23 */
+EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp * iPtr,
+ char * procName));
+/* 24 */
+EXTERN int TclFormatInt _ANSI_ARGS_((char * buffer, long n));
+/* 25 */
+EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp * iPtr));
+/* Slot 26 is reserved */
+/* 27 */
+EXTERN int TclGetDate _ANSI_ARGS_((char * p, unsigned long now,
+ long zone, unsigned long * timePtr));
+/* 28 */
+EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
+/* 29 */
+EXTERN Tcl_Obj * TclGetElementOfIndexedArray _ANSI_ARGS_((
+ Tcl_Interp * interp, int localIndex,
+ Tcl_Obj * elemPtr, int leaveErrorMsg));
+/* Slot 30 is reserved */
+/* 31 */
+EXTERN char * TclGetExtension _ANSI_ARGS_((char * name));
+/* 32 */
+EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, CallFrame ** framePtrPtr));
+/* 33 */
+EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void));
+/* 34 */
+EXTERN int TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, int endValue,
+ int * indexPtr));
+/* 35 */
+EXTERN Tcl_Obj * TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp,
+ int localIndex, int leaveErrorMsg));
+/* 36 */
+EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, long * longPtr));
+/* 37 */
+EXTERN int TclGetLoadedPackages _ANSI_ARGS_((
+ Tcl_Interp * interp, char * targetName));
+/* 38 */
+EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
+ Tcl_Interp * interp, char * qualName,
+ Namespace * cxtNsPtr, int flags,
+ Namespace ** nsPtrPtr,
+ Namespace ** altNsPtrPtr,
+ Namespace ** actualCxtPtrPtr,
+ char ** simpleNamePtr));
+/* 39 */
+EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
+/* 40 */
+EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, int * seekFlagPtr));
+/* 41 */
+EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
+ Tcl_Command command));
+/* 42 */
+EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name,
+ Tcl_DString * bufferPtr));
+/* 43 */
+EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv, int flags));
+/* 44 */
+EXTERN int TclGuessPackageName _ANSI_ARGS_((char * fileName,
+ Tcl_DString * bufPtr));
+/* 45 */
+EXTERN int TclHideUnsafeCommands _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 46 */
+EXTERN int TclInExit _ANSI_ARGS_((void));
+/* 47 */
+EXTERN Tcl_Obj * TclIncrElementOfIndexedArray _ANSI_ARGS_((
+ Tcl_Interp * interp, int localIndex,
+ Tcl_Obj * elemPtr, long incrAmount));
+/* 48 */
+EXTERN Tcl_Obj * TclIncrIndexedScalar _ANSI_ARGS_((
+ Tcl_Interp * interp, int localIndex,
+ long incrAmount));
+/* 49 */
+EXTERN Tcl_Obj * TclIncrVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr,
+ long incrAmount, int part1NotParsed));
+/* 50 */
+EXTERN void TclInitCompiledLocals _ANSI_ARGS_((
+ Tcl_Interp * interp, CallFrame * framePtr,
+ Namespace * nsPtr));
+/* 51 */
+EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp * interp));
+/* 52 */
+EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp * interp, int argc,
+ char ** argv, int flags));
+/* 53 */
+EXTERN int TclInvokeObjectCommand _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp * interp,
+ int argc, char ** argv));
+/* 54 */
+EXTERN int TclInvokeStringCommand _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[]));
+/* 55 */
+EXTERN Proc * TclIsProc _ANSI_ARGS_((Command * cmdPtr));
+/* Slot 56 is reserved */
+/* Slot 57 is reserved */
+/* 58 */
+EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp * interp,
+ char * part1, char * part2, int flags,
+ char * msg, int createPart1, int createPart2,
+ Var ** arrayPtrPtr));
+/* 59 */
+EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp * interp,
+ char * separators, Tcl_DString * dirPtr,
+ char * pattern, char * tail));
+/* 60 */
+EXTERN int TclNeedSpace _ANSI_ARGS_((char * start, char * end));
+/* 61 */
+EXTERN Tcl_Obj * TclNewProcBodyObj _ANSI_ARGS_((Proc * procPtr));
+/* 62 */
+EXTERN int TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj * cmdPtr));
+/* 63 */
+EXTERN int TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp * interp, int objc,
+ Tcl_Obj *CONST objv[]));
+/* 64 */
+EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[], int flags));
+/* 65 */
+EXTERN int TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[], int flags));
+/* 66 */
+EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_((
+ TclOpenFileChannelProc_ * proc));
+/* 67 */
+EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_((
+ TclOpenFileChannelProc_ * proc));
+/* 68 */
+EXTERN int TclpAccess _ANSI_ARGS_((CONST char * path, int mode));
+/* 69 */
+EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size));
+/* 70 */
+EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char * source,
+ CONST char * dest));
+/* 71 */
+EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char * source,
+ CONST char * dest, Tcl_DString * errorPtr));
+/* 72 */
+EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char * path));
+/* 73 */
+EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char * path));
+/* 74 */
+EXTERN void TclpFree _ANSI_ARGS_((char * ptr));
+/* 75 */
+EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void));
+/* 76 */
+EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void));
+/* 77 */
+EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time * time));
+/* 78 */
+EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
+/* 79 */
+EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp * interp));
+/* 80 */
+EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp,
+ char * fileName, char * modeString,
+ int permissions));
+/* 81 */
+EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr,
+ unsigned int size));
+/* 82 */
+EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char * path,
+ int recursive, Tcl_DString * errorPtr));
+/* 83 */
+EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char * source,
+ CONST char * dest));
+/* Slot 84 is reserved */
+/* Slot 85 is reserved */
+/* Slot 86 is reserved */
+/* Slot 87 is reserved */
+/* 88 */
+EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp * interp, char * name1,
+ char * name2, int flags));
+/* 89 */
+EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Interp * cmdInterp, Tcl_Command cmd));
+/* Slot 90 is reserved */
+/* 91 */
+EXTERN void TclProcCleanupProc _ANSI_ARGS_((Proc * procPtr));
+/* 92 */
+EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp * interp,
+ Proc * procPtr, Tcl_Obj * bodyPtr,
+ Namespace * nsPtr, CONST char * description,
+ CONST char * procName));
+/* 93 */
+EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
+/* 94 */
+EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp * interp, int argc, char ** argv));
+/* 95 */
+EXTERN int TclpStat _ANSI_ARGS_((CONST char * path,
+ struct stat * buf));
+/* 96 */
+EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp,
+ char * oldName, char * newName));
+/* 97 */
+EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_((
+ Tcl_Interp * interp, Command * newCmdPtr));
+/* 98 */
+EXTERN int TclServiceIdle _ANSI_ARGS_((void));
+/* 99 */
+EXTERN Tcl_Obj * TclSetElementOfIndexedArray _ANSI_ARGS_((
+ Tcl_Interp * interp, int localIndex,
+ Tcl_Obj * elemPtr, Tcl_Obj * objPtr,
+ int leaveErrorMsg));
+/* 100 */
+EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp,
+ int localIndex, Tcl_Obj * objPtr,
+ int leaveErrorMsg));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 101 */
+EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 101 */
+EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string));
+#endif /* __WIN32__ */
+/* 102 */
+EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp * interp));
+/* 103 */
+EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, char * proto, int * portPtr));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 104 */
+EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
+ int size));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 104 */
+EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
+ int size));
+#endif /* __WIN32__ */
+/* 105 */
+EXTERN int TclStat _ANSI_ARGS_((CONST char * path,
+ struct stat * buf));
+/* 106 */
+EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ * proc));
+/* 107 */
+EXTERN int TclStatInsertProc _ANSI_ARGS_((TclStatProc_ * proc));
+/* 108 */
+EXTERN void TclTeardownNamespace _ANSI_ARGS_((Namespace * nsPtr));
+/* 109 */
+EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp * iPtr));
+/* Slot 110 is reserved */
+/* 111 */
+EXTERN void Tcl_AddInterpResolvers _ANSI_ARGS_((
+ Tcl_Interp * interp, char * name,
+ Tcl_ResolveCmdProc * cmdProc,
+ Tcl_ResolveVarProc * varProc,
+ Tcl_ResolveCompiledVarProc * compiledVarProc));
+/* 112 */
+EXTERN int Tcl_AppendExportList _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Namespace * nsPtr,
+ Tcl_Obj * objPtr));
+/* 113 */
+EXTERN Tcl_Namespace * Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, ClientData clientData,
+ Tcl_NamespaceDeleteProc * deleteProc));
+/* 114 */
+EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_((
+ Tcl_Namespace * nsPtr));
+/* 115 */
+EXTERN int Tcl_Export _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Namespace * nsPtr, char * pattern,
+ int resetListFirst));
+/* 116 */
+EXTERN Tcl_Command Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, Tcl_Namespace * contextNsPtr,
+ int flags));
+/* 117 */
+EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, Tcl_Namespace * contextNsPtr,
+ int flags));
+/* 118 */
+EXTERN int Tcl_GetInterpResolvers _ANSI_ARGS_((
+ Tcl_Interp * interp, char * name,
+ Tcl_ResolverInfo * resInfo));
+/* 119 */
+EXTERN int Tcl_GetNamespaceResolvers _ANSI_ARGS_((
+ Tcl_Namespace * namespacePtr,
+ Tcl_ResolverInfo * resInfo));
+/* 120 */
+EXTERN Tcl_Var Tcl_FindNamespaceVar _ANSI_ARGS_((
+ Tcl_Interp * interp, char * name,
+ Tcl_Namespace * contextNsPtr, int flags));
+/* 121 */
+EXTERN int Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Namespace * nsPtr, char * pattern));
+/* 122 */
+EXTERN Tcl_Command Tcl_GetCommandFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr));
+/* 123 */
+EXTERN void Tcl_GetCommandFullName _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Command command,
+ Tcl_Obj * objPtr));
+/* 124 */
+EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 125 */
+EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 126 */
+EXTERN void Tcl_GetVariableFullName _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Var variable,
+ Tcl_Obj * objPtr));
+/* 127 */
+EXTERN int Tcl_Import _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Namespace * nsPtr, char * pattern,
+ int allowOverwrite));
+/* 128 */
+EXTERN void Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp* interp));
+/* 129 */
+EXTERN int Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_CallFrame * framePtr,
+ Tcl_Namespace * nsPtr, int isProcCallFrame));
+/* 130 */
+EXTERN int Tcl_RemoveInterpResolvers _ANSI_ARGS_((
+ Tcl_Interp * interp, char * name));
+/* 131 */
+EXTERN void Tcl_SetNamespaceResolvers _ANSI_ARGS_((
+ Tcl_Namespace * namespacePtr,
+ Tcl_ResolveCmdProc * cmdProc,
+ Tcl_ResolveVarProc * varProc,
+ Tcl_ResolveCompiledVarProc * compiledVarProc));
+/* 132 */
+EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp * interp));
+/* 133 */
+EXTERN struct tm * TclpGetDate _ANSI_ARGS_((TclpTime_t time, int useGMT));
+/* 134 */
+EXTERN size_t TclpStrftime _ANSI_ARGS_((char * s, size_t maxsize,
+ CONST char * format, CONST struct tm * t));
+/* 135 */
+EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void));
+/* Slot 136 is reserved */
+/* 137 */
+EXTERN int TclpChdir _ANSI_ARGS_((CONST char * dirName));
+/* 138 */
+EXTERN char * TclGetEnv _ANSI_ARGS_((CONST char * name,
+ Tcl_DString * valuePtr));
+/* 139 */
+EXTERN int TclpLoadFile _ANSI_ARGS_((Tcl_Interp * interp,
+ char * fileName, char * sym1, char * sym2,
+ Tcl_PackageInitProc ** proc1Ptr,
+ Tcl_PackageInitProc ** proc2Ptr,
+ ClientData * clientDataPtr));
+/* 140 */
+EXTERN int TclLooksLikeInt _ANSI_ARGS_((char * bytes,
+ int length));
+/* 141 */
+EXTERN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_DString * cwdPtr));
+/* 142 */
+EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr,
+ CompileHookProc * hookProc,
+ ClientData clientData));
+/* 143 */
+EXTERN int TclAddLiteralObj _ANSI_ARGS_((
+ struct CompileEnv * envPtr, Tcl_Obj * objPtr,
+ LiteralEntry ** litPtrPtr));
+/* 144 */
+EXTERN void TclHideLiteral _ANSI_ARGS_((Tcl_Interp * interp,
+ struct CompileEnv * envPtr, int index));
+/* 145 */
+EXTERN struct AuxDataType * TclGetAuxDataType _ANSI_ARGS_((char * typeName));
+/* 146 */
+EXTERN TclHandle TclHandleCreate _ANSI_ARGS_((VOID * ptr));
+/* 147 */
+EXTERN void TclHandleFree _ANSI_ARGS_((TclHandle handle));
+/* 148 */
+EXTERN TclHandle TclHandlePreserve _ANSI_ARGS_((TclHandle handle));
+/* 149 */
+EXTERN void TclHandleRelease _ANSI_ARGS_((TclHandle handle));
+/* 150 */
+EXTERN int TclRegAbout _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_RegExp re));
+/* 151 */
+EXTERN void TclRegExpRangeUniChar _ANSI_ARGS_((Tcl_RegExp re,
+ int index, int * startPtr, int * endPtr));
+/* 152 */
+EXTERN void TclSetLibraryPath _ANSI_ARGS_((Tcl_Obj * pathPtr));
+/* 153 */
+EXTERN Tcl_Obj * TclGetLibraryPath _ANSI_ARGS_((void));
+/* Slot 154 is reserved */
+/* Slot 155 is reserved */
+/* 156 */
+EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp,
+ char * msg, int status));
+/* 157 */
+EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp,
+ char * varName));
+/* 158 */
+EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_((
+ char * filename));
+/* 159 */
+EXTERN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
+/* 160 */
+EXTERN int TclpMatchFilesTypes _ANSI_ARGS_((Tcl_Interp * interp,
+ char * separators, Tcl_DString * dirPtr,
+ char * pattern, char * tail,
+ GlobTypeData * types));
+/* 161 */
+EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Channel chan, Tcl_Obj * cmdObjPtr));
+/* 162 */
+EXTERN void TclChannelEventScriptInvoker _ANSI_ARGS_((
+ ClientData clientData, int flags));
+
+typedef struct TclIntStubs {
+ int magic;
+ struct TclIntStubHooks *hooks;
+
+ int (*tclAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 0 */
+ int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 1 */
+ int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 2 */
+ void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */
+ void *reserved4;
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp * interp, int numPids, Tcl_Pid * pidPtr, Tcl_Channel errorChan)); /* 5 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp * interp, int numPids, Tcl_Pid * pidPtr, Tcl_Channel errorChan)); /* 5 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved5;
+#endif /* MAC_TCL */
+ void (*tclCleanupCommand) _ANSI_ARGS_((Command * cmdPtr)); /* 6 */
+ int (*tclCopyAndCollapse) _ANSI_ARGS_((int count, CONST char * src, char * dst)); /* 7 */
+ int (*tclCopyChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj * cmdPtr)); /* 8 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved9;
+#endif /* MAC_TCL */
+ int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp * interp, Namespace * nsPtr, char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)); /* 10 */
+ void (*tclDeleteCompiledLocalVars) _ANSI_ARGS_((Interp * iPtr, CallFrame * framePtr)); /* 11 */
+ void (*tclDeleteVars) _ANSI_ARGS_((Interp * iPtr, Tcl_HashTable * tablePtr)); /* 12 */
+ int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail, GlobTypeData * types)); /* 13 */
+ void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */
+ void *reserved15;
+ void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp * interp, double value)); /* 16 */
+ int (*tclFileAttrsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 17 */
+ int (*tclFileCopyCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 18 */
+ int (*tclFileDeleteCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 19 */
+ int (*tclFileMakeDirsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 20 */
+ int (*tclFileRenameCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 21 */
+ int (*tclFindElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int listLength, CONST char ** elementPtr, CONST char ** nextPtr, int * sizePtr, int * bracePtr)); /* 22 */
+ Proc * (*tclFindProc) _ANSI_ARGS_((Interp * iPtr, char * procName)); /* 23 */
+ int (*tclFormatInt) _ANSI_ARGS_((char * buffer, long n)); /* 24 */
+ void (*tclFreePackageInfo) _ANSI_ARGS_((Interp * iPtr)); /* 25 */
+ void *reserved26;
+ int (*tclGetDate) _ANSI_ARGS_((char * p, unsigned long now, long zone, unsigned long * timePtr)); /* 27 */
+ Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */
+ Tcl_Obj * (*tclGetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, int leaveErrorMsg)); /* 29 */
+ void *reserved30;
+ char * (*tclGetExtension) _ANSI_ARGS_((char * name)); /* 31 */
+ int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, char * str, CallFrame ** framePtrPtr)); /* 32 */
+ TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */
+ int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */
+ Tcl_Obj * (*tclGetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, int leaveErrorMsg)); /* 35 */
+ int (*tclGetLong) _ANSI_ARGS_((Tcl_Interp * interp, char * str, long * longPtr)); /* 36 */
+ int (*tclGetLoadedPackages) _ANSI_ARGS_((Tcl_Interp * interp, char * targetName)); /* 37 */
+ int (*tclGetNamespaceForQualName) _ANSI_ARGS_((Tcl_Interp * interp, char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, char ** simpleNamePtr)); /* 38 */
+ TclObjCmdProcType (*tclGetObjInterpProc) _ANSI_ARGS_((void)); /* 39 */
+ int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * seekFlagPtr)); /* 40 */
+ Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */
+ char * (*tclpGetUserHome) _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 42 */
+ int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 43 */
+ int (*tclGuessPackageName) _ANSI_ARGS_((char * fileName, Tcl_DString * bufPtr)); /* 44 */
+ int (*tclHideUnsafeCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 45 */
+ int (*tclInExit) _ANSI_ARGS_((void)); /* 46 */
+ Tcl_Obj * (*tclIncrElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, long incrAmount)); /* 47 */
+ Tcl_Obj * (*tclIncrIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, long incrAmount)); /* 48 */
+ Tcl_Obj * (*tclIncrVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, long incrAmount, int part1NotParsed)); /* 49 */
+ void (*tclInitCompiledLocals) _ANSI_ARGS_((Tcl_Interp * interp, CallFrame * framePtr, Namespace * nsPtr)); /* 50 */
+ int (*tclInterpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 51 */
+ int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 52 */
+ int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 53 */
+ int (*tclInvokeStringCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 54 */
+ Proc * (*tclIsProc) _ANSI_ARGS_((Command * cmdPtr)); /* 55 */
+ void *reserved56;
+ void *reserved57;
+ Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */
+ int (*tclpMatchFiles) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * dirPtr, char * pattern, char * tail)); /* 59 */
+ int (*tclNeedSpace) _ANSI_ARGS_((char * start, char * end)); /* 60 */
+ Tcl_Obj * (*tclNewProcBodyObj) _ANSI_ARGS_((Proc * procPtr)); /* 61 */
+ int (*tclObjCommandComplete) _ANSI_ARGS_((Tcl_Obj * cmdPtr)); /* 62 */
+ int (*tclObjInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 63 */
+ int (*tclObjInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 64 */
+ int (*tclObjInvokeGlobal) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 65 */
+ int (*tclOpenFileChannelDeleteProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 66 */
+ int (*tclOpenFileChannelInsertProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 67 */
+ int (*tclpAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 68 */
+ char * (*tclpAlloc) _ANSI_ARGS_((unsigned int size)); /* 69 */
+ int (*tclpCopyFile) _ANSI_ARGS_((CONST char * source, CONST char * dest)); /* 70 */
+ int (*tclpCopyDirectory) _ANSI_ARGS_((CONST char * source, CONST char * dest, Tcl_DString * errorPtr)); /* 71 */
+ int (*tclpCreateDirectory) _ANSI_ARGS_((CONST char * path)); /* 72 */
+ int (*tclpDeleteFile) _ANSI_ARGS_((CONST char * path)); /* 73 */
+ void (*tclpFree) _ANSI_ARGS_((char * ptr)); /* 74 */
+ unsigned long (*tclpGetClicks) _ANSI_ARGS_((void)); /* 75 */
+ unsigned long (*tclpGetSeconds) _ANSI_ARGS_((void)); /* 76 */
+ void (*tclpGetTime) _ANSI_ARGS_((Tcl_Time * time)); /* 77 */
+ int (*tclpGetTimeZone) _ANSI_ARGS_((unsigned long time)); /* 78 */
+ int (*tclpListVolumes) _ANSI_ARGS_((Tcl_Interp * interp)); /* 79 */
+ Tcl_Channel (*tclpOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 80 */
+ char * (*tclpRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 81 */
+ int (*tclpRemoveDirectory) _ANSI_ARGS_((CONST char * path, int recursive, Tcl_DString * errorPtr)); /* 82 */
+ int (*tclpRenameFile) _ANSI_ARGS_((CONST char * source, CONST char * dest)); /* 83 */
+ void *reserved84;
+ void *reserved85;
+ void *reserved86;
+ void *reserved87;
+ char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, char * name1, char * name2, int flags)); /* 88 */
+ int (*tclPreventAliasLoop) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Interp * cmdInterp, Tcl_Command cmd)); /* 89 */
+ void *reserved90;
+ void (*tclProcCleanupProc) _ANSI_ARGS_((Proc * procPtr)); /* 91 */
+ int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */
+ void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */
+ int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 94 */
+ int (*tclpStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 95 */
+ int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */
+ void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */
+ int (*tclServiceIdle) _ANSI_ARGS_((void)); /* 98 */
+ Tcl_Obj * (*tclSetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, Tcl_Obj * objPtr, int leaveErrorMsg)); /* 99 */
+ Tcl_Obj * (*tclSetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * objPtr, int leaveErrorMsg)); /* 100 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ char * (*tclSetPreInitScript) _ANSI_ARGS_((char * string)); /* 101 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ char * (*tclSetPreInitScript) _ANSI_ARGS_((char * string)); /* 101 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved101;
+#endif /* MAC_TCL */
+ void (*tclSetupEnv) _ANSI_ARGS_((Tcl_Interp * interp)); /* 102 */
+ int (*tclSockGetPort) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char * proto, int * portPtr)); /* 103 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ int (*tclSockMinimumBuffers) _ANSI_ARGS_((int sock, int size)); /* 104 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ int (*tclSockMinimumBuffers) _ANSI_ARGS_((int sock, int size)); /* 104 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void *reserved104;
+#endif /* MAC_TCL */
+ int (*tclStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 105 */
+ int (*tclStatDeleteProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 106 */
+ int (*tclStatInsertProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 107 */
+ void (*tclTeardownNamespace) _ANSI_ARGS_((Namespace * nsPtr)); /* 108 */
+ int (*tclUpdateReturnInfo) _ANSI_ARGS_((Interp * iPtr)); /* 109 */
+ void *reserved110;
+ void (*tcl_AddInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)); /* 111 */
+ int (*tcl_AppendExportList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, Tcl_Obj * objPtr)); /* 112 */
+ Tcl_Namespace * (*tcl_CreateNamespace) _ANSI_ARGS_((Tcl_Interp * interp, char * name, ClientData clientData, Tcl_NamespaceDeleteProc * deleteProc)); /* 113 */
+ void (*tcl_DeleteNamespace) _ANSI_ARGS_((Tcl_Namespace * nsPtr)); /* 114 */
+ int (*tcl_Export) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, char * pattern, int resetListFirst)); /* 115 */
+ Tcl_Command (*tcl_FindCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 116 */
+ Tcl_Namespace * (*tcl_FindNamespace) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 117 */
+ int (*tcl_GetInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_ResolverInfo * resInfo)); /* 118 */
+ int (*tcl_GetNamespaceResolvers) _ANSI_ARGS_((Tcl_Namespace * namespacePtr, Tcl_ResolverInfo * resInfo)); /* 119 */
+ Tcl_Var (*tcl_FindNamespaceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 120 */
+ int (*tcl_ForgetImport) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, char * pattern)); /* 121 */
+ Tcl_Command (*tcl_GetCommandFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 122 */
+ void (*tcl_GetCommandFullName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command, Tcl_Obj * objPtr)); /* 123 */
+ Tcl_Namespace * (*tcl_GetCurrentNamespace) _ANSI_ARGS_((Tcl_Interp * interp)); /* 124 */
+ Tcl_Namespace * (*tcl_GetGlobalNamespace) _ANSI_ARGS_((Tcl_Interp * interp)); /* 125 */
+ void (*tcl_GetVariableFullName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Var variable, Tcl_Obj * objPtr)); /* 126 */
+ int (*tcl_Import) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, char * pattern, int allowOverwrite)); /* 127 */
+ void (*tcl_PopCallFrame) _ANSI_ARGS_((Tcl_Interp* interp)); /* 128 */
+ int (*tcl_PushCallFrame) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_CallFrame * framePtr, Tcl_Namespace * nsPtr, int isProcCallFrame)); /* 129 */
+ int (*tcl_RemoveInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, char * name)); /* 130 */
+ void (*tcl_SetNamespaceResolvers) _ANSI_ARGS_((Tcl_Namespace * namespacePtr, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)); /* 131 */
+ int (*tclpHasSockets) _ANSI_ARGS_((Tcl_Interp * interp)); /* 132 */
+ struct tm * (*tclpGetDate) _ANSI_ARGS_((TclpTime_t time, int useGMT)); /* 133 */
+ size_t (*tclpStrftime) _ANSI_ARGS_((char * s, size_t maxsize, CONST char * format, CONST struct tm * t)); /* 134 */
+ int (*tclpCheckStackSpace) _ANSI_ARGS_((void)); /* 135 */
+ void *reserved136;
+ int (*tclpChdir) _ANSI_ARGS_((CONST char * dirName)); /* 137 */
+ char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */
+ int (*tclpLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr)); /* 139 */
+ int (*tclLooksLikeInt) _ANSI_ARGS_((char * bytes, int length)); /* 140 */
+ char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */
+ int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)); /* 142 */
+ int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)); /* 143 */
+ void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp * interp, struct CompileEnv * envPtr, int index)); /* 144 */
+ struct AuxDataType * (*tclGetAuxDataType) _ANSI_ARGS_((char * typeName)); /* 145 */
+ TclHandle (*tclHandleCreate) _ANSI_ARGS_((VOID * ptr)); /* 146 */
+ void (*tclHandleFree) _ANSI_ARGS_((TclHandle handle)); /* 147 */
+ TclHandle (*tclHandlePreserve) _ANSI_ARGS_((TclHandle handle)); /* 148 */
+ void (*tclHandleRelease) _ANSI_ARGS_((TclHandle handle)); /* 149 */
+ int (*tclRegAbout) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp re)); /* 150 */
+ void (*tclRegExpRangeUniChar) _ANSI_ARGS_((Tcl_RegExp re, int index, int * startPtr, int * endPtr)); /* 151 */
+ void (*tclSetLibraryPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 152 */
+ Tcl_Obj * (*tclGetLibraryPath) _ANSI_ARGS_((void)); /* 153 */
+ void *reserved154;
+ void *reserved155;
+ void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, int status)); /* 156 */
+ Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
+ void (*tclSetStartupScriptFileName) _ANSI_ARGS_((char * filename)); /* 158 */
+ char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
+ int (*tclpMatchFilesTypes) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * dirPtr, char * pattern, char * tail, GlobTypeData * types)); /* 160 */
+ int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */
+ void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */
+} TclIntStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TclIntStubs *tclIntStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifndef TclAccess
+#define TclAccess \
+ (tclIntStubsPtr->tclAccess) /* 0 */
+#endif
+#ifndef TclAccessDeleteProc
+#define TclAccessDeleteProc \
+ (tclIntStubsPtr->tclAccessDeleteProc) /* 1 */
+#endif
+#ifndef TclAccessInsertProc
+#define TclAccessInsertProc \
+ (tclIntStubsPtr->tclAccessInsertProc) /* 2 */
+#endif
+#ifndef TclAllocateFreeObjects
+#define TclAllocateFreeObjects \
+ (tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
+#endif
+/* Slot 4 is reserved */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclCleanupChildren
+#define TclCleanupChildren \
+ (tclIntStubsPtr->tclCleanupChildren) /* 5 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclCleanupChildren
+#define TclCleanupChildren \
+ (tclIntStubsPtr->tclCleanupChildren) /* 5 */
+#endif
+#endif /* __WIN32__ */
+#ifndef TclCleanupCommand
+#define TclCleanupCommand \
+ (tclIntStubsPtr->tclCleanupCommand) /* 6 */
+#endif
+#ifndef TclCopyAndCollapse
+#define TclCopyAndCollapse \
+ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
+#endif
+#ifndef TclCopyChannel
+#define TclCopyChannel \
+ (tclIntStubsPtr->tclCopyChannel) /* 8 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclCreatePipeline
+#define TclCreatePipeline \
+ (tclIntStubsPtr->tclCreatePipeline) /* 9 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclCreatePipeline
+#define TclCreatePipeline \
+ (tclIntStubsPtr->tclCreatePipeline) /* 9 */
+#endif
+#endif /* __WIN32__ */
+#ifndef TclCreateProc
+#define TclCreateProc \
+ (tclIntStubsPtr->tclCreateProc) /* 10 */
+#endif
+#ifndef TclDeleteCompiledLocalVars
+#define TclDeleteCompiledLocalVars \
+ (tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
+#endif
+#ifndef TclDeleteVars
+#define TclDeleteVars \
+ (tclIntStubsPtr->tclDeleteVars) /* 12 */
+#endif
+#ifndef TclDoGlob
+#define TclDoGlob \
+ (tclIntStubsPtr->tclDoGlob) /* 13 */
+#endif
+#ifndef TclDumpMemoryInfo
+#define TclDumpMemoryInfo \
+ (tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */
+#endif
+/* Slot 15 is reserved */
+#ifndef TclExprFloatError
+#define TclExprFloatError \
+ (tclIntStubsPtr->tclExprFloatError) /* 16 */
+#endif
+#ifndef TclFileAttrsCmd
+#define TclFileAttrsCmd \
+ (tclIntStubsPtr->tclFileAttrsCmd) /* 17 */
+#endif
+#ifndef TclFileCopyCmd
+#define TclFileCopyCmd \
+ (tclIntStubsPtr->tclFileCopyCmd) /* 18 */
+#endif
+#ifndef TclFileDeleteCmd
+#define TclFileDeleteCmd \
+ (tclIntStubsPtr->tclFileDeleteCmd) /* 19 */
+#endif
+#ifndef TclFileMakeDirsCmd
+#define TclFileMakeDirsCmd \
+ (tclIntStubsPtr->tclFileMakeDirsCmd) /* 20 */
+#endif
+#ifndef TclFileRenameCmd
+#define TclFileRenameCmd \
+ (tclIntStubsPtr->tclFileRenameCmd) /* 21 */
+#endif
+#ifndef TclFindElement
+#define TclFindElement \
+ (tclIntStubsPtr->tclFindElement) /* 22 */
+#endif
+#ifndef TclFindProc
+#define TclFindProc \
+ (tclIntStubsPtr->tclFindProc) /* 23 */
+#endif
+#ifndef TclFormatInt
+#define TclFormatInt \
+ (tclIntStubsPtr->tclFormatInt) /* 24 */
+#endif
+#ifndef TclFreePackageInfo
+#define TclFreePackageInfo \
+ (tclIntStubsPtr->tclFreePackageInfo) /* 25 */
+#endif
+/* Slot 26 is reserved */
+#ifndef TclGetDate
+#define TclGetDate \
+ (tclIntStubsPtr->tclGetDate) /* 27 */
+#endif
+#ifndef TclpGetDefaultStdChannel
+#define TclpGetDefaultStdChannel \
+ (tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */
+#endif
+#ifndef TclGetElementOfIndexedArray
+#define TclGetElementOfIndexedArray \
+ (tclIntStubsPtr->tclGetElementOfIndexedArray) /* 29 */
+#endif
+/* Slot 30 is reserved */
+#ifndef TclGetExtension
+#define TclGetExtension \
+ (tclIntStubsPtr->tclGetExtension) /* 31 */
+#endif
+#ifndef TclGetFrame
+#define TclGetFrame \
+ (tclIntStubsPtr->tclGetFrame) /* 32 */
+#endif
+#ifndef TclGetInterpProc
+#define TclGetInterpProc \
+ (tclIntStubsPtr->tclGetInterpProc) /* 33 */
+#endif
+#ifndef TclGetIntForIndex
+#define TclGetIntForIndex \
+ (tclIntStubsPtr->tclGetIntForIndex) /* 34 */
+#endif
+#ifndef TclGetIndexedScalar
+#define TclGetIndexedScalar \
+ (tclIntStubsPtr->tclGetIndexedScalar) /* 35 */
+#endif
+#ifndef TclGetLong
+#define TclGetLong \
+ (tclIntStubsPtr->tclGetLong) /* 36 */
+#endif
+#ifndef TclGetLoadedPackages
+#define TclGetLoadedPackages \
+ (tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
+#endif
+#ifndef TclGetNamespaceForQualName
+#define TclGetNamespaceForQualName \
+ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
+#endif
+#ifndef TclGetObjInterpProc
+#define TclGetObjInterpProc \
+ (tclIntStubsPtr->tclGetObjInterpProc) /* 39 */
+#endif
+#ifndef TclGetOpenMode
+#define TclGetOpenMode \
+ (tclIntStubsPtr->tclGetOpenMode) /* 40 */
+#endif
+#ifndef TclGetOriginalCommand
+#define TclGetOriginalCommand \
+ (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */
+#endif
+#ifndef TclpGetUserHome
+#define TclpGetUserHome \
+ (tclIntStubsPtr->tclpGetUserHome) /* 42 */
+#endif
+#ifndef TclGlobalInvoke
+#define TclGlobalInvoke \
+ (tclIntStubsPtr->tclGlobalInvoke) /* 43 */
+#endif
+#ifndef TclGuessPackageName
+#define TclGuessPackageName \
+ (tclIntStubsPtr->tclGuessPackageName) /* 44 */
+#endif
+#ifndef TclHideUnsafeCommands
+#define TclHideUnsafeCommands \
+ (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
+#endif
+#ifndef TclInExit
+#define TclInExit \
+ (tclIntStubsPtr->tclInExit) /* 46 */
+#endif
+#ifndef TclIncrElementOfIndexedArray
+#define TclIncrElementOfIndexedArray \
+ (tclIntStubsPtr->tclIncrElementOfIndexedArray) /* 47 */
+#endif
+#ifndef TclIncrIndexedScalar
+#define TclIncrIndexedScalar \
+ (tclIntStubsPtr->tclIncrIndexedScalar) /* 48 */
+#endif
+#ifndef TclIncrVar2
+#define TclIncrVar2 \
+ (tclIntStubsPtr->tclIncrVar2) /* 49 */
+#endif
+#ifndef TclInitCompiledLocals
+#define TclInitCompiledLocals \
+ (tclIntStubsPtr->tclInitCompiledLocals) /* 50 */
+#endif
+#ifndef TclInterpInit
+#define TclInterpInit \
+ (tclIntStubsPtr->tclInterpInit) /* 51 */
+#endif
+#ifndef TclInvoke
+#define TclInvoke \
+ (tclIntStubsPtr->tclInvoke) /* 52 */
+#endif
+#ifndef TclInvokeObjectCommand
+#define TclInvokeObjectCommand \
+ (tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */
+#endif
+#ifndef TclInvokeStringCommand
+#define TclInvokeStringCommand \
+ (tclIntStubsPtr->tclInvokeStringCommand) /* 54 */
+#endif
+#ifndef TclIsProc
+#define TclIsProc \
+ (tclIntStubsPtr->tclIsProc) /* 55 */
+#endif
+/* Slot 56 is reserved */
+/* Slot 57 is reserved */
+#ifndef TclLookupVar
+#define TclLookupVar \
+ (tclIntStubsPtr->tclLookupVar) /* 58 */
+#endif
+#ifndef TclpMatchFiles
+#define TclpMatchFiles \
+ (tclIntStubsPtr->tclpMatchFiles) /* 59 */
+#endif
+#ifndef TclNeedSpace
+#define TclNeedSpace \
+ (tclIntStubsPtr->tclNeedSpace) /* 60 */
+#endif
+#ifndef TclNewProcBodyObj
+#define TclNewProcBodyObj \
+ (tclIntStubsPtr->tclNewProcBodyObj) /* 61 */
+#endif
+#ifndef TclObjCommandComplete
+#define TclObjCommandComplete \
+ (tclIntStubsPtr->tclObjCommandComplete) /* 62 */
+#endif
+#ifndef TclObjInterpProc
+#define TclObjInterpProc \
+ (tclIntStubsPtr->tclObjInterpProc) /* 63 */
+#endif
+#ifndef TclObjInvoke
+#define TclObjInvoke \
+ (tclIntStubsPtr->tclObjInvoke) /* 64 */
+#endif
+#ifndef TclObjInvokeGlobal
+#define TclObjInvokeGlobal \
+ (tclIntStubsPtr->tclObjInvokeGlobal) /* 65 */
+#endif
+#ifndef TclOpenFileChannelDeleteProc
+#define TclOpenFileChannelDeleteProc \
+ (tclIntStubsPtr->tclOpenFileChannelDeleteProc) /* 66 */
+#endif
+#ifndef TclOpenFileChannelInsertProc
+#define TclOpenFileChannelInsertProc \
+ (tclIntStubsPtr->tclOpenFileChannelInsertProc) /* 67 */
+#endif
+#ifndef TclpAccess
+#define TclpAccess \
+ (tclIntStubsPtr->tclpAccess) /* 68 */
+#endif
+#ifndef TclpAlloc
+#define TclpAlloc \
+ (tclIntStubsPtr->tclpAlloc) /* 69 */
+#endif
+#ifndef TclpCopyFile
+#define TclpCopyFile \
+ (tclIntStubsPtr->tclpCopyFile) /* 70 */
+#endif
+#ifndef TclpCopyDirectory
+#define TclpCopyDirectory \
+ (tclIntStubsPtr->tclpCopyDirectory) /* 71 */
+#endif
+#ifndef TclpCreateDirectory
+#define TclpCreateDirectory \
+ (tclIntStubsPtr->tclpCreateDirectory) /* 72 */
+#endif
+#ifndef TclpDeleteFile
+#define TclpDeleteFile \
+ (tclIntStubsPtr->tclpDeleteFile) /* 73 */
+#endif
+#ifndef TclpFree
+#define TclpFree \
+ (tclIntStubsPtr->tclpFree) /* 74 */
+#endif
+#ifndef TclpGetClicks
+#define TclpGetClicks \
+ (tclIntStubsPtr->tclpGetClicks) /* 75 */
+#endif
+#ifndef TclpGetSeconds
+#define TclpGetSeconds \
+ (tclIntStubsPtr->tclpGetSeconds) /* 76 */
+#endif
+#ifndef TclpGetTime
+#define TclpGetTime \
+ (tclIntStubsPtr->tclpGetTime) /* 77 */
+#endif
+#ifndef TclpGetTimeZone
+#define TclpGetTimeZone \
+ (tclIntStubsPtr->tclpGetTimeZone) /* 78 */
+#endif
+#ifndef TclpListVolumes
+#define TclpListVolumes \
+ (tclIntStubsPtr->tclpListVolumes) /* 79 */
+#endif
+#ifndef TclpOpenFileChannel
+#define TclpOpenFileChannel \
+ (tclIntStubsPtr->tclpOpenFileChannel) /* 80 */
+#endif
+#ifndef TclpRealloc
+#define TclpRealloc \
+ (tclIntStubsPtr->tclpRealloc) /* 81 */
+#endif
+#ifndef TclpRemoveDirectory
+#define TclpRemoveDirectory \
+ (tclIntStubsPtr->tclpRemoveDirectory) /* 82 */
+#endif
+#ifndef TclpRenameFile
+#define TclpRenameFile \
+ (tclIntStubsPtr->tclpRenameFile) /* 83 */
+#endif
+/* Slot 84 is reserved */
+/* Slot 85 is reserved */
+/* Slot 86 is reserved */
+/* Slot 87 is reserved */
+#ifndef TclPrecTraceProc
+#define TclPrecTraceProc \
+ (tclIntStubsPtr->tclPrecTraceProc) /* 88 */
+#endif
+#ifndef TclPreventAliasLoop
+#define TclPreventAliasLoop \
+ (tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
+#endif
+/* Slot 90 is reserved */
+#ifndef TclProcCleanupProc
+#define TclProcCleanupProc \
+ (tclIntStubsPtr->tclProcCleanupProc) /* 91 */
+#endif
+#ifndef TclProcCompileProc
+#define TclProcCompileProc \
+ (tclIntStubsPtr->tclProcCompileProc) /* 92 */
+#endif
+#ifndef TclProcDeleteProc
+#define TclProcDeleteProc \
+ (tclIntStubsPtr->tclProcDeleteProc) /* 93 */
+#endif
+#ifndef TclProcInterpProc
+#define TclProcInterpProc \
+ (tclIntStubsPtr->tclProcInterpProc) /* 94 */
+#endif
+#ifndef TclpStat
+#define TclpStat \
+ (tclIntStubsPtr->tclpStat) /* 95 */
+#endif
+#ifndef TclRenameCommand
+#define TclRenameCommand \
+ (tclIntStubsPtr->tclRenameCommand) /* 96 */
+#endif
+#ifndef TclResetShadowedCmdRefs
+#define TclResetShadowedCmdRefs \
+ (tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */
+#endif
+#ifndef TclServiceIdle
+#define TclServiceIdle \
+ (tclIntStubsPtr->tclServiceIdle) /* 98 */
+#endif
+#ifndef TclSetElementOfIndexedArray
+#define TclSetElementOfIndexedArray \
+ (tclIntStubsPtr->tclSetElementOfIndexedArray) /* 99 */
+#endif
+#ifndef TclSetIndexedScalar
+#define TclSetIndexedScalar \
+ (tclIntStubsPtr->tclSetIndexedScalar) /* 100 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclSetPreInitScript
+#define TclSetPreInitScript \
+ (tclIntStubsPtr->tclSetPreInitScript) /* 101 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclSetPreInitScript
+#define TclSetPreInitScript \
+ (tclIntStubsPtr->tclSetPreInitScript) /* 101 */
+#endif
+#endif /* __WIN32__ */
+#ifndef TclSetupEnv
+#define TclSetupEnv \
+ (tclIntStubsPtr->tclSetupEnv) /* 102 */
+#endif
+#ifndef TclSockGetPort
+#define TclSockGetPort \
+ (tclIntStubsPtr->tclSockGetPort) /* 103 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclSockMinimumBuffers
+#define TclSockMinimumBuffers \
+ (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclSockMinimumBuffers
+#define TclSockMinimumBuffers \
+ (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */
+#endif
+#endif /* __WIN32__ */
+#ifndef TclStat
+#define TclStat \
+ (tclIntStubsPtr->tclStat) /* 105 */
+#endif
+#ifndef TclStatDeleteProc
+#define TclStatDeleteProc \
+ (tclIntStubsPtr->tclStatDeleteProc) /* 106 */
+#endif
+#ifndef TclStatInsertProc
+#define TclStatInsertProc \
+ (tclIntStubsPtr->tclStatInsertProc) /* 107 */
+#endif
+#ifndef TclTeardownNamespace
+#define TclTeardownNamespace \
+ (tclIntStubsPtr->tclTeardownNamespace) /* 108 */
+#endif
+#ifndef TclUpdateReturnInfo
+#define TclUpdateReturnInfo \
+ (tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
+#endif
+/* Slot 110 is reserved */
+#ifndef Tcl_AddInterpResolvers
+#define Tcl_AddInterpResolvers \
+ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
+#endif
+#ifndef Tcl_AppendExportList
+#define Tcl_AppendExportList \
+ (tclIntStubsPtr->tcl_AppendExportList) /* 112 */
+#endif
+#ifndef Tcl_CreateNamespace
+#define Tcl_CreateNamespace \
+ (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
+#endif
+#ifndef Tcl_DeleteNamespace
+#define Tcl_DeleteNamespace \
+ (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
+#endif
+#ifndef Tcl_Export
+#define Tcl_Export \
+ (tclIntStubsPtr->tcl_Export) /* 115 */
+#endif
+#ifndef Tcl_FindCommand
+#define Tcl_FindCommand \
+ (tclIntStubsPtr->tcl_FindCommand) /* 116 */
+#endif
+#ifndef Tcl_FindNamespace
+#define Tcl_FindNamespace \
+ (tclIntStubsPtr->tcl_FindNamespace) /* 117 */
+#endif
+#ifndef Tcl_GetInterpResolvers
+#define Tcl_GetInterpResolvers \
+ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
+#endif
+#ifndef Tcl_GetNamespaceResolvers
+#define Tcl_GetNamespaceResolvers \
+ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
+#endif
+#ifndef Tcl_FindNamespaceVar
+#define Tcl_FindNamespaceVar \
+ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
+#endif
+#ifndef Tcl_ForgetImport
+#define Tcl_ForgetImport \
+ (tclIntStubsPtr->tcl_ForgetImport) /* 121 */
+#endif
+#ifndef Tcl_GetCommandFromObj
+#define Tcl_GetCommandFromObj \
+ (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
+#endif
+#ifndef Tcl_GetCommandFullName
+#define Tcl_GetCommandFullName \
+ (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
+#endif
+#ifndef Tcl_GetCurrentNamespace
+#define Tcl_GetCurrentNamespace \
+ (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
+#endif
+#ifndef Tcl_GetGlobalNamespace
+#define Tcl_GetGlobalNamespace \
+ (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
+#endif
+#ifndef Tcl_GetVariableFullName
+#define Tcl_GetVariableFullName \
+ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
+#endif
+#ifndef Tcl_Import
+#define Tcl_Import \
+ (tclIntStubsPtr->tcl_Import) /* 127 */
+#endif
+#ifndef Tcl_PopCallFrame
+#define Tcl_PopCallFrame \
+ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
+#endif
+#ifndef Tcl_PushCallFrame
+#define Tcl_PushCallFrame \
+ (tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
+#endif
+#ifndef Tcl_RemoveInterpResolvers
+#define Tcl_RemoveInterpResolvers \
+ (tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
+#endif
+#ifndef Tcl_SetNamespaceResolvers
+#define Tcl_SetNamespaceResolvers \
+ (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
+#endif
+#ifndef TclpHasSockets
+#define TclpHasSockets \
+ (tclIntStubsPtr->tclpHasSockets) /* 132 */
+#endif
+#ifndef TclpGetDate
+#define TclpGetDate \
+ (tclIntStubsPtr->tclpGetDate) /* 133 */
+#endif
+#ifndef TclpStrftime
+#define TclpStrftime \
+ (tclIntStubsPtr->tclpStrftime) /* 134 */
+#endif
+#ifndef TclpCheckStackSpace
+#define TclpCheckStackSpace \
+ (tclIntStubsPtr->tclpCheckStackSpace) /* 135 */
+#endif
+/* Slot 136 is reserved */
+#ifndef TclpChdir
+#define TclpChdir \
+ (tclIntStubsPtr->tclpChdir) /* 137 */
+#endif
+#ifndef TclGetEnv
+#define TclGetEnv \
+ (tclIntStubsPtr->tclGetEnv) /* 138 */
+#endif
+#ifndef TclpLoadFile
+#define TclpLoadFile \
+ (tclIntStubsPtr->tclpLoadFile) /* 139 */
+#endif
+#ifndef TclLooksLikeInt
+#define TclLooksLikeInt \
+ (tclIntStubsPtr->tclLooksLikeInt) /* 140 */
+#endif
+#ifndef TclpGetCwd
+#define TclpGetCwd \
+ (tclIntStubsPtr->tclpGetCwd) /* 141 */
+#endif
+#ifndef TclSetByteCodeFromAny
+#define TclSetByteCodeFromAny \
+ (tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */
+#endif
+#ifndef TclAddLiteralObj
+#define TclAddLiteralObj \
+ (tclIntStubsPtr->tclAddLiteralObj) /* 143 */
+#endif
+#ifndef TclHideLiteral
+#define TclHideLiteral \
+ (tclIntStubsPtr->tclHideLiteral) /* 144 */
+#endif
+#ifndef TclGetAuxDataType
+#define TclGetAuxDataType \
+ (tclIntStubsPtr->tclGetAuxDataType) /* 145 */
+#endif
+#ifndef TclHandleCreate
+#define TclHandleCreate \
+ (tclIntStubsPtr->tclHandleCreate) /* 146 */
+#endif
+#ifndef TclHandleFree
+#define TclHandleFree \
+ (tclIntStubsPtr->tclHandleFree) /* 147 */
+#endif
+#ifndef TclHandlePreserve
+#define TclHandlePreserve \
+ (tclIntStubsPtr->tclHandlePreserve) /* 148 */
+#endif
+#ifndef TclHandleRelease
+#define TclHandleRelease \
+ (tclIntStubsPtr->tclHandleRelease) /* 149 */
+#endif
+#ifndef TclRegAbout
+#define TclRegAbout \
+ (tclIntStubsPtr->tclRegAbout) /* 150 */
+#endif
+#ifndef TclRegExpRangeUniChar
+#define TclRegExpRangeUniChar \
+ (tclIntStubsPtr->tclRegExpRangeUniChar) /* 151 */
+#endif
+#ifndef TclSetLibraryPath
+#define TclSetLibraryPath \
+ (tclIntStubsPtr->tclSetLibraryPath) /* 152 */
+#endif
+#ifndef TclGetLibraryPath
+#define TclGetLibraryPath \
+ (tclIntStubsPtr->tclGetLibraryPath) /* 153 */
+#endif
+/* Slot 154 is reserved */
+/* Slot 155 is reserved */
+#ifndef TclRegError
+#define TclRegError \
+ (tclIntStubsPtr->tclRegError) /* 156 */
+#endif
+#ifndef TclVarTraceExists
+#define TclVarTraceExists \
+ (tclIntStubsPtr->tclVarTraceExists) /* 157 */
+#endif
+#ifndef TclSetStartupScriptFileName
+#define TclSetStartupScriptFileName \
+ (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
+#endif
+#ifndef TclGetStartupScriptFileName
+#define TclGetStartupScriptFileName \
+ (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
+#endif
+#ifndef TclpMatchFilesTypes
+#define TclpMatchFilesTypes \
+ (tclIntStubsPtr->tclpMatchFilesTypes) /* 160 */
+#endif
+#ifndef TclChannelTransform
+#define TclChannelTransform \
+ (tclIntStubsPtr->tclChannelTransform) /* 161 */
+#endif
+#ifndef TclChannelEventScriptInvoker
+#define TclChannelEventScriptInvoker \
+ (tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */
+#endif
+
+#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#endif /* _TCLINTDECLS */
+
diff --git a/tcl/generic/tclIntPlatDecls.h b/tcl/generic/tclIntPlatDecls.h
new file mode 100644
index 00000000000..b985bb0987e
--- /dev/null
+++ b/tcl/generic/tclIntPlatDecls.h
@@ -0,0 +1,535 @@
+/*
+ * tclIntPlatDecls.h --
+ *
+ * This file contains the declarations for all platform dependent
+ * unsupported functions that are exported by the Tcl library. These
+ * interfaces are not guaranteed to remain the same between
+ * versions. Use at your own risk.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * All rights reserved.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLINTPLATDECLS
+#define _TCLINTPLATDECLS
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tclInt.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 0 */
+EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Channel chan));
+/* 1 */
+EXTERN int TclpCloseFile _ANSI_ARGS_((TclFile file));
+/* 2 */
+EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_((
+ TclFile readFile, TclFile writeFile,
+ TclFile errorFile, int numPids,
+ Tcl_Pid * pidPtr));
+/* 3 */
+EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile * readPipe,
+ TclFile * writePipe));
+/* 4 */
+EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv, TclFile inputFile,
+ TclFile outputFile, TclFile errorFile,
+ Tcl_Pid * pidPtr));
+/* Slot 5 is reserved */
+/* 6 */
+EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
+ int direction));
+/* 7 */
+EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char * fname,
+ int mode));
+/* 8 */
+EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
+ int timeout));
+/* 9 */
+EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((
+ CONST char * contents));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 0 */
+EXTERN void TclWinConvertError _ANSI_ARGS_((DWORD errCode));
+/* 1 */
+EXTERN void TclWinConvertWSAError _ANSI_ARGS_((DWORD errCode));
+/* 2 */
+EXTERN struct servent * TclWinGetServByName _ANSI_ARGS_((CONST char * nm,
+ CONST char * proto));
+/* 3 */
+EXTERN int TclWinGetSockOpt _ANSI_ARGS_((SOCKET s, int level,
+ int optname, char FAR * optval,
+ int FAR * optlen));
+/* 4 */
+EXTERN HINSTANCE TclWinGetTclInstance _ANSI_ARGS_((void));
+/* Slot 5 is reserved */
+/* 6 */
+EXTERN u_short TclWinNToHS _ANSI_ARGS_((u_short ns));
+/* 7 */
+EXTERN int TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level,
+ int optname, CONST char FAR * optval,
+ int optlen));
+/* 8 */
+EXTERN unsigned long TclpGetPid _ANSI_ARGS_((Tcl_Pid pid));
+/* 9 */
+EXTERN int TclWinGetPlatformId _ANSI_ARGS_((void));
+/* Slot 10 is reserved */
+/* 11 */
+EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Channel chan));
+/* 12 */
+EXTERN int TclpCloseFile _ANSI_ARGS_((TclFile file));
+/* 13 */
+EXTERN Tcl_Channel TclpCreateCommandChannel _ANSI_ARGS_((
+ TclFile readFile, TclFile writeFile,
+ TclFile errorFile, int numPids,
+ Tcl_Pid * pidPtr));
+/* 14 */
+EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile * readPipe,
+ TclFile * writePipe));
+/* 15 */
+EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv, TclFile inputFile,
+ TclFile outputFile, TclFile errorFile,
+ Tcl_Pid * pidPtr));
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+/* 18 */
+EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
+ int direction));
+/* 19 */
+EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char * fname,
+ int mode));
+/* 20 */
+EXTERN void TclWinAddProcess _ANSI_ARGS_((HANDLE hProcess,
+ DWORD id));
+/* 21 */
+EXTERN void TclpAsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
+/* 22 */
+EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((
+ CONST char * contents));
+/* 23 */
+EXTERN char * TclpGetTZName _ANSI_ARGS_((int isdst));
+/* 24 */
+EXTERN char * TclWinNoBackslash _ANSI_ARGS_((char * path));
+/* 25 */
+EXTERN TclPlatformType * TclWinGetPlatform _ANSI_ARGS_((void));
+/* 26 */
+EXTERN void TclWinSetInterfaces _ANSI_ARGS_((int wide));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 0 */
+EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin));
+/* 1 */
+EXTERN void TclpSysFree _ANSI_ARGS_((VOID * ptr));
+/* 2 */
+EXTERN VOID * TclpSysRealloc _ANSI_ARGS_((VOID * cp,
+ unsigned int size));
+/* 3 */
+EXTERN void TclpExit _ANSI_ARGS_((int status));
+/* 4 */
+EXTERN int FSpGetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
+/* 5 */
+EXTERN int FSpSetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
+/* 6 */
+EXTERN OSErr FSpFindFolder _ANSI_ARGS_((short vRefNum,
+ OSType folderType, Boolean createFolder,
+ FSSpec * spec));
+/* 7 */
+EXTERN void GetGlobalMouse _ANSI_ARGS_((Point * mouse));
+/* 8 */
+EXTERN pascal OSErr FSpGetDirectoryID _ANSI_ARGS_((CONST FSSpec * spec,
+ long * theDirID, Boolean * isDirectory));
+/* 9 */
+EXTERN pascal short FSpOpenResFileCompat _ANSI_ARGS_((
+ CONST FSSpec * spec, SignedByte permission));
+/* 10 */
+EXTERN pascal void FSpCreateResFileCompat _ANSI_ARGS_((
+ CONST FSSpec * spec, OSType creator,
+ OSType fileType, ScriptCode scriptTag));
+/* 11 */
+EXTERN int FSpLocationFromPath _ANSI_ARGS_((int length,
+ CONST char * path, FSSpecPtr theSpec));
+/* 12 */
+EXTERN OSErr FSpPathFromLocation _ANSI_ARGS_((FSSpecPtr theSpec,
+ int * length, Handle * fullPath));
+/* 13 */
+EXTERN void TclMacExitHandler _ANSI_ARGS_((void));
+/* 14 */
+EXTERN void TclMacInitExitToShell _ANSI_ARGS_((int usePatch));
+/* 15 */
+EXTERN OSErr TclMacInstallExitToShellPatch _ANSI_ARGS_((
+ ExitToShellProcPtr newProc));
+/* 16 */
+EXTERN int TclMacOSErrorToPosixError _ANSI_ARGS_((int error));
+/* 17 */
+EXTERN void TclMacRemoveTimer _ANSI_ARGS_((void * timerToken));
+/* 18 */
+EXTERN void * TclMacStartTimer _ANSI_ARGS_((long ms));
+/* 19 */
+EXTERN int TclMacTimerExpired _ANSI_ARGS_((void * timerToken));
+/* 20 */
+EXTERN int TclMacRegisterResourceFork _ANSI_ARGS_((
+ short fileRef, Tcl_Obj * tokenPtr,
+ int insert));
+/* 21 */
+EXTERN short TclMacUnRegisterResourceFork _ANSI_ARGS_((
+ char * tokenPtr, Tcl_Obj * resultPtr));
+/* 22 */
+EXTERN int TclMacCreateEnv _ANSI_ARGS_((void));
+/* 23 */
+EXTERN FILE * TclMacFOpenHack _ANSI_ARGS_((CONST char * path,
+ CONST char * mode));
+/* Slot 24 is reserved */
+/* 25 */
+EXTERN int TclMacChmod _ANSI_ARGS_((char * path, int mode));
+#endif /* MAC_TCL */
+
+typedef struct TclIntPlatStubs {
+ int magic;
+ struct TclIntPlatStubHooks *hooks;
+
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 0 */
+ int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 1 */
+ Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid * pidPtr)); /* 2 */
+ int (*tclpCreatePipe) _ANSI_ARGS_((TclFile * readPipe, TclFile * writePipe)); /* 3 */
+ int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)); /* 4 */
+ void *reserved5;
+ TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 6 */
+ TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char * fname, int mode)); /* 7 */
+ int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 8 */
+ TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */
+ void (*tclWinConvertWSAError) _ANSI_ARGS_((DWORD errCode)); /* 1 */
+ struct servent * (*tclWinGetServByName) _ANSI_ARGS_((CONST char * nm, CONST char * proto)); /* 2 */
+ int (*tclWinGetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, char FAR * optval, int FAR * optlen)); /* 3 */
+ HINSTANCE (*tclWinGetTclInstance) _ANSI_ARGS_((void)); /* 4 */
+ void *reserved5;
+ u_short (*tclWinNToHS) _ANSI_ARGS_((u_short ns)); /* 6 */
+ int (*tclWinSetSockOpt) _ANSI_ARGS_((SOCKET s, int level, int optname, CONST char FAR * optval, int optlen)); /* 7 */
+ unsigned long (*tclpGetPid) _ANSI_ARGS_((Tcl_Pid pid)); /* 8 */
+ int (*tclWinGetPlatformId) _ANSI_ARGS_((void)); /* 9 */
+ void *reserved10;
+ void (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 11 */
+ int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 12 */
+ Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid * pidPtr)); /* 13 */
+ int (*tclpCreatePipe) _ANSI_ARGS_((TclFile * readPipe, TclFile * writePipe)); /* 14 */
+ int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)); /* 15 */
+ void *reserved16;
+ void *reserved17;
+ TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 18 */
+ TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char * fname, int mode)); /* 19 */
+ void (*tclWinAddProcess) _ANSI_ARGS_((HANDLE hProcess, DWORD id)); /* 20 */
+ void (*tclpAsyncMark) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 21 */
+ TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 22 */
+ char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 23 */
+ char * (*tclWinNoBackslash) _ANSI_ARGS_((char * path)); /* 24 */
+ TclPlatformType * (*tclWinGetPlatform) _ANSI_ARGS_((void)); /* 25 */
+ void (*tclWinSetInterfaces) _ANSI_ARGS_((int wide)); /* 26 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ VOID * (*tclpSysAlloc) _ANSI_ARGS_((long size, int isBin)); /* 0 */
+ void (*tclpSysFree) _ANSI_ARGS_((VOID * ptr)); /* 1 */
+ VOID * (*tclpSysRealloc) _ANSI_ARGS_((VOID * cp, unsigned int size)); /* 2 */
+ void (*tclpExit) _ANSI_ARGS_((int status)); /* 3 */
+ int (*fSpGetDefaultDir) _ANSI_ARGS_((FSSpecPtr theSpec)); /* 4 */
+ int (*fSpSetDefaultDir) _ANSI_ARGS_((FSSpecPtr theSpec)); /* 5 */
+ OSErr (*fSpFindFolder) _ANSI_ARGS_((short vRefNum, OSType folderType, Boolean createFolder, FSSpec * spec)); /* 6 */
+ void (*getGlobalMouse) _ANSI_ARGS_((Point * mouse)); /* 7 */
+ pascal OSErr (*fSpGetDirectoryID) _ANSI_ARGS_((CONST FSSpec * spec, long * theDirID, Boolean * isDirectory)); /* 8 */
+ pascal short (*fSpOpenResFileCompat) _ANSI_ARGS_((CONST FSSpec * spec, SignedByte permission)); /* 9 */
+ pascal void (*fSpCreateResFileCompat) _ANSI_ARGS_((CONST FSSpec * spec, OSType creator, OSType fileType, ScriptCode scriptTag)); /* 10 */
+ int (*fSpLocationFromPath) _ANSI_ARGS_((int length, CONST char * path, FSSpecPtr theSpec)); /* 11 */
+ OSErr (*fSpPathFromLocation) _ANSI_ARGS_((FSSpecPtr theSpec, int * length, Handle * fullPath)); /* 12 */
+ void (*tclMacExitHandler) _ANSI_ARGS_((void)); /* 13 */
+ void (*tclMacInitExitToShell) _ANSI_ARGS_((int usePatch)); /* 14 */
+ OSErr (*tclMacInstallExitToShellPatch) _ANSI_ARGS_((ExitToShellProcPtr newProc)); /* 15 */
+ int (*tclMacOSErrorToPosixError) _ANSI_ARGS_((int error)); /* 16 */
+ void (*tclMacRemoveTimer) _ANSI_ARGS_((void * timerToken)); /* 17 */
+ void * (*tclMacStartTimer) _ANSI_ARGS_((long ms)); /* 18 */
+ int (*tclMacTimerExpired) _ANSI_ARGS_((void * timerToken)); /* 19 */
+ int (*tclMacRegisterResourceFork) _ANSI_ARGS_((short fileRef, Tcl_Obj * tokenPtr, int insert)); /* 20 */
+ short (*tclMacUnRegisterResourceFork) _ANSI_ARGS_((char * tokenPtr, Tcl_Obj * resultPtr)); /* 21 */
+ int (*tclMacCreateEnv) _ANSI_ARGS_((void)); /* 22 */
+ FILE * (*tclMacFOpenHack) _ANSI_ARGS_((CONST char * path, CONST char * mode)); /* 23 */
+ void *reserved24;
+ int (*tclMacChmod) _ANSI_ARGS_((char * path, int mode)); /* 25 */
+#endif /* MAC_TCL */
+} TclIntPlatStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TclIntPlatStubs *tclIntPlatStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclGetAndDetachPids
+#define TclGetAndDetachPids \
+ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
+#endif
+#ifndef TclpCloseFile
+#define TclpCloseFile \
+ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
+#endif
+#ifndef TclpCreateCommandChannel
+#define TclpCreateCommandChannel \
+ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
+#endif
+#ifndef TclpCreatePipe
+#define TclpCreatePipe \
+ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
+#endif
+#ifndef TclpCreateProcess
+#define TclpCreateProcess \
+ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
+#endif
+/* Slot 5 is reserved */
+#ifndef TclpMakeFile
+#define TclpMakeFile \
+ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
+#endif
+#ifndef TclpOpenFile
+#define TclpOpenFile \
+ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
+#endif
+#ifndef TclUnixWaitForFile
+#define TclUnixWaitForFile \
+ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
+#endif
+#ifndef TclpCreateTempFile
+#define TclpCreateTempFile \
+ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclWinConvertError
+#define TclWinConvertError \
+ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
+#endif
+#ifndef TclWinConvertWSAError
+#define TclWinConvertWSAError \
+ (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
+#endif
+#ifndef TclWinGetServByName
+#define TclWinGetServByName \
+ (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
+#endif
+#ifndef TclWinGetSockOpt
+#define TclWinGetSockOpt \
+ (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
+#endif
+#ifndef TclWinGetTclInstance
+#define TclWinGetTclInstance \
+ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
+#endif
+/* Slot 5 is reserved */
+#ifndef TclWinNToHS
+#define TclWinNToHS \
+ (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
+#endif
+#ifndef TclWinSetSockOpt
+#define TclWinSetSockOpt \
+ (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
+#endif
+#ifndef TclpGetPid
+#define TclpGetPid \
+ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */
+#endif
+#ifndef TclWinGetPlatformId
+#define TclWinGetPlatformId \
+ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
+#endif
+/* Slot 10 is reserved */
+#ifndef TclGetAndDetachPids
+#define TclGetAndDetachPids \
+ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
+#endif
+#ifndef TclpCloseFile
+#define TclpCloseFile \
+ (tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
+#endif
+#ifndef TclpCreateCommandChannel
+#define TclpCreateCommandChannel \
+ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
+#endif
+#ifndef TclpCreatePipe
+#define TclpCreatePipe \
+ (tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
+#endif
+#ifndef TclpCreateProcess
+#define TclpCreateProcess \
+ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
+#endif
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+#ifndef TclpMakeFile
+#define TclpMakeFile \
+ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
+#endif
+#ifndef TclpOpenFile
+#define TclpOpenFile \
+ (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
+#endif
+#ifndef TclWinAddProcess
+#define TclWinAddProcess \
+ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
+#endif
+#ifndef TclpAsyncMark
+#define TclpAsyncMark \
+ (tclIntPlatStubsPtr->tclpAsyncMark) /* 21 */
+#endif
+#ifndef TclpCreateTempFile
+#define TclpCreateTempFile \
+ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
+#endif
+#ifndef TclpGetTZName
+#define TclpGetTZName \
+ (tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
+#endif
+#ifndef TclWinNoBackslash
+#define TclWinNoBackslash \
+ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
+#endif
+#ifndef TclWinGetPlatform
+#define TclWinGetPlatform \
+ (tclIntPlatStubsPtr->tclWinGetPlatform) /* 25 */
+#endif
+#ifndef TclWinSetInterfaces
+#define TclWinSetInterfaces \
+ (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TclpSysAlloc
+#define TclpSysAlloc \
+ (tclIntPlatStubsPtr->tclpSysAlloc) /* 0 */
+#endif
+#ifndef TclpSysFree
+#define TclpSysFree \
+ (tclIntPlatStubsPtr->tclpSysFree) /* 1 */
+#endif
+#ifndef TclpSysRealloc
+#define TclpSysRealloc \
+ (tclIntPlatStubsPtr->tclpSysRealloc) /* 2 */
+#endif
+#ifndef TclpExit
+#define TclpExit \
+ (tclIntPlatStubsPtr->tclpExit) /* 3 */
+#endif
+#ifndef FSpGetDefaultDir
+#define FSpGetDefaultDir \
+ (tclIntPlatStubsPtr->fSpGetDefaultDir) /* 4 */
+#endif
+#ifndef FSpSetDefaultDir
+#define FSpSetDefaultDir \
+ (tclIntPlatStubsPtr->fSpSetDefaultDir) /* 5 */
+#endif
+#ifndef FSpFindFolder
+#define FSpFindFolder \
+ (tclIntPlatStubsPtr->fSpFindFolder) /* 6 */
+#endif
+#ifndef GetGlobalMouse
+#define GetGlobalMouse \
+ (tclIntPlatStubsPtr->getGlobalMouse) /* 7 */
+#endif
+#ifndef FSpGetDirectoryID
+#define FSpGetDirectoryID \
+ (tclIntPlatStubsPtr->fSpGetDirectoryID) /* 8 */
+#endif
+#ifndef FSpOpenResFileCompat
+#define FSpOpenResFileCompat \
+ (tclIntPlatStubsPtr->fSpOpenResFileCompat) /* 9 */
+#endif
+#ifndef FSpCreateResFileCompat
+#define FSpCreateResFileCompat \
+ (tclIntPlatStubsPtr->fSpCreateResFileCompat) /* 10 */
+#endif
+#ifndef FSpLocationFromPath
+#define FSpLocationFromPath \
+ (tclIntPlatStubsPtr->fSpLocationFromPath) /* 11 */
+#endif
+#ifndef FSpPathFromLocation
+#define FSpPathFromLocation \
+ (tclIntPlatStubsPtr->fSpPathFromLocation) /* 12 */
+#endif
+#ifndef TclMacExitHandler
+#define TclMacExitHandler \
+ (tclIntPlatStubsPtr->tclMacExitHandler) /* 13 */
+#endif
+#ifndef TclMacInitExitToShell
+#define TclMacInitExitToShell \
+ (tclIntPlatStubsPtr->tclMacInitExitToShell) /* 14 */
+#endif
+#ifndef TclMacInstallExitToShellPatch
+#define TclMacInstallExitToShellPatch \
+ (tclIntPlatStubsPtr->tclMacInstallExitToShellPatch) /* 15 */
+#endif
+#ifndef TclMacOSErrorToPosixError
+#define TclMacOSErrorToPosixError \
+ (tclIntPlatStubsPtr->tclMacOSErrorToPosixError) /* 16 */
+#endif
+#ifndef TclMacRemoveTimer
+#define TclMacRemoveTimer \
+ (tclIntPlatStubsPtr->tclMacRemoveTimer) /* 17 */
+#endif
+#ifndef TclMacStartTimer
+#define TclMacStartTimer \
+ (tclIntPlatStubsPtr->tclMacStartTimer) /* 18 */
+#endif
+#ifndef TclMacTimerExpired
+#define TclMacTimerExpired \
+ (tclIntPlatStubsPtr->tclMacTimerExpired) /* 19 */
+#endif
+#ifndef TclMacRegisterResourceFork
+#define TclMacRegisterResourceFork \
+ (tclIntPlatStubsPtr->tclMacRegisterResourceFork) /* 20 */
+#endif
+#ifndef TclMacUnRegisterResourceFork
+#define TclMacUnRegisterResourceFork \
+ (tclIntPlatStubsPtr->tclMacUnRegisterResourceFork) /* 21 */
+#endif
+#ifndef TclMacCreateEnv
+#define TclMacCreateEnv \
+ (tclIntPlatStubsPtr->tclMacCreateEnv) /* 22 */
+#endif
+#ifndef TclMacFOpenHack
+#define TclMacFOpenHack \
+ (tclIntPlatStubsPtr->tclMacFOpenHack) /* 23 */
+#endif
+/* Slot 24 is reserved */
+#ifndef TclMacChmod
+#define TclMacChmod \
+ (tclIntPlatStubsPtr->tclMacChmod) /* 25 */
+#endif
+#endif /* MAC_TCL */
+
+#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#endif /* _TCLINTPLATDECLS */
+
diff --git a/tcl/generic/tclInterp.c b/tcl/generic/tclInterp.c
index b4c0cd5203e..96d2e27d418 100644
--- a/tcl/generic/tclInterp.c
+++ b/tcl/generic/tclInterp.c
@@ -21,6 +21,42 @@
*/
static int aliasCounter = 0;
+TCL_DECLARE_MUTEX(cntMutex)
+
+/*
+ * struct Alias:
+ *
+ * Stores information about an alias. Is stored in the slave interpreter
+ * and used by the source command to find the target command in the master
+ * when the source command is invoked.
+ */
+
+typedef struct Alias {
+ Tcl_Obj *namePtr; /* Name of alias command in slave interp. */
+ Tcl_Interp *targetInterp; /* Interp in which target command will be
+ * invoked. */
+ Tcl_Obj *prefixPtr; /* Tcl list making up the prefix of the
+ * target command to be invoked in the target
+ * interpreter. Additional arguments
+ * specified when calling the alias in the
+ * slave interp will be appended to the prefix
+ * before the command is invoked. */
+ Tcl_Command slaveCmd; /* Source command in slave interpreter,
+ * bound to command that invokes the target
+ * command in the target interpreter. */
+ Tcl_HashEntry *aliasEntryPtr;
+ /* Entry for the alias hash table in slave.
+ * This is used by alias deletion to remove
+ * the alias from the slave interpreter
+ * alias table. */
+ Tcl_HashEntry *targetEntryPtr;
+ /* Entry for target command in master.
+ * This is used in the master interpreter to
+ * map back from the target command to aliases
+ * redirecting to it. Random access to this
+ * hash table is never required - we are using
+ * a hash table only for convenience. */
+} Alias;
/*
*
@@ -31,13 +67,14 @@ static int aliasCounter = 0;
* a slave interpreter, e.g. what aliases are defined in it.
*/
-typedef struct {
+typedef struct Slave {
Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
- Tcl_HashEntry *slaveEntry; /* Hash entry in masters slave table for
- * this slave interpreter. Used to find
+ Tcl_HashEntry *slaveEntryPtr;
+ /* Hash entry in masters slave table for
+ * this slave interpreter. Used to find
* this record, and used when deleting the
* slave interpreter to delete it from the
- * masters table. */
+ * master's table. */
Tcl_Interp *slaveInterp; /* The slave interpreter. */
Tcl_Command interpCmd; /* Interpreter object command. */
Tcl_HashTable aliasTable; /* Table which maps from names of commands
@@ -46,33 +83,6 @@ typedef struct {
} Slave;
/*
- * struct Alias:
- *
- * Stores information about an alias. Is stored in the slave interpreter
- * and used by the source command to find the target command in the master
- * when the source command is invoked.
- */
-
-typedef struct {
- char *aliasName; /* Name of alias command. */
- char *targetName; /* Name of target command in master interp. */
- Tcl_Interp *targetInterp; /* Master interpreter. */
- int objc; /* Count of additional args to pass. */
- Tcl_Obj **objv; /* Actual additional args to pass. */
- Tcl_HashEntry *aliasEntry; /* Entry for the alias hash table in slave.
- * This is used by alias deletion to remove
- * the alias from the slave interpreter
- * alias table. */
- Tcl_HashEntry *targetEntry; /* Entry for target command in master.
- * This is used in the master interpreter to
- * map back from the target command to aliases
- * redirecting to it. Random access to this
- * hash table is never required - we are using
- * a hash table only for convenience. */
- Tcl_Command slaveCmd; /* Source command in slave interpreter. */
-} Alias;
-
-/*
* struct Target:
*
* Maps from master interpreter commands back to the source commands in slave
@@ -86,7 +96,7 @@ typedef struct {
* the master is deleted.
*/
-typedef struct {
+typedef struct Target {
Tcl_Command slaveCmd; /* Command for alias in slave interp. */
Tcl_Interp *slaveInterp; /* Slave Interpreter. */
} Target;
@@ -107,7 +117,7 @@ typedef struct {
* interpreters and can only load safe extensions.
*/
-typedef struct {
+typedef struct Master {
Tcl_HashTable slaveTable; /* Hash table for slave interpreters.
* Maps from command names to Slave records. */
Tcl_HashTable targetTable; /* Hash table for Target Records. Contains
@@ -120,718 +130,978 @@ typedef struct {
} Master;
/*
+ * The following structure keeps track of all the Master and Slave information
+ * on a per-interp basis.
+ */
+
+typedef struct InterpInfo {
+ Master master; /* Keeps track of all interps for which this
+ * interp is the Master. */
+ Slave slave; /* Information necessary for this interp to
+ * function as a slave. */
+} InterpInfo;
+
+/*
* Prototypes for local static procedures:
*/
-static int AliasCmd _ANSI_ARGS_((ClientData dummy,
+static int AliasCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
+ Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
+ Tcl_Obj *CONST objv[]));
+static int AliasDelete _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, Tcl_Obj *namePtr));
+static int AliasDescribe _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, Tcl_Obj *objPtr));
+static int AliasList _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp));
+static int AliasObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *currentInterp, int objc,
Tcl_Obj *CONST objv[]));
-static void AliasCmdDeleteProc _ANSI_ARGS_((
+static void AliasObjCmdDeleteProc _ANSI_ARGS_((
ClientData clientData));
-static int AliasCreationHelper _ANSI_ARGS_((Tcl_Interp *curInterp,
- Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
- Master *masterPtr, char *aliasName,
- char *targetName, int objc,
+
+static Tcl_Interp * GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *pathPtr));
+static Tcl_Interp * GetInterp2 _ANSI_ARGS_((Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
-static int CreateInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static Tcl_Interp *CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, char *slavePath, int safe));
-static int DeleteAlias _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, char *aliasName));
-static int DescribeAlias _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, char *aliasName));
-static int DeleteInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int DeleteOneInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, char *path));
-static Tcl_Interp *GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, char *path,
- Master **masterPtrPtr));
-static int GetTarget _ANSI_ARGS_((Tcl_Interp *interp, char *path,
- char *aliasName));
-static int InterpAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpAliasesHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpExistsHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpEvalHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpExposeHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpIsSafeHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpHideHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpHiddenHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpInvokeHiddenHelper _ANSI_ARGS_((
- Tcl_Interp *interp, Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpMarkTrustedHelper _ANSI_ARGS_((
- Tcl_Interp *interp, Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpSlavesHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpShareHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpTargetHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int InterpTransferHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Master *masterPtr, int objc,
- Tcl_Obj *CONST objv[]));
-static int MarkTrusted _ANSI_ARGS_((Tcl_Interp *interp));
-static void MasterRecordDeleteProc _ANSI_ARGS_((
+static void InterpInfoDeleteProc _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp));
-static int SlaveAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Slave *slavePtr,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveAliasesHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Slave *slavePtr,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveEvalHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Slave *slavePtr,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveExposeHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Slave *slavePtr,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveHideHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Slave *slavePtr,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveHiddenHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Slave *slavePtr,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveIsSafeHelper _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Interp *slaveInterp,
- Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
-static int SlaveInvokeHiddenHelper _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Interp *slaveInterp,
- Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
-static int SlaveMarkTrustedHelper _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *slaveInterp, Slave *slavePtr,
- int objc, Tcl_Obj *CONST objv[]));
-static int SlaveObjectCmd _ANSI_ARGS_((ClientData dummy,
+static Tcl_Interp * SlaveCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *pathPtr, int safe));
+static int SlaveEval _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int SlaveExpose _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int SlaveHide _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int SlaveHidden _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp));
+static int SlaveInvokeHidden _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, int global, int objc,
+ Tcl_Obj *CONST objv[]));
+static int SlaveMarkTrusted _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp));
+static int SlaveObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
-static void SlaveObjectDeleteProc _ANSI_ARGS_((
+static void SlaveObjCmdDeleteProc _ANSI_ARGS_((
ClientData clientData));
-static void SlaveRecordDeleteProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclPreventAliasLoop --
+ * TclInterpInit --
*
- * When defining an alias or renaming a command, prevent an alias
- * loop from being formed.
+ * Initializes the invoking interpreter for using the master, slave
+ * and safe interp facilities. This is called from inside
+ * Tcl_CreateInterp().
*
* Results:
- * A standard Tcl object result.
+ * Always returns TCL_OK for backwards compatibility.
*
* Side effects:
- * If TCL_ERROR is returned, the function also stores an error message
- * in the interpreter's result object.
- *
- * NOTE:
- * This function is public internal (instead of being static to
- * this file) because it is also used from TclRenameCommand.
+ * Adds the "interp" command to an interpreter and initializes the
+ * interpInfoPtr field of the invoking interpreter.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
-TclPreventAliasLoop(interp, cmdInterp, cmd)
- Tcl_Interp *interp; /* Interp in which to report errors. */
- Tcl_Interp *cmdInterp; /* Interp in which the command is
- * being defined. */
- Tcl_Command cmd; /* Tcl command we are attempting
- * to define. */
+TclInterpInit(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
{
- Command *cmdPtr = (Command *) cmd;
- Alias *aliasPtr, *nextAliasPtr;
- Tcl_Command aliasCmd;
- Command *aliasCmdPtr;
-
- /*
- * If we are not creating or renaming an alias, then it is
- * always OK to create or rename the command.
- */
-
- if (cmdPtr->objProc != AliasCmd) {
- return TCL_OK;
- }
-
- /*
- * OK, we are dealing with an alias, so traverse the chain of aliases.
- * If we encounter the alias we are defining (or renaming to) any in
- * the chain then we have a loop.
- */
-
- aliasPtr = (Alias *) cmdPtr->objClientData;
- nextAliasPtr = aliasPtr;
- while (1) {
+ InterpInfo *interpInfoPtr;
+ Master *masterPtr;
+ Slave *slavePtr;
- /*
- * If the target of the next alias in the chain is the same as
- * the source alias, we have a loop.
- */
+ interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
+ ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr;
- aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
- nextAliasPtr->targetName,
- Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
- /*flags*/ 0);
- if (aliasCmd == (Tcl_Command) NULL) {
- return TCL_OK;
- }
- aliasCmdPtr = (Command *) aliasCmd;
- if (aliasCmdPtr == cmdPtr) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "cannot define or rename alias \"", aliasPtr->aliasName,
- "\": would create a loop", (char *) NULL);
- return TCL_ERROR;
- }
+ masterPtr = &interpInfoPtr->master;
+ Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&masterPtr->targetTable, TCL_ONE_WORD_KEYS);
- /*
- * Otherwise, follow the chain one step further. See if the target
- * command is an alias - if so, follow the loop to its target
- * command. Otherwise we do not have a loop.
- */
+ slavePtr = &interpInfoPtr->slave;
+ slavePtr->masterInterp = NULL;
+ slavePtr->slaveEntryPtr = NULL;
+ slavePtr->slaveInterp = interp;
+ slavePtr->interpCmd = NULL;
+ Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
- if (aliasCmdPtr->objProc != AliasCmd) {
- return TCL_OK;
- }
- nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
- }
+ Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);
- /* NOTREACHED */
+ Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
+ return TCL_OK;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * MarkTrusted --
+ * InterpInfoDeleteProc --
*
- * Mark an interpreter as unsafe (i.e. remove the "safe" mark).
+ * Invoked when an interpreter is being deleted. It releases all
+ * storage used by the master/slave/safe interpreter facilities.
*
* Results:
- * A standard Tcl result.
+ * None.
*
* Side effects:
- * Removes the "safe" mark from an interpreter.
+ * Cleans up storage. Sets the interpInfoPtr field of the interp
+ * to NULL.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-static int
-MarkTrusted(interp)
- Tcl_Interp *interp; /* Interpreter to be marked unsafe. */
+static void
+InterpInfoDeleteProc(clientData, interp)
+ ClientData clientData; /* Ignored. */
+ Tcl_Interp *interp; /* Interp being deleted. All commands for
+ * slave interps should already be deleted. */
{
- Interp *iPtr = (Interp *) interp;
+ InterpInfo *interpInfoPtr;
+ Slave *slavePtr;
+ Master *masterPtr;
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry *hPtr;
+ Target *targetPtr;
- iPtr->flags &= ~SAFE_INTERP;
- return TCL_OK;
+ interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
+
+ /*
+ * There shouldn't be any commands left.
+ */
+
+ masterPtr = &interpInfoPtr->master;
+ if (masterPtr->slaveTable.numEntries != 0) {
+ panic("InterpInfoDeleteProc: still exist commands");
+ }
+ Tcl_DeleteHashTable(&masterPtr->slaveTable);
+
+ /*
+ * Tell any interps that have aliases to this interp that they should
+ * delete those aliases. If the other interp was already dead, it
+ * would have removed the target record already.
+ */
+
+ hPtr = Tcl_FirstHashEntry(&masterPtr->targetTable, &hSearch);
+ while (hPtr != NULL) {
+ targetPtr = (Target *) Tcl_GetHashValue(hPtr);
+ Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
+ targetPtr->slaveCmd);
+ hPtr = Tcl_NextHashEntry(&hSearch);
+ }
+ Tcl_DeleteHashTable(&masterPtr->targetTable);
+
+ slavePtr = &interpInfoPtr->slave;
+ if (slavePtr->interpCmd != NULL) {
+ /*
+ * Tcl_DeleteInterp() was called on this interpreter, rather
+ * "interp delete" or the equivalent deletion of the command in the
+ * master. First ensure that the cleanup callback doesn't try to
+ * delete the interp again.
+ */
+
+ slavePtr->slaveInterp = NULL;
+ Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
+ slavePtr->interpCmd);
+ }
+
+ /*
+ * There shouldn't be any aliases left.
+ */
+
+ if (slavePtr->aliasTable.numEntries != 0) {
+ panic("InterpInfoDeleteProc: still exist aliases");
+ }
+ Tcl_DeleteHashTable(&slavePtr->aliasTable);
+
+ ckfree((char *) interpInfoPtr);
}
/*
*----------------------------------------------------------------------
*
- * Tcl_MakeSafe --
+ * Tcl_InterpObjCmd --
*
- * Makes its argument interpreter contain only functionality that is
- * defined to be part of Safe Tcl. Unsafe commands are hidden, the
- * env array is unset, and the standard channels are removed.
+ * This procedure is invoked to process the "interp" Tcl command.
+ * See the user documentation for details on what it does.
*
* Results:
- * None.
+ * A standard Tcl result.
*
* Side effects:
- * Hides commands in its argument interpreter, and removes settings
- * and channels.
+ * See the user documentation.
*
*----------------------------------------------------------------------
*/
-
+ /* ARGSUSED */
int
-Tcl_MakeSafe(interp)
- Tcl_Interp *interp; /* Interpreter to be made safe. */
+Tcl_InterpObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Unused. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_Channel chan; /* Channel to remove from
- * safe interpreter. */
- Interp *iPtr = (Interp *) interp;
+ int index;
+ static char *options[] = {
+ "alias", "aliases", "create", "delete",
+ "eval", "exists", "expose", "hide",
+ "hidden", "issafe", "invokehidden", "marktrusted",
+ "slaves", "share", "target", "transfer",
+ NULL
+ };
+ enum option {
+ OPT_ALIAS, OPT_ALIASES, OPT_CREATE, OPT_DELETE,
+ OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE,
+ OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID, OPT_MARKTRUSTED,
+ OPT_SLAVES, OPT_SHARE, OPT_TARGET, OPT_TRANSFER
+ };
- TclHideUnsafeCommands(interp);
-
- iPtr->flags |= SAFE_INTERP;
- /*
- * Unsetting variables : (which should not have been set
- * in the first place, but...)
- */
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum option) index) {
+ case OPT_ALIAS: {
+ Tcl_Interp *slaveInterp, *masterInterp;
- /*
- * No env array in a safe slave.
- */
+ if (objc < 4) {
+ aliasArgs:
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == (Tcl_Interp *) NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ return AliasDescribe(interp, slaveInterp, objv[3]);
+ }
+ if ((objc == 5) && (Tcl_GetString(objv[4])[0] == '\0')) {
+ return AliasDelete(interp, slaveInterp, objv[3]);
+ }
+ if (objc > 5) {
+ masterInterp = GetInterp(interp, objv[4]);
+ if (masterInterp == (Tcl_Interp *) NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetString(objv[5])[0] == '\0') {
+ if (objc == 6) {
+ return AliasDelete(interp, slaveInterp, objv[3]);
+ }
+ } else {
+ return AliasCreate(interp, slaveInterp, masterInterp,
+ objv[3], objv[5], objc - 6, objv + 6);
+ }
+ }
+ goto aliasArgs;
+ }
+ case OPT_ALIASES: {
+ Tcl_Interp *slaveInterp;
- Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);
+ slaveInterp = GetInterp2(interp, objc, objv);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ return AliasList(interp, slaveInterp);
+ }
+ case OPT_CREATE: {
+ int i, last, safe;
+ Tcl_Obj *slavePtr;
+ char buf[16 + TCL_INTEGER_SPACE];
+ static char *options[] = {
+ "-safe", "--", NULL
+ };
+ enum option {
+ OPT_SAFE, OPT_LAST
+ };
+
+ safe = Tcl_IsSafe(interp);
+
+ /*
+ * Weird historical rules: "-safe" is accepted at the end, too.
+ */
+
+ slavePtr = NULL;
+ last = 0;
+ for (i = 2; i < objc; i++) {
+ if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_SAFE) {
+ safe = 1;
+ continue;
+ }
+ i++;
+ last = 1;
+ }
+ if (slavePtr != NULL) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
+ return TCL_ERROR;
+ }
+ slavePtr = objv[i];
+ }
+ buf[0] = '\0';
+ if (slavePtr == NULL) {
+ /*
+ * Create an anonymous interpreter -- we choose its name and
+ * the name of the command. We check that the command name
+ * that we use for the interpreter does not collide with an
+ * existing command in the master interpreter.
+ */
+
+ for (i = 0; ; i++) {
+ Tcl_CmdInfo cmdInfo;
+
+ sprintf(buf, "interp%d", i);
+ if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
+ break;
+ }
+ }
+ slavePtr = Tcl_NewStringObj(buf, -1);
+ }
+ if (SlaveCreate(interp, slavePtr, safe) == NULL) {
+ if (buf[0] != '\0') {
+ Tcl_DecrRefCount(slavePtr);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, slavePtr);
+ return TCL_OK;
+ }
+ case OPT_DELETE: {
+ int i;
+ InterpInfo *iiPtr;
+ Tcl_Interp *slaveInterp;
+
+ for (i = 2; i < objc; i++) {
+ slaveInterp = GetInterp(interp, objv[i]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ } else if (slaveInterp == interp) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot delete the current interpreter",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
+ Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,
+ iiPtr->slave.interpCmd);
+ }
+ return TCL_OK;
+ }
+ case OPT_EVAL: {
+ Tcl_Interp *slaveInterp;
- /*
- * Remove unsafe parts of tcl_platform
- */
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
+ }
+ case OPT_EXISTS: {
+ int exists;
+ Tcl_Interp *slaveInterp;
+
+ exists = 1;
+ slaveInterp = GetInterp2(interp, objc, objv);
+ if (slaveInterp == NULL) {
+ if (objc > 3) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
+ exists = 0;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), exists);
+ return TCL_OK;
+ }
+ case OPT_EXPOSE: {
+ Tcl_Interp *slaveInterp;
- Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
- Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
- Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
+ if ((objc < 4) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "path hiddenCmdName ?cmdName?");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
+ }
+ case OPT_HIDE: {
+ Tcl_Interp *slaveInterp; /* A slave. */
- /*
- * Unset path informations variables
- * (the only one remaining is [info nameofexecutable])
- */
+ if ((objc < 4) || (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "path cmdName ?hiddenCmdName?");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == (Tcl_Interp *) NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
+ }
+ case OPT_HIDDEN: {
+ Tcl_Interp *slaveInterp; /* A slave. */
- Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
- Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
- Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);
-
- /*
- * Remove the standard channels from the interpreter; safe interpreters
- * do not ordinarily have access to stdin, stdout and stderr.
- *
- * NOTE: These channels are not added to the interpreter by the
- * Tcl_CreateInterp call, but may be added later, by another I/O
- * operation. We want to ensure that the interpreter does not have
- * these channels even if it is being made safe after being used for
- * some time..
- */
+ slaveInterp = GetInterp2(interp, objc, objv);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveHidden(interp, slaveInterp);
+ }
+ case OPT_ISSAFE: {
+ Tcl_Interp *slaveInterp;
- chan = Tcl_GetStdChannel(TCL_STDIN);
- if (chan != (Tcl_Channel) NULL) {
- Tcl_UnregisterChannel(interp, chan);
- }
- chan = Tcl_GetStdChannel(TCL_STDOUT);
- if (chan != (Tcl_Channel) NULL) {
- Tcl_UnregisterChannel(interp, chan);
- }
- chan = Tcl_GetStdChannel(TCL_STDERR);
- if (chan != (Tcl_Channel) NULL) {
- Tcl_UnregisterChannel(interp, chan);
- }
+ slaveInterp = GetInterp2(interp, objc, objv);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));
+ return TCL_OK;
+ }
+ case OPT_INVOKEHID: {
+ int i, index, global;
+ Tcl_Interp *slaveInterp;
+ static char *hiddenOptions[] = {
+ "-global", "--", NULL
+ };
+ enum hiddenOption {
+ OPT_GLOBAL, OPT_LAST
+ };
+
+ global = 0;
+ for (i = 3; i < objc; i++) {
+ if (Tcl_GetString(objv[i])[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,
+ "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_GLOBAL) {
+ global = 1;
+ } else {
+ i++;
+ break;
+ }
+ }
+ if (objc - i < 1) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "path ?-global? ?--? cmd ?arg ..?");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == (Tcl_Interp *) NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,
+ objv + i);
+ }
+ case OPT_MARKTRUSTED: {
+ Tcl_Interp *slaveInterp;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "path");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveMarkTrusted(interp, slaveInterp);
+ }
+ case OPT_SLAVES: {
+ Tcl_Interp *slaveInterp;
+ InterpInfo *iiPtr;
+ Tcl_Obj *resultPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hashSearch;
+ char *string;
+
+ slaveInterp = GetInterp2(interp, objc, objv);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
+ resultPtr = Tcl_GetObjResult(interp);
+ hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
+ string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(string, -1));
+ }
+ return TCL_OK;
+ }
+ case OPT_SHARE: {
+ Tcl_Interp *slaveInterp; /* A slave. */
+ Tcl_Interp *masterInterp; /* Its master. */
+ Tcl_Channel chan;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
+ return TCL_ERROR;
+ }
+ masterInterp = GetInterp(interp, objv[2]);
+ if (masterInterp == NULL) {
+ return TCL_ERROR;
+ }
+ chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]),
+ NULL);
+ if (chan == NULL) {
+ TclTransferResult(masterInterp, TCL_OK, interp);
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[4]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_RegisterChannel(slaveInterp, chan);
+ return TCL_OK;
+ }
+ case OPT_TARGET: {
+ Tcl_Interp *slaveInterp;
+ InterpInfo *iiPtr;
+ Tcl_HashEntry *hPtr;
+ Alias *aliasPtr;
+ char *aliasName;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "path alias");
+ return TCL_ERROR;
+ }
+
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+
+ aliasName = Tcl_GetString(objv[3]);
+ iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
+ hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
+ if (hPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "alias \"", aliasName, "\" in path \"",
+ Tcl_GetString(objv[2]), "\" not found",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "target interpreter for alias \"", aliasName,
+ "\" in path \"", Tcl_GetString(objv[2]),
+ "\" is not my descendant", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+ case OPT_TRANSFER: {
+ Tcl_Interp *slaveInterp; /* A slave. */
+ Tcl_Interp *masterInterp; /* Its master. */
+ Tcl_Channel chan;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "srcPath channelId destPath");
+ return TCL_ERROR;
+ }
+ masterInterp = GetInterp(interp, objv[2]);
+ if (masterInterp == NULL) {
+ return TCL_ERROR;
+ }
+ chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]), NULL);
+ if (chan == NULL) {
+ TclTransferResult(masterInterp, TCL_OK, interp);
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[4]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_RegisterChannel(slaveInterp, chan);
+ if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
+ TclTransferResult(masterInterp, TCL_OK, interp);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+ }
return TCL_OK;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * GetInterp --
+ * GetInterp2 --
*
- * Helper function to find a slave interpreter given a pathname.
+ * Helper function for Tcl_InterpObjCmd() to convert the interp name
+ * potentially specified on the command line to an Tcl_Interp.
*
* Results:
- * Returns the slave interpreter known by that name in the calling
- * interpreter, or NULL if no interpreter known by that name exists.
+ * The return value is the interp specified on the command line,
+ * or the interp argument itself if no interp was specified on the
+ * command line. If the interp could not be found or the wrong
+ * number of arguments was specified on the command line, the return
+ * value is NULL and an error message is left in the interp's result.
*
* Side effects:
- * Assigns to the pointer variable passed in, if not NULL.
+ * None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-
+
static Tcl_Interp *
-GetInterp(interp, masterPtr, path, masterPtrPtr)
- Tcl_Interp *interp; /* Interp. to start search from. */
- Master *masterPtr; /* Its master record. */
- char *path; /* The path (name) of interp. to be found. */
- Master **masterPtrPtr; /* (Return) its master record. */
+GetInterp2(interp, objc, objv)
+ Tcl_Interp *interp; /* Default interp if no interp was specified
+ * on the command line. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_HashEntry *hPtr; /* Search element. */
- Slave *slavePtr; /* Interim slave record. */
- char **argv; /* Split-up path (name) for interp to find. */
- int argc, i; /* Loop indices. */
- Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */
-
- if (masterPtrPtr != (Master **) NULL) {
- *masterPtrPtr = masterPtr;
- }
-
- if (Tcl_SplitList(interp, path, &argc, &argv) != TCL_OK) {
- return (Tcl_Interp *) NULL;
- }
-
- for (searchInterp = interp, i = 0; i < argc; i++) {
-
- hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), argv[i]);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- ckfree((char *) argv);
- return (Tcl_Interp *) NULL;
- }
- slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
- searchInterp = slavePtr->slaveInterp;
- if (searchInterp == (Tcl_Interp *) NULL) {
- ckfree((char *) argv);
- return (Tcl_Interp *) NULL;
- }
- masterPtr = (Master *) Tcl_GetAssocData(searchInterp,
- "tclMasterRecord", NULL);
- if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
- if (masterPtr == (Master *) NULL) {
- ckfree((char *) argv);
- return (Tcl_Interp *) NULL;
- }
+ if (objc == 2) {
+ return interp;
+ } else if (objc == 3) {
+ return GetInterp(interp, objv[2]);
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?path?");
+ return NULL;
}
- ckfree((char *) argv);
- return searchInterp;
}
/*
*----------------------------------------------------------------------
*
- * CreateSlave --
+ * Tcl_CreateAlias --
*
- * Helper function to do the actual work of creating a slave interp
- * and new object command. Also optionally makes the new slave
- * interpreter "safe".
+ * Creates an alias between two interpreters.
*
* Results:
- * Returns the new Tcl_Interp * if successful or NULL if not. If failed,
- * the result of the invoking interpreter contains an error message.
+ * A standard Tcl result.
*
* Side effects:
- * Creates a new slave interpreter and a new object command.
+ * Creates a new alias, manipulates the result field of slaveInterp.
*
*----------------------------------------------------------------------
*/
-static Tcl_Interp *
-CreateSlave(interp, masterPtr, slavePath, safe)
- Tcl_Interp *interp; /* Interp. to start search from. */
- Master *masterPtr; /* Master record. */
- char *slavePath; /* Path (name) of slave to create. */
- int safe; /* Should we make it "safe"? */
+int
+Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
+ Tcl_Interp *slaveInterp; /* Interpreter for source command. */
+ char *slaveCmd; /* Command to install in slave. */
+ Tcl_Interp *targetInterp; /* Interpreter for target command. */
+ char *targetCmd; /* Name of target command. */
+ int argc; /* How many additional arguments? */
+ char **argv; /* These are the additional args. */
{
- Tcl_Interp *slaveInterp; /* Ptr to slave interpreter. */
- Tcl_Interp *masterInterp; /* Ptr to master interp for slave. */
- Slave *slavePtr; /* Slave record. */
- Tcl_HashEntry *hPtr; /* Entry into interp hashtable. */
- int new; /* Indicates whether new entry. */
- int argc; /* Count of elements in slavePath. */
- char **argv; /* Elements in slavePath. */
- char *masterPath; /* Path to its master. */
-
- if (Tcl_SplitList(interp, slavePath, &argc, &argv) != TCL_OK) {
- return (Tcl_Interp *) NULL;
- }
-
- if (argc < 2) {
- masterInterp = interp;
- if (argc == 1) {
- slavePath = argv[0];
- }
- } else {
- masterPath = Tcl_Merge(argc-1, argv);
- masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
- if (masterInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter named \"", masterPath,
- "\" not found", (char *) NULL);
- ckfree((char *) argv);
- ckfree((char *) masterPath);
- return (Tcl_Interp *) NULL;
- }
- ckfree((char *) masterPath);
- slavePath = argv[argc-1];
- if (!safe) {
- safe = Tcl_IsSafe(masterInterp);
- }
- }
- hPtr = Tcl_CreateHashEntry(&(masterPtr->slaveTable), slavePath, &new);
- if (new == 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter named \"", slavePath,
- "\" already exists, cannot create", (char *) NULL);
- ckfree((char *) argv);
- return (Tcl_Interp *) NULL;
- }
- slaveInterp = Tcl_CreateInterp();
- if (slaveInterp == (Tcl_Interp *) NULL) {
- panic("CreateSlave: out of memory while creating a new interpreter");
+ Tcl_Obj *slaveObjPtr, *targetObjPtr;
+ Tcl_Obj **objv;
+ int i;
+ int result;
+
+ objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
+ for (i = 0; i < argc; i++) {
+ objv[i] = Tcl_NewStringObj(argv[i], -1);
+ Tcl_IncrRefCount(objv[i]);
}
- slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
- slavePtr->masterInterp = masterInterp;
- slavePtr->slaveEntry = hPtr;
- slavePtr->slaveInterp = slaveInterp;
- slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, slavePath,
- SlaveObjectCmd, (ClientData) slaveInterp, SlaveObjectDeleteProc);
- Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
- (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
- SlaveRecordDeleteProc, (ClientData) slavePtr);
- Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
- Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
- /*
- * Inherit the recursion limit.
- */
- ((Interp *)slaveInterp)->maxNestingDepth =
- ((Interp *)masterInterp)->maxNestingDepth ;
+ slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
+ Tcl_IncrRefCount(slaveObjPtr);
- if (safe) {
- if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
- goto error;
- }
- } else {
- if (Tcl_Init(slaveInterp) == TCL_ERROR) {
- goto error;
- }
+ targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
+ Tcl_IncrRefCount(targetObjPtr);
+
+ result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
+ targetObjPtr, argc, objv);
+
+ for (i = 0; i < argc; i++) {
+ Tcl_DecrRefCount(objv[i]);
}
+ ckfree((char *) objv);
+ Tcl_DecrRefCount(targetObjPtr);
+ Tcl_DecrRefCount(slaveObjPtr);
- ckfree((char *) argv);
- return slaveInterp;
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateAliasObj --
+ *
+ * Object version: Creates an alias between two interpreters.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Creates a new alias.
+ *
+ *----------------------------------------------------------------------
+ */
-error:
+int
+Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
+ Tcl_Interp *slaveInterp; /* Interpreter for source command. */
+ char *slaveCmd; /* Command to install in slave. */
+ Tcl_Interp *targetInterp; /* Interpreter for target command. */
+ char *targetCmd; /* Name of target command. */
+ int objc; /* How many additional arguments? */
+ Tcl_Obj *CONST objv[]; /* Argument vector. */
+{
+ Tcl_Obj *slaveObjPtr, *targetObjPtr;
+ int result;
- Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp, "errorInfo", (char *)
- NULL, TCL_GLOBAL_ONLY));
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
- TCL_GLOBAL_ONLY),
- TCL_GLOBAL_ONLY);
+ slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
+ Tcl_IncrRefCount(slaveObjPtr);
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
+ targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
+ Tcl_IncrRefCount(targetObjPtr);
- (void) Tcl_DeleteCommand(masterInterp, slavePath);
+ result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
+ targetObjPtr, objc, objv);
- ckfree((char *) argv);
- return (Tcl_Interp *) NULL;
+ Tcl_DecrRefCount(slaveObjPtr);
+ Tcl_DecrRefCount(targetObjPtr);
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * CreateInterpObject -
+ * Tcl_GetAlias --
*
- * Helper function to do the actual work of creating a new interpreter
- * and an object command.
+ * Gets information about an alias.
*
* Results:
- * A Tcl result.
+ * A standard Tcl result.
*
* Side effects:
- * See user documentation for details.
+ * None.
*
*----------------------------------------------------------------------
*/
-static int
-CreateInterpObject(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Invoking interpreter. */
- Master *masterPtr; /* Master record for same. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* with alias. */
+int
+Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
+ argvPtr)
+ Tcl_Interp *interp; /* Interp to start search from. */
+ char *aliasName; /* Name of alias to find. */
+ Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
+ char **targetNamePtr; /* (Return) name of target command. */
+ int *argcPtr; /* (Return) count of addnl args. */
+ char ***argvPtr; /* (Return) additional arguments. */
{
- int safe; /* Create a safe interpreter? */
- int moreFlags; /* Expecting more flag args? */
- char *string; /* Local pointer to object string. */
- char *slavePath; /* Name of slave. */
- char localSlaveName[200]; /* Local area for creating names. */
- int i; /* Loop counter. */
- int len; /* Length of option argument. */
- static int interpCounter = 0; /* Unique id for created names. */
-
- moreFlags = 1;
- slavePath = NULL;
- safe = Tcl_IsSafe(interp);
+ InterpInfo *iiPtr;
+ Tcl_HashEntry *hPtr;
+ Alias *aliasPtr;
+ int i, objc;
+ Tcl_Obj **objv;
- if ((objc < 2) || (objc > 5)) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
- return TCL_ERROR;
- }
- for (i = 2; i < objc; i++) {
- string = Tcl_GetStringFromObj(objv[i], &len);
- if ((string[0] == '-') && (moreFlags != 0)) {
- if ((string[1] == 's') &&
- (strncmp(string, "-safe", (size_t) len) == 0) &&
- (len > 1)){
- safe = 1;
- } else if ((strncmp(string, "--", (size_t) len) == 0) &&
- (len > 1)) {
- moreFlags = 0;
- } else {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad option \"", string, "\": should be -safe",
- (char *) NULL);
- return TCL_ERROR;
- }
- } else {
- slavePath = string;
- }
+ iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
+ hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
+ if (hPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "alias \"", aliasName, "\" not found", (char *) NULL);
+ return TCL_ERROR;
}
- if (slavePath == (char *) NULL) {
+ aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ Tcl_ListObjGetElements(NULL, aliasPtr->prefixPtr, &objc, &objv);
- /*
- * Create an anonymous interpreter -- we choose its name and
- * the name of the command. We check that the command name that
- * we use for the interpreter does not collide with an existing
- * command in the master interpreter.
- */
-
- while (1) {
- Tcl_CmdInfo cmdInfo;
-
- sprintf(localSlaveName, "interp%d", interpCounter);
- interpCounter++;
- if (!(Tcl_GetCommandInfo(interp, localSlaveName, &cmdInfo))) {
- break;
- }
- }
- slavePath = localSlaveName;
+ if (targetInterpPtr != NULL) {
+ *targetInterpPtr = aliasPtr->targetInterp;
}
- if (CreateSlave(interp, masterPtr, slavePath, safe) != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(slavePath, -1));
- return TCL_OK;
- } else {
- /*
- * CreateSlave already set the result if there was an error,
- * so we do not do it here.
- */
- return TCL_ERROR;
+ if (targetNamePtr != NULL) {
+ *targetNamePtr = Tcl_GetString(objv[0]);
+ }
+ if (argcPtr != NULL) {
+ *argcPtr = objc - 1;
}
+ if (argvPtr != NULL) {
+ *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) * (objc - 1));
+ for (i = 1; i < objc; i++) {
+ *argvPtr[i - 1] = Tcl_GetString(objv[i]);
+ }
+ }
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * DeleteOneInterpObject --
+ * Tcl_ObjGetAlias --
*
- * Helper function for DeleteInterpObject. It deals with deleting one
- * interpreter at a time.
+ * Object version: Gets information about an alias.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Deletes an interpreter and its interpreter object command.
+ * None.
*
*----------------------------------------------------------------------
*/
-static int
-DeleteOneInterpObject(interp, masterPtr, path)
- Tcl_Interp *interp; /* Interpreter for reporting errors. */
- Master *masterPtr; /* Interim storage for master record.*/
- char *path; /* Path of interpreter to delete. */
+int
+Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
+ objvPtr)
+ Tcl_Interp *interp; /* Interp to start search from. */
+ char *aliasName; /* Name of alias to find. */
+ Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
+ char **targetNamePtr; /* (Return) name of target command. */
+ int *objcPtr; /* (Return) count of addnl args. */
+ Tcl_Obj ***objvPtr; /* (Return) additional args. */
{
- Slave *slavePtr; /* Interim storage for slave record. */
- Tcl_Interp *masterInterp; /* Master of interp. to delete. */
- Tcl_HashEntry *hPtr; /* Search element. */
- int localArgc; /* Local copy of count of elements in
- * path (name) of interp. to delete. */
- char **localArgv; /* Local copy of path. */
- char *slaveName; /* Last component in path. */
- char *masterPath; /* One-before-last component in path.*/
-
- if (Tcl_SplitList(interp, path, &localArgc, &localArgv) != TCL_OK) {
+ InterpInfo *iiPtr;
+ Tcl_HashEntry *hPtr;
+ Alias *aliasPtr;
+ int objc;
+ Tcl_Obj **objv;
+
+ iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
+ hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
+ if (hPtr == (Tcl_HashEntry *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad interpreter path \"", path, "\"", (char *) NULL);
+ "alias \"", aliasName, "\" not found", (char *) NULL);
return TCL_ERROR;
}
- if (localArgc < 2) {
- masterInterp = interp;
- if (localArgc == 0) {
- slaveName = "";
- } else {
- slaveName = localArgv[0];
- }
- } else {
- masterPath = Tcl_Merge(localArgc-1, localArgv);
- masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
- if (masterInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter named \"", masterPath, "\" not found",
- (char *) NULL);
- ckfree((char *) localArgv);
- ckfree((char *) masterPath);
- return TCL_ERROR;
- }
- ckfree((char *) masterPath);
- slaveName = localArgv[localArgc-1];
+ aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ Tcl_ListObjGetElements(NULL, aliasPtr->prefixPtr, &objc, &objv);
+
+ if (targetInterpPtr != (Tcl_Interp **) NULL) {
+ *targetInterpPtr = aliasPtr->targetInterp;
}
- hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), slaveName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- ckfree((char *) localArgv);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter named \"", path, "\" not found", (char *) NULL);
- return TCL_ERROR;
+ if (targetNamePtr != (char **) NULL) {
+ *targetNamePtr = Tcl_GetString(objv[0]);
}
- slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
- if (Tcl_DeleteCommandFromToken(masterInterp, slavePtr->interpCmd) != 0) {
- ckfree((char *) localArgv);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter named \"", path, "\" not found", (char *) NULL);
- return TCL_ERROR;
+ if (objcPtr != (int *) NULL) {
+ *objcPtr = objc - 1;
+ }
+ if (objvPtr != (Tcl_Obj ***) NULL) {
+ *objvPtr = objv + 1;
}
- ckfree((char *) localArgv);
-
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * DeleteInterpObject --
+ * TclPreventAliasLoop --
*
- * Helper function to do the work of deleting zero or more
- * interpreters and their interpreter object commands.
+ * When defining an alias or renaming a command, prevent an alias
+ * loop from being formed.
*
* Results:
- * A standard Tcl result.
+ * A standard Tcl object result.
*
* Side effects:
- * Deletes interpreters and their interpreter object command.
+ * If TCL_ERROR is returned, the function also stores an error message
+ * in the interpreter's result object.
+ *
+ * NOTE:
+ * This function is public internal (instead of being static to
+ * this file) because it is also used from TclRenameCommand.
*
*----------------------------------------------------------------------
*/
-static int
-DeleteInterpObject(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Interpreter start search from. */
- Master *masterPtr; /* Interim storage for master record.*/
- int objc; /* Number of arguments in vector. */
- Tcl_Obj *CONST objv[]; /* with alias. */
+int
+TclPreventAliasLoop(interp, cmdInterp, cmd)
+ Tcl_Interp *interp; /* Interp in which to report errors. */
+ Tcl_Interp *cmdInterp; /* Interp in which the command is
+ * being defined. */
+ Tcl_Command cmd; /* Tcl command we are attempting
+ * to define. */
{
- int i;
- int len;
+ Command *cmdPtr = (Command *) cmd;
+ Alias *aliasPtr, *nextAliasPtr;
+ Tcl_Command aliasCmd;
+ Command *aliasCmdPtr;
- for (i = 2; i < objc; i++) {
- if (DeleteOneInterpObject(interp, masterPtr,
- Tcl_GetStringFromObj(objv[i], &len))
- != TCL_OK) {
+ /*
+ * If we are not creating or renaming an alias, then it is
+ * always OK to create or rename the command.
+ */
+
+ if (cmdPtr->objProc != AliasObjCmd) {
+ return TCL_OK;
+ }
+
+ /*
+ * OK, we are dealing with an alias, so traverse the chain of aliases.
+ * If we encounter the alias we are defining (or renaming to) any in
+ * the chain then we have a loop.
+ */
+
+ aliasPtr = (Alias *) cmdPtr->objClientData;
+ nextAliasPtr = aliasPtr;
+ while (1) {
+ int objc;
+ Tcl_Obj **objv;
+
+ /*
+ * If the target of the next alias in the chain is the same as
+ * the source alias, we have a loop.
+ */
+
+ Tcl_ListObjGetElements(NULL, nextAliasPtr->prefixPtr, &objc, &objv);
+ aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
+ Tcl_GetString(objv[0]),
+ Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
+ /*flags*/ 0);
+ if (aliasCmd == (Tcl_Command) NULL) {
+ return TCL_OK;
+ }
+ aliasCmdPtr = (Command *) aliasCmd;
+ if (aliasCmdPtr == cmdPtr) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot define or rename alias \"",
+ Tcl_GetString(aliasPtr->namePtr),
+ "\": would create a loop", (char *) NULL);
return TCL_ERROR;
}
+
+ /*
+ * Otherwise, follow the chain one step further. See if the target
+ * command is an alias - if so, follow the loop to its target
+ * command. Otherwise we do not have a loop.
+ */
+
+ if (aliasCmdPtr->objProc != AliasObjCmd) {
+ return TCL_OK;
+ }
+ nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
}
- return TCL_OK;
+
+ /* NOTREACHED */
}
/*
*----------------------------------------------------------------------
*
- * AliasCreationHelper --
+ * AliasCreate --
*
- * Helper function to do the work to actually create an alias or
- * delete an alias.
+ * Helper function to do the work to actually create an alias.
*
* Results:
* A standard Tcl result.
@@ -844,98 +1114,56 @@ DeleteInterpObject(interp, masterPtr, objc, objv)
*/
static int
-AliasCreationHelper(curInterp, slaveInterp, masterInterp, masterPtr,
- aliasName, targetName, objc, objv)
- Tcl_Interp *curInterp; /* Interp that invoked this proc. */
- Tcl_Interp *slaveInterp; /* Interp where alias cmd will live
- * or from which alias will be
- * deleted. */
- Tcl_Interp *masterInterp; /* Interp where target cmd will be. */
- Master *masterPtr; /* Master record for target interp. */
- char *aliasName; /* Name of alias cmd. */
- char *targetName; /* Name of target cmd. */
- int objc; /* Additional arguments to store */
- Tcl_Obj *CONST objv[]; /* with alias. */
+AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
+ objc, objv)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+ Tcl_Interp *slaveInterp; /* Interp where alias cmd will live or from
+ * which alias will be deleted. */
+ Tcl_Interp *masterInterp; /* Interp in which target command will be
+ * invoked. */
+ Tcl_Obj *namePtr; /* Name of alias cmd. */
+ Tcl_Obj *targetNamePtr; /* Name of target cmd. */
+ int objc; /* Additional arguments to store */
+ Tcl_Obj *CONST objv[]; /* with alias. */
{
- Alias *aliasPtr; /* Storage for alias data. */
- Alias *tmpAliasPtr; /* Temp storage for alias to delete. */
- Tcl_HashEntry *hPtr; /* Entry into interp hashtable. */
- int i; /* Loop index. */
- int new; /* Is it a new hash entry? */
- Target *targetPtr; /* Maps from target command in master
- * to source command in slave. */
- Slave *slavePtr; /* Maps from source command in slave
- * to target command in master. */
-
- slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
-
- /*
- * Slave record should be always present because it is created when
- * the interpreter is created.
- */
-
- if (slavePtr == (Slave *) NULL) {
- panic("AliasCreationHelper: could not find slave record");
- }
-
- if ((targetName == (char *) NULL) || (targetName[0] == '\0')) {
- if (objc != 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(curInterp),
- "malformed command: should be",
- " \"alias ", aliasName, " {}\"", (char *) NULL);
- return TCL_ERROR;
- }
+ Alias *aliasPtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+ Target *targetPtr;
+ Slave *slavePtr;
+ Master *masterPtr;
- return DeleteAlias(curInterp, slaveInterp, aliasName);
- }
-
aliasPtr = (Alias *) ckalloc((unsigned) sizeof(Alias));
- aliasPtr->aliasName = (char *) ckalloc((unsigned) strlen(aliasName)+1);
- aliasPtr->targetName = (char *) ckalloc((unsigned) strlen(targetName)+1);
- strcpy(aliasPtr->aliasName, aliasName);
- strcpy(aliasPtr->targetName, targetName);
- aliasPtr->targetInterp = masterInterp;
-
- aliasPtr->objv = NULL;
- aliasPtr->objc = objc;
-
- if (aliasPtr->objc > 0) {
- aliasPtr->objv =
- (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) *
- aliasPtr->objc);
- for (i = 0; i < objc; i++) {
- aliasPtr->objv[i] = objv[i];
- Tcl_IncrRefCount(objv[i]);
- }
- }
-
- aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, aliasName,
- AliasCmd, (ClientData) aliasPtr, AliasCmdDeleteProc);
-
- if (TclPreventAliasLoop(curInterp, slaveInterp,
- aliasPtr->slaveCmd) != TCL_OK) {
-
+ aliasPtr->namePtr = namePtr;
+ Tcl_IncrRefCount(aliasPtr->namePtr);
+ aliasPtr->targetInterp = masterInterp;
+ aliasPtr->prefixPtr = Tcl_NewListObj(1, &targetNamePtr);
+ Tcl_ListObjReplace(NULL, aliasPtr->prefixPtr, 1, 0, objc, objv);
+ Tcl_IncrRefCount(aliasPtr->prefixPtr);
+
+ aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
+ Tcl_GetString(namePtr), AliasObjCmd, (ClientData) aliasPtr,
+ AliasObjCmdDeleteProc);
+
+ if (TclPreventAliasLoop(interp, slaveInterp, aliasPtr->slaveCmd) != TCL_OK) {
/*
- * Found an alias loop! The last call to Tcl_CreateObjCommand
- * made the alias point to itself. Delete the command and
- * its alias record. Be careful to wipe out its client data
- * first, so the command doesn't try to delete itself.
- */
+ * Found an alias loop! The last call to Tcl_CreateObjCommand made
+ * the alias point to itself. Delete the command and its alias
+ * record. Be careful to wipe out its client data first, so the
+ * command doesn't try to delete itself.
+ */
+
+ Command *cmdPtr;
- Command *cmdPtr = (Command*) aliasPtr->slaveCmd;
+ Tcl_DecrRefCount(aliasPtr->namePtr);
+ Tcl_DecrRefCount(aliasPtr->prefixPtr);
+
+ cmdPtr = (Command *) aliasPtr->slaveCmd;
cmdPtr->clientData = NULL;
cmdPtr->deleteProc = NULL;
cmdPtr->deleteData = NULL;
Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
- for (i = 0; i < objc; i++) {
- Tcl_DecrRefCount(aliasPtr->objv[i]);
- }
- if (aliasPtr->objv != (Tcl_Obj *CONST *) NULL) {
- ckfree((char *) aliasPtr->objv);
- }
- ckfree(aliasPtr->aliasName);
- ckfree(aliasPtr->targetName);
ckfree((char *) aliasPtr);
/*
@@ -950,21 +1178,22 @@ AliasCreationHelper(curInterp, slaveInterp, masterInterp, masterPtr,
* the alias command. Then retry.
*/
- do {
- hPtr = Tcl_CreateHashEntry(&(slavePtr->aliasTable), aliasName, &new);
- if (!new) {
- tmpAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
- (void) Tcl_DeleteCommandFromToken(slaveInterp,
- tmpAliasPtr->slaveCmd);
-
- /*
- * The hash entry should be deleted by the Tcl_DeleteCommand
- * above, in its command deletion callback (most likely this
- * will be AliasCmdDeleteProc, which does the deletion).
- */
- }
- } while (new == 0);
- aliasPtr->aliasEntry = hPtr;
+ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
+ while (1) {
+ Alias *oldAliasPtr;
+ char *string;
+
+ string = Tcl_GetString(namePtr);
+ hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &new);
+ if (new != 0) {
+ break;
+ }
+
+ oldAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ Tcl_DeleteCommandFromToken(slaveInterp, oldAliasPtr->slaveCmd);
+ }
+
+ aliasPtr->aliasEntryPtr = hPtr;
Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
/*
@@ -980,435 +1209,145 @@ AliasCreationHelper(curInterp, slaveInterp, masterInterp, masterPtr,
targetPtr->slaveCmd = aliasPtr->slaveCmd;
targetPtr->slaveInterp = slaveInterp;
+ Tcl_MutexLock(&cntMutex);
+ masterPtr = &((InterpInfo *) ((Interp *) masterInterp)->interpInfo)->master;
do {
- hPtr = Tcl_CreateHashEntry(&(masterPtr->targetTable),
+ hPtr = Tcl_CreateHashEntry(&masterPtr->targetTable,
(char *) aliasCounter, &new);
aliasCounter++;
} while (new == 0);
+ Tcl_MutexUnlock(&cntMutex);
Tcl_SetHashValue(hPtr, (ClientData) targetPtr);
+ aliasPtr->targetEntryPtr = hPtr;
- aliasPtr->targetEntry = hPtr;
-
- /*
- * Make sure we clear out the object result when setting the string
- * result.
- */
-
- Tcl_SetObjResult(curInterp, Tcl_NewStringObj(aliasPtr->aliasName, -1));
-
+ Tcl_SetObjResult(interp, namePtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * InterpAliasesHelper --
+ * AliasDelete --
*
- * Computes a list of aliases defined in an interpreter.
+ * Deletes the given alias from the slave interpreter given.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * None.
+ * Deletes the alias from the slave interpreter.
*
*----------------------------------------------------------------------
*/
static int
-InterpAliasesHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Invoking interpreter. */
- Master *masterPtr; /* Master record for current interp. */
- int objc; /* How many arguments? */
- Tcl_Obj *CONST objv[]; /* Actual arguments. */
+AliasDelete(interp, slaveInterp, namePtr)
+ Tcl_Interp *interp; /* Interpreter for result & errors. */
+ Tcl_Interp *slaveInterp; /* Interpreter containing alias. */
+ Tcl_Obj *namePtr; /* Name of alias to describe. */
{
- Tcl_Interp *slaveInterp; /* A slave. */
- Slave *slavePtr; /* Record for slave interp. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- Tcl_HashSearch hSearch; /* Iteration variable. */
- int len; /* Dummy length variable. */
- Tcl_Obj *listObjPtr, *elemObjPtr; /* Local object pointers. */
-
- if ((objc != 2) && (objc != 3)) {
- Tcl_WrongNumArgs(interp, 2, objv, "?path?");
- return TCL_ERROR;
- }
- if (objc == 3) {
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), NULL);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- } else {
- slaveInterp = interp;
- }
- slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
- "tclSlaveRecord", NULL);
- if (slavePtr == (Slave *) NULL) {
- return TCL_OK;
- }
+ Slave *slavePtr;
+ Alias *aliasPtr;
+ Tcl_HashEntry *hPtr;
/*
- * Build a list to return the aliases:
+ * If the alias has been renamed in the slave, the master can still use
+ * the original name (with which it was created) to find the alias to
+ * delete it.
*/
-
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable), &hSearch);
- hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
-
- elemObjPtr = Tcl_NewStringObj(
- Tcl_GetHashKey(&(slavePtr->aliasTable), hPtr), -1);
- Tcl_ListObjAppendElement(interp, listObjPtr, elemObjPtr);
- }
- Tcl_SetObjResult(interp, listObjPtr);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InterpAliasHelper -
- *
- * Handles the different forms of the "interp alias" command:
- * - interp alias slavePath aliasName
- * Describes an alias.
- * - interp alias slavePath aliasName {}
- * Deletes an alias.
- * - interp alias slavePath srcCmd masterPath targetCmd args...
- * Creates an alias.
- *
- * Results:
- * A Tcl result.
- *
- * Side effects:
- * See user documentation for details.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InterpAliasHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for current interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Tcl_Interp *slaveInterp, /* Interpreters used when */
- *masterInterp; /* creating an alias btn siblings. */
- Master *masterMasterPtr; /* Master record for master interp. */
- int len;
-
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "slavePath slaveCmd masterPath masterCmd ?args ..?");
- return TCL_ERROR;
- }
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), NULL);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not find interpreter \"",
- Tcl_GetStringFromObj(objv[2], &len), "\"",
- (char *) NULL);
- return TCL_ERROR;
- }
- if (objc == 4) {
- return DescribeAlias(interp, slaveInterp,
- Tcl_GetStringFromObj(objv[3], &len));
- }
- if (objc == 5 && strcmp(Tcl_GetStringFromObj(objv[4], &len), "") == 0) {
- return DeleteAlias(interp, slaveInterp,
- Tcl_GetStringFromObj(objv[3], &len));
- }
- if (objc < 6) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "slavePath slaveCmd masterPath masterCmd ?args ..?");
- return TCL_ERROR;
- }
- masterInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[4], &len), &masterMasterPtr);
- if (masterInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not find interpreter \"",
- Tcl_GetStringFromObj(objv[4], &len), "\"", (char *) NULL);
- return TCL_ERROR;
- }
- return AliasCreationHelper(interp, slaveInterp, masterInterp,
- masterMasterPtr, Tcl_GetStringFromObj(objv[3], &len),
- Tcl_GetStringFromObj(objv[5], &len),
- objc-6, objv+6);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InterpExistsHelper --
- *
- * Computes whether a named interpreter exists or not.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InterpExistsHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for current interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Tcl_Obj *objPtr;
- int len;
-
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?path?");
+ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
+ hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
+ if (hPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "alias \"",
+ Tcl_GetString(namePtr), "\" not found", NULL);
return TCL_ERROR;
}
- if (objc == 3) {
- if (GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), NULL) ==
- (Tcl_Interp *) NULL) {
- objPtr = Tcl_NewIntObj(0);
- } else {
- objPtr = Tcl_NewIntObj(1);
- }
- } else {
- objPtr = Tcl_NewIntObj(1);
- }
- Tcl_SetObjResult(interp, objPtr);
-
+ aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * InterpEvalHelper --
+ * AliasDescribe --
*
- * Helper function to handle all the details of evaluating a
- * command in another interpreter.
+ * Sets the interpreter's result object to a Tcl list describing
+ * the given alias in the given interpreter: its target command
+ * and the additional arguments to prepend to any invocation
+ * of the alias.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Whatever the command itself does.
+ * None.
*
*----------------------------------------------------------------------
*/
static int
-InterpEvalHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for current interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+AliasDescribe(interp, slaveInterp, namePtr)
+ Tcl_Interp *interp; /* Interpreter for result & errors. */
+ Tcl_Interp *slaveInterp; /* Interpreter containing alias. */
+ Tcl_Obj *namePtr; /* Name of alias to describe. */
{
- Tcl_Interp *slaveInterp; /* A slave. */
- Interp *iPtr; /* Internal data type for slave. */
- int len; /* Dummy length variable. */
- int result;
- Tcl_Obj *namePtr, *objPtr; /* Local object pointer. */
- char *string;
-
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
- return TCL_ERROR;
- }
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), NULL);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter named \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- objPtr = Tcl_ConcatObj(objc-3, objv+3);
- Tcl_IncrRefCount(objPtr);
-
- Tcl_Preserve((ClientData) slaveInterp);
- result = Tcl_EvalObj(slaveInterp, objPtr);
-
- Tcl_DecrRefCount(objPtr);
+ Slave *slavePtr;
+ Tcl_HashEntry *hPtr;
+ Alias *aliasPtr;
/*
- * Now make the result and any error information accessible. We
- * have to be careful because the slave interpreter and the current
- * interpreter can be the same - do not destroy the result.. This
- * can happen if an interpreter contains an alias which is directed
- * at a target command in the same interpreter.
+ * If the alias has been renamed in the slave, the master can still use
+ * the original name (with which it was created) to find the alias to
+ * describe it.
*/
- if (interp != slaveInterp) {
- if (result == TCL_ERROR) {
-
- /*
- * An error occurred, so transfer error information from
- * the target interpreter back to our interpreter.
- */
-
- iPtr = (Interp *) slaveInterp;
- if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
- Tcl_AddErrorInfo(slaveInterp, "");
- }
- iPtr->flags &= (~(ERR_ALREADY_LOGGED));
-
- Tcl_ResetResult(interp);
- namePtr = Tcl_NewStringObj("errorInfo", -1);
- objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
- (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
- string = Tcl_GetStringFromObj(objPtr, &len);
- Tcl_AddObjErrorInfo(interp, string, len);
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(slaveInterp, "errorCode", (char *)
- NULL, TCL_GLOBAL_ONLY),
- TCL_GLOBAL_ONLY);
- Tcl_DecrRefCount(namePtr);
- }
-
- /*
- * Move the result object from one interpreter to the
- * other.
- */
-
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
-
- }
- Tcl_Release((ClientData) slaveInterp);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InterpExposeHelper --
- *
- * Helper function to handle the details of exposing a command in
- * another interpreter.
- *
- * Results:
- * Standard Tcl result.
- *
- * Side effects:
- * Exposes a command. From now on the command can be called by scripts
- * in the interpreter in which it was exposed.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InterpExposeHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for current interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Tcl_Interp *slaveInterp; /* A slave. */
- int len; /* Dummy length variable. */
-
- if ((objc != 4) && (objc != 5)) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "path hiddenCmdName ?cmdName?");
- return TCL_ERROR;
- }
- if (Tcl_IsSafe(interp)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "permission denied: safe interpreter cannot expose commands",
- (char *) NULL);
- return TCL_ERROR;
- }
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_ExposeCommand(slaveInterp,
- Tcl_GetStringFromObj(objv[3], &len),
- (objc == 5 ?
- Tcl_GetStringFromObj(objv[4], &len) :
- Tcl_GetStringFromObj(objv[3], &len)))
- == TCL_ERROR) {
- if (interp != slaveInterp) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
- }
- return TCL_ERROR;
+ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
+ hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
+ if (hPtr == NULL) {
+ return TCL_OK;
}
+ aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+ Tcl_SetObjResult(interp, aliasPtr->prefixPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * InterpHideHelper --
+ * AliasList --
*
- * Helper function that handles the details of hiding a command in
- * another interpreter.
+ * Computes a list of aliases defined in a slave interpreter.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Hides a command. From now on the command cannot be called by
- * scripts in that interpreter.
+ * None.
*
*----------------------------------------------------------------------
*/
static int
-InterpHideHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+AliasList(interp, slaveInterp)
+ Tcl_Interp *interp; /* Interp for data return. */
+ Tcl_Interp *slaveInterp; /* Interp whose aliases to compute. */
{
- Tcl_Interp *slaveInterp; /* A slave. */
- int len; /* Dummy length variable. */
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch hashSearch;
+ Tcl_Obj *resultPtr;
+ Alias *aliasPtr;
+ Slave *slavePtr;
- if ((objc != 4) && (objc != 5)) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "path cmdName ?hiddenCmdName?");
- return TCL_ERROR;
- }
- if (Tcl_IsSafe(interp)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "permission denied: safe interpreter cannot hide commands",
- (char *) NULL);
- return TCL_ERROR;
- }
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[3], &len),
- (objc == 5 ?
- Tcl_GetStringFromObj(objv[4], &len) :
- Tcl_GetStringFromObj(objv[3], &len)))
- == TCL_ERROR) {
- if (interp != slaveInterp) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
- }
- return TCL_ERROR;
+ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
+ resultPtr = Tcl_GetObjResult(interp);
+
+ entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);
+ for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {
+ aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->namePtr);
}
return TCL_OK;
}
@@ -1416,524 +1355,186 @@ InterpHideHelper(interp, masterPtr, objc, objv)
/*
*----------------------------------------------------------------------
*
- * InterpHiddenHelper --
+ * AliasObjCmd --
*
- * Computes the list of hidden commands in a named interpreter.
+ * This is the procedure that services invocations of aliases in a
+ * slave interpreter. One such command exists for each alias. When
+ * invoked, this procedure redirects the invocation to the target
+ * command in the master interpreter as designated by the Alias
+ * record associated with this command.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * None.
+ * Causes forwarding of the invocation; all possible side effects
+ * may occur as a result of invoking the command to which the
+ * invocation is forwarded.
*
*----------------------------------------------------------------------
*/
static int
-InterpHiddenHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+AliasObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Alias record. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument vector. */
{
- Tcl_Interp *slaveInterp; /* A slave. */
- int len;
- Tcl_HashTable *hTblPtr; /* Hidden command table. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- Tcl_HashSearch hSearch; /* Iteration variable. */
- Tcl_Obj *listObjPtr; /* Local object pointer. */
+ Tcl_Interp *targetInterp;
+ Alias *aliasPtr;
+ int result, prefc, cmdc;
+ Tcl_Obj *cmdPtr;
+ Tcl_Obj **prefv, **cmdv;
+
+ aliasPtr = (Alias *) clientData;
+ targetInterp = aliasPtr->targetInterp;
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?path?");
- return TCL_ERROR;
- }
- if (objc == 3) {
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len),
- &masterPtr);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- } else {
- slaveInterp = interp;
- }
-
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
- "tclHiddenCmds", NULL);
- if (hTblPtr != (Tcl_HashTable *) NULL) {
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
+ Tcl_Preserve((ClientData) targetInterp);
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
- }
- }
- Tcl_SetObjResult(interp, listObjPtr);
-
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InterpInvokeHiddenHelper --
- *
- * Helper routine to handle the details of invoking a hidden
- * command in another interpreter.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Whatever the hidden command does.
- *
- *----------------------------------------------------------------------
- */
+ ((Interp *) targetInterp)->numLevels++;
-static int
-InterpInvokeHiddenHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- int doGlobal = 0;
- int len;
- int result;
- Tcl_Obj *namePtr, *objPtr;
- Tcl_Interp *slaveInterp;
- Interp *iPtr;
- char *string;
-
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "path ?-global? cmd ?arg ..?");
- return TCL_ERROR;
- }
- if (Tcl_IsSafe(interp)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "not allowed to invoke hidden commands from safe interpreter",
- (char *) NULL);
- return TCL_ERROR;
- }
- if (strcmp(Tcl_GetStringFromObj(objv[3], &len), "-global") == 0) {
- doGlobal = 1;
- if (objc < 5) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "path ?-global? cmd ?arg ..?");
- return TCL_ERROR;
- }
- }
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_Preserve((ClientData) slaveInterp);
- if (doGlobal) {
- result = TclObjInvokeGlobal(slaveInterp, objc-4, objv+4,
- TCL_INVOKE_HIDDEN);
- } else {
- result = TclObjInvoke(slaveInterp, objc-3, objv+3, TCL_INVOKE_HIDDEN);
- }
+ Tcl_ResetResult(targetInterp);
+ Tcl_AllowExceptions(targetInterp);
/*
- * Now make the result and any error information accessible. We
- * have to be careful because the slave interpreter and the current
- * interpreter can be the same - do not destroy the result.. This
- * can happen if an interpreter contains an alias which is directed
- * at a target command in the same interpreter.
+ * Append the arguments to the command prefix and invoke the command
+ * in the target interp's global namespace.
*/
+
+ Tcl_ListObjGetElements(NULL, aliasPtr->prefixPtr, &prefc, &prefv);
+ cmdPtr = Tcl_NewListObj(prefc, prefv);
+ Tcl_ListObjReplace(NULL, cmdPtr, prefc, 0, objc - 1, objv + 1);
+ Tcl_ListObjGetElements(NULL, cmdPtr, &cmdc, &cmdv);
+ result = TclObjInvoke(targetInterp, cmdc, cmdv,
+ TCL_INVOKE_NO_TRACEBACK);
+ Tcl_DecrRefCount(cmdPtr);
+
+ ((Interp *) targetInterp)->numLevels--;
+
+ /*
+ * Check if we are at the bottom of the stack for the target interpreter.
+ * If so, check for special return codes.
+ */
+
+ if (((Interp *) targetInterp)->numLevels == 0) {
+ if (result == TCL_RETURN) {
+ result = TclUpdateReturnInfo((Interp *) targetInterp);
+ }
+ if ((result != TCL_OK) && (result != TCL_ERROR)) {
+ Tcl_ResetResult(targetInterp);
+ if (result == TCL_BREAK) {
+ Tcl_SetObjResult(targetInterp,
+ Tcl_NewStringObj("invoked \"break\" outside of a loop",
+ -1));
+ } else if (result == TCL_CONTINUE) {
+ Tcl_SetObjResult(targetInterp,
+ Tcl_NewStringObj(
+ "invoked \"continue\" outside of a loop",
+ -1));
+ } else {
+ char buf[32 + TCL_INTEGER_SPACE];
- if (interp != slaveInterp) {
- if (result == TCL_ERROR) {
-
- /*
- * An error occurred, so transfer error information from
- * the target interpreter back to our interpreter.
- */
-
- iPtr = (Interp *) slaveInterp;
- if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
- Tcl_AddErrorInfo(slaveInterp, "");
- }
- iPtr->flags &= (~(ERR_ALREADY_LOGGED));
-
- Tcl_ResetResult(interp);
- namePtr = Tcl_NewStringObj("errorInfo", -1);
- objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
- (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
- Tcl_DecrRefCount(namePtr);
- string = Tcl_GetStringFromObj(objPtr, &len);
- Tcl_AddObjErrorInfo(interp, string, len);
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(slaveInterp, "errorCode", (char *)
- NULL, TCL_GLOBAL_ONLY),
- TCL_GLOBAL_ONLY);
- }
-
- /*
- * Move the result object from the slave to the master.
- */
-
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
+ sprintf(buf, "command returned bad code: %d", result);
+ Tcl_SetObjResult(targetInterp, Tcl_NewStringObj(buf, -1));
+ }
+ result = TCL_ERROR;
+ }
}
- Tcl_Release((ClientData) slaveInterp);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InterpMarkTrustedHelper --
- *
- * Helper function to handle the details of marking another
- * interpreter as trusted (unsafe).
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Henceforth the hard-wired checks for safety will not prevent
- * this interpreter from performing certain operations.
- *
- *----------------------------------------------------------------------
- */
-static int
-InterpMarkTrustedHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Tcl_Interp *slaveInterp; /* A slave. */
- int len; /* Dummy length variable. */
+ TclTransferResult(targetInterp, result, interp);
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "path");
- return TCL_ERROR;
- }
- if (Tcl_IsSafe(interp)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "\"", Tcl_GetStringFromObj(objv[0], &len),
- " marktrusted\" can only",
- " be invoked from a trusted interpreter",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- return MarkTrusted(slaveInterp);
+ Tcl_Release((ClientData) targetInterp);
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * InterpIsSafeHelper --
+ * AliasObjCmdDeleteProc --
*
- * Computes whether a named interpreter is safe.
+ * Is invoked when an alias command is deleted in a slave. Cleans up
+ * all storage associated with this alias.
*
* Results:
- * A standard Tcl result.
- *
- * Side effects:
* None.
*
- *----------------------------------------------------------------------
- */
-
-static int
-InterpIsSafeHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Tcl_Interp *slaveInterp; /* A slave. */
- int len; /* Dummy length variable. */
- Tcl_Obj *objPtr; /* Local object pointer. */
-
- if (objc > 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "?path?");
- return TCL_ERROR;
- }
- if (objc == 3) {
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"",
- Tcl_GetStringFromObj(objv[2], &len), "\" not found",
- (char *) NULL);
- return TCL_ERROR;
- }
- objPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
- } else {
- objPtr = Tcl_NewIntObj(Tcl_IsSafe(interp));
- }
- Tcl_SetObjResult(interp, objPtr);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InterpSlavesHelper --
- *
- * Computes a list of slave interpreters of a named interpreter.
- *
- * Results:
- * A standard Tcl result.
- *
* Side effects:
- * None.
+ * Deletes the alias record and its entry in the alias table for
+ * the interpreter.
*
*----------------------------------------------------------------------
*/
-static int
-InterpSlavesHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+static void
+AliasObjCmdDeleteProc(clientData)
+ ClientData clientData; /* The alias record for this alias. */
{
- int len;
- Tcl_HashEntry *hPtr; /* Search variable. */
- Tcl_HashSearch hSearch; /* Iteration variable. */
- Tcl_Obj *listObjPtr; /* Local object pointers. */
+ Alias *aliasPtr;
+ Target *targetPtr;
- if ((objc != 2) && (objc != 3)) {
- Tcl_WrongNumArgs(interp, 2, objv, "?path?");
- return TCL_ERROR;
- }
- if (objc == 3) {
- if (GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), &masterPtr) ==
- (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- }
+ aliasPtr = (Alias *) clientData;
+
+ Tcl_DecrRefCount(aliasPtr->namePtr);
+ Tcl_DecrRefCount(aliasPtr->prefixPtr);
+ Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
- hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
+ targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntryPtr);
+ ckfree((char *) targetPtr);
+ Tcl_DeleteHashEntry(aliasPtr->targetEntryPtr);
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(
- Tcl_GetHashKey(&(masterPtr->slaveTable), hPtr), -1));
- }
- Tcl_SetObjResult(interp, listObjPtr);
- return TCL_OK;
+ ckfree((char *) aliasPtr);
}
/*
*----------------------------------------------------------------------
*
- * InterpShareHelper --
+ * Tcl_CreateSlave --
*
- * Helper function to handle the details of sharing a channel between
- * interpreters.
+ * Creates a slave interpreter. The slavePath argument denotes the
+ * name of the new slave relative to the current interpreter; the
+ * slave is a direct descendant of the one-before-last component of
+ * the path, e.g. it is a descendant of the current interpreter if
+ * the slavePath argument contains only one component. Optionally makes
+ * the slave interpreter safe.
*
* Results:
- * A standard Tcl result.
+ * Returns the interpreter structure created, or NULL if an error
+ * occurred.
*
* Side effects:
- * After this call the named channel will be shared between the
- * interpreters named in the arguments.
+ * Creates a new interpreter and a new interpreter object command in
+ * the interpreter indicated by the slavePath argument.
*
*----------------------------------------------------------------------
*/
-static int
-InterpShareHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_Interp *
+Tcl_CreateSlave(interp, slavePath, isSafe)
+ Tcl_Interp *interp; /* Interpreter to start search at. */
+ char *slavePath; /* Name of slave to create. */
+ int isSafe; /* Should new slave be "safe" ? */
{
- Tcl_Interp *slaveInterp; /* A slave. */
- Tcl_Interp *masterInterp; /* Its master. */
- int len;
- Tcl_Channel chan;
-
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
- return TCL_ERROR;
- }
- masterInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), NULL);
- if (masterInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[4], &len), NULL);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- chan = Tcl_GetChannel(masterInterp, Tcl_GetStringFromObj(objv[3], &len),
- NULL);
- if (chan == (Tcl_Channel) NULL) {
- if (interp != masterInterp) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
- Tcl_ResetResult(masterInterp);
- }
- return TCL_ERROR;
- }
- Tcl_RegisterChannel(slaveInterp, chan);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InterpTargetHelper --
- *
- * Helper function to compute the target of an alias.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
+ Tcl_Obj *pathPtr;
+ Tcl_Interp *slaveInterp;
-static int
-InterpTargetHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- int len;
-
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "path alias");
- return TCL_ERROR;
- }
- return GetTarget(interp,
- Tcl_GetStringFromObj(objv[2], &len),
- Tcl_GetStringFromObj(objv[3], &len));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InterpTransferHelper --
- *
- * Helper function to handle the details of transferring ownership
- * of a channel between interpreters.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * After the call, the named channel will be registered in the target
- * interpreter and no longer available for use in the source interpreter.
- *
- *----------------------------------------------------------------------
- */
+ pathPtr = Tcl_NewStringObj(slavePath, -1);
+ slaveInterp = SlaveCreate(interp, pathPtr, isSafe);
+ Tcl_DecrRefCount(pathPtr);
-static int
-InterpTransferHelper(interp, masterPtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Master *masterPtr; /* Master record for interp. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Tcl_Interp *slaveInterp; /* A slave. */
- Tcl_Interp *masterInterp; /* Its master. */
- int len;
- Tcl_Channel chan;
-
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "srcPath channelId destPath");
- return TCL_ERROR;
- }
- masterInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[2], &len), NULL);
- if (masterInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- slaveInterp = GetInterp(interp, masterPtr,
- Tcl_GetStringFromObj(objv[4], &len), NULL);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
- "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- chan = Tcl_GetChannel(masterInterp,
- Tcl_GetStringFromObj(objv[3], &len), NULL);
- if (chan == (Tcl_Channel) NULL) {
- if (interp != masterInterp) {
-
- /*
- * After fixing objresult, this code will change to:
- * Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
- */
-
- Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
- Tcl_ResetResult(masterInterp);
- }
- return TCL_ERROR;
- }
- Tcl_RegisterChannel(slaveInterp, chan);
- if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
- if (interp != masterInterp) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
- Tcl_ResetResult(masterInterp);
- }
- return TCL_ERROR;
- }
- return TCL_OK;
+ return slaveInterp;
}
/*
*----------------------------------------------------------------------
*
- * DescribeAlias --
+ * Tcl_GetSlave --
*
- * Sets the interpreter's result object to a Tcl list describing
- * the given alias in the given interpreter: its target command
- * and the additional arguments to prepend to any invocation
- * of the alias.
+ * Finds a slave interpreter by its path name.
*
* Results:
- * A standard Tcl result.
+ * Returns a Tcl_Interp * for the named interpreter or NULL if not
+ * found.
*
* Side effects:
* None.
@@ -1941,125 +1542,48 @@ InterpTransferHelper(interp, masterPtr, objc, objv)
*----------------------------------------------------------------------
*/
-static int
-DescribeAlias(interp, slaveInterp, aliasName)
- Tcl_Interp *interp; /* Interpreter for result & errors. */
- Tcl_Interp *slaveInterp; /* Interpreter defining alias. */
- char *aliasName; /* Name of alias to describe. */
+Tcl_Interp *
+Tcl_GetSlave(interp, slavePath)
+ Tcl_Interp *interp; /* Interpreter to start search from. */
+ char *slavePath; /* Path of slave to find. */
{
- Slave *slavePtr; /* Slave interp slave record. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- Alias *aliasPtr; /* Structure describing alias. */
- int i; /* Loop variable. */
- Tcl_Obj *listObjPtr; /* Local object pointer. */
+ Tcl_Obj *pathPtr;
+ Tcl_Interp *slaveInterp;
- slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
- NULL);
+ pathPtr = Tcl_NewStringObj(slavePath, -1);
+ slaveInterp = GetInterp(interp, pathPtr);
+ Tcl_DecrRefCount(pathPtr);
- /*
- * The slave record should always be present because it is created
- * by Tcl_CreateInterp.
- */
-
- if (slavePtr == (Slave *) NULL) {
- panic("DescribeAlias: could not find slave record");
- }
- hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- return TCL_OK;
- }
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(aliasPtr->targetName, -1));
- for (i = 0; i < aliasPtr->objc; i++) {
- Tcl_ListObjAppendElement(interp, listObjPtr, aliasPtr->objv[i]);
- }
- Tcl_SetObjResult(interp, listObjPtr);
- return TCL_OK;
+ return slaveInterp;
}
/*
*----------------------------------------------------------------------
*
- * DeleteAlias --
+ * Tcl_GetMaster --
*
- * Deletes the given alias from the slave interpreter given.
+ * Finds the master interpreter of a slave interpreter.
*
* Results:
- * A standard Tcl result.
+ * Returns a Tcl_Interp * for the master interpreter or NULL if none.
*
* Side effects:
- * Deletes the alias from the slave interpreter.
+ * None.
*
*----------------------------------------------------------------------
*/
-static int
-DeleteAlias(interp, slaveInterp, aliasName)
- Tcl_Interp *interp; /* Interpreter for result and errors. */
- Tcl_Interp *slaveInterp; /* Interpreter defining alias. */
- char *aliasName; /* Name of alias to delete. */
+Tcl_Interp *
+Tcl_GetMaster(interp)
+ Tcl_Interp *interp; /* Get the master of this interpreter. */
{
- Slave *slavePtr; /* Slave record for slave interpreter. */
- Alias *aliasPtr; /* Points at alias structure to delete. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- char *tmpPtr, *namePtr; /* Local pointers to name of command to
- * be deleted. */
-
- slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
- NULL);
- if (slavePtr == (Slave *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "alias \"", aliasName, "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- * Get the alias from the alias table, then delete the command. The
- * deleteProc on the alias command will take care of removing the entry
- * from the alias table.
- */
-
- hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "alias \"", aliasName, "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-
- /*
- * Get a copy of the real name of the command -- it might have
- * been renamed, and we want to delete the renamed command, not
- * the current command (if any) by the name of the original alias.
- * We need the local copy because the name may get smashed when the
- * command to delete is exposed, if it was hidden.
- */
-
- tmpPtr = Tcl_GetCommandName(slaveInterp, aliasPtr->slaveCmd);
- namePtr = (char *) ckalloc((unsigned) strlen(tmpPtr) + 1);
- strcpy(namePtr, tmpPtr);
-
- /*
- * NOTE: The deleteProc for this command will delete the
- * alias from the hash table. The deleteProc will also
- * delete the target information from the master interpreter
- * target table.
- */
+ Slave *slavePtr; /* Slave record of this interpreter. */
- if (Tcl_DeleteCommand(slaveInterp, namePtr) != 0) {
- if (Tcl_ExposeCommand(slaveInterp, namePtr, namePtr) != TCL_OK) {
- panic("DeleteAlias: did not find alias to be deleted");
- }
- if (Tcl_DeleteCommand(slaveInterp, namePtr) != 0) {
- panic("DeleteAlias: did not find alias to be deleted");
- }
+ if (interp == (Tcl_Interp *) NULL) {
+ return NULL;
}
- ckfree(namePtr);
-
- return TCL_OK;
+ slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
+ return slavePtr->masterInterp;
}
/*
@@ -2093,316 +1617,378 @@ Tcl_GetInterpPath(askingInterp, targetInterp)
Tcl_Interp *askingInterp; /* Interpreter to start search from. */
Tcl_Interp *targetInterp; /* Interpreter to find. */
{
- Master *masterPtr; /* Interim storage for Master record. */
- Slave *slavePtr; /* Interim storage for Slave record. */
+ InterpInfo *iiPtr;
if (targetInterp == askingInterp) {
return TCL_OK;
}
- if (targetInterp == (Tcl_Interp *) NULL) {
- return TCL_ERROR;
+ if (targetInterp == NULL) {
+ return TCL_ERROR;
}
- slavePtr = (Slave *) Tcl_GetAssocData(targetInterp, "tclSlaveRecord",
- NULL);
- if (slavePtr == (Slave *) NULL) {
+ iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
+ if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) {
return TCL_ERROR;
}
- if (Tcl_GetInterpPath(askingInterp, slavePtr->masterInterp) == TCL_ERROR) {
-
- /*
- * The result of askingInterp was set by recursive call.
- */
-
- return TCL_ERROR;
- }
- masterPtr = (Master *) Tcl_GetAssocData(slavePtr->masterInterp,
- "tclMasterRecord", NULL);
- if (masterPtr == (Master *) NULL) {
- panic("Tcl_GetInterpPath: could not find master record");
- }
- Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&(masterPtr->slaveTable),
- slavePtr->slaveEntry));
+ Tcl_AppendElement(askingInterp,
+ Tcl_GetHashKey(&iiPtr->master.slaveTable,
+ iiPtr->slave.slaveEntryPtr));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * GetTarget --
+ * GetInterp --
*
- * Sets the result of the invoking interpreter to a path name for
- * the target interpreter of an alias in one of the slaves.
+ * Helper function to find a slave interpreter given a pathname.
*
* Results:
- * TCL_OK if the target interpreter of the alias is a slave of the
- * invoking interpreter, TCL_ERROR else.
+ * Returns the slave interpreter known by that name in the calling
+ * interpreter, or NULL if no interpreter known by that name exists.
*
* Side effects:
- * Sets the result of the invoking interpreter.
+ * Assigns to the pointer variable passed in, if not NULL.
*
*----------------------------------------------------------------------
*/
-static int
-GetTarget(askingInterp, path, aliasName)
- Tcl_Interp *askingInterp; /* Interpreter to start search from. */
- char *path; /* The path of the interp to find. */
- char *aliasName; /* The target of this allias. */
+static Tcl_Interp *
+GetInterp(interp, pathPtr)
+ Tcl_Interp *interp; /* Interp. to start search from. */
+ Tcl_Obj *pathPtr; /* List object containing name of interp. to
+ * be found. */
{
- Tcl_Interp *slaveInterp; /* Interim storage for slave. */
- Slave *slaveSlavePtr; /* Its Slave record. */
- Master *masterPtr; /* Interim storage for Master record. */
Tcl_HashEntry *hPtr; /* Search element. */
- Alias *aliasPtr; /* Data describing the alias. */
+ Slave *slavePtr; /* Interim slave record. */
+ Tcl_Obj **objv;
+ int objc, i;
+ Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */
+ InterpInfo *masterInfoPtr;
- Tcl_ResetResult(askingInterp);
- masterPtr = (Master *) Tcl_GetAssocData(askingInterp, "tclMasterRecord",
- NULL);
- if (masterPtr == (Master *) NULL) {
- panic("GetTarget: could not find master record");
- }
- slaveInterp = GetInterp(askingInterp, masterPtr, path, NULL);
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
- "could not find interpreter \"", path, "\"", (char *) NULL);
- return TCL_ERROR;
- }
- slaveSlavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
- NULL);
- if (slaveSlavePtr == (Slave *) NULL) {
- panic("GetTarget: could not find slave record");
- }
- hPtr = Tcl_FindHashEntry(&(slaveSlavePtr->aliasTable), aliasName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
- "alias \"", aliasName, "\" in path \"", path, "\" not found",
- (char *) NULL);
- return TCL_ERROR;
+ if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
+ return NULL;
}
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
- if (aliasPtr == (Alias *) NULL) {
- panic("GetTarget: could not find alias record");
+
+ searchInterp = interp;
+ for (i = 0; i < objc; i++) {
+ masterInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
+ hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
+ Tcl_GetString(objv[i]));
+ if (hPtr == NULL) {
+ searchInterp = NULL;
+ break;
+ }
+ slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+ searchInterp = slavePtr->slaveInterp;
+ if (searchInterp == NULL) {
+ break;
+ }
}
-
- if (Tcl_GetInterpPath(askingInterp, aliasPtr->targetInterp) == TCL_ERROR) {
- Tcl_ResetResult(askingInterp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
- "target interpreter for alias \"",
- aliasName, "\" in path \"", path, "\" is not my descendant",
- (char *) NULL);
- return TCL_ERROR;
+ if (searchInterp == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not find interpreter \"",
+ Tcl_GetString(pathPtr), "\"", (char *) NULL);
}
-
- return TCL_OK;
+ return searchInterp;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_InterpCmd --
+ * SlaveCreate --
*
- * This procedure is invoked to process the "interp" Tcl command.
- * See the user documentation for details on what it does.
+ * Helper function to do the actual work of creating a slave interp
+ * and new object command. Also optionally makes the new slave
+ * interpreter "safe".
*
* Results:
- * A standard Tcl result.
+ * Returns the new Tcl_Interp * if successful or NULL if not. If failed,
+ * the result of the invoking interpreter contains an error message.
*
* Side effects:
- * See the user documentation.
+ * Creates a new slave interpreter and a new object command.
*
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
-int
-Tcl_InterpObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Unused. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- Master *masterPtr; /* Master record for current interp. */
- int result; /* Local result variable. */
- /*
- * These are all the different subcommands for this command:
- */
-
- static char *subCmds[] = {
- "alias", "aliases", "create", "delete", "eval", "exists",
- "expose", "hide", "hidden", "issafe", "invokehidden",
- "marktrusted", "slaves", "share", "target", "transfer",
- (char *) NULL};
- enum ISubCmdIdx {
- IAliasIdx, IAliasesIdx, ICreateIdx, IDeleteIdx, IEvalIdx,
- IExistsIdx, IExposeIdx, IHideIdx, IHiddenIdx, IIsSafeIdx,
- IInvokeHiddenIdx, IMarkTrustedIdx, ISlavesIdx, IShareIdx,
- ITargetIdx, ITransferIdx
- } index;
+static Tcl_Interp *
+SlaveCreate(interp, pathPtr, safe)
+ Tcl_Interp *interp; /* Interp. to start search from. */
+ Tcl_Obj *pathPtr; /* Path (name) of slave to create. */
+ int safe; /* Should we make it "safe"? */
+{
+ Tcl_Interp *masterInterp, *slaveInterp;
+ Slave *slavePtr;
+ InterpInfo *masterInfoPtr;
+ Tcl_HashEntry *hPtr;
+ char *path;
+ int new, objc;
+ Tcl_Obj **objv;
+ if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
+ return NULL;
+ }
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
- return TCL_ERROR;
+ masterInterp = interp;
+ path = Tcl_GetString(pathPtr);
+ } else {
+ Tcl_Obj *objPtr;
+
+ objPtr = Tcl_NewListObj(objc - 1, objv);
+ masterInterp = GetInterp(interp, objPtr);
+ Tcl_DecrRefCount(objPtr);
+ if (masterInterp == NULL) {
+ return NULL;
+ }
+ path = Tcl_GetString(objv[objc - 1]);
}
-
- masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
- if (masterPtr == (Master *) NULL) {
- panic("Tcl_InterpCmd: could not find master record");
+ if (safe == 0) {
+ safe = Tcl_IsSafe(masterInterp);
}
- result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
- 0, (int *) &index);
- if (result != TCL_OK) {
- return result;
+ masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;
+ hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &new);
+ if (new == 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "interpreter named \"", path,
+ "\" already exists, cannot create", (char *) NULL);
+ return NULL;
}
+
+ slaveInterp = Tcl_CreateInterp();
+ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
+ slavePtr->masterInterp = masterInterp;
+ slavePtr->slaveEntryPtr = hPtr;
+ slavePtr->slaveInterp = slaveInterp;
+ slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
+ SlaveObjCmd, (ClientData) slaveInterp, SlaveObjCmdDeleteProc);
+ Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
+ Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
+ Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
- switch (index) {
- case IAliasIdx:
- return InterpAliasHelper(interp, masterPtr, objc, objv);
- case IAliasesIdx:
- return InterpAliasesHelper(interp, masterPtr, objc, objv);
- case ICreateIdx:
- return CreateInterpObject(interp, masterPtr, objc, objv);
- case IDeleteIdx:
- return DeleteInterpObject(interp, masterPtr, objc, objv);
- case IEvalIdx:
- return InterpEvalHelper(interp, masterPtr, objc, objv);
- case IExistsIdx:
- return InterpExistsHelper(interp, masterPtr, objc, objv);
- case IExposeIdx:
- return InterpExposeHelper(interp, masterPtr, objc, objv);
- case IHideIdx:
- return InterpHideHelper(interp, masterPtr, objc, objv);
- case IHiddenIdx:
- return InterpHiddenHelper(interp, masterPtr, objc, objv);
- case IIsSafeIdx:
- return InterpIsSafeHelper(interp, masterPtr, objc, objv);
- case IInvokeHiddenIdx:
- return InterpInvokeHiddenHelper(interp, masterPtr, objc, objv);
- case IMarkTrustedIdx:
- return InterpMarkTrustedHelper(interp, masterPtr, objc, objv);
- case ISlavesIdx:
- return InterpSlavesHelper(interp, masterPtr, objc, objv);
- case IShareIdx:
- return InterpShareHelper(interp, masterPtr, objc, objv);
- case ITargetIdx:
- return InterpTargetHelper(interp, masterPtr, objc, objv);
- case ITransferIdx:
- return InterpTransferHelper(interp, masterPtr, objc, objv);
+ /*
+ * Inherit the recursion limit.
+ */
+ ((Interp *) slaveInterp)->maxNestingDepth =
+ ((Interp *) masterInterp)->maxNestingDepth ;
+
+ if (safe) {
+ if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
+ goto error;
+ }
+ } else {
+ if (Tcl_Init(slaveInterp) == TCL_ERROR) {
+ goto error;
+ }
}
+ return slaveInterp;
+
+ error:
+ TclTransferResult(slaveInterp, TCL_ERROR, interp);
+ Tcl_DeleteInterp(slaveInterp);
- return TCL_ERROR;
+ return NULL;
}
/*
*----------------------------------------------------------------------
*
- * SlaveAliasHelper --
+ * SlaveObjCmd --
*
- * Helper function to construct or query an alias for a slave
- * interpreter.
+ * Command to manipulate an interpreter, e.g. to send commands to it
+ * to be evaluated. One such command exists for each slave interpreter.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Potentially creates a new alias.
+ * See user documentation for details.
*
*----------------------------------------------------------------------
*/
static int
-SlaveAliasHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
+SlaveObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Slave interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Master *masterPtr;
- int len;
+ Tcl_Interp *slaveInterp;
+ int index;
+ static char *options[] = {
+ "alias", "aliases", "eval", "expose",
+ "hide", "hidden", "issafe", "invokehidden",
+ "marktrusted", NULL
+ };
+ enum options {
+ OPT_ALIAS, OPT_ALIASES, OPT_EVAL, OPT_EXPOSE,
+ OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHIDDEN,
+ OPT_MARKTRUSTED
+ };
+
+ slaveInterp = (Tcl_Interp *) clientData;
+ if (slaveInterp == NULL) {
+ panic("SlaveObjCmd: interpreter has been deleted");
+ }
- switch (objc-2) {
- case 0:
- Tcl_WrongNumArgs(interp, 2, objv,
- "aliasName ?targetName? ?args..?");
- return TCL_ERROR;
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
- case 1:
-
- /*
- * Return the name of the command in the current
- * interpreter for which the argument is an alias in the
- * slave interpreter, and the list of saved arguments
- */
-
- return DescribeAlias(interp, slaveInterp,
- Tcl_GetStringFromObj(objv[2], &len));
-
- default:
- masterPtr = (Master *) Tcl_GetAssocData(interp,
- "tclMasterRecord", NULL);
- if (masterPtr == (Master *) NULL) {
- panic("SlaveObjectCmd: could not find master record");
- }
- return AliasCreationHelper(interp, slaveInterp, interp,
- masterPtr,
- Tcl_GetStringFromObj(objv[2], &len),
- Tcl_GetStringFromObj(objv[3], &len),
- objc-4, objv+4);
+ switch ((enum options) index) {
+ case OPT_ALIAS: {
+ if (objc == 3) {
+ return AliasDescribe(interp, slaveInterp, objv[2]);
+ }
+ if (Tcl_GetString(objv[3])[0] == '\0') {
+ if (objc == 4) {
+ return AliasDelete(interp, slaveInterp, objv[2]);
+ }
+ } else {
+ return AliasCreate(interp, slaveInterp, interp, objv[2],
+ objv[3], objc - 4, objv + 4);
+ }
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "aliasName ?targetName? ?args..?");
+ return TCL_ERROR;
+ }
+ case OPT_ALIASES: {
+ return AliasList(interp, slaveInterp);
+ }
+ case OPT_EVAL: {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
+ return TCL_ERROR;
+ }
+ return SlaveEval(interp, slaveInterp, objc - 2, objv + 2);
+ }
+ case OPT_EXPOSE: {
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
+ return TCL_ERROR;
+ }
+ return SlaveExpose(interp, slaveInterp, objc - 2, objv + 2);
+ }
+ case OPT_HIDE: {
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
+ return TCL_ERROR;
+ }
+ return SlaveHide(interp, slaveInterp, objc - 2, objv + 2);
+ }
+ case OPT_HIDDEN: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ return SlaveHidden(interp, slaveInterp);
+ }
+ case OPT_ISSAFE: {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));
+ return TCL_OK;
+ }
+ case OPT_INVOKEHIDDEN: {
+ int global, i, index;
+ static char *hiddenOptions[] = {
+ "-global", "--", NULL
+ };
+ enum hiddenOption {
+ OPT_GLOBAL, OPT_LAST
+ };
+ global = 0;
+ for (i = 2; i < objc; i++) {
+ if (Tcl_GetString(objv[i])[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,
+ "option", 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == OPT_GLOBAL) {
+ global = 1;
+ } else {
+ i++;
+ break;
+ }
+ }
+ if (objc - i < 1) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-global? ?--? cmd ?arg ..?");
+ return TCL_ERROR;
+ }
+ return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,
+ objv + i);
+ }
+ case OPT_MARKTRUSTED: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ return SlaveMarkTrusted(interp, slaveInterp);
+ }
}
+
+ return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * SlaveAliasesHelper --
+ * SlaveObjCmdDeleteProc --
*
- * Computes a list of aliases defined in a slave interpreter.
+ * Invoked when an object command for a slave interpreter is deleted;
+ * cleans up all state associated with the slave interpreter and destroys
+ * the slave interpreter.
*
* Results:
- * A standard Tcl result.
+ * None.
*
* Side effects:
- * None.
+ * Cleans up all state associated with the slave interpreter and
+ * destroys the slave interpreter.
*
*----------------------------------------------------------------------
*/
-static int
-SlaveAliasesHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
+static void
+SlaveObjCmdDeleteProc(clientData)
+ ClientData clientData; /* The SlaveRecord for the command. */
{
- Tcl_HashEntry *hPtr; /* For local searches. */
- Tcl_HashSearch hSearch; /* For local searches. */
- Tcl_Obj *listObjPtr; /* Local object pointer. */
- Alias *aliasPtr; /* Alias information. */
+ Slave *slavePtr; /* Interim storage for Slave record. */
+ Tcl_Interp *slaveInterp; /* And for a slave interp. */
+
+ slaveInterp = (Tcl_Interp *) clientData;
+ slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
/*
- * Return the names of all the aliases created in the
- * slave interpreter.
+ * Unlink the slave from its master interpreter.
+ */
+
+ Tcl_DeleteHashEntry(slavePtr->slaveEntryPtr);
+
+ /*
+ * Set to NULL so that when the InterpInfo is cleaned up in the slave
+ * it does not try to delete the command causing all sorts of grief.
+ * See SlaveRecordDeleteProc().
*/
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable),
- &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(aliasPtr->aliasName, -1));
+ slavePtr->interpCmd = NULL;
+
+ if (slavePtr->slaveInterp != NULL) {
+ Tcl_DeleteInterp(slavePtr->slaveInterp);
}
- Tcl_SetObjResult(interp, listObjPtr);
- return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * SlaveEvalHelper --
+ * SlaveEval --
*
* Helper function to evaluate a command in a slave interpreter.
*
@@ -2416,84 +2002,37 @@ SlaveAliasesHelper(interp, slaveInterp, slavePtr, objc, objv)
*/
static int
-SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
+SlaveEval(interp, slaveInterp, objc, objv)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tcl_Interp *slaveInterp; /* The slave interpreter in which command
+ * will be evaluated. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Interp *iPtr; /* Internal data type for slave. */
- Tcl_Obj *objPtr; /* Local object pointer. */
- Tcl_Obj *namePtr; /* Local object pointer. */
- int len;
- char *string;
int result;
-
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
- return TCL_ERROR;
- }
-
- objPtr = Tcl_ConcatObj(objc-2, objv+2);
- Tcl_IncrRefCount(objPtr);
+ Tcl_Obj *objPtr;
Tcl_Preserve((ClientData) slaveInterp);
- result = Tcl_EvalObj(slaveInterp, objPtr);
-
- Tcl_DecrRefCount(objPtr);
-
- /*
- * Make the result and any error information accessible. We have
- * to be careful because the slave interpreter and the current
- * interpreter can be the same - do not destroy the result.. This
- * can happen if an interpreter contains an alias which is directed
- * at a target command in the same interpreter.
- */
-
- if (interp != slaveInterp) {
- if (result == TCL_ERROR) {
-
- /*
- * An error occurred, so transfer error information from the
- * destination interpreter back to our interpreter.
- */
-
- iPtr = (Interp *) slaveInterp;
- if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
- Tcl_AddErrorInfo(slaveInterp, "");
- }
- iPtr->flags &= (~(ERR_ALREADY_LOGGED));
-
- Tcl_ResetResult(interp);
- namePtr = Tcl_NewStringObj("errorInfo", -1);
- objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
- (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
- string = Tcl_GetStringFromObj(objPtr, &len);
- Tcl_AddObjErrorInfo(interp, string, len);
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(slaveInterp, "errorCode", (char *)
- NULL, TCL_GLOBAL_ONLY),
- TCL_GLOBAL_ONLY);
- Tcl_DecrRefCount(namePtr);
- }
+ Tcl_AllowExceptions(slaveInterp);
- /*
- * Move the result object from one interpreter to the
- * other.
- */
-
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
+ if (objc == 1) {
+ result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);
+ } else {
+ objPtr = Tcl_ConcatObj(objc, objv);
+ Tcl_IncrRefCount(objPtr);
+ result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
+ Tcl_DecrRefCount(objPtr);
}
+ TclTransferResult(slaveInterp, result, interp);
+
Tcl_Release((ClientData) slaveInterp);
- return result;
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * SlaveExposeHelper --
+ * SlaveExpose --
*
* Helper function to expose a command in a slave interpreter.
*
@@ -2508,33 +2047,26 @@ SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv)
*/
static int
-SlaveExposeHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
+SlaveExpose(interp, slaveInterp, objc, objv)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tcl_Interp *slaveInterp; /* Interp in which command will be exposed. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
{
- int len;
+ char *name;
- if ((objc != 3) && (objc != 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
- return TCL_ERROR;
- }
if (Tcl_IsSafe(interp)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "permission denied: safe interpreter cannot expose commands",
- (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "permission denied: safe interpreter cannot expose commands",
+ (char *) NULL);
+ return TCL_ERROR;
}
- if (Tcl_ExposeCommand(slaveInterp, Tcl_GetStringFromObj(objv[2], &len),
- (objc == 4 ?
- Tcl_GetStringFromObj(objv[3], &len) :
- Tcl_GetStringFromObj(objv[2], &len)))
- == TCL_ERROR) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
- return TCL_ERROR;
+
+ name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
+ if (Tcl_ExposeCommand(slaveInterp, Tcl_GetString(objv[0]),
+ name) != TCL_OK) {
+ TclTransferResult(slaveInterp, TCL_ERROR, interp);
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -2542,7 +2074,7 @@ SlaveExposeHelper(interp, slaveInterp, slavePtr, objc, objv)
/*
*----------------------------------------------------------------------
*
- * SlaveHideHelper --
+ * SlaveHide --
*
* Helper function to hide a command in a slave interpreter.
*
@@ -2557,33 +2089,26 @@ SlaveExposeHelper(interp, slaveInterp, slavePtr, objc, objv)
*/
static int
-SlaveHideHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
+SlaveHide(interp, slaveInterp, objc, objv)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tcl_Interp *slaveInterp; /* Interp in which command will be exposed. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
{
- int len;
-
- if ((objc != 3) && (objc != 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
- return TCL_ERROR;
- }
+ char *name;
+
if (Tcl_IsSafe(interp)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "permission denied: safe interpreter cannot hide commands",
- (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "permission denied: safe interpreter cannot hide commands",
+ (char *) NULL);
+ return TCL_ERROR;
}
- if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[2], &len),
- (objc == 4 ?
- Tcl_GetStringFromObj(objv[3], &len) :
- Tcl_GetStringFromObj(objv[2], &len)))
- == TCL_ERROR) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
- return TCL_ERROR;
+
+ name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
+ if (Tcl_HideCommand(slaveInterp, Tcl_GetString(objv[0]),
+ name) != TCL_OK) {
+ TclTransferResult(slaveInterp, TCL_ERROR, interp);
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -2591,7 +2116,7 @@ SlaveHideHelper(interp, slaveInterp, slavePtr, objc, objv)
/*
*----------------------------------------------------------------------
*
- * SlaveHiddenHelper --
+ * SlaveHidden --
*
* Helper function to compute list of hidden commands in a slave
* interpreter.
@@ -2606,78 +2131,33 @@ SlaveHideHelper(interp, slaveInterp, slavePtr, objc, objv)
*/
static int
-SlaveHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
+SlaveHidden(interp, slaveInterp)
+ Tcl_Interp *interp; /* Interp for data return. */
+ Tcl_Interp *slaveInterp; /* Interp whose hidden commands to query. */
{
Tcl_Obj *listObjPtr; /* Local object pointer. */
Tcl_HashTable *hTblPtr; /* For local searches. */
Tcl_HashEntry *hPtr; /* For local searches. */
Tcl_HashSearch hSearch; /* For local searches. */
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
- return TCL_ERROR;
- }
-
- listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
- "tclHiddenCmds", NULL);
+ listObjPtr = Tcl_GetObjResult(interp);
+ hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr;
if (hTblPtr != (Tcl_HashTable *) NULL) {
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- Tcl_ListObjAppendElement(interp, listObjPtr,
- Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
- }
- }
- Tcl_SetObjResult(interp, listObjPtr);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SlaveIsSafeHelper --
- *
- * Helper function to compute whether a slave interpreter is safe.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != (Tcl_HashEntry *) NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
-static int
-SlaveIsSafeHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
-{
- Tcl_Obj *resultPtr; /* Local object pointer. */
-
- if (objc > 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
- return TCL_ERROR;
+ Tcl_ListObjAppendElement(NULL, listObjPtr,
+ Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
+ }
}
- resultPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
-
- Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * SlaveInvokeHiddenHelper --
+ * SlaveInvokeHidden --
*
* Helper function to invoke a hidden command in a slave interpreter.
*
@@ -2691,96 +2171,35 @@ SlaveIsSafeHelper(interp, slaveInterp, slavePtr, objc, objv)
*/
static int
-SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
+SlaveInvokeHidden(interp, slaveInterp, global, objc, objv)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tcl_Interp *slaveInterp; /* The slave interpreter in which command
+ * will be invoked. */
+ int global; /* Non-zero to invoke in global namespace. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Interp *iPtr;
- Master *masterPtr;
- int doGlobal = 0;
int result;
- int len;
- char *string;
- Tcl_Obj *namePtr, *objPtr;
-
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-global? cmd ?arg ..?");
- return TCL_ERROR;
- }
+
if (Tcl_IsSafe(interp)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "not allowed to invoke hidden commands from safe interpreter",
- (char *) NULL);
- return TCL_ERROR;
- }
- if (strcmp(Tcl_GetStringFromObj(objv[2], &len), "-global") == 0) {
- doGlobal = 1;
- if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "path ?-global? cmd ?arg ..?");
- return TCL_ERROR;
- }
- }
- masterPtr = (Master *) Tcl_GetAssocData(slaveInterp,
- "tclMasterRecord", NULL);
- if (masterPtr == (Master *) NULL) {
- panic("SlaveObjectCmd: could not find master record");
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "not allowed to invoke hidden commands from safe interpreter",
+ -1);
+ return TCL_ERROR;
}
+
Tcl_Preserve((ClientData) slaveInterp);
- if (doGlobal) {
- result = TclObjInvokeGlobal(slaveInterp, objc-3, objv+3,
+ Tcl_AllowExceptions(slaveInterp);
+
+ if (global) {
+ result = TclObjInvokeGlobal(slaveInterp, objc, objv,
TCL_INVOKE_HIDDEN);
} else {
- result = TclObjInvoke(slaveInterp, objc-2, objv+2,
- TCL_INVOKE_HIDDEN);
+ result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
}
- /*
- * Now make the result and any error information accessible. We
- * have to be careful because the slave interpreter and the current
- * interpreter can be the same - do not destroy the result.. This
- * can happen if an interpreter contains an alias which is directed
- * at a target command in the same interpreter.
- */
-
- if (interp != slaveInterp) {
- if (result == TCL_ERROR) {
-
- /*
- * An error occurred, so transfer error information from
- * the target interpreter back to our interpreter.
- */
-
- iPtr = (Interp *) slaveInterp;
- if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
- Tcl_AddErrorInfo(slaveInterp, "");
- }
- iPtr->flags &= (~(ERR_ALREADY_LOGGED));
-
- Tcl_ResetResult(interp);
- namePtr = Tcl_NewStringObj("errorInfo", -1);
- objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
- (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
- string = Tcl_GetStringFromObj(objPtr, &len);
- Tcl_AddObjErrorInfo(interp, string, len);
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(slaveInterp, "errorCode", (char *)
- NULL, TCL_GLOBAL_ONLY),
- TCL_GLOBAL_ONLY);
- Tcl_DecrRefCount(namePtr);
- }
+ TclTransferResult(slaveInterp, result, interp);
- /*
- * Move the result object from the slave to the master.
- */
-
- Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
- Tcl_ResetResult(slaveInterp);
- }
Tcl_Release((ClientData) slaveInterp);
return result;
}
@@ -2788,7 +2207,7 @@ SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
/*
*----------------------------------------------------------------------
*
- * SlaveMarkTrustedHelper --
+ * SlaveMarkTrusted --
*
* Helper function to mark a slave interpreter as trusted (unsafe).
*
@@ -2803,675 +2222,18 @@ SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
*/
static int
-SlaveMarkTrustedHelper(interp, slaveInterp, slavePtr, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- Tcl_Interp *slaveInterp; /* The slave interpreter. */
- Slave *slavePtr; /* Its slave record. */
- int objc; /* Count of arguments. */
- Tcl_Obj *CONST objv[]; /* Vector of arguments. */
+SlaveMarkTrusted(interp, slaveInterp)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tcl_Interp *slaveInterp; /* The slave interpreter which will be
+ * marked trusted. */
{
- int len;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
- return TCL_ERROR;
- }
if (Tcl_IsSafe(interp)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "\"", Tcl_GetStringFromObj(objv[0], &len), " marktrusted\"",
- " can only be invoked from a trusted interpreter",
- (char *) NULL);
- return TCL_ERROR;
- }
- return MarkTrusted(slaveInterp);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SlaveObjectCmd --
- *
- * Command to manipulate an interpreter, e.g. to send commands to it
- * to be evaluated. One such command exists for each slave interpreter.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See user documentation for details.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SlaveObjectCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Slave interpreter. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument vector. */
-{
- Slave *slavePtr; /* Slave record. */
- Tcl_Interp *slaveInterp; /* Slave interpreter. */
- int result; /* Loop counter, status return. */
- int len; /* Length of command name. */
-
- /*
- * These are all the different subcommands for this command:
- */
-
- static char *subCmds[] = {
- "alias", "aliases",
- "eval", "expose",
- "hide", "hidden",
- "issafe", "invokehidden",
- "marktrusted",
- (char *) NULL};
- enum ISubCmdIdx {
- IAliasIdx, IAliasesIdx,
- IEvalIdx, IExposeIdx,
- IHideIdx, IHiddenIdx,
- IIsSafeIdx, IInvokeHiddenIdx,
- IMarkTrustedIdx
- } index;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
- return TCL_ERROR;
- }
-
- slaveInterp = (Tcl_Interp *) clientData;
- if (slaveInterp == (Tcl_Interp *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "interpreter ", Tcl_GetStringFromObj(objv[0], &len),
- " has been deleted", (char *) NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "permission denied: safe interpreter cannot mark trusted",
+ (char *) NULL);
return TCL_ERROR;
}
-
- slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
- "tclSlaveRecord", NULL);
- if (slavePtr == (Slave *) NULL) {
- panic("SlaveObjectCmd: could not find slave record");
- }
-
- result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
- 0, (int *) &index);
- if (result != TCL_OK) {
- return result;
- }
-
- switch (index) {
- case IAliasIdx:
- return SlaveAliasHelper(interp, slaveInterp, slavePtr, objc, objv);
- case IAliasesIdx:
- return SlaveAliasesHelper(interp, slaveInterp, slavePtr,
- objc, objv);
- case IEvalIdx:
- return SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv);
- case IExposeIdx:
- return SlaveExposeHelper(interp, slaveInterp, slavePtr,
- objc, objv);
- case IHideIdx:
- return SlaveHideHelper(interp, slaveInterp, slavePtr,
- objc, objv);
- case IHiddenIdx:
- return SlaveHiddenHelper(interp, slaveInterp, slavePtr,
- objc, objv);
- case IIsSafeIdx:
- return SlaveIsSafeHelper(interp, slaveInterp, slavePtr,
- objc, objv);
- case IInvokeHiddenIdx:
- return SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr,
- objc, objv);
- case IMarkTrustedIdx:
- return SlaveMarkTrustedHelper(interp, slaveInterp, slavePtr,
- objc, objv);
- }
-
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SlaveObjectDeleteProc --
- *
- * Invoked when an object command for a slave interpreter is deleted;
- * cleans up all state associated with the slave interpreter and destroys
- * the slave interpreter.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Cleans up all state associated with the slave interpreter and
- * destroys the slave interpreter.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SlaveObjectDeleteProc(clientData)
- ClientData clientData; /* The SlaveRecord for the command. */
-{
- Slave *slavePtr; /* Interim storage for Slave record. */
- Tcl_Interp *slaveInterp; /* And for a slave interp. */
-
- slaveInterp = (Tcl_Interp *) clientData;
- slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",NULL);
- if (slavePtr == (Slave *) NULL) {
- panic("SlaveObjectDeleteProc: could not find slave record");
- }
-
- /*
- * Delete the entry in the slave table in the master interpreter now.
- * This is to avoid an infinite loop in the Master hash table cleanup in
- * the master interpreter. This can happen if this slave is being deleted
- * because the master is being deleted and the slave deletion is deferred
- * because it is still active.
- */
-
- Tcl_DeleteHashEntry(slavePtr->slaveEntry);
-
- /*
- * Set to NULL so that when the slave record is cleaned up in the slave
- * it does not try to delete the command causing all sorts of grief.
- * See SlaveRecordDeleteProc().
- */
-
- slavePtr->interpCmd = NULL;
-
- /*
- * Destroy the interpreter - this will cause all the deleteProcs for
- * all commands (including aliases) to run.
- *
- * NOTE: WE ASSUME THAT THE INTERPRETER HAS NOT BEEN DELETED YET!!
- */
-
- Tcl_DeleteInterp(slavePtr->slaveInterp);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AliasCmd --
- *
- * This is the procedure that services invocations of aliases in a
- * slave interpreter. One such command exists for each alias. When
- * invoked, this procedure redirects the invocation to the target
- * command in the master interpreter as designated by the Alias
- * record associated with this command.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Causes forwarding of the invocation; all possible side effects
- * may occur as a result of invoking the command to which the
- * invocation is forwarded.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-AliasCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Alias record. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument vector. */
-{
- Tcl_Interp *targetInterp; /* Target for alias exec. */
- Interp *iPtr; /* Internal type of target. */
- Alias *aliasPtr; /* Describes the alias. */
- Tcl_Command cmd; /* The target command. */
- Command *cmdPtr; /* Points to target command. */
- Tcl_Namespace *targetNsPtr; /* Target command's namespace. */
- int result; /* Result of execution. */
- int i, j, addObjc; /* Loop counters. */
- int localObjc; /* Local argument count. */
- Tcl_Obj **localObjv; /* Local argument vector. */
- Tcl_Obj *namePtr, *objPtr; /* Local object pointers. */
- char *string; /* Local object string rep. */
- int len; /* Dummy length arg. */
-
- aliasPtr = (Alias *) clientData;
- targetInterp = aliasPtr->targetInterp;
-
- /*
- * Look for the target command in the global namespace of the target
- * interpreter.
- */
-
- cmdPtr = NULL;
- targetNsPtr = Tcl_GetGlobalNamespace(aliasPtr->targetInterp);
- cmd = Tcl_FindCommand(targetInterp, aliasPtr->targetName,
- targetNsPtr, /*flags*/ 0);
- if (cmd != (Tcl_Command) NULL) {
- cmdPtr = (Command *) cmd;
- }
-
- iPtr = (Interp *) targetInterp;
-
- /*
- * If the command does not exist, invoke "unknown" in the master.
- */
-
- if (cmdPtr == NULL) {
- addObjc = aliasPtr->objc;
- localObjc = addObjc + objc + 1;
- localObjv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *)
- * localObjc);
-
- localObjv[0] = Tcl_NewStringObj("unknown", -1);
- localObjv[1] = Tcl_NewStringObj(aliasPtr->targetName, -1);
- Tcl_IncrRefCount(localObjv[0]);
- Tcl_IncrRefCount(localObjv[1]);
-
- for (i = 0, j = 2; i < addObjc; i++, j++) {
- localObjv[j] = aliasPtr->objv[i];
- }
- for (i = 1; i < objc; i++, j++) {
- localObjv[j] = objv[i];
- }
- Tcl_Preserve((ClientData) targetInterp);
- result = TclObjInvoke(targetInterp, localObjc, localObjv, 0);
-
- Tcl_DecrRefCount(localObjv[0]);
- Tcl_DecrRefCount(localObjv[1]);
-
- ckfree((char *) localObjv);
-
- if (targetInterp != interp) {
- if (result == TCL_ERROR) {
-
- /*
- * An error occurred, so transfer error information from
- * the target interpreter back to our interpreter.
- */
-
- if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
- Tcl_AddErrorInfo((Tcl_Interp *) iPtr, "");
- }
- iPtr->flags &= (~(ERR_ALREADY_LOGGED));
-
- Tcl_ResetResult(interp);
- namePtr = Tcl_NewStringObj("errorInfo", -1);
- objPtr = Tcl_ObjGetVar2(targetInterp, namePtr,
- (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
- string = Tcl_GetStringFromObj(objPtr, &len);
- Tcl_AddObjErrorInfo(interp, string, len);
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(targetInterp, "errorCode", (char *)
- NULL, TCL_GLOBAL_ONLY),
- TCL_GLOBAL_ONLY);
- Tcl_DecrRefCount(namePtr);
- }
-
- /*
- * Transfer the result from the target interpreter to the
- * calling interpreter.
- */
-
- Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
- Tcl_ResetResult(targetInterp);
- }
-
- Tcl_Release((ClientData) targetInterp);
- return result;
- }
-
- /*
- * Otherwise invoke the regular target command.
- */
-
- if (aliasPtr->objc <= 0) {
- localObjv = (Tcl_Obj **) objv;
- localObjc = objc;
- } else {
- addObjc = aliasPtr->objc;
- localObjc = objc + addObjc;
- localObjv =
- (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * localObjc);
- localObjv[0] = objv[0];
- for (i = 0, j = 1; i < addObjc; i++, j++) {
- localObjv[j] = aliasPtr->objv[i];
- }
- for (i = 1; i < objc; i++, j++) {
- localObjv[j] = objv[i];
- }
- }
-
- iPtr->numLevels++;
- Tcl_Preserve((ClientData) targetInterp);
-
- /*
- * Reset the interpreter to its clean state; we do not know what state
- * it is in now..
- */
-
- Tcl_ResetResult(targetInterp);
- result = (cmdPtr->objProc)(cmdPtr->objClientData, targetInterp,
- localObjc, localObjv);
-
- iPtr->numLevels--;
-
- /*
- * Check if we are at the bottom of the stack for the target interpreter.
- * If so, check for special return codes.
- */
-
- if (iPtr->numLevels == 0) {
- if (result == TCL_RETURN) {
- result = TclUpdateReturnInfo(iPtr);
- }
- if ((result != TCL_OK) && (result != TCL_ERROR)) {
- Tcl_ResetResult(targetInterp);
- if (result == TCL_BREAK) {
- Tcl_SetObjResult(targetInterp,
- Tcl_NewStringObj("invoked \"break\" outside of a loop",
- -1));
- } else if (result == TCL_CONTINUE) {
- Tcl_SetObjResult(targetInterp,
- Tcl_NewStringObj(
- "invoked \"continue\" outside of a loop",
- -1));
- } else {
- char buf[128];
-
- sprintf(buf, "command returned bad code: %d", result);
- Tcl_SetObjResult(targetInterp, Tcl_NewStringObj(buf, -1));
- }
- result = TCL_ERROR;
- }
- }
-
- /*
- * Clean up any locally allocated argument vector structure.
- */
-
- if (localObjv != objv) {
- ckfree((char *) localObjv);
- }
-
- /*
- * Move the result from the target interpreter to the invoking
- * interpreter if they are different.
- *
- * Note: We cannot use aliasPtr any more because the alias may have
- * been deleted.
- */
-
- if (interp != targetInterp) {
- if (result == TCL_ERROR) {
-
- /*
- * An error occurred, so transfer the error information from
- * the target interpreter back to our interpreter.
- */
-
- if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
- Tcl_AddErrorInfo(targetInterp, "");
- }
- iPtr->flags &= (~(ERR_ALREADY_LOGGED));
-
- Tcl_ResetResult(interp);
- namePtr = Tcl_NewStringObj("errorInfo", -1);
- objPtr = Tcl_ObjGetVar2(targetInterp, namePtr, (Tcl_Obj *) NULL,
- TCL_GLOBAL_ONLY);
- string = Tcl_GetStringFromObj(objPtr, &len);
- Tcl_AddObjErrorInfo(interp, string, len);
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(targetInterp, "errorCode", (char *) NULL,
- TCL_GLOBAL_ONLY),
- TCL_GLOBAL_ONLY);
- Tcl_DecrRefCount(namePtr);
- }
-
- /*
- * Move the result object from one interpreter to the
- * other.
- */
-
- Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
- Tcl_ResetResult(targetInterp);
- }
- Tcl_Release((ClientData) targetInterp);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AliasCmdDeleteProc --
- *
- * Is invoked when an alias command is deleted in a slave. Cleans up
- * all storage associated with this alias.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Deletes the alias record and its entry in the alias table for
- * the interpreter.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AliasCmdDeleteProc(clientData)
- ClientData clientData; /* The alias record for this alias. */
-{
- Alias *aliasPtr; /* Alias record for alias to delete. */
- Target *targetPtr; /* Record for target of this alias. */
- int i; /* Loop counter. */
-
- aliasPtr = (Alias *) clientData;
-
- targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntry);
- ckfree((char *) targetPtr);
- Tcl_DeleteHashEntry(aliasPtr->targetEntry);
-
- ckfree((char *) aliasPtr->targetName);
- ckfree((char *) aliasPtr->aliasName);
- for (i = 0; i < aliasPtr->objc; i++) {
- Tcl_DecrRefCount(aliasPtr->objv[i]);
- }
- if (aliasPtr->objv != (Tcl_Obj **) NULL) {
- ckfree((char *) aliasPtr->objv);
- }
-
- Tcl_DeleteHashEntry(aliasPtr->aliasEntry);
-
- ckfree((char *) aliasPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MasterRecordDeleteProc -
- *
- * Is invoked when an interpreter (which is using the "interp" facility)
- * is deleted, and it cleans up the storage associated with the
- * "tclMasterRecord" assoc-data entry.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Cleans up storage.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-MasterRecordDeleteProc(clientData, interp)
- ClientData clientData; /* Master record for deleted interp. */
- Tcl_Interp *interp; /* Interpreter being deleted. */
-{
- Target *targetPtr; /* Loop variable. */
- Tcl_HashEntry *hPtr; /* Search element. */
- Tcl_HashSearch hSearch; /* Search record (internal). */
- Slave *slavePtr; /* Loop variable. */
- Master *masterPtr; /* Interim storage. */
-
- masterPtr = (Master *) clientData;
- for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
- hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
- (void) Tcl_DeleteCommandFromToken(interp, slavePtr->interpCmd);
- }
- Tcl_DeleteHashTable(&(masterPtr->slaveTable));
-
- for (hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch);
- hPtr != NULL;
- hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch)) {
- targetPtr = (Target *) Tcl_GetHashValue(hPtr);
- (void) Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
- targetPtr->slaveCmd);
- }
- Tcl_DeleteHashTable(&(masterPtr->targetTable));
-
- ckfree((char *) masterPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SlaveRecordDeleteProc --
- *
- * Is invoked when an interpreter (which is using the interp facility)
- * is deleted, and it cleans up the storage associated with the
- * tclSlaveRecord assoc-data entry.
- *
- * Results:
- * None
- *
- * Side effects:
- * Cleans up storage.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SlaveRecordDeleteProc(clientData, interp)
- ClientData clientData; /* Slave record for deleted interp. */
- Tcl_Interp *interp; /* Interpreter being deleted. */
-{
- Slave *slavePtr; /* Interim storage. */
- Alias *aliasPtr;
- Tcl_HashTable *hTblPtr;
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch hSearch;
-
- slavePtr = (Slave *) clientData;
-
- /*
- * In every case that we call SetAssocData on "tclSlaveRecord",
- * slavePtr is not NULL. Otherwise we panic.
- */
-
- if (slavePtr == NULL) {
- panic("SlaveRecordDeleteProc: NULL slavePtr");
- }
-
- if (slavePtr->interpCmd != (Tcl_Command) NULL) {
- Command *cmdPtr = (Command *) slavePtr->interpCmd;
-
- /*
- * The interpCmd has not been deleted in the master yet, since
- * it's callback sets interpCmd to NULL.
- *
- * Probably Tcl_DeleteInterp() was called on this interpreter directly,
- * rather than via "interp delete", or equivalent (deletion of the
- * command in the master).
- *
- * Perform the cleanup done by SlaveObjectDeleteProc() directly,
- * and turn off the callback now (since we are about to free slavePtr
- * and this interpreter is going away, while the deletion of commands
- * in the master may be deferred).
- */
-
- Tcl_DeleteHashEntry(slavePtr->slaveEntry);
- cmdPtr->clientData = NULL;
- cmdPtr->deleteProc = NULL;
- cmdPtr->deleteData = NULL;
-
- Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
- slavePtr->interpCmd);
- }
-
- /*
- * If there are any aliases, delete those now. This removes any
- * dependency on the order of deletion between commands and the
- * slave record.
- */
-
- hTblPtr = (Tcl_HashTable *) &(slavePtr->aliasTable);
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-
- /*
- * The call to Tcl_DeleteCommand will release the storage
- * occupied by the hash entry and the alias record.
- */
-
- Tcl_DeleteCommandFromToken(interp, aliasPtr->slaveCmd);
- }
-
- /*
- * Finally dispose of the hash table and the slave record.
- */
-
- Tcl_DeleteHashTable(hTblPtr);
- ckfree((char *) slavePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInterpInit --
- *
- * Initializes the invoking interpreter for using the "interp"
- * facility. This is called from inside Tcl_Init.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Adds the "interp" command to an interpreter and initializes several
- * records in the associated data of the invoking interpreter.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclInterpInit(interp)
- Tcl_Interp *interp; /* Interpreter to initialize. */
-{
- Master *masterPtr; /* Its Master record. */
- Slave *slavePtr; /* And its slave record. */
-
- masterPtr = (Master *) ckalloc((unsigned) sizeof(Master));
-
- Tcl_InitHashTable(&(masterPtr->slaveTable), TCL_STRING_KEYS);
- Tcl_InitHashTable(&(masterPtr->targetTable), TCL_ONE_WORD_KEYS);
-
- (void) Tcl_SetAssocData(interp, "tclMasterRecord", MasterRecordDeleteProc,
- (ClientData) masterPtr);
-
- slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
-
- slavePtr->masterInterp = (Tcl_Interp *) NULL;
- slavePtr->slaveEntry = (Tcl_HashEntry *) NULL;
- slavePtr->slaveInterp = interp;
- slavePtr->interpCmd = (Tcl_Command) NULL;
- Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
-
- (void) Tcl_SetAssocData(interp, "tclSlaveRecord", SlaveRecordDeleteProc,
- (ClientData) slavePtr);
-
+ ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
return TCL_OK;
}
@@ -3508,328 +2270,86 @@ Tcl_IsSafe(interp)
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateSlave --
- *
- * Creates a slave interpreter. The slavePath argument denotes the
- * name of the new slave relative to the current interpreter; the
- * slave is a direct descendant of the one-before-last component of
- * the path, e.g. it is a descendant of the current interpreter if
- * the slavePath argument contains only one component. Optionally makes
- * the slave interpreter safe.
- *
- * Results:
- * Returns the interpreter structure created, or NULL if an error
- * occurred.
- *
- * Side effects:
- * Creates a new interpreter and a new interpreter object command in
- * the interpreter indicated by the slavePath argument.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Interp *
-Tcl_CreateSlave(interp, slavePath, isSafe)
- Tcl_Interp *interp; /* Interpreter to start search at. */
- char *slavePath; /* Name of slave to create. */
- int isSafe; /* Should new slave be "safe" ? */
-{
- Master *masterPtr; /* Master record for same. */
-
- if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
- return NULL;
- }
- masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
- NULL);
- if (masterPtr == (Master *) NULL) {
- panic("CreatSlave: could not find master record");
- }
- return CreateSlave(interp, masterPtr, slavePath, isSafe);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetSlave --
- *
- * Finds a slave interpreter by its path name.
- *
- * Results:
- * Returns a Tcl_Interp * for the named interpreter or NULL if not
- * found.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Interp *
-Tcl_GetSlave(interp, slavePath)
- Tcl_Interp *interp; /* Interpreter to start search from. */
- char *slavePath; /* Path of slave to find. */
-{
- Master *masterPtr; /* Interim storage for Master record. */
-
- if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
- return NULL;
- }
- masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
- if (masterPtr == (Master *) NULL) {
- panic("Tcl_GetSlave: could not find master record");
- }
- return GetInterp(interp, masterPtr, slavePath, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetMaster --
+ * Tcl_MakeSafe --
*
- * Finds the master interpreter of a slave interpreter.
+ * Makes its argument interpreter contain only functionality that is
+ * defined to be part of Safe Tcl. Unsafe commands are hidden, the
+ * env array is unset, and the standard channels are removed.
*
* Results:
- * Returns a Tcl_Interp * for the master interpreter or NULL if none.
- *
- * Side effects:
* None.
*
- *----------------------------------------------------------------------
- */
-
-Tcl_Interp *
-Tcl_GetMaster(interp)
- Tcl_Interp *interp; /* Get the master of this interpreter. */
-{
- Slave *slavePtr; /* Slave record of this interpreter. */
-
- if (interp == (Tcl_Interp *) NULL) {
- return NULL;
- }
- slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
- if (slavePtr == (Slave *) NULL) {
- return NULL;
- }
- return slavePtr->masterInterp;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateAlias --
- *
- * Creates an alias between two interpreters.
- *
- * Results:
- * A standard Tcl result.
- *
* Side effects:
- * Creates a new alias, manipulates the result field of slaveInterp.
+ * Hides commands in its argument interpreter, and removes settings
+ * and channels.
*
*----------------------------------------------------------------------
*/
int
-Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
- Tcl_Interp *slaveInterp; /* Interpreter for source command. */
- char *slaveCmd; /* Command to install in slave. */
- Tcl_Interp *targetInterp; /* Interpreter for target command. */
- char *targetCmd; /* Name of target command. */
- int argc; /* How many additional arguments? */
- char **argv; /* These are the additional args. */
+Tcl_MakeSafe(interp)
+ Tcl_Interp *interp; /* Interpreter to be made safe. */
{
- Master *masterPtr; /* Master record for target interp. */
- Tcl_Obj **objv;
- int i;
- int result;
-
- if ((slaveInterp == (Tcl_Interp *) NULL) ||
- (targetInterp == (Tcl_Interp *) NULL) ||
- (slaveCmd == (char *) NULL) ||
- (targetCmd == (char *) NULL)) {
- return TCL_ERROR;
- }
- masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
- NULL);
- if (masterPtr == (Master *) NULL) {
- panic("Tcl_CreateAlias: could not find master record");
- }
- objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
- for (i = 0; i < argc; i++) {
- objv[i] = Tcl_NewStringObj(argv[i], -1);
- Tcl_IncrRefCount(objv[i]);
- }
+ Tcl_Channel chan; /* Channel to remove from
+ * safe interpreter. */
+ Interp *iPtr = (Interp *) interp;
+
+ TclHideUnsafeCommands(interp);
- result = AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
- masterPtr, slaveCmd, targetCmd, argc, objv);
+ iPtr->flags |= SAFE_INTERP;
- ckfree((char *) objv);
+ /*
+ * Unsetting variables : (which should not have been set
+ * in the first place, but...)
+ */
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateAliasObj --
- *
- * Object version: Creates an alias between two interpreters.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Creates a new alias.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * No env array in a safe slave.
+ */
-int
-Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
- Tcl_Interp *slaveInterp; /* Interpreter for source command. */
- char *slaveCmd; /* Command to install in slave. */
- Tcl_Interp *targetInterp; /* Interpreter for target command. */
- char *targetCmd; /* Name of target command. */
- int objc; /* How many additional arguments? */
- Tcl_Obj *CONST objv[]; /* Argument vector. */
-{
- Master *masterPtr; /* Master record for target interp. */
+ Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);
- if ((slaveInterp == (Tcl_Interp *) NULL) ||
- (targetInterp == (Tcl_Interp *) NULL) ||
- (slaveCmd == (char *) NULL) ||
- (targetCmd == (char *) NULL)) {
- return TCL_ERROR;
- }
- masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
- NULL);
- if (masterPtr == (Master *) NULL) {
- panic("Tcl_CreateAlias: could not find master record");
- }
- return AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
- masterPtr, slaveCmd, targetCmd, objc, objv);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetAlias --
- *
- * Gets information about an alias.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * Remove unsafe parts of tcl_platform
+ */
-int
-Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
- argvPtr)
- Tcl_Interp *interp; /* Interp to start search from. */
- char *aliasName; /* Name of alias to find. */
- Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
- char **targetNamePtr; /* (Return) name of target command. */
- int *argcPtr; /* (Return) count of addnl args. */
- char ***argvPtr; /* (Return) additional arguments. */
-{
- Slave *slavePtr; /* Slave record for slave interp. */
- Tcl_HashEntry *hPtr; /* Search element. */
- Alias *aliasPtr; /* Storage for alias found. */
- int len;
- int i;
+ Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
+ Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
+ Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
+ Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY);
- if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
- return TCL_ERROR;
- }
- slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
- if (slavePtr == (Slave *) NULL) {
- panic("Tcl_GetAlias: could not find slave record");
- }
- hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
- (char *) NULL);
- return TCL_ERROR;
- }
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
- if (targetInterpPtr != (Tcl_Interp **) NULL) {
- *targetInterpPtr = aliasPtr->targetInterp;
- }
- if (targetNamePtr != (char **) NULL) {
- *targetNamePtr = aliasPtr->targetName;
- }
- if (argcPtr != (int *) NULL) {
- *argcPtr = aliasPtr->objc;
- }
- if (argvPtr != (char ***) NULL) {
- *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) *
- aliasPtr->objc);
- for (i = 0; i < aliasPtr->objc; i++) {
- *argvPtr[i] = Tcl_GetStringFromObj(aliasPtr->objv[i], &len);
- }
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ObjGetAlias --
- *
- * Object version: Gets information about an alias.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * Unset path informations variables
+ * (the only one remaining is [info nameofexecutable])
+ */
-int
-Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
- objvPtr)
- Tcl_Interp *interp; /* Interp to start search from. */
- char *aliasName; /* Name of alias to find. */
- Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
- char **targetNamePtr; /* (Return) name of target command. */
- int *objcPtr; /* (Return) count of addnl args. */
- Tcl_Obj ***objvPtr; /* (Return) additional args. */
-{
- Slave *slavePtr; /* Slave record for slave interp. */
- Tcl_HashEntry *hPtr; /* Search element. */
- Alias *aliasPtr; /* Storage for alias found. */
+ Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
+ Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
+ Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);
+
+ /*
+ * Remove the standard channels from the interpreter; safe interpreters
+ * do not ordinarily have access to stdin, stdout and stderr.
+ *
+ * NOTE: These channels are not added to the interpreter by the
+ * Tcl_CreateInterp call, but may be added later, by another I/O
+ * operation. We want to ensure that the interpreter does not have
+ * these channels even if it is being made safe after being used for
+ * some time..
+ */
- if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
- return TCL_ERROR;
- }
- slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
- if (slavePtr == (Slave *) NULL) {
- panic("Tcl_GetAlias: could not find slave record");
- }
- hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "alias \"", aliasName, "\" not found", (char *) NULL);
- return TCL_ERROR;
- }
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
- if (targetInterpPtr != (Tcl_Interp **) NULL) {
- *targetInterpPtr = aliasPtr->targetInterp;
- }
- if (targetNamePtr != (char **) NULL) {
- *targetNamePtr = aliasPtr->targetName;
+ chan = Tcl_GetStdChannel(TCL_STDIN);
+ if (chan != (Tcl_Channel) NULL) {
+ Tcl_UnregisterChannel(interp, chan);
}
- if (objcPtr != (int *) NULL) {
- *objcPtr = aliasPtr->objc;
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != (Tcl_Channel) NULL) {
+ Tcl_UnregisterChannel(interp, chan);
}
- if (objvPtr != (Tcl_Obj ***) NULL) {
- *objvPtr = aliasPtr->objv;
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan != (Tcl_Channel) NULL) {
+ Tcl_UnregisterChannel(interp, chan);
}
+
return TCL_OK;
}
diff --git a/tcl/generic/tclLink.c b/tcl/generic/tclLink.c
index 7addcd2e305..13c5691a863 100644
--- a/tcl/generic/tclLink.c
+++ b/tcl/generic/tclLink.c
@@ -8,7 +8,7 @@
* him.
*
* Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -74,7 +74,8 @@ static char * StringValue _ANSI_ARGS_((Link *linkPtr,
*
* Results:
* The return value is TCL_OK if everything went well or TCL_ERROR
- * if an error occurred (interp->result is also set after errors).
+ * if an error occurred (the interp's result is also set after
+ * errors).
*
* Side effects:
* The value at *addr is linked to the Tcl variable "varName",
@@ -234,8 +235,8 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
Link *linkPtr = (Link *) clientData;
int changed;
char buffer[TCL_DOUBLE_SPACE];
- char *value, **pp;
- Tcl_DString savedResult;
+ char *value, **pp, *result;
+ Tcl_Obj *objPtr;
/*
* If the variable is being unset, then just re-create it (with a
@@ -315,36 +316,42 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*/
return "internal error: linked variable couldn't be read";
}
- Tcl_DStringInit(&savedResult);
- Tcl_DStringAppend(&savedResult, interp->result, -1);
+
+ objPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(objPtr);
Tcl_ResetResult(interp);
+ result = NULL;
+
switch (linkPtr->type) {
case TCL_LINK_INT:
if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
- Tcl_DStringResult(interp, &savedResult);
+ Tcl_SetObjResult(interp, objPtr);
Tcl_SetVar(interp, linkPtr->varName,
StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- return "variable must have integer value";
+ result = "variable must have integer value";
+ goto end;
}
*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
break;
case TCL_LINK_DOUBLE:
if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d)
!= TCL_OK) {
- Tcl_DStringResult(interp, &savedResult);
+ Tcl_SetObjResult(interp, objPtr);
Tcl_SetVar(interp, linkPtr->varName,
StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- return "variable must have real value";
+ result = "variable must have real value";
+ goto end;
}
*(double *)(linkPtr->addr) = linkPtr->lastValue.d;
break;
case TCL_LINK_BOOLEAN:
if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i)
!= TCL_OK) {
- Tcl_DStringResult(interp, &savedResult);
+ Tcl_SetObjResult(interp, objPtr);
Tcl_SetVar(interp, linkPtr->varName,
StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- return "variable must have boolean value";
+ result = "variable must have boolean value";
+ goto end;
}
*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
break;
@@ -359,8 +366,9 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
default:
return "internal error: bad linked variable type";
}
- Tcl_DStringResult(interp, &savedResult);
- return NULL;
+ end:
+ Tcl_DecrRefCount(objPtr);
+ return result;
}
/*
@@ -372,8 +380,7 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
* Tcl variable to which it is linked.
*
* Results:
- * The return value is a pointer
- to a string that represents
+ * The return value is a pointer to a string that represents
* the value of the C variable given by linkPtr.
*
* Side effects:
diff --git a/tcl/generic/tclListObj.c b/tcl/generic/tclListObj.c
index c7d9bca44a4..0e22a6020ac 100644
--- a/tcl/generic/tclListObj.c
+++ b/tcl/generic/tclListObj.c
@@ -236,14 +236,16 @@ Tcl_SetListObj(objPtr, objc, objv)
* Free any old string rep and any internal rep for the old type.
*/
- Tcl_InvalidateStringRep(objPtr);
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
oldTypePtr->freeIntRepProc(objPtr);
}
objPtr->typePtr = NULL;
+ Tcl_InvalidateStringRep(objPtr);
/*
* Set the object's type to "list" and initialize the internal rep.
+ * However, if there are no elements to put in the list, just give
+ * the object an empty string rep and a NULL type.
*/
if (objc > 0) {
@@ -303,7 +305,7 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
* is to be returned. */
int *objcPtr; /* Where to store the count of objects
* referenced by objv. */
- Tcl_Obj ***objvPtr; /* Where to store the pointer to an array
+ Tcl_Obj ***objvPtr; /* Where to store the pointer to an array
* of pointers to the list's objects. */
{
register List *listRepPtr;
@@ -877,10 +879,11 @@ SetListFromAny(interp, objPtr)
Tcl_Obj *objPtr; /* The object to convert. */
{
Tcl_ObjType *oldTypePtr = objPtr->typePtr;
- char *string, *elemStart, *nextElem, *s;
+ char *string, *s;
+ CONST char *elemStart, *nextElem;
int lenRemain, length, estCount, elemSize, hasBrace, i, j, result;
char *limit; /* Points just after string's last byte. */
- register char *p;
+ register CONST char *p;
register Tcl_Obj **elemPtrs;
register Tcl_Obj *elemPtr;
List *listRepPtr;
@@ -903,7 +906,7 @@ SetListFromAny(interp, objPtr)
limit = (string + length);
estCount = 1;
for (p = string; p < limit; p++) {
- if (isspace(UCHAR(*p))) {
+ if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
estCount++;
}
}
diff --git a/tcl/generic/tclLiteral.c b/tcl/generic/tclLiteral.c
new file mode 100644
index 00000000000..37b1d33aa84
--- /dev/null
+++ b/tcl/generic/tclLiteral.c
@@ -0,0 +1,1062 @@
+/*
+ * tclLiteral.c --
+ *
+ * Implementation of the global and ByteCode-local literal tables
+ * used to manage the Tcl objects created for literal values during
+ * compilation of Tcl scripts. This implementation borrows heavily
+ * from the more general hashtable implementation of Tcl hash tables
+ * that appears in tclHash.c.
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#include "tclPort.h"
+/*
+ * When there are this many entries per bucket, on average, rebuild
+ * a literal's hash table to make it larger.
+ */
+
+#define REBUILD_MULTIPLIER 3
+
+/*
+ * Procedure prototypes for static procedures in this file:
+ */
+
+static int AddLocalLiteralEntry _ANSI_ARGS_((
+ CompileEnv *envPtr, LiteralEntry *globalPtr,
+ int localHash));
+static void ExpandLocalLiteralArray _ANSI_ARGS_((
+ CompileEnv *envPtr));
+static unsigned int HashString _ANSI_ARGS_((CONST char *bytes,
+ int length));
+static void RebuildLiteralTable _ANSI_ARGS_((
+ LiteralTable *tablePtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitLiteralTable --
+ *
+ * This procedure is called to initialize the fields of a literal table
+ * structure for either an interpreter or a compilation's CompileEnv
+ * structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The literal table is made ready for use.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitLiteralTable(tablePtr)
+ register LiteralTable *tablePtr; /* Pointer to table structure, which
+ * is supplied by the caller. */
+{
+#if (TCL_SMALL_HASH_TABLE != 4)
+ panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+ TCL_SMALL_HASH_TABLE);
+#endif
+
+ tablePtr->buckets = tablePtr->staticBuckets;
+ tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
+ tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
+ tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
+ tablePtr->numEntries = 0;
+ tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
+ tablePtr->mask = 3;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDeleteLiteralTable --
+ *
+ * This procedure frees up everything associated with a literal table
+ * except for the table's structure itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Each literal in the table is released: i.e., its reference count
+ * in the global literal table is decremented and, if it becomes zero,
+ * the literal is freed. In addition, the table's bucket array is
+ * freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDeleteLiteralTable(interp, tablePtr)
+ Tcl_Interp *interp; /* Interpreter containing shared literals
+ * referenced by the table to delete. */
+ LiteralTable *tablePtr; /* Points to the literal table to delete. */
+{
+ LiteralEntry *entryPtr;
+ int i, start;
+
+ /*
+ * Release remaining literals in the table. Note that releasing a
+ * literal might release other literals, modifying the table, so we
+ * restart the search from the bucket chain we last found an entry.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyGlobalLiteralTable((Interp *) interp);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ start = 0;
+ while (tablePtr->numEntries > 0) {
+ for (i = start; i < tablePtr->numBuckets; i++) {
+ entryPtr = tablePtr->buckets[i];
+ if (entryPtr != NULL) {
+ TclReleaseLiteral(interp, entryPtr->objPtr);
+ start = i;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Free up the table's bucket array if it was dynamically allocated.
+ */
+
+ if (tablePtr->buckets != tablePtr->staticBuckets) {
+ ckfree((char *) tablePtr->buckets);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegisterLiteral --
+ *
+ * Find, or if necessary create, an object in a CompileEnv literal
+ * array that has a string representation matching the argument string.
+ *
+ * Results:
+ * The index in the CompileEnv's literal array that references a
+ * shared literal matching the string. The object is created if
+ * necessary.
+ *
+ * Side effects:
+ * To maximize sharing, we look up the string in the interpreter's
+ * global literal table. If not found, we create a new shared literal
+ * in the global table. We then add a reference to the shared
+ * literal in the CompileEnv's literal array.
+ *
+ * If onHeap is 1, this procedure is given ownership of the string: if
+ * an object is created then its string representation is set directly
+ * from string, otherwise the string is freed. Typically, a caller sets
+ * onHeap 1 if "string" is an already heap-allocated buffer holding the
+ * result of backslash substitutions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegisterLiteral(envPtr, bytes, length, onHeap)
+ CompileEnv *envPtr; /* Points to the CompileEnv in whose object
+ * array an object is found or created. */
+ register char *bytes; /* Points to string for which to find or
+ * create an object in CompileEnv's object
+ * array. */
+ int length; /* Number of bytes in the string. If < 0,
+ * the string consists of all bytes up to
+ * the first null character. */
+ int onHeap; /* If 1 then the caller already malloc'd
+ * bytes and ownership is passed to this
+ * procedure. */
+{
+ Interp *iPtr = envPtr->iPtr;
+ LiteralTable *globalTablePtr = &(iPtr->literalTable);
+ LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ register LiteralEntry *globalPtr, *localPtr;
+ register Tcl_Obj *objPtr;
+ unsigned int hash;
+ int localHash, globalHash, objIndex;
+ long n;
+ char buf[TCL_INTEGER_SPACE];
+
+ if (length < 0) {
+ length = (bytes? strlen(bytes) : 0);
+ }
+ hash = HashString(bytes, length);
+
+ /*
+ * Is the literal already in the CompileEnv's local literal array?
+ * If so, just return its index.
+ */
+
+ localHash = (hash & localTablePtr->mask);
+ for (localPtr = localTablePtr->buckets[localHash];
+ localPtr != NULL; localPtr = localPtr->nextPtr) {
+ objPtr = localPtr->objPtr;
+ if ((objPtr->length == length) && ((length == 0)
+ || ((objPtr->bytes[0] == bytes[0])
+ && (memcmp(objPtr->bytes, bytes, (unsigned) length)
+ == 0)))) {
+ if (onHeap) {
+ ckfree(bytes);
+ }
+ objIndex = (localPtr - envPtr->literalArrayPtr);
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ return objIndex;
+ }
+ }
+
+ /*
+ * The literal is new to this CompileEnv. Is it in the interpreter's
+ * global literal table?
+ */
+
+ globalHash = (hash & globalTablePtr->mask);
+ for (globalPtr = globalTablePtr->buckets[globalHash];
+ globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
+ objPtr = globalPtr->objPtr;
+ if ((objPtr->length == length) && ((length == 0)
+ || ((objPtr->bytes[0] == bytes[0])
+ && (memcmp(objPtr->bytes, bytes, (unsigned) length)
+ == 0)))) {
+ /*
+ * A global literal was found. Add an entry to the CompileEnv's
+ * local literal array.
+ */
+
+ if (onHeap) {
+ ckfree(bytes);
+ }
+ objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
+#ifdef TCL_COMPILE_DEBUG
+ if (globalPtr->refCount < 1) {
+ panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
+ (length>60? 60 : length), bytes,
+ globalPtr->refCount);
+ }
+ TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+ return objIndex;
+ }
+ }
+
+ /*
+ * The literal is new to the interpreter. Add it to the global literal
+ * table then add an entry to the CompileEnv's local literal array.
+ * Convert the object to an integer object if possible.
+ */
+
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ if (onHeap) {
+ objPtr->bytes = bytes;
+ objPtr->length = length;
+ } else {
+ TclInitStringRep(objPtr, bytes, length);
+ }
+
+ if (TclLooksLikeInt(bytes, length)) {
+ /*
+ * From here we use the objPtr, because it is NULL terminated
+ */
+ if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) {
+ TclFormatInt(buf, n);
+ if (strcmp(objPtr->bytes, buf) == 0) {
+ objPtr->internalRep.longValue = n;
+ objPtr->typePtr = &tclIntType;
+ }
+ }
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
+ panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
+ (length>60? 60 : length), bytes);
+ }
+#endif
+
+ globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
+ globalPtr->objPtr = objPtr;
+ globalPtr->refCount = 0;
+ globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
+ globalTablePtr->buckets[globalHash] = globalPtr;
+ globalTablePtr->numEntries++;
+
+ /*
+ * If the global literal table has exceeded a decent size, rebuild it
+ * with more buckets.
+ */
+
+ if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
+ RebuildLiteralTable(globalTablePtr);
+ }
+ objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
+
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyGlobalLiteralTable(iPtr);
+ TclVerifyLocalLiteralTable(envPtr);
+ {
+ LiteralEntry *entryPtr;
+ int found, i;
+ found = 0;
+ for (i = 0; i < globalTablePtr->numBuckets; i++) {
+ for (entryPtr = globalTablePtr->buckets[i];
+ entryPtr != NULL; entryPtr = entryPtr->nextPtr) {
+ if ((entryPtr == globalPtr)
+ && (entryPtr->objPtr == objPtr)) {
+ found = 1;
+ }
+ }
+ }
+ if (!found) {
+ panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
+ (length>60? 60 : length), bytes);
+ }
+ }
+#endif /*TCL_COMPILE_DEBUG*/
+#ifdef TCL_COMPILE_STATS
+ iPtr->stats.numLiteralsCreated++;
+ iPtr->stats.totalLitStringBytes += (double) (length + 1);
+ iPtr->stats.currentLitStringBytes += (double) (length + 1);
+ iPtr->stats.literalCount[TclLog2(length)]++;
+#endif /*TCL_COMPILE_STATS*/
+ return objIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLookupLiteralEntry --
+ *
+ * Finds the LiteralEntry that corresponds to a literal Tcl object
+ * holding a literal.
+ *
+ * Results:
+ * Returns the matching LiteralEntry if found, otherwise NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+LiteralEntry *
+TclLookupLiteralEntry(interp, objPtr)
+ Tcl_Interp *interp; /* Interpreter for which objPtr was created
+ * to hold a literal. */
+ register Tcl_Obj *objPtr; /* Points to a Tcl object holding a
+ * literal that was previously created by a
+ * call to TclRegisterLiteral. */
+{
+ Interp *iPtr = (Interp *) interp;
+ LiteralTable *globalTablePtr = &(iPtr->literalTable);
+ register LiteralEntry *entryPtr;
+ char *bytes;
+ int length, globalHash;
+
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ globalHash = (HashString(bytes, length) & globalTablePtr->mask);
+ for (entryPtr = globalTablePtr->buckets[globalHash];
+ entryPtr != NULL; entryPtr = entryPtr->nextPtr) {
+ if (entryPtr->objPtr == objPtr) {
+ return entryPtr;
+ }
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclHideLiteral --
+ *
+ * Remove a literal entry from the literal hash tables, leaving it in
+ * the literal array so existing references continue to function.
+ * This makes it possible to turn a shared literal into a private
+ * literal that cannot be shared.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Removes the literal from the local hash table and decrements the
+ * global hash entry's reference count.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclHideLiteral(interp, envPtr, index)
+ Tcl_Interp *interp; /* Interpreter for which objPtr was created
+ * to hold a literal. */
+ register CompileEnv *envPtr; /* Points to CompileEnv whose literal array
+ * contains the entry being hidden. */
+ int index; /* The index of the entry in the literal
+ * array. */
+{
+ LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
+ LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ int localHash, length;
+ char *bytes;
+ Tcl_Obj *newObjPtr;
+
+ lPtr = &(envPtr->literalArrayPtr[index]);
+
+ /*
+ * To avoid unwanted sharing we need to copy the object and remove it from
+ * the local and global literal tables. It still has a slot in the literal
+ * array so it can be referred to by byte codes, but it will not be matched
+ * by literal searches.
+ */
+
+ newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
+ Tcl_IncrRefCount(newObjPtr);
+ TclReleaseLiteral(interp, lPtr->objPtr);
+ lPtr->objPtr = newObjPtr;
+
+ bytes = Tcl_GetStringFromObj(newObjPtr, &length);
+ localHash = (HashString(bytes, length) & localTablePtr->mask);
+ nextPtrPtr = &localTablePtr->buckets[localHash];
+
+ for (entryPtr = *nextPtrPtr; entryPtr != NULL; entryPtr = *nextPtrPtr) {
+ if (entryPtr == lPtr) {
+ *nextPtrPtr = lPtr->nextPtr;
+ lPtr->nextPtr = NULL;
+ localTablePtr->numEntries--;
+ break;
+ }
+ nextPtrPtr = &entryPtr->nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAddLiteralObj --
+ *
+ * Add a single literal object to the literal array. This
+ * function does not add the literal to the local or global
+ * literal tables. The caller is expected to add the entry
+ * to whatever tables are appropriate.
+ *
+ * Results:
+ * The index in the CompileEnv's literal array that references the
+ * literal. Stores the pointer to the new literal entry in the
+ * location referenced by the localPtrPtr argument.
+ *
+ * Side effects:
+ * Expands the literal array if necessary. Increments the refcount
+ * on the literal object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
+ register CompileEnv *envPtr; /* Points to CompileEnv in whose literal
+ * array the object is to be inserted. */
+ Tcl_Obj *objPtr; /* The object to insert into the array. */
+ LiteralEntry **litPtrPtr; /* The location where the pointer to the
+ * new literal entry should be stored.
+ * May be NULL. */
+{
+ register LiteralEntry *lPtr;
+ int objIndex;
+
+ if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {
+ ExpandLocalLiteralArray(envPtr);
+ }
+ objIndex = envPtr->literalArrayNext;
+ envPtr->literalArrayNext++;
+
+ lPtr = &(envPtr->literalArrayPtr[objIndex]);
+ lPtr->objPtr = objPtr;
+ Tcl_IncrRefCount(objPtr);
+ lPtr->refCount = -1; /* i.e., unused */
+ lPtr->nextPtr = NULL;
+
+ if (litPtrPtr) {
+ *litPtrPtr = lPtr;
+ }
+
+ return objIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddLocalLiteralEntry --
+ *
+ * Insert a new literal into a CompileEnv's local literal array.
+ *
+ * Results:
+ * The index in the CompileEnv's literal array that references the
+ * literal.
+ *
+ * Side effects:
+ * Increments the ref count of the global LiteralEntry since the
+ * CompileEnv now refers to the literal. Expands the literal array
+ * if necessary. May rebuild the hash bucket array of the CompileEnv's
+ * literal array if it becomes too large.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AddLocalLiteralEntry(envPtr, globalPtr, localHash)
+ register CompileEnv *envPtr; /* Points to CompileEnv in whose literal
+ * array the object is to be inserted. */
+ LiteralEntry *globalPtr; /* Points to the global LiteralEntry for
+ * the literal to add to the CompileEnv. */
+ int localHash; /* Hash value for the literal's string. */
+{
+ register LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ LiteralEntry *localPtr;
+ int objIndex;
+
+ objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);
+
+ /*
+ * Add the literal to the local table.
+ */
+
+ localPtr->nextPtr = localTablePtr->buckets[localHash];
+ localTablePtr->buckets[localHash] = localPtr;
+ localTablePtr->numEntries++;
+
+ globalPtr->refCount++;
+
+ /*
+ * If the CompileEnv's local literal table has exceeded a decent size,
+ * rebuild it with more buckets.
+ */
+
+ if (localTablePtr->numEntries >= localTablePtr->rebuildSize) {
+ RebuildLiteralTable(localTablePtr);
+ }
+
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyLocalLiteralTable(envPtr);
+ {
+ char *bytes;
+ int length, found, i;
+ found = 0;
+ for (i = 0; i < localTablePtr->numBuckets; i++) {
+ for (localPtr = localTablePtr->buckets[i];
+ localPtr != NULL; localPtr = localPtr->nextPtr) {
+ if (localPtr->objPtr == globalPtr->objPtr) {
+ found = 1;
+ }
+ }
+ }
+ if (!found) {
+ bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
+ panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
+ (length>60? 60 : length), bytes);
+ }
+ }
+#endif /*TCL_COMPILE_DEBUG*/
+ return objIndex;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ExpandLocalLiteralArray --
+ *
+ * Procedure that uses malloc to allocate more storage for a
+ * CompileEnv's local literal array.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The literal array in *envPtr is reallocated to a new array of
+ * double the size, and if envPtr->mallocedLiteralArray is non-zero
+ * the old array is freed. Entries are copied from the old array
+ * to the new one. The local literal table is updated to refer to
+ * the new entries.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ExpandLocalLiteralArray(envPtr)
+ register CompileEnv *envPtr; /* Points to the CompileEnv whose object
+ * array must be enlarged. */
+{
+ /*
+ * The current allocated local literal entries are stored between
+ * elements 0 and (envPtr->literalArrayNext - 1) [inclusive].
+ */
+
+ LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ int currElems = envPtr->literalArrayNext;
+ size_t currBytes = (currElems * sizeof(LiteralEntry));
+ register LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
+ register LiteralEntry *newArrayPtr =
+ (LiteralEntry *) ckalloc((unsigned) (2 * currBytes));
+ int i;
+
+ /*
+ * Copy from the old literal array to the new, then update the local
+ * literal table's bucket array.
+ */
+
+ memcpy((VOID *) newArrayPtr, (VOID *) currArrayPtr, currBytes);
+ for (i = 0; i < currElems; i++) {
+ if (currArrayPtr[i].nextPtr == NULL) {
+ newArrayPtr[i].nextPtr = NULL;
+ } else {
+ newArrayPtr[i].nextPtr = newArrayPtr
+ + (currArrayPtr[i].nextPtr - currArrayPtr);
+ }
+ }
+ for (i = 0; i < localTablePtr->numBuckets; i++) {
+ if (localTablePtr->buckets[i] != NULL) {
+ localTablePtr->buckets[i] = newArrayPtr
+ + (localTablePtr->buckets[i] - currArrayPtr);
+ }
+ }
+
+ /*
+ * Free the old literal array if needed, and mark the new literal
+ * array as malloced.
+ */
+
+ if (envPtr->mallocedLiteralArray) {
+ ckfree((char *) currArrayPtr);
+ }
+ envPtr->literalArrayPtr = newArrayPtr;
+ envPtr->literalArrayEnd = (2 * currElems);
+ envPtr->mallocedLiteralArray = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclReleaseLiteral --
+ *
+ * This procedure releases a reference to one of the shared Tcl objects
+ * that hold literals. It is called to release the literals referenced
+ * by a ByteCode that is being destroyed, and it is also called by
+ * TclDeleteLiteralTable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count for the global LiteralTable entry that
+ * corresponds to the literal is decremented. If no other reference
+ * to a global literal object remains, it is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclReleaseLiteral(interp, objPtr)
+ Tcl_Interp *interp; /* Interpreter for which objPtr was created
+ * to hold a literal. */
+ register Tcl_Obj *objPtr; /* Points to a literal object that was
+ * previously created by a call to
+ * TclRegisterLiteral. */
+{
+ Interp *iPtr = (Interp *) interp;
+ LiteralTable *globalTablePtr = &(iPtr->literalTable);
+ register LiteralEntry *entryPtr, *prevPtr;
+ ByteCode* codePtr;
+ char *bytes;
+ int length, index;
+
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ index = (HashString(bytes, length) & globalTablePtr->mask);
+
+ /*
+ * Check to see if the object is in the global literal table and
+ * remove this reference. The object may not be in the table if
+ * it is a hidden local literal.
+ */
+
+ for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index];
+ entryPtr != NULL;
+ prevPtr = entryPtr, entryPtr = entryPtr->nextPtr) {
+ if (entryPtr->objPtr == objPtr) {
+ entryPtr->refCount--;
+
+ /*
+ * We found the matching LiteralEntry. Check if it's only being
+ * kept alive only by a circular reference from a ByteCode
+ * stored as its internal rep.
+ */
+
+ if ((entryPtr->refCount == 1)
+ && (objPtr->typePtr == &tclByteCodeType)) {
+ codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ if ((codePtr->numLitObjects == 1)
+ && (codePtr->objArrayPtr[0] == objPtr)) {
+ entryPtr->refCount = 0;
+
+ /*
+ * Set the ByteCode object array entry NULL to signal
+ * to TclCleanupByteCode to not try to release this
+ * about to be freed literal again.
+ */
+
+ codePtr->objArrayPtr[0] = NULL;
+ }
+ }
+
+ /*
+ * If the literal is no longer being used by any ByteCode,
+ * delete the entry then decrement the ref count of its object.
+ */
+
+ if (entryPtr->refCount == 0) {
+ if (prevPtr == NULL) {
+ globalTablePtr->buckets[index] = entryPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = entryPtr->nextPtr;
+ }
+#ifdef TCL_COMPILE_STATS
+ iPtr->stats.currentLitStringBytes -= (double) (length + 1);
+#endif /*TCL_COMPILE_STATS*/
+ ckfree((char *) entryPtr);
+ globalTablePtr->numEntries--;
+
+ /*
+ * Remove the reference corresponding to the global
+ * literal table entry.
+ */
+
+ TclDecrRefCount(objPtr);
+ }
+ break;
+ }
+ }
+
+ /*
+ * Remove the reference corresponding to the local literal table
+ * entry.
+ */
+ Tcl_DecrRefCount(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HashString --
+ *
+ * Compute a one-word summary of a text string, which can be
+ * used to generate a hash index.
+ *
+ * Results:
+ * The return value is a one-word summary of the information in
+ * string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned int
+HashString(bytes, length)
+ register CONST char *bytes; /* String for which to compute hash
+ * value. */
+ int length; /* Number of bytes in the string. */
+{
+ register unsigned int result;
+ register int i;
+
+ /*
+ * I tried a zillion different hash functions and asked many other
+ * people for advice. Many people had their own favorite functions,
+ * all different, but no-one had much idea why they were good ones.
+ * I chose the one below (multiply by 9 and add new character)
+ * because of the following reasons:
+ *
+ * 1. Multiplying by 10 is perfect for keys that are decimal strings,
+ * and multiplying by 9 is just about as good.
+ * 2. Times-9 is (shift-left-3) plus (old). This means that each
+ * character's bits hang around in the low-order bits of the
+ * hash value for ever, plus they spread fairly rapidly up to
+ * the high-order bits to fill out the hash value. This seems
+ * works well both for decimal and non-decimal strings.
+ */
+
+ result = 0;
+ for (i = 0; i < length; i++) {
+ result += (result<<3) + *bytes++;
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RebuildLiteralTable --
+ *
+ * This procedure is invoked when the ratio of entries to hash buckets
+ * becomes too large in a local or global literal table. It allocates
+ * a larger bucket array and moves the entries into the new buckets.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets reallocated and entries get rehashed into new buckets.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RebuildLiteralTable(tablePtr)
+ register LiteralTable *tablePtr; /* Local or global table to enlarge. */
+{
+ LiteralEntry **oldBuckets;
+ register LiteralEntry **oldChainPtr, **newChainPtr;
+ register LiteralEntry *entryPtr;
+ LiteralEntry **bucketPtr;
+ char *bytes;
+ int oldSize, count, index, length;
+
+ oldSize = tablePtr->numBuckets;
+ oldBuckets = tablePtr->buckets;
+
+ /*
+ * Allocate and initialize the new bucket array, and set up
+ * hashing constants for new array size.
+ */
+
+ tablePtr->numBuckets *= 4;
+ tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
+ (tablePtr->numBuckets * sizeof(LiteralEntry *)));
+ for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
+ count > 0;
+ count--, newChainPtr++) {
+ *newChainPtr = NULL;
+ }
+ tablePtr->rebuildSize *= 4;
+ tablePtr->mask = (tablePtr->mask << 2) + 3;
+
+ /*
+ * Rehash all of the existing entries into the new bucket array.
+ */
+
+ for (oldChainPtr = oldBuckets;
+ oldSize > 0;
+ oldSize--, oldChainPtr++) {
+ for (entryPtr = *oldChainPtr; entryPtr != NULL;
+ entryPtr = *oldChainPtr) {
+ bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+ index = (HashString(bytes, length) & tablePtr->mask);
+
+ *oldChainPtr = entryPtr->nextPtr;
+ bucketPtr = &(tablePtr->buckets[index]);
+ entryPtr->nextPtr = *bucketPtr;
+ *bucketPtr = entryPtr;
+ }
+ }
+
+ /*
+ * Free up the old bucket array, if it was dynamically allocated.
+ */
+
+ if (oldBuckets != tablePtr->staticBuckets) {
+ ckfree((char *) oldBuckets);
+ }
+}
+
+#ifdef TCL_COMPILE_STATS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLiteralStats --
+ *
+ * Return statistics describing the layout of the hash table
+ * in its hash buckets.
+ *
+ * Results:
+ * The return value is a malloc-ed string containing information
+ * about tablePtr. It is the caller's responsibility to free
+ * this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclLiteralStats(tablePtr)
+ LiteralTable *tablePtr; /* Table for which to produce stats. */
+{
+#define NUM_COUNTERS 10
+ int count[NUM_COUNTERS], overflow, i, j;
+ double average, tmp;
+ register LiteralEntry *entryPtr;
+ char *result, *p;
+
+ /*
+ * Compute a histogram of bucket usage. For each bucket chain i,
+ * j is the number of entries in the chain.
+ */
+
+ for (i = 0; i < NUM_COUNTERS; i++) {
+ count[i] = 0;
+ }
+ overflow = 0;
+ average = 0.0;
+ for (i = 0; i < tablePtr->numBuckets; i++) {
+ j = 0;
+ for (entryPtr = tablePtr->buckets[i]; entryPtr != NULL;
+ entryPtr = entryPtr->nextPtr) {
+ j++;
+ }
+ if (j < NUM_COUNTERS) {
+ count[j]++;
+ } else {
+ overflow++;
+ }
+ tmp = j;
+ average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
+ }
+
+ /*
+ * Print out the histogram and a few other pieces of information.
+ */
+
+ result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
+ sprintf(result, "%d entries in table, %d buckets\n",
+ tablePtr->numEntries, tablePtr->numBuckets);
+ p = result + strlen(result);
+ for (i = 0; i < NUM_COUNTERS; i++) {
+ sprintf(p, "number of buckets with %d entries: %d\n",
+ i, count[i]);
+ p += strlen(p);
+ }
+ sprintf(p, "number of buckets with %d or more entries: %d\n",
+ NUM_COUNTERS, overflow);
+ p += strlen(p);
+ sprintf(p, "average search distance for entry: %.1f", average);
+ return result;
+}
+#endif /*TCL_COMPILE_STATS*/
+
+#ifdef TCL_COMPILE_DEBUG
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclVerifyLocalLiteralTable --
+ *
+ * Check a CompileEnv's local literal table for consistency.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Panics if problems are found.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclVerifyLocalLiteralTable(envPtr)
+ CompileEnv *envPtr; /* Points to CompileEnv whose literal
+ * table is to be validated. */
+{
+ register LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ register LiteralEntry *localPtr;
+ char *bytes;
+ register int i;
+ int length, count;
+
+ count = 0;
+ for (i = 0; i < localTablePtr->numBuckets; i++) {
+ for (localPtr = localTablePtr->buckets[i];
+ localPtr != NULL; localPtr = localPtr->nextPtr) {
+ count++;
+ if (localPtr->refCount != -1) {
+ bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
+ panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
+ (length>60? 60 : length), bytes,
+ localPtr->refCount);
+ }
+ if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
+ localPtr->objPtr) == NULL) {
+ bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
+ panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
+ (length>60? 60 : length), bytes);
+ }
+ if (localPtr->objPtr->bytes == NULL) {
+ panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
+ }
+ }
+ }
+ if (count != localTablePtr->numEntries) {
+ panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
+ count, localTablePtr->numEntries);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclVerifyGlobalLiteralTable --
+ *
+ * Check an interpreter's global literal table literal for consistency.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Panics if problems are found.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclVerifyGlobalLiteralTable(iPtr)
+ Interp *iPtr; /* Points to interpreter whose global
+ * literal table is to be validated. */
+{
+ register LiteralTable *globalTablePtr = &(iPtr->literalTable);
+ register LiteralEntry *globalPtr;
+ char *bytes;
+ register int i;
+ int length, count;
+
+ count = 0;
+ for (i = 0; i < globalTablePtr->numBuckets; i++) {
+ for (globalPtr = globalTablePtr->buckets[i];
+ globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
+ count++;
+ if (globalPtr->refCount < 1) {
+ bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
+ panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
+ (length>60? 60 : length), bytes,
+ globalPtr->refCount);
+ }
+ if (globalPtr->objPtr->bytes == NULL) {
+ panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
+ }
+ }
+ }
+ if (count != globalTablePtr->numEntries) {
+ panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d",
+ count, globalTablePtr->numEntries);
+ }
+}
+#endif /*TCL_COMPILE_DEBUG*/
diff --git a/tcl/generic/tclLoad.c b/tcl/generic/tclLoad.c
index 3502889a5f7..81e963a6e86 100644
--- a/tcl/generic/tclLoad.c
+++ b/tcl/generic/tclLoad.c
@@ -4,7 +4,7 @@
* This file provides the generic portion (those that are the same
* on all platforms) of Tcl's dynamic loading facilities.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,7 +17,7 @@
/*
* The following structure describes a package that has been loaded
* either dynamically (with the "load" command) or statically (as
- * indicated by a call to Tcl_PackageLoaded). All such packages
+ * indicated by a call to TclGetLoadedPackages). All such packages
* are linked together into a single list for the process. Packages
* are never unloaded, so these structures are never freed.
*/
@@ -31,6 +31,10 @@ typedef struct LoadedPackage {
* properly capitalized (first letter UC,
* others LC), no "_", as in "Net".
* Malloc-ed. */
+ ClientData clientData; /* Token for the loaded file which should be
+ * passed to TclpUnloadFile() when the file
+ * is no longer needed. If fileName is NULL,
+ * then this field is irrelevant. */
Tcl_PackageInitProc *initProc;
/* Initialization procedure to call to
* incorporate this package into a trusted
@@ -48,10 +52,18 @@ typedef struct LoadedPackage {
* end of list. */
} LoadedPackage;
+/*
+ * TCL_THREADS
+ * There is a global list of packages that is anchored at firstPackagePtr.
+ * Access to this list is governed by a mutex.
+ */
+
static LoadedPackage *firstPackagePtr = NULL;
/* First in list of all packages loaded into
* this process. */
+TCL_DECLARE_MUTEX(packageMutex)
+
/*
* The following structure represents a particular package that has
* been incorporated into a particular interpreter (by calling its
@@ -74,12 +86,11 @@ typedef struct InterpPackage {
static void LoadCleanupProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp));
-static void LoadExitProc _ANSI_ARGS_((ClientData clientData));
/*
*----------------------------------------------------------------------
*
- * Tcl_LoadCmd --
+ * Tcl_LoadObjCmd --
*
* This procedure is invoked to process the "load" Tcl command.
* See the user documentation for details on what it does.
@@ -94,38 +105,45 @@ static void LoadExitProc _ANSI_ARGS_((ClientData clientData));
*/
int
-Tcl_LoadCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+Tcl_LoadObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Interp *target;
LoadedPackage *pkgPtr, *defaultPtr;
- Tcl_DString pkgName, initName, safeInitName, fileName;
+ Tcl_DString pkgName, tmp, initName, safeInitName, fileName;
Tcl_PackageInitProc *initProc, *safeInitProc;
InterpPackage *ipFirstPtr, *ipPtr;
- int code, c, gotPkgName, namesMatch, filesMatch;
- char *p, *fullFileName, *p1, *p2;
-
- if ((argc < 2) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " fileName ?packageName? ?interp?\"", (char *) NULL);
+ int code, namesMatch, filesMatch;
+ char *p, *tempString, *fullFileName, *packageName;
+ ClientData clientData;
+ Tcl_UniChar ch;
+ int offset;
+
+ if ((objc < 2) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
return TCL_ERROR;
}
- fullFileName = Tcl_TranslateFileName(interp, argv[1], &fileName);
+ tempString = Tcl_GetString(objv[1]);
+ fullFileName = Tcl_TranslateFileName(interp, tempString, &fileName);
if (fullFileName == NULL) {
return TCL_ERROR;
}
Tcl_DStringInit(&pkgName);
Tcl_DStringInit(&initName);
Tcl_DStringInit(&safeInitName);
- if ((argc >= 3) && (argv[2][0] != 0)) {
- gotPkgName = 1;
- } else {
- gotPkgName = 0;
+ Tcl_DStringInit(&tmp);
+
+ packageName = NULL;
+ if (objc >= 3) {
+ packageName = Tcl_GetString(objv[2]);
+ if (packageName[0] == '\0') {
+ packageName = NULL;
+ }
}
- if ((fullFileName[0] == 0) && !gotPkgName) {
+ if ((fullFileName[0] == 0) && (packageName == NULL)) {
Tcl_SetResult(interp,
"must specify either file name or package name",
TCL_STATIC);
@@ -138,11 +156,11 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
*/
target = interp;
- if (argc == 4) {
- target = Tcl_GetSlave(interp, argv[3]);
+ if (objc == 4) {
+ char *slaveIntName;
+ slaveIntName = Tcl_GetString(objv[3]);
+ target = Tcl_GetSlave(interp, slaveIntName);
if (target == NULL) {
- Tcl_AppendResult(interp, "couldn't find slave interpreter named \"",
- argv[3], "\"", (char *) NULL);
return TCL_ERROR;
}
}
@@ -156,26 +174,30 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
* - Its name matches, the file name was specified as empty, and there
* is only no statically loaded package with the same name.
*/
+ Tcl_MutexLock(&packageMutex);
defaultPtr = NULL;
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
- if (!gotPkgName) {
+ if (packageName == NULL) {
namesMatch = 0;
} else {
- namesMatch = 1;
- for (p1 = argv[2], p2 = pkgPtr->packageName; ; p1++, p2++) {
- if ((isupper(UCHAR(*p1)) ? tolower(UCHAR(*p1)) : *p1)
- != (isupper(UCHAR(*p2)) ? tolower(UCHAR(*p2)) : *p2)) {
- namesMatch = 0;
- break;
- }
- if (*p1 == 0) {
- break;
- }
+ Tcl_DStringSetLength(&pkgName, 0);
+ Tcl_DStringAppend(&pkgName, packageName, -1);
+ Tcl_DStringSetLength(&tmp, 0);
+ Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
+ Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
+ Tcl_UtfToLower(Tcl_DStringValue(&tmp));
+ if (strcmp(Tcl_DStringValue(&tmp),
+ Tcl_DStringValue(&pkgName)) == 0) {
+ namesMatch = 1;
+ } else {
+ namesMatch = 0;
}
}
+ Tcl_DStringSetLength(&pkgName, 0);
+
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
- if (filesMatch && (namesMatch || !gotPkgName)) {
+ if (filesMatch && (namesMatch || (packageName == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
@@ -191,9 +213,11 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
"\" is already loaded for package \"",
pkgPtr->packageName, "\"", (char *) NULL);
code = TCL_ERROR;
+ Tcl_MutexUnlock(&packageMutex);
goto done;
}
}
+ Tcl_MutexUnlock(&packageMutex);
if (pkgPtr == NULL) {
pkgPtr = defaultPtr;
}
@@ -222,7 +246,7 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
*/
if (fullFileName[0] == 0) {
- Tcl_AppendResult(interp, "package \"", argv[2],
+ Tcl_AppendResult(interp, "package \"", packageName,
"\" isn't loaded statically", (char *) NULL);
code = TCL_ERROR;
goto done;
@@ -232,10 +256,15 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
* Figure out the module name if it wasn't provided explicitly.
*/
- if (gotPkgName) {
- Tcl_DStringAppend(&pkgName, argv[2], -1);
+ if (packageName != NULL) {
+ Tcl_DStringAppend(&pkgName, packageName, -1);
} else {
- if (!TclGuessPackageName(fullFileName, &pkgName)) {
+ int retc;
+ /*
+ * Threading note - this call used to be protected by a mutex.
+ */
+ retc = TclGuessPackageName(fullFileName, &pkgName);
+ if (!retc) {
int pargc;
char **pargv, *pkgGuess;
@@ -253,8 +282,13 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
&& (pkgGuess[2] == 'b')) {
pkgGuess += 3;
}
- for (p = pkgGuess; isalpha(UCHAR(*p)) || (*p == '_'); p++) {
- /* Empty loop body. */
+ for (p = pkgGuess; *p != 0; p += offset) {
+ offset = Tcl_UtfToUniChar(p, &ch);
+ if ((ch > 0x100)
+ || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
+ || (UCHAR(ch) == '_'))) {
+ break;
+ }
}
if (p == pkgGuess) {
ckfree((char *)pargv);
@@ -271,27 +305,12 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
/*
* Fix the capitalization in the package name so that the first
- * character is in caps but the others are all lower-case.
+ * character is in caps (or title case) but the others are all
+ * lower-case.
*/
- p = Tcl_DStringValue(&pkgName);
- c = UCHAR(*p);
- if (c != 0) {
- if (islower(c)) {
- *p = (char) toupper(c);
- }
- p++;
- while (1) {
- c = UCHAR(*p);
- if (c == 0) {
- break;
- }
- if (isupper(c)) {
- *p = (char) tolower(c);
- }
- p++;
- }
- }
+ Tcl_DStringSetLength(&pkgName,
+ Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
/*
* Compute the names of the two initialization procedures,
@@ -302,20 +321,24 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
Tcl_DStringAppend(&initName, "_Init", 5);
Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
-
+
/*
* Call platform-specific code to load the package and find the
* two initialization procedures.
*/
-
- code = TclLoadFile(interp, fullFileName, Tcl_DStringValue(&initName),
- Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc);
+
+ Tcl_MutexLock(&packageMutex);
+ code = TclpLoadFile(interp, fullFileName, Tcl_DStringValue(&initName),
+ Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc,
+ &clientData);
+ Tcl_MutexUnlock(&packageMutex);
if (code != TCL_OK) {
goto done;
}
- if (initProc == NULL) {
+ if (initProc == NULL) {
Tcl_AppendResult(interp, "couldn't find procedure ",
Tcl_DStringValue(&initName), (char *) NULL);
+ TclpUnloadFile(clientData);
code = TCL_ERROR;
goto done;
}
@@ -324,20 +347,20 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
* Create a new record to describe this package.
*/
- if (firstPackagePtr == NULL) {
- Tcl_CreateExitHandler(LoadExitProc, (ClientData) NULL);
- }
pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
- pkgPtr->fileName = (char *) ckalloc((unsigned)
+ pkgPtr->fileName = (char *) ckalloc((unsigned)
(strlen(fullFileName) + 1));
strcpy(pkgPtr->fileName, fullFileName);
- pkgPtr->packageName = (char *) ckalloc((unsigned)
+ pkgPtr->packageName = (char *) ckalloc((unsigned)
(Tcl_DStringLength(&pkgName) + 1));
strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
- pkgPtr->initProc = initProc;
- pkgPtr->safeInitProc = safeInitProc;
- pkgPtr->nextPtr = firstPackagePtr;
- firstPackagePtr = pkgPtr;
+ pkgPtr->clientData = clientData;
+ pkgPtr->initProc = initProc;
+ pkgPtr->safeInitProc = safeInitProc;
+ Tcl_MutexLock(&packageMutex);
+ pkgPtr->nextPtr = firstPackagePtr;
+ firstPackagePtr = pkgPtr;
+ Tcl_MutexUnlock(&packageMutex);
}
/*
@@ -360,28 +383,6 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
} else {
code = (*pkgPtr->initProc)(target);
}
- if ((code == TCL_ERROR) && (target != interp)) {
- /*
- * An error occurred, so transfer error information from the
- * destination interpreter back to our interpreter. Must clear
- * interp's result before calling Tcl_AddErrorInfo, since
- * Tcl_AddErrorInfo will store the interp's result in errorInfo
- * before appending target's $errorInfo; we've already got
- * everything we need in target's $errorInfo.
- */
-
- /*
- * It is (abusively) assumed that errorInfo and errorCode vars exists.
- * we changed SetVar2 to accept NULL values to avoid crashes. --dl
- */
- Tcl_ResetResult(interp);
- Tcl_AddErrorInfo(interp, Tcl_GetVar2(target,
- "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(target, "errorCode", (char *) NULL,
- TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
- Tcl_SetResult(interp, target->result, TCL_VOLATILE);
- }
/*
* Record the fact that the package has been loaded in the
@@ -401,6 +402,8 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
(ClientData) ipPtr);
+ } else {
+ TclTransferResult(target, code, interp);
}
done:
@@ -408,6 +411,7 @@ Tcl_LoadCmd(dummy, interp, argc, argv)
Tcl_DStringFree(&initName);
Tcl_DStringFree(&safeInitName);
Tcl_DStringFree(&fileName);
+ Tcl_DStringFree(&tmp);
return code;
}
@@ -456,27 +460,31 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
* statically loaded. If this call is redundant then just return.
*/
+ Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
if ((pkgPtr->initProc == initProc)
&& (pkgPtr->safeInitProc == safeInitProc)
&& (strcmp(pkgPtr->packageName, pkgName) == 0)) {
+ Tcl_MutexUnlock(&packageMutex);
return;
}
}
- if (firstPackagePtr == NULL) {
- Tcl_CreateExitHandler(LoadExitProc, (ClientData) NULL);
- }
+ Tcl_MutexUnlock(&packageMutex);
+
pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
- pkgPtr->fileName = (char *) ckalloc((unsigned) 1);
- pkgPtr->fileName[0] = 0;
- pkgPtr->packageName = (char *) ckalloc((unsigned)
+ pkgPtr->fileName = (char *) ckalloc((unsigned) 1);
+ pkgPtr->fileName[0] = 0;
+ pkgPtr->packageName = (char *) ckalloc((unsigned)
(strlen(pkgName) + 1));
strcpy(pkgPtr->packageName, pkgName);
- pkgPtr->initProc = initProc;
- pkgPtr->safeInitProc = safeInitProc;
- pkgPtr->nextPtr = firstPackagePtr;
- firstPackagePtr = pkgPtr;
+ pkgPtr->clientData = NULL;
+ pkgPtr->initProc = initProc;
+ pkgPtr->safeInitProc = safeInitProc;
+ Tcl_MutexLock(&packageMutex);
+ pkgPtr->nextPtr = firstPackagePtr;
+ firstPackagePtr = pkgPtr;
+ Tcl_MutexUnlock(&packageMutex);
if (interp != NULL) {
ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad",
@@ -500,7 +508,7 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
*
* Results:
* The return value is a standard Tcl completion code. If
- * successful, a list of lists is placed in interp->result.
+ * successful, a list of lists is placed in the interp's result.
* Each sublist corresponds to one loaded file; its first
* element is the name of the file (or an empty string for
* something that's statically loaded) and the second element
@@ -532,6 +540,7 @@ TclGetLoadedPackages(interp, targetName)
*/
prefix = "{";
+ Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
pkgPtr = pkgPtr->nextPtr) {
Tcl_AppendResult(interp, prefix, (char *) NULL);
@@ -540,6 +549,7 @@ TclGetLoadedPackages(interp, targetName)
Tcl_AppendResult(interp, "}", (char *) NULL);
prefix = " {";
}
+ Tcl_MutexUnlock(&packageMutex);
return TCL_OK;
}
@@ -550,8 +560,6 @@ TclGetLoadedPackages(interp, targetName)
target = Tcl_GetSlave(interp, targetName);
if (target == NULL) {
- Tcl_AppendResult(interp, "couldn't find slave interpreter named \"",
- targetName, "\"", (char *) NULL);
return TCL_ERROR;
}
ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
@@ -606,7 +614,7 @@ LoadCleanupProc(clientData, interp)
/*
*----------------------------------------------------------------------
*
- * LoadExitProc --
+ * TclFinalizeLoad --
*
* This procedure is invoked just before the application exits.
* It frees all of the LoadedPackage structures.
@@ -620,15 +628,34 @@ LoadCleanupProc(clientData, interp)
*----------------------------------------------------------------------
*/
-static void
-LoadExitProc(clientData)
- ClientData clientData; /* Not used. */
+void
+TclFinalizeLoad()
{
LoadedPackage *pkgPtr;
+ /*
+ * No synchronization here because there should just be
+ * one thread alive at this point. Logically,
+ * packageMutex should be grabbed at this point, but
+ * the Mutexes get finalized before the call to this routine.
+ * The only subsystem left alive at this point is the
+ * memory allocator.
+ */
+
while (firstPackagePtr != NULL) {
pkgPtr = firstPackagePtr;
firstPackagePtr = pkgPtr->nextPtr;
+#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 a core on exit because it wants to
+ * call a function in the dll after it's been unloaded.
+ */
+ if (pkgPtr->fileName[0] != '\0') {
+ TclpUnloadFile(pkgPtr->clientData);
+ }
+#endif
ckfree(pkgPtr->fileName);
ckfree(pkgPtr->packageName);
ckfree((char *) pkgPtr);
diff --git a/tcl/generic/tclLoadNone.c b/tcl/generic/tclLoadNone.c
index e9975ee1646..35180f5ff52 100644
--- a/tcl/generic/tclLoadNone.c
+++ b/tcl/generic/tclLoadNone.c
@@ -5,7 +5,7 @@
* in systems that don't support dynamic loading; it just returns
* an error.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -18,7 +18,7 @@
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpLoadFile --
*
* This procedure is called to carry out dynamic loading of binary
* code; it is intended for use only on systems that don't support
@@ -26,7 +26,7 @@
*
* Results:
* The result is TCL_ERROR, and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -35,7 +35,7 @@
*/
int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
* code. */
@@ -44,6 +44,9 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
Tcl_SetResult(interp,
"dynamic loading is not currently available on this system",
@@ -80,3 +83,30 @@ TclGuessPackageName(fileName, bufPtr)
{
return 0;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpUnloadFile --
+ *
+ * This procedure is called to carry out dynamic unloading of binary
+ * code; it is intended for use only on systems that don't support
+ * dynamic loading (it does nothing).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+}
diff --git a/tcl/generic/tclMain.c b/tcl/generic/tclMain.c
index 06069debc25..a89d0caf3f3 100644
--- a/tcl/generic/tclMain.c
+++ b/tcl/generic/tclMain.c
@@ -4,7 +4,7 @@
* Main program for Tcl shells and other Tcl-based applications.
*
* Copyright (c) 1988-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -40,24 +40,57 @@ int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
extern int isatty _ANSI_ARGS_((int fd));
extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
-static Tcl_Interp *interp; /* Interpreter for application. */
+static char *tclStartupScriptFileName = NULL;
-#ifdef TCL_MEM_DEBUG
-static char dumpFile[100]; /* Records where to dump memory allocation
- * information. */
-static int quitFlag = 0; /* 1 means "checkmem" command was called,
- * so the application should quit and dump
- * memory allocation information. */
-#endif
+
+
/*
- * Forward references for procedures defined later in this file:
+ *----------------------------------------------------------------------
+ *
+ * TclSetStartupScriptFileName --
+ *
+ * Primes the startup script file name, used to override the
+ * command line processing.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This procedure initializes the file name of the Tcl script to
+ * run at startup.
+ *
+ *----------------------------------------------------------------------
*/
+void TclSetStartupScriptFileName(fileName)
+ char *fileName;
+{
+ tclStartupScriptFileName = fileName;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetStartupScriptFileName --
+ *
+ * Gets the startup script file name, used to override the
+ * command line processing.
+ *
+ * Results:
+ * The startup script file name, NULL if none has been set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+char *TclGetStartupScriptFileName()
+{
+ return tclStartupScriptFileName;
+}
+
-#ifdef TCL_MEM_DEBUG
-static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
-#endif
/*
*----------------------------------------------------------------------
@@ -71,7 +104,7 @@ static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
* it's done.
*
* Side effects:
- * This procedure initializes the Tk world and then starts
+ * This procedure initializes the Tcl world and then starts
* interpreting commands; almost anything could happen, depending
* on the script being interpreted.
*
@@ -88,21 +121,19 @@ Tcl_Main(argc, argv, appInitProc)
* initialization but before starting to
* execute commands. */
{
- Tcl_Obj *prompt1NamePtr = NULL;
- Tcl_Obj *prompt2NamePtr = NULL;
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
- char buffer[1000], *args, *fileName, *bytes;
+ char buffer[1000], *args;
int code, gotPartial, tty, length;
int exitCode = 0;
Tcl_Channel inChannel, outChannel, errChannel;
+ Tcl_Interp *interp;
+ Tcl_DString argString;
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
- Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
#endif
/*
@@ -111,19 +142,29 @@ Tcl_Main(argc, argv, appInitProc)
* strip it off and use it as the name of a script file to process.
*/
- fileName = NULL;
- if ((argc > 1) && (argv[1][0] != '-')) {
- fileName = argv[1];
- argc--;
- argv++;
+ if (tclStartupScriptFileName == NULL) {
+ if ((argc > 1) && (argv[1][0] != '-')) {
+ tclStartupScriptFileName = argv[1];
+ argc--;
+ argv++;
+ }
}
args = Tcl_Merge(argc-1, argv+1);
- Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
+ Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
+ Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&argString);
ckfree(args);
+
+ if (tclStartupScriptFileName == NULL) {
+ Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
+ } else {
+ tclStartupScriptFileName = Tcl_ExternalToUtfDString(NULL,
+ tclStartupScriptFileName, -1, &argString);
+ }
+
TclFormatInt(buffer, argc-1);
Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
- TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
@@ -131,7 +172,8 @@ Tcl_Main(argc, argv, appInitProc)
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive",
- ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
+ ((tclStartupScriptFileName == NULL) && tty) ? "1" : "0",
+ TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
@@ -140,10 +182,10 @@ Tcl_Main(argc, argv, appInitProc)
if ((*appInitProc)(interp) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
- Tcl_Write(errChannel,
+ Tcl_WriteChars(errChannel,
"application-specific initialization failed: ", -1);
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
}
@@ -152,8 +194,8 @@ Tcl_Main(argc, argv, appInitProc)
* and quit.
*/
- if (fileName != NULL) {
- code = Tcl_EvalFile(interp, fileName);
+ if (tclStartupScriptFileName != NULL) {
+ code = Tcl_EvalFile(interp, tclStartupScriptFileName);
if (code != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
@@ -163,14 +205,15 @@ Tcl_Main(argc, argv, appInitProc)
*/
Tcl_AddErrorInfo(interp, "");
- Tcl_Write(errChannel,
- Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
+ NULL, TCL_GLOBAL_ONLY));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
exitCode = 1;
}
goto done;
}
+ Tcl_DStringFree(&argString);
/*
* We're running interactively. Source a user-specific startup
@@ -187,11 +230,7 @@ Tcl_Main(argc, argv, appInitProc)
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
- prompt1NamePtr = Tcl_NewStringObj("tcl_prompt1", -1);
- Tcl_IncrRefCount(prompt1NamePtr);
- prompt2NamePtr = Tcl_NewStringObj("tcl_prompt2", -1);
- Tcl_IncrRefCount(prompt2NamePtr);
-
+
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
gotPartial = 0;
@@ -199,25 +238,23 @@ Tcl_Main(argc, argv, appInitProc)
if (tty) {
Tcl_Obj *promptCmdPtr;
- promptCmdPtr = Tcl_ObjGetVar2(interp,
- (gotPartial? prompt2NamePtr : prompt1NamePtr),
- (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
+ promptCmdPtr = Tcl_GetVar2Ex(interp,
+ (gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
+ NULL, TCL_GLOBAL_ONLY);
if (promptCmdPtr == NULL) {
defaultPrompt:
if (!gotPartial && outChannel) {
- Tcl_Write(outChannel, "% ", 2);
+ Tcl_WriteChars(outChannel, "% ", 2);
}
} else {
- code = Tcl_EvalObj(interp, promptCmdPtr);
+ code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (code != TCL_OK) {
if (errChannel) {
- resultPtr = Tcl_GetObjResult(interp);
- bytes = Tcl_GetStringFromObj(resultPtr, &length);
- Tcl_Write(errChannel, bytes, length);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
@@ -254,27 +291,25 @@ Tcl_Main(argc, argv, appInitProc)
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
- Tcl_SetObjLength(commandPtr, 0);
+ Tcl_DecrRefCount(commandPtr);
+ commandPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(commandPtr);
if (code != TCL_OK) {
if (errChannel) {
- resultPtr = Tcl_GetObjResult(interp);
- bytes = Tcl_GetStringFromObj(resultPtr, &length);
- Tcl_Write(errChannel, bytes, length);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
} else if (tty) {
resultPtr = Tcl_GetObjResult(interp);
- bytes = Tcl_GetStringFromObj(resultPtr, &length);
+ Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && outChannel) {
- Tcl_Write(outChannel, bytes, length);
- Tcl_Write(outChannel, "\n", 1);
+ Tcl_WriteObj(outChannel, resultPtr);
+ Tcl_WriteChars(outChannel, "\n", 1);
}
}
#ifdef TCL_MEM_DEBUG
- if (quitFlag) {
+ if (tclMemDumpFileName != NULL) {
Tcl_DecrRefCount(commandPtr);
- Tcl_DecrRefCount(prompt1NamePtr);
- Tcl_DecrRefCount(prompt2NamePtr);
Tcl_DeleteInterp(interp);
Tcl_Exit(0);
}
@@ -291,53 +326,6 @@ Tcl_Main(argc, argv, appInitProc)
if (commandPtr != NULL) {
Tcl_DecrRefCount(commandPtr);
}
- if (prompt1NamePtr != NULL) {
- Tcl_DecrRefCount(prompt1NamePtr);
- }
- if (prompt2NamePtr != NULL) {
- Tcl_DecrRefCount(prompt2NamePtr);
- }
sprintf(buffer, "exit %d", exitCode);
Tcl_Eval(interp, buffer);
}
-
-/*
- *----------------------------------------------------------------------
- *
- * CheckmemCmd --
- *
- * This is the command procedure for the "checkmem" command, which
- * causes the application to exit after printing information about
- * memory usage to the file passed to this command as its first
- * argument.
- *
- * Results:
- * Returns a standard Tcl completion code.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-#ifdef TCL_MEM_DEBUG
-
- /* ARGSUSED */
-static int
-CheckmemCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter for evaluation. */
- int argc; /* Number of arguments. */
- char *argv[]; /* String values of arguments. */
-{
- extern char *tclMemDumpFileName;
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " fileName\"", (char *) NULL);
- return TCL_ERROR;
- }
- strcpy(dumpFile, argv[1]);
- tclMemDumpFileName = dumpFile;
- quitFlag = 1;
- return TCL_OK;
-}
-#endif
diff --git a/tcl/generic/tclNamesp.c b/tcl/generic/tclNamesp.c
index 97a60029424..38f7d2a794c 100644
--- a/tcl/generic/tclNamesp.c
+++ b/tcl/generic/tclNamesp.c
@@ -9,7 +9,7 @@
*
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* Originally implemented by
* Michael J. McLennan
@@ -34,7 +34,7 @@
#define FIND_ONLY_NS 0x1000
/*
- * Initial sise of stack allocated space for tail list - used when resetting
+ * Initial size of stack allocated space for tail list - used when resetting
* shadowed command references in the functin: TclResetShadowedCmdRefs.
*/
@@ -46,6 +46,7 @@
*/
static long numNsCreated = 0;
+TCL_DECLARE_MUTEX(nsMutex)
/*
* This structure contains a cached pointer to a namespace that is the
@@ -149,39 +150,28 @@ Tcl_ObjType tclNsNameType = {
UpdateStringOfNsName, /* updateStringProc */
SetNsNameFromAny /* setFromAnyProc */
};
-
-/*
- * Boolean flag indicating whether or not the namespName object
- * type has been registered with the Tcl compiler.
- */
-
-static int nsInitialized = 0;
/*
*----------------------------------------------------------------------
*
- * TclInitNamespaces --
+ * TclInitNamespaceSubsystem --
*
- * Called when any interpreter is created to make sure that
- * things are properly set up for namespaces.
+ * This procedure is called to initialize all the structures that
+ * are used by namespaces on a per-process basis.
*
* Results:
* None.
*
* Side effects:
- * On the first call, the namespName object type is registered
- * with the Tcl compiler.
+ * The namespace object type is registered with the Tcl compiler.
*
*----------------------------------------------------------------------
*/
void
-TclInitNamespaces()
+TclInitNamespaceSubsystem()
{
- if (!nsInitialized) {
- Tcl_RegisterObjType(&tclNsNameType);
- nsInitialized = 1;
- }
+ Tcl_RegisterObjType(&tclNsNameType);
}
/*
@@ -266,7 +256,7 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
Tcl_Interp *interp; /* Interpreter in which the new call frame
* is to be pushed. */
Tcl_CallFrame *callFramePtr; /* Points to a call frame structure to
- * push. Storage for this have already been
+ * push. Storage for this has already been
* allocated by the caller; typically this
* is the address of a CallFrame structure
* allocated on the caller's C stack. The
@@ -298,11 +288,8 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
} else {
nsPtr = (Namespace *) namespacePtr;
if (nsPtr->flags & NS_DEAD) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "namespace \"",
- nsPtr->fullName, "\" not found in context \"",
- Tcl_GetCurrentNamespace(interp)->fullName, "\"",
- (char *) NULL);
- return TCL_ERROR;
+ panic("Trying to push call frame for dead namespace");
+ /*NOTREACHED*/
}
}
@@ -458,7 +445,7 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
char *simpleName;
Tcl_HashEntry *entryPtr;
Tcl_DString buffer1, buffer2;
- int newEntry, result;
+ int newEntry;
/*
* If there is no active namespace, the interpreter is being
@@ -482,13 +469,9 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
* Find the parent for the new namespace.
*/
- result = TclGetNamespaceForQualName(interp, name,
- (Namespace *) NULL,
+ TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
/*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
&parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
- if (result != TCL_OK) {
- return NULL;
- }
/*
* If the unqualified name at the end is empty, there were trailing
@@ -519,7 +502,6 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
* count of namespaces created.
*/
- numNsCreated++;
nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
nsPtr->name = (char *) ckalloc((unsigned) (strlen(simpleName)+1));
@@ -529,7 +511,10 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
nsPtr->deleteProc = deleteProc;
nsPtr->parentPtr = parentPtr;
Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
+ Tcl_MutexLock(&nsMutex);
+ numNsCreated++;
nsPtr->nsId = numNsCreated;
+ Tcl_MutexUnlock(&nsMutex);
nsPtr->interp = interp;
nsPtr->flags = 0;
nsPtr->activationCount = 0;
@@ -889,8 +874,8 @@ NamespaceFree(nsPtr)
* Tcl_Export --
*
* Makes all the commands matching a pattern available to later be
- * imported from the namespace specified by contextNsPtr (or the
- * current namespace if contextNsPtr is NULL). The specified pattern is
+ * imported from the namespace specified by namespacePtr (or the
+ * current namespace if namespacePtr is NULL). The specified pattern is
* appended onto the namespace's export pattern list, which is
* optionally cleared beforehand.
*
@@ -917,8 +902,7 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
* in the specified namespace may be
* exported. */
int resetListFirst; /* If nonzero, resets the namespace's
- * export list before appending
- * be overwritten by imported commands.
+ * export list before appending.
* If 0, return an error if an imported
* cmd conflicts with an existing one. */
{
@@ -926,7 +910,7 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
Namespace *nsPtr, *exportNsPtr, *dummyPtr;
Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
char *simplePattern, *patternCpy;
- int neededElems, len, i, result;
+ int neededElems, len, i;
/*
* If the specified namespace is NULL, use the current namespace.
@@ -959,12 +943,10 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
* Check that the pattern doesn't have namespace qualifiers.
*/
- result = TclGetNamespaceForQualName(interp, pattern, nsPtr,
+ TclGetNamespaceForQualName(interp, pattern, nsPtr,
/*flags*/ TCL_LEAVE_ERR_MSG, &exportNsPtr, &dummyPtr,
&dummyPtr, &simplePattern);
- if (result != TCL_OK) {
- return result;
- }
+
if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"invalid export pattern \"", pattern,
@@ -974,6 +956,20 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
}
/*
+ * Make sure that we don't already have the pattern in the array
+ */
+ if (nsPtr->exportArrayPtr != NULL) {
+ for (i = 0; i < nsPtr->numExportPatterns; i++) {
+ if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) {
+ /*
+ * The pattern already exists in the list
+ */
+ return TCL_OK;
+ }
+ }
+ }
+
+ /*
* Make sure there is room in the namespace's pattern array for the
* new pattern.
*/
@@ -1074,7 +1070,7 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
* Tcl_Import --
*
* Imports all of the commands matching a pattern into the namespace
- * specified by contextNsPtr (or the current namespace if contextNsPtr
+ * specified by namespacePtr (or the current namespace if contextNsPtr
* is NULL). This is done by creating a new command (the "imported
* command") that points to the real command in its original namespace.
*
@@ -1115,7 +1111,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
char *simplePattern, *cmdName;
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- Command *cmdPtr;
+ Command *cmdPtr, *realCmdPtr;
ImportRef *refPtr;
Tcl_Command autoCmd, importedCmd;
ImportedCmdData *dataPtr;
@@ -1174,12 +1170,10 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
"empty import pattern", -1);
return TCL_ERROR;
}
- result = TclGetNamespaceForQualName(interp, pattern, nsPtr,
+ TclGetNamespaceForQualName(interp, pattern, nsPtr,
/*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr,
&dummyPtr, &simplePattern);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
+
if (importNsPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"unknown namespace in import pattern \"",
@@ -1251,8 +1245,30 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
Tcl_DStringAppend(&ds, "::", 2);
}
Tcl_DStringAppend(&ds, cmdName, -1);
-
+
+ /*
+ * Check whether creating the new imported command in the
+ * current namespace would create a cycle of imported->real
+ * command references that also would destroy an existing
+ * "real" command already in the current namespace.
+ */
+
cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+ if (cmdPtr->deleteProc == DeleteImportedCmd) {
+ realCmdPtr = (Command *) TclGetOriginalCommand(
+ (Tcl_Command) cmdPtr);
+ if ((realCmdPtr != NULL)
+ && (realCmdPtr->nsPtr == currNsPtr)
+ && (Tcl_FindHashEntry(&currNsPtr->cmdTable,
+ cmdName) != NULL)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "import pattern \"", pattern,
+ "\" would create a loop containing command \"",
+ Tcl_DStringValue(&ds), "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
dataPtr = (ImportedCmdData *)
ckalloc(sizeof(ImportedCmdData));
importedCmd = Tcl_CreateObjCommand(interp,
@@ -1260,6 +1276,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
(ClientData) dataPtr, DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
dataPtr->selfPtr = (Command *) importedCmd;
+ dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
/*
* Create an ImportRef structure describing this new import
@@ -1322,7 +1339,6 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Command *cmdPtr;
- int result;
/*
* If the specified namespace is NULL, use the current namespace.
@@ -1340,12 +1356,10 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
* the end.
*/
- result = TclGetNamespaceForQualName(interp, pattern, nsPtr,
+ TclGetNamespaceForQualName(interp, pattern, nsPtr,
/*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr,
&actualCtxPtr, &simplePattern);
- if (result != TCL_OK) {
- return result;
- }
+
if (importNsPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"unknown namespace in namespace forget pattern \"",
@@ -1382,10 +1396,10 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
*
* TclGetOriginalCommand --
*
- * An imported command is created in an namespace when it imports a
- * "real" command from another namespace. If the specified command is a
+ * An imported command is created in an namespace when a "real" command
+ * is imported from another namespace. If the specified command is an
* imported command, this procedure returns the original command it
- * refers to.
+ * refers to.
*
* Results:
* If the command was imported into a sequence of namespaces a, b,...,n
@@ -1402,8 +1416,8 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
Tcl_Command
TclGetOriginalCommand(command)
- Tcl_Command command; /* The command for which the original
- * command should be returned. */
+ Tcl_Command command; /* The imported command for which the
+ * original command should be returned. */
{
register Command *cmdPtr = (Command *) command;
ImportedCmdData *dataPtr;
@@ -1557,15 +1571,14 @@ DeleteImportedCmd(clientData)
* final component is stored in *simpleNamePtr.
*
* Results:
- * Ordinarily this procedure returns TCL_OK. It sets *nsPtrPtr and
- * *altNsPtrPtr to point to the two possible namespaces which represent
- * the last (containing) namespace in the qualified name. If the
- * procedure sets either *nsPtrPtr or *altNsPtrPtr to NULL, then the
- * search along that path failed. The procedure also stores a pointer
- * to the simple name of the final component in *simpleNamePtr. If the
- * qualified name is "::" or was treated as a namespace reference
- * (FIND_ONLY_NS), the procedure stores a pointer to the
- * namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets
+ * It sets *nsPtrPtr and *altNsPtrPtr to point to the two possible
+ * namespaces which represent the last (containing) namespace in the
+ * qualified name. If the procedure sets either *nsPtrPtr or *altNsPtrPtr
+ * to NULL, then the search along that path failed. The procedure also
+ * stores a pointer to the simple name of the final component in
+ * *simpleNamePtr. If the qualified name is "::" or was treated as a
+ * namespace reference (FIND_ONLY_NS), the procedure stores a pointer
+ * to the namespace in *nsPtrPtr, NULL in *altNsPtrPtr, and sets
* *simpleNamePtr to point to an empty string.
*
* If there is an error, this procedure returns TCL_ERROR. If "flags"
@@ -1577,9 +1590,12 @@ DeleteImportedCmd(clientData)
* set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
* is NULL, it is set to the current namespace context.
*
+ * For backwards compatibility with the TclPro byte code loader,
+ * this function always returns TCL_OK.
+ *
* Side effects:
- * If flags contains TCL_LEAVE_ERR_MSG and an error is encountered,
- * the interpreter's result object will contain an error message.
+ * If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be
+ * created.
*
*----------------------------------------------------------------------
*/
@@ -1634,7 +1650,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
char *nsName;
Tcl_HashEntry *entryPtr;
Tcl_DString buffer;
- int len, result;
+ int len;
/*
* Determine the context namespace nsPtr in which to start the primary
@@ -1759,18 +1775,15 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
} else if (flags & CREATE_NS_IF_UNKNOWN) {
Tcl_CallFrame frame;
- result = Tcl_PushCallFrame(interp, &frame,
+ (void) Tcl_PushCallFrame(interp, &frame,
(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
- if (result != TCL_OK) {
- Tcl_DStringFree(&buffer);
- return result;
- }
+
nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
(ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
Tcl_PopCallFrame(interp);
+
if (nsPtr == NULL) {
- Tcl_DStringFree(&buffer);
- return TCL_ERROR;
+ panic("Could not create namespace '%s'", nsName);
}
} else { /* namespace not found and wasn't created */
nsPtr = NULL;
@@ -1873,7 +1886,6 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
{
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
char *dummy;
- int result;
/*
* Find the namespace(s) that contain the specified namespace name.
@@ -1881,12 +1893,9 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
* to its last component, a namespace.
*/
- result = TclGetNamespaceForQualName(interp, name,
- (Namespace *) contextNsPtr, /*flags*/ (flags | FIND_ONLY_NS),
- &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
- if (result != TCL_OK) {
- return NULL;
- }
+ TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+ (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+
if (nsPtr != NULL) {
return (Tcl_Namespace *) nsPtr;
} else if (flags & TCL_LEAVE_ERR_MSG) {
@@ -1997,12 +2006,8 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
* Find the namespace(s) that contain the command.
*/
- result = TclGetNamespaceForQualName(interp, name,
- (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1],
- &cxtNsPtr, &simpleName);
- if (result != TCL_OK) {
- return (Tcl_Command) NULL;
- }
+ TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+ flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
/*
* Look for the command in the command table of its namespace.
@@ -2131,12 +2136,8 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
* Find the namespace(s) that contain the variable.
*/
- result = TclGetNamespaceForQualName(interp, name,
- (Namespace *) contextNsPtr, flags, &nsPtr[0], &nsPtr[1],
- &cxtNsPtr, &simpleName);
- if (result != TCL_OK) {
- return (Tcl_Var) NULL;
- }
+ TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+ flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
/*
* Look for the variable in the variable table of its namespace.
@@ -2314,7 +2315,7 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
*
* GetNamespaceFromObj --
*
- * Returns the namespace specified by the name in a Tcl_Obj.
+ * Gets the namespace specified by the name in a Tcl_Obj.
*
* Results:
* Returns TCL_OK if the namespace was resolved successfully, and
@@ -2451,8 +2452,8 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
NSEvalIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
NSTailIdx, NSWhichIdx
- } index;
- int result;
+ };
+ int index, result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
@@ -2565,8 +2566,7 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
}
if (namespacePtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"",
- Tcl_GetStringFromObj(objv[2], (int *) NULL),
+ "unknown namespace \"", Tcl_GetString(objv[2]),
"\" in namespace children command", (char *) NULL);
return TCL_ERROR;
}
@@ -2582,7 +2582,7 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
Tcl_DStringInit(&buffer);
if (objc == 4) {
- char *name = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+ char *name = Tcl_GetString(objv[3]);
if ((*name == ':') && (*(name+1) == ':')) {
pattern = name;
@@ -2816,13 +2816,12 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
*/
for (i = 2; i < objc; i++) {
- name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ name = Tcl_GetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name,
(Tcl_Namespace *) NULL, /*flags*/ 0);
if (namespacePtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"",
- Tcl_GetStringFromObj(objv[i], (int *) NULL),
+ "unknown namespace \"", Tcl_GetString(objv[i]),
"\" in namespace delete command", (char *) NULL);
return TCL_ERROR;
}
@@ -2833,7 +2832,7 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
*/
for (i = 2; i < objc; i++) {
- name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ name = Tcl_GetString(objv[i]);
namespacePtr = Tcl_FindNamespace(interp, name,
(Tcl_Namespace *) NULL, /* flags */ 0);
if (namespacePtr) {
@@ -2923,14 +2922,18 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
}
if (objc == 4) {
- result = Tcl_EvalObj(interp, objv[3]);
+ result = Tcl_EvalObjEx(interp, objv[3], 0);
} else {
+ /*
+ * More than one argument: concatenate them together with spaces
+ * between, then evaluate the result. Tcl_EvalObjEx will delete
+ * the object when it decrements its refcount after eval'ing it.
+ */
objPtr = Tcl_ConcatObj(objc-3, objv+3);
- result = Tcl_EvalObj(interp, objPtr);
- Tcl_DecrRefCount(objPtr); /* we're done with the object */
+ result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
- char msg[256];
+ char msg[256 + TCL_INTEGER_SPACE];
sprintf(msg, "\n (in namespace eval \"%.200s\" script line %d)",
namespacePtr->fullName, interp->errorLine);
@@ -3005,7 +3008,7 @@ NamespaceExportCmd(dummy, interp, objc, objv)
firstArg = 2;
if (firstArg < objc) {
- string = Tcl_GetStringFromObj(objv[firstArg], (int *) NULL);
+ string = Tcl_GetString(objv[firstArg]);
if (strcmp(string, "-clear") == 0) {
resetListFirst = 1;
firstArg++;
@@ -3038,7 +3041,7 @@ NamespaceExportCmd(dummy, interp, objc, objv)
*/
for (i = firstArg; i < objc; i++) {
- pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ pattern = Tcl_GetString(objv[i]);
result = Tcl_Export(interp, (Tcl_Namespace *) currNsPtr, pattern,
((i == firstArg)? resetListFirst : 0));
if (result != TCL_OK) {
@@ -3094,7 +3097,7 @@ NamespaceForgetCmd(dummy, interp, objc, objv)
}
for (i = 2; i < objc; i++) {
- pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ pattern = Tcl_GetString(objv[i]);
result = Tcl_ForgetImport(interp, (Tcl_Namespace *) NULL, pattern);
if (result != TCL_OK) {
return result;
@@ -3164,7 +3167,7 @@ NamespaceImportCmd(dummy, interp, objc, objv)
firstArg = 2;
if (firstArg < objc) {
- string = Tcl_GetStringFromObj(objv[firstArg], (int *) NULL);
+ string = Tcl_GetString(objv[firstArg]);
if ((*string == '-') && (strcmp(string, "-force") == 0)) {
allowOverwrite = 1;
firstArg++;
@@ -3176,7 +3179,7 @@ NamespaceImportCmd(dummy, interp, objc, objv)
*/
for (i = firstArg; i < objc; i++) {
- pattern = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ pattern = Tcl_GetString(objv[i]);
result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
allowOverwrite);
if (result != TCL_OK) {
@@ -3250,8 +3253,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
}
if (namespacePtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"",
- Tcl_GetStringFromObj(objv[2], (int *) NULL),
+ "unknown namespace \"", Tcl_GetString(objv[2]),
"\" in inscope namespace command", (char *) NULL);
return TCL_ERROR;
}
@@ -3274,7 +3276,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
*/
if (objc == 4) {
- result = Tcl_EvalObj(interp, objv[3]);
+ result = Tcl_EvalObjEx(interp, objv[3], 0);
} else {
Tcl_Obj *concatObjv[2];
register Tcl_Obj *listPtr, *cmdObjPtr;
@@ -3291,13 +3293,11 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
concatObjv[0] = objv[3];
concatObjv[1] = listPtr;
cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
- result = Tcl_EvalObj(interp, cmdObjPtr);
-
- Tcl_DecrRefCount(cmdObjPtr); /* we're done with the cmd object */
+ result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
Tcl_DecrRefCount(listPtr); /* we're done with the list object */
}
if (result == TCL_ERROR) {
- char msg[256];
+ char msg[256 + TCL_INTEGER_SPACE];
sprintf(msg,
"\n (in namespace inscope \"%.200s\" script line %d)",
@@ -3359,8 +3359,7 @@ NamespaceOriginCmd(dummy, interp, objc, objv)
command = Tcl_GetCommandFromObj(interp, objv[2]);
if (command == (Tcl_Command) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "invalid command name \"",
- Tcl_GetStringFromObj(objv[2], (int *) NULL),
+ "invalid command name \"", Tcl_GetString(objv[2]),
"\"", (char *) NULL);
return TCL_ERROR;
}
@@ -3419,8 +3418,7 @@ NamespaceParentCmd(dummy, interp, objc, objv)
}
if (nsPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"",
- Tcl_GetStringFromObj(objv[2], (int *) NULL),
+ "unknown namespace \"", Tcl_GetString(objv[2]),
"\" in namespace parent command", (char *) NULL);
return TCL_ERROR;
}
@@ -3486,7 +3484,7 @@ NamespaceQualifiersCmd(dummy, interp, objc, objv)
* the start of the last "::" qualifier.
*/
- name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ name = Tcl_GetString(objv[2]);
for (p = name; *p != '\0'; p++) {
/* empty body */
}
@@ -3552,7 +3550,7 @@ NamespaceTailCmd(dummy, interp, objc, objv)
* last "::" qualifier.
*/
- name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ name = Tcl_GetString(objv[2]);
for (p = name; *p != '\0'; p++) {
/* empty body */
}
@@ -3616,7 +3614,7 @@ NamespaceWhichCmd(dummy, interp, objc, objv)
argIndex = 2;
lookup = 0; /* assume command lookup by default */
- arg = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ arg = Tcl_GetString(objv[2]);
if (*arg == '-') {
if (strncmp(arg, "-command", 8) == 0) {
lookup = 0;
@@ -3641,7 +3639,7 @@ NamespaceWhichCmd(dummy, interp, objc, objv)
break;
case 1: /* -variable */
- arg = Tcl_GetStringFromObj(objv[argIndex], (int *) NULL);
+ arg = Tcl_GetString(objv[argIndex]);
variable = Tcl_FindNamespaceVar(interp, arg, (Tcl_Namespace *) NULL,
/*flags*/ 0);
if (variable != (Tcl_Var) NULL) {
@@ -3773,7 +3771,6 @@ SetNsNameFromAny(interp, objPtr)
char *name, *dummy;
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
register ResolvedNsName *resNamePtr;
- int flags, result;
/*
* Get the string representation. Make it up-to-date if necessary.
@@ -3781,7 +3778,7 @@ SetNsNameFromAny(interp, objPtr)
name = objPtr->bytes;
if (name == NULL) {
- name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+ name = Tcl_GetString(objPtr);
}
/*
@@ -3791,12 +3788,8 @@ SetNsNameFromAny(interp, objPtr)
* object with a NULL ResolvedNsName* internal rep.
*/
- flags = ((interp != NULL)? TCL_LEAVE_ERR_MSG : 0) | FIND_ONLY_NS;
- result = TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
- flags, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
- if (result != TCL_OK) {
- return result;
- }
+ TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
+ FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
/*
* If we found a namespace, then create a new ResolvedNsName structure
@@ -3887,3 +3880,4 @@ UpdateStringOfNsName(objPtr)
}
objPtr->length = length;
}
+
diff --git a/tcl/generic/tclNotify.c b/tcl/generic/tclNotify.c
index 67bf7bfa4e1..2c386ab9e7c 100644
--- a/tcl/generic/tclNotify.c
+++ b/tcl/generic/tclNotify.c
@@ -19,11 +19,7 @@
#include "tclInt.h"
#include "tclPort.h"
-/*
- * The following static indicates whether this module has been initialized.
- */
-
-static int initialized = 0;
+extern TclStubs tclStubs;
/*
* For each event source (created with Tcl_CreateEventSource) there
@@ -38,21 +34,25 @@ typedef struct EventSource {
} EventSource;
/*
- * The following structure keeps track of the state of the notifier.
- * The first three elements keep track of the event queue. In addition to
- * the first (next to be serviced) and last events in the queue, we keep
- * track of a "marker" event. This provides a simple priority mechanism
- * whereby events can be inserted at the front of the queue but behind all
- * other high-priority events already in the queue (this is used for things
- * like a sequence of Enter and Leave events generated during a grab in
- * Tk).
+ * The following structure keeps track of the state of the notifier on a
+ * per-thread basis. The first three elements keep track of the event queue.
+ * In addition to the first (next to be serviced) and last events in the queue,
+ * we keep track of a "marker" event. This provides a simple priority
+ * mechanism whereby events can be inserted at the front of the queue but
+ * behind all other high-priority events already in the queue (this is used for
+ * things like a sequence of Enter and Leave events generated during a grab in
+ * Tk). These elements are protected by the queueMutex so that any thread
+ * can queue an event on any notifier. Note that all of the values in this
+ * structure will be initialized to 0.
*/
-static struct {
+typedef struct ThreadSpecificData {
Tcl_Event *firstEventPtr; /* First pending event, or NULL if none. */
Tcl_Event *lastEventPtr; /* Last pending event, or NULL if none. */
Tcl_Event *markerEventPtr; /* Last high-priority event in queue, or
* NULL if none. */
+ Tcl_Mutex queueMutex; /* Mutex to protect access to the previous
+ * three fields. */
int serviceMode; /* One of TCL_SERVICE_NONE or
* TCL_SERVICE_ALL. */
int blockTimeSet; /* 0 means there is no maximum block
@@ -63,63 +63,135 @@ static struct {
* called during an event source traversal. */
EventSource *firstEventSourcePtr;
/* Pointer to first event source in
- * global list of event sources. */
-} notifier;
+ * list of event sources for this thread. */
+ Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */
+ ClientData clientData; /* Opaque handle for platform specific
+ * notifier. */
+ struct ThreadSpecificData *nextPtr;
+ /* Next notifier in global list of notifiers.
+ * Access is controlled by the listLock global
+ * mutex. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
/*
- * Declarations for functions used in this file.
+ * Global list of notifiers. Access to this list is controlled by the
+ * listLock mutex. If this becomes a performance bottleneck, this could
+ * be replaced with a hashtable.
*/
-static void InitNotifier _ANSI_ARGS_((void));
-static void NotifierExitHandler _ANSI_ARGS_((ClientData clientData));
+static ThreadSpecificData *firstNotifierPtr;
+TCL_DECLARE_MUTEX(listLock)
+
+/*
+ * Declarations for routines used only in this file.
+ */
+static void QueueEvent _ANSI_ARGS_((ThreadSpecificData *tsdPtr,
+ Tcl_Event* evPtr, Tcl_QueuePosition position));
/*
*----------------------------------------------------------------------
*
- * InitNotifier --
+ * TclInitNotifier --
*
- * This routine is called to initialize the notifier module.
+ * Initialize the thread local data structures for the notifier
+ * subsystem.
*
* Results:
* None.
*
* Side effects:
- * Creates an exit handler and initializes static data.
+ * Adds the current thread to the global list of notifiers.
*
*----------------------------------------------------------------------
*/
-static void
-InitNotifier()
+void
+TclInitNotifier()
{
- initialized = 1;
- memset(&notifier, 0, sizeof(notifier));
- notifier.serviceMode = TCL_SERVICE_NONE;
- Tcl_CreateExitHandler(NotifierExitHandler, NULL);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ Tcl_MutexLock(&listLock);
+
+ tsdPtr->threadId = Tcl_GetCurrentThread();
+ tsdPtr->clientData = Tcl_InitNotifier();
+ tsdPtr->nextPtr = firstNotifierPtr;
+ firstNotifierPtr = tsdPtr;
+
+ Tcl_MutexUnlock(&listLock);
}
/*
*----------------------------------------------------------------------
*
- * NotifierExitHandler --
+ * TclFinalizeNotifier --
*
- * This routine is called during Tcl finalization.
+ * Finalize the thread local data structures for the notifier
+ * subsystem.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Removes the notifier associated with the current thread from
+ * the global notifier list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeNotifier()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData **prevPtrPtr;
+
+ Tcl_MutexLock(&listLock);
+
+ Tcl_FinalizeNotifier(tsdPtr->clientData);
+ Tcl_MutexFinalize(&(tsdPtr->queueMutex));
+ for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
+ prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
+ if (*prevPtrPtr == tsdPtr) {
+ *prevPtrPtr = tsdPtr->nextPtr;
+ break;
+ }
+ }
+
+ Tcl_MutexUnlock(&listLock);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetNotifier --
+ *
+ * Install a set of alternate functions for use with the notifier.
+ # In particular, this can be used to install the Xt-based
+ * notifier for use with the Browser plugin.
*
* Results:
* None.
*
* Side effects:
- * Clears the notifier intialization flag.
+ * Overstomps part of the stub vector. This relies on hooks
+ * added to the default procedures in case those are called
+ * directly (i.e., not through the stub table.)
*
*----------------------------------------------------------------------
*/
-static void
-NotifierExitHandler(clientData)
- ClientData clientData; /* Not used. */
+void
+Tcl_SetNotifier(notifierProcPtr)
+ Tcl_NotifierProcs *notifierProcPtr;
{
- initialized = 0;
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ tclStubs.tcl_CreateFileHandler = notifierProcPtr->createFileHandlerProc;
+ tclStubs.tcl_DeleteFileHandler = notifierProcPtr->deleteFileHandlerProc;
+#endif
+ tclStubs.tcl_SetTimer = notifierProcPtr->setTimerProc;
+ tclStubs.tcl_WaitForEvent = notifierProcPtr->waitForEventProc;
}
/*
@@ -140,12 +212,12 @@ NotifierExitHandler(clientData)
* SetupProc and checkProc will be invoked each time that Tcl_DoOneEvent
* runs out of things to do. SetupProc will be invoked before
* Tcl_DoOneEvent calls select or whatever else it uses to wait
- * for events. SetupProc typically calls functions like Tcl_WatchFile
- * or Tcl_SetMaxBlockTime to indicate what to wait for.
+ * for events. SetupProc typically calls functions like
+ * Tcl_SetMaxBlockTime to indicate what to wait for.
*
* CheckProc is called after select or whatever operation was actually
* used to wait. It figures out whether anything interesting actually
- * happened (e.g. by calling Tcl_FileReady), and then calls
+ * happened (e.g. by calling Tcl_AsyncReady), and then calls
* Tcl_QueueEvent to queue any events that are ready.
*
* Each of these procedures is passed two arguments, e.g.
@@ -167,18 +239,14 @@ Tcl_CreateEventSource(setupProc, checkProc, clientData)
ClientData clientData; /* One-word argument to pass to
* setupProc and checkProc. */
{
- EventSource *sourcePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
- if (!initialized) {
- InitNotifier();
- }
-
- sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
sourcePtr->setupProc = setupProc;
sourcePtr->checkProc = checkProc;
sourcePtr->clientData = clientData;
- sourcePtr->nextPtr = notifier.firstEventSourcePtr;
- notifier.firstEventSourcePtr = sourcePtr;
+ sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
+ tsdPtr->firstEventSourcePtr = sourcePtr;
}
/*
@@ -209,9 +277,10 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
ClientData clientData; /* One-word argument to pass to
* setupProc and checkProc. */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
EventSource *sourcePtr, *prevPtr;
- for (sourcePtr = notifier.firstEventSourcePtr, prevPtr = NULL;
+ for (sourcePtr = tsdPtr->firstEventSourcePtr, prevPtr = NULL;
sourcePtr != NULL;
prevPtr = sourcePtr, sourcePtr = sourcePtr->nextPtr) {
if ((sourcePtr->setupProc != setupProc)
@@ -220,7 +289,7 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
continue;
}
if (prevPtr == NULL) {
- notifier.firstEventSourcePtr = sourcePtr->nextPtr;
+ tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr;
} else {
prevPtr->nextPtr = sourcePtr->nextPtr;
}
@@ -234,12 +303,8 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
*
* Tcl_QueueEvent --
*
- * Insert an event into the Tk event queue at one of three
- * positions: the head, the tail, or before a floating marker.
- * Events inserted before the marker will be processed in
- * first-in-first-out order, but before any events inserted at
- * the tail of the queue. Events inserted at the head of the
- * queue will be processed in last-in-first-out order.
+ * Queue an event on the event queue associated with the
+ * current thread.
*
* Results:
* None.
@@ -261,50 +326,136 @@ Tcl_QueueEvent(evPtr, position)
Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
* TCL_QUEUE_MARK. */
{
- if (!initialized) {
- InitNotifier();
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ QueueEvent(tsdPtr, evPtr, position);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ThreadQueueEvent --
+ *
+ * Queue an event on the specified thread's event queue.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ThreadQueueEvent(threadId, evPtr, position)
+ Tcl_ThreadId threadId; /* Identifier for thread to use. */
+ Tcl_Event* evPtr; /* Event to add to queue. The storage
+ * space must have been allocated the caller
+ * with malloc (ckalloc), and it becomes
+ * the property of the event queue. It
+ * will be freed after the event has been
+ * handled. */
+ Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ * TCL_QUEUE_MARK. */
+{
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Find the notifier associated with the specified thread.
+ */
+
+ Tcl_MutexLock(&listLock);
+ for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
+ tsdPtr = tsdPtr->nextPtr) {
+ /* Empty loop body. */
}
+ /*
+ * Queue the event if there was a notifier associated with the thread.
+ */
+
+ if (tsdPtr) {
+ QueueEvent(tsdPtr, evPtr, position);
+ }
+ Tcl_MutexUnlock(&listLock);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QueueEvent --
+ *
+ * Insert an event into the specified thread's event queue at one
+ * of three positions: the head, the tail, or before a floating
+ * marker. Events inserted before the marker will be processed in
+ * first-in-first-out order, but before any events inserted at
+ * the tail of the queue. Events inserted at the head of the
+ * queue will be processed in last-in-first-out order.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+QueueEvent(tsdPtr, evPtr, position)
+ ThreadSpecificData *tsdPtr; /* Handle to thread local data that indicates
+ * which event queue to use. */
+ Tcl_Event* evPtr; /* Event to add to queue. The storage
+ * space must have been allocated the caller
+ * with malloc (ckalloc), and it becomes
+ * the property of the event queue. It
+ * will be freed after the event has been
+ * handled. */
+ Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ * TCL_QUEUE_MARK. */
+{
+ Tcl_MutexLock(&(tsdPtr->queueMutex));
if (position == TCL_QUEUE_TAIL) {
/*
* Append the event on the end of the queue.
*/
evPtr->nextPtr = NULL;
- if (notifier.firstEventPtr == NULL) {
- notifier.firstEventPtr = evPtr;
+ if (tsdPtr->firstEventPtr == NULL) {
+ tsdPtr->firstEventPtr = evPtr;
} else {
- notifier.lastEventPtr->nextPtr = evPtr;
+ tsdPtr->lastEventPtr->nextPtr = evPtr;
}
- notifier.lastEventPtr = evPtr;
+ tsdPtr->lastEventPtr = evPtr;
} else if (position == TCL_QUEUE_HEAD) {
/*
* Push the event on the head of the queue.
*/
- evPtr->nextPtr = notifier.firstEventPtr;
- if (notifier.firstEventPtr == NULL) {
- notifier.lastEventPtr = evPtr;
+ evPtr->nextPtr = tsdPtr->firstEventPtr;
+ if (tsdPtr->firstEventPtr == NULL) {
+ tsdPtr->lastEventPtr = evPtr;
}
- notifier.firstEventPtr = evPtr;
+ tsdPtr->firstEventPtr = evPtr;
} else if (position == TCL_QUEUE_MARK) {
/*
* Insert the event after the current marker event and advance
* the marker to the new event.
*/
- if (notifier.markerEventPtr == NULL) {
- evPtr->nextPtr = notifier.firstEventPtr;
- notifier.firstEventPtr = evPtr;
+ if (tsdPtr->markerEventPtr == NULL) {
+ evPtr->nextPtr = tsdPtr->firstEventPtr;
+ tsdPtr->firstEventPtr = evPtr;
} else {
- evPtr->nextPtr = notifier.markerEventPtr->nextPtr;
- notifier.markerEventPtr->nextPtr = evPtr;
+ evPtr->nextPtr = tsdPtr->markerEventPtr->nextPtr;
+ tsdPtr->markerEventPtr->nextPtr = evPtr;
}
- notifier.markerEventPtr = evPtr;
+ tsdPtr->markerEventPtr = evPtr;
if (evPtr->nextPtr == NULL) {
- notifier.lastEventPtr = evPtr;
+ tsdPtr->lastEventPtr = evPtr;
}
}
+ Tcl_MutexUnlock(&(tsdPtr->queueMutex));
}
/*
@@ -314,7 +465,8 @@ Tcl_QueueEvent(evPtr, position)
*
* Calls a procedure for each event in the queue and deletes those
* for which the procedure returns 1. Events for which the
- * procedure returns 0 are left in the queue.
+ * procedure returns 0 are left in the queue. Operates on the
+ * queue associated with the current thread.
*
* Results:
* None.
@@ -331,22 +483,20 @@ Tcl_DeleteEvents(proc, clientData)
ClientData clientData; /* type-specific data. */
{
Tcl_Event *evPtr, *prevPtr, *hold;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!initialized) {
- InitNotifier();
- }
-
- for (prevPtr = (Tcl_Event *) NULL, evPtr = notifier.firstEventPtr;
+ Tcl_MutexLock(&(tsdPtr->queueMutex));
+ for (prevPtr = (Tcl_Event *) NULL, evPtr = tsdPtr->firstEventPtr;
evPtr != (Tcl_Event *) NULL;
) {
if ((*proc) (evPtr, clientData) == 1) {
- if (notifier.firstEventPtr == evPtr) {
- notifier.firstEventPtr = evPtr->nextPtr;
- if (evPtr->nextPtr == NULL) {
- notifier.lastEventPtr = prevPtr;
+ if (tsdPtr->firstEventPtr == evPtr) {
+ tsdPtr->firstEventPtr = evPtr->nextPtr;
+ if (evPtr->nextPtr == (Tcl_Event *) NULL) {
+ tsdPtr->lastEventPtr = prevPtr;
}
- if (notifier.markerEventPtr == evPtr) {
- notifier.markerEventPtr = prevPtr;
+ if (tsdPtr->markerEventPtr == evPtr) {
+ tsdPtr->markerEventPtr = prevPtr;
}
} else {
prevPtr->nextPtr = evPtr->nextPtr;
@@ -359,6 +509,7 @@ Tcl_DeleteEvents(proc, clientData)
evPtr = evPtr->nextPtr;
}
}
+ Tcl_MutexUnlock(&(tsdPtr->queueMutex));
}
/*
@@ -367,7 +518,8 @@ Tcl_DeleteEvents(proc, clientData)
* Tcl_ServiceEvent --
*
* Process one event from the event queue, or invoke an
- * asynchronous event handler.
+ * asynchronous event handler. Operates on event queue for
+ * current thread.
*
* Results:
* The return value is 1 if the procedure actually found an event
@@ -392,10 +544,8 @@ Tcl_ServiceEvent(flags)
{
Tcl_Event *evPtr, *prevPtr;
Tcl_EventProc *proc;
-
- if (!initialized) {
- InitNotifier();
- }
+ int result;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Asynchronous event handlers are considered to be the highest
@@ -421,12 +571,13 @@ Tcl_ServiceEvent(flags)
* that can actually be handled.
*/
- for (evPtr = notifier.firstEventPtr; evPtr != NULL;
+ Tcl_MutexLock(&(tsdPtr->queueMutex));
+ for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL;
evPtr = evPtr->nextPtr) {
/*
* Call the handler for the event. If it actually handles the
* event then free the storage for the event. There are two
- * tricky things here, but stemming from the fact that the event
+ * tricky things here, both stemming from the fact that the event
* code may be re-entered while servicing the event:
*
* 1. Set the "proc" field to NULL. This is a signal to ourselves
@@ -440,30 +591,57 @@ Tcl_ServiceEvent(flags)
*/
proc = evPtr->proc;
+ if (proc == NULL) {
+ continue;
+ }
evPtr->proc = NULL;
- if ((proc != NULL) && (*proc)(evPtr, flags)) {
- if (notifier.firstEventPtr == evPtr) {
- notifier.firstEventPtr = evPtr->nextPtr;
+
+ /*
+ * Release the lock before calling the event procedure. This
+ * allows other threads to post events if we enter a recursive
+ * event loop in this thread. Note that we are making the assumption
+ * that if the proc returns 0, the event is still in the list.
+ */
+
+ Tcl_MutexUnlock(&(tsdPtr->queueMutex));
+ result = (*proc)(evPtr, flags);
+ Tcl_MutexLock(&(tsdPtr->queueMutex));
+
+ if (result) {
+ /*
+ * The event was processed, so remove it from the queue.
+ */
+
+ if (tsdPtr->firstEventPtr == evPtr) {
+ tsdPtr->firstEventPtr = evPtr->nextPtr;
if (evPtr->nextPtr == NULL) {
- notifier.lastEventPtr = NULL;
+ tsdPtr->lastEventPtr = NULL;
}
- if (notifier.markerEventPtr == evPtr) {
- notifier.markerEventPtr = NULL;
+ if (tsdPtr->markerEventPtr == evPtr) {
+ tsdPtr->markerEventPtr = NULL;
}
} else {
- for (prevPtr = notifier.firstEventPtr;
- prevPtr->nextPtr != evPtr; prevPtr = prevPtr->nextPtr) {
+ for (prevPtr = tsdPtr->firstEventPtr;
+ prevPtr && prevPtr->nextPtr != evPtr;
+ prevPtr = prevPtr->nextPtr) {
/* Empty loop body. */
}
- prevPtr->nextPtr = evPtr->nextPtr;
- if (evPtr->nextPtr == NULL) {
- notifier.lastEventPtr = prevPtr;
- }
- if (notifier.markerEventPtr == evPtr) {
- notifier.markerEventPtr = prevPtr;
+ if (prevPtr) {
+ prevPtr->nextPtr = evPtr->nextPtr;
+ if (evPtr->nextPtr == NULL) {
+ tsdPtr->lastEventPtr = prevPtr;
+ }
+ if (tsdPtr->markerEventPtr == evPtr) {
+ tsdPtr->markerEventPtr = prevPtr;
+ }
+ } else {
+ evPtr = NULL;
}
}
- ckfree((char *) evPtr);
+ if (evPtr) {
+ ckfree((char *) evPtr);
+ }
+ Tcl_MutexUnlock(&(tsdPtr->queueMutex));
return 1;
} else {
/*
@@ -473,14 +651,8 @@ Tcl_ServiceEvent(flags)
evPtr->proc = proc;
}
-
- /*
- * The handler for this event asked to defer it. Just go on to
- * the next event.
- */
-
- continue;
}
+ Tcl_MutexUnlock(&(tsdPtr->queueMutex));
return 0;
}
@@ -503,11 +675,9 @@ Tcl_ServiceEvent(flags)
int
Tcl_GetServiceMode()
{
- if (!initialized) {
- InitNotifier();
- }
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- return notifier.serviceMode;
+ return tsdPtr->serviceMode;
}
/*
@@ -515,13 +685,13 @@ Tcl_GetServiceMode()
*
* Tcl_SetServiceMode --
*
- * This routine sets the current service mode of the notifier.
+ * This routine sets the current service mode of the tsdPtr->
*
* Results:
* Returns the previous service mode.
*
* Side effects:
- * None.
+ * Invokes the notifier service mode hook procedure.
*
*----------------------------------------------------------------------
*/
@@ -532,13 +702,11 @@ Tcl_SetServiceMode(mode)
* TCL_SERVICE_NONE */
{
int oldMode;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!initialized) {
- InitNotifier();
- }
-
- oldMode = notifier.serviceMode;
- notifier.serviceMode = mode;
+ oldMode = tsdPtr->serviceMode;
+ tsdPtr->serviceMode = mode;
+ Tcl_ServiceModeHook(mode);
return oldMode;
}
@@ -556,7 +724,7 @@ Tcl_SetServiceMode(mode)
* None.
*
* Side effects:
- * May reduce the length of the next sleep in the notifier.
+ * May reduce the length of the next sleep in the tsdPtr->
*
*----------------------------------------------------------------------
*/
@@ -565,17 +733,15 @@ void
Tcl_SetMaxBlockTime(timePtr)
Tcl_Time *timePtr; /* Specifies a maximum elapsed time for
* the next blocking operation in the
- * event notifier. */
+ * event tsdPtr-> */
{
- if (!initialized) {
- InitNotifier();
- }
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!notifier.blockTimeSet || (timePtr->sec < notifier.blockTime.sec)
- || ((timePtr->sec == notifier.blockTime.sec)
- && (timePtr->usec < notifier.blockTime.usec))) {
- notifier.blockTime = *timePtr;
- notifier.blockTimeSet = 1;
+ if (!tsdPtr->blockTimeSet || (timePtr->sec < tsdPtr->blockTime.sec)
+ || ((timePtr->sec == tsdPtr->blockTime.sec)
+ && (timePtr->usec < tsdPtr->blockTime.usec))) {
+ tsdPtr->blockTime = *timePtr;
+ tsdPtr->blockTimeSet = 1;
}
/*
@@ -583,9 +749,9 @@ Tcl_SetMaxBlockTime(timePtr)
* timeout immediately.
*/
- if (!notifier.inTraversal) {
- if (notifier.blockTimeSet) {
- Tcl_SetTimer(&notifier.blockTime);
+ if (!tsdPtr->inTraversal) {
+ if (tsdPtr->blockTimeSet) {
+ Tcl_SetTimer(&tsdPtr->blockTime);
} else {
Tcl_SetTimer(NULL);
}
@@ -626,10 +792,7 @@ Tcl_DoOneEvent(flags)
int result = 0, oldMode;
EventSource *sourcePtr;
Tcl_Time *timePtr;
-
- if (!initialized) {
- InitNotifier();
- }
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* The first thing we do is to service any asynchronous event
@@ -654,8 +817,8 @@ Tcl_DoOneEvent(flags)
* try to service events recursively.
*/
- oldMode = notifier.serviceMode;
- notifier.serviceMode = TCL_SERVICE_NONE;
+ oldMode = tsdPtr->serviceMode;
+ tsdPtr->serviceMode = TCL_SERVICE_NONE;
/*
* The core of this procedure is an infinite loop, even though
@@ -691,11 +854,11 @@ Tcl_DoOneEvent(flags)
*/
if (flags & TCL_DONT_WAIT) {
- notifier.blockTime.sec = 0;
- notifier.blockTime.usec = 0;
- notifier.blockTimeSet = 1;
+ tsdPtr->blockTime.sec = 0;
+ tsdPtr->blockTime.usec = 0;
+ tsdPtr->blockTimeSet = 1;
} else {
- notifier.blockTimeSet = 0;
+ tsdPtr->blockTimeSet = 0;
}
/*
@@ -703,17 +866,17 @@ Tcl_DoOneEvent(flags)
* cause the block time to be updated if necessary.
*/
- notifier.inTraversal = 1;
- for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+ tsdPtr->inTraversal = 1;
+ for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
sourcePtr = sourcePtr->nextPtr) {
if (sourcePtr->setupProc) {
(sourcePtr->setupProc)(sourcePtr->clientData, flags);
}
}
- notifier.inTraversal = 0;
+ tsdPtr->inTraversal = 0;
- if ((flags & TCL_DONT_WAIT) || notifier.blockTimeSet) {
- timePtr = &notifier.blockTime;
+ if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) {
+ timePtr = &tsdPtr->blockTime;
} else {
timePtr = NULL;
}
@@ -733,7 +896,7 @@ Tcl_DoOneEvent(flags)
* Check all the event sources for new events.
*/
- for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+ for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
sourcePtr = sourcePtr->nextPtr) {
if (sourcePtr->checkProc) {
(sourcePtr->checkProc)(sourcePtr->clientData, flags);
@@ -786,7 +949,7 @@ Tcl_DoOneEvent(flags)
}
- notifier.serviceMode = oldMode;
+ tsdPtr->serviceMode = oldMode;
return result;
}
@@ -816,12 +979,9 @@ Tcl_ServiceAll()
{
int result = 0;
EventSource *sourcePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!initialized) {
- InitNotifier();
- }
-
- if (notifier.serviceMode == TCL_SERVICE_NONE) {
+ if (tsdPtr->serviceMode == TCL_SERVICE_NONE) {
return result;
}
@@ -830,7 +990,7 @@ Tcl_ServiceAll()
* to avoid recursive calls.
*/
- notifier.serviceMode = TCL_SERVICE_NONE;
+ tsdPtr->serviceMode = TCL_SERVICE_NONE;
/*
* Check async handlers first.
@@ -846,16 +1006,16 @@ Tcl_ServiceAll()
* timer until the end so we can avoid multiple changes.
*/
- notifier.inTraversal = 1;
- notifier.blockTimeSet = 0;
+ tsdPtr->inTraversal = 1;
+ tsdPtr->blockTimeSet = 0;
- for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+ for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
sourcePtr = sourcePtr->nextPtr) {
if (sourcePtr->setupProc) {
(sourcePtr->setupProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
}
}
- for (sourcePtr = notifier.firstEventSourcePtr; sourcePtr != NULL;
+ for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
sourcePtr = sourcePtr->nextPtr) {
if (sourcePtr->checkProc) {
(sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
@@ -869,12 +1029,53 @@ Tcl_ServiceAll()
result = 1;
}
- if (!notifier.blockTimeSet) {
+ if (!tsdPtr->blockTimeSet) {
Tcl_SetTimer(NULL);
} else {
- Tcl_SetTimer(&notifier.blockTime);
+ Tcl_SetTimer(&tsdPtr->blockTime);
}
- notifier.inTraversal = 0;
- notifier.serviceMode = TCL_SERVICE_ALL;
+ tsdPtr->inTraversal = 0;
+ tsdPtr->serviceMode = TCL_SERVICE_ALL;
return result;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ThreadAlert --
+ *
+ * This function wakes up the notifier associated with the
+ * specified thread (if there is one).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ThreadAlert(threadId)
+ Tcl_ThreadId threadId; /* Identifier for thread to use. */
+{
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Find the notifier associated with the specified thread.
+ * Note that we need to hold the listLock while calling
+ * Tcl_AlertNotifier to avoid a race condition where
+ * the specified thread might destroy its notifier.
+ */
+
+ Tcl_MutexLock(&listLock);
+ for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
+ if (tsdPtr->threadId == threadId) {
+ Tcl_AlertNotifier(tsdPtr->clientData);
+ break;
+ }
+ }
+ Tcl_MutexUnlock(&listLock);
+}
+
diff --git a/tcl/generic/tclObj.c b/tcl/generic/tclObj.c
index 8f0812c68dc..581c6b0aaa5 100644
--- a/tcl/generic/tclObj.c
+++ b/tcl/generic/tclObj.c
@@ -5,6 +5,7 @@
* many Tcl commands.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -21,24 +22,35 @@
static Tcl_HashTable typeTable;
static int typeTableInitialized = 0; /* 0 means not yet initialized. */
+TCL_DECLARE_MUTEX(tableMutex)
/*
- * Head of the list of free Tcl_Objs we maintain.
+ * Head of the list of free Tcl_Obj structs we maintain.
*/
Tcl_Obj *tclFreeObjList = NULL;
/*
+ * The object allocator is single threaded. This mutex is referenced
+ * by the TclNewObj macro, however, so must be visible.
+ */
+
+#ifdef TCL_THREADS
+Tcl_Mutex tclObjMutex;
+#endif
+
+/*
* Pointer to a heap-allocated string of length zero that the Tcl core uses
* as the value of an empty string representation for an object. This value
* is shared by all new objects allocated by Tcl_NewObj.
*/
-char *tclEmptyStringRep = NULL;
+static char emptyString;
+char *tclEmptyStringRep = &emptyString;
/*
- * Count of the number of Tcl objects every allocated (by Tcl_NewObj) and
- * freed (by TclFreeObj).
+ * The number of Tcl objects ever allocated (by Tcl_NewObj) and freed
+ * (by TclFreeObj).
*/
#ifdef TCL_COMPILE_STATS
@@ -50,15 +62,6 @@ long tclObjsFreed = 0;
* Prototypes for procedures defined later in this file:
*/
-static void DupBooleanInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void DupDoubleInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void DupIntInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void FinalizeTypeTable _ANSI_ARGS_((void));
-static void FinalizeFreeObjList _ANSI_ARGS_((void));
-static void InitTypeTable _ANSI_ARGS_((void));
static int SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
static int SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
@@ -79,7 +82,7 @@ static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
Tcl_ObjType tclBooleanType = {
"boolean", /* name */
(Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- DupBooleanInternalRep, /* dupIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
UpdateStringOfBoolean, /* updateStringProc */
SetBooleanFromAny /* setFromAnyProc */
};
@@ -87,7 +90,7 @@ Tcl_ObjType tclBooleanType = {
Tcl_ObjType tclDoubleType = {
"double", /* name */
(Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- DupDoubleInternalRep, /* dupIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
UpdateStringOfDouble, /* updateStringProc */
SetDoubleFromAny /* setFromAnyProc */
};
@@ -95,15 +98,15 @@ Tcl_ObjType tclDoubleType = {
Tcl_ObjType tclIntType = {
"int", /* name */
(Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- DupIntInternalRep, /* dupIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
/*
- *--------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * InitTypeTable --
+ * TclInitObjectSubsystem --
*
* This procedure is invoked to perform once-only initialization of
* the type table. It also registers the object types defined in
@@ -114,21 +117,21 @@ Tcl_ObjType tclIntType = {
*
* Side effects:
* Initializes the table of defined object types "typeTable" with
- * builtin object types defined in this file. It also initializes the
- * value of tclEmptyStringRep, which points to the heap-allocated
- * string of length zero used as the string representation for
- * newly-created objects.
+ * builtin object types defined in this file.
*
- *--------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-static void
-InitTypeTable()
+void
+TclInitObjSubsystem()
{
+ Tcl_MutexLock(&tableMutex);
typeTableInitialized = 1;
-
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
+ Tcl_MutexUnlock(&tableMutex);
+
Tcl_RegisterObjType(&tclBooleanType);
+ Tcl_RegisterObjType(&tclByteArrayType);
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(&tclIntType);
Tcl_RegisterObjType(&tclStringType);
@@ -136,86 +139,47 @@ InitTypeTable()
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclProcBodyType);
- tclEmptyStringRep = (char *) ckalloc((unsigned) 1);
- tclEmptyStringRep[0] = '\0';
+#ifdef TCL_COMPILE_STATS
+ Tcl_MutexLock(&tclObjMutex);
+ tclObjsAlloced = 0;
+ tclObjsFreed = 0;
+ Tcl_MutexUnlock(&tclObjMutex);
+#endif
}
/*
*----------------------------------------------------------------------
*
- * FinalizeTypeTable --
+ * TclFinalizeCompExecEnv --
*
- * This procedure is called by Tcl_Finalize after all exit handlers
- * have been run to free up storage associated with the table of Tcl
- * object types.
+ * This procedure is called by Tcl_Finalize to clean up the Tcl
+ * compilation and execution environment so it can later be properly
+ * reinitialized.
*
* Results:
* None.
*
* Side effects:
- * Deletes all entries in the hash table of object types, "typeTable".
- * Then sets "typeTableInitialized" to 0 so that the Tcl type system
- * will be properly reinitialized if Tcl is restarted. Also deallocates
- * the storage for tclEmptyStringRep.
+ * Cleans up the compilation and execution environment
*
*----------------------------------------------------------------------
*/
-static void
-FinalizeTypeTable()
+void
+TclFinalizeCompExecEnv()
{
+ Tcl_MutexLock(&tableMutex);
if (typeTableInitialized) {
Tcl_DeleteHashTable(&typeTable);
- ckfree(tclEmptyStringRep);
typeTableInitialized = 0;
}
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FinalizeFreeObjList --
- *
- * Resets the free object list so it can later be reinitialized.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Resets the value of tclFreeObjList.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FinalizeFreeObjList()
-{
+ Tcl_MutexUnlock(&tableMutex);
+ Tcl_MutexLock(&tclObjMutex);
tclFreeObjList = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeCompExecEnv --
- *
- * Clean up the compiler execution environment so it can later be
- * properly reinitialized.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Cleans up the execution environment
- *
- *----------------------------------------------------------------------
- */
+ Tcl_MutexUnlock(&tclObjMutex);
-void
-TclFinalizeCompExecEnv()
-{
- FinalizeTypeTable();
- FinalizeFreeObjList();
- TclFinalizeExecEnv();
+ TclFinalizeCompilation();
+ TclFinalizeExecution();
}
/*
@@ -246,14 +210,10 @@ Tcl_RegisterObjType(typePtr)
register Tcl_HashEntry *hPtr;
int new;
- if (!typeTableInitialized) {
- InitTypeTable();
- }
-
/*
* If there's already an object type with the given name, remove it.
*/
-
+ Tcl_MutexLock(&tableMutex);
hPtr = Tcl_FindHashEntry(&typeTable, typePtr->name);
if (hPtr != (Tcl_HashEntry *) NULL) {
Tcl_DeleteHashEntry(hPtr);
@@ -267,6 +227,7 @@ Tcl_RegisterObjType(typePtr)
if (new) {
Tcl_SetHashValue(hPtr, typePtr);
}
+ Tcl_MutexUnlock(&tableMutex);
}
/*
@@ -277,7 +238,7 @@ Tcl_RegisterObjType(typePtr)
* This procedure appends onto the argument object the name of each
* object type as a list element. This includes the builtin object
* types (e.g. int, list) as well as those added using
- * Tcl_CreateObjType. These names can be used, for example, with
+ * Tcl_NewObj. These names can be used, for example, with
* Tcl_GetObjType to get pointers to the corresponding Tcl_ObjType
* structures.
*
@@ -306,23 +267,22 @@ Tcl_AppendAllObjTypes(interp, objPtr)
Tcl_ObjType *typePtr;
int result;
- if (!typeTableInitialized) {
- InitTypeTable();
- }
-
/*
* This code assumes that types names do not contain embedded NULLs.
*/
+ Tcl_MutexLock(&tableMutex);
for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
result = Tcl_ListObjAppendElement(interp, objPtr,
Tcl_NewStringObj(typePtr->name, -1));
if (result == TCL_ERROR) {
+ Tcl_MutexUnlock(&tableMutex);
return result;
}
}
+ Tcl_MutexUnlock(&tableMutex);
return TCL_OK;
}
@@ -351,15 +311,14 @@ Tcl_GetObjType(typeName)
register Tcl_HashEntry *hPtr;
Tcl_ObjType *typePtr;
- if (!typeTableInitialized) {
- InitTypeTable();
- }
-
+ Tcl_MutexLock(&tableMutex);
hPtr = Tcl_FindHashEntry(&typeTable, typeName);
if (hPtr != (Tcl_HashEntry *) NULL) {
typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+ Tcl_MutexUnlock(&tableMutex);
return typePtr;
}
+ Tcl_MutexUnlock(&tableMutex);
return NULL;
}
@@ -445,9 +404,11 @@ Tcl_NewObj()
register Tcl_Obj *objPtr;
/*
- * Allocate the object using the list of free Tcl_Objs we maintain.
+ * Allocate the object using the list of free Tcl_Obj structs
+ * we maintain.
*/
+ Tcl_MutexLock(&tclObjMutex);
if (tclFreeObjList == NULL) {
TclAllocateFreeObjects();
}
@@ -461,6 +422,7 @@ Tcl_NewObj()
#ifdef TCL_COMPILE_STATS
tclObjsAlloced++;
#endif /* TCL_COMPILE_STATS */
+ Tcl_MutexUnlock(&tclObjMutex);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -505,7 +467,8 @@ Tcl_DbNewObj(file, line)
/*
* If debugging Tcl's memory usage, allocate the object using ckalloc.
- * Otherwise, allocate it using the list of free Tcl_Objs we maintain.
+ * Otherwise, allocate it using the list of free Tcl_Obj structs we
+ * maintain.
*/
objPtr = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), file, line);
@@ -514,7 +477,9 @@ Tcl_DbNewObj(file, line)
objPtr->length = 0;
objPtr->typePtr = NULL;
#ifdef TCL_COMPILE_STATS
+ Tcl_MutexLock(&tclObjMutex);
tclObjsAlloced++;
+ Tcl_MutexUnlock(&tclObjMutex);
#endif /* TCL_COMPILE_STATS */
return objPtr;
}
@@ -540,6 +505,8 @@ Tcl_DbNewObj(file, line)
* Procedure to allocate a number of free Tcl_Objs. This is done using
* a single ckalloc to reduce the overhead for Tcl_Obj allocation.
*
+ * Assumes mutex is held.
+ *
* Results:
* None.
*
@@ -615,17 +582,18 @@ TclFreeObj(objPtr)
}
#endif /* TCL_MEM_DEBUG */
- Tcl_InvalidateStringRep(objPtr);
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
typePtr->freeIntRepProc(objPtr);
}
+ Tcl_InvalidateStringRep(objPtr);
/*
* If debugging Tcl's memory usage, deallocate the object using ckfree.
* Otherwise, deallocate it by adding it onto the list of free
- * Tcl_Objs we maintain.
+ * Tcl_Obj structs we maintain.
*/
-
+
+ Tcl_MutexLock(&tclObjMutex);
#ifdef TCL_MEM_DEBUG
ckfree((char *) objPtr);
#else
@@ -633,9 +601,10 @@ TclFreeObj(objPtr)
tclFreeObjList = objPtr;
#endif /* TCL_MEM_DEBUG */
-#ifdef TCL_COMPILE_STATS
+#ifdef TCL_COMPILE_STATS
tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+#endif /* TCL_COMPILE_STATS */
+ Tcl_MutexUnlock(&tclObjMutex);
}
/*
@@ -691,7 +660,12 @@ Tcl_DuplicateObj(objPtr)
}
if (typePtr != NULL) {
- typePtr->dupIntRepProc(objPtr, dupPtr);
+ if (typePtr->dupIntRepProc == NULL) {
+ dupPtr->internalRep = objPtr->internalRep;
+ dupPtr->typePtr = typePtr;
+ } else {
+ (*typePtr->dupIntRepProc)(objPtr, dupPtr);
+ }
}
return dupPtr;
}
@@ -699,6 +673,44 @@ Tcl_DuplicateObj(objPtr)
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetString --
+ *
+ * Returns the string representation byte array pointer for an object.
+ *
+ * Results:
+ * Returns a pointer to the string representation of objPtr. The byte
+ * array referenced by the returned pointer must not be modified by the
+ * caller. Furthermore, the caller must copy the bytes if they need to
+ * retain them since the object's string rep can change as a result of
+ * other operations.
+ *
+ * Side effects:
+ * May call the object's updateStringProc to update the string
+ * representation from the internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetString(objPtr)
+ register Tcl_Obj *objPtr; /* Object whose string rep byte pointer
+ * should be returned. */
+{
+ if (objPtr->bytes != NULL) {
+ return objPtr->bytes;
+ }
+
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ panic("UpdateStringProc should not be invoked for type %s",
+ objPtr->typePtr->name);
+ }
+ (*objPtr->typePtr->updateStringProc)(objPtr);
+ return objPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetStringFromObj --
*
* Returns the string representation's byte array pointer and length
@@ -734,7 +746,11 @@ Tcl_GetStringFromObj(objPtr, lengthPtr)
return objPtr->bytes;
}
- objPtr->typePtr->updateStringProc(objPtr);
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ panic("UpdateStringProc should not be invoked for type %s",
+ objPtr->typePtr->name);
+ }
+ (*objPtr->typePtr->updateStringProc)(objPtr);
if (lengthPtr != NULL) {
*lengthPtr = objPtr->length;
}
@@ -911,13 +927,13 @@ Tcl_SetBooleanObj(objPtr, boolValue)
panic("Tcl_SetBooleanObj called with shared object");
}
- Tcl_InvalidateStringRep(objPtr);
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
oldTypePtr->freeIntRepProc(objPtr);
}
objPtr->internalRep.longValue = (boolValue? 1 : 0);
objPtr->typePtr = &tclBooleanType;
+ Tcl_InvalidateStringRep(objPtr);
}
/*
@@ -959,33 +975,6 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
/*
*----------------------------------------------------------------------
*
- * DupBooleanInternalRep --
- *
- * Initialize the internal representation of a boolean Tcl_Obj to a
- * copy of the internal representation of an existing boolean object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to the boolean (an integer)
- * corresponding to "srcPtr"s internal rep.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupBooleanInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
- copyPtr->typePtr = &tclBooleanType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetBooleanFromAny --
*
* Attempt to generate a boolean internal form for the Tcl object
@@ -1020,7 +1009,7 @@ SetBooleanFromAny(interp, objPtr)
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
/*
* Copy the string converting its characters to lower case.
@@ -1028,8 +1017,16 @@ SetBooleanFromAny(interp, objPtr)
for (i = 0; (i < 9) && (i < length); i++) {
c = string[i];
- if (isupper(UCHAR(c))) {
- c = (char) tolower(UCHAR(c));
+ /*
+ * Weed out international characters so we can safely operate
+ * on single bytes.
+ */
+
+ if (c & 0x80) {
+ goto badBoolean;
+ }
+ if (Tcl_UniCharIsUpper(UCHAR(c))) {
+ c = (char) Tcl_UniCharToLower(UCHAR(c));
}
lowerCase[i] = c;
}
@@ -1080,7 +1077,8 @@ SetBooleanFromAny(interp, objPtr)
* Make sure the string has no garbage after the end of the double.
*/
- while ((end < (string+length)) && isspace(UCHAR(*end))) {
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO only */
end++;
}
if (end != (string+length)) {
@@ -1287,13 +1285,13 @@ Tcl_SetDoubleObj(objPtr, dblValue)
panic("Tcl_SetDoubleObj called with shared object");
}
- Tcl_InvalidateStringRep(objPtr);
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
oldTypePtr->freeIntRepProc(objPtr);
}
objPtr->internalRep.doubleValue = dblValue;
objPtr->typePtr = &tclDoubleType;
+ Tcl_InvalidateStringRep(objPtr);
}
/*
@@ -1340,33 +1338,6 @@ Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
/*
*----------------------------------------------------------------------
*
- * DupDoubleInternalRep --
- *
- * Initialize the internal representation of a double Tcl_Obj to a
- * copy of the internal representation of an existing double object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to the double precision floating
- * point number corresponding to "srcPtr"s internal rep.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupDoubleInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- copyPtr->internalRep.doubleValue = srcPtr->internalRep.doubleValue;
- copyPtr->typePtr = &tclDoubleType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetDoubleFromAny --
*
* Attempt to generate an double-precision floating point internal form
@@ -1398,7 +1369,7 @@ SetDoubleFromAny(interp, objPtr)
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
/*
* Now parse "objPtr"s string as an double. Numbers can't have embedded
@@ -1435,7 +1406,8 @@ SetDoubleFromAny(interp, objPtr)
* Make sure that the string has no garbage after the end of the double.
*/
- while ((end < (string+length)) && isspace(UCHAR(*end))) {
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO space. */
end++;
}
if (end != (string+length)) {
@@ -1581,13 +1553,13 @@ Tcl_SetIntObj(objPtr, intValue)
panic("Tcl_SetIntObj called with shared object");
}
- Tcl_InvalidateStringRep(objPtr);
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
oldTypePtr->freeIntRepProc(objPtr);
}
objPtr->internalRep.longValue = (long) intValue;
objPtr->typePtr = &tclIntType;
+ Tcl_InvalidateStringRep(objPtr);
}
/*
@@ -1647,33 +1619,6 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
/*
*----------------------------------------------------------------------
*
- * DupIntInternalRep --
- *
- * Initialize the internal representation of an int Tcl_Obj to a
- * copy of the internal representation of an existing int object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to the integer corresponding to
- * "srcPtr"s internal rep.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupIntInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
- copyPtr->typePtr = &tclIntType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetIntFromAny --
*
* Attempt to generate an integer internal form for the Tcl object
@@ -1706,7 +1651,7 @@ SetIntFromAny(interp, objPtr)
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
/*
* Now parse "objPtr"s string as an int. We use an implementation here
@@ -1717,7 +1662,7 @@ SetIntFromAny(interp, objPtr)
*/
errno = 0;
- for (p = string; isspace(UCHAR(*p)); p++) {
+ for (p = string; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
/* Empty loop body. */
}
if (*p == '-') {
@@ -1741,6 +1686,7 @@ SetIntFromAny(interp, objPtr)
sprintf(buf, "expected integer but got \"%.50s\"", string);
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+ TclCheckBadOctal(interp, string);
}
return TCL_ERROR;
}
@@ -1758,7 +1704,8 @@ SetIntFromAny(interp, objPtr)
* Make sure that the string has no garbage after the end of the int.
*/
- while ((end < (string+length)) && isspace(UCHAR(*end))) {
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO space. */
end++;
}
if (end != (string+length)) {
@@ -1804,7 +1751,7 @@ static void
UpdateStringOfInt(objPtr)
register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
{
- char buffer[TCL_DOUBLE_SPACE];
+ char buffer[TCL_INTEGER_SPACE];
register int len;
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
@@ -1972,13 +1919,13 @@ Tcl_SetLongObj(objPtr, longValue)
panic("Tcl_SetLongObj called with shared object");
}
- Tcl_InvalidateStringRep(objPtr);
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
oldTypePtr->freeIntRepProc(objPtr);
}
objPtr->internalRep.longValue = longValue;
objPtr->typePtr = &tclIntType;
+ Tcl_InvalidateStringRep(objPtr);
}
/*
@@ -2044,7 +1991,8 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
void
Tcl_DbIncrRefCount(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are adding a reference to. */
+ register Tcl_Obj *objPtr; /* The object we are registering a
+ * reference to. */
char *file; /* The name of the source file calling this
* procedure; used for debugging. */
int line; /* Line number in the source file; used
@@ -2067,9 +2015,9 @@ Tcl_DbIncrRefCount(objPtr, file, line)
*
* This procedure is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. This checks to see whether or not
- * the memory has been freed before incrementing the ref count.
+ * the memory has been freed before decrementing the ref count.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just increments
+ * When TCL_MEM_DEBUG is not defined, this procedure just decrements
* the reference count of the object.
*
* Results:
@@ -2083,7 +2031,8 @@ Tcl_DbIncrRefCount(objPtr, file, line)
void
Tcl_DbDecrRefCount(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are adding a reference to. */
+ register Tcl_Obj *objPtr; /* The object we are releasing a reference
+ * to. */
char *file; /* The name of the source file calling this
* procedure; used for debugging. */
int line; /* Line number in the source file; used
@@ -2107,25 +2056,24 @@ Tcl_DbDecrRefCount(objPtr, file, line)
* Tcl_DbIsShared --
*
* This procedure is normally called when debugging: i.e., when
- * TCL_MEM_DEBUG is defined. This checks to see whether or not
- * the memory has been freed before incrementing the ref count.
+ * TCL_MEM_DEBUG is defined. It tests whether the object has a ref
+ * count greater than one.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just decrements
- * the reference count of the object and throws it away if the count
- * is 0 or less.
+ * When TCL_MEM_DEBUG is not defined, this procedure just tests
+ * if the object has a ref count greater than one.
*
* Results:
* None.
*
* Side effects:
- * The object's ref count is incremented.
+ * None.
*
*----------------------------------------------------------------------
*/
int
Tcl_DbIsShared(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are adding a reference to. */
+ register Tcl_Obj *objPtr; /* The object to test for being shared. */
char *file; /* The name of the source file calling this
* procedure; used for debugging. */
int line; /* Line number in the source file; used
diff --git a/tcl/generic/tclPanic.c b/tcl/generic/tclPanic.c
new file mode 100644
index 00000000000..4e8cc1e2365
--- /dev/null
+++ b/tcl/generic/tclPanic.c
@@ -0,0 +1,123 @@
+/*
+ * tclPanic.c --
+ *
+ * Source code for the "Tcl_Panic" library procedure for Tcl;
+ * individual applications will probably override this with
+ * an application-specific panic procedure.
+ *
+ * Copyright (c) 1988-1993 The Regents of the University of California.
+ * Copyright (c) 1994 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * The panicProc variable contains a pointer to an application
+ * specific panic procedure.
+ */
+
+void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetPanicProc --
+ *
+ * Replace the default panic behavior with the specified functiion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the panicProc variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetPanicProc(proc)
+ void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));
+{
+ panicProc = proc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PanicVA --
+ *
+ * Print an error message and kill the process.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The process dies, entering the debugger if possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_PanicVA (format, argList)
+ char *format; /* Format string, suitable for passing to
+ * fprintf. */
+ va_list argList; /* Variable argument list. */
+{
+ char *arg1, *arg2, *arg3, *arg4; /* Additional arguments (variable in
+ * number) to pass to fprintf. */
+ char *arg5, *arg6, *arg7, *arg8;
+
+ arg1 = va_arg(argList, char *);
+ arg2 = va_arg(argList, char *);
+ arg3 = va_arg(argList, char *);
+ arg4 = va_arg(argList, char *);
+ arg5 = va_arg(argList, char *);
+ arg6 = va_arg(argList, char *);
+ arg7 = va_arg(argList, char *);
+ arg8 = va_arg(argList, char *);
+
+ if (panicProc != NULL) {
+ (void) (*panicProc)(format, arg1, arg2, arg3, arg4,
+ arg5, arg6, arg7, arg8);
+ } else {
+ (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
+ arg7, arg8);
+ (void) fprintf(stderr, "\n");
+ (void) fflush(stderr);
+ abort();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * panic --
+ *
+ * Print an error message and kill the process.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The process dies, entering the debugger if possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* VARARGS ARGSUSED */
+void
+panic TCL_VARARGS_DEF(char *,arg1)
+{
+ va_list argList;
+ char *format;
+
+ format = TCL_VARARGS_START(char *,arg1,argList);
+ Tcl_PanicVA(format, argList);
+ va_end (argList);
+}
diff --git a/tcl/generic/tclParse.c b/tcl/generic/tclParse.c
index c266f19e5e9..1422cd02336 100644
--- a/tcl/generic/tclParse.c
+++ b/tcl/generic/tclParse.c
@@ -1,12 +1,15 @@
/*
* tclParse.c --
*
- * This file contains a collection of procedures that are used
- * to parse Tcl commands or parts of commands (like quoted
- * strings or nested sub-commands).
+ * This file contains procedures that parse Tcl scripts. They
+ * do so in a general-purpose fashion that can be used for many
+ * different purposes, including compilation, direct execution,
+ * code analysis, etc. This file also includes a few additional
+ * procedures such as Tcl_EvalObjv, Tcl_Eval, and Tcl_EvalEx, which
+ * allow scripts to be evaluated directly, without compiling.
*
- * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * 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.
@@ -18,710 +21,1754 @@
#include "tclPort.h"
/*
- * Function prototypes for procedures local to this file:
+ * The following table provides parsing information about each possible
+ * 8-bit character. The table is designed to be referenced with either
+ * signed or unsigned characters, so it has 384 entries. The first 128
+ * entries correspond to negative character values, the next 256 correspond
+ * to positive character values. The last 128 entries are identical to the
+ * first 128. The table is always indexed with a 128-byte offset (the 128th
+ * entry corresponds to a character value of 0).
+ *
+ * The macro CHAR_TYPE is used to index into the table and return
+ * information about its character argument. The following return
+ * values are defined.
+ *
+ * TYPE_NORMAL - All characters that don't have special significance
+ * to the Tcl parser.
+ * TYPE_SPACE - The character is a whitespace character other
+ * than newline.
+ * TYPE_COMMAND_END - Character is newline or semicolon.
+ * TYPE_SUBS - Character begins a substitution or has other
+ * special meaning in ParseTokens: backslash, dollar
+ * sign, open bracket, or null.
+ * TYPE_QUOTE - Character is a double quote.
+ * TYPE_CLOSE_PAREN - Character is a right parenthesis.
+ * TYPE_CLOSE_BRACK - Character is a right square bracket.
+ * TYPE_BRACE - Character is a curly brace (either left or right).
+ */
+
+#define TYPE_NORMAL 0
+#define TYPE_SPACE 0x1
+#define TYPE_COMMAND_END 0x2
+#define TYPE_SUBS 0x4
+#define TYPE_QUOTE 0x8
+#define TYPE_CLOSE_PAREN 0x10
+#define TYPE_CLOSE_BRACK 0x20
+#define TYPE_BRACE 0x40
+
+#define CHAR_TYPE(c) (typeTable+128)[(int)(c)]
+
+char typeTable[] = {
+ /*
+ * Negative character values, from -128 to -1:
+ */
+
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+
+ /*
+ * Positive character values, from 0-127:
+ */
+
+ TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE,
+ TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL,
+ TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS,
+ TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE,
+ TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL,
+
+ /*
+ * Large unsigned character values, from 128-255:
+ */
+
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+ TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
*/
-static char * QuoteEnd _ANSI_ARGS_((char *string, char *lastChar,
- int term));
-static char * ScriptEnd _ANSI_ARGS_((char *p, char *lastChar,
- int nested));
-static char * VarNameEnd _ANSI_ARGS_((char *string, char *lastChar));
+static int CommandComplete _ANSI_ARGS_((char *script,
+ int length));
+static int ParseTokens _ANSI_ARGS_((char *src, int mask,
+ Tcl_Parse *parsePtr));
+static int EvalObjv _ANSI_ARGS_((Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], char *command, int length,
+ int flags));
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclParseQuotes --
+ * Tcl_ParseCommand --
*
- * This procedure parses a double-quoted string such as a
- * quoted Tcl command argument or a quoted value in a Tcl
- * expression. This procedure is also used to parse array
- * element names within parentheses, or anything else that
- * needs all the substitutions that happen in quotes.
+ * Given a string, this procedure parses the first Tcl command
+ * in the string and returns information about the structure of
+ * the command.
*
* Results:
- * The return value is a standard Tcl result, which is
- * TCL_OK unless there was an error while parsing the
- * quoted string. If an error occurs then interp->result
- * contains a standard error message. *TermPtr is filled
- * in with the address of the character just after the
- * last one successfully processed; this is usually the
- * character just after the matching close-quote. The
- * fully-substituted contents of the quotes are stored in
- * standard fashion in *pvPtr, null-terminated with
- * pvPtr->next pointing to the terminating null character.
+ * The return value is TCL_OK if the command was parsed
+ * successfully and TCL_ERROR otherwise. If an error occurs
+ * and interp isn't NULL then an error message is left in
+ * its result. On a successful return, parsePtr is filled in
+ * with information about the command that was parsed.
*
* Side effects:
- * The buffer space in pvPtr may be enlarged by calling its
- * expandProc.
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the command, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
-TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* Character just after opening double-
- * quote. */
- int termChar; /* Character that terminates "quoted" string
- * (usually double-quote, but sometimes
- * right-paren or something else). */
- int flags; /* Flags to pass to nested Tcl_Eval calls. */
- char **termPtr; /* Store address of terminating character
- * here. */
- ParseValue *pvPtr; /* Information about where to place
- * fully-substituted result of parse. */
+Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting;
+ * if NULL, then no error message is
+ * provided. */
+ char *string; /* First character of string containing
+ * one or more Tcl commands. The string
+ * must be in writable memory and must
+ * have one additional byte of space at
+ * string[length] where we can
+ * temporarily store a 0 sentinel
+ * character. */
+ int numBytes; /* Total number of bytes in string. If < 0,
+ * the script consists of all bytes up to
+ * the first null character. */
+ int nested; /* Non-zero means this is a nested command:
+ * close bracket should be considered
+ * a command terminator. If zero, then close
+ * bracket has no special meaning. */
+ register Tcl_Parse *parsePtr;
+ /* Structure to fill in with information
+ * about the parsed command; any previous
+ * information in the structure is
+ * ignored. */
{
- register char *src, *dst, c;
- char *lastChar = string + strlen(string);
+ register char *src; /* Points to current character
+ * in the command. */
+ int type; /* Result returned by CHAR_TYPE(*src). */
+ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */
+ int wordIndex; /* Index of word token for current word. */
+ char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */
+ int terminators; /* CHAR_TYPE bits that indicate the end
+ * of a command. */
+ char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
+ * point to char after terminating one. */
+ int length, savedChar;
- src = string;
- dst = pvPtr->next;
+ if (numBytes < 0) {
+ numBytes = (string? strlen(string) : 0);
+ }
+ parsePtr->commentStart = NULL;
+ parsePtr->commentSize = 0;
+ parsePtr->commandStart = NULL;
+ parsePtr->commandSize = 0;
+ parsePtr->numWords = 0;
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->string = string;
+ parsePtr->end = string + numBytes;
+ parsePtr->term = parsePtr->end;
+ parsePtr->interp = interp;
+ parsePtr->incomplete = 0;
+ parsePtr->errorType = TCL_PARSE_SUCCESS;
+ if (nested != 0) {
+ terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
+ } else {
+ terminators = TYPE_COMMAND_END;
+ }
+
+ /*
+ * Temporarily overwrite the character just after the end of the
+ * string with a 0 byte. This acts as a sentinel and reduces the
+ * number of places where we have to check for the end of the
+ * input string. The original value of the byte is restored at
+ * the end of the parse.
+ */
+
+ savedChar = string[numBytes];
+ if (savedChar != 0) {
+ string[numBytes] = 0;
+ }
+
+ /*
+ * Parse any leading space and comments before the first word of the
+ * command.
+ */
+
+ src = string;
while (1) {
- if (dst == pvPtr->end) {
+ while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) {
+ src++;
+ }
+ if ((*src == '\\') && (src[1] == '\n')) {
/*
- * Target buffer space is about to run out. Make more space.
+ * Skip backslash-newline sequence: it should be treated
+ * just like white space.
*/
- pvPtr->next = dst;
- (*pvPtr->expandProc)(pvPtr, 1);
- dst = pvPtr->next;
+ if ((src + 2) == parsePtr->end) {
+ parsePtr->incomplete = 1;
+ }
+ src += 2;
+ continue;
+ }
+ if (*src != '#') {
+ break;
+ }
+ if (parsePtr->commentStart == NULL) {
+ parsePtr->commentStart = src;
}
+ while (1) {
+ if (src == parsePtr->end) {
+ if (nested) {
+ parsePtr->incomplete = nested;
+ }
+ parsePtr->commentSize = src - parsePtr->commentStart;
+ break;
+ } else if (*src == '\\') {
+ if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) {
+ parsePtr->incomplete = 1;
+ }
+ Tcl_UtfBackslash(src, &length, utfBytes);
+ src += length;
+ } else if (*src == '\n') {
+ src++;
+ parsePtr->commentSize = src - parsePtr->commentStart;
+ break;
+ } else {
+ src++;
+ }
+ }
+ }
- c = *src;
- src++;
- if (c == termChar) {
- *dst = '\0';
- pvPtr->next = dst;
- *termPtr = src;
- return TCL_OK;
- } else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
- copy:
- *dst = c;
- dst++;
- continue;
- } else if (c == '$') {
- int length;
- char *value;
+ /*
+ * The following loop parses the words of the command, one word
+ * in each iteration through the loop.
+ */
- value = Tcl_ParseVar(interp, src-1, termPtr);
- if (value == NULL) {
- return TCL_ERROR;
+ parsePtr->commandStart = src;
+ while (1) {
+ /*
+ * Create the token for the word.
+ */
+
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ wordIndex = parsePtr->numTokens;
+ tokenPtr = &parsePtr->tokenPtr[wordIndex];
+ tokenPtr->type = TCL_TOKEN_WORD;
+
+ /*
+ * Skip white space before the word. Also skip a backslash-newline
+ * sequence: it should be treated just like white space.
+ */
+
+ while (1) {
+ type = CHAR_TYPE(*src);
+ if (type == TYPE_SPACE) {
+ src++;
+ continue;
+ } else if ((*src == '\\') && (src[1] == '\n')) {
+ if ((src + 2) == parsePtr->end) {
+ parsePtr->incomplete = 1;
+ }
+ Tcl_UtfBackslash(src, &length, utfBytes);
+ src += length;
+ continue;
}
- src = *termPtr;
- length = strlen(value);
- if ((pvPtr->end - dst) <= length) {
- pvPtr->next = dst;
- (*pvPtr->expandProc)(pvPtr, length);
- dst = pvPtr->next;
+ break;
+ }
+ if ((type & terminators) != 0) {
+ parsePtr->term = src;
+ src++;
+ break;
+ }
+ if (src == parsePtr->end) {
+ break;
+ }
+ tokenPtr->start = src;
+ parsePtr->numTokens++;
+ parsePtr->numWords++;
+
+ /*
+ * At this point the word can have one of three forms: something
+ * enclosed in quotes, something enclosed in braces, or an
+ * unquoted word (anything else).
+ */
+
+ if (*src == '"') {
+ if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src),
+ parsePtr, 1, &termPtr) != TCL_OK) {
+ goto error;
}
- strcpy(dst, value);
- dst += length;
- continue;
- } else if (c == '[') {
- int result;
+ src = termPtr;
+ } else if (*src == '{') {
+ if (Tcl_ParseBraces(interp, src, (parsePtr->end - src),
+ parsePtr, 1, &termPtr) != TCL_OK) {
+ goto error;
+ }
+ src = termPtr;
+ } else {
+ /*
+ * This is an unquoted word. Call ParseTokens and let it do
+ * all of the work.
+ */
- pvPtr->next = dst;
- result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
- if (result != TCL_OK) {
- return result;
+ if (ParseTokens(src, TYPE_SPACE|terminators,
+ parsePtr) != TCL_OK) {
+ goto error;
}
- src = *termPtr;
- dst = pvPtr->next;
- continue;
- } else if (c == '\\') {
- int numRead;
+ src = parsePtr->term;
+ }
+
+ /*
+ * Finish filling in the token for the word and check for the
+ * special case of a word consisting of a single range of
+ * literal text.
+ */
+
+ tokenPtr = &parsePtr->tokenPtr[wordIndex];
+ tokenPtr->size = src - tokenPtr->start;
+ tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
+ if ((tokenPtr->numComponents == 1)
+ && (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
+ tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
+ }
+
+ /*
+ * Do two additional checks: (a) make sure we're really at the
+ * end of a word (there might have been garbage left after a
+ * quoted or braced word), and (b) check for the end of the
+ * command.
+ */
- src--;
- *dst = Tcl_Backslash(src, &numRead);
- dst++;
- src += numRead;
+ type = CHAR_TYPE(*src);
+ if (type == TYPE_SPACE) {
+ src++;
continue;
- } else if (c == '\0') {
- char buf[30];
-
- Tcl_ResetResult(interp);
- sprintf(buf, "missing %c", termChar);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- *termPtr = string-1;
- return TCL_ERROR;
} else {
- goto copy;
+ /*
+ * Backslash-newline (and any following white space) must be
+ * treated as if it were a space character.
+ */
+
+ if ((*src == '\\') && (src[1] == '\n')) {
+ if ((src + 2) == parsePtr->end) {
+ parsePtr->incomplete = 1;
+ }
+ Tcl_UtfBackslash(src, &length, utfBytes);
+ src += length;
+ continue;
+ }
+ }
+
+ if ((type & terminators) != 0) {
+ parsePtr->term = src;
+ src++;
+ break;
+ }
+ if (src == parsePtr->end) {
+ break;
+ }
+ if (src[-1] == '"') {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "extra characters after close-quote",
+ TCL_STATIC);
+ }
+ parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
+ } else {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "extra characters after close-brace",
+ TCL_STATIC);
+ }
+ parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
}
+ parsePtr->term = src;
+ goto error;
+ }
+
+
+ parsePtr->commandSize = src - parsePtr->commandStart;
+ if (savedChar != 0) {
+ string[numBytes] = (char) savedChar;
}
+ return TCL_OK;
+
+ error:
+ if (savedChar != 0) {
+ string[numBytes] = (char) savedChar;
+ }
+ Tcl_FreeParse(parsePtr);
+ if (parsePtr->commandStart == NULL) {
+ parsePtr->commandStart = string;
+ }
+ parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
+ return TCL_ERROR;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclParseNestedCmd --
+ * ParseTokens --
*
- * This procedure parses a nested Tcl command between
- * brackets, returning the result of the command.
+ * This procedure forms the heart of the Tcl parser. It parses one
+ * or more tokens from a string, up to a termination point
+ * specified by the caller. This procedure is used to parse
+ * unquoted command words (those not in quotes or braces), words in
+ * quotes, and array indices for variables.
*
* Results:
- * The return value is a standard Tcl result, which is
- * TCL_OK unless there was an error while executing the
- * nested command. If an error occurs then interp->result
- * contains a standard error message. *TermPtr is filled
- * in with the address of the character just after the
- * last one processed; this is usually the character just
- * after the matching close-bracket, or the null character
- * at the end of the string if the close-bracket was missing
- * (a missing close bracket is an error). The result returned
- * by the command is stored in standard fashion in *pvPtr,
- * null-terminated, with pvPtr->next pointing to the null
- * character.
+ * Tokens are added to parsePtr and parsePtr->term is filled in
+ * with the address of the character that terminated the parse (the
+ * first one whose CHAR_TYPE matched mask or the character at
+ * parsePtr->end). The return value is TCL_OK if the parse
+ * completed successfully and TCL_ERROR otherwise. If a parse
+ * error occurs and parsePtr->interp isn't NULL, then an error
+ * message is left in the interpreter's result.
*
* Side effects:
- * The storage space at *pvPtr may be expanded.
+ * None.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-int
-TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* Character just after opening bracket. */
- int flags; /* Flags to pass to nested Tcl_Eval. */
- char **termPtr; /* Store address of terminating character
- * here. */
- register ParseValue *pvPtr; /* Information about where to place
- * result of command. */
+static int
+ParseTokens(src, mask, parsePtr)
+ register char *src; /* First character to parse. */
+ int mask; /* Specifies when to stop parsing. The
+ * parse stops at the first unquoted
+ * character whose CHAR_TYPE contains
+ * any of the bits in mask. */
+ Tcl_Parse *parsePtr; /* Information about parse in progress.
+ * Updated with additional tokens and
+ * termination information. */
{
- int result, length, shortfall;
- Interp *iPtr = (Interp *) interp;
+ int type, originalTokens, varToken;
+ char utfBytes[TCL_UTF_MAX];
+ Tcl_Token *tokenPtr;
+ Tcl_Parse nested;
- iPtr->evalFlags = flags | TCL_BRACKET_TERM;
- result = Tcl_Eval(interp, string);
- *termPtr = (string + iPtr->termOffset);
- if (result != TCL_OK) {
- /*
- * The increment below results in slightly cleaner message in
- * the errorInfo variable (the close-bracket will appear).
- */
+ /*
+ * Each iteration through the following loop adds one token of
+ * type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
+ * TCL_TOKEN_VARIABLE to parsePtr. For TCL_TOKEN_VARIABLE tokens,
+ * additional tokens are added for the parsed variable name.
+ */
- if (**termPtr == ']') {
- *termPtr += 1;
+ originalTokens = parsePtr->numTokens;
+ while (1) {
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+
+ type = CHAR_TYPE(*src);
+ if (type & mask) {
+ break;
+ }
+
+ if ((type & TYPE_SUBS) == 0) {
+ /*
+ * This is a simple range of characters. Scan to find the end
+ * of the range.
+ */
+
+ while (1) {
+ src++;
+ if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) {
+ break;
+ }
+ }
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->size = src - tokenPtr->start;
+ parsePtr->numTokens++;
+ } else if (*src == '$') {
+ /*
+ * This is a variable reference. Call Tcl_ParseVarName to do
+ * all the dirty work of parsing the name.
+ */
+
+ varToken = parsePtr->numTokens;
+ if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src,
+ parsePtr, 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ src += parsePtr->tokenPtr[varToken].size;
+ } else if (*src == '[') {
+ /*
+ * Command substitution. Call Tcl_ParseCommand recursively
+ * (and repeatedly) to parse the nested command(s), then
+ * throw away the parse information.
+ */
+
+ src++;
+ while (1) {
+ if (Tcl_ParseCommand(parsePtr->interp, src,
+ parsePtr->end - src, 1, &nested) != TCL_OK) {
+ parsePtr->errorType = nested.errorType;
+ parsePtr->term = nested.term;
+ parsePtr->incomplete = nested.incomplete;
+ return TCL_ERROR;
+ }
+ src = nested.commandStart + nested.commandSize;
+ if (nested.tokenPtr != nested.staticTokens) {
+ ckfree((char *) nested.tokenPtr);
+ }
+ if ((*nested.term == ']') && !nested.incomplete) {
+ break;
+ }
+ if (src == parsePtr->end) {
+ if (parsePtr->interp != NULL) {
+ Tcl_SetResult(parsePtr->interp,
+ "missing close-bracket", TCL_STATIC);
+ }
+ parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
+ parsePtr->term = tokenPtr->start;
+ parsePtr->incomplete = 1;
+ return TCL_ERROR;
+ }
+ }
+ tokenPtr->type = TCL_TOKEN_COMMAND;
+ tokenPtr->size = src - tokenPtr->start;
+ parsePtr->numTokens++;
+ } else if (*src == '\\') {
+ /*
+ * Backslash substitution.
+ */
+
+ if (src[1] == '\n') {
+ if ((src + 2) == parsePtr->end) {
+ parsePtr->incomplete = 1;
+ }
+
+ /*
+ * Note: backslash-newline is special in that it is
+ * treated the same as a space character would be. This
+ * means that it could terminate the token.
+ */
+
+ if (mask & TYPE_SPACE) {
+ break;
+ }
+ }
+ tokenPtr->type = TCL_TOKEN_BS;
+ Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes);
+ parsePtr->numTokens++;
+ src += tokenPtr->size;
+ } else if (*src == 0) {
+ /*
+ * We encountered a null character. If it is the null
+ * character at the end of the string, then return.
+ * Otherwise generate a text token for the single
+ * character.
+ */
+
+ if (src == parsePtr->end) {
+ break;
+ }
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->size = 1;
+ parsePtr->numTokens++;
+ src++;
+ } else {
+ panic("ParseTokens encountered unknown character");
}
- return result;
}
- (*termPtr) += 1;
- length = strlen(iPtr->result);
- shortfall = length + 1 - (pvPtr->end - pvPtr->next);
- if (shortfall > 0) {
- (*pvPtr->expandProc)(pvPtr, shortfall);
+ if (parsePtr->numTokens == originalTokens) {
+ /*
+ * There was nothing in this range of text. Add an empty token
+ * for the empty range, so that there is always at least one
+ * token added.
+ */
+
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->size = 0;
+ parsePtr->numTokens++;
}
- strcpy(pvPtr->next, iPtr->result);
- pvPtr->next += length;
-
- Tcl_FreeResult(interp);
- iPtr->result = iPtr->resultSpace;
- iPtr->resultSpace[0] = '\0';
+ parsePtr->term = src;
return TCL_OK;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclParseBraces --
+ * Tcl_FreeParse --
*
- * This procedure scans the information between matching
- * curly braces.
+ * This procedure is invoked to free any dynamic storage that may
+ * have been allocated by a previous call to Tcl_ParseCommand.
*
* Results:
- * The return value is a standard Tcl result, which is
- * TCL_OK unless there was an error while parsing string.
- * If an error occurs then interp->result contains a
- * standard error message. *TermPtr is filled
- * in with the address of the character just after the
- * last one successfully processed; this is usually the
- * character just after the matching close-brace. The
- * information between curly braces is stored in standard
- * fashion in *pvPtr, null-terminated with pvPtr->next
- * pointing to the terminating null character.
+ * None.
*
* Side effects:
- * The storage space at *pvPtr may be expanded.
+ * If there is any dynamically allocated memory in *parsePtr,
+ * it is freed.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-int
-TclParseBraces(interp, string, termPtr, pvPtr)
- Tcl_Interp *interp; /* Interpreter to use for nested command
- * evaluations and error messages. */
- char *string; /* Character just after opening bracket. */
- char **termPtr; /* Store address of terminating character
- * here. */
- register ParseValue *pvPtr; /* Information about where to place
- * result of command. */
+void
+Tcl_FreeParse(parsePtr)
+ Tcl_Parse *parsePtr; /* Structure that was filled in by a
+ * previous call to Tcl_ParseCommand. */
{
- int level;
- register char *src, *dst, *end;
- register char c;
- char *lastChar = string + strlen(string);
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclExpandTokenArray --
+ *
+ * This procedure is invoked when the current space for tokens in
+ * a Tcl_Parse structure fills up; it allocates memory to grow the
+ * token array
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is allocated for a new larger token array; the memory
+ * for the old array is freed, if it had been dynamically allocated.
+ *
+ *----------------------------------------------------------------------
+ */
- src = string;
- dst = pvPtr->next;
- end = pvPtr->end;
- level = 1;
+void
+TclExpandTokenArray(parsePtr)
+ Tcl_Parse *parsePtr; /* Parse structure whose token space
+ * has overflowed. */
+{
+ int newCount;
+ Tcl_Token *newPtr;
+
+ newCount = parsePtr->tokensAvailable*2;
+ newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
+ memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
+ (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ }
+ parsePtr->tokenPtr = newPtr;
+ parsePtr->tokensAvailable = newCount;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EvalObjv --
+ *
+ * This procedure evaluates a Tcl command that has already been
+ * parsed into words, with one Tcl_Obj holding each word.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR. A result or error message is left in
+ * interp's result. If an error occurs, this procedure does
+ * NOT add any information to the errorInfo variable.
+ *
+ * Side effects:
+ * Depends on the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EvalObjv(interp, objc, objv, command, length, flags)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate the
+ * command. Also used for error
+ * reporting. */
+ int objc; /* Number of words in command. */
+ Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
+ * the words that make up the command. */
+ char *command; /* Points to the beginning of the string
+ * representation of the command; this
+ * is used for traces. If the string
+ * representation of the command is
+ * unknown, an empty string should be
+ * supplied. */
+ int length; /* Number of bytes in command; if -1, all
+ * characters up to the first null byte are
+ * used. */
+ int flags; /* Collection of OR-ed bits that control
+ * the evaluation of the script. Only
+ * TCL_EVAL_GLOBAL is currently
+ * supported. */
+
+{
+ Command *cmdPtr;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj **newObjv;
+ int i, code;
+ Trace *tracePtr, *nextPtr;
+ char **argv, *commandCopy;
+ CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
+ * in case TCL_EVAL_GLOBAL was set. */
+
+ Tcl_ResetResult(interp);
+ if (objc == 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * If the interpreter was deleted, return an error.
+ */
+
+ if (iPtr->flags & DELETED) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "attempt to call eval in deleted interpreter", -1);
+ Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+ "attempt to call eval in deleted interpreter",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
/*
- * Copy the characters one at a time to the result area, stopping
- * when the matching close-brace is found.
+ * Check depth of nested calls to Tcl_Eval: if this gets too large,
+ * it's probably because of an infinite loop somewhere.
*/
- while (1) {
- c = *src;
- src++;
- if (dst == end) {
- pvPtr->next = dst;
- (*pvPtr->expandProc)(pvPtr, 20);
- dst = pvPtr->next;
- end = pvPtr->end;
- }
- *dst = c;
- dst++;
- if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
+ if (iPtr->numLevels >= iPtr->maxNestingDepth) {
+ iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
+ return TCL_ERROR;
+ }
+ iPtr->numLevels++;
+
+ /*
+ * On the Mac, we will never reach the default recursion limit before
+ * blowing the stack. So we need to do a check here.
+ */
+
+ if (TclpCheckStackSpace() == 0) {
+ /*NOTREACHED*/
+ iPtr->numLevels--;
+ iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find the procedure to execute this command. If there isn't one,
+ * then see if there is a command "unknown". If so, create a new
+ * word array with "unknown" as the first word and the original
+ * command words as arguments. Then call ourselves recursively
+ * to execute it.
+ */
+
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+ if (cmdPtr == NULL) {
+ newObjv = (Tcl_Obj **) ckalloc((unsigned)
+ ((objc + 1) * sizeof (Tcl_Obj *)));
+ for (i = objc-1; i >= 0; i--) {
+ newObjv[i+1] = objv[i];
+ }
+ newObjv[0] = Tcl_NewStringObj("unknown", -1);
+ Tcl_IncrRefCount(newObjv[0]);
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
+ if (cmdPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid command name \"", Tcl_GetString(objv[0]), "\"",
+ (char *) NULL);
+ code = TCL_ERROR;
+ } else {
+ code = EvalObjv(interp, objc+1, newObjv, command, length, 0);
+ }
+ Tcl_DecrRefCount(newObjv[0]);
+ ckfree((char *) newObjv);
+ goto done;
+ }
+
+ /*
+ * Call trace procedures if needed.
+ */
+
+ argv = NULL;
+ commandCopy = command;
+
+ for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) {
+ nextPtr = tracePtr->nextPtr;
+ if (iPtr->numLevels > tracePtr->level) {
continue;
- } else if (c == '{') {
- level++;
- } else if (c == '}') {
- level--;
- if (level == 0) {
- dst--; /* Don't copy the last close brace. */
- break;
- }
- } else if (c == '\\') {
- int count;
+ }
- /*
- * Must always squish out backslash-newlines, even when in
- * braces. This is needed so that this sequence can appear
- * anywhere in a command, such as the middle of an expression.
- */
+ /*
+ * This is a bit messy because we have to emulate the old trace
+ * interface, which uses strings for everything.
+ */
- if (*src == '\n') {
- dst[-1] = Tcl_Backslash(src-1, &count);
- src += count - 1;
- } else {
- (void) Tcl_Backslash(src-1, &count);
- while (count > 1) {
- if (dst == end) {
- pvPtr->next = dst;
- (*pvPtr->expandProc)(pvPtr, 20);
- dst = pvPtr->next;
- end = pvPtr->end;
- }
- *dst = *src;
- dst++;
- src++;
- count--;
- }
+ if (argv == NULL) {
+ argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ argv[i] = Tcl_GetString(objv[i]);
+ }
+ argv[objc] = 0;
+
+ if (length < 0) {
+ length = strlen(command);
+ } else if ((size_t)length < strlen(command)) {
+ commandCopy = (char *) ckalloc((unsigned) (length + 1));
+ strncpy(commandCopy, command, (size_t) length);
+ commandCopy[length] = 0;
}
- } else if (c == '\0') {
- Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
- *termPtr = string-1;
- return TCL_ERROR;
}
+ (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
+ commandCopy, cmdPtr->proc, cmdPtr->clientData,
+ objc, argv);
+ }
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ if (commandCopy != command) {
+ ckfree((char *) commandCopy);
+ }
+
+ /*
+ * Finally, invoke the command's Tcl_ObjCmdProc.
+ */
+
+ iPtr->cmdCount++;
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ }
+ code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ iPtr->varFramePtr = savedVarFramePtr;
+ if (Tcl_AsyncReady()) {
+ code = Tcl_AsyncInvoke(interp, code);
}
- *dst = '\0';
- pvPtr->next = dst;
- *termPtr = src;
- return TCL_OK;
+ /*
+ * If the interpreter has a non-empty string result, the result
+ * object is either empty or stale because some procedure set
+ * interp->result directly. If so, move the string result to the
+ * result object, then reset the string result.
+ */
+
+ if (*(iPtr->result) != 0) {
+ (void) Tcl_GetObjResult(interp);
+ }
+
+ done:
+ iPtr->numLevels--;
+ return code;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclExpandParseValue --
+ * Tcl_EvalObjv --
*
- * This procedure is commonly used as the value of the
- * expandProc in a ParseValue. It uses malloc to allocate
- * more space for the result of a parse.
+ * This procedure evaluates a Tcl command that has already been
+ * parsed into words, with one Tcl_Obj holding each word.
*
* Results:
- * The buffer space in *pvPtr is reallocated to something
- * larger, and if pvPtr->clientData is non-zero the old
- * buffer is freed. Information is copied from the old
- * buffer to the new one.
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR. A result or error message is left in
+ * interp's result.
*
* Side effects:
- * None.
+ * Depends on the command.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
-void
-TclExpandParseValue(pvPtr, needed)
- register ParseValue *pvPtr; /* Information about buffer that
- * must be expanded. If the clientData
- * in the structure is non-zero, it
- * means that the current buffer is
- * dynamically allocated. */
- int needed; /* Minimum amount of additional space
- * to allocate. */
+int
+Tcl_EvalObjv(interp, objc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate the
+ * command. Also used for error
+ * reporting. */
+ int objc; /* Number of words in command. */
+ Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
+ * the words that make up the command. */
+ int flags; /* Collection of OR-ed bits that control
+ * the evaluation of the script. Only
+ * TCL_EVAL_GLOBAL is currently
+ * supported. */
{
- int newSpace;
- char *new;
-
- /*
- * Either double the size of the buffer or add enough new space
- * to meet the demand, whichever produces a larger new buffer.
- */
+ Interp *iPtr = (Interp *)interp;
+ Trace *tracePtr;
+ Tcl_DString cmdBuf;
+ char *cmdString = "";
+ int cmdLen = 0;
+ int code = TCL_OK;
- newSpace = (pvPtr->end - pvPtr->buffer) + 1;
- if (newSpace < needed) {
- newSpace += needed;
- } else {
- newSpace += newSpace;
+ for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
+ /*
+ * EvalObjv will increment numLevels so use "<" rather than "<="
+ */
+ if (iPtr->numLevels < tracePtr->level) {
+ int i;
+ /*
+ * The command will be needed for an execution trace or stack trace
+ * generate a command string.
+ */
+ cmdtraced:
+ Tcl_DStringInit(&cmdBuf);
+ for (i = 0; i < objc; i++) {
+ Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
+ }
+ cmdString = Tcl_DStringValue(&cmdBuf);
+ cmdLen = Tcl_DStringLength(&cmdBuf);
+ break;
+ }
}
- new = (char *) ckalloc((unsigned) newSpace);
/*
- * Copy from old buffer to new, free old buffer if needed, and
- * mark new buffer as malloc-ed.
+ * Execute the command if we have not done so already
*/
+ switch (code) {
+ case TCL_OK:
+ code = EvalObjv(interp, objc, objv, cmdString, cmdLen, flags);
+ if (code == TCL_ERROR && cmdLen == 0)
+ goto cmdtraced;
+ break;
+ case TCL_ERROR:
+ Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+ break;
+ default:
+ /*NOTREACHED*/
+ break;
+ }
- memcpy((VOID *) new, (VOID *) pvPtr->buffer,
- (size_t) (pvPtr->next - pvPtr->buffer));
- pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
- if (pvPtr->clientData != 0) {
- ckfree(pvPtr->buffer);
+ if (cmdLen != 0) {
+ Tcl_DStringFree(&cmdBuf);
}
- pvPtr->buffer = new;
- pvPtr->end = new + newSpace - 1;
- pvPtr->clientData = (ClientData) 1;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * TclWordEnd --
+ * Tcl_LogCommandInfo --
*
- * Given a pointer into a Tcl command, find the end of the next
- * word of the command.
+ * This procedure is invoked after an error occurs in an interpreter.
+ * It adds information to the "errorInfo" variable to describe the
+ * command that was being executed when the error occurred.
*
* Results:
- * The return value is a pointer to the last character that's part
- * of the word pointed to by "start". If the word doesn't end
- * properly within the string then the return value is the address
- * of the null character at the end of the string.
+ * None.
*
* Side effects:
- * None.
+ * Information about the command is added to errorInfo and the
+ * line number stored internally in the interpreter is set. If this
+ * is the first call to this procedure or Tcl_AddObjErrorInfo since
+ * an error occurred, then old information in errorInfo is
+ * deleted.
*
*----------------------------------------------------------------------
*/
-char *
-TclWordEnd(start, lastChar, nested, semiPtr)
- char *start; /* Beginning of a word of a Tcl command. */
- char *lastChar; /* Terminating character in string. */
- int nested; /* Zero means this is a top-level command.
- * One means this is a nested command (close
- * bracket is a word terminator). */
- int *semiPtr; /* Set to 1 if word ends with a command-
- * terminating semi-colon, zero otherwise.
- * If NULL then ignored. */
+void
+Tcl_LogCommandInfo(interp, script, command, length)
+ Tcl_Interp *interp; /* Interpreter in which to log information. */
+ char *script; /* First character in script containing
+ * command (must be <= command). */
+ char *command; /* First character in command that
+ * generated the error. */
+ int length; /* Number of bytes in command (-1 means
+ * use all bytes up to first null byte). */
{
+ char buffer[200];
register char *p;
- int count;
+ char *ellipsis = "";
+ Interp *iPtr = (Interp *) interp;
- if (semiPtr != NULL) {
- *semiPtr = 0;
+ if (iPtr->flags & ERR_ALREADY_LOGGED) {
+ /*
+ * Someone else has already logged error information for this
+ * command; we shouldn't add anything more.
+ */
+
+ return;
}
/*
- * Skip leading white space (backslash-newline must be treated like
- * white-space, except that it better not be the last thing in the
- * command).
+ * Compute the line number where the error occurred.
*/
- for (p = start; ; p++) {
- if (isspace(UCHAR(*p))) {
- continue;
- }
- if ((p[0] == '\\') && (p[1] == '\n')) {
- if (p+2 == lastChar) {
- return p+2;
- }
- continue;
+ iPtr->errorLine = 1;
+ for (p = script; p != command; p++) {
+ if (*p == '\n') {
+ iPtr->errorLine++;
}
- break;
}
/*
- * Handle words beginning with a double-quote or a brace.
+ * Create an error message to add to errorInfo, including up to a
+ * maximum number of characters of the command.
*/
- if (*p == '"') {
- p = QuoteEnd(p+1, lastChar, '"');
- if (p == lastChar) {
- return p;
- }
- p++;
- } else if (*p == '{') {
- int braces = 1;
- while (braces != 0) {
- p++;
- while (*p == '\\') {
- (void) Tcl_Backslash(p, &count);
- p += count;
- }
- if (*p == '}') {
- braces--;
- } else if (*p == '{') {
- braces++;
- } else if (p == lastChar) {
- return p;
- }
- }
- p++;
+ if (length < 0) {
+ length = strlen(command);
+ }
+ if (length > 150) {
+ length = 150;
+ ellipsis = "...";
}
+ if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+ sprintf(buffer, "\n while executing\n\"%.*s%s\"",
+ length, command, ellipsis);
+ } else {
+ sprintf(buffer, "\n invoked from within\n\"%.*s%s\"",
+ length, command, ellipsis);
+ }
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ iPtr->flags &= ~ERR_ALREADY_LOGGED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalTokens --
+ *
+ * Given an array of tokens parsed from a Tcl command (e.g., the
+ * tokens that make up a word or the index for an array variable)
+ * this procedure evaluates the tokens and concatenates their
+ * values to form a single result value.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated Tcl_Obj
+ * containing the value of the array of tokens. The reference
+ * count of the returned object has been incremented. If an error
+ * occurs in evaluating the tokens then a NULL value is returned
+ * and an error message is left in interp's result.
+ *
+ * Side effects:
+ * A new object is allocated to hold the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_EvalTokens(interp, tokenPtr, count)
+ Tcl_Interp *interp; /* Interpreter in which to lookup
+ * variables, execute nested commands,
+ * and report errors. */
+ Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
+ * to evaluate and concatenate. */
+ int count; /* Number of tokens to consider at tokenPtr.
+ * Must be at least 1. */
+{
+ Tcl_Obj *resultPtr, *indexPtr, *valuePtr, *newPtr;
+ char buffer[TCL_UTF_MAX];
+#ifdef TCL_MEM_DEBUG
+# define MAX_VAR_CHARS 5
+#else
+# define MAX_VAR_CHARS 30
+#endif
+ char nameBuffer[MAX_VAR_CHARS+1];
+ char *varName, *index;
+ char *p = NULL; /* Initialized to avoid compiler warning. */
+ int length, code;
/*
- * Handle words that don't start with a brace or double-quote.
- * This code is also invoked if the word starts with a brace or
- * double-quote and there is garbage after the closing brace or
- * quote. This is an error as far as Tcl_Eval is concerned, but
- * for here the garbage is treated as part of the word.
+ * The only tricky thing about this procedure is that it attempts to
+ * avoid object creation and string copying whenever possible. For
+ * example, if the value is just a nested command, then use the
+ * command's result object directly.
*/
- while (1) {
- if (*p == '[') {
- p = ScriptEnd(p+1, lastChar, 1);
- if (p == lastChar) {
- return p;
- }
- p++;
- } else if (*p == '\\') {
- if (p[1] == '\n') {
- /*
- * Backslash-newline: it maps to a space character
- * that is a word separator, so the word ends just before
- * the backslash.
- */
+ resultPtr = NULL;
+ for ( ; count > 0; count--, tokenPtr++) {
+ valuePtr = NULL;
- return p-1;
- }
- (void) Tcl_Backslash(p, &count);
- p += count;
- } else if (*p == '$') {
- p = VarNameEnd(p, lastChar);
- if (p == lastChar) {
- return p;
- }
- p++;
- } else if (*p == ';') {
- /*
- * Include the semi-colon in the word that is returned.
- */
+ /*
+ * The switch statement below computes the next value to be
+ * concat to the result, as either a range of text or an
+ * object.
+ */
+
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_TEXT:
+ p = tokenPtr->start;
+ length = tokenPtr->size;
+ break;
+
+ case TCL_TOKEN_BS:
+ length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
+ buffer);
+ p = buffer;
+ break;
+
+ case TCL_TOKEN_COMMAND:
+ code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
+ 0);
+ if (code != TCL_OK) {
+ goto error;
+ }
+ valuePtr = Tcl_GetObjResult(interp);
+ break;
+
+ case TCL_TOKEN_VARIABLE:
+ if (tokenPtr->numComponents == 1) {
+ indexPtr = NULL;
+ } else {
+ indexPtr = Tcl_EvalTokens(interp, tokenPtr+2,
+ tokenPtr->numComponents - 1);
+ if (indexPtr == NULL) {
+ goto error;
+ }
+ }
- if (semiPtr != NULL) {
- *semiPtr = 1;
- }
- return p;
- } else if (isspace(UCHAR(*p))) {
- return p-1;
- } else if ((*p == ']') && nested) {
- return p-1;
- } else if (p == lastChar) {
- if (nested) {
/*
- * Nested commands can't end because of the end of the
- * string.
+ * We have to make a copy of the variable name in order
+ * to have a null-terminated string. We can't make a
+ * temporary modification to the script to null-terminate
+ * the name, because a trace callback might potentially
+ * reuse the script and be affected by the null character.
*/
- return p;
+
+ if (tokenPtr[1].size <= MAX_VAR_CHARS) {
+ varName = nameBuffer;
+ } else {
+ varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
+ }
+ strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
+ varName[tokenPtr[1].size] = 0;
+ if (indexPtr != NULL) {
+ index = TclGetString(indexPtr);
+ } else {
+ index = NULL;
+ }
+ valuePtr = Tcl_GetVar2Ex(interp, varName, index,
+ TCL_LEAVE_ERR_MSG);
+ if (varName != nameBuffer) {
+ ckfree(varName);
+ }
+ if (indexPtr != NULL) {
+ Tcl_DecrRefCount(indexPtr);
+ }
+ if (valuePtr == NULL) {
+ goto error;
+ }
+ count -= tokenPtr->numComponents;
+ tokenPtr += tokenPtr->numComponents;
+ break;
+
+ default:
+ panic("unexpected token type in Tcl_EvalTokens");
+ }
+
+ /*
+ * If valuePtr isn't NULL, the next piece of text comes from that
+ * object; otherwise, take length bytes starting at p.
+ */
+
+ if (resultPtr == NULL) {
+ if (valuePtr != NULL) {
+ resultPtr = valuePtr;
+ } else {
+ resultPtr = Tcl_NewStringObj(p, length);
}
- return p-1;
+ Tcl_IncrRefCount(resultPtr);
} else {
- p++;
+ if (Tcl_IsShared(resultPtr)) {
+ newPtr = Tcl_DuplicateObj(resultPtr);
+ Tcl_DecrRefCount(resultPtr);
+ resultPtr = newPtr;
+ Tcl_IncrRefCount(resultPtr);
+ }
+ if (valuePtr != NULL) {
+ p = Tcl_GetStringFromObj(valuePtr, &length);
+ }
+ Tcl_AppendToObj(resultPtr, p, length);
}
}
+ return resultPtr;
+
+ error:
+ if (resultPtr != NULL) {
+ Tcl_DecrRefCount(resultPtr);
+ }
+ return NULL;
}
/*
*----------------------------------------------------------------------
*
- * QuoteEnd --
+ * Tcl_EvalEx --
*
- * Given a pointer to a string that obeys the parsing conventions
- * for quoted things in Tcl, find the end of that quoted thing.
- * The actual thing may be a quoted argument or a parenthesized
- * index name.
+ * This procedure evaluates a Tcl script without using the compiler
+ * or byte-code interpreter. It just parses the script, creates
+ * values for each word of each command, then calls EvalObjv
+ * to execute each command.
*
* Results:
- * The return value is a pointer to the last character that is
- * part of the quoted string (i.e the character that's equal to
- * term). If the quoted string doesn't terminate properly then
- * the return value is a pointer to the null character at the
- * end of the string.
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR. A result or error message is left in
+ * interp's result.
*
* Side effects:
- * None.
+ * Depends on the script.
*
*----------------------------------------------------------------------
*/
-static char *
-QuoteEnd(string, lastChar, term)
- char *string; /* Pointer to character just after opening
- * "quote". */
- char *lastChar; /* Terminating character in string. */
- int term; /* This character will terminate the
- * quoted string (e.g. '"' or ')'). */
+int
+Tcl_EvalEx(interp, script, numBytes, flags)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate the
+ * script. Also used for error reporting. */
+ char *script; /* First character of script to evaluate. */
+ int numBytes; /* Number of bytes in script. If < 0, the
+ * script consists of all bytes up to the
+ * first null character. */
+ int flags; /* Collection of OR-ed bits that control
+ * the evaluation of the script. Only
+ * TCL_EVAL_GLOBAL is currently
+ * supported. */
{
- register char *p = string;
- int count;
-
- while (*p != term) {
- if (*p == '\\') {
- (void) Tcl_Backslash(p, &count);
- p += count;
- } else if (*p == '[') {
- for (p++; *p != ']'; p++) {
- p = TclWordEnd(p, lastChar, 1, (int *) NULL);
- if (*p == 0) {
- return p;
+ Interp *iPtr = (Interp *) interp;
+ char *p, *next;
+ Tcl_Parse parse;
+#define NUM_STATIC_OBJS 20
+ Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
+ Tcl_Token *tokenPtr;
+ int i, code, commandLength, bytesLeft, nested;
+ CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
+ * in case TCL_EVAL_GLOBAL was set. */
+
+ /*
+ * The variables below keep track of how much state has been
+ * allocated while evaluating the script, so that it can be freed
+ * properly if an error occurs.
+ */
+
+ int gotParse = 0, objectsUsed = 0;
+
+ if (numBytes < 0) {
+ numBytes = strlen(script);
+ }
+ Tcl_ResetResult(interp);
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ }
+
+ /*
+ * Each iteration through the following loop parses the next
+ * command from the script and then executes it.
+ */
+
+ objv = staticObjArray;
+ p = script;
+ bytesLeft = numBytes;
+ if (iPtr->evalFlags & TCL_BRACKET_TERM) {
+ nested = 1;
+ } else {
+ nested = 0;
+ }
+ iPtr->evalFlags = 0;
+ do {
+ if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto error;
+ }
+ gotParse = 1;
+ if (parse.numWords > 0) {
+ /*
+ * Generate an array of objects for the words of the command.
+ */
+
+ if (parse.numWords <= NUM_STATIC_OBJS) {
+ objv = staticObjArray;
+ } else {
+ objv = (Tcl_Obj **) ckalloc((unsigned)
+ (parse.numWords * sizeof (Tcl_Obj *)));
+ }
+ for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
+ objectsUsed < parse.numWords;
+ objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1,
+ tokenPtr->numComponents);
+ if (objv[objectsUsed] == NULL) {
+ code = TCL_ERROR;
+ goto error;
}
}
- p++;
- } else if (*p == '$') {
- p = VarNameEnd(p, lastChar);
- if (*p == 0) {
- return p;
+
+ /*
+ * Execute the command and free the objects for its words.
+ */
+
+ code = EvalObjv(interp, objectsUsed, objv, p, bytesLeft, 0);
+ if (code != TCL_OK) {
+ goto error;
}
- p++;
- } else if (p == lastChar) {
- return p;
- } else {
- p++;
+ for (i = 0; i < objectsUsed; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ objectsUsed = 0;
+ if (objv != staticObjArray) {
+ ckfree((char *) objv);
+ objv = staticObjArray;
+ }
+ }
+
+ /*
+ * Advance to the next command in the script.
+ */
+
+ next = parse.commandStart + parse.commandSize;
+ bytesLeft -= next - p;
+ p = next;
+ Tcl_FreeParse(&parse);
+ gotParse = 0;
+ if ((nested != 0) && (p > script) && (p[-1] == ']')) {
+ /*
+ * We get here in the special case where the TCL_BRACKET_TERM
+ * flag was set in the interpreter and we reached a close
+ * bracket in the script. Return immediately.
+ */
+
+ iPtr->termOffset = (p - 1) - script;
+ iPtr->varFramePtr = savedVarFramePtr;
+ return TCL_OK;
+ }
+ } while (bytesLeft > 0);
+ iPtr->termOffset = p - script;
+ iPtr->varFramePtr = savedVarFramePtr;
+ return TCL_OK;
+
+ error:
+ /*
+ * Generate various pieces of error information, such as the line
+ * number where the error occurred and information to add to the
+ * errorInfo variable. Then free resources that had been allocated
+ * to the command.
+ */
+
+ if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ commandLength = parse.commandSize;
+ if ((parse.commandStart + commandLength) != (script + numBytes)) {
+ /*
+ * The command where the error occurred didn't end at the end
+ * of the script (i.e. it ended at a terminator character such
+ * as ";". Reduce the length by one so that the error message
+ * doesn't include the terminator character.
+ */
+
+ commandLength -= 1;
}
+ Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
+ }
+
+ for (i = 0; i < objectsUsed; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ if (gotParse) {
+ p = parse.commandStart + parse.commandSize;
+ Tcl_FreeParse(&parse);
+ if ((nested != 0) && (p > script) && (p[-1] == ']')) {
+ /*
+ * We get here in the special case where the TCL_BRACKET_TERM
+ * flag was set in the interpreter and we reached a close
+ * bracket in the script. Return immediately.
+ */
+
+ iPtr->termOffset = (p - 1) - script;
+ } else {
+ iPtr->termOffset = p - script;
+ }
+ }
+ if (objv != staticObjArray) {
+ ckfree((char *) objv);
}
- return p-1;
+ iPtr->varFramePtr = savedVarFramePtr;
+ return code;
}
/*
*----------------------------------------------------------------------
*
- * VarNameEnd --
+ * Tcl_Eval --
*
- * Given a pointer to a variable reference using $-notation, find
- * the end of the variable name spec.
+ * Execute a Tcl command in a string. This procedure executes the
+ * script directly, rather than compiling it to bytecodes. Before
+ * the arrival of the bytecode compiler in Tcl 8.0 Tcl_Eval was
+ * the main procedure used for executing Tcl commands, but nowadays
+ * it isn't used much.
*
* Results:
- * The return value is a pointer to the last character that
- * is part of the variable name. If the variable name doesn't
- * terminate properly then the return value is a pointer to the
- * null character at the end of the string.
+ * The return value is one of the return codes defined in tcl.h
+ * (such as TCL_OK), and interp's result contains a value
+ * to supplement the return code. The value of the result
+ * will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
+ * you must copy it or lose it!
*
* Side effects:
- * None.
+ * Can be almost arbitrary, depending on the commands in the script.
*
*----------------------------------------------------------------------
*/
-static char *
-VarNameEnd(string, lastChar)
- char *string; /* Pointer to dollar-sign character. */
- char *lastChar; /* Terminating character in string. */
+int
+Tcl_Eval(interp, string)
+ Tcl_Interp *interp; /* Token for command interpreter (returned
+ * by previous call to Tcl_CreateInterp). */
+ char *string; /* Pointer to TCL command to execute. */
{
- register char *p = string+1;
+ int code;
- if (*p == '{') {
- for (p++; (*p != '}') && (p != lastChar); p++) {
- /* Empty loop body. */
- }
- return p;
- }
- while (isalnum(UCHAR(*p)) || (*p == '_')) {
- p++;
- }
- if ((*p == '(') && (p != string+1)) {
- return QuoteEnd(p+1, lastChar, ')');
- }
- return p-1;
+ code = Tcl_EvalEx(interp, string, -1, 0);
+
+ /*
+ * For backwards compatibility with old C code that predates the
+ * object system in Tcl 8.0, we have to mirror the object result
+ * back into the string result (some callers may expect it there).
+ */
+
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+ TCL_VOLATILE);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObj, Tcl_GlobalEvalObj --
+ *
+ * These functions are deprecated but we keep them around for backwards
+ * compatibility reasons.
+ *
+ * Results:
+ * See the functions they call.
+ *
+ * Side effects:
+ * See the functions they call.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_EvalObj
+int
+Tcl_EvalObj(interp, objPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+{
+ return Tcl_EvalObjEx(interp, objPtr, 0);
}
+#undef Tcl_GlobalEvalObj
+int
+Tcl_GlobalEvalObj(interp, objPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+{
+ return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
+}
/*
*----------------------------------------------------------------------
*
- * ScriptEnd --
+ * Tcl_ParseVarName --
*
- * Given a pointer to the beginning of a Tcl script, find the end of
- * the script.
+ * Given a string starting with a $ sign, parse off a variable
+ * name and return information about the parse.
*
* Results:
- * The return value is a pointer to the last character that's part
- * of the script pointed to by "p". If the command doesn't end
- * properly within the string then the return value is the address
- * of the null character at the end of the string.
+ * The return value is TCL_OK if the command was parsed
+ * successfully and TCL_ERROR otherwise. If an error occurs and
+ * interp isn't NULL then an error message is left in its result.
+ * On a successful return, tokenPtr and numTokens fields of
+ * parsePtr are filled in with information about the variable name
+ * that was parsed. The "size" field of the first new token gives
+ * the total number of bytes in the variable name. Other fields in
+ * parsePtr are undefined.
*
* Side effects:
- * None.
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the command, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
*
*----------------------------------------------------------------------
*/
-static char *
-ScriptEnd(p, lastChar, nested)
- char *p; /* Script to check. */
- char *lastChar; /* Terminating character in string. */
- int nested; /* Zero means this is a top-level command.
- * One means this is a nested command (the
- * last character of the script must be
- * an unquoted ]). */
+int
+Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting;
+ * if NULL, then no error message is
+ * provided. */
+ char *string; /* String containing variable name. First
+ * character must be "$". */
+ int numBytes; /* Total number of bytes in string. If < 0,
+ * the string consists of all bytes up to the
+ * first null character. */
+ Tcl_Parse *parsePtr; /* Structure to fill in with information
+ * about the variable name. */
+ int append; /* Non-zero means append tokens to existing
+ * information in parsePtr; zero means ignore
+ * existing tokens in parsePtr and reinitialize
+ * it. */
{
- int commentOK = 1;
- int length;
+ Tcl_Token *tokenPtr;
+ char *end, *src;
+ unsigned char c;
+ int varIndex, offset;
+ Tcl_UniChar ch;
+ unsigned array;
- while (1) {
- while (isspace(UCHAR(*p))) {
- if (*p == '\n') {
- commentOK = 1;
- }
- p++;
- }
- if ((*p == '#') && commentOK) {
- do {
- if (*p == '\\') {
- /*
- * If the script ends with backslash-newline, then
- * this command isn't complete.
- */
-
- if ((p[1] == '\n') && (p+2 == lastChar)) {
- return p+2;
- }
- Tcl_Backslash(p, &length);
- p += length;
- } else {
- p++;
+ if (numBytes >= 0) {
+ end = string + numBytes;
+ } else {
+ end = string + strlen(string);
+ }
+
+ if (!append) {
+ parsePtr->numWords = 0;
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->string = string;
+ parsePtr->end = end;
+ parsePtr->interp = interp;
+ parsePtr->errorType = TCL_PARSE_SUCCESS;
+ parsePtr->incomplete = 0;
+ }
+
+ /*
+ * Generate one token for the variable, an additional token for the
+ * name, plus any number of additional tokens for the index, if
+ * there is one.
+ */
+
+ src = string;
+ if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_VARIABLE;
+ tokenPtr->start = src;
+ varIndex = parsePtr->numTokens;
+ parsePtr->numTokens++;
+ tokenPtr++;
+ src++;
+ if (src >= end) {
+ goto justADollarSign;
+ }
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+
+ /*
+ * The name of the variable can have three forms:
+ * 1. The $ sign is followed by an open curly brace. Then
+ * the variable name is everything up to the next close
+ * curly brace, and the variable is a scalar variable.
+ * 2. The $ sign is not followed by an open curly brace. Then
+ * the variable name is everything up to the next
+ * character that isn't a letter, digit, or underscore.
+ * :: sequences are also considered part of the variable
+ * name, in order to support namespaces. If the following
+ * character is an open parenthesis, then the information
+ * between parentheses is the array element name.
+ * 3. The $ sign is followed by something that isn't a letter,
+ * digit, or underscore: in this case, there is no variable
+ * name and the token is just "$".
+ */
+
+ if (*src == '{') {
+ src++;
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ while (1) {
+ if (src == end) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp,
+ "missing close-brace for variable name",
+ TCL_STATIC);
}
- } while ((p != lastChar) && (*p != '\n'));
- continue;
+ parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
+ parsePtr->term = tokenPtr->start-1;
+ parsePtr->incomplete = 1;
+ goto error;
+ }
+ if (*src == '}') {
+ break;
+ }
+ src++;
}
- p = TclWordEnd(p, lastChar, nested, &commentOK);
- if (p == lastChar) {
- return p;
+ tokenPtr->size = src - tokenPtr->start;
+ tokenPtr[-1].size = src - tokenPtr[-1].start;
+ parsePtr->numTokens++;
+ src++;
+ } else {
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ while (src != end) {
+ offset = Tcl_UtfToUniChar(src, &ch);
+ c = UCHAR(ch);
+ if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
+ src += offset;
+ continue;
+ }
+ if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) {
+ src += 2;
+ while ((src != end) && (*src == ':')) {
+ src += 1;
+ }
+ continue;
+ }
+ break;
+ }
+
+ /*
+ * Support for empty array names here.
+ */
+ array = ((src != end) && (*src == '('));
+ tokenPtr->size = src - tokenPtr->start;
+ if (tokenPtr->size == 0 && !array) {
+ goto justADollarSign;
}
- p++;
- if (nested) {
- if (*p == ']') {
- return p;
+ parsePtr->numTokens++;
+ if (array) {
+ /*
+ * This is a reference to an array element. Call
+ * ParseTokens recursively to parse the element name,
+ * since it could contain any number of substitutions.
+ */
+
+ if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr)
+ != TCL_OK) {
+ goto error;
}
- } else {
- if (p == lastChar) {
- return p-1;
+ if ((parsePtr->term == end) || (*parsePtr->term != ')')) {
+ if (parsePtr->interp != NULL) {
+ Tcl_SetResult(parsePtr->interp, "missing )",
+ TCL_STATIC);
+ }
+ parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
+ parsePtr->term = src;
+ parsePtr->incomplete = 1;
+ goto error;
}
+ src = parsePtr->term + 1;
}
}
+ tokenPtr = &parsePtr->tokenPtr[varIndex];
+ tokenPtr->size = src - tokenPtr->start;
+ tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1);
+ return TCL_OK;
+
+ /*
+ * The dollar sign isn't followed by a variable name.
+ * replace the TCL_TOKEN_VARIABLE token with a
+ * TCL_TOKEN_TEXT token for the dollar sign.
+ */
+
+ justADollarSign:
+ tokenPtr = &parsePtr->tokenPtr[varIndex];
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->size = 1;
+ tokenPtr->numComponents = 0;
+ return TCL_OK;
+
+ error:
+ Tcl_FreeParse(parsePtr);
+ return TCL_ERROR;
}
/*
@@ -738,7 +1785,7 @@ ScriptEnd(p, lastChar, nested)
* *termPtr gets filled in with the address of the character
* just after the last one in the variable specifier. If the
* variable doesn't exist, then the return value is NULL and
- * an error message will be left in interp->result.
+ * an error message will be left in interp's result.
*
* Side effects:
* None.
@@ -756,119 +1803,384 @@ Tcl_ParseVar(interp, string, termPtr)
* one in the variable specifier. */
{
- char *name1, *name1End, c, *result;
- register char *name2;
-#define NUM_CHARS 200
- char copyStorage[NUM_CHARS];
- ParseValue pv;
+ Tcl_Parse parse;
+ register Tcl_Obj *objPtr;
+
+ if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
+ return NULL;
+ }
+
+ if (termPtr != NULL) {
+ *termPtr = string + parse.tokenPtr->size;
+ }
+ if (parse.numTokens == 1) {
+ /*
+ * There isn't a variable name after all: the $ is just a $.
+ */
+
+ return "$";
+ }
+
+ objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens);
+ if (objPtr == NULL) {
+ return NULL;
+ }
/*
- * There are three cases:
- * 1. The $ sign is followed by an open curly brace. Then the variable
- * name is everything up to the next close curly brace, and the
- * variable is a scalar variable.
- * 2. The $ sign is not followed by an open curly brace. Then the
- * variable name is everything up to the next character that isn't
- * a letter, digit, or underscore, or a "::" namespace separator.
- * If the following character is an open parenthesis, then the
- * information between parentheses is the array element name, which
- * can include any of the substitutions permissible between quotes.
- * 3. The $ sign is followed by something that isn't a letter, digit,
- * underscore, or a "::" namespace separator: in this case,
- * there is no variable name, and "$" is returned.
+ * At this point we should have an object containing the value of
+ * a variable. Just return the string from that object.
*/
- name2 = NULL;
- string++;
- if (*string == '{') {
- string++;
- name1 = string;
- while (*string != '}') {
- if (*string == 0) {
- Tcl_SetResult(interp, "missing close-brace for variable name",
- TCL_STATIC);
- if (termPtr != 0) {
- *termPtr = string;
- }
- return NULL;
- }
- string++;
- }
- name1End = string;
- string++;
+#ifdef TCL_COMPILE_DEBUG
+ if (objPtr->refCount < 2) {
+ panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens");
+ }
+#endif /*TCL_COMPILE_DEBUG*/
+ TclDecrRefCount(objPtr);
+ return TclGetString(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseBraces --
+ *
+ * Given a string in braces such as a Tcl command argument or a string
+ * value in a Tcl expression, this procedure parses the string and
+ * returns information about the parse.
+ *
+ * Results:
+ * The return value is TCL_OK if the string was parsed successfully and
+ * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
+ * an error message is left in its result. On a successful return,
+ * tokenPtr and numTokens fields of parsePtr are filled in with
+ * information about the string that was parsed. Other fields in
+ * parsePtr are undefined. termPtr is set to point to the character
+ * just after the last one in the braced string.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the command, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting;
+ * if NULL, then no error message is
+ * provided. */
+ char *string; /* String containing the string in braces.
+ * The first character must be '{'. */
+ int numBytes; /* Total number of bytes in string. If < 0,
+ * the string consists of all bytes up to
+ * the first null character. */
+ register Tcl_Parse *parsePtr;
+ /* Structure to fill in with information
+ * about the string. */
+ int append; /* Non-zero means append tokens to existing
+ * information in parsePtr; zero means
+ * ignore existing tokens in parsePtr and
+ * reinitialize it. */
+ char **termPtr; /* If non-NULL, points to word in which to
+ * store a pointer to the character just
+ * after the terminating '}' if the parse
+ * was successful. */
+
+{
+ char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */
+ Tcl_Token *tokenPtr;
+ register char *src, *end;
+ int startIndex, level, length;
+
+ if ((numBytes >= 0) || (string == NULL)) {
+ end = string + numBytes;
} else {
- name1 = string;
- while (isalnum(UCHAR(*string)) || (*string == '_')
- || (*string == ':')) {
- if (*string == ':') {
- if (*(string+1) == ':') {
- string += 2; /* skip over the initial :: */
- while (*string == ':') {
- string++; /* skip over a subsequent : */
- }
- } else {
- break; /* : by itself */
- }
- } else {
- string++;
- }
+ end = string + strlen(string);
+ }
+
+ if (!append) {
+ parsePtr->numWords = 0;
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->string = string;
+ parsePtr->end = end;
+ parsePtr->interp = interp;
+ parsePtr->errorType = TCL_PARSE_SUCCESS;
+ }
+
+ src = string+1;
+ startIndex = parsePtr->numTokens;
+
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[startIndex];
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ level = 1;
+ while (1) {
+ while (CHAR_TYPE(*src) == TYPE_NORMAL) {
+ src++;
}
- if (string == name1) {
- if (termPtr != 0) {
- *termPtr = string;
+ if (*src == '}') {
+ level--;
+ if (level == 0) {
+ break;
}
- return "$";
- }
- name1End = string;
- if (*string == '(') {
- char *end;
+ src++;
+ } else if (*src == '{') {
+ level++;
+ src++;
+ } else if (*src == '\\') {
+ Tcl_UtfBackslash(src, &length, utfBytes);
+ if (src[1] == '\n') {
+ /*
+ * A backslash-newline sequence must be collapsed, even
+ * inside braces, so we have to split the word into
+ * multiple tokens so that the backslash-newline can be
+ * represented explicitly.
+ */
+
+ if ((src + 2) == end) {
+ parsePtr->incomplete = 1;
+ }
+ tokenPtr->size = (src - tokenPtr->start);
+ if (tokenPtr->size != 0) {
+ parsePtr->numTokens++;
+ }
+ if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_BS;
+ tokenPtr->start = src;
+ tokenPtr->size = length;
+ tokenPtr->numComponents = 0;
+ parsePtr->numTokens++;
+
+ src += length;
+ tokenPtr++;
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ } else {
+ src += length;
+ }
+ } else if (src == end) {
+ int openBrace;
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
+ }
/*
- * Perform substitutions on the array element name, just as
- * is done for quotes.
+ * Search the source string for a possible open
+ * brace within the context of a comment. Since we
+ * aren't performing a full Tcl parse, just look for
+ * an open brace preceeded by a '<whitspace>#' on
+ * the same line.
*/
-
- pv.buffer = pv.next = copyStorage;
- pv.end = copyStorage + NUM_CHARS - 1;
- pv.expandProc = TclExpandParseValue;
- pv.clientData = (ClientData) NULL;
- if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
- != TCL_OK) {
- char msg[200];
- int length;
-
- length = string-name1;
- if (length > 100) {
- length = 100;
+ openBrace = 0;
+ while (src > string ) {
+ switch (*src) {
+ case '{':
+ openBrace = 1;
+ break;
+ case '\n':
+ openBrace = 0;
+ break;
+ case '#':
+ if ((openBrace == 1) && (isspace(UCHAR(src[-1])))) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp,
+ ": possible unbalanced brace in comment",
+ (char *) NULL);
+ }
+ openBrace = -1;
+ break;
+ }
+ break;
}
- sprintf(msg, "\n (parsing index for array \"%.*s\")",
- length, name1);
- Tcl_AddErrorInfo(interp, msg);
- result = NULL;
- name2 = pv.buffer;
- if (termPtr != 0) {
- *termPtr = end;
+ if (openBrace == -1) {
+ break;
}
- goto done;
+ src--;
}
- Tcl_ResetResult(interp);
- string = end;
- name2 = pv.buffer;
+ parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
+ parsePtr->term = string;
+ parsePtr->incomplete = 1;
+ goto error;
+ } else {
+ src++;
}
}
- if (termPtr != 0) {
- *termPtr = string;
+
+ /*
+ * Decide if we need to finish emitting a partially-finished token.
+ * There are 3 cases:
+ * {abc \newline xyz} or {xyz} - finish emitting "xyz" token
+ * {abc \newline} - don't emit token after \newline
+ * {} - finish emitting zero-sized token
+ * The last case ensures that there is a token (even if empty) that
+ * describes the braced string.
+ */
+
+ if ((src != tokenPtr->start)
+ || (parsePtr->numTokens == startIndex)) {
+ tokenPtr->size = (src - tokenPtr->start);
+ parsePtr->numTokens++;
}
+ if (termPtr != NULL) {
+ *termPtr = src+1;
+ }
+ return TCL_OK;
- c = *name1End;
- *name1End = 0;
- result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
- *name1End = c;
+ error:
+ Tcl_FreeParse(parsePtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseQuotedString --
+ *
+ * Given a double-quoted string such as a quoted Tcl command argument
+ * or a quoted value in a Tcl expression, this procedure parses the
+ * string and returns information about the parse.
+ *
+ * Results:
+ * The return value is TCL_OK if the string was parsed successfully and
+ * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
+ * an error message is left in its result. On a successful return,
+ * tokenPtr and numTokens fields of parsePtr are filled in with
+ * information about the string that was parsed. Other fields in
+ * parsePtr are undefined. termPtr is set to point to the character
+ * just after the quoted string's terminating close-quote.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the command, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
+ *
+ *----------------------------------------------------------------------
+ */
- done:
- if ((name2 != NULL) && (pv.buffer != copyStorage)) {
- ckfree(pv.buffer);
+int
+Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting;
+ * if NULL, then no error message is
+ * provided. */
+ char *string; /* String containing the quoted string.
+ * The first character must be '"'. */
+ int numBytes; /* Total number of bytes in string. If < 0,
+ * the string consists of all bytes up to
+ * the first null character. */
+ register Tcl_Parse *parsePtr;
+ /* Structure to fill in with information
+ * about the string. */
+ int append; /* Non-zero means append tokens to existing
+ * information in parsePtr; zero means
+ * ignore existing tokens in parsePtr and
+ * reinitialize it. */
+ char **termPtr; /* If non-NULL, points to word in which to
+ * store a pointer to the character just
+ * after the quoted string's terminating
+ * close-quote if the parse succeeds. */
+{
+ char *end;
+
+ if ((numBytes >= 0) || (string == NULL)) {
+ end = string + numBytes;
+ } else {
+ end = string + strlen(string);
+ }
+
+ if (!append) {
+ parsePtr->numWords = 0;
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->string = string;
+ parsePtr->end = end;
+ parsePtr->interp = interp;
+ parsePtr->errorType = TCL_PARSE_SUCCESS;
+ }
+
+ if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) {
+ goto error;
+ }
+ if (*parsePtr->term != '"') {
+ if (interp != NULL) {
+ Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
+ }
+ parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
+ parsePtr->term = string;
+ parsePtr->incomplete = 1;
+ goto error;
+ }
+ if (termPtr != NULL) {
+ *termPtr = (parsePtr->term + 1);
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_FreeParse(parsePtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CommandComplete --
+ *
+ * This procedure is shared by TclCommandComplete and
+ * Tcl_ObjCommandcoComplete; it does all the real work of seeing
+ * whether a script is complete
+ *
+ * Results:
+ * 1 is returned if the script is complete, 0 if there are open
+ * delimiters such as " or (. 1 is also returned if there is a
+ * parse error in the script other than unmatched delimiters.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CommandComplete(script, length)
+ char *script; /* Script to check. */
+ int length; /* Number of bytes in script. */
+{
+ Tcl_Parse parse;
+ char *p, *end;
+ int result;
+
+ p = script;
+ end = p + length;
+ while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
+ == TCL_OK) {
+ p = parse.commandStart + parse.commandSize;
+ if (*p == 0) {
+ break;
+ }
+ Tcl_FreeParse(&parse);
+ }
+ if (parse.incomplete) {
+ result = 0;
+ } else {
+ result = 1;
}
+ Tcl_FreeParse(&parse);
return result;
}
@@ -877,12 +2189,14 @@ Tcl_ParseVar(interp, string, termPtr)
*
* Tcl_CommandComplete --
*
- * Given a partial or complete Tcl command, this procedure
- * determines whether the command is complete in the sense
+ * Given a partial or complete Tcl script, this procedure
+ * determines whether the script is complete in the sense
* of having matched braces and quotes and brackets.
*
* Results:
- * 1 is returned if the command is complete, 0 otherwise.
+ * 1 is returned if the script is complete, 0 otherwise.
+ * 1 is also returned if there is a parse error in the script
+ * other than unmatched delimiters.
*
* Side effects:
* None.
@@ -891,16 +2205,10 @@ Tcl_ParseVar(interp, string, termPtr)
*/
int
-Tcl_CommandComplete(cmd)
- char *cmd; /* Command to check. */
+Tcl_CommandComplete(script)
+ char *script; /* Script to check. */
{
- char *p;
-
- if (*cmd == 0) {
- return 1;
- }
- p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
- return (*p != 0);
+ return CommandComplete(script, (int) strlen(script));
}
/*
@@ -922,17 +2230,63 @@ Tcl_CommandComplete(cmd)
*/
int
-TclObjCommandComplete(cmdPtr)
- Tcl_Obj *cmdPtr; /* Points to object holding command
+TclObjCommandComplete(objPtr)
+ Tcl_Obj *objPtr; /* Points to object holding script
* to check. */
{
- char *cmd, *p;
+ char *script;
int length;
- cmd = Tcl_GetStringFromObj(cmdPtr, &length);
- if (length == 0) {
- return 1;
+ script = Tcl_GetStringFromObj(objPtr, &length);
+ return CommandComplete(script, length);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIsLocalScalar --
+ *
+ * Check to see if a given string is a legal scalar variable
+ * name with no namespace qualifiers or substitutions.
+ *
+ * Results:
+ * Returns 1 if the variable is a local scalar.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsLocalScalar(src, len)
+ CONST char *src;
+ int len;
+{
+ CONST char *p;
+ CONST char *lastChar = src + (len - 1);
+
+ for (p = src; p <= lastChar; p++) {
+ if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
+ (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
+ /*
+ * TCL_COMMAND_END is returned for the last character
+ * of the string. By this point we know it isn't
+ * an array or namespace reference.
+ */
+
+ return 0;
+ }
+ if (*p == '(') {
+ if (*lastChar == ')') { /* we have an array element */
+ return 0;
+ }
+ } else if (*p == ':') {
+ if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
+ return 0;
+ }
+ }
}
- p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
- return (*p != 0);
+
+ return 1;
}
diff --git a/tcl/generic/tclParseExpr.c b/tcl/generic/tclParseExpr.c
new file mode 100644
index 00000000000..00612db7efa
--- /dev/null
+++ b/tcl/generic/tclParseExpr.c
@@ -0,0 +1,1852 @@
+/*
+ * tclParseExpr.c --
+ *
+ * This file contains procedures that parse Tcl expressions. They
+ * do so in a general-purpose fashion that can be used for many
+ * different purposes, including compilation, direct execution,
+ * code analysis, etc.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclCompile.h"
+
+/*
+ * The stuff below is a bit of a hack so that this file can be used in
+ * environments that include no UNIX, i.e. no errno: just arrange to use
+ * the errno from tclExecute.c here.
+ */
+
+#ifndef TCL_GENERIC_ONLY
+#include "tclPort.h"
+#else
+#define NO_ERRNO_H
+#endif
+
+#ifdef NO_ERRNO_H
+extern int errno; /* Use errno from tclExecute.c. */
+#define ERANGE 34
+#endif
+
+/*
+ * Boolean variable that controls whether expression parse tracing
+ * is enabled.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static int traceParseExpr = 0;
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * The ParseInfo structure holds state while parsing an expression.
+ * A pointer to an ParseInfo record is passed among the routines in
+ * this module.
+ */
+
+typedef struct ParseInfo {
+ Tcl_Parse *parsePtr; /* Points to structure to fill in with
+ * information about the expression. */
+ int lexeme; /* Type of last lexeme scanned in expr.
+ * See below for definitions. Corresponds to
+ * size characters beginning at start. */
+ char *start; /* First character in lexeme. */
+ int size; /* Number of bytes in lexeme. */
+ char *next; /* Position of the next character to be
+ * scanned in the expression string. */
+ char *prevEnd; /* Points to the character just after the
+ * last one in the previous lexeme. Used to
+ * compute size of subexpression tokens. */
+ char *originalExpr; /* Points to the start of the expression
+ * originally passed to Tcl_ParseExpr. */
+ char *lastChar; /* Points just after last byte of expr. */
+} ParseInfo;
+
+/*
+ * Definitions of the different lexemes that appear in expressions. The
+ * order of these must match the corresponding entries in the
+ * operatorStrings array below.
+ */
+
+#define LITERAL 0
+#define FUNC_NAME 1
+#define OPEN_BRACKET 2
+#define OPEN_BRACE 3
+#define OPEN_PAREN 4
+#define CLOSE_PAREN 5
+#define DOLLAR 6
+#define QUOTE 7
+#define COMMA 8
+#define END 9
+#define UNKNOWN 10
+
+/*
+ * Binary operators:
+ */
+
+#define MULT 11
+#define DIVIDE 12
+#define MOD 13
+#define PLUS 14
+#define MINUS 15
+#define LEFT_SHIFT 16
+#define RIGHT_SHIFT 17
+#define LESS 18
+#define GREATER 19
+#define LEQ 20
+#define GEQ 21
+#define EQUAL 22
+#define NEQ 23
+#define BIT_AND 24
+#define BIT_XOR 25
+#define BIT_OR 26
+#define AND 27
+#define OR 28
+#define QUESTY 29
+#define COLON 30
+
+/*
+ * Unary operators. Unary minus and plus are represented by the (binary)
+ * lexemes MINUS and PLUS.
+ */
+
+#define NOT 31
+#define BIT_NOT 32
+
+/*
+ * Mapping from lexemes to strings; used for debugging messages. These
+ * entries must match the order and number of the lexeme definitions above.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+static char *lexemeStrings[] = {
+ "LITERAL", "FUNCNAME",
+ "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
+ "*", "/", "%", "+", "-",
+ "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
+ "&", "^", "|", "&&", "||", "?", ":",
+ "!", "~"
+};
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * Declarations for local procedures to this file:
+ */
+
+static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
+static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static void PrependSubExprTokens _ANSI_ARGS_((char *op,
+ int opBytes, char *src, int srcBytes,
+ int firstIndex, ParseInfo *infoPtr));
+
+/*
+ * Macro used to debug the execution of the recursive descent parser used
+ * to parse expressions.
+ */
+
+#ifdef TCL_COMPILE_DEBUG
+#define HERE(production, level) \
+ if (traceParseExpr) { \
+ fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
+ (level), " ", (production), \
+ lexemeStrings[infoPtr->lexeme], infoPtr->next); \
+ }
+#else
+#define HERE(production, level)
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseExpr --
+ *
+ * Given a string, this procedure parses the first Tcl expression
+ * in the string and returns information about the structure of
+ * the expression. This procedure is the top-level interface to the
+ * the expression parsing module.
+ *
+ * Results:
+ * The return value is TCL_OK if the command was parsed successfully
+ * and TCL_ERROR otherwise. If an error occurs and interp isn't NULL
+ * then an error message is left in its result. On a successful return,
+ * parsePtr is filled in with information about the expression that
+ * was parsed.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the expression, then additional space is
+ * malloc-ed. If the procedure returns TCL_OK then the caller must
+ * eventually invoke Tcl_FreeParse to release any additional space
+ * that was allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ParseExpr(interp, string, numBytes, parsePtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *string; /* The source string to parse. */
+ int numBytes; /* Number of bytes in string. If < 0, the
+ * string consists of all bytes up to the
+ * first null character. */
+ Tcl_Parse *parsePtr; /* Structure to fill with information about
+ * the parsed expression; any previous
+ * information in the structure is
+ * ignored. */
+{
+ ParseInfo info;
+ int code;
+ char savedChar;
+
+ if (numBytes < 0) {
+ numBytes = (string? strlen(string) : 0);
+ }
+#ifdef TCL_COMPILE_DEBUG
+ if (traceParseExpr) {
+ fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
+ numBytes, string);
+ }
+#endif /* TCL_COMPILE_DEBUG */
+
+ parsePtr->commentStart = NULL;
+ parsePtr->commentSize = 0;
+ parsePtr->commandStart = NULL;
+ parsePtr->commandSize = 0;
+ parsePtr->numWords = 0;
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->string = string;
+ parsePtr->end = (string + numBytes);
+ parsePtr->interp = interp;
+ parsePtr->term = string;
+ parsePtr->incomplete = 0;
+
+ /*
+ * Temporarily overwrite the character just after the end of the
+ * string with a 0 byte. This acts as a sentinel and reduces the
+ * number of places where we have to check for the end of the
+ * input string. The original value of the byte is restored at
+ * the end of the parse.
+ */
+
+ savedChar = string[numBytes];
+ string[numBytes] = 0;
+
+ /*
+ * Initialize the ParseInfo structure that holds state while parsing
+ * the expression.
+ */
+
+ info.parsePtr = parsePtr;
+ info.lexeme = UNKNOWN;
+ info.start = NULL;
+ info.size = 0;
+ info.next = string;
+ info.prevEnd = string;
+ info.originalExpr = string;
+ info.lastChar = (string + numBytes); /* just after last char of expr */
+
+ /*
+ * Get the first lexeme then parse the expression.
+ */
+
+ code = GetLexeme(&info);
+ if (code != TCL_OK) {
+ goto error;
+ }
+ code = ParseCondExpr(&info);
+ if (code != TCL_OK) {
+ goto error;
+ }
+ if (info.lexeme != END) {
+ LogSyntaxError(&info);
+ goto error;
+ }
+ string[numBytes] = (char) savedChar;
+ return TCL_OK;
+
+ error:
+ string[numBytes] = (char) savedChar;
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseCondExpr --
+ *
+ * This procedure parses a Tcl conditional expression:
+ * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
+ *
+ * Note that this is the topmost recursive-descent parsing routine used
+ * by TclParseExpr to parse expressions. This avoids an extra procedure
+ * call since such a procedure would only return the result of calling
+ * ParseCondExpr. Other recursive-descent procedures that need to parse
+ * complete expressions also call ParseCondExpr.
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseCondExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
+ int firstIndex, numToMove, code;
+ char *srcStart;
+
+ HERE("condExpr", 1);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseLorExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ if (infoPtr->lexeme == QUESTY) {
+ /*
+ * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
+ * conditional expression, and a TCL_TOKEN_OPERATOR token for
+ * the "?" operator. Note that these two tokens must be inserted
+ * before the LOR operand tokens generated above.
+ */
+
+ if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
+ tokenPtr = (firstTokenPtr + 2);
+ numToMove = (parsePtr->numTokens - firstIndex);
+ memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
+ (size_t) (numToMove * sizeof(Tcl_Token)));
+ parsePtr->numTokens += 2;
+
+ tokenPtr = firstTokenPtr;
+ tokenPtr->type = TCL_TOKEN_SUB_EXPR;
+ tokenPtr->start = srcStart;
+
+ tokenPtr++;
+ tokenPtr->type = TCL_TOKEN_OPERATOR;
+ tokenPtr->start = infoPtr->start;
+ tokenPtr->size = 1;
+ tokenPtr->numComponents = 0;
+
+ /*
+ * Skip over the '?'.
+ */
+
+ code = GetLexeme(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Parse the "then" expression.
+ */
+
+ code = ParseCondExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ if (infoPtr->lexeme != COLON) {
+ LogSyntaxError(infoPtr);
+ return TCL_ERROR;
+ }
+ code = GetLexeme(infoPtr); /* skip over the ':' */
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Parse the "else" expression.
+ */
+
+ code = ParseCondExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Now set the size-related fields in the '?' subexpression token.
+ */
+
+ condTokenPtr = &parsePtr->tokenPtr[firstIndex];
+ condTokenPtr->size = (infoPtr->prevEnd - srcStart);
+ condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseLorExpr --
+ *
+ * This procedure parses a Tcl logical or expression:
+ * lorExpr ::= landExpr {'||' landExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseLorExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, code;
+ char *srcStart, *operator;
+
+ HERE("lorExpr", 2);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseLandExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ while (infoPtr->lexeme == OR) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over the '||' */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseLandExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the LOR subexpression and the '||' operator.
+ */
+
+ PrependSubExprTokens(operator, 2, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseLandExpr --
+ *
+ * This procedure parses a Tcl logical and expression:
+ * landExpr ::= bitOrExpr {'&&' bitOrExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseLandExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, code;
+ char *srcStart, *operator;
+
+ HERE("landExpr", 3);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseBitOrExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ while (infoPtr->lexeme == AND) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over the '&&' */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseBitOrExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the LAND subexpression and the '&&' operator.
+ */
+
+ PrependSubExprTokens(operator, 2, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseBitOrExpr --
+ *
+ * This procedure parses a Tcl bitwise or expression:
+ * bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseBitOrExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, code;
+ char *srcStart, *operator;
+
+ HERE("bitOrExpr", 4);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseBitXorExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ while (infoPtr->lexeme == BIT_OR) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over the '|' */
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ code = ParseBitXorExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the BITOR subexpression and the '|' operator.
+ */
+
+ PrependSubExprTokens(operator, 1, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseBitXorExpr --
+ *
+ * This procedure parses a Tcl bitwise exclusive or expression:
+ * bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseBitXorExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, code;
+ char *srcStart, *operator;
+
+ HERE("bitXorExpr", 5);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseBitAndExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ while (infoPtr->lexeme == BIT_XOR) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over the '^' */
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ code = ParseBitAndExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the XOR subexpression and the '^' operator.
+ */
+
+ PrependSubExprTokens(operator, 1, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseBitAndExpr --
+ *
+ * This procedure parses a Tcl bitwise and expression:
+ * bitAndExpr ::= equalityExpr {'&' equalityExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseBitAndExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, code;
+ char *srcStart, *operator;
+
+ HERE("bitAndExpr", 6);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseEqualityExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ while (infoPtr->lexeme == BIT_AND) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over the '&' */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseEqualityExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the BITAND subexpression and '&' operator.
+ */
+
+ PrependSubExprTokens(operator, 1, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseEqualityExpr --
+ *
+ * This procedure parses a Tcl equality (inequality) expression:
+ * equalityExpr ::= relationalExpr {('==' | '!=') relationalExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseEqualityExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, lexeme, code;
+ char *srcStart, *operator;
+
+ HERE("equalityExpr", 7);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseRelationalExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ lexeme = infoPtr->lexeme;
+ while ((lexeme == EQUAL) || (lexeme == NEQ)) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over == or != */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseRelationalExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the subexpression and '==' or '!=' operator.
+ */
+
+ PrependSubExprTokens(operator, 2, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ lexeme = infoPtr->lexeme;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseRelationalExpr --
+ *
+ * This procedure parses a Tcl relational expression:
+ * relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseRelationalExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, lexeme, operatorSize, code;
+ char *srcStart, *operator;
+
+ HERE("relationalExpr", 8);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseShiftExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ lexeme = infoPtr->lexeme;
+ while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
+ || (lexeme == GEQ)) {
+ operator = infoPtr->start;
+ if ((lexeme == LEQ) || (lexeme == GEQ)) {
+ operatorSize = 2;
+ } else {
+ operatorSize = 1;
+ }
+ code = GetLexeme(infoPtr); /* skip over the operator */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseShiftExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the subexpression and the operator.
+ */
+
+ PrependSubExprTokens(operator, operatorSize, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ lexeme = infoPtr->lexeme;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseShiftExpr --
+ *
+ * This procedure parses a Tcl shift expression:
+ * shiftExpr ::= addExpr {('<<' | '>>') addExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseShiftExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, lexeme, code;
+ char *srcStart, *operator;
+
+ HERE("shiftExpr", 9);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseAddExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ lexeme = infoPtr->lexeme;
+ while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over << or >> */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseAddExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the subexpression and '<<' or '>>' operator.
+ */
+
+ PrependSubExprTokens(operator, 2, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ lexeme = infoPtr->lexeme;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseAddExpr --
+ *
+ * This procedure parses a Tcl addition expression:
+ * addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseAddExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, lexeme, code;
+ char *srcStart, *operator;
+
+ HERE("addExpr", 10);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseMultiplyExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ lexeme = infoPtr->lexeme;
+ while ((lexeme == PLUS) || (lexeme == MINUS)) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over + or - */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseMultiplyExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the subexpression and '+' or '-' operator.
+ */
+
+ PrependSubExprTokens(operator, 1, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ lexeme = infoPtr->lexeme;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseMultiplyExpr --
+ *
+ * This procedure parses a Tcl multiply expression:
+ * multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseMultiplyExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, lexeme, code;
+ char *srcStart, *operator;
+
+ HERE("multiplyExpr", 11);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseUnaryExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ lexeme = infoPtr->lexeme;
+ while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over * or / or % */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseUnaryExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the subexpression and * or / or % operator.
+ */
+
+ PrependSubExprTokens(operator, 1, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ lexeme = infoPtr->lexeme;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseUnaryExpr --
+ *
+ * This procedure parses a Tcl unary expression:
+ * unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseUnaryExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, lexeme, code;
+ char *srcStart, *operator;
+
+ HERE("unaryExpr", 12);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ lexeme = infoPtr->lexeme;
+ if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
+ || (lexeme == NOT)) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over the unary operator */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseUnaryExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the subexpression and the operator.
+ */
+
+ PrependSubExprTokens(operator, 1, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ } else { /* must be a primaryExpr */
+ code = ParsePrimaryExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParsePrimaryExpr --
+ *
+ * This procedure parses a Tcl primary expression:
+ * primaryExpr ::= literal | varReference | quotedString |
+ * '[' command ']' | mathFuncCall | '(' condExpr ')'
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParsePrimaryExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ Tcl_Interp *interp = parsePtr->interp;
+ Tcl_Token *tokenPtr, *exprTokenPtr;
+ Tcl_Parse nested;
+ char *dollarPtr, *stringStart, *termPtr, *src;
+ int lexeme, exprIndex, firstIndex, numToMove, code;
+
+ /*
+ * We simply recurse on parenthesized subexpressions.
+ */
+
+ HERE("primaryExpr", 13);
+ lexeme = infoPtr->lexeme;
+ if (lexeme == OPEN_PAREN) {
+ code = GetLexeme(infoPtr); /* skip over the '(' */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseCondExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ if (infoPtr->lexeme != CLOSE_PAREN) {
+ goto syntaxError;
+ }
+ code = GetLexeme(infoPtr); /* skip over the ')' */
+ if (code != TCL_OK) {
+ return code;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Start a TCL_TOKEN_SUB_EXPR token for the primary.
+ */
+
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ exprIndex = parsePtr->numTokens;
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
+ exprTokenPtr->start = infoPtr->start;
+ parsePtr->numTokens++;
+
+ /*
+ * Process the primary then finish setting the fields of the
+ * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now
+ * stored in "exprTokenPtr" in the code below since the token array
+ * might be reallocated.
+ */
+
+ firstIndex = parsePtr->numTokens;
+ switch (lexeme) {
+ case LITERAL:
+ /*
+ * Int or double number.
+ */
+
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = infoPtr->start;
+ tokenPtr->size = infoPtr->size;
+ tokenPtr->numComponents = 0;
+ parsePtr->numTokens++;
+
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->size = infoPtr->size;
+ exprTokenPtr->numComponents = 1;
+ break;
+
+ case DOLLAR:
+ /*
+ * $var variable reference.
+ */
+
+ dollarPtr = (infoPtr->next - 1);
+ code = Tcl_ParseVarName(interp, dollarPtr,
+ (infoPtr->lastChar - dollarPtr), parsePtr, 1);
+ if (code != TCL_OK) {
+ return code;
+ }
+ infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;
+
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
+ exprTokenPtr->numComponents =
+ (parsePtr->tokenPtr[firstIndex].numComponents + 1);
+ break;
+
+ case QUOTE:
+ /*
+ * '"' string '"'
+ */
+
+ stringStart = infoPtr->next;
+ code = Tcl_ParseQuotedString(interp, infoPtr->start,
+ (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ infoPtr->next = termPtr;
+
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->size = (termPtr - exprTokenPtr->start);
+ exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
+
+ /*
+ * If parsing the quoted string resulted in more than one token,
+ * insert a TCL_TOKEN_WORD token before them. This indicates that
+ * the quoted string represents a concatenation of multiple tokens.
+ */
+
+ if (exprTokenPtr->numComponents > 1) {
+ if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[firstIndex];
+ numToMove = (parsePtr->numTokens - firstIndex);
+ memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
+ (size_t) (numToMove * sizeof(Tcl_Token)));
+ parsePtr->numTokens++;
+
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->numComponents++;
+
+ tokenPtr->type = TCL_TOKEN_WORD;
+ tokenPtr->start = exprTokenPtr->start;
+ tokenPtr->size = exprTokenPtr->size;
+ tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
+ }
+ break;
+
+ case OPEN_BRACKET:
+ /*
+ * '[' command {command} ']'
+ */
+
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_COMMAND;
+ tokenPtr->start = infoPtr->start;
+ tokenPtr->numComponents = 0;
+ parsePtr->numTokens++;
+
+ /*
+ * Call Tcl_ParseCommand repeatedly to parse the nested command(s)
+ * to find their end, then throw away that parse information.
+ */
+
+ src = infoPtr->next;
+ while (1) {
+ if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
+ &nested) != TCL_OK) {
+ parsePtr->term = nested.term;
+ parsePtr->errorType = nested.errorType;
+ parsePtr->incomplete = nested.incomplete;
+ return TCL_ERROR;
+ }
+ src = (nested.commandStart + nested.commandSize);
+ if (nested.tokenPtr != nested.staticTokens) {
+ ckfree((char *) nested.tokenPtr);
+ }
+ if ((src[-1] == ']') && !nested.incomplete) {
+ break;
+ }
+ if (src == parsePtr->end) {
+ if (parsePtr->interp != NULL) {
+ Tcl_SetResult(interp, "missing close-bracket",
+ TCL_STATIC);
+ }
+ parsePtr->term = tokenPtr->start;
+ parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
+ parsePtr->incomplete = 1;
+ return TCL_ERROR;
+ }
+ }
+ tokenPtr->size = (src - tokenPtr->start);
+ infoPtr->next = src;
+
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->size = (src - tokenPtr->start);
+ exprTokenPtr->numComponents = 1;
+ break;
+
+ case OPEN_BRACE:
+ /*
+ * '{' string '}'
+ */
+
+ code = Tcl_ParseBraces(interp, infoPtr->start,
+ (infoPtr->lastChar - infoPtr->start), parsePtr, 1,
+ &termPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ infoPtr->next = termPtr;
+
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->size = (termPtr - infoPtr->start);
+ exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
+
+ /*
+ * If parsing the braced string resulted in more than one token,
+ * insert a TCL_TOKEN_WORD token before them. This indicates that
+ * the braced string represents a concatenation of multiple tokens.
+ */
+
+ if (exprTokenPtr->numComponents > 1) {
+ if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[firstIndex];
+ numToMove = (parsePtr->numTokens - firstIndex);
+ memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
+ (size_t) (numToMove * sizeof(Tcl_Token)));
+ parsePtr->numTokens++;
+
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->numComponents++;
+
+ tokenPtr->type = TCL_TOKEN_WORD;
+ tokenPtr->start = exprTokenPtr->start;
+ tokenPtr->size = exprTokenPtr->size;
+ tokenPtr->numComponents = exprTokenPtr->numComponents-1;
+ }
+ break;
+
+ case FUNC_NAME:
+ /*
+ * math_func '(' expr {',' expr} ')'
+ */
+
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_OPERATOR;
+ tokenPtr->start = infoPtr->start;
+ tokenPtr->size = infoPtr->size;
+ tokenPtr->numComponents = 0;
+ parsePtr->numTokens++;
+
+ code = GetLexeme(infoPtr); /* skip over function name */
+ if (code != TCL_OK) {
+ return code;
+ }
+ if (infoPtr->lexeme != OPEN_PAREN) {
+ goto syntaxError;
+ }
+ code = GetLexeme(infoPtr); /* skip over '(' */
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ while (infoPtr->lexeme != CLOSE_PAREN) {
+ code = ParseCondExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ if (infoPtr->lexeme == COMMA) {
+ code = GetLexeme(infoPtr); /* skip over , */
+ if (code != TCL_OK) {
+ return code;
+ }
+ } else if (infoPtr->lexeme != CLOSE_PAREN) {
+ goto syntaxError;
+ }
+ }
+
+ exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
+ exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
+ exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
+ break;
+
+ default:
+ goto syntaxError;
+ }
+
+ /*
+ * Advance to the next lexeme before returning.
+ */
+
+ code = GetLexeme(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+
+ syntaxError:
+ LogSyntaxError(infoPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetLexeme --
+ *
+ * Lexical scanner for Tcl expressions: scans a single operator or
+ * other syntactic element from an expression string.
+ *
+ * Results:
+ * TCL_OK is returned unless an error occurred. In that case a standard
+ * Tcl error code is returned and, if infoPtr->parsePtr->interp is
+ * non-NULL, the interpreter's result is set to hold an error
+ * message. TCL_ERROR is returned if an integer overflow, or a
+ * floating-point overflow or underflow occurred while reading in a
+ * number. If the lexical analysis is successful, infoPtr->lexeme
+ * refers to the next symbol in the expression string, and
+ * infoPtr->next is advanced past the lexeme. Also, if the lexeme is a
+ * LITERAL or FUNC_NAME, then infoPtr->start is set to the first
+ * character of the lexeme; otherwise it is set NULL.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed..
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetLexeme(infoPtr)
+ ParseInfo *infoPtr; /* Holds state needed to parse the expr,
+ * including the resulting lexeme. */
+{
+ register char *src; /* Points to current source char. */
+ char *termPtr; /* Points to char terminating a literal. */
+ double doubleValue; /* Value of a scanned double literal. */
+ char c;
+ int startsWithDigit, offset;
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ Tcl_Interp *interp = parsePtr->interp;
+ Tcl_UniChar ch;
+
+ /*
+ * Record where the previous lexeme ended. Since we always read one
+ * lexeme ahead during parsing, this helps us know the source length of
+ * subexpression tokens.
+ */
+
+ infoPtr->prevEnd = infoPtr->next;
+
+ /*
+ * Scan over leading white space at the start of a lexeme. Note that a
+ * backslash-newline is treated as a space.
+ */
+
+ src = infoPtr->next;
+ c = *src;
+ while (isspace(UCHAR(c)) || (c == '\\')) { /* INTL: ISO space */
+ if (c == '\\') {
+ if (src[1] == '\n') {
+ src += 2;
+ } else {
+ break; /* no longer white space */
+ }
+ } else {
+ src++;
+ }
+ c = *src;
+ }
+ parsePtr->term = src;
+ if (src >= infoPtr->lastChar) {
+ infoPtr->lexeme = END;
+ infoPtr->next = src;
+ return TCL_OK;
+ }
+
+ /*
+ * Try to parse the lexeme first as an integer or floating-point
+ * number. Don't check for a number if the first character c is
+ * "+" or "-". If we did, we might treat a binary operator as unary
+ * by mistake, which would eventually cause a syntax error.
+ */
+
+ if ((c != '+') && (c != '-')) {
+ startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */
+ if (startsWithDigit && TclLooksLikeInt(src, -1)) {
+ errno = 0;
+ (void) strtoul(src, &termPtr, 0);
+ if (errno == ERANGE) {
+ if (interp != NULL) {
+ char *s = "integer value too large to represent";
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
+ (char *) NULL);
+ }
+ parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+ return TCL_ERROR;
+ }
+ if (termPtr != src) {
+ /*
+ * src was the start of a valid integer, but was it
+ * a bad octal? Stopping at a digit would cause that.
+ */
+ if (isdigit(UCHAR(*termPtr))) { /* INTL: digit. */
+ /*
+ * We only want to report an error for the number,
+ * but we may have something like "08+1"
+ */
+ if (interp != NULL) {
+ while (isdigit(UCHAR(*(++termPtr)))) {} /* INTL: digit. */
+ Tcl_ResetResult(interp);
+ offset = termPtr - src;
+ c = src[offset];
+ src[offset] = 0;
+ Tcl_AppendResult(interp, "\"", src,
+ "\" is an invalid octal number",
+ (char *) NULL);
+ src[offset] = c;
+ }
+ parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+ return TCL_ERROR;
+ }
+
+ infoPtr->lexeme = LITERAL;
+ infoPtr->start = src;
+ infoPtr->size = (termPtr - src);
+ infoPtr->next = termPtr;
+ parsePtr->term = termPtr;
+ return TCL_OK;
+ }
+ } else if (startsWithDigit || (c == '.')
+ || (c == 'n') || (c == 'N')) {
+ errno = 0;
+ doubleValue = strtod(src, &termPtr);
+ if (termPtr != src) {
+ if (errno != 0) {
+ if (interp != NULL) {
+ TclExprFloatError(interp, doubleValue);
+ }
+ parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+ return TCL_ERROR;
+ }
+
+ /*
+ * src was the start of a valid double.
+ */
+
+ infoPtr->lexeme = LITERAL;
+ infoPtr->start = src;
+ infoPtr->size = (termPtr - src);
+ infoPtr->next = termPtr;
+ parsePtr->term = termPtr;
+ return TCL_OK;
+ }
+ }
+ }
+
+ /*
+ * Not an integer or double literal. Initialize the lexeme's fields
+ * assuming the common case of a single character lexeme.
+ */
+
+ infoPtr->start = src;
+ infoPtr->size = 1;
+ infoPtr->next = src+1;
+ parsePtr->term = infoPtr->next;
+
+ switch (*src) {
+ case '[':
+ infoPtr->lexeme = OPEN_BRACKET;
+ return TCL_OK;
+
+ case '{':
+ infoPtr->lexeme = OPEN_BRACE;
+ return TCL_OK;
+
+ case '(':
+ infoPtr->lexeme = OPEN_PAREN;
+ return TCL_OK;
+
+ case ')':
+ infoPtr->lexeme = CLOSE_PAREN;
+ return TCL_OK;
+
+ case '$':
+ infoPtr->lexeme = DOLLAR;
+ return TCL_OK;
+
+ case '\"':
+ infoPtr->lexeme = QUOTE;
+ return TCL_OK;
+
+ case ',':
+ infoPtr->lexeme = COMMA;
+ return TCL_OK;
+
+ case '*':
+ infoPtr->lexeme = MULT;
+ return TCL_OK;
+
+ case '/':
+ infoPtr->lexeme = DIVIDE;
+ return TCL_OK;
+
+ case '%':
+ infoPtr->lexeme = MOD;
+ return TCL_OK;
+
+ case '+':
+ infoPtr->lexeme = PLUS;
+ return TCL_OK;
+
+ case '-':
+ infoPtr->lexeme = MINUS;
+ return TCL_OK;
+
+ case '?':
+ infoPtr->lexeme = QUESTY;
+ return TCL_OK;
+
+ case ':':
+ infoPtr->lexeme = COLON;
+ return TCL_OK;
+
+ case '<':
+ switch (src[1]) {
+ case '<':
+ infoPtr->lexeme = LEFT_SHIFT;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ break;
+ case '=':
+ infoPtr->lexeme = LEQ;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ break;
+ default:
+ infoPtr->lexeme = LESS;
+ break;
+ }
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+
+ case '>':
+ switch (src[1]) {
+ case '>':
+ infoPtr->lexeme = RIGHT_SHIFT;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ break;
+ case '=':
+ infoPtr->lexeme = GEQ;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ break;
+ default:
+ infoPtr->lexeme = GREATER;
+ break;
+ }
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+
+ case '=':
+ if (src[1] == '=') {
+ infoPtr->lexeme = EQUAL;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ } else {
+ infoPtr->lexeme = UNKNOWN;
+ }
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+
+ case '!':
+ if (src[1] == '=') {
+ infoPtr->lexeme = NEQ;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ } else {
+ infoPtr->lexeme = NOT;
+ }
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+
+ case '&':
+ if (src[1] == '&') {
+ infoPtr->lexeme = AND;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ } else {
+ infoPtr->lexeme = BIT_AND;
+ }
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+
+ case '^':
+ infoPtr->lexeme = BIT_XOR;
+ return TCL_OK;
+
+ case '|':
+ if (src[1] == '|') {
+ infoPtr->lexeme = OR;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ } else {
+ infoPtr->lexeme = BIT_OR;
+ }
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+
+ case '~':
+ infoPtr->lexeme = BIT_NOT;
+ return TCL_OK;
+
+ default:
+ offset = Tcl_UtfToUniChar(src, &ch);
+ c = UCHAR(ch);
+ if (isalpha(UCHAR(c))) { /* INTL: ISO only. */
+ infoPtr->lexeme = FUNC_NAME;
+ while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
+ src += offset;
+ offset = Tcl_UtfToUniChar(src, &ch);
+ c = UCHAR(ch);
+ }
+ infoPtr->size = (src - infoPtr->start);
+ infoPtr->next = src;
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+ }
+ infoPtr->lexeme = UNKNOWN;
+ return TCL_OK;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrependSubExprTokens --
+ *
+ * This procedure is called after the operands of an subexpression have
+ * been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
+ * the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
+ * These two tokens are inserted before the operand tokens.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold the new tokens,
+ * additional space is malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
+ char *op; /* Points to first byte of the operator
+ * in the source script. */
+ int opBytes; /* Number of bytes in the operator. */
+ char *src; /* Points to first byte of the subexpression
+ * in the source script. */
+ int srcBytes; /* Number of bytes in subexpression's
+ * source. */
+ int firstIndex; /* Index of first token already emitted for
+ * operator's first (or only) operand. */
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ Tcl_Token *tokenPtr, *firstTokenPtr;
+ int numToMove;
+
+ if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
+ tokenPtr = (firstTokenPtr + 2);
+ numToMove = (parsePtr->numTokens - firstIndex);
+ memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
+ (size_t) (numToMove * sizeof(Tcl_Token)));
+ parsePtr->numTokens += 2;
+
+ tokenPtr = firstTokenPtr;
+ tokenPtr->type = TCL_TOKEN_SUB_EXPR;
+ tokenPtr->start = src;
+ tokenPtr->size = srcBytes;
+ tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
+
+ tokenPtr++;
+ tokenPtr->type = TCL_TOKEN_OPERATOR;
+ tokenPtr->start = op;
+ tokenPtr->size = opBytes;
+ tokenPtr->numComponents = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LogSyntaxError --
+ *
+ * This procedure is invoked after an error occurs when parsing an
+ * expression. It sets the interpreter result to an error message
+ * describing the error.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the interpreter result to an error message describing the
+ * expression that was being parsed when the error occurred.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+LogSyntaxError(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
+ char buffer[100];
+
+ sprintf(buffer, "syntax error in expression \"%.*s\"",
+ ((numBytes > 60)? 60 : numBytes), infoPtr->originalExpr);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
+ buffer, (char *) NULL);
+ infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
+ infoPtr->parsePtr->term = infoPtr->start;
+}
diff --git a/tcl/generic/tclPatch.h b/tcl/generic/tclPatch.h
new file mode 100644
index 00000000000..ec26abc9d75
--- /dev/null
+++ b/tcl/generic/tclPatch.h
@@ -0,0 +1,23 @@
+/*
+ * tclPatch.h --
+ *
+ * This file does nothing except define a "patch level" for Tcl.
+ * The patch level has the form "X.YpZ" where X.Y is the base
+ * release, and Z is a serial number that is used to sequence
+ * patches for a given release. Thus 7.4p1 is the first patch
+ * to release 7.4, 7.4p2 is the patch that follows 7.4p1, and
+ * so on. The "pZ" is omitted in an original new release, and
+ * it is replaced with "bZ" for beta releases or "aZ for alpha
+ * releases. The patch level ensures that patches are applied
+ * in the correct order and only to appropriate sources.
+ *
+ * Copyright (c) 1993-1994 The Regents of the University of California.
+ * Copyright (c) 1994-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.
+ *
+ * SCCS: @(#) tclPatch.h 1.23 96/10/02 14:36:15
+ */
+
+#define TCL_PATCH_LEVEL "7.6"
diff --git a/tcl/generic/tclPipe.c b/tcl/generic/tclPipe.c
index 0e958692db1..09bcb486671 100644
--- a/tcl/generic/tclPipe.c
+++ b/tcl/generic/tclPipe.c
@@ -32,6 +32,7 @@ typedef struct Detached {
} Detached;
static Detached *detList = NULL; /* List of all detached proceses. */
+TCL_DECLARE_MUTEX(pipeMutex) /* Guard access to detList. */
/*
* Declarations for local procedures defined in this file:
@@ -53,7 +54,7 @@ static TclFile FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
* Results:
* The return value is the descriptor number for the file. If an
* error occurs then NULL is returned and an error message is left
- * in interp->result. Several arguments are side-effected; see
+ * in the interp's result. Several arguments are side-effected; see
* the argument list below for details.
*
* Side effects:
@@ -183,12 +184,15 @@ Tcl_DetachPids(numPids, pidPtr)
register Detached *detPtr;
int i;
+ Tcl_MutexLock(&pipeMutex);
for (i = 0; i < numPids; i++) {
detPtr = (Detached *) ckalloc(sizeof(Detached));
detPtr->pid = pidPtr[i];
detPtr->nextPtr = detList;
detList = detPtr;
}
+ Tcl_MutexUnlock(&pipeMutex);
+
}
/*
@@ -219,6 +223,7 @@ Tcl_ReapDetachedProcs()
int status;
Tcl_Pid pid;
+ Tcl_MutexLock(&pipeMutex);
for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
@@ -235,6 +240,7 @@ Tcl_ReapDetachedProcs()
ckfree((char *) detPtr);
detPtr = nextPtr;
}
+ Tcl_MutexUnlock(&pipeMutex);
}
/*
@@ -249,10 +255,10 @@ Tcl_ReapDetachedProcs()
* Results:
* The return value is a standard Tcl result. If anything at
* weird happened with the child processes, TCL_ERROR is returned
- * and a message is left in interp->result.
+ * and a message is left in the interp's result.
*
* Side effects:
- * If the last character of interp->result is a newline, then it
+ * If the last character of the interp's result is a newline, then it
* is removed unless keepNewline is non-zero. File errorId gets
* closed, and pidPtr is freed back to the storage allocator.
*
@@ -305,13 +311,13 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
*/
if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
- char msg1[20], msg2[20];
+ char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
result = TCL_ERROR;
- sprintf(msg1, "%ld", TclpGetPid(pid));
+ TclFormatInt(msg1, (long) TclpGetPid(pid));
if (WIFEXITED(waitStatus)) {
if (interp != (Tcl_Interp *) NULL) {
- sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
+ TclFormatInt(msg2, WEXITSTATUS(waitStatus));
Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
(char *) NULL);
}
@@ -361,32 +367,28 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
* Make sure we start at the beginning of the file.
*/
- Tcl_Seek(errorChan, 0L, SEEK_SET);
-
- if (interp != (Tcl_Interp *) NULL) {
- while (1) {
-#define BUFFER_SIZE 1000
- char buffer[BUFFER_SIZE+1];
- int count;
-
- count = Tcl_Read(errorChan, buffer, BUFFER_SIZE);
- if (count == 0) {
- break;
- }
- result = TCL_ERROR;
- if (count < 0) {
- Tcl_AppendResult(interp,
- "error reading stderr output file: ",
- Tcl_PosixError(interp), (char *) NULL);
- break; /* out of the "while (1)" loop. */
- }
- buffer[count] = 0;
- Tcl_AppendResult(interp, buffer, (char *) NULL);
- anyErrorInfo = 1;
- }
- }
-
- Tcl_Close((Tcl_Interp *) NULL, errorChan);
+ if (interp != NULL) {
+ int count;
+ Tcl_Obj *objPtr;
+
+ Tcl_Seek(errorChan, 0L, SEEK_SET);
+ objPtr = Tcl_NewObj();
+ count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
+ if (count < 0) {
+ result = TCL_ERROR;
+ Tcl_DecrRefCount(objPtr);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "error reading stderr output file: ",
+ Tcl_PosixError(interp), NULL);
+ } else if (count > 0) {
+ anyErrorInfo = 1;
+ Tcl_SetObjResult(interp, objPtr);
+ result = TCL_ERROR;
+ } else {
+ Tcl_DecrRefCount(objPtr);
+ }
+ }
+ Tcl_Close(NULL, errorChan);
}
/*
@@ -394,11 +396,10 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
* at all, generate an error message here.
*/
- if (abnormalExit && !anyErrorInfo && (interp != (Tcl_Interp *) NULL)) {
+ if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
Tcl_AppendResult(interp, "child process exited abnormally",
(char *) NULL);
}
-
return result;
}
@@ -497,8 +498,6 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
int errorClose = 0; /* If non-zero, then errorFile should be
* closed when cleaning up. */
int errorRelease = 0;
- int joinError = 0; /* CYGNUS LOCAL: If non-zero, join stderr
- * and stdout. */
char *p;
int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
Tcl_DString execBuffer;
@@ -667,28 +666,10 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
errorRelease = 0;
TclpReleaseFile(errorFile);
}
-
- /* CYGNUS LOCAL: On windows we need to handle redirecting
- stderr to stdout specially. On Unix it works out
- because TclpCreateProcess happens to dup stderr to
- stdout after reopening stdout, but that fails on
- Windows. */
- joinError = 0;
- if (*p == '@'
- && strcmp ((p[1] == '\0' ? argv[i + 1] : p + 1),
- "stdout") == 0) {
- joinError = 1;
- if (p[1] == '\0') {
- skip = 2;
- } else {
- skip = 1;
- }
- } else {
- errorFile = FileForRedirect(interp, p, atOK, argv[i],
- argv[i + 1], flags, &skip, &errorClose, &errorRelease);
- if (errorFile == NULL) {
- goto error;
- }
+ errorFile = FileForRedirect(interp, p, atOK, argv[i],
+ argv[i + 1], flags, &skip, &errorClose, &errorRelease);
+ if (errorFile == NULL) {
+ goto error;
}
break;
}
@@ -709,7 +690,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
* Tcl. Create a temporary file for it and put the data into the
* file.
*/
- inputFile = TclpCreateTempFile(inputLiteral, NULL);
+ inputFile = TclpCreateTempFile(inputLiteral);
if (inputFile == NULL) {
Tcl_AppendResult(interp,
"couldn't create input file for command: ",
@@ -775,10 +756,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
}
if (errorFile == NULL) {
- /* CYGNUS LOCAL: Handle joinError. */
- if (joinError) {
- errorFile = outputFile;
- } else if (errFilePtr != NULL) {
+ if (errFilePtr != NULL) {
/*
* Set up the standard error output sink for the pipeline, if
* requested. Use a temporary file which is opened, then deleted.
@@ -788,7 +766,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
* complete because stderr was backed up.
*/
- errorFile = TclpCreateTempFile(NULL, NULL);
+ errorFile = TclpCreateTempFile(NULL);
if (errorFile == NULL) {
Tcl_AppendResult(interp,
"couldn't create error file for command: ",
@@ -822,15 +800,15 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
curInFile = inputFile;
for (i = 0; i < argc; i = lastArg + 1) {
- int joinThisError;
+ int result, joinThisError;
Tcl_Pid pid;
+ char *oldName;
/*
* Convert the program name into native form.
*/
- argv[i] = Tcl_TranslateFileName(interp, argv[i], &execBuffer);
- if (argv[i] == NULL) {
+ if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) {
goto error;
}
@@ -874,8 +852,17 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
curErrFile = errorFile;
}
- if (TclpCreateProcess(interp, lastArg - i, argv + i,
- curInFile, curOutFile, curErrFile, &pid) != TCL_OK) {
+ /*
+ * Restore argv[i], since a caller wouldn't expect the contents of
+ * argv to be modified.
+ */
+
+ oldName = argv[i];
+ argv[i] = Tcl_DStringValue(&execBuffer);
+ result = TclpCreateProcess(interp, lastArg - i, argv + i,
+ curInFile, curOutFile, curErrFile, &pid);
+ argv[i] = oldName;
+ if (result != TCL_OK) {
goto error;
}
Tcl_DStringFree(&execBuffer);
diff --git a/tcl/generic/tclPkg.c b/tcl/generic/tclPkg.c
index e74356185c4..1906e8dbafb 100644
--- a/tcl/generic/tclPkg.c
+++ b/tcl/generic/tclPkg.c
@@ -43,6 +43,7 @@ typedef struct Package {
* exist in this interpreter yet. */
PkgAvail *availPtr; /* First in list of all available versions
* of this package. */
+ ClientData clientData; /* Client data. */
} Package;
/*
@@ -59,7 +60,7 @@ static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgProvide --
+ * Tcl_PkgProvide / Tcl_PkgProvideEx --
*
* This procedure is invoked to declare that a particular version
* of a particular package is now present in an interpreter. There
@@ -69,7 +70,7 @@ static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
* Results:
* Normally returns TCL_OK; if there is already another version
* of the package loaded then TCL_ERROR is returned and an error
- * message is left in interp->result.
+ * message is left in the interp's result.
*
* Side effects:
* The interpreter remembers that this package is available,
@@ -86,15 +87,31 @@ Tcl_PkgProvide(interp, name, version)
char *name; /* Name of package. */
char *version; /* Version string for package. */
{
+ return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL);
+}
+
+int
+Tcl_PkgProvideEx(interp, name, version, clientData)
+ Tcl_Interp *interp; /* Interpreter in which package is now
+ * available. */
+ char *name; /* Name of package. */
+ char *version; /* Version string for package. */
+ ClientData clientData; /* clientdata for this package (normally
+ * used for C callback function table) */
+{
Package *pkgPtr;
pkgPtr = FindPackage(interp, name);
if (pkgPtr->version == NULL) {
pkgPtr->version = ckalloc((unsigned) (strlen(version) + 1));
strcpy(pkgPtr->version, version);
+ pkgPtr->clientData = clientData;
return TCL_OK;
}
if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {
+ if (clientData != NULL) {
+ pkgPtr->clientData = clientData;
+ }
return TCL_OK;
}
Tcl_AppendResult(interp, "conflicting versions provided for package \"",
@@ -105,7 +122,7 @@ Tcl_PkgProvide(interp, name, version)
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgRequire --
+ * Tcl_PkgRequire / Tcl_PkgRequireEx --
*
* This procedure is called by code that depends on a particular
* version of a particular package. If the package is not already
@@ -122,7 +139,7 @@ Tcl_PkgProvide(interp, name, version)
* a currently provided version, or the required version cannot
* be found, or the script to provide the required version
* generates an error), NULL is returned and an error
- * message is left in interp->result.
+ * message is left in the interp's result.
*
* Side effects:
* The script from some previous "package ifneeded" command may
@@ -143,6 +160,25 @@ Tcl_PkgRequire(interp, name, version, exact)
* version given is acceptable. Zero means
* use the latest compatible version. */
{
+ return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL);
+}
+
+char *
+Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter in which package is now
+ * available. */
+ char *name; /* Name of desired package. */
+ char *version; /* Version string for desired version;
+ * NULL means use the latest version
+ * available. */
+ int exact; /* Non-zero means that only the particular
+ * version given is acceptable. Zero means
+ * use the latest compatible version. */
+ ClientData *clientDataPtr; /* Used to return the client data for this
+ * package. If it is NULL then the client
+ * data is not returned. This is unchanged
+ * if this call fails for any reason. */
+{
Package *pkgPtr;
PkgAvail *availPtr, *bestPtr;
char *script;
@@ -150,6 +186,22 @@ Tcl_PkgRequire(interp, name, version, exact)
Tcl_DString command;
/*
+ * If an attempt is being made to load this into a standalong executable
+ * on a platform where backlinking is not supported then this must be
+ * a shared version of Tcl (Otherwise the load would have failed).
+ * Detect this situation by checking that this library has been correctly
+ * initialised. If it has not been then return immediately as nothing will
+ * work.
+ */
+
+ if (!tclEmptyStringRep) {
+ Tcl_AppendResult(interp, "Cannot load package \"", name,
+ "\" in standalone executable: This package is not ",
+ "compiled with stub support", NULL);
+ return NULL;
+ }
+
+ /*
* It can take up to three passes to find the package: one pass to
* run the "package unknown" script, one to run the "package ifneeded"
* script for a specific version, and a final pass to lookup the
@@ -253,15 +305,21 @@ Tcl_PkgRequire(interp, name, version, exact)
}
/*
- * At this point we now that the package is present. Make sure that the
+ * At this point we know that the package is present. Make sure that the
* provided version meets the current requirement.
*/
if (version == NULL) {
+ if (clientDataPtr) {
+ *clientDataPtr = pkgPtr->clientData;
+ }
return pkgPtr->version;
}
result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
if ((satisfies && !exact) || (result == 0)) {
+ if (clientDataPtr) {
+ *clientDataPtr = pkgPtr->clientData;
+ }
return pkgPtr->version;
}
Tcl_AppendResult(interp, "version conflict for package \"",
@@ -273,7 +331,123 @@ Tcl_PkgRequire(interp, name, version, exact)
/*
*----------------------------------------------------------------------
*
- * Tcl_PackageCmd --
+ * Tcl_PkgPresent / Tcl_PkgPresentEx --
+ *
+ * Checks to see whether the specified package is present. If it
+ * is not then no additional action is taken.
+ *
+ * Results:
+ * If successful, returns the version string for the currently
+ * provided version of the package, which may be different from
+ * the "version" argument. If the caller's requirements
+ * cannot be met (e.g. the version requested conflicts with
+ * a currently provided version), NULL is returned and an error
+ * message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_PkgPresent(interp, name, version, exact)
+ Tcl_Interp *interp; /* Interpreter in which package is now
+ * available. */
+ char *name; /* Name of desired package. */
+ char *version; /* Version string for desired version;
+ * NULL means use the latest version
+ * available. */
+ int exact; /* Non-zero means that only the particular
+ * version given is acceptable. Zero means
+ * use the latest compatible version. */
+{
+ return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);
+}
+
+char *
+Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter in which package is now
+ * available. */
+ char *name; /* Name of desired package. */
+ char *version; /* Version string for desired version;
+ * NULL means use the latest version
+ * available. */
+ int exact; /* Non-zero means that only the particular
+ * version given is acceptable. Zero means
+ * use the latest compatible version. */
+ ClientData *clientDataPtr; /* Used to return the client data for this
+ * package. If it is NULL then the client
+ * data is not returned. This is unchanged
+ * if this call fails for any reason. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+ Package *pkgPtr;
+ int satisfies, result;
+
+ /*
+ * If an attempt is being made to load this into a standalone executable
+ * on a platform where backlinking is not supported then this must be
+ * a shared version of Tcl (Otherwise the load would have failed).
+ * Detect this situation by checking that this library has been correctly
+ * initialised. If it has not been then return immediately as nothing will
+ * work.
+ */
+
+ if (!tclEmptyStringRep) {
+ Tcl_AppendResult(interp, "Cannot load package \"", name,
+ "\" in standalone executable: This package is not ",
+ "compiled with stub support", NULL);
+ return NULL;
+ }
+
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
+ if (hPtr) {
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ if (pkgPtr->version != NULL) {
+
+ /*
+ * At this point we know that the package is present. Make sure
+ * that the provided version meets the current requirement.
+ */
+
+ if (version == NULL) {
+ if (clientDataPtr) {
+ *clientDataPtr = pkgPtr->clientData;
+ }
+
+ return pkgPtr->version;
+ }
+ result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
+ if ((satisfies && !exact) || (result == 0)) {
+ if (clientDataPtr) {
+ *clientDataPtr = pkgPtr->clientData;
+ }
+
+ return pkgPtr->version;
+ }
+ Tcl_AppendResult(interp, "version conflict for package \"",
+ name, "\": have ", pkgPtr->version,
+ ", need ", version, (char *) NULL);
+ return NULL;
+ }
+ }
+
+ if (version != NULL) {
+ Tcl_AppendResult(interp, "package ", name, " ", version,
+ " is not present", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "package ", name, " is not present",
+ (char *) NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_PackageObjCmd --
*
* This procedure is invoked to process the "package" Tcl command.
* See the user documentation for details on what it does.
@@ -289,226 +463,293 @@ Tcl_PkgRequire(interp, name, version, exact)
/* ARGSUSED */
int
-Tcl_PackageCmd(dummy, interp, argc, argv)
+Tcl_PackageObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ static char *pkgOptions[] = {
+ "forget", "ifneeded", "names", "present", "provide", "require",
+ "unknown", "vcompare", "versions", "vsatisfies", (char *) NULL
+ };
+ enum pkgOptions {
+ PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PRESENT,
+ PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE,
+ PKG_VERSIONS, PKG_VSATISFIES
+ };
Interp *iPtr = (Interp *) interp;
- size_t length;
- int c, exact, i, satisfies;
+ int optionIndex, exact, i, satisfies;
PkgAvail *availPtr, *prevPtr;
Package *pkgPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_HashTable *tablePtr;
- char *version;
- char buf[30];
+ char *version, *argv2, *argv3, *argv4;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option ?arg arg ...?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
- for (i = 2; i < argc; i++) {
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[i]);
- if (hPtr == NULL) {
- return TCL_OK;
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,
+ &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum pkgOptions) optionIndex) {
+ case PKG_FORGET: {
+ char *keyString;
+ for (i = 2; i < objc; i++) {
+ keyString = Tcl_GetString(objv[i]);
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
+ if (hPtr == NULL) {
+ return TCL_OK;
+ }
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ if (pkgPtr->version != NULL) {
+ ckfree(pkgPtr->version);
+ }
+ while (pkgPtr->availPtr != NULL) {
+ availPtr = pkgPtr->availPtr;
+ pkgPtr->availPtr = availPtr->nextPtr;
+ ckfree(availPtr->version);
+ Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+ ckfree((char *) availPtr);
+ }
+ ckfree((char *) pkgPtr);
}
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- Tcl_DeleteHashEntry(hPtr);
- if (pkgPtr->version != NULL) {
- ckfree(pkgPtr->version);
+ break;
+ }
+ case PKG_IFNEEDED: {
+ int length;
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
+ return TCL_ERROR;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (CheckVersion(interp, argv3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ argv2 = Tcl_GetString(objv[2]);
+ if (objc == 4) {
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
+ if (hPtr == NULL) {
+ return TCL_OK;
+ }
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ } else {
+ pkgPtr = FindPackage(interp, argv2);
}
- while (pkgPtr->availPtr != NULL) {
- availPtr = pkgPtr->availPtr;
- pkgPtr->availPtr = availPtr->nextPtr;
- ckfree(availPtr->version);
- Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
- ckfree((char *) availPtr);
+ argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
+ prevPtr = availPtr, availPtr = availPtr->nextPtr) {
+ if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL)
+ == 0) {
+ if (objc == 4) {
+ Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+ break;
+ }
}
- ckfree((char *) pkgPtr);
+ if (objc == 4) {
+ return TCL_OK;
+ }
+ if (availPtr == NULL) {
+ availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
+ availPtr->version = ckalloc((unsigned) (length + 1));
+ strcpy(availPtr->version, argv3);
+ if (prevPtr == NULL) {
+ availPtr->nextPtr = pkgPtr->availPtr;
+ pkgPtr->availPtr = availPtr;
+ } else {
+ availPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = availPtr;
+ }
+ }
+ argv4 = Tcl_GetStringFromObj(objv[4], &length);
+ availPtr->script = ckalloc((unsigned) (length + 1));
+ strcpy(availPtr->script, argv4);
+ break;
}
- } else if ((c == 'i') && (strncmp(argv[1], "ifneeded", length) == 0)) {
- if ((argc != 4) && (argc != 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ifneeded package version ?script?\"", (char *) NULL);
- return TCL_ERROR;
+ case PKG_NAMES: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ tablePtr = &iPtr->packageTable;
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
+ }
+ }
+ break;
}
- if (CheckVersion(interp, argv[3]) != TCL_OK) {
- return TCL_ERROR;
+ case PKG_PRESENT: {
+ if (objc < 3) {
+ presentSyntax:
+ Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
+ return TCL_ERROR;
+ }
+ argv2 = Tcl_GetString(objv[2]);
+ if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
+ exact = 1;
+ } else {
+ exact = 0;
+ }
+ version = NULL;
+ if (objc == (4 + exact)) {
+ version = Tcl_GetString(objv[3 + exact]);
+ if (CheckVersion(interp, version) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if ((objc != 3) || exact) {
+ goto presentSyntax;
+ }
+ if (exact) {
+ argv3 = Tcl_GetString(objv[3]);
+ version = Tcl_PkgPresent(interp, argv3, version, exact);
+ } else {
+ version = Tcl_PkgPresent(interp, argv2, version, exact);
+ }
+ if (version == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, version, TCL_VOLATILE);
+ break;
}
- if (argc == 4) {
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
- if (hPtr == NULL) {
+ case PKG_PROVIDE: {
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
+ return TCL_ERROR;
+ }
+ argv2 = Tcl_GetString(objv[2]);
+ if (objc == 3) {
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
+ if (hPtr != NULL) {
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ if (pkgPtr->version != NULL) {
+ Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
+ }
+ }
return TCL_OK;
}
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- } else {
- pkgPtr = FindPackage(interp, argv[2]);
+ argv3 = Tcl_GetString(objv[3]);
+ if (CheckVersion(interp, argv3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_PkgProvide(interp, argv2, argv3);
}
- for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
- prevPtr = availPtr, availPtr = availPtr->nextPtr) {
- if (ComparePkgVersions(availPtr->version, argv[3], (int *) NULL)
- == 0) {
- if (argc == 4) {
- Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
- return TCL_OK;
+ case PKG_REQUIRE: {
+ if (objc < 3) {
+ requireSyntax:
+ Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
+ return TCL_ERROR;
+ }
+ argv2 = Tcl_GetString(objv[2]);
+ if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
+ exact = 1;
+ } else {
+ exact = 0;
+ }
+ version = NULL;
+ if (objc == (4 + exact)) {
+ version = Tcl_GetString(objv[3 + exact]);
+ if (CheckVersion(interp, version) != TCL_OK) {
+ return TCL_ERROR;
}
- Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
- break;
+ } else if ((objc != 3) || exact) {
+ goto requireSyntax;
}
- }
- if (argc == 4) {
- return TCL_OK;
- }
- if (availPtr == NULL) {
- availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
- availPtr->version = ckalloc((unsigned) (strlen(argv[3]) + 1));
- strcpy(availPtr->version, argv[3]);
- if (prevPtr == NULL) {
- availPtr->nextPtr = pkgPtr->availPtr;
- pkgPtr->availPtr = availPtr;
+ if (exact) {
+ argv3 = Tcl_GetString(objv[3]);
+ version = Tcl_PkgRequire(interp, argv3, version, exact);
} else {
- availPtr->nextPtr = prevPtr->nextPtr;
- prevPtr->nextPtr = availPtr;
+ version = Tcl_PkgRequire(interp, argv2, version, exact);
}
+ if (version == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, version, TCL_VOLATILE);
+ break;
}
- availPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
- strcpy(availPtr->script, argv[4]);
- } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " names\"", (char *) NULL);
- return TCL_ERROR;
- }
- tablePtr = &iPtr->packageTable;
- for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&search)) {
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
+ case PKG_UNKNOWN: {
+ int length;
+ if (objc == 2) {
+ if (iPtr->packageUnknown != NULL) {
+ Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
+ }
+ } else if (objc == 3) {
+ if (iPtr->packageUnknown != NULL) {
+ ckfree(iPtr->packageUnknown);
+ }
+ argv2 = Tcl_GetStringFromObj(objv[2], &length);
+ if (argv2[0] == 0) {
+ iPtr->packageUnknown = NULL;
+ } else {
+ iPtr->packageUnknown = (char *) ckalloc((unsigned)
+ (length + 1));
+ strcpy(iPtr->packageUnknown, argv2);
+ }
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?command?");
+ return TCL_ERROR;
}
+ break;
}
- } else if ((c == 'p') && (strncmp(argv[1], "provide", length) == 0)) {
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " provide package ?version?\"", (char *) NULL);
- return TCL_ERROR;
+ case PKG_VCOMPARE: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
+ return TCL_ERROR;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ argv2 = Tcl_GetString(objv[2]);
+ if ((CheckVersion(interp, argv2) != TCL_OK)
+ || (CheckVersion(interp, argv3) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ ComparePkgVersions(argv2, argv3, (int *) NULL));
+ break;
}
- if (argc == 3) {
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
+ case PKG_VERSIONS: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "package");
+ return TCL_ERROR;
+ }
+ argv2 = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
if (hPtr != NULL) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- if (pkgPtr->version != NULL) {
- Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
+ for (availPtr = pkgPtr->availPtr; availPtr != NULL;
+ availPtr = availPtr->nextPtr) {
+ Tcl_AppendElement(interp, availPtr->version);
}
}
- return TCL_OK;
- }
- if (CheckVersion(interp, argv[3]) != TCL_OK) {
- return TCL_ERROR;
- }
- return Tcl_PkgProvide(interp, argv[2], argv[3]);
- } else if ((c == 'r') && (strncmp(argv[1], "require", length) == 0)) {
- if (argc < 3) {
- requireSyntax:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " require ?-exact? package ?version?\"", (char *) NULL);
- return TCL_ERROR;
- }
- if ((argv[2][0] == '-') && (strcmp(argv[2], "-exact") == 0)) {
- exact = 1;
- } else {
- exact = 0;
+ break;
}
- version = NULL;
- if (argc == (4+exact)) {
- version = argv[3+exact];
- if (CheckVersion(interp, version) != TCL_OK) {
+ case PKG_VSATISFIES: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
return TCL_ERROR;
}
- } else if ((argc != 3) || exact) {
- goto requireSyntax;
- }
- version = Tcl_PkgRequire(interp, argv[2+exact], version, exact);
- if (version == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetResult(interp, version, TCL_VOLATILE);
- } else if ((c == 'u') && (strncmp(argv[1], "unknown", length) == 0)) {
- if (argc == 2) {
- if (iPtr->packageUnknown != NULL) {
- Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
- }
- } else if (argc == 3) {
- if (iPtr->packageUnknown != NULL) {
- ckfree(iPtr->packageUnknown);
- }
- if (argv[2][0] == 0) {
- iPtr->packageUnknown = NULL;
- } else {
- iPtr->packageUnknown = (char *) ckalloc((unsigned)
- (strlen(argv[2]) + 1));
- strcpy(iPtr->packageUnknown, argv[2]);
- }
- } else {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " unknown ?command?\"", (char *) NULL);
- return TCL_ERROR;
- }
- } else if ((c == 'v') && (strncmp(argv[1], "vcompare", length) == 0)
- && (length >= 2)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " vcompare version1 version2\"", (char *) NULL);
- return TCL_ERROR;
- }
- if ((CheckVersion(interp, argv[2]) != TCL_OK)
- || (CheckVersion(interp, argv[3]) != TCL_OK)) {
- return TCL_ERROR;
- }
- TclFormatInt(buf, ComparePkgVersions(argv[2], argv[3], (int *) NULL));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- } else if ((c == 'v') && (strncmp(argv[1], "versions", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " versions package\"", (char *) NULL);
- return TCL_ERROR;
- }
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
- if (hPtr != NULL) {
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- for (availPtr = pkgPtr->availPtr; availPtr != NULL;
- availPtr = availPtr->nextPtr) {
- Tcl_AppendElement(interp, availPtr->version);
+ argv3 = Tcl_GetString(objv[3]);
+ argv2 = Tcl_GetString(objv[2]);
+ if ((CheckVersion(interp, argv2) != TCL_OK)
+ || (CheckVersion(interp, argv3) != TCL_OK)) {
+ return TCL_ERROR;
}
+ ComparePkgVersions(argv2, argv3, &satisfies);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies);
+ break;
}
- } else if ((c == 'v') && (strncmp(argv[1], "vsatisfies", length) == 0)
- && (length >= 2)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " vsatisfies version1 version2\"", (char *) NULL);
- return TCL_ERROR;
- }
- if ((CheckVersion(interp, argv[2]) != TCL_OK)
- || (CheckVersion(interp, argv[3]) != TCL_OK)) {
- return TCL_ERROR;
+ default: {
+ panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
}
- ComparePkgVersions(argv[2], argv[3], &satisfies);
- TclFormatInt(buf, satisfies);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be forget, ifneeded, names, ",
- "provide, require, unknown, vcompare, ",
- "versions, or vsatisfies", (char *) NULL);
- return TCL_ERROR;
}
return TCL_OK;
}
@@ -547,6 +788,7 @@ FindPackage(interp, name)
pkgPtr = (Package *) ckalloc(sizeof(Package));
pkgPtr->version = NULL;
pkgPtr->availPtr = NULL;
+ pkgPtr->clientData = NULL;
Tcl_SetHashValue(hPtr, pkgPtr);
} else {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
@@ -613,7 +855,7 @@ TclFreePackageInfo(iPtr)
* Results:
* If string is a properly formed version number the TCL_OK
* is returned. Otherwise TCL_ERROR is returned and an error
- * message is left in interp->result.
+ * message is left in the interp's result.
*
* Side effects:
* None.
@@ -629,16 +871,19 @@ CheckVersion(interp, string)
* by dots. */
{
char *p = string;
-
- if (!isdigit(UCHAR(*p))) {
+ char prevChar;
+
+ if (!isdigit(UCHAR(*p))) { /* INTL: digit */
goto error;
}
- for (p++; *p != 0; p++) {
- if (!isdigit(UCHAR(*p)) && (*p != '.')) {
+ for (prevChar = *p, p++; *p != 0; p++) {
+ if (!isdigit(UCHAR(*p)) &&
+ ((*p != '.') || (prevChar == '.'))) { /* INTL: digit */
goto error;
}
+ prevChar = *p;
}
- if (p[-1] != '.') {
+ if (prevChar != '.') {
return TCL_OK;
}
diff --git a/tcl/generic/tclPlatDecls.h b/tcl/generic/tclPlatDecls.h
new file mode 100644
index 00000000000..2aff8ad1b9f
--- /dev/null
+++ b/tcl/generic/tclPlatDecls.h
@@ -0,0 +1,152 @@
+/*
+ * tclPlatDecls.h --
+ *
+ * Declarations of platform specific Tcl APIs.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * All rights reserved.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TCLPLATDECLS
+#define _TCLPLATDECLS
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported function declarations:
+ */
+
+#ifdef __WIN32__
+/* 0 */
+EXTERN TCHAR * Tcl_WinUtfToTChar _ANSI_ARGS_((CONST char * str,
+ int len, Tcl_DString * dsPtr));
+/* 1 */
+EXTERN char * Tcl_WinTCharToUtf _ANSI_ARGS_((CONST TCHAR * str,
+ int len, Tcl_DString * dsPtr));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 0 */
+EXTERN void Tcl_MacSetEventProc _ANSI_ARGS_((
+ Tcl_MacConvertEventPtr procPtr));
+/* 1 */
+EXTERN char * Tcl_MacConvertTextResource _ANSI_ARGS_((
+ Handle resource));
+/* 2 */
+EXTERN int Tcl_MacEvalResource _ANSI_ARGS_((Tcl_Interp * interp,
+ char * resourceName, int resourceNumber,
+ char * fileName));
+/* 3 */
+EXTERN Handle Tcl_MacFindResource _ANSI_ARGS_((Tcl_Interp * interp,
+ long resourceType, char * resourceName,
+ int resourceNumber, char * resFileRef,
+ int * releaseIt));
+/* 4 */
+EXTERN int Tcl_GetOSTypeFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr,
+ OSType * osTypePtr));
+/* 5 */
+EXTERN void Tcl_SetOSTypeObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ OSType osType));
+/* 6 */
+EXTERN Tcl_Obj * Tcl_NewOSTypeObj _ANSI_ARGS_((OSType osType));
+/* 7 */
+EXTERN int strncasecmp _ANSI_ARGS_((CONST char * s1,
+ CONST char * s2, size_t n));
+/* 8 */
+EXTERN int strcasecmp _ANSI_ARGS_((CONST char * s1,
+ CONST char * s2));
+#endif /* MAC_TCL */
+
+typedef struct TclPlatStubs {
+ int magic;
+ struct TclPlatStubHooks *hooks;
+
+#ifdef __WIN32__
+ TCHAR * (*tcl_WinUtfToTChar) _ANSI_ARGS_((CONST char * str, int len, Tcl_DString * dsPtr)); /* 0 */
+ char * (*tcl_WinTCharToUtf) _ANSI_ARGS_((CONST TCHAR * str, int len, Tcl_DString * dsPtr)); /* 1 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tcl_MacSetEventProc) _ANSI_ARGS_((Tcl_MacConvertEventPtr procPtr)); /* 0 */
+ char * (*tcl_MacConvertTextResource) _ANSI_ARGS_((Handle resource)); /* 1 */
+ int (*tcl_MacEvalResource) _ANSI_ARGS_((Tcl_Interp * interp, char * resourceName, int resourceNumber, char * fileName)); /* 2 */
+ Handle (*tcl_MacFindResource) _ANSI_ARGS_((Tcl_Interp * interp, long resourceType, char * resourceName, int resourceNumber, char * resFileRef, int * releaseIt)); /* 3 */
+ int (*tcl_GetOSTypeFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, OSType * osTypePtr)); /* 4 */
+ void (*tcl_SetOSTypeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, OSType osType)); /* 5 */
+ Tcl_Obj * (*tcl_NewOSTypeObj) _ANSI_ARGS_((OSType osType)); /* 6 */
+ int (*strncasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, size_t n)); /* 7 */
+ int (*strcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2)); /* 8 */
+#endif /* MAC_TCL */
+} TclPlatStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern TclPlatStubs *tclPlatStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifdef __WIN32__
+#ifndef Tcl_WinUtfToTChar
+#define Tcl_WinUtfToTChar \
+ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
+#endif
+#ifndef Tcl_WinTCharToUtf
+#define Tcl_WinTCharToUtf \
+ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef Tcl_MacSetEventProc
+#define Tcl_MacSetEventProc \
+ (tclPlatStubsPtr->tcl_MacSetEventProc) /* 0 */
+#endif
+#ifndef Tcl_MacConvertTextResource
+#define Tcl_MacConvertTextResource \
+ (tclPlatStubsPtr->tcl_MacConvertTextResource) /* 1 */
+#endif
+#ifndef Tcl_MacEvalResource
+#define Tcl_MacEvalResource \
+ (tclPlatStubsPtr->tcl_MacEvalResource) /* 2 */
+#endif
+#ifndef Tcl_MacFindResource
+#define Tcl_MacFindResource \
+ (tclPlatStubsPtr->tcl_MacFindResource) /* 3 */
+#endif
+#ifndef Tcl_GetOSTypeFromObj
+#define Tcl_GetOSTypeFromObj \
+ (tclPlatStubsPtr->tcl_GetOSTypeFromObj) /* 4 */
+#endif
+#ifndef Tcl_SetOSTypeObj
+#define Tcl_SetOSTypeObj \
+ (tclPlatStubsPtr->tcl_SetOSTypeObj) /* 5 */
+#endif
+#ifndef Tcl_NewOSTypeObj
+#define Tcl_NewOSTypeObj \
+ (tclPlatStubsPtr->tcl_NewOSTypeObj) /* 6 */
+#endif
+#ifndef strncasecmp
+#define strncasecmp \
+ (tclPlatStubsPtr->strncasecmp) /* 7 */
+#endif
+#ifndef strcasecmp
+#define strcasecmp \
+ (tclPlatStubsPtr->strcasecmp) /* 8 */
+#endif
+#endif /* MAC_TCL */
+
+#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#endif /* _TCLPLATDECLS */
+
+
diff --git a/tcl/generic/tclPort.h b/tcl/generic/tclPort.h
index d6620dc1b69..4c719340b0e 100644
--- a/tcl/generic/tclPort.h
+++ b/tcl/generic/tclPort.h
@@ -16,10 +16,9 @@
#ifndef _TCLPORT
#define _TCLPORT
-#if defined(__CYGWIN__) && defined(__TCL_UNIX_VARIANT)
-# include "../unix/tclUnixPort.h"
-#else
-#if defined(__WIN32__) || defined(_WIN32)
+#include "tcl.h"
+
+#if defined(__WIN32__)
# include "../win/tclWinPort.h"
#else
# if defined(MAC_TCL)
@@ -28,6 +27,5 @@
# include "../unix/tclUnixPort.h"
# endif
#endif
-#endif
#endif /* _TCLPORT */
diff --git a/tcl/generic/tclPosixStr.c b/tcl/generic/tclPosixStr.c
index d2649b56c2c..2055f19eb48 100644
--- a/tcl/generic/tclPosixStr.c
+++ b/tcl/generic/tclPosixStr.c
@@ -336,7 +336,7 @@ Tcl_ErrnoId()
#ifdef ENXIO
case ENXIO: return "ENXIO";
#endif
-#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (EOPNOTSUPP != ENOTSUP))
+#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
case EOPNOTSUPP: return "EOPNOTSUPP";
#endif
#ifdef EPERM
@@ -736,7 +736,7 @@ Tcl_ErrnoMsg(err)
case ENOPKG: return "package not installed";
#endif
#ifdef ENOPROTOOPT
- case ENOPROTOOPT: return "bad proocol option";
+ case ENOPROTOOPT: return "bad protocol option";
#endif
#ifdef ENOSPC
case ENOSPC: return "no space left on device";
@@ -783,7 +783,7 @@ Tcl_ErrnoMsg(err)
#ifdef ENXIO
case ENXIO: return "no such device or address";
#endif
-#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (EOPNOTSUPP != ENOTSUP))
+#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
case EOPNOTSUPP: return "operation not supported on socket";
#endif
#ifdef EPERM
@@ -986,7 +986,7 @@ Tcl_SignalId(sig)
#ifdef SIGPROF
case SIGPROF: return "SIGPROF";
#endif
-#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ))
+#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST))
case SIGPWR: return "SIGPWR";
#endif
#ifdef SIGQUIT
@@ -1118,7 +1118,7 @@ Tcl_SignalMsg(sig)
#ifdef SIGPROF
case SIGPROF: return "profiling alarm";
#endif
-#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ))
+#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST))
case SIGPWR: return "power-fail restart";
#endif
#ifdef SIGQUIT
@@ -1172,3 +1172,4 @@ Tcl_SignalMsg(sig)
}
return "unknown signal";
}
+
diff --git a/tcl/generic/tclPreserve.c b/tcl/generic/tclPreserve.c
index 0f813eb7b19..ebde57a1e3d 100644
--- a/tcl/generic/tclPreserve.c
+++ b/tcl/generic/tclPreserve.c
@@ -7,7 +7,7 @@
* depend on their existence.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -40,6 +40,31 @@ static int spaceAvl = 0; /* Total number of structures available
static int inUse = 0; /* Count of structures currently in use
* in refArray. */
#define INITIAL_SIZE 2
+TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */
+
+/*
+ * The following data structure is used to keep track of whether an
+ * arbitrary block of memory has been deleted. This is used by the
+ * TclHandle code to avoid the more time-expensive algorithm of
+ * Tcl_Preserve(). This mechanism is mainly used when we have lots of
+ * references to a few big, expensive objects that we don't want to live
+ * any longer than necessary.
+ */
+
+typedef struct HandleStruct {
+ VOID *ptr; /* Pointer to the memory block being
+ * tracked. This field will become NULL when
+ * the memory block is deleted. This field
+ * must be the first in the structure. */
+#ifdef TCL_MEM_DEBUG
+ VOID *ptr2; /* Backup copy of the abpve pointer used to
+ * ensure that the contents of the handle are
+ * not changed by anyone else. */
+#endif
+ int refCount; /* Number of TclHandlePreserve() calls in
+ * effect on this handle. */
+} HandleStruct;
+
/*
* Static routines in this file:
@@ -69,12 +94,14 @@ static void
PreserveExitProc(clientData)
ClientData clientData; /* NULL -Unused. */
{
+ Tcl_MutexLock(&preserveMutex);
if (spaceAvl != 0) {
ckfree((char *) refArray);
refArray = (Reference *) NULL;
inUse = 0;
spaceAvl = 0;
}
+ Tcl_MutexUnlock(&preserveMutex);
}
/*
@@ -108,9 +135,11 @@ Tcl_Preserve(clientData)
* just increment its reference count.
*/
+ Tcl_MutexLock(&preserveMutex);
for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
if (refPtr->clientData == clientData) {
refPtr->refCount++;
+ Tcl_MutexUnlock(&preserveMutex);
return;
}
}
@@ -150,6 +179,7 @@ Tcl_Preserve(clientData)
refPtr->mustFree = 0;
refPtr->freeProc = TCL_STATIC;
inUse += 1;
+ Tcl_MutexUnlock(&preserveMutex);
}
/*
@@ -181,6 +211,7 @@ Tcl_Release(clientData)
Tcl_FreeProc *freeProc;
int i;
+ Tcl_MutexLock(&preserveMutex);
for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
if (refPtr->clientData != clientData) {
continue;
@@ -206,12 +237,16 @@ Tcl_Release(clientData)
(freeProc == (Tcl_FreeProc *) free)) {
ckfree((char *) clientData);
} else {
+ Tcl_MutexUnlock(&preserveMutex);
(*freeProc)((char *) clientData);
+ return;
}
}
}
+ Tcl_MutexUnlock(&preserveMutex);
return;
}
+ Tcl_MutexUnlock(&preserveMutex);
/*
* Reference not found. This is a bug in the caller.
@@ -252,6 +287,7 @@ Tcl_EventuallyFree(clientData, freeProc)
* "mustFree" flag (the flag had better not be set already!).
*/
+ Tcl_MutexLock(&preserveMutex);
for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
if (refPtr->clientData != clientData) {
continue;
@@ -261,8 +297,10 @@ Tcl_EventuallyFree(clientData, freeProc)
}
refPtr->mustFree = 1;
refPtr->freeProc = freeProc;
+ Tcl_MutexUnlock(&preserveMutex);
return;
}
+ Tcl_MutexUnlock(&preserveMutex);
/*
* No reference for this block. Free it now.
@@ -275,3 +313,178 @@ Tcl_EventuallyFree(clientData, freeProc)
(*freeProc)((char *)clientData);
}
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclHandleCreate --
+ *
+ * Allocate a handle that contains enough information to determine
+ * if an arbitrary malloc'd block has been deleted. This is
+ * used to avoid the more time-expensive algorithm of Tcl_Preserve().
+ *
+ * Results:
+ * The return value is a TclHandle that refers to the given malloc'd
+ * block. Doubly dereferencing the returned handle will give
+ * back the pointer to the block, or will give NULL if the block has
+ * been deleted.
+ *
+ * Side effects:
+ * The caller must keep track of this handle (generally by storing
+ * it in a field in the malloc'd block) and call TclHandleFree()
+ * on this handle when the block is deleted. Everything else that
+ * wishes to keep track of whether the malloc'd block has been deleted
+ * should use calls to TclHandlePreserve() and TclHandleRelease()
+ * on the associated handle.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TclHandle
+TclHandleCreate(ptr)
+ VOID *ptr; /* Pointer to an arbitrary block of memory
+ * to be tracked for deletion. Must not be
+ * NULL. */
+{
+ HandleStruct *handlePtr;
+
+ handlePtr = (HandleStruct *) ckalloc(sizeof(HandleStruct));
+ handlePtr->ptr = ptr;
+#ifdef TCL_MEM_DEBUG
+ handlePtr->ptr2 = ptr;
+#endif
+ handlePtr->refCount = 0;
+ return (TclHandle) handlePtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclHandleFree --
+ *
+ * Called when the arbitrary malloc'd block associated with the
+ * handle is being deleted. Modifies the handle so that doubly
+ * dereferencing it will give NULL. This informs any user of the
+ * handle that the block of memory formerly referenced by the
+ * handle has been freed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If nothing is referring to the handle, the handle will be reclaimed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclHandleFree(handle)
+ TclHandle handle; /* Previously created handle associated
+ * with a malloc'd block that is being
+ * deleted. The handle is modified so that
+ * doubly dereferencing it will give NULL. */
+{
+ HandleStruct *handlePtr;
+
+ handlePtr = (HandleStruct *) handle;
+#ifdef TCL_MEM_DEBUG
+ if (handlePtr->refCount == 0x61616161) {
+ panic("using previously disposed TclHandle %x", handlePtr);
+ }
+ if (handlePtr->ptr2 != handlePtr->ptr) {
+ panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+ handlePtr, handlePtr->ptr2, handlePtr->ptr);
+ }
+#endif
+ handlePtr->ptr = NULL;
+ if (handlePtr->refCount == 0) {
+ ckfree((char *) handlePtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclHandlePreserve --
+ *
+ * Declare an interest in the arbitrary malloc'd block associated
+ * with the handle.
+ *
+ * Results:
+ * The return value is the handle argument, with its ref count
+ * incremented.
+ *
+ * Side effects:
+ * For each call to TclHandlePreserve(), there should be a matching
+ * call to TclHandleRelease() when the caller is no longer interested
+ * in the malloc'd block associated with the handle.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TclHandle
+TclHandlePreserve(handle)
+ TclHandle handle; /* Declare an interest in the block of
+ * memory referenced by this handle. */
+{
+ HandleStruct *handlePtr;
+
+ handlePtr = (HandleStruct *) handle;
+#ifdef TCL_MEM_DEBUG
+ if (handlePtr->refCount == 0x61616161) {
+ panic("using previously disposed TclHandle %x", handlePtr);
+ }
+ if ((handlePtr->ptr != NULL)
+ && (handlePtr->ptr != handlePtr->ptr2)) {
+ panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+ handlePtr, handlePtr->ptr2, handlePtr->ptr);
+ }
+#endif
+ handlePtr->refCount++;
+
+ return handle;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclHandleRelease --
+ *
+ * This procedure is called to release an interest in the malloc'd
+ * block associated with the handle.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The ref count of the handle is decremented. If the malloc'd block
+ * has been freed and if no one is using the handle any more, the
+ * handle will be reclaimed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclHandleRelease(handle)
+ TclHandle handle; /* Unregister interest in the block of
+ * memory referenced by this handle. */
+{
+ HandleStruct *handlePtr;
+
+ handlePtr = (HandleStruct *) handle;
+#ifdef TCL_MEM_DEBUG
+ if (handlePtr->refCount == 0x61616161) {
+ panic("using previously disposed TclHandle %x", handlePtr);
+ }
+ if ((handlePtr->ptr != NULL)
+ && (handlePtr->ptr != handlePtr->ptr2)) {
+ panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
+ handlePtr, handlePtr->ptr2, handlePtr->ptr);
+ }
+#endif
+ handlePtr->refCount--;
+ if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
+ ckfree((char *) handlePtr);
+ }
+}
+
diff --git a/tcl/generic/tclProc.c b/tcl/generic/tclProc.c
index b956c9670fc..f9d19696ebe 100644
--- a/tcl/generic/tclProc.c
+++ b/tcl/generic/tclProc.c
@@ -5,7 +5,7 @@
* including the "proc" and "uplevel" commands.
*
* Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -25,6 +25,8 @@ static void ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr));
static int ProcBodySetFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
static void ProcBodyUpdateString _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int ProcessProcResultCode _ANSI_ARGS_((Tcl_Interp *interp,
+ char *procName, int nameLen, int returnCode));
/*
* The ProcBodyObjType type
@@ -37,7 +39,6 @@ Tcl_ObjType tclProcBodyType = {
ProcBodyUpdateString, /* UpdateString procedure */
ProcBodySetFromAny /* SetFromAny procedure */
};
-
/*
*----------------------------------------------------------------------
@@ -70,7 +71,6 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_Command cmd;
Tcl_DString ds;
- int result;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "name args body");
@@ -83,13 +83,10 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
* current namespace.
*/
- fullName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
- result = TclGetNamespaceForQualName(interp, fullName,
- (Namespace *) NULL, TCL_LEAVE_ERR_MSG,
- &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
- if (result != TCL_OK) {
- return result;
- }
+ fullName = TclGetString(objv[1]);
+ TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL,
+ 0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+
if (nsPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"can't create procedure \"", fullName,
@@ -138,6 +135,7 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
+ Tcl_DStringFree(&ds);
/*
* Now initialize the new procedure's cmdPtr field. This will be used
* later when the procedure is called to determine what namespace the
@@ -149,7 +147,6 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
@@ -189,7 +186,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
register Proc *procPtr;
int i, length, result, numArgs;
char *args, *bytes, *p;
- register CompiledLocal *localPtr;
+ register CompiledLocal *localPtr = NULL;
Tcl_Obj *defPtr;
int precompiled = 0;
@@ -269,7 +266,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
if (precompiled) {
if (numArgs > procPtr->numArgs) {
- char buf[128];
+ char buf[64 + TCL_INTEGER_SPACE + TCL_INTEGER_SPACE];
sprintf(buf, "\": arg list contains %d entries, precompiled header expects %d",
numArgs, procPtr->numArgs);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -355,7 +352,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
&& (fieldCount == 2))
|| ((localPtr->defValuePtr != NULL)
&& (fieldCount != 2))) {
- char buf[128];
+ char buf[80 + TCL_INTEGER_SPACE];
sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body",
i);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -418,7 +415,6 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
}
strcpy(localPtr->name, fieldValues[0]);
}
-
ckfree((char *) fieldValues);
}
@@ -456,7 +452,6 @@ procError:
}
return TCL_ERROR;
}
-
/*
*----------------------------------------------------------------------
@@ -468,8 +463,8 @@ procError:
* call frame for the appropriate level of procedure.
*
* Results:
- * The return value is -1 if an error occurred in finding the
- * frame (in this case an error message is left in interp->result).
+ * The return value is -1 if an error occurred in finding the frame
+ * (in this case an error message is left in the interp's result).
* 1 is returned if string was either a number or a number preceded
* by "#" and it specified a valid frame. 0 is returned if string
* isn't one of the two things above (in this case, the lookup
@@ -510,7 +505,7 @@ TclGetFrame(interp, string, framePtrPtr)
(char *) NULL);
return -1;
}
- } else if (isdigit(UCHAR(*string))) {
+ } else if (isdigit(UCHAR(*string))) { /* INTL: digit */
if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
return -1;
}
@@ -569,7 +564,7 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
{
register Interp *iPtr = (Interp *) interp;
char *optLevel;
- int length, result;
+ int result;
CallFrame *savedVarFramePtr, *framePtr;
if (objc < 2) {
@@ -580,10 +575,9 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
/*
* Find the level to use for executing the command.
- * THIS FAILS IF THE OBJECT RESULT'S STRING REP CONTAINS A NULL.
*/
- optLevel = Tcl_GetStringFromObj(objv[1], &length);
+ optLevel = TclGetString(objv[1]);
result = TclGetFrame(interp, optLevel, &framePtr);
if (result == -1) {
return TCL_ERROR;
@@ -606,14 +600,20 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
*/
if (objc == 1) {
- result = Tcl_EvalObj(interp, objv[0]);
+ result = Tcl_EvalObjEx(interp, objv[0], TCL_EVAL_DIRECT);
} else {
- Tcl_Obj *cmdObjPtr = Tcl_ConcatObj(objc, objv);
- result = Tcl_EvalObj(interp, cmdObjPtr);
- Tcl_DecrRefCount(cmdObjPtr); /* done with object */
+ /*
+ * More than one argument: concatenate them together with spaces
+ * between, then evaluate the result. Tcl_EvalObjEx will delete
+ * the object when it decrements its refcount after eval'ing it.
+ */
+ Tcl_Obj *objPtr;
+
+ objPtr = Tcl_ConcatObj(objc, objv);
+ result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
- char msg[60];
+ char msg[32 + TCL_INTEGER_SPACE];
sprintf(msg, "\n (\"uplevel\" body line %d)", interp->errorLine);
Tcl_AddObjErrorInfo(interp, msg, -1);
}
@@ -632,12 +632,17 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
* TclFindProc --
*
* Given the name of a procedure, return a pointer to the
- * record describing the procedure.
+ * record describing the procedure. The procedure will be
+ * looked up using the usual rules: first in the current
+ * namespace and then in the global namespace.
*
* Results:
* NULL is returned if the name doesn't correspond to any
- * procedure. Otherwise the return value is a pointer to
- * the procedure's record.
+ * procedure. Otherwise, the return value is a pointer to
+ * the procedure's record. If the name is found but refers
+ * to an imported command that points to a "real" procedure
+ * defined in another namespace, a pointer to that "real"
+ * procedure's structure is returned.
*
* Side effects:
* None.
@@ -772,11 +777,9 @@ TclProcInterpProc(clientData, interp, argc, argv)
/*
* Move the interpreter's object result to the string result,
* then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
*/
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
/*
@@ -819,23 +822,23 @@ TclProcInterpProc(clientData, interp, argc, argv)
int
TclObjInterpProc(clientData, interp, objc, objv)
- ClientData clientData; /* Record describing procedure to be
- * interpreted. */
- Tcl_Interp *interp; /* Interpreter in which procedure was
- * invoked. */
- int objc; /* Count of number of arguments to this
- * procedure. */
- Tcl_Obj *CONST objv[]; /* Argument value objects. */
+ ClientData clientData; /* Record describing procedure to be
+ * interpreted. */
+ register Tcl_Interp *interp; /* Interpreter in which procedure was
+ * invoked. */
+ int objc; /* Count of number of arguments to this
+ * procedure. */
+ Tcl_Obj *CONST objv[]; /* Argument value objects. */
{
Interp *iPtr = (Interp *) interp;
- Proc *procPtr = (Proc *) clientData;
+ register Proc *procPtr = (Proc *) clientData;
Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
CallFrame frame;
register CallFrame *framePtr = &frame;
+ register Var *varPtr;
register CompiledLocal *localPtr;
- char *procName, *bytes;
- int nameLen, localCt, numArgs, argCt, length, i, result;
- Var *varPtr;
+ char *procName;
+ int nameLen, localCt, numArgs, argCt, i, result;
/*
* This procedure generates an array "compiledLocals" that holds the
@@ -849,7 +852,6 @@ TclObjInterpProc(clientData, interp, objc, objv)
/*
* Get the procedure's name.
- * THIS FAILS IF THE PROC NAME'S STRING REP HAS A NULL.
*/
procName = Tcl_GetStringFromObj(objv[0], &nameLen);
@@ -861,7 +863,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
* procPtr->numCompiledLocals if new local variables are found
* while compiling.
*/
-
+
result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
"body of proc", procName);
@@ -907,7 +909,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
framePtr->compiledLocals = compiledLocals;
TclInitCompiledLocals(interp, framePtr, nsPtr);
-
+
/*
* Match and assign the call's actual parameters to the procedure's
* formal arguments. The formal arguments are described by the first
@@ -960,8 +962,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"no value given for parameter \"", localPtr->name,
- "\" to \"", Tcl_GetStringFromObj(objv[0], (int *) NULL),
- "\"", (char *) NULL);
+ "\" to \"", Tcl_GetString(objv[0]), "\"", (char *) NULL);
result = TCL_ERROR;
goto procDone;
}
@@ -970,7 +971,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
}
if (argCt > 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "called \"", Tcl_GetStringFromObj(objv[0], (int *) NULL),
+ "called \"", Tcl_GetString(objv[0]),
"\" with too many arguments", (char *) NULL);
result = TCL_ERROR;
goto procDone;
@@ -981,57 +982,38 @@ TclObjInterpProc(clientData, interp, objc, objv)
*/
if (tclTraceExec >= 1) {
+#ifdef TCL_COMPILE_DEBUG
fprintf(stdout, "Calling proc ");
for (i = 0; i < objc; i++) {
- bytes = Tcl_GetStringFromObj(objv[i], &length);
- TclPrintSource(stdout, bytes, TclMin(length, 15));
+ TclPrintObject(stdout, objv[i], 15);
fprintf(stdout, " ");
}
fprintf(stdout, "\n");
+#else /* TCL_COMPILE_DEBUG */
+ fprintf(stdout, "Calling proc %.*s\n", nameLen, procName);
+#endif /*TCL_COMPILE_DEBUG*/
fflush(stdout);
}
iPtr->returnCode = TCL_OK;
procPtr->refCount++;
- result = Tcl_EvalObj(interp, procPtr->bodyPtr);
+ result = Tcl_EvalObjEx(interp, procPtr->bodyPtr, 0);
procPtr->refCount--;
if (procPtr->refCount <= 0) {
TclProcCleanupProc(procPtr);
}
if (result != TCL_OK) {
- if (result == TCL_RETURN) {
- result = TclUpdateReturnInfo(iPtr);
- } else if (result == TCL_ERROR) {
- char msg[100];
- sprintf(msg, "\n (procedure \"%.50s\" line %d)",
- procName, iPtr->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- } else if (result == TCL_BREAK) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "invoked \"break\" outside of a loop", -1);
- result = TCL_ERROR;
- } else if (result == TCL_CONTINUE) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "invoked \"continue\" outside of a loop", -1);
- result = TCL_ERROR;
- }
+ result = ProcessProcResultCode(interp, procName, nameLen, result);
}
- procDone:
-
/*
- * Pop and free the call frame for this procedure invocation.
+ * Pop and free the call frame for this procedure invocation, then
+ * free the compiledLocals array if malloc'ed storage was used.
*/
+ procDone:
Tcl_PopCallFrame(interp);
-
- /*
- * Free the compiledLocals array if malloc'ed storage was used.
- */
-
if (compiledLocals != localStorage) {
ckfree((char *) compiledLocals);
}
@@ -1092,11 +1074,11 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
*/
if (bodyPtr->typePtr == &tclByteCodeType) {
- if ((codePtr->iPtr != iPtr)
+ if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)) {
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if (codePtr->iPtr != iPtr) {
+ if ((Interp *) *codePtr->interpHandle != iPtr) {
Tcl_AppendResult(interp,
"a precompiled script jumped interps", NULL);
return TCL_ERROR;
@@ -1104,13 +1086,12 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = nsPtr;
} else {
- tclByteCodeType.freeIntRepProc(bodyPtr);
+ (*tclByteCodeType.freeIntRepProc)(bodyPtr);
bodyPtr->typePtr = (Tcl_ObjType *) NULL;
}
}
}
if (bodyPtr->typePtr != &tclByteCodeType) {
- char buf[100];
int numChars;
char *ellipsis;
@@ -1156,7 +1137,9 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
if (result != TCL_OK) {
if (result == TCL_ERROR) {
- numChars = strlen(procName);
+ char buf[100 + TCL_INTEGER_SPACE];
+
+ numChars = strlen(procName);
ellipsis = "";
if (numChars > 50) {
numChars = 50;
@@ -1192,7 +1175,66 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
}
return TCL_OK;
}
-
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcessProcResultCode --
+ *
+ * Procedure called by TclObjInterpProc to process a return code other
+ * than TCL_OK returned by a Tcl procedure.
+ *
+ * Results:
+ * Depending on the argument return code, the result returned is
+ * another return code and the interpreter's result is set to a value
+ * to supplement that return code.
+ *
+ * Side effects:
+ * If the result returned is TCL_ERROR, traceback information about
+ * the procedure just executed is appended to the interpreter's
+ * "errorInfo" variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcessProcResultCode(interp, procName, nameLen, returnCode)
+ Tcl_Interp *interp; /* The interpreter in which the procedure
+ * was called and returned returnCode. */
+ char *procName; /* Name of the procedure. Used for error
+ * messages and trace information. */
+ int nameLen; /* Number of bytes in procedure's name. */
+ int returnCode; /* The unexpected result code. */
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (returnCode == TCL_RETURN) {
+ returnCode = TclUpdateReturnInfo(iPtr);
+ } else if (returnCode == TCL_ERROR) {
+ char msg[100 + TCL_INTEGER_SPACE];
+ char *ellipsis = "";
+ int numChars = nameLen;
+
+ if (numChars > 60) {
+ numChars = 60;
+ ellipsis = "...";
+ }
+ sprintf(msg, "\n (procedure \"%.*s%s\" line %d)",
+ numChars, procName, ellipsis, iPtr->errorLine);
+ Tcl_AddObjErrorInfo(interp, msg, -1);
+ } else if (returnCode == TCL_BREAK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "invoked \"break\" outside of a loop", -1);
+ returnCode = TCL_ERROR;
+ } else if (returnCode == TCL_CONTINUE) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "invoked \"continue\" outside of a loop", -1);
+ returnCode = TCL_ERROR;
+ }
+ return returnCode;
+}
/*
*----------------------------------------------------------------------
@@ -1343,7 +1385,7 @@ TclUpdateReturnInfo(iPtr)
TclCmdProcType
TclGetInterpProc()
{
- return TclProcInterpProc;
+ return (TclCmdProcType) TclProcInterpProc;
}
/*
@@ -1368,7 +1410,7 @@ TclGetInterpProc()
TclObjCmdProcType
TclGetObjInterpProc()
{
- return TclObjInterpProc;
+ return (TclObjCmdProcType) TclObjInterpProc;
}
/*
diff --git a/tcl/generic/tclRegexp.c b/tcl/generic/tclRegexp.c
new file mode 100644
index 00000000000..47254712ced
--- /dev/null
+++ b/tcl/generic/tclRegexp.c
@@ -0,0 +1,1029 @@
+/*
+ * tclRegexp.c --
+ *
+ * This file contains the public interfaces to the Tcl regular
+ * expression mechanism.
+ *
+ * Copyright (c) 1998 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclRegexp.h"
+
+/*
+ *----------------------------------------------------------------------
+ * The routines in this file use Henry Spencer's regular expression
+ * package contained in the following additional source files:
+ *
+ * regc_color.c regc_cvec.c regc_lex.c
+ * regc_nfa.c regcomp.c regcustom.h
+ * rege_dfa.c regerror.c regerrs.h
+ * regex.h regexec.c regfree.c
+ * regfronts.c regguts.h
+ *
+ * Copyright (c) 1998 Henry Spencer. All rights reserved.
+ *
+ * Development of this software was funded, in part, by Cray Research Inc.,
+ * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
+ * Corporation, none of whom are responsible for the results. The author
+ * thanks all of them.
+ *
+ * Redistribution and use in source and binary forms -- with or without
+ * modification -- are permitted for any purpose, provided that
+ * redistributions in source form retain this entire copyright notice and
+ * indicate the origin and nature of any modifications.
+ *
+ * I'd appreciate being given credit for this package in the documentation
+ * of software which uses it, but that is not a requirement.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
+ * HENRY SPENCER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * *** NOTE: this code has been altered slightly for use in Tcl: ***
+ * *** 1. Names have been changed, e.g. from re_comp to ***
+ * *** TclRegComp, to avoid clashes with other ***
+ * *** regexp implementations used by applications. ***
+ */
+
+/*
+ * Thread local storage used to maintain a per-thread cache of compiled
+ * regular expressions.
+ */
+
+#define NUM_REGEXPS 30
+
+typedef struct ThreadSpecificData {
+ int initialized; /* Set to 1 when the module is initialized. */
+ char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled
+ * regular expression patterns. NULL
+ * means that this slot isn't used.
+ * Malloc-ed. */
+ int patLengths[NUM_REGEXPS];/* Number of non-null characters in
+ * corresponding entry in patterns.
+ * -1 means entry isn't used. */
+ struct TclRegexp *regexps[NUM_REGEXPS];
+ /* Compiled forms of above strings. Also
+ * malloc-ed, or NULL if not in use yet. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static TclRegexp * CompileRegexp _ANSI_ARGS_((Tcl_Interp *interp,
+ char *pattern, int length, int flags));
+static void DupRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void FinalizeRegexp _ANSI_ARGS_((ClientData clientData));
+static void FreeRegexp _ANSI_ARGS_((TclRegexp *regexpPtr));
+static void FreeRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int RegExpExecUniChar _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_RegExp re, CONST Tcl_UniChar *uniString,
+ int numChars, int nmatches, int flags));
+static int SetRegexpFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The regular expression Tcl object type. This serves as a cache
+ * of the compiled form of the regular expression.
+ */
+
+Tcl_ObjType tclRegexpType = {
+ "regexp", /* name */
+ FreeRegexpInternalRep, /* freeIntRepProc */
+ DupRegexpInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetRegexpFromAny /* setFromAnyProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpCompile --
+ *
+ * Compile a regular expression into a form suitable for fast
+ * matching. This procedure is DEPRECATED in favor of the
+ * object version of the command.
+ *
+ * Results:
+ * The return value is a pointer to the compiled form of string,
+ * suitable for passing to Tcl_RegExpExec. This compiled form
+ * is only valid up until the next call to this procedure, so
+ * don't keep these around for a long time! If an error occurred
+ * while compiling the pattern, then NULL is returned and an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * Updates the cache of compiled regexps.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_RegExp
+Tcl_RegExpCompile(interp, string)
+ Tcl_Interp *interp; /* For use in error reporting and
+ * to access the interp regexp cache. */
+ char *string; /* String for which to produce
+ * compiled regular expression. */
+{
+ return (Tcl_RegExp) CompileRegexp(interp, string, (int) strlen(string),
+ REG_ADVANCED);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpExec --
+ *
+ * Execute the regular expression matcher using a compiled form
+ * of a regular expression and save information about any match
+ * that is found.
+ *
+ * Results:
+ * If an error occurs during the matching operation then -1
+ * is returned and the interp's result contains an error message.
+ * Otherwise the return value is 1 if a matching range is
+ * found and 0 if there is no matching range.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RegExpExec(interp, re, string, start)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tcl_RegExp re; /* Compiled regular expression; must have
+ * been returned by previous call to
+ * Tcl_GetRegExpFromObj. */
+ CONST char *string; /* String against which to match re. */
+ CONST char *start; /* If string is part of a larger string,
+ * this identifies beginning of larger
+ * string, so that "^" won't match. */
+{
+ int flags, result, numChars;
+ TclRegexp *regexp = (TclRegexp *)re;
+ Tcl_DString ds;
+ Tcl_UniChar *ustr;
+
+ /*
+ * If the starting point is offset from the beginning of the buffer,
+ * then we need to tell the regexp engine not to match "^".
+ */
+
+ if (string > start) {
+ flags = REG_NOTBOL;
+ } else {
+ flags = 0;
+ }
+
+ /*
+ * Remember the string for use by Tcl_RegExpRange().
+ */
+
+ regexp->string = string;
+ regexp->objPtr = NULL;
+
+ /*
+ * Convert the string to Unicode and perform the match.
+ */
+
+ Tcl_DStringInit(&ds);
+ ustr = Tcl_UtfToUniCharDString(string, -1, &ds);
+ numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar);
+ result = RegExpExecUniChar(interp, re, ustr, numChars,
+ -1 /* nmatches */, flags);
+ Tcl_DStringFree(&ds);
+
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_RegExpRange --
+ *
+ * Returns pointers describing the range of a regular expression match,
+ * or one of the subranges within the match.
+ *
+ * Results:
+ * The variables at *startPtr and *endPtr are modified to hold the
+ * addresses of the endpoints of the range given by index. If the
+ * specified range doesn't exist then NULLs are returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tcl_RegExpRange(re, index, startPtr, endPtr)
+ Tcl_RegExp re; /* Compiled regular expression that has
+ * been passed to Tcl_RegExpExec. */
+ int index; /* 0 means give the range of the entire
+ * match, > 0 means give the range of
+ * a matching subrange. */
+ char **startPtr; /* Store address of first character in
+ * (sub-) range here. */
+ char **endPtr; /* Store address of character just after last
+ * in (sub-) range here. */
+{
+ TclRegexp *regexpPtr = (TclRegexp *) re;
+ CONST char *string;
+
+ if ((size_t) index > regexpPtr->re.re_nsub) {
+ *startPtr = *endPtr = NULL;
+ } else if (regexpPtr->matches[index].rm_so < 0) {
+ *startPtr = *endPtr = NULL;
+ } else {
+ if (regexpPtr->objPtr) {
+ string = Tcl_GetString(regexpPtr->objPtr);
+ } else {
+ string = regexpPtr->string;
+ }
+ *startPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_so);
+ *endPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_eo);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * RegExpExecUniChar --
+ *
+ * Execute the regular expression matcher using a compiled form of a
+ * regular expression and save information about any match that is
+ * found.
+ *
+ * Results:
+ * If an error occurs during the matching operation then -1 is
+ * returned and an error message is left in interp's result.
+ * Otherwise the return value is 1 if a matching range was found or
+ * 0 if there was no matching range.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tcl_RegExp re; /* Compiled regular expression; returned by
+ * a previous call to Tcl_GetRegExpFromObj */
+ CONST Tcl_UniChar *wString; /* String against which to match re. */
+ int numChars; /* Length of Tcl_UniChar string (must
+ * be >= 0). */
+ int nmatches; /* How many subexpression matches (counting
+ * the whole match as subexpression 0) are
+ * of interest. -1 means "don't know". */
+ int flags; /* Regular expression flags. */
+{
+ int status;
+ TclRegexp *regexpPtr = (TclRegexp *) re;
+ size_t last = regexpPtr->re.re_nsub + 1;
+ size_t nm = last;
+
+ if (nmatches >= 0 && (size_t) nmatches < nm) {
+ nm = (size_t) nmatches;
+ }
+
+ status = TclReExec(&regexpPtr->re, wString, (size_t) numChars,
+ &regexpPtr->details, nm, regexpPtr->matches, flags);
+
+ /*
+ * Check for errors.
+ */
+
+ if (status != REG_OKAY) {
+ if (status == REG_NOMATCH) {
+ return 0;
+ }
+ if (interp != NULL) {
+ TclRegError(interp, "error while matching regular expression: ",
+ status);
+ }
+ return -1;
+ }
+ return 1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclRegExpRangeUniChar --
+ *
+ * Returns pointers describing the range of a regular expression match,
+ * or one of the subranges within the match, or the hypothetical range
+ * represented by the rm_extend field of the rm_detail_t.
+ *
+ * Results:
+ * The variables at *startPtr and *endPtr are modified to hold the
+ * offsets of the endpoints of the range given by index. If the
+ * specified range doesn't exist then -1s are supplied.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclRegExpRangeUniChar(re, index, startPtr, endPtr)
+ Tcl_RegExp re; /* Compiled regular expression that has
+ * been passed to Tcl_RegExpExec. */
+ int index; /* 0 means give the range of the entire
+ * match, > 0 means give the range of
+ * a matching subrange, -1 means the
+ * range of the rm_extend field. */
+ int *startPtr; /* Store address of first character in
+ * (sub-) range here. */
+ int *endPtr; /* Store address of character just after last
+ * in (sub-) range here. */
+{
+ TclRegexp *regexpPtr = (TclRegexp *) re;
+
+ if ((regexpPtr->flags&REG_EXPECT) && index == -1) {
+ *startPtr = regexpPtr->details.rm_extend.rm_so;
+ *endPtr = regexpPtr->details.rm_extend.rm_eo;
+ } else if ((size_t) index > regexpPtr->re.re_nsub) {
+ *startPtr = -1;
+ *endPtr = -1;
+ } else {
+ *startPtr = regexpPtr->matches[index].rm_so;
+ *endPtr = regexpPtr->matches[index].rm_eo;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpMatch --
+ *
+ * See if a string matches a regular expression.
+ *
+ * Results:
+ * If an error occurs during the matching operation then -1
+ * is returned and the interp's result contains an error message.
+ * Otherwise the return value is 1 if "string" matches "pattern"
+ * and 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RegExpMatch(interp, string, pattern)
+ Tcl_Interp *interp; /* Used for error reporting. May be NULL. */
+ char *string; /* String. */
+ char *pattern; /* Regular expression to match against
+ * string. */
+{
+ Tcl_RegExp re;
+
+ re = Tcl_RegExpCompile(interp, pattern);
+ if (re == NULL) {
+ return -1;
+ }
+ return Tcl_RegExpExec(interp, re, string, string);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpExecObj --
+ *
+ * Execute a precompiled regexp against the given object.
+ *
+ * Results:
+ * If an error occurs during the matching operation then -1
+ * is returned and the interp's result contains an error message.
+ * Otherwise the return value is 1 if "string" matches "pattern"
+ * and 0 otherwise.
+ *
+ * Side effects:
+ * Converts the object to a Unicode object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tcl_RegExp re; /* Compiled regular expression; must have
+ * been returned by previous call to
+ * Tcl_GetRegExpFromObj. */
+ Tcl_Obj *objPtr; /* String against which to match re. */
+ int offset; /* Character index that marks where matching
+ * should begin. */
+ int nmatches; /* How many subexpression matches (counting
+ * the whole match as subexpression 0) are
+ * of interest. -1 means all of them. */
+ int flags; /* Regular expression execution flags. */
+{
+ TclRegexp *regexpPtr = (TclRegexp *) re;
+ Tcl_UniChar *udata;
+ int length;
+
+ /*
+ * Save the target object so we can extract strings from it later.
+ */
+
+ regexpPtr->string = NULL;
+ regexpPtr->objPtr = objPtr;
+
+ udata = Tcl_GetUnicode(objPtr);
+ length = Tcl_GetCharLength(objPtr);
+
+ if (offset > length) {
+ offset = length;
+ }
+ udata += offset;
+ length -= offset;
+
+ return RegExpExecUniChar(interp, re, udata, length, nmatches, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpMatchObj --
+ *
+ * See if an object matches a regular expression.
+ *
+ * Results:
+ * If an error occurs during the matching operation then -1
+ * is returned and the interp's result contains an error message.
+ * Otherwise the return value is 1 if "string" matches "pattern"
+ * and 0 otherwise.
+ *
+ * Side effects:
+ * Changes the internal rep of the pattern and string objects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_RegExpMatchObj(interp, stringObj, patternObj)
+ Tcl_Interp *interp; /* Used for error reporting. May be NULL. */
+ Tcl_Obj *stringObj; /* Object containing the String to search. */
+ Tcl_Obj *patternObj; /* Regular expression to match against
+ * string. */
+{
+ Tcl_RegExp re;
+
+ re = Tcl_GetRegExpFromObj(interp, patternObj,
+ TCL_REG_ADVANCED | TCL_REG_NOSUB);
+ if (re == NULL) {
+ return -1;
+ }
+ return Tcl_RegExpExecObj(interp, re, stringObj, 0 /* offset */,
+ 0 /* nmatches */, 0 /* flags */);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RegExpGetInfo --
+ *
+ * Retrieve information about the current match.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_RegExpGetInfo(regexp, infoPtr)
+ Tcl_RegExp regexp; /* Pattern from which to get subexpressions. */
+ Tcl_RegExpInfo *infoPtr; /* Match information is stored here. */
+{
+ TclRegexp *regexpPtr = (TclRegexp *) regexp;
+
+ infoPtr->nsubs = regexpPtr->re.re_nsub;
+ infoPtr->matches = (Tcl_RegExpIndices *) regexpPtr->matches;
+ infoPtr->extendStart = regexpPtr->details.rm_extend.rm_so;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetRegExpFromObj --
+ *
+ * Compile a regular expression into a form suitable for fast
+ * matching. This procedure caches the result in a Tcl_Obj.
+ *
+ * Results:
+ * The return value is a pointer to the compiled form of string,
+ * suitable for passing to Tcl_RegExpExec. If an error occurred
+ * while compiling the pattern, then NULL is returned and an error
+ * message is left in the interp's result.
+ *
+ * Side effects:
+ * Updates the native rep of the Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_RegExp
+Tcl_GetRegExpFromObj(interp, objPtr, flags)
+ Tcl_Interp *interp; /* For use in error reporting, and to access
+ * the interp regexp cache. */
+ Tcl_Obj *objPtr; /* Object whose string rep contains regular
+ * expression pattern. Internal rep will be
+ * changed to compiled form of this regular
+ * expression. */
+ int flags; /* Regular expression compilation flags. */
+{
+ int length;
+ Tcl_ObjType *typePtr;
+ TclRegexp *regexpPtr;
+ char *pattern;
+
+ typePtr = objPtr->typePtr;
+ regexpPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
+
+ if ((typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
+ pattern = Tcl_GetStringFromObj(objPtr, &length);
+
+ regexpPtr = CompileRegexp(interp, pattern, length, flags);
+ if (regexpPtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Add a reference to the regexp so it will persist even if it is
+ * pushed out of the current thread's regexp cache. This reference
+ * will be removed when the object's internal rep is freed.
+ */
+
+ regexpPtr->refCount++;
+
+ /*
+ * Free the old representation and set our type.
+ */
+
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->internalRep.otherValuePtr = (VOID *) regexpPtr;
+ objPtr->typePtr = &tclRegexpType;
+ }
+ return (Tcl_RegExp) regexpPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegAbout --
+ *
+ * Return information about a compiled regular expression.
+ *
+ * Results:
+ * The return value is -1 for failure, 0 for success, although at
+ * the moment there's nothing that could fail. On success, a list
+ * is left in the interp's result: first element is the subexpression
+ * count, second is a list of re_info bit names.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegAbout(interp, re)
+ Tcl_Interp *interp; /* For use in variable assignment. */
+ Tcl_RegExp re; /* The compiled regular expression. */
+{
+ TclRegexp *regexpPtr = (TclRegexp *)re;
+ char buf[TCL_INTEGER_SPACE];
+ static struct infoname {
+ int bit;
+ char *text;
+ } infonames[] = {
+ {REG_UBACKREF, "REG_UBACKREF"},
+ {REG_ULOOKAHEAD, "REG_ULOOKAHEAD"},
+ {REG_UBOUNDS, "REG_UBOUNDS"},
+ {REG_UBRACES, "REG_UBRACES"},
+ {REG_UBSALNUM, "REG_UBSALNUM"},
+ {REG_UPBOTCH, "REG_UPBOTCH"},
+ {REG_UBBS, "REG_UBBS"},
+ {REG_UNONPOSIX, "REG_UNONPOSIX"},
+ {REG_UUNSPEC, "REG_UUNSPEC"},
+ {REG_UUNPORT, "REG_UUNPORT"},
+ {REG_ULOCALE, "REG_ULOCALE"},
+ {REG_UEMPTYMATCH, "REG_UEMPTYMATCH"},
+ {REG_UIMPOSSIBLE, "REG_UIMPOSSIBLE"},
+ {REG_USHORTEST, "REG_USHORTEST"},
+ {0, ""}
+ };
+ struct infoname *inf;
+ int n;
+
+ Tcl_ResetResult(interp);
+
+ sprintf(buf, "%u", (unsigned)(regexpPtr->re.re_nsub));
+ Tcl_AppendElement(interp, buf);
+
+ /*
+ * Must count bits before generating list, because we must know
+ * whether {} are needed before we start appending names.
+ */
+ n = 0;
+ for (inf = infonames; inf->bit != 0; inf++) {
+ if (regexpPtr->re.re_info&inf->bit) {
+ n++;
+ }
+ }
+ if (n != 1) {
+ Tcl_AppendResult(interp, " {", NULL);
+ }
+ for (inf = infonames; inf->bit != 0; inf++) {
+ if (regexpPtr->re.re_info&inf->bit) {
+ Tcl_AppendElement(interp, inf->text);
+ }
+ }
+ if (n != 1) {
+ Tcl_AppendResult(interp, "}", NULL);
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegError --
+ *
+ * Generate an error message based on the regexp status code.
+ *
+ * Results:
+ * Places an error in the interpreter.
+ *
+ * Side effects:
+ * Sets errorCode as well.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclRegError(interp, msg, status)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ char *msg; /* Message to prepend to error. */
+ int status; /* Status code to report. */
+{
+ char buf[100]; /* ample in practice */
+ char cbuf[100]; /* lots in practice */
+ size_t n;
+ char *p;
+
+ Tcl_ResetResult(interp);
+ n = TclReError(status, (regex_t *)NULL, buf, sizeof(buf));
+ p = (n > sizeof(buf)) ? "..." : "";
+ Tcl_AppendResult(interp, msg, buf, p, NULL);
+
+ sprintf(cbuf, "%d", status);
+ (VOID) TclReError(REG_ITOA, (regex_t *)NULL, cbuf, sizeof(cbuf));
+ Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeRegexpInternalRep --
+ *
+ * Deallocate the storage associated with a regexp object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the compiled regular expression.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeRegexpInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* Regexp object with internal rep to free. */
+{
+ TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
+
+ /*
+ * If this is the last reference to the regexp, free it.
+ */
+
+ if (--(regexpRepPtr->refCount) <= 0) {
+ FreeRegexp(regexpRepPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupRegexpInternalRep --
+ *
+ * We copy the reference to the compiled regexp and bump its
+ * reference count.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Increments the reference count of the regexp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupRegexpInternalRep(srcPtr, copyPtr)
+ Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.otherValuePtr;
+ regexpPtr->refCount++;
+ copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;
+ copyPtr->typePtr = &tclRegexpType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetRegexpFromAny --
+ *
+ * Attempt to generate a compiled regular expression for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is TCL_OK or TCL_ERROR. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a regular expression is stored as "objPtr"s
+ * internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetRegexpFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CompileRegexp --
+ *
+ * Attempt to compile the given regexp pattern. If the compiled
+ * regular expression can be found in the per-thread cache, it
+ * will be used instead of compiling a new copy.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated TclRegexp
+ * that represents the compiled pattern, or NULL if the pattern
+ * could not be compiled. If NULL is returned, an error message is
+ * left in the interp's result.
+ *
+ * Side effects:
+ * The thread-local regexp cache is updated and a new TclRegexp may
+ * be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TclRegexp *
+CompileRegexp(interp, string, length, flags)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ char *string; /* The regexp to compile (UTF-8). */
+ int length; /* The length of the string in bytes. */
+ int flags; /* Compilation flags. */
+{
+ TclRegexp *regexpPtr;
+ Tcl_UniChar *uniString;
+ int numChars;
+ Tcl_DString stringBuf;
+ int status, i;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ Tcl_CreateThreadExitHandler(FinalizeRegexp, NULL);
+ }
+
+ /*
+ * This routine maintains a second-level regular expression cache in
+ * addition to the per-object regexp cache. The per-thread cache is needed
+ * to handle the case where for various reasons the object is lost between
+ * invocations of the regexp command, but the literal pattern is the same.
+ */
+
+ /*
+ * Check the per-thread compiled regexp cache. We can only reuse
+ * a regexp if it has the same pattern and the same flags.
+ */
+
+ for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
+ if ((length == tsdPtr->patLengths[i])
+ && (tsdPtr->regexps[i]->flags == flags)
+ && (strcmp(string, tsdPtr->patterns[i]) == 0)) {
+ /*
+ * Move the matched pattern to the first slot in the
+ * cache and shift the other patterns down one position.
+ */
+
+ if (i != 0) {
+ int j;
+ char *cachedString;
+
+ cachedString = tsdPtr->patterns[i];
+ regexpPtr = tsdPtr->regexps[i];
+ for (j = i-1; j >= 0; j--) {
+ tsdPtr->patterns[j+1] = tsdPtr->patterns[j];
+ tsdPtr->patLengths[j+1] = tsdPtr->patLengths[j];
+ tsdPtr->regexps[j+1] = tsdPtr->regexps[j];
+ }
+ tsdPtr->patterns[0] = cachedString;
+ tsdPtr->patLengths[0] = length;
+ tsdPtr->regexps[0] = regexpPtr;
+ }
+ return tsdPtr->regexps[0];
+ }
+ }
+
+ /*
+ * This is a new expression, so compile it and add it to the cache.
+ */
+
+ regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));
+ regexpPtr->objPtr = NULL;
+ regexpPtr->string = NULL;
+ regexpPtr->details.rm_extend.rm_so = -1;
+ regexpPtr->details.rm_extend.rm_eo = -1;
+
+ /*
+ * Get the up-to-date string representation and map to unicode.
+ */
+
+ Tcl_DStringInit(&stringBuf);
+ uniString = Tcl_UtfToUniCharDString(string, length, &stringBuf);
+ numChars = Tcl_DStringLength(&stringBuf) / sizeof(Tcl_UniChar);
+
+ /*
+ * Compile the string and check for errors.
+ */
+
+ regexpPtr->flags = flags;
+ status = TclReComp(&regexpPtr->re, uniString, (size_t) numChars, flags);
+ Tcl_DStringFree(&stringBuf);
+
+ if (status != REG_OKAY) {
+ /*
+ * Clean up and report errors in the interpreter, if possible.
+ */
+
+ ckfree((char *)regexpPtr);
+ if (interp) {
+ TclRegError(interp,
+ "couldn't compile regular expression pattern: ",
+ status);
+ }
+ return NULL;
+ }
+
+ /*
+ * Allocate enough space for all of the subexpressions, plus one
+ * extra for the entire pattern.
+ */
+
+ regexpPtr->matches = (regmatch_t *) ckalloc(
+ sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
+
+ /*
+ * Initialize the refcount to one initially, since it is in the cache.
+ */
+
+ regexpPtr->refCount = 1;
+
+ /*
+ * Free the last regexp, if necessary, and make room at the head of the
+ * list for the new regexp.
+ */
+
+ if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
+ TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];
+ if (--(oldRegexpPtr->refCount) <= 0) {
+ FreeRegexp(oldRegexpPtr);
+ }
+ ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
+ }
+ for (i = NUM_REGEXPS - 2; i >= 0; i--) {
+ tsdPtr->patterns[i+1] = tsdPtr->patterns[i];
+ tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
+ tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
+ }
+ tsdPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
+ strcpy(tsdPtr->patterns[0], string);
+ tsdPtr->patLengths[0] = length;
+ tsdPtr->regexps[0] = regexpPtr;
+
+ return regexpPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeRegexp --
+ *
+ * Release the storage associated with a TclRegexp.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeRegexp(regexpPtr)
+ TclRegexp *regexpPtr; /* Compiled regular expression to free. */
+{
+ TclReFree(&regexpPtr->re);
+ if (regexpPtr->matches) {
+ ckfree((char *) regexpPtr->matches);
+ }
+ ckfree((char *) regexpPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeRegexp --
+ *
+ * Release the storage associated with the per-thread regexp
+ * cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeRegexp(clientData)
+ ClientData clientData; /* Not used. */
+{
+ int i;
+ TclRegexp *regexpPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
+ regexpPtr = tsdPtr->regexps[i];
+ if (--(regexpPtr->refCount) <= 0) {
+ FreeRegexp(regexpPtr);
+ }
+ ckfree(tsdPtr->patterns[i]);
+ }
+}
diff --git a/tcl/generic/tclRegexp.h b/tcl/generic/tclRegexp.h
index f04c1ac1904..a56c4cf1f7d 100644
--- a/tcl/generic/tclRegexp.h
+++ b/tcl/generic/tclRegexp.h
@@ -1,18 +1,22 @@
-/*
- * Definitions etc. for regexp(3) routines.
+/*
+ * tclRegexp.h --
+ *
+ * This file contains definitions used internally by Henry
+ * Spencer's regular expression code.
+ *
+ * Copyright (c) 1998 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
- * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
- * not the System V one.
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id$
*/
-#ifndef _REGEXP
-#define _REGEXP 1
+#ifndef _TCLREGEXP
+#define _TCLREGEXP
-#ifndef _TCL
-#include "tcl.h"
-#endif
+#include "regex.h"
#ifdef BUILD_tcl
# undef TCL_STORAGE_CLASS
@@ -20,29 +24,28 @@
#endif
/*
- * NSUBEXP must be at least 10, and no greater than 117 or the parser
- * will not work properly.
+ * The TclRegexp structure encapsulates a compiled regex_t,
+ * the flags that were used to compile it, and an array of pointers
+ * that are used to indicate subexpressions after a call to Tcl_RegExpExec.
+ * Note that the string and objPtr are mutually exclusive. These values
+ * are needed by Tcl_RegExpRange in order to return pointers into the
+ * original string.
*/
-#define NSUBEXP 20
-
-typedef struct regexp {
- char *startp[NSUBEXP];
- char *endp[NSUBEXP];
- char regstart; /* Internal use only. */
- char reganch; /* Internal use only. */
- char *regmust; /* Internal use only. */
- int regmlen; /* Internal use only. */
- char program[1]; /* Unwarranted chumminess with compiler. */
-} regexp;
-
-EXTERN regexp *TclRegComp _ANSI_ARGS_((char *exp));
-EXTERN int TclRegExec _ANSI_ARGS_((regexp *prog, char *string, char *start));
-EXTERN void TclRegSub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
-EXTERN void TclRegError _ANSI_ARGS_((char *msg));
-EXTERN char *TclGetRegError _ANSI_ARGS_((void));
-
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
-
-#endif /* REGEXP */
+typedef struct TclRegexp {
+ int flags; /* Regexp compile flags. */
+ regex_t re; /* Compiled re, includes number of
+ * subexpressions. */
+ CONST char *string; /* Last string passed to Tcl_RegExpExec. */
+ Tcl_Obj *objPtr; /* Last object passed to Tcl_RegExpExecObj. */
+ regmatch_t *matches; /* Array of indices into the Tcl_UniChar
+ * representation of the last string matched
+ * with this regexp to indicate the location
+ * of subexpressions. */
+ rm_detail_t details; /* Detailed information on match (currently
+ * used only for REG_EXPECT). */
+ int refCount; /* Count of number of references to this
+ * compiled regexp. */
+} TclRegexp;
+
+#endif /* _TCLREGEXP */
diff --git a/tcl/generic/tclResult.c b/tcl/generic/tclResult.c
new file mode 100644
index 00000000000..2b537b73e7a
--- /dev/null
+++ b/tcl/generic/tclResult.c
@@ -0,0 +1,1052 @@
+/*
+ * tclResult.c --
+ *
+ * This file contains code to manage the interpreter result.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * Function prototypes for local procedures in this file:
+ */
+
+static void ResetObjResult _ANSI_ARGS_((Interp *iPtr));
+static void SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
+ int newSpace));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SaveResult --
+ *
+ * Takes a snapshot of the current result state of the interpreter.
+ * The snapshot can be restored at any point by
+ * Tcl_RestoreResult. Note that this routine does not
+ * preserve the errorCode, errorInfo, or flags fields so it
+ * should not be used if an error is in progress.
+ *
+ * Once a snapshot is saved, it must be restored by calling
+ * Tcl_RestoreResult, or discarded by calling
+ * Tcl_DiscardResult.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resets the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SaveResult(interp, statePtr)
+ Tcl_Interp *interp; /* Interpreter to save. */
+ Tcl_SavedResult *statePtr; /* Pointer to state structure. */
+{
+ Interp *iPtr = (Interp *) interp;
+
+ /*
+ * Move the result object into the save state. Note that we don't need
+ * to change its refcount because we're moving it, not adding a new
+ * reference. Put an empty object into the interpreter.
+ */
+
+ statePtr->objResultPtr = iPtr->objResultPtr;
+ iPtr->objResultPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(iPtr->objResultPtr);
+
+ /*
+ * Save the string result.
+ */
+
+ statePtr->freeProc = iPtr->freeProc;
+ if (iPtr->result == iPtr->resultSpace) {
+ /*
+ * Copy the static string data out of the interp buffer.
+ */
+
+ statePtr->result = statePtr->resultSpace;
+ strcpy(statePtr->result, iPtr->result);
+ statePtr->appendResult = NULL;
+ } else if (iPtr->result == iPtr->appendResult) {
+ /*
+ * Move the append buffer out of the interp.
+ */
+
+ statePtr->appendResult = iPtr->appendResult;
+ statePtr->appendAvl = iPtr->appendAvl;
+ statePtr->appendUsed = iPtr->appendUsed;
+ statePtr->result = statePtr->appendResult;
+ iPtr->appendResult = NULL;
+ iPtr->appendAvl = 0;
+ iPtr->appendUsed = 0;
+ } else {
+ /*
+ * Move the dynamic or static string out of the interpreter.
+ */
+
+ statePtr->result = iPtr->result;
+ statePtr->appendResult = NULL;
+ }
+
+ iPtr->result = iPtr->resultSpace;
+ iPtr->resultSpace[0] = 0;
+ iPtr->freeProc = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_RestoreResult --
+ *
+ * Restores the state of the interpreter to a snapshot taken
+ * by Tcl_SaveResult. After this call, the token for
+ * the interpreter state is no longer valid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_RestoreResult(interp, statePtr)
+ Tcl_Interp* interp; /* Interpreter being restored. */
+ Tcl_SavedResult *statePtr; /* State returned by Tcl_SaveResult. */
+{
+ Interp *iPtr = (Interp *) interp;
+
+ Tcl_ResetResult(interp);
+
+ /*
+ * Restore the string result.
+ */
+
+ iPtr->freeProc = statePtr->freeProc;
+ if (statePtr->result == statePtr->resultSpace) {
+ /*
+ * Copy the static string data into the interp buffer.
+ */
+
+ iPtr->result = iPtr->resultSpace;
+ strcpy(iPtr->result, statePtr->result);
+ } else if (statePtr->result == statePtr->appendResult) {
+ /*
+ * Move the append buffer back into the interp.
+ */
+
+ if (iPtr->appendResult != NULL) {
+ ckfree((char *)iPtr->appendResult);
+ }
+
+ iPtr->appendResult = statePtr->appendResult;
+ iPtr->appendAvl = statePtr->appendAvl;
+ iPtr->appendUsed = statePtr->appendUsed;
+ iPtr->result = iPtr->appendResult;
+ } else {
+ /*
+ * Move the dynamic or static string back into the interpreter.
+ */
+
+ iPtr->result = statePtr->result;
+ }
+
+ /*
+ * Restore the object result.
+ */
+
+ Tcl_DecrRefCount(iPtr->objResultPtr);
+ iPtr->objResultPtr = statePtr->objResultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DiscardResult --
+ *
+ * Frees the memory associated with an interpreter snapshot
+ * taken by Tcl_SaveResult. If the snapshot is not
+ * restored, this procedure must be called to discard it,
+ * or the memory will be lost.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DiscardResult(statePtr)
+ Tcl_SavedResult *statePtr; /* State returned by Tcl_SaveResult. */
+{
+ TclDecrRefCount(statePtr->objResultPtr);
+
+ if (statePtr->result == statePtr->appendResult) {
+ ckfree(statePtr->appendResult);
+ } else if (statePtr->freeProc) {
+ if ((statePtr->freeProc == TCL_DYNAMIC)
+ || (statePtr->freeProc == (Tcl_FreeProc *) free)) {
+ ckfree(statePtr->result);
+ } else {
+ (*statePtr->freeProc)(statePtr->result);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetResult --
+ *
+ * Arrange for "string" to be the Tcl return value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * interp->result is left pointing either to "string" (if "copy" is 0)
+ * or to a copy of string. Also, the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetResult(interp, string, freeProc)
+ Tcl_Interp *interp; /* Interpreter with which to associate the
+ * return value. */
+ register char *string; /* Value to be returned. If NULL, the
+ * result is set to an empty string. */
+ Tcl_FreeProc *freeProc; /* Gives information about the string:
+ * TCL_STATIC, TCL_VOLATILE, or the address
+ * of a Tcl_FreeProc such as free. */
+{
+ Interp *iPtr = (Interp *) interp;
+ int length;
+ register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
+ char *oldResult = iPtr->result;
+
+ if (string == NULL) {
+ iPtr->resultSpace[0] = 0;
+ iPtr->result = iPtr->resultSpace;
+ iPtr->freeProc = 0;
+ } else if (freeProc == TCL_VOLATILE) {
+ length = strlen(string);
+ if (length > TCL_RESULT_SIZE) {
+ iPtr->result = (char *) ckalloc((unsigned) length+1);
+ iPtr->freeProc = TCL_DYNAMIC;
+ } else {
+ iPtr->result = iPtr->resultSpace;
+ iPtr->freeProc = 0;
+ }
+ strcpy(iPtr->result, string);
+ } else {
+ iPtr->result = string;
+ iPtr->freeProc = freeProc;
+ }
+
+ /*
+ * If the old result was dynamically-allocated, free it up. Do it
+ * here, rather than at the beginning, in case the new result value
+ * was part of the old result value.
+ */
+
+ if (oldFreeProc != 0) {
+ if ((oldFreeProc == TCL_DYNAMIC)
+ || (oldFreeProc == (Tcl_FreeProc *) free)) {
+ ckfree(oldResult);
+ } else {
+ (*oldFreeProc)(oldResult);
+ }
+ }
+
+ /*
+ * Reset the object result since we just set the string result.
+ */
+
+ ResetObjResult(iPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetStringResult --
+ *
+ * Returns an interpreter's result value as a string.
+ *
+ * Results:
+ * The interpreter's result as a string.
+ *
+ * Side effects:
+ * If the string result is empty, the object result is moved to the
+ * string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetStringResult(interp)
+ register Tcl_Interp *interp; /* Interpreter whose result to return. */
+{
+ /*
+ * If the string result is empty, move the object result to the
+ * string result, then reset the object result.
+ */
+
+ if (*(interp->result) == 0) {
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+ TCL_VOLATILE);
+ }
+ return interp->result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetObjResult --
+ *
+ * Arrange for objPtr to be an interpreter's result value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * interp->objResultPtr is left pointing to the object referenced
+ * by objPtr. The object's reference count is incremented since
+ * there is now a new reference to it. The reference count for any
+ * old objResultPtr value is decremented. Also, the string result
+ * is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetObjResult(interp, objPtr)
+ Tcl_Interp *interp; /* Interpreter with which to associate the
+ * return object value. */
+ register Tcl_Obj *objPtr; /* Tcl object to be returned. If NULL, the
+ * obj result is made an empty string
+ * object. */
+{
+ register Interp *iPtr = (Interp *) interp;
+ register Tcl_Obj *oldObjResult = iPtr->objResultPtr;
+
+ iPtr->objResultPtr = objPtr;
+ Tcl_IncrRefCount(objPtr); /* since interp result is a reference */
+
+ /*
+ * We wait until the end to release the old object result, in case
+ * we are setting the result to itself.
+ */
+
+ TclDecrRefCount(oldObjResult);
+
+ /*
+ * Reset the string result since we just set the result object.
+ */
+
+ if (iPtr->freeProc != NULL) {
+ if ((iPtr->freeProc == TCL_DYNAMIC)
+ || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+ ckfree(iPtr->result);
+ } else {
+ (*iPtr->freeProc)(iPtr->result);
+ }
+ iPtr->freeProc = 0;
+ }
+ iPtr->result = iPtr->resultSpace;
+ iPtr->resultSpace[0] = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetObjResult --
+ *
+ * Returns an interpreter's result value as a Tcl object. The object's
+ * reference count is not modified; the caller must do that if it
+ * needs to hold on to a long-term reference to it.
+ *
+ * Results:
+ * The interpreter's result as an object.
+ *
+ * Side effects:
+ * If the interpreter has a non-empty string result, the result object
+ * is either empty or stale because some procedure set interp->result
+ * directly. If so, the string result is moved to the result object
+ * then the string result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_GetObjResult(interp)
+ Tcl_Interp *interp; /* Interpreter whose result to return. */
+{
+ register Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *objResultPtr;
+ int length;
+
+ /*
+ * If the string result is non-empty, move the string result to the
+ * object result, then reset the string result.
+ */
+
+ if (*(iPtr->result) != 0) {
+ ResetObjResult(iPtr);
+
+ objResultPtr = iPtr->objResultPtr;
+ length = strlen(iPtr->result);
+ TclInitStringRep(objResultPtr, iPtr->result, length);
+
+ if (iPtr->freeProc != NULL) {
+ if ((iPtr->freeProc == TCL_DYNAMIC)
+ || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+ ckfree(iPtr->result);
+ } else {
+ (*iPtr->freeProc)(iPtr->result);
+ }
+ iPtr->freeProc = 0;
+ }
+ iPtr->result = iPtr->resultSpace;
+ iPtr->resultSpace[0] = 0;
+ }
+ return iPtr->objResultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendResultVA --
+ *
+ * Append a variable number of strings onto the interpreter's string
+ * result.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The result of the interpreter given by the first argument is
+ * extended by the strings in the va_list (up to a terminating NULL
+ * argument).
+ *
+ * If the string result is empty, the object result is moved to the
+ * string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendResultVA (interp, argList)
+ Tcl_Interp *interp; /* Interpreter with which to associate the
+ * return value. */
+ va_list argList; /* Variable argument list. */
+{
+#define STATIC_LIST_SIZE 16
+ Interp *iPtr = (Interp *) interp;
+ char *string, *static_list[STATIC_LIST_SIZE];
+ char **args = static_list;
+ int nargs_space = STATIC_LIST_SIZE;
+ int nargs, newSpace, i;
+
+ /*
+ * If the string result is empty, move the object result to the
+ * string result, then reset the object result.
+ */
+
+ if (*(iPtr->result) == 0) {
+ Tcl_SetResult((Tcl_Interp *) iPtr,
+ TclGetString(Tcl_GetObjResult((Tcl_Interp *) iPtr)),
+ TCL_VOLATILE);
+ }
+
+ /*
+ * Scan through all the arguments to see how much space is needed
+ * and save pointers to the arguments in the args array,
+ * reallocating as necessary.
+ */
+
+ nargs = 0;
+ newSpace = 0;
+ while (1) {
+ string = va_arg(argList, char *);
+ if (string == NULL) {
+ break;
+ }
+ if (nargs >= nargs_space) {
+ /*
+ * Expand the args buffer
+ */
+ nargs_space += STATIC_LIST_SIZE;
+ if (args == static_list) {
+ args = (void *)ckalloc(nargs_space * sizeof(char *));
+ for (i = 0; i < nargs; ++i) {
+ args[i] = static_list[i];
+ }
+ } else {
+ args = (void *)ckrealloc((void *)args,
+ nargs_space * sizeof(char *));
+ }
+ }
+ newSpace += strlen(string);
+ args[nargs++] = string;
+ }
+
+ /*
+ * If the append buffer isn't already setup and large enough to hold
+ * the new data, set it up.
+ */
+
+ if ((iPtr->result != iPtr->appendResult)
+ || (iPtr->appendResult[iPtr->appendUsed] != 0)
+ || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
+ SetupAppendBuffer(iPtr, newSpace);
+ }
+
+ /*
+ * Now go through all the argument strings again, copying them into the
+ * buffer.
+ */
+
+ for (i = 0; i < nargs; ++i) {
+ string = args[i];
+ strcpy(iPtr->appendResult + iPtr->appendUsed, string);
+ iPtr->appendUsed += strlen(string);
+ }
+
+ /*
+ * If we had to allocate a buffer from the heap,
+ * free it now.
+ */
+
+ if (args != static_list) {
+ ckfree((void *)args);
+ }
+#undef STATIC_LIST_SIZE
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendResult --
+ *
+ * Append a variable number of strings onto the interpreter's string
+ * result.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The result of the interpreter given by the first argument is
+ * extended by the strings given by the second and following arguments
+ * (up to a terminating NULL argument).
+ *
+ * If the string result is empty, the object result is moved to the
+ * string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+ Tcl_Interp *interp;
+ va_list argList;
+
+ interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+ Tcl_AppendResultVA(interp, argList);
+ va_end(argList);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendElement --
+ *
+ * Convert a string to a valid Tcl list element and append it to the
+ * result (which is ostensibly a list).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The result in the interpreter given by the first argument is
+ * extended with a list element converted from string. A separator
+ * space is added before the converted list element unless the current
+ * result is empty, contains the single character "{", or ends in " {".
+ *
+ * If the string result is empty, the object result is moved to the
+ * string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendElement(interp, string)
+ Tcl_Interp *interp; /* Interpreter whose result is to be
+ * extended. */
+ CONST char *string; /* String to convert to list element and
+ * add to result. */
+{
+ Interp *iPtr = (Interp *) interp;
+ char *dst;
+ int size;
+ int flags;
+
+ /*
+ * If the string result is empty, move the object result to the
+ * string result, then reset the object result.
+ */
+
+ if (*(iPtr->result) == 0) {
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+ TCL_VOLATILE);
+ }
+
+ /*
+ * See how much space is needed, and grow the append buffer if
+ * needed to accommodate the list element.
+ */
+
+ size = Tcl_ScanElement(string, &flags) + 1;
+ if ((iPtr->result != iPtr->appendResult)
+ || (iPtr->appendResult[iPtr->appendUsed] != 0)
+ || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
+ SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
+ }
+
+ /*
+ * Convert the string into a list element and copy it to the
+ * buffer that's forming, with a space separator if needed.
+ */
+
+ dst = iPtr->appendResult + iPtr->appendUsed;
+ if (TclNeedSpace(iPtr->appendResult, dst)) {
+ iPtr->appendUsed++;
+ *dst = ' ';
+ dst++;
+ }
+ iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetupAppendBuffer --
+ *
+ * This procedure makes sure that there is an append buffer properly
+ * initialized, if necessary, from the interpreter's result, and
+ * that it has at least enough room to accommodate newSpace new
+ * bytes of information.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetupAppendBuffer(iPtr, newSpace)
+ Interp *iPtr; /* Interpreter whose result is being set up. */
+ int newSpace; /* Make sure that at least this many bytes
+ * of new information may be added. */
+{
+ int totalSpace;
+
+ /*
+ * Make the append buffer larger, if that's necessary, then copy the
+ * result into the append buffer and make the append buffer the official
+ * Tcl result.
+ */
+
+ if (iPtr->result != iPtr->appendResult) {
+ /*
+ * If an oversized buffer was used recently, then free it up
+ * so we go back to a smaller buffer. This avoids tying up
+ * memory forever after a large operation.
+ */
+
+ if (iPtr->appendAvl > 500) {
+ ckfree(iPtr->appendResult);
+ iPtr->appendResult = NULL;
+ iPtr->appendAvl = 0;
+ }
+ iPtr->appendUsed = strlen(iPtr->result);
+ } else if (iPtr->result[iPtr->appendUsed] != 0) {
+ /*
+ * Most likely someone has modified a result created by
+ * Tcl_AppendResult et al. so that it has a different size.
+ * Just recompute the size.
+ */
+
+ iPtr->appendUsed = strlen(iPtr->result);
+ }
+
+ totalSpace = newSpace + iPtr->appendUsed;
+ if (totalSpace >= iPtr->appendAvl) {
+ char *new;
+
+ if (totalSpace < 100) {
+ totalSpace = 200;
+ } else {
+ totalSpace *= 2;
+ }
+ new = (char *) ckalloc((unsigned) totalSpace);
+ strcpy(new, iPtr->result);
+ if (iPtr->appendResult != NULL) {
+ ckfree(iPtr->appendResult);
+ }
+ iPtr->appendResult = new;
+ iPtr->appendAvl = totalSpace;
+ } else if (iPtr->result != iPtr->appendResult) {
+ strcpy(iPtr->appendResult, iPtr->result);
+ }
+
+ Tcl_FreeResult((Tcl_Interp *) iPtr);
+ iPtr->result = iPtr->appendResult;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FreeResult --
+ *
+ * This procedure frees up the memory associated with an interpreter's
+ * string result. It also resets the interpreter's result object.
+ * Tcl_FreeResult is most commonly used when a procedure is about to
+ * replace one result value with another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the memory associated with interp's string result and sets
+ * interp->freeProc to zero, but does not change interp->result or
+ * clear error state. Resets interp's result object to an unshared
+ * empty object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FreeResult(interp)
+ register Tcl_Interp *interp; /* Interpreter for which to free result. */
+{
+ register Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->freeProc != NULL) {
+ if ((iPtr->freeProc == TCL_DYNAMIC)
+ || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+ ckfree(iPtr->result);
+ } else {
+ (*iPtr->freeProc)(iPtr->result);
+ }
+ iPtr->freeProc = 0;
+ }
+
+ ResetObjResult(iPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ResetResult --
+ *
+ * This procedure resets both the interpreter's string and object
+ * results.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * It resets the result object to an unshared empty object. It
+ * then restores the interpreter's string result area to its default
+ * initialized state, freeing up any memory that may have been
+ * allocated. It also clears any error information for the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ResetResult(interp)
+ register Tcl_Interp *interp; /* Interpreter for which to clear result. */
+{
+ register Interp *iPtr = (Interp *) interp;
+
+ ResetObjResult(iPtr);
+ if (iPtr->freeProc != NULL) {
+ if ((iPtr->freeProc == TCL_DYNAMIC)
+ || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
+ ckfree(iPtr->result);
+ } else {
+ (*iPtr->freeProc)(iPtr->result);
+ }
+ iPtr->freeProc = 0;
+ }
+ iPtr->result = iPtr->resultSpace;
+ iPtr->resultSpace[0] = 0;
+ iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResetObjResult --
+ *
+ * Procedure used to reset an interpreter's Tcl result object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resets the interpreter's result object to an unshared empty string
+ * object with ref count one. It does not clear any error information
+ * in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResetObjResult(iPtr)
+ register Interp *iPtr; /* Points to the interpreter whose result
+ * object should be reset. */
+{
+ register Tcl_Obj *objResultPtr = iPtr->objResultPtr;
+
+ if (Tcl_IsShared(objResultPtr)) {
+ TclDecrRefCount(objResultPtr);
+ TclNewObj(objResultPtr);
+ Tcl_IncrRefCount(objResultPtr);
+ iPtr->objResultPtr = objResultPtr;
+ } else {
+ if ((objResultPtr->bytes != NULL)
+ && (objResultPtr->bytes != tclEmptyStringRep)) {
+ ckfree((char *) objResultPtr->bytes);
+ }
+ objResultPtr->bytes = tclEmptyStringRep;
+ objResultPtr->length = 0;
+ if ((objResultPtr->typePtr != NULL)
+ && (objResultPtr->typePtr->freeIntRepProc != NULL)) {
+ objResultPtr->typePtr->freeIntRepProc(objResultPtr);
+ }
+ objResultPtr->typePtr = (Tcl_ObjType *) NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetErrorCodeVA --
+ *
+ * This procedure is called to record machine-readable information
+ * about an error that is about to be returned.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The errorCode global variable is modified to hold all of the
+ * arguments to this procedure, in a list form with each argument
+ * becoming one element of the list. A flag is set internally
+ * to remember that errorCode has been set, so the variable doesn't
+ * get set automatically when the error is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetErrorCodeVA (interp, argList)
+ Tcl_Interp *interp; /* Interpreter in which to access the errorCode
+ * variable. */
+ va_list argList; /* Variable argument list. */
+{
+ char *string;
+ int flags;
+ Interp *iPtr = (Interp *) interp;
+
+ /*
+ * Scan through the arguments one at a time, appending them to
+ * $errorCode as list elements.
+ */
+
+ flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
+ while (1) {
+ string = va_arg(argList, char *);
+ if (string == NULL) {
+ break;
+ }
+ (void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
+ (char *) NULL, string, flags);
+ flags |= TCL_APPEND_VALUE;
+ }
+ iPtr->flags |= ERROR_CODE_SET;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetErrorCode --
+ *
+ * This procedure is called to record machine-readable information
+ * about an error that is about to be returned.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The errorCode global variable is modified to hold all of the
+ * arguments to this procedure, in a list form with each argument
+ * becoming one element of the list. A flag is set internally
+ * to remember that errorCode has been set, so the variable doesn't
+ * get set automatically when the error is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+ /* VARARGS2 */
+void
+Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+ Tcl_Interp *interp;
+ va_list argList;
+
+ /*
+ * Scan through the arguments one at a time, appending them to
+ * $errorCode as list elements.
+ */
+
+ interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+ Tcl_SetErrorCodeVA(interp, argList);
+ va_end(argList);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetObjErrorCode --
+ *
+ * This procedure is called to record machine-readable information
+ * about an error that is about to be returned. The caller should
+ * build a list object up and pass it to this routine.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The errorCode global variable is modified to be the new value.
+ * A flag is set internally to remember that errorCode has been
+ * set, so the variable doesn't get set automatically when the
+ * error is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetObjErrorCode(interp, errorObjPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *errorObjPtr;
+{
+ Interp *iPtr;
+
+ iPtr = (Interp *) interp;
+ Tcl_SetVar2Ex(interp, "errorCode", NULL, errorObjPtr, TCL_GLOBAL_ONLY);
+ iPtr->flags |= ERROR_CODE_SET;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclTransferResult --
+ *
+ * Copy the result (and error information) from one interp to
+ * another. Used when one interp has caused another interp to
+ * evaluate a script and then wants to transfer the results back
+ * to itself.
+ *
+ * This routine copies the string reps of the result and error
+ * information. It does not simply increment the refcounts of the
+ * result and error information objects themselves.
+ * It is not legal to exchange objects between interps, because an
+ * object may be kept alive by one interp, but have an internal rep
+ * that is only valid while some other interp is alive.
+ *
+ * Results:
+ * The target interp's result is set to a copy of the source interp's
+ * result. The source's error information "$errorInfo" may be
+ * appended to the target's error information and the source's error
+ * code "$errorCode" may be stored in the target's error code.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclTransferResult(sourceInterp, result, targetInterp)
+ Tcl_Interp *sourceInterp; /* Interp whose result and error information
+ * should be moved to the target interp.
+ * After moving result, this interp's result
+ * is reset. */
+ int result; /* TCL_OK if just the result should be copied,
+ * TCL_ERROR if both the result and error
+ * information should be copied. */
+ Tcl_Interp *targetInterp; /* Interp where result and error information
+ * should be stored. If source and target
+ * are the same, nothing is done. */
+{
+ Interp *iPtr;
+ Tcl_Obj *objPtr;
+
+ if (sourceInterp == targetInterp) {
+ return;
+ }
+
+ if (result == TCL_ERROR) {
+ /*
+ * An error occurred, so transfer error information from the source
+ * interpreter to the target interpreter. Setting the flags tells
+ * the target interp that it has inherited a partial traceback
+ * chain, not just a simple error message.
+ */
+
+ iPtr = (Interp *) sourceInterp;
+ if ((iPtr->flags & ERR_ALREADY_LOGGED) == 0) {
+ Tcl_AddErrorInfo(sourceInterp, "");
+ }
+ iPtr->flags &= ~(ERR_ALREADY_LOGGED);
+
+ Tcl_ResetResult(targetInterp);
+
+ objPtr = Tcl_GetVar2Ex(sourceInterp, "errorInfo", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr,
+ TCL_GLOBAL_ONLY);
+
+ objPtr = Tcl_GetVar2Ex(sourceInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex(targetInterp, "errorCode", NULL, objPtr,
+ TCL_GLOBAL_ONLY);
+
+ ((Interp *) targetInterp)->flags |= (ERR_IN_PROGRESS | ERROR_CODE_SET);
+ }
+
+ ((Interp *) targetInterp)->returnCode = ((Interp *) sourceInterp)->returnCode;
+ Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));
+ Tcl_ResetResult(sourceInterp);
+}
diff --git a/tcl/generic/tclScan.c b/tcl/generic/tclScan.c
new file mode 100644
index 00000000000..c5d4784dfe3
--- /dev/null
+++ b/tcl/generic/tclScan.c
@@ -0,0 +1,1133 @@
+/*
+ * tclScan.c --
+ *
+ * This file contains the implementation of the "scan" command.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * Flag values used by Tcl_ScanObjCmd.
+ */
+
+#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */
+#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */
+#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */
+#define SCAN_WIDTH 0x8 /* A width value was supplied. */
+
+#define SCAN_SIGNOK 0x10 /* A +/- character is allowed. */
+#define SCAN_NODIGITS 0x20 /* No digits have been scanned. */
+#define SCAN_NOZERO 0x40 /* No zero digits have been scanned. */
+#define SCAN_XOK 0x80 /* An 'x' is allowed. */
+#define SCAN_PTOK 0x100 /* Decimal point is allowed. */
+#define SCAN_EXPOK 0x200 /* An exponent is allowed. */
+
+
+/*
+ * The following structure contains the information associated with
+ * a character set.
+ */
+
+typedef struct CharSet {
+ int exclude; /* 1 if this is an exclusion set. */
+ int nchars;
+ Tcl_UniChar *chars;
+ int nranges;
+ struct Range {
+ Tcl_UniChar start;
+ Tcl_UniChar end;
+ } *ranges;
+} CharSet;
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static char * BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format));
+static int CharInSet _ANSI_ARGS_((CharSet *cset, int ch));
+static void ReleaseCharSet _ANSI_ARGS_((CharSet *cset));
+static int ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,
+ int numVars, int *totalVars));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BuildCharSet --
+ *
+ * This function examines a character set format specification
+ * and builds a CharSet containing the individual characters and
+ * character ranges specified.
+ *
+ * Results:
+ * Returns the next format position.
+ *
+ * Side effects:
+ * Initializes the charset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+BuildCharSet(cset, format)
+ CharSet *cset;
+ char *format; /* Points to first char of set. */
+{
+ Tcl_UniChar ch, start;
+ int offset, nranges;
+ char *end;
+
+ memset(cset, 0, sizeof(CharSet));
+
+ offset = Tcl_UtfToUniChar(format, &ch);
+ if (ch == '^') {
+ cset->exclude = 1;
+ format += offset;
+ offset = Tcl_UtfToUniChar(format, &ch);
+ }
+ end = format + offset;
+
+ /*
+ * Find the close bracket so we can overallocate the set.
+ */
+
+ if (ch == ']') {
+ end += Tcl_UtfToUniChar(end, &ch);
+ }
+ nranges = 0;
+ while (ch != ']') {
+ if (ch == '-') {
+ nranges++;
+ }
+ end += Tcl_UtfToUniChar(end, &ch);
+ }
+
+ cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar)
+ * (end - format - 1));
+ if (nranges > 0) {
+ cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
+ } else {
+ cset->ranges = NULL;
+ }
+
+ /*
+ * Now build the character set.
+ */
+
+ cset->nchars = cset->nranges = 0;
+ format += Tcl_UtfToUniChar(format, &ch);
+ start = ch;
+ if (ch == ']' || ch == '-') {
+ cset->chars[cset->nchars++] = ch;
+ format += Tcl_UtfToUniChar(format, &ch);
+ }
+ while (ch != ']') {
+ if (*format == '-') {
+ /*
+ * This may be the first character of a range, so don't add
+ * it yet.
+ */
+
+ start = ch;
+ } else if (ch == '-') {
+ /*
+ * Check to see if this is the last character in the set, in which
+ * case it is not a range and we should add the previous character
+ * as well as the dash.
+ */
+
+ if (*format == ']') {
+ cset->chars[cset->nchars++] = start;
+ cset->chars[cset->nchars++] = ch;
+ } else {
+ format += Tcl_UtfToUniChar(format, &ch);
+
+ /*
+ * Check to see if the range is in reverse order.
+ */
+
+ if (start < ch) {
+ cset->ranges[cset->nranges].start = start;
+ cset->ranges[cset->nranges].end = ch;
+ } else {
+ cset->ranges[cset->nranges].start = ch;
+ cset->ranges[cset->nranges].end = start;
+ }
+ cset->nranges++;
+ }
+ } else {
+ cset->chars[cset->nchars++] = ch;
+ }
+ format += Tcl_UtfToUniChar(format, &ch);
+ }
+ return format;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CharInSet --
+ *
+ * Check to see if a character matches the given set.
+ *
+ * Results:
+ * Returns non-zero if the character matches the given set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CharInSet(cset, c)
+ CharSet *cset;
+ int c; /* Character to test, passed as int because
+ * of non-ANSI prototypes. */
+{
+ Tcl_UniChar ch = (Tcl_UniChar) c;
+ int i, match = 0;
+ for (i = 0; i < cset->nchars; i++) {
+ if (cset->chars[i] == ch) {
+ match = 1;
+ break;
+ }
+ }
+ if (!match) {
+ for (i = 0; i < cset->nranges; i++) {
+ if ((cset->ranges[i].start <= ch)
+ && (ch <= cset->ranges[i].end)) {
+ match = 1;
+ break;
+ }
+ }
+ }
+ return (cset->exclude ? !match : match);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseCharSet --
+ *
+ * Free the storage associated with a character set.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseCharSet(cset)
+ CharSet *cset;
+{
+ ckfree((char *)cset->chars);
+ if (cset->ranges) {
+ ckfree((char *)cset->ranges);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidateFormat --
+ *
+ * Parse the format string and verify that it is properly formed
+ * and that there are exactly enough variables on the command line.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May place an error in the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ValidateFormat(interp, format, numVars, totalSubs)
+ Tcl_Interp *interp; /* Current interpreter. */
+ char *format; /* The format string. */
+ int numVars; /* The number of variables passed to the
+ * scan command. */
+ int *totalSubs; /* The number of variables that will be
+ * required. */
+{
+#define STATIC_LIST_SIZE 16
+ int gotXpg, gotSequential, value, i, flags;
+ char *end;
+ Tcl_UniChar ch;
+ int staticAssign[STATIC_LIST_SIZE];
+ int *nassign = staticAssign;
+ int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
+
+ /*
+ * Initialize an array that records the number of times a variable
+ * is assigned to by the format string. We use this to detect if
+ * a variable is multiply assigned or left unassigned.
+ */
+
+ if (numVars > nspace) {
+ nassign = (int*)ckalloc(sizeof(int) * numVars);
+ nspace = numVars;
+ }
+ for (i = 0; i < nspace; i++) {
+ nassign[i] = 0;
+ }
+
+ xpgSize = objIndex = gotXpg = gotSequential = 0;
+
+ while (*format != '\0') {
+ format += Tcl_UtfToUniChar(format, &ch);
+
+ flags = 0;
+
+ if (ch != '%') {
+ continue;
+ }
+ format += Tcl_UtfToUniChar(format, &ch);
+ if (ch == '%') {
+ continue;
+ }
+ if (ch == '*') {
+ flags |= SCAN_SUPPRESS;
+ format += Tcl_UtfToUniChar(format, &ch);
+ goto xpgCheckDone;
+ }
+
+ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+ /*
+ * Check for an XPG3-style %n$ specification. Note: there
+ * must not be a mixture of XPG3 specs and non-XPG3 specs
+ * in the same format string.
+ */
+
+ value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
+ if (*end != '$') {
+ goto notXpg;
+ }
+ format = end+1;
+ format += Tcl_UtfToUniChar(format, &ch);
+ gotXpg = 1;
+ if (gotSequential) {
+ goto mixedXPG;
+ }
+ objIndex = value - 1;
+ if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
+ goto badIndex;
+ } else if (numVars == 0) {
+ /*
+ * In the case where no vars are specified, the user can
+ * specify %9999$ legally, so we have to consider special
+ * rules for growing the assign array. 'value' is
+ * guaranteed to be > 0.
+ */
+ xpgSize = (xpgSize > value) ? xpgSize : value;
+ }
+ goto xpgCheckDone;
+ }
+
+ notXpg:
+ gotSequential = 1;
+ if (gotXpg) {
+ mixedXPG:
+ Tcl_SetResult(interp,
+ "cannot mix \"%\" and \"%n$\" conversion specifiers",
+ TCL_STATIC);
+ goto error;
+ }
+
+ xpgCheckDone:
+ /*
+ * Parse any width specifier.
+ */
+
+ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+ value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
+ flags |= SCAN_WIDTH;
+ format += Tcl_UtfToUniChar(format, &ch);
+ }
+
+ /*
+ * Ignore size specifier.
+ */
+
+ if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
+ format += Tcl_UtfToUniChar(format, &ch);
+ }
+
+ if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
+ goto badIndex;
+ }
+
+ /*
+ * Handle the various field types.
+ */
+
+ switch (ch) {
+ case 'n':
+ case 'd':
+ case 'i':
+ case 'o':
+ case 'x':
+ case 'u':
+ case 'f':
+ case 'e':
+ case 'g':
+ case 's':
+ break;
+ case 'c':
+ if (flags & SCAN_WIDTH) {
+ Tcl_SetResult(interp, "field width may not be specified in %c conversion", TCL_STATIC);
+ goto error;
+ }
+ break;
+ case '[':
+ if (*format == '\0') {
+ goto badSet;
+ }
+ format += Tcl_UtfToUniChar(format, &ch);
+ if (ch == '^') {
+ if (*format == '\0') {
+ goto badSet;
+ }
+ format += Tcl_UtfToUniChar(format, &ch);
+ }
+ if (ch == ']') {
+ if (*format == '\0') {
+ goto badSet;
+ }
+ format += Tcl_UtfToUniChar(format, &ch);
+ }
+ while (ch != ']') {
+ if (*format == '\0') {
+ goto badSet;
+ }
+ format += Tcl_UtfToUniChar(format, &ch);
+ }
+ break;
+ badSet:
+ Tcl_SetResult(interp, "unmatched [ in format string",
+ TCL_STATIC);
+ goto error;
+ default:
+ {
+ char buf[TCL_UTF_MAX+1];
+
+ buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad scan conversion character \"", buf, "\"", NULL);
+ goto error;
+ }
+ }
+ if (!(flags & SCAN_SUPPRESS)) {
+ if (objIndex >= nspace) {
+ /*
+ * Expand the nassign buffer. If we are using XPG specifiers,
+ * make sure that we grow to a large enough size. xpgSize is
+ * guaranteed to be at least one larger than objIndex.
+ */
+ value = nspace;
+ if (xpgSize) {
+ nspace = xpgSize;
+ } else {
+ nspace += STATIC_LIST_SIZE;
+ }
+ if (nassign == staticAssign) {
+ nassign = (void *)ckalloc(nspace * sizeof(int));
+ for (i = 0; i < STATIC_LIST_SIZE; ++i) {
+ nassign[i] = staticAssign[i];
+ }
+ } else {
+ nassign = (void *)ckrealloc((void *)nassign,
+ nspace * sizeof(int));
+ }
+ for (i = value; i < nspace; i++) {
+ nassign[i] = 0;
+ }
+ }
+ nassign[objIndex]++;
+ objIndex++;
+ }
+ }
+
+ /*
+ * Verify that all of the variable were assigned exactly once.
+ */
+
+ if (numVars == 0) {
+ if (xpgSize) {
+ numVars = xpgSize;
+ } else {
+ numVars = objIndex;
+ }
+ }
+ if (totalSubs) {
+ *totalSubs = numVars;
+ }
+ for (i = 0; i < numVars; i++) {
+ if (nassign[i] > 1) {
+ Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);
+ goto error;
+ } else if (!xpgSize && (nassign[i] == 0)) {
+ /*
+ * If the space is empty, and xpgSize is 0 (means XPG wasn't
+ * used, and/or numVars != 0), then too many vars were given
+ */
+ Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);
+ goto error;
+ }
+ }
+
+ if (nassign != staticAssign) {
+ ckfree((char *)nassign);
+ }
+ return TCL_OK;
+
+ badIndex:
+ if (gotXpg) {
+ Tcl_SetResult(interp, "\"%n$\" argument index out of range",
+ TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp,
+ "different numbers of variable names and field specifiers",
+ TCL_STATIC);
+ }
+
+ error:
+ if (nassign != staticAssign) {
+ ckfree((char *)nassign);
+ }
+ return TCL_ERROR;
+#undef STATIC_LIST_SIZE
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ScanObjCmd --
+ *
+ * This procedure is invoked to process the "scan" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_ScanObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ char *format;
+ int numVars, nconversions, totalVars = -1;
+ int objIndex, offset, i, value, result, code;
+ char *string, *end, *baseString;
+ char op = 0;
+ int base = 0;
+ int underflow = 0;
+ size_t width;
+ long (*fn)() = NULL;
+ Tcl_UniChar ch, sch;
+ Tcl_Obj **objs = NULL, *objPtr = NULL;
+ int flags;
+ char buf[513]; /* Temporary buffer to hold scanned
+ * number strings before they are
+ * passed to strtoul. */
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "string format ?varName varName ...?");
+ return TCL_ERROR;
+ }
+
+ format = Tcl_GetStringFromObj(objv[2], NULL);
+ numVars = objc-3;
+
+ /*
+ * Check for errors in the format string.
+ */
+
+ if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Allocate space for the result objects.
+ */
+
+ if (totalVars > 0) {
+ objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
+ for (i = 0; i < totalVars; i++) {
+ objs[i] = NULL;
+ }
+ }
+
+ string = Tcl_GetStringFromObj(objv[1], NULL);
+ baseString = string;
+
+ /*
+ * Iterate over the format string filling in the result objects until
+ * we reach the end of input, the end of the format string, or there
+ * is a mismatch.
+ */
+
+ objIndex = 0;
+ nconversions = 0;
+ while (*format != '\0') {
+ format += Tcl_UtfToUniChar(format, &ch);
+
+ flags = 0;
+
+ /*
+ * If we see whitespace in the format, skip whitespace in the string.
+ */
+
+ if (Tcl_UniCharIsSpace(ch)) {
+ offset = Tcl_UtfToUniChar(string, &sch);
+ while (Tcl_UniCharIsSpace(sch)) {
+ if (*string == '\0') {
+ goto done;
+ }
+ string += offset;
+ offset = Tcl_UtfToUniChar(string, &sch);
+ }
+ continue;
+ }
+
+ if (ch != '%') {
+ literal:
+ if (*string == '\0') {
+ underflow = 1;
+ goto done;
+ }
+ string += Tcl_UtfToUniChar(string, &sch);
+ if (ch != sch) {
+ goto done;
+ }
+ continue;
+ }
+
+ format += Tcl_UtfToUniChar(format, &ch);
+ if (ch == '%') {
+ goto literal;
+ }
+
+ /*
+ * Check for assignment suppression ('*') or an XPG3-style
+ * assignment ('%n$').
+ */
+
+ if (ch == '*') {
+ flags |= SCAN_SUPPRESS;
+ format += Tcl_UtfToUniChar(format, &ch);
+ } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+ value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
+ if (*end == '$') {
+ format = end+1;
+ format += Tcl_UtfToUniChar(format, &ch);
+ objIndex = value - 1;
+ }
+ }
+
+ /*
+ * Parse any width specifier.
+ */
+
+ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+ width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
+ format += Tcl_UtfToUniChar(format, &ch);
+ } else {
+ width = 0;
+ }
+
+ /*
+ * Ignore size specifier.
+ */
+
+ if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
+ format += Tcl_UtfToUniChar(format, &ch);
+ }
+
+ /*
+ * Handle the various field types.
+ */
+
+ switch (ch) {
+ case 'n':
+ if (!(flags & SCAN_SUPPRESS)) {
+ objPtr = Tcl_NewIntObj(string - baseString);
+ Tcl_IncrRefCount(objPtr);
+ objs[objIndex++] = objPtr;
+ }
+ nconversions++;
+ continue;
+
+ case 'd':
+ op = 'i';
+ base = 10;
+ fn = (long (*)())strtol;
+ break;
+ case 'i':
+ op = 'i';
+ base = 0;
+ fn = (long (*)())strtol;
+ break;
+ case 'o':
+ op = 'i';
+ base = 8;
+ fn = (long (*)())strtol;
+ break;
+ case 'x':
+ op = 'i';
+ base = 16;
+ fn = (long (*)())strtol;
+ break;
+ case 'u':
+ op = 'i';
+ base = 10;
+ flags |= SCAN_UNSIGNED;
+ fn = (long (*)())strtoul;
+ break;
+
+ case 'f':
+ case 'e':
+ case 'g':
+ op = 'f';
+ break;
+
+ case 's':
+ op = 's';
+ break;
+
+ case 'c':
+ op = 'c';
+ flags |= SCAN_NOSKIP;
+ break;
+ case '[':
+ op = '[';
+ flags |= SCAN_NOSKIP;
+ break;
+ }
+
+ /*
+ * At this point, we will need additional characters from the
+ * string to proceed.
+ */
+
+ if (*string == '\0') {
+ underflow = 1;
+ goto done;
+ }
+
+ /*
+ * Skip any leading whitespace at the beginning of a field unless
+ * the format suppresses this behavior.
+ */
+
+ if (!(flags & SCAN_NOSKIP)) {
+ while (*string != '\0') {
+ offset = Tcl_UtfToUniChar(string, &sch);
+ if (!Tcl_UniCharIsSpace(sch)) {
+ break;
+ }
+ string += offset;
+ }
+ if (*string == '\0') {
+ underflow = 1;
+ goto done;
+ }
+ }
+
+ /*
+ * Perform the requested scanning operation.
+ */
+
+ switch (op) {
+ case 's':
+ /*
+ * Scan a string up to width characters or whitespace.
+ */
+
+ if (width == 0) {
+ width = (size_t) ~0;
+ }
+ end = string;
+ while (*end != '\0') {
+ offset = Tcl_UtfToUniChar(end, &sch);
+ if (Tcl_UniCharIsSpace(sch)) {
+ break;
+ }
+ end += offset;
+ if (--width == 0) {
+ break;
+ }
+ }
+ if (!(flags & SCAN_SUPPRESS)) {
+ objPtr = Tcl_NewStringObj(string, end-string);
+ Tcl_IncrRefCount(objPtr);
+ objs[objIndex++] = objPtr;
+ }
+ string = end;
+ break;
+
+ case '[': {
+ CharSet cset;
+
+ if (width == 0) {
+ width = (size_t) ~0;
+ }
+ end = string;
+
+ format = BuildCharSet(&cset, format);
+ while (*end != '\0') {
+ offset = Tcl_UtfToUniChar(end, &sch);
+ if (!CharInSet(&cset, (int)sch)) {
+ break;
+ }
+ end += offset;
+ if (--width == 0) {
+ break;
+ }
+ }
+ ReleaseCharSet(&cset);
+
+ if (string == end) {
+ /*
+ * Nothing matched the range, stop processing
+ */
+ goto done;
+ }
+ if (!(flags & SCAN_SUPPRESS)) {
+ objPtr = Tcl_NewStringObj(string, end-string);
+ Tcl_IncrRefCount(objPtr);
+ objs[objIndex++] = objPtr;
+ }
+ string = end;
+
+ break;
+ }
+ case 'c':
+ /*
+ * Scan a single Unicode character.
+ */
+
+ string += Tcl_UtfToUniChar(string, &sch);
+ if (!(flags & SCAN_SUPPRESS)) {
+ objPtr = Tcl_NewIntObj((int)sch);
+ Tcl_IncrRefCount(objPtr);
+ objs[objIndex++] = objPtr;
+ }
+ break;
+
+ case 'i':
+ /*
+ * Scan an unsigned or signed integer.
+ */
+
+ if ((width == 0) || (width > sizeof(buf) - 1)) {
+ width = sizeof(buf) - 1;
+ }
+ flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO;
+ for (end = buf; width > 0; width--) {
+ switch (*string) {
+ /*
+ * The 0 digit has special meaning at the beginning of
+ * a number. If we are unsure of the base, it
+ * indicates that we are in base 8 or base 16 (if it is
+ * followed by an 'x').
+ */
+ case '0':
+ if (base == 0) {
+ base = 8;
+ flags |= SCAN_XOK;
+ }
+ if (flags & SCAN_NOZERO) {
+ flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS
+ | SCAN_NOZERO);
+ } else {
+ flags &= ~(SCAN_SIGNOK | SCAN_XOK
+ | SCAN_NODIGITS);
+ }
+ goto addToInt;
+
+ case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7':
+ if (base == 0) {
+ base = 10;
+ }
+ flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
+ goto addToInt;
+
+ case '8': case '9':
+ if (base == 0) {
+ base = 10;
+ }
+ if (base <= 8) {
+ break;
+ }
+ flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
+ goto addToInt;
+
+ case 'A': case 'B': case 'C':
+ case 'D': case 'E': case 'F':
+ case 'a': case 'b': case 'c':
+ case 'd': case 'e': case 'f':
+ if (base <= 10) {
+ break;
+ }
+ flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
+ goto addToInt;
+
+ case '+': case '-':
+ if (flags & SCAN_SIGNOK) {
+ flags &= ~SCAN_SIGNOK;
+ goto addToInt;
+ }
+ break;
+
+ case 'x': case 'X':
+ if ((flags & SCAN_XOK) && (end == buf+1)) {
+ base = 16;
+ flags &= ~SCAN_XOK;
+ goto addToInt;
+ }
+ break;
+ }
+
+ /*
+ * We got an illegal character so we are done accumulating.
+ */
+
+ break;
+
+ addToInt:
+ /*
+ * Add the character to the temporary buffer.
+ */
+
+ *end++ = *string++;
+ if (*string == '\0') {
+ break;
+ }
+ }
+
+ /*
+ * Check to see if we need to back up because we only got a
+ * sign or a trailing x after a 0.
+ */
+
+ if (flags & SCAN_NODIGITS) {
+ if (*string == '\0') {
+ underflow = 1;
+ }
+ goto done;
+ } else if (end[-1] == 'x' || end[-1] == 'X') {
+ end--;
+ string--;
+ }
+
+
+ /*
+ * Scan the value from the temporary buffer. If we are
+ * returning a large unsigned value, we have to convert it back
+ * to a string since Tcl only supports signed values.
+ */
+
+ if (!(flags & SCAN_SUPPRESS)) {
+ *end = '\0';
+ value = (int) (*fn)(buf, NULL, base);
+ if ((flags & SCAN_UNSIGNED) && (value < 0)) {
+ sprintf(buf, "%u", value); /* INTL: ISO digit */
+ objPtr = Tcl_NewStringObj(buf, -1);
+ } else {
+ objPtr = Tcl_NewIntObj(value);
+ }
+ Tcl_IncrRefCount(objPtr);
+ objs[objIndex++] = objPtr;
+ }
+
+ break;
+
+ case 'f':
+ /*
+ * Scan a floating point number
+ */
+
+ if ((width == 0) || (width > sizeof(buf) - 1)) {
+ width = sizeof(buf) - 1;
+ }
+ flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;
+ for (end = buf; width > 0; width--) {
+ switch (*string) {
+ case '0': case '1': case '2': case '3':
+ case '4': case '5': case '6': case '7':
+ case '8': case '9':
+ flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS);
+ goto addToFloat;
+ case '+': case '-':
+ if (flags & SCAN_SIGNOK) {
+ flags &= ~SCAN_SIGNOK;
+ goto addToFloat;
+ }
+ break;
+ case '.':
+ if (flags & SCAN_PTOK) {
+ flags &= ~(SCAN_SIGNOK | SCAN_PTOK);
+ goto addToFloat;
+ }
+ break;
+ case 'e': case 'E':
+ /*
+ * An exponent is not allowed until there has
+ * been at least one digit.
+ */
+
+ if ((flags & (SCAN_NODIGITS | SCAN_EXPOK))
+ == SCAN_EXPOK) {
+ flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK))
+ | SCAN_SIGNOK | SCAN_NODIGITS;
+ goto addToFloat;
+ }
+ break;
+ }
+
+ /*
+ * We got an illegal character so we are done accumulating.
+ */
+
+ break;
+
+ addToFloat:
+ /*
+ * Add the character to the temporary buffer.
+ */
+
+ *end++ = *string++;
+ if (*string == '\0') {
+ break;
+ }
+ }
+
+ /*
+ * Check to see if we need to back up because we saw a
+ * trailing 'e' or sign.
+ */
+
+ if (flags & SCAN_NODIGITS) {
+ if (flags & SCAN_EXPOK) {
+ /*
+ * There were no digits at all so scanning has
+ * failed and we are done.
+ */
+ if (*string == '\0') {
+ underflow = 1;
+ }
+ goto done;
+ }
+
+ /*
+ * We got a bad exponent ('e' and maybe a sign).
+ */
+
+ end--;
+ string--;
+ if (*end != 'e' && *end != 'E') {
+ end--;
+ string--;
+ }
+ }
+
+ /*
+ * Scan the value from the temporary buffer.
+ */
+
+ if (!(flags & SCAN_SUPPRESS)) {
+ double dvalue;
+ *end = '\0';
+ dvalue = strtod(buf, NULL);
+ objPtr = Tcl_NewDoubleObj(dvalue);
+ Tcl_IncrRefCount(objPtr);
+ objs[objIndex++] = objPtr;
+ }
+ break;
+ }
+ nconversions++;
+ }
+
+ done:
+ result = 0;
+ code = TCL_OK;
+
+ if (numVars) {
+ /*
+ * In this case, variables were specified (classic scan)
+ */
+ for (i = 0; i < totalVars; i++) {
+ if (objs[i] != NULL) {
+ result++;
+ if (Tcl_ObjSetVar2(interp, objv[i+3], NULL,
+ objs[i], 0) == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "couldn't set variable \"",
+ Tcl_GetString(objv[i+3]), "\"", (char *) NULL);
+ code = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(objs[i]);
+ }
+ }
+ } else {
+ /*
+ * Here no vars were specified, we want a list returned (inline scan)
+ */
+ objPtr = Tcl_NewObj();
+ for (i = 0; i < totalVars; i++) {
+ if (objs[i] != NULL) {
+ Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
+ Tcl_DecrRefCount(objs[i]);
+ } else {
+ /*
+ * More %-specifiers than matching chars, so we
+ * just spit out empty strings for these
+ */
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
+ }
+ }
+ }
+ ckfree((char*) objs);
+ if (code == TCL_OK) {
+ if (underflow && (nconversions == 0)) {
+ if (numVars) {
+ objPtr = Tcl_NewIntObj(-1);
+ } else {
+ if (objPtr) {
+ Tcl_SetListObj(objPtr, 0, NULL);
+ } else {
+ objPtr = Tcl_NewObj();
+ }
+ }
+ } else if (numVars) {
+ objPtr = Tcl_NewIntObj(result);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ return code;
+}
diff --git a/tcl/generic/tclStringObj.c b/tcl/generic/tclStringObj.c
index ecc9445f208..7c435b508f6 100644
--- a/tcl/generic/tclStringObj.c
+++ b/tcl/generic/tclStringObj.c
@@ -1,15 +1,34 @@
/*
* tclStringObj.c --
*
- * This file contains procedures that implement string operations
- * on Tcl objects. To do this efficiently (i.e. to allow many
- * appends to be done to an object without constantly reallocating
- * the space for the string representation) we overallocate the
- * space for the string and use the internal representation to keep
- * track of the extra space. Objects with this internal
- * representation are called "expandable string objects".
+ * This file contains procedures that implement string operations on Tcl
+ * objects. Some string operations work with UTF strings and others
+ * require Unicode format. Functions that require knowledge of the width
+ * of each character, such as indexing, operate on Unicode data.
+ *
+ * A Unicode string is an internationalized string. Conceptually, a
+ * Unicode string is an array of 16-bit quantities organized as a sequence
+ * of properly formed UTF-8 characters. There is a one-to-one map between
+ * Unicode and UTF characters. Because Unicode characters have a fixed
+ * width, operations such as indexing operate on Unicode data. The String
+ * ojbect is opitmized for the case where each UTF char in a string is
+ * only one byte. In this case, we store the value of numChars, but we
+ * don't store the Unicode data (unless Tcl_GetUnicode is explicitly
+ * called).
+ *
+ * The String object type stores one or both formats. The default
+ * behavior is to store UTF. Once Unicode is calculated by a function, it
+ * is stored in the internal rep for future access (without an additional
+ * O(n) cost).
+ *
+ * To allow many appends to be done to an object without constantly
+ * reallocating the space for the string or Unicode representation, we
+ * allocate double the space for the string or Unicode and use the
+ * internal representation to keep track of how much space is used
+ * vs. allocated.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -23,7 +42,20 @@
* Prototypes for procedures defined later in this file:
*/
-static void ConvertToStringType _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void AppendUnicodeToUnicodeRep _ANSI_ARGS_((
+ Tcl_Obj *objPtr, Tcl_UniChar *unicode,
+ int appendNumChars));
+static void AppendUnicodeToUtfRep _ANSI_ARGS_((
+ Tcl_Obj *objPtr, Tcl_UniChar *unicode,
+ int numChars));
+static void AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+ char *bytes, int numBytes));
+static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+ char *bytes, int numBytes));
+
+static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+static void FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
Tcl_Obj *copyPtr));
static int SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
@@ -37,11 +69,46 @@ static void UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
Tcl_ObjType tclStringType = {
"string", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ FreeStringInternalRep, /* freeIntRepPro */
DupStringInternalRep, /* dupIntRepProc */
UpdateStringOfString, /* updateStringProc */
SetStringFromAny /* setFromAnyProc */
};
+
+/*
+ * The following structure is the internal rep for a String object.
+ * It keeps track of how much memory has been used and how much has been
+ * allocated for the Unicode and UTF string to enable growing and
+ * shrinking of the UTF and Unicode reps of the String object with fewer
+ * mallocs. To optimize string length and indexing operations, this
+ * structure also stores the number of characters (same of UTF and Unicode!)
+ * once that value has been computed.
+ */
+
+typedef struct String {
+ int numChars; /* The number of chars in the string.
+ * -1 means this value has not been
+ * calculated. >= 0 means that there is a
+ * valid Unicode rep, or that the number
+ * of UTF bytes == the number of chars. */
+ size_t allocated; /* The amount of space actually allocated
+ * for the UTF string (minus 1 byte for
+ * the termination char). */
+ size_t uallocated; /* The amount of space actually allocated
+ * for the Unicode string. 0 means the
+ * Unicode string rep is invalid. */
+ Tcl_UniChar unicode[2]; /* The array of Unicode chars. The actual
+ * size of this field depends on the
+ * 'uallocated' field above. */
+} String;
+
+#define STRING_SIZE(len) \
+ ((unsigned) (sizeof(String) + ((len-1) * sizeof(Tcl_UniChar))))
+#define GET_STRING(objPtr) \
+ ((String *) (objPtr)->internalRep.otherValuePtr)
+#define SET_STRING(objPtr, stringPtr) \
+ (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)
+
/*
*----------------------------------------------------------------------
@@ -74,9 +141,9 @@ Tcl_ObjType tclStringType = {
Tcl_Obj *
Tcl_NewStringObj(bytes, length)
- register char *bytes; /* Points to the first of the length bytes
+ CONST char *bytes; /* Points to the first of the length bytes
* used to initialize the new object. */
- register int length; /* The number of bytes to copy from "bytes"
+ int length; /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first
* NULL byte. */
@@ -88,9 +155,9 @@ Tcl_NewStringObj(bytes, length)
Tcl_Obj *
Tcl_NewStringObj(bytes, length)
- register char *bytes; /* Points to the first of the length bytes
+ CONST char *bytes; /* Points to the first of the length bytes
* used to initialize the new object. */
- register int length; /* The number of bytes to copy from "bytes"
+ int length; /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first
* NULL byte. */
@@ -140,9 +207,9 @@ Tcl_NewStringObj(bytes, length)
Tcl_Obj *
Tcl_DbNewStringObj(bytes, length, file, line)
- register char *bytes; /* Points to the first of the length bytes
+ CONST char *bytes; /* Points to the first of the length bytes
* used to initialize the new object. */
- register int length; /* The number of bytes to copy from "bytes"
+ int length; /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first
* NULL byte. */
@@ -165,7 +232,7 @@ Tcl_DbNewStringObj(bytes, length, file, line)
Tcl_Obj *
Tcl_DbNewStringObj(bytes, length, file, line)
- register char *bytes; /* Points to the first of the length bytes
+ CONST char *bytes; /* Points to the first of the length bytes
* used to initialize the new object. */
register int length; /* The number of bytes to copy from "bytes"
* when initializing the new object. If
@@ -181,6 +248,315 @@ Tcl_DbNewStringObj(bytes, length, file, line)
#endif /* TCL_MEM_DEBUG */
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNewUnicodeObj --
+ *
+ * This procedure is creates a new String object and initializes
+ * it from the given Utf String. If the Utf String is the same size
+ * as the Unicode string, don't duplicate the data.
+ *
+ * Results:
+ * The newly created object is returned. This object will have no
+ * initial string representation. The returned object has a ref count
+ * of 0.
+ *
+ * Side effects:
+ * Memory allocated for new object and copy of Unicode argument.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_NewUnicodeObj(unicode, numChars)
+ Tcl_UniChar *unicode; /* The unicode string used to initialize
+ * the new object. */
+ int numChars; /* Number of characters in the unicode
+ * string. */
+{
+ Tcl_Obj *objPtr;
+ String *stringPtr;
+ size_t uallocated;
+
+ if (numChars < 0) {
+ numChars = 0;
+ if (unicode) {
+ while (unicode[numChars] != 0) { numChars++; }
+ }
+ }
+ uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
+
+ /*
+ * Create a new obj with an invalid string rep.
+ */
+
+ TclNewObj(objPtr);
+ Tcl_InvalidateStringRep(objPtr);
+ objPtr->typePtr = &tclStringType;
+
+ stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
+ stringPtr->numChars = numChars;
+ stringPtr->uallocated = uallocated;
+ stringPtr->allocated = 0;
+ memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
+ stringPtr->unicode[numChars] = 0;
+ SET_STRING(objPtr, stringPtr);
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCharLength --
+ *
+ * Get the length of the Unicode string from the Tcl object.
+ *
+ * Results:
+ * Pointer to unicode string representing the unicode object.
+ *
+ * Side effects:
+ * Frees old internal rep. Allocates memory for new "String"
+ * internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetCharLength(objPtr)
+ Tcl_Obj *objPtr; /* The String object to get the num chars of. */
+{
+ String *stringPtr;
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ /*
+ * If numChars is unknown, then calculate the number of characaters
+ * while populating the Unicode string.
+ */
+
+ if (stringPtr->numChars == -1) {
+
+ stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
+
+ if (stringPtr->numChars == objPtr->length) {
+
+ /*
+ * Since we've just calculated the number of chars, and all
+ * UTF chars are 1-byte long, we don't need to store the
+ * unicode string.
+ */
+
+ stringPtr->uallocated = 0;
+
+ } else {
+
+ /*
+ * Since we've just calucalated the number of chars, and not
+ * all UTF chars are 1-byte long, go ahead and populate the
+ * unicode string.
+ */
+
+ FillUnicodeRep(objPtr);
+
+ /*
+ * We need to fetch the pointer again because we have just
+ * reallocated the structure to make room for the Unicode data.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ }
+ }
+ return stringPtr->numChars;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetUniChar --
+ *
+ * Get the index'th Unicode character from the String object. The
+ * index is assumed to be in the appropriate range.
+ *
+ * Results:
+ * Returns the index'th Unicode character in the Object.
+ *
+ * Side effects:
+ * Fills unichar with the index'th Unicode character.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_UniChar
+Tcl_GetUniChar(objPtr, index)
+ Tcl_Obj *objPtr; /* The object to get the Unicode charater from. */
+ int index; /* Get the index'th Unicode character. */
+{
+ Tcl_UniChar unichar;
+ String *stringPtr;
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ if (stringPtr->numChars == -1) {
+
+ /*
+ * We haven't yet calculated the length, so we don't have the
+ * Unicode str. We need to know the number of chars before we
+ * can do indexing.
+ */
+
+ Tcl_GetCharLength(objPtr);
+
+ /*
+ * We need to fetch the pointer again because we may have just
+ * reallocated the structure.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ }
+ if (stringPtr->uallocated == 0) {
+
+ /*
+ * All of the characters in the Utf string are 1 byte chars,
+ * so we don't store the unicode char. We get the Utf string
+ * and convert the index'th byte to a Unicode character.
+ */
+
+ Tcl_UtfToUniChar(&objPtr->bytes[index], &unichar);
+ } else {
+ unichar = stringPtr->unicode[index];
+ }
+ return unichar;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetUnicode --
+ *
+ * Get the Unicode form of the String object. If
+ * the object is not already a String object, it will be converted
+ * to one. If the String object does not have a Unicode rep, then
+ * one is create from the UTF string format.
+ *
+ * Results:
+ * Returns a pointer to the object's internal Unicode string.
+ *
+ * Side effects:
+ * Converts the object to have the String internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_UniChar *
+Tcl_GetUnicode(objPtr)
+ Tcl_Obj *objPtr; /* The object to find the unicode string for. */
+{
+ String *stringPtr;
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ if ((stringPtr->numChars == -1) || (stringPtr->uallocated == 0)) {
+
+ /*
+ * We haven't yet calculated the length, or all of the characters
+ * in the Utf string are 1 byte chars (so we didn't store the
+ * unicode str). Since this function must return a unicode string,
+ * and one has not yet been stored, force the Unicode to be
+ * calculated and stored now.
+ */
+
+ FillUnicodeRep(objPtr);
+
+ /*
+ * We need to fetch the pointer again because we have just
+ * reallocated the structure to make room for the Unicode data.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ }
+ return stringPtr->unicode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetRange --
+ *
+ * Create a Tcl Object that contains the chars between first and last
+ * of the object indicated by "objPtr". If the object is not already
+ * a String object, convert it to one. The first and last indices
+ * are assumed to be in the appropriate range.
+ *
+ * Results:
+ * Returns a new Tcl Object of the String type.
+ *
+ * Side effects:
+ * Changes the internal rep of "objPtr" to the String type.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+Tcl_GetRange(objPtr, first, last)
+
+ Tcl_Obj *objPtr; /* The Tcl object to find the range of. */
+ int first; /* First index of the range. */
+ int last; /* Last index of the range. */
+{
+ Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
+ String *stringPtr;
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ if (stringPtr->numChars == -1) {
+
+ /*
+ * We haven't yet calculated the length, so we don't have the
+ * Unicode str. We need to know the number of chars before we
+ * can do indexing.
+ */
+
+ Tcl_GetCharLength(objPtr);
+
+ /*
+ * We need to fetch the pointer again because we may have just
+ * reallocated the structure.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ }
+
+ if (stringPtr->numChars == objPtr->length) {
+ char *str = Tcl_GetString(objPtr);
+
+ /*
+ * All of the characters in the Utf string are 1 byte chars,
+ * so we don't store the unicode char. Create a new string
+ * object containing the specified range of chars.
+ */
+
+ newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
+
+ /*
+ * Since we know the new string only has 1-byte chars, we
+ * can set it's numChars field.
+ */
+
+ SetStringFromAny(NULL, newObjPtr);
+ stringPtr = GET_STRING(newObjPtr);
+ stringPtr->numChars = last-first+1;
+ } else {
+ newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
+ last-first+1);
+ }
+ return newObjPtr;
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_SetStringObj --
@@ -222,12 +598,6 @@ Tcl_SetStringObj(objPtr, bytes, length)
panic("Tcl_SetStringObj called with shared object");
}
- Tcl_InvalidateStringRep(objPtr);
- if (length < 0) {
- length = strlen(bytes);
- }
- TclInitStringRep(objPtr, bytes, length);
-
/*
* Set the type to NULL and free any internal rep for the old type.
*/
@@ -236,6 +606,12 @@ Tcl_SetStringObj(objPtr, bytes, length)
oldTypePtr->freeIntRepProc(objPtr);
}
objPtr->typePtr = NULL;
+
+ Tcl_InvalidateStringRep(objPtr);
+ if (length < 0) {
+ length = (bytes? strlen(bytes) : 0);
+ }
+ TclInitStringRep(objPtr, bytes, length);
}
/*
@@ -271,15 +647,23 @@ Tcl_SetObjLength(objPtr, length)
* terminating null byte. */
{
char *new;
+ String *stringPtr;
if (Tcl_IsShared(objPtr)) {
panic("Tcl_SetObjLength called with shared object");
}
- if (objPtr->typePtr != &tclStringType) {
- ConvertToStringType(objPtr);
- }
-
- if ((long)length > objPtr->internalRep.longValue) {
+ SetStringFromAny(NULL, objPtr);
+
+ /*
+ * Invalidate the unicode data.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ stringPtr->numChars = -1;
+ stringPtr->uallocated = 0;
+
+ if (length > (int) stringPtr->allocated) {
+
/*
* Not enough space in current string. Reallocate the string
* space and free the old string.
@@ -292,8 +676,9 @@ Tcl_SetObjLength(objPtr, length)
Tcl_InvalidateStringRep(objPtr);
}
objPtr->bytes = new;
- objPtr->internalRep.longValue = (long) length;
+ stringPtr->allocated = length;
}
+
objPtr->length = length;
if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
objPtr->bytes[length] = 0;
@@ -301,6 +686,67 @@ Tcl_SetObjLength(objPtr, length)
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclSetUnicodeObj --
+ *
+ * Modify an object to hold the Unicode string indicated by "unicode".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated for new "String" internal rep.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tcl_SetUnicodeObj(objPtr, unicode, numChars)
+ Tcl_Obj *objPtr; /* The object to set the string of. */
+ Tcl_UniChar *unicode; /* The unicode string used to initialize
+ * the object. */
+ int numChars; /* Number of characters in the unicode
+ * string. */
+{
+ Tcl_ObjType *typePtr;
+ String *stringPtr;
+ size_t uallocated;
+
+ if (numChars < 0) {
+ numChars = 0;
+ if (unicode) {
+ while (unicode[numChars] != 0) { numChars++; }
+ }
+ }
+ uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
+
+ /*
+ * Free the internal rep if one exists, and invalidate the string rep.
+ */
+
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tclStringType;
+
+ /*
+ * Allocate enough space for the String structure + Unicode string.
+ */
+
+ stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
+ stringPtr->numChars = numChars;
+ stringPtr->uallocated = uallocated;
+ stringPtr->allocated = 0;
+ memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
+ stringPtr->unicode[numChars] = 0;
+ SET_STRING(objPtr, stringPtr);
+ Tcl_InvalidateStringRep(objPtr);
+ return;
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_AppendToObj --
@@ -326,44 +772,412 @@ Tcl_AppendToObj(objPtr, bytes, length)
* "bytes". If < 0, then append all bytes
* up to NULL byte. */
{
- int newLength, oldLength;
+ String *stringPtr;
if (Tcl_IsShared(objPtr)) {
panic("Tcl_AppendToObj called with shared object");
}
- if (objPtr->typePtr != &tclStringType) {
- ConvertToStringType(objPtr);
- }
+
+ SetStringFromAny(NULL, objPtr);
+
if (length < 0) {
- length = strlen(bytes);
+ length = (bytes ? strlen(bytes) : 0);
+ }
+ if (length == 0) {
+ return;
+ }
+
+ /*
+ * If objPtr has a valid Unicode rep, then append the Unicode
+ * conversion of "bytes" to the objPtr's Unicode rep, otherwise
+ * append "bytes" to objPtr's string rep.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ if (stringPtr->uallocated > 0) {
+ AppendUtfToUnicodeRep(objPtr, bytes, length);
+
+ stringPtr = GET_STRING(objPtr);
+ } else {
+ AppendUtfToUtfRep(objPtr, bytes, length);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendUnicodeToObj --
+ *
+ * This procedure appends a Unicode string to an object in the
+ * most efficient manner possible. Length must be >= 0.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invalidates the string rep and creates a new Unicode string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendUnicodeToObj(objPtr, unicode, length)
+ register Tcl_Obj *objPtr; /* Points to the object to append to. */
+ Tcl_UniChar *unicode; /* The unicode string to append to the
+ * object. */
+ int length; /* Number of chars in "unicode". */
+{
+ String *stringPtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ panic("Tcl_AppendUnicodeToObj called with shared object");
}
+
if (length == 0) {
return;
}
+
+ SetStringFromAny(NULL, objPtr);
+
+ /*
+ * TEMPORARY!!! This is terribly inefficient, but it works, and Don
+ * needs for me to check this stuff in ASAP. -Melissa
+ */
+
+/* UpdateStringOfString(objPtr); */
+/* AppendUnicodeToUtfRep(objPtr, unicode, length); */
+/* return; */
+
+ /*
+ * If objPtr has a valid Unicode rep, then append the "unicode"
+ * to the objPtr's Unicode rep, otherwise the UTF conversion of
+ * "unicode" to objPtr's string rep.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ if (stringPtr->uallocated > 0) {
+ AppendUnicodeToUnicodeRep(objPtr, unicode, length);
+ } else {
+ AppendUnicodeToUtfRep(objPtr, unicode, length);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendObjToObj --
+ *
+ * This procedure appends the string rep of one object to another.
+ * "objPtr" cannot be a shared object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The string rep of appendObjPtr is appended to the string
+ * representation of objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendObjToObj(objPtr, appendObjPtr)
+ Tcl_Obj *objPtr; /* Points to the object to append to. */
+ Tcl_Obj *appendObjPtr; /* Object to append. */
+{
+ String *stringPtr;
+ int length, numChars, allOneByteChars;
+ char *bytes;
+
+ SetStringFromAny(NULL, objPtr);
+
+ /*
+ * If objPtr has a valid Unicode rep, then get a Unicode string
+ * from appendObjPtr and append it.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ if (stringPtr->uallocated > 0) {
+
+ /*
+ * If appendObjPtr is not of the "String" type, don't convert it.
+ */
+
+ if (appendObjPtr->typePtr == &tclStringType) {
+ stringPtr = GET_STRING(appendObjPtr);
+ if ((stringPtr->numChars == -1)
+ || (stringPtr->uallocated == 0)) {
+
+ /*
+ * If appendObjPtr is a string obj with no valide Unicode
+ * rep, then fill its unicode rep.
+ */
+
+ FillUnicodeRep(appendObjPtr);
+ stringPtr = GET_STRING(appendObjPtr);
+ }
+ AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
+ stringPtr->numChars);
+ } else {
+ bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
+ AppendUtfToUnicodeRep(objPtr, bytes, length);
+ }
+ return;
+ }
+
+ /*
+ * Append to objPtr's UTF string rep. If we know the number of
+ * characters in both objects before appending, then set the combined
+ * number of characters in the final (appended-to) object.
+ */
+
+ bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
+
+ allOneByteChars = 0;
+ numChars = stringPtr->numChars;
+ if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
+ stringPtr = GET_STRING(appendObjPtr);
+ if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
+ numChars += stringPtr->numChars;
+ allOneByteChars = 1;
+ }
+ }
+
+ AppendUtfToUtfRep(objPtr, bytes, length);
+
+ if (allOneByteChars) {
+ stringPtr = GET_STRING(objPtr);
+ stringPtr->numChars = numChars;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendUnicodeToUnicodeRep --
+ *
+ * This procedure appends the contents of "unicode" to the Unicode
+ * rep of "objPtr". objPtr must already have a valid Unicode rep.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * objPtr's internal rep is reallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
+ Tcl_Obj *objPtr; /* Points to the object to append to. */
+ Tcl_UniChar *unicode; /* String to append. */
+ int appendNumChars; /* Number of chars of "unicode" to append. */
+{
+ String *stringPtr;
+ int numChars;
+ size_t newSize;
+
+ if (appendNumChars < 0) {
+ appendNumChars = 0;
+ if (unicode) {
+ while (unicode[appendNumChars] != 0) { appendNumChars++; }
+ }
+ }
+ if (appendNumChars == 0) {
+ return;
+ }
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ /*
+ * If not enough space has been allocated for the unicode rep,
+ * reallocate the internal rep object with double the amount of
+ * space needed, so the unicode string can grow without being
+ * reallocated.
+ */
+
+ numChars = stringPtr->numChars + appendNumChars;
+ newSize = (numChars + 1) * sizeof(Tcl_UniChar);
+
+ if (newSize > stringPtr->uallocated) {
+ stringPtr->uallocated = newSize * 2;
+ stringPtr = (String *) ckrealloc((char*)stringPtr,
+ STRING_SIZE(stringPtr->uallocated));
+ SET_STRING(objPtr, stringPtr);
+ }
+
+ /*
+ * Copy the new string onto the end of the old string, then add the
+ * trailing null.
+ */
+
+ memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode,
+ appendNumChars * sizeof(Tcl_UniChar));
+ stringPtr->unicode[numChars] = 0;
+ stringPtr->numChars = numChars;
+
+ SET_STRING(objPtr, stringPtr);
+ Tcl_InvalidateStringRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendUnicodeToUtfRep --
+ *
+ * This procedure converts the contents of "unicode" to UTF and
+ * appends the UTF to the string rep of "objPtr".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * objPtr's internal rep is reallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendUnicodeToUtfRep(objPtr, unicode, numChars)
+ Tcl_Obj *objPtr; /* Points to the object to append to. */
+ Tcl_UniChar *unicode; /* String to convert to UTF. */
+ int numChars; /* Number of chars of "unicode" to convert. */
+{
+ Tcl_DString dsPtr;
+ char *bytes;
+
+ if (numChars < 0) {
+ numChars = 0;
+ if (unicode) {
+ while (unicode[numChars] != 0) { numChars++; }
+ }
+ }
+ if (numChars == 0) {
+ return;
+ }
+
+ Tcl_DStringInit(&dsPtr);
+ bytes = (char *)Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
+ AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
+ Tcl_DStringFree(&dsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendUtfToUnicodeRep --
+ *
+ * This procedure converts the contents of "bytes" to Unicode and
+ * appends the Unicode to the Unicode rep of "objPtr". objPtr must
+ * already have a valid Unicode rep.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * objPtr's internal rep is reallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
+ Tcl_Obj *objPtr; /* Points to the object to append to. */
+ char *bytes; /* String to convert to Unicode. */
+ int numBytes; /* Number of bytes of "bytes" to convert. */
+{
+ Tcl_DString dsPtr;
+ int numChars;
+ Tcl_UniChar *unicode;
+
+ if (numBytes < 0) {
+ numBytes = (bytes ? strlen(bytes) : 0);
+ }
+ if (numBytes == 0) {
+ return;
+ }
+
+ Tcl_DStringInit(&dsPtr);
+ numChars = Tcl_NumUtfChars(bytes, numBytes);
+ unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
+ AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
+ Tcl_DStringFree(&dsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AppendUtfToUtfRep --
+ *
+ * This procedure appends "numBytes" bytes of "bytes" to the UTF string
+ * rep of "objPtr". objPtr must already have a valid String rep.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * objPtr's internal rep is reallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AppendUtfToUtfRep(objPtr, bytes, numBytes)
+ Tcl_Obj *objPtr; /* Points to the object to append to. */
+ char *bytes; /* String to append. */
+ int numBytes; /* Number of bytes of "bytes" to append. */
+{
+ String *stringPtr;
+ int newLength, oldLength;
+
+ if (numBytes < 0) {
+ numBytes = (bytes ? strlen(bytes) : 0);
+ }
+ if (numBytes == 0) {
+ return;
+ }
+
+ /*
+ * Copy the new string onto the end of the old string, then add the
+ * trailing null.
+ */
+
oldLength = objPtr->length;
- newLength = length + oldLength;
- if ((long)newLength > objPtr->internalRep.longValue) {
+ newLength = numBytes + oldLength;
+
+ stringPtr = GET_STRING(objPtr);
+ if (newLength > (int) stringPtr->allocated) {
+
/*
* There isn't currently enough space in the string
- * representation so allocate additional space. In fact,
- * overallocate so that there is room for future growth without
- * having to reallocate again.
+ * representation so allocate additional space. Overallocate the
+ * space by doubling it so that we won't have to do as much
+ * reallocation in the future.
*/
Tcl_SetObjLength(objPtr, 2*newLength);
+ } else {
+
+ /*
+ * Invalidate the unicode data.
+ */
+
+ stringPtr->numChars = -1;
+ stringPtr->uallocated = 0;
}
- if (length > 0) {
- memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
- (size_t) length);
- objPtr->length = newLength;
- objPtr->bytes[objPtr->length] = 0;
- }
+
+ memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
+ (size_t) numBytes);
+ objPtr->bytes[newLength] = 0;
+ objPtr->length = newLength;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_AppendStringsToObj --
+ * Tcl_AppendStringsToObjVA --
*
* This procedure appends one or more null-terminated strings
* to an object.
@@ -379,40 +1193,64 @@ Tcl_AppendToObj(objPtr, bytes, length)
*/
void
-Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
+Tcl_AppendStringsToObjVA (objPtr, argList)
+ Tcl_Obj *objPtr; /* Points to the object to append to. */
+ va_list argList; /* Variable argument list. */
{
- va_list argList;
- register Tcl_Obj *objPtr;
+#define STATIC_LIST_SIZE 16
+ String *stringPtr;
int newLength, oldLength;
register char *string, *dst;
+ char *static_list[STATIC_LIST_SIZE];
+ char **args = static_list;
+ int nargs_space = STATIC_LIST_SIZE;
+ int nargs, i;
- objPtr = (Tcl_Obj *) TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
if (Tcl_IsShared(objPtr)) {
panic("Tcl_AppendStringsToObj called with shared object");
}
- if (objPtr->typePtr != &tclStringType) {
- ConvertToStringType(objPtr);
- }
+
+ SetStringFromAny(NULL, objPtr);
/*
* Figure out how much space is needed for all the strings, and
* expand the string representation if it isn't big enough. If no
- * bytes would be appended, just return.
+ * bytes would be appended, just return. Note that on some platforms
+ * (notably OS/390) the argList is an array so we need to use memcpy.
*/
+ nargs = 0;
newLength = oldLength = objPtr->length;
while (1) {
string = va_arg(argList, char *);
if (string == NULL) {
break;
}
+ if (nargs >= nargs_space) {
+ /*
+ * Expand the args buffer
+ */
+ nargs_space += STATIC_LIST_SIZE;
+ if (args == static_list) {
+ args = (void *)ckalloc(nargs_space * sizeof(char *));
+ for (i = 0; i < nargs; ++i) {
+ args[i] = static_list[i];
+ }
+ } else {
+ args = (void *)ckrealloc((void *)args,
+ nargs_space * sizeof(char *));
+ }
+ }
newLength += strlen(string);
+ args[nargs++] = string;
}
if (newLength == oldLength) {
- return;
+ goto done;
}
- if ((long)newLength > objPtr->internalRep.longValue) {
+ stringPtr = GET_STRING(objPtr);
+ if (newLength > (int) stringPtr->allocated) {
+
/*
* There isn't currently enough space in the string
* representation so allocate additional space. If the current
@@ -430,10 +1268,9 @@ Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
* strings to the object.
*/
- TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
dst = objPtr->bytes + oldLength;
- while (1) {
- string = va_arg(argList, char *);
+ for (i = 0; i < nargs; ++i) {
+ string = args[i];
if (string == NULL) {
break;
}
@@ -455,49 +1292,115 @@ Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
*dst = 0;
}
objPtr->length = newLength;
- va_end(argList);
+
+ done:
+ /*
+ * If we had to allocate a buffer from the heap,
+ * free it now.
+ */
+
+ if (args != static_list) {
+ ckfree((void *)args);
+ }
+#undef STATIC_LIST_SIZE
}
/*
*----------------------------------------------------------------------
*
- * ConvertToStringType --
+ * Tcl_AppendStringsToObj --
*
- * This procedure converts the internal representation of an object
- * to "expandable string" type.
+ * This procedure appends one or more null-terminated strings
+ * to an object.
*
* Results:
* None.
*
* Side effects:
- * Any old internal reputation for objPtr is freed and the
- * internal representation is set to that for an expandable string
- * (the field internalRep.longValue holds 1 less than the allocated
- * length of objPtr's string representation).
+ * The contents of all the string arguments are appended to the
+ * string representation of objPtr.
*
*----------------------------------------------------------------------
*/
+void
+Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
+{
+ register Tcl_Obj *objPtr;
+ va_list argList;
+
+ objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
+ Tcl_AppendStringsToObjVA(objPtr, argList);
+ va_end(argList);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FillUnicodeRep --
+ *
+ * Populate the Unicode internal rep with the Unicode form of its string
+ * rep. The object must alread have a "String" internal rep.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Reallocates the String internal rep.
+ *
+ *---------------------------------------------------------------------------
+ */
+
static void
-ConvertToStringType(objPtr)
- register Tcl_Obj *objPtr; /* Pointer to object. Must have a
- * typePtr that isn't &tclStringType. */
+FillUnicodeRep(objPtr)
+ Tcl_Obj *objPtr; /* The object in which to fill the unicode rep. */
{
- if (objPtr->typePtr != NULL) {
- if (objPtr->bytes == NULL) {
- objPtr->typePtr->updateStringProc(objPtr);
- }
- if (objPtr->typePtr->freeIntRepProc != NULL) {
- objPtr->typePtr->freeIntRepProc(objPtr);
+ String *stringPtr;
+ size_t uallocated;
+ char *src, *srcEnd;
+ Tcl_UniChar *dst;
+ src = objPtr->bytes;
+
+ stringPtr = GET_STRING(objPtr);
+ if (stringPtr->numChars == -1) {
+ stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
+ }
+
+ uallocated = stringPtr->numChars * sizeof(Tcl_UniChar);
+ if (uallocated > stringPtr->uallocated) {
+
+ /*
+ * If not enough space has been allocated for the unicode rep,
+ * reallocate the internal rep object.
+ */
+
+ /*
+ * There isn't currently enough space in the Unicode
+ * representation so allocate additional space. If the current
+ * Unicode representation isn't empty (i.e. it looks like we've
+ * done some appends) then overallocate the space so
+ * that we won't have to do as much reallocation in the future.
+ */
+
+ if (stringPtr->uallocated > 0) {
+ uallocated *= 2;
}
+ stringPtr = (String *) ckrealloc((char*) stringPtr,
+ STRING_SIZE(uallocated));
+ stringPtr->uallocated = uallocated;
}
- objPtr->typePtr = &tclStringType;
- if (objPtr->bytes != NULL) {
- objPtr->internalRep.longValue = (long)objPtr->length;
- } else {
- objPtr->internalRep.longValue = 0;
- objPtr->length = 0;
+
+ /*
+ * Convert src to Unicode and store the coverted data in "unicode".
+ */
+
+ srcEnd = src + objPtr->length;
+ for (dst = stringPtr->unicode; src < srcEnd; dst++) {
+ src += Tcl_UtfToUniChar(src, dst);
}
+ *dst = 0;
+
+ SET_STRING(objPtr, stringPtr);
}
/*
@@ -521,18 +1424,45 @@ ConvertToStringType(objPtr)
static void
DupStringInternalRep(srcPtr, copyPtr)
register Tcl_Obj *srcPtr; /* Object with internal rep to copy. Must
- * have an internal representation of type
- * "expandable string". */
+ * have an internal rep of type "String". */
register Tcl_Obj *copyPtr; /* Object with internal rep to set. Must
* not currently have an internal rep.*/
{
+ String *srcStringPtr = GET_STRING(srcPtr);
+ String *copyStringPtr = NULL;
+
+ /*
+ * If the src obj is a string of 1-byte Utf chars, then copy the
+ * string rep of the source object and create an "empty" Unicode
+ * internal rep for the new object. Otherwise, copy Unicode
+ * internal rep, and invalidate the string rep of the new object.
+ */
+
+ if (srcStringPtr->uallocated == 0) {
+ copyStringPtr = (String *) ckalloc(sizeof(String));
+ copyStringPtr->uallocated = 0;
+ } else {
+ copyStringPtr = (String *) ckalloc(
+ STRING_SIZE(srcStringPtr->uallocated));
+ copyStringPtr->uallocated = srcStringPtr->uallocated;
+
+ memcpy((VOID *) copyStringPtr->unicode,
+ (VOID *) srcStringPtr->unicode,
+ (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
+ copyStringPtr->unicode[srcStringPtr->numChars] = 0;
+ }
+ copyStringPtr->numChars = srcStringPtr->numChars;
+ copyStringPtr->allocated = srcStringPtr->allocated;
+
/*
* Tricky point: the string value was copied by generic object
* management code, so it doesn't contain any extra bytes that
* might exist in the source object.
*/
- copyPtr->internalRep.longValue = (long)copyPtr->length;
+ copyStringPtr->allocated = copyPtr->length;
+
+ SET_STRING(copyPtr, copyStringPtr);
copyPtr->typePtr = &tclStringType;
}
@@ -541,15 +1471,14 @@ DupStringInternalRep(srcPtr, copyPtr)
*
* SetStringFromAny --
*
- * Create an internal representation of type "expandable string"
- * for an object.
+ * Create an internal representation of type "String" for an object.
*
* Results:
* This operation always succeeds and returns TCL_OK.
*
* Side effects:
- * This procedure does nothing; there is no advantage in converting
- * the internal representation now, so we just defer it.
+ * Any old internal reputation for objPtr is freed and the
+ * internal representation is set to "String".
*
*----------------------------------------------------------------------
*/
@@ -559,6 +1488,42 @@ SetStringFromAny(interp, objPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr; /* The object to convert. */
{
+ String *stringPtr;
+
+ /*
+ * The Unicode object is opitmized for the case where each UTF char
+ * in a string is only one byte. In this case, we store the value of
+ * numChars, but we don't copy the bytes to the unicodeObj->unicode.
+ */
+
+ if (objPtr->typePtr != &tclStringType) {
+
+ if (objPtr->typePtr != NULL) {
+ if (objPtr->bytes == NULL) {
+ objPtr->typePtr->updateStringProc(objPtr);
+ }
+ if ((objPtr->typePtr->freeIntRepProc) != NULL) {
+ (*objPtr->typePtr->freeIntRepProc)(objPtr);
+ }
+ }
+ objPtr->typePtr = &tclStringType;
+
+ /*
+ * Allocate enough space for the basic String structure.
+ */
+
+ stringPtr = (String *) ckalloc(sizeof(String));
+ stringPtr->numChars = -1;
+ stringPtr->uallocated = 0;
+
+ if (objPtr->bytes != NULL) {
+ stringPtr->allocated = objPtr->length;
+ objPtr->bytes[objPtr->length] = 0;
+ } else {
+ objPtr->length = 0;
+ }
+ SET_STRING(objPtr, stringPtr);
+ }
return TCL_OK;
}
@@ -568,13 +1533,14 @@ SetStringFromAny(interp, objPtr)
* UpdateStringOfString --
*
* Update the string representation for an object whose internal
- * representation is "expandable string".
+ * representation is "String".
*
* Results:
* None.
*
* Side effects:
- * None.
+ * The object's string may be set by converting its Unicode
+ * represention to UTF format.
*
*----------------------------------------------------------------------
*/
@@ -583,16 +1549,73 @@ static void
UpdateStringOfString(objPtr)
Tcl_Obj *objPtr; /* Object with string rep to update. */
{
- /*
- * The string is almost always valid already, in which case there's
- * nothing for us to do. The only case we have to worry about is if
- * the object is totally null. In this case, set the string rep to
- * an empty string.
- */
+ int i, length, size;
+ Tcl_UniChar *unicode;
+ char dummy[TCL_UTF_MAX];
+ char *dst;
+ String *stringPtr;
+
+ stringPtr = GET_STRING(objPtr);
+ if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
+
+ if (stringPtr->numChars <= 0) {
+
+ /*
+ * If there is no Unicode rep, or the string has 0 chars,
+ * then set the string rep to an empty string.
+ */
+
+ objPtr->bytes = tclEmptyStringRep;
+ objPtr->length = 0;
+ return;
+ }
- if (objPtr->bytes == NULL) {
- objPtr->bytes = tclEmptyStringRep;
- objPtr->length = 0;
+ unicode = stringPtr->unicode;
+ length = stringPtr->numChars * sizeof(Tcl_UniChar);
+
+ /*
+ * Translate the Unicode string to UTF. "size" will hold the
+ * amount of space the UTF string needs.
+ */
+
+ size = 0;
+ for (i = 0; i < stringPtr->numChars; i++) {
+ size += Tcl_UniCharToUtf((int) unicode[i], dummy);
+ }
+
+ dst = (char *) ckalloc((unsigned) (size + 1));
+ objPtr->bytes = dst;
+ objPtr->length = size;
+ stringPtr->allocated = size;
+
+ for (i = 0; i < stringPtr->numChars; i++) {
+ dst += Tcl_UniCharToUtf(unicode[i], dst);
+ }
+ *dst = '\0';
}
return;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeStringInternalRep --
+ *
+ * Deallocate the storage associated with a String data object's
+ * internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeStringInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* Object with internal rep to free. */
+{
+ ckfree((char *) GET_STRING(objPtr));
+}
diff --git a/tcl/generic/tclStubInit.c b/tcl/generic/tclStubInit.c
new file mode 100644
index 00000000000..fec95ec45f4
--- /dev/null
+++ b/tcl/generic/tclStubInit.c
@@ -0,0 +1,817 @@
+/*
+ * tclStubInit.c --
+ *
+ * This file contains the initializers for the Tcl stub vectors.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Remove macros that will interfere with the definitions below.
+ */
+
+#undef Tcl_Alloc
+#undef Tcl_Free
+#undef Tcl_Realloc
+#undef Tcl_NewBooleanObj
+#undef Tcl_NewByteArrayObj
+#undef Tcl_NewDoubleObj
+#undef Tcl_NewIntObj
+#undef Tcl_NewListObj
+#undef Tcl_NewLongObj
+#undef Tcl_NewObj
+#undef Tcl_NewStringObj
+#undef Tcl_DumpActiveMemory
+#undef Tcl_ValidateAllMemory
+
+/*
+ * WARNING: The contents of this file is automatically generated by the
+ * tools/genStubs.tcl script. Any modifications to the function declarations
+ * below should be made in the generic/tcl.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+TclIntStubs tclIntStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+ TclAccess, /* 0 */
+ TclAccessDeleteProc, /* 1 */
+ TclAccessInsertProc, /* 2 */
+ TclAllocateFreeObjects, /* 3 */
+ NULL, /* 4 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ TclCleanupChildren, /* 5 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TclCleanupChildren, /* 5 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 5 */
+#endif /* MAC_TCL */
+ TclCleanupCommand, /* 6 */
+ TclCopyAndCollapse, /* 7 */
+ TclCopyChannel, /* 8 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ TclCreatePipeline, /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TclCreatePipeline, /* 9 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 9 */
+#endif /* MAC_TCL */
+ TclCreateProc, /* 10 */
+ TclDeleteCompiledLocalVars, /* 11 */
+ TclDeleteVars, /* 12 */
+ TclDoGlob, /* 13 */
+ TclDumpMemoryInfo, /* 14 */
+ NULL, /* 15 */
+ TclExprFloatError, /* 16 */
+ TclFileAttrsCmd, /* 17 */
+ TclFileCopyCmd, /* 18 */
+ TclFileDeleteCmd, /* 19 */
+ TclFileMakeDirsCmd, /* 20 */
+ TclFileRenameCmd, /* 21 */
+ TclFindElement, /* 22 */
+ TclFindProc, /* 23 */
+ TclFormatInt, /* 24 */
+ TclFreePackageInfo, /* 25 */
+ NULL, /* 26 */
+ TclGetDate, /* 27 */
+ TclpGetDefaultStdChannel, /* 28 */
+ TclGetElementOfIndexedArray, /* 29 */
+ NULL, /* 30 */
+ TclGetExtension, /* 31 */
+ TclGetFrame, /* 32 */
+ TclGetInterpProc, /* 33 */
+ TclGetIntForIndex, /* 34 */
+ TclGetIndexedScalar, /* 35 */
+ TclGetLong, /* 36 */
+ TclGetLoadedPackages, /* 37 */
+ TclGetNamespaceForQualName, /* 38 */
+ TclGetObjInterpProc, /* 39 */
+ TclGetOpenMode, /* 40 */
+ TclGetOriginalCommand, /* 41 */
+ TclpGetUserHome, /* 42 */
+ TclGlobalInvoke, /* 43 */
+ TclGuessPackageName, /* 44 */
+ TclHideUnsafeCommands, /* 45 */
+ TclInExit, /* 46 */
+ TclIncrElementOfIndexedArray, /* 47 */
+ TclIncrIndexedScalar, /* 48 */
+ TclIncrVar2, /* 49 */
+ TclInitCompiledLocals, /* 50 */
+ TclInterpInit, /* 51 */
+ TclInvoke, /* 52 */
+ TclInvokeObjectCommand, /* 53 */
+ TclInvokeStringCommand, /* 54 */
+ TclIsProc, /* 55 */
+ NULL, /* 56 */
+ NULL, /* 57 */
+ TclLookupVar, /* 58 */
+ TclpMatchFiles, /* 59 */
+ TclNeedSpace, /* 60 */
+ TclNewProcBodyObj, /* 61 */
+ TclObjCommandComplete, /* 62 */
+ TclObjInterpProc, /* 63 */
+ TclObjInvoke, /* 64 */
+ TclObjInvokeGlobal, /* 65 */
+ TclOpenFileChannelDeleteProc, /* 66 */
+ TclOpenFileChannelInsertProc, /* 67 */
+ TclpAccess, /* 68 */
+ TclpAlloc, /* 69 */
+ TclpCopyFile, /* 70 */
+ TclpCopyDirectory, /* 71 */
+ TclpCreateDirectory, /* 72 */
+ TclpDeleteFile, /* 73 */
+ TclpFree, /* 74 */
+ TclpGetClicks, /* 75 */
+ TclpGetSeconds, /* 76 */
+ TclpGetTime, /* 77 */
+ TclpGetTimeZone, /* 78 */
+ TclpListVolumes, /* 79 */
+ TclpOpenFileChannel, /* 80 */
+ TclpRealloc, /* 81 */
+ TclpRemoveDirectory, /* 82 */
+ TclpRenameFile, /* 83 */
+ NULL, /* 84 */
+ NULL, /* 85 */
+ NULL, /* 86 */
+ NULL, /* 87 */
+ TclPrecTraceProc, /* 88 */
+ TclPreventAliasLoop, /* 89 */
+ NULL, /* 90 */
+ TclProcCleanupProc, /* 91 */
+ TclProcCompileProc, /* 92 */
+ TclProcDeleteProc, /* 93 */
+ TclProcInterpProc, /* 94 */
+ TclpStat, /* 95 */
+ TclRenameCommand, /* 96 */
+ TclResetShadowedCmdRefs, /* 97 */
+ TclServiceIdle, /* 98 */
+ TclSetElementOfIndexedArray, /* 99 */
+ TclSetIndexedScalar, /* 100 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ TclSetPreInitScript, /* 101 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TclSetPreInitScript, /* 101 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 101 */
+#endif /* MAC_TCL */
+ TclSetupEnv, /* 102 */
+ TclSockGetPort, /* 103 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ TclSockMinimumBuffers, /* 104 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TclSockMinimumBuffers, /* 104 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 104 */
+#endif /* MAC_TCL */
+ TclStat, /* 105 */
+ TclStatDeleteProc, /* 106 */
+ TclStatInsertProc, /* 107 */
+ TclTeardownNamespace, /* 108 */
+ TclUpdateReturnInfo, /* 109 */
+ NULL, /* 110 */
+ Tcl_AddInterpResolvers, /* 111 */
+ Tcl_AppendExportList, /* 112 */
+ Tcl_CreateNamespace, /* 113 */
+ Tcl_DeleteNamespace, /* 114 */
+ Tcl_Export, /* 115 */
+ Tcl_FindCommand, /* 116 */
+ Tcl_FindNamespace, /* 117 */
+ Tcl_GetInterpResolvers, /* 118 */
+ Tcl_GetNamespaceResolvers, /* 119 */
+ Tcl_FindNamespaceVar, /* 120 */
+ Tcl_ForgetImport, /* 121 */
+ Tcl_GetCommandFromObj, /* 122 */
+ Tcl_GetCommandFullName, /* 123 */
+ Tcl_GetCurrentNamespace, /* 124 */
+ Tcl_GetGlobalNamespace, /* 125 */
+ Tcl_GetVariableFullName, /* 126 */
+ Tcl_Import, /* 127 */
+ Tcl_PopCallFrame, /* 128 */
+ Tcl_PushCallFrame, /* 129 */
+ Tcl_RemoveInterpResolvers, /* 130 */
+ Tcl_SetNamespaceResolvers, /* 131 */
+ TclpHasSockets, /* 132 */
+ TclpGetDate, /* 133 */
+ TclpStrftime, /* 134 */
+ TclpCheckStackSpace, /* 135 */
+ NULL, /* 136 */
+ TclpChdir, /* 137 */
+ TclGetEnv, /* 138 */
+ TclpLoadFile, /* 139 */
+ TclLooksLikeInt, /* 140 */
+ TclpGetCwd, /* 141 */
+ TclSetByteCodeFromAny, /* 142 */
+ TclAddLiteralObj, /* 143 */
+ TclHideLiteral, /* 144 */
+ TclGetAuxDataType, /* 145 */
+ TclHandleCreate, /* 146 */
+ TclHandleFree, /* 147 */
+ TclHandlePreserve, /* 148 */
+ TclHandleRelease, /* 149 */
+ TclRegAbout, /* 150 */
+ TclRegExpRangeUniChar, /* 151 */
+ TclSetLibraryPath, /* 152 */
+ TclGetLibraryPath, /* 153 */
+ NULL, /* 154 */
+ NULL, /* 155 */
+ TclRegError, /* 156 */
+ TclVarTraceExists, /* 157 */
+ TclSetStartupScriptFileName, /* 158 */
+ TclGetStartupScriptFileName, /* 159 */
+ TclpMatchFilesTypes, /* 160 */
+ TclChannelTransform, /* 161 */
+ TclChannelEventScriptInvoker, /* 162 */
+};
+
+TclIntPlatStubs tclIntPlatStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ TclGetAndDetachPids, /* 0 */
+ TclpCloseFile, /* 1 */
+ TclpCreateCommandChannel, /* 2 */
+ TclpCreatePipe, /* 3 */
+ TclpCreateProcess, /* 4 */
+ NULL, /* 5 */
+ TclpMakeFile, /* 6 */
+ TclpOpenFile, /* 7 */
+ TclUnixWaitForFile, /* 8 */
+ TclpCreateTempFile, /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TclWinConvertError, /* 0 */
+ TclWinConvertWSAError, /* 1 */
+ TclWinGetServByName, /* 2 */
+ TclWinGetSockOpt, /* 3 */
+ TclWinGetTclInstance, /* 4 */
+ NULL, /* 5 */
+ TclWinNToHS, /* 6 */
+ TclWinSetSockOpt, /* 7 */
+ TclpGetPid, /* 8 */
+ TclWinGetPlatformId, /* 9 */
+ NULL, /* 10 */
+ TclGetAndDetachPids, /* 11 */
+ TclpCloseFile, /* 12 */
+ TclpCreateCommandChannel, /* 13 */
+ TclpCreatePipe, /* 14 */
+ TclpCreateProcess, /* 15 */
+ NULL, /* 16 */
+ NULL, /* 17 */
+ TclpMakeFile, /* 18 */
+ TclpOpenFile, /* 19 */
+ TclWinAddProcess, /* 20 */
+ TclpAsyncMark, /* 21 */
+ TclpCreateTempFile, /* 22 */
+ TclpGetTZName, /* 23 */
+ TclWinNoBackslash, /* 24 */
+ TclWinGetPlatform, /* 25 */
+ TclWinSetInterfaces, /* 26 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TclpSysAlloc, /* 0 */
+ TclpSysFree, /* 1 */
+ TclpSysRealloc, /* 2 */
+ TclpExit, /* 3 */
+ FSpGetDefaultDir, /* 4 */
+ FSpSetDefaultDir, /* 5 */
+ FSpFindFolder, /* 6 */
+ GetGlobalMouse, /* 7 */
+ FSpGetDirectoryID, /* 8 */
+ FSpOpenResFileCompat, /* 9 */
+ FSpCreateResFileCompat, /* 10 */
+ FSpLocationFromPath, /* 11 */
+ FSpPathFromLocation, /* 12 */
+ TclMacExitHandler, /* 13 */
+ TclMacInitExitToShell, /* 14 */
+ TclMacInstallExitToShellPatch, /* 15 */
+ TclMacOSErrorToPosixError, /* 16 */
+ TclMacRemoveTimer, /* 17 */
+ TclMacStartTimer, /* 18 */
+ TclMacTimerExpired, /* 19 */
+ TclMacRegisterResourceFork, /* 20 */
+ TclMacUnRegisterResourceFork, /* 21 */
+ TclMacCreateEnv, /* 22 */
+ TclMacFOpenHack, /* 23 */
+ NULL, /* 24 */
+ TclMacChmod, /* 25 */
+#endif /* MAC_TCL */
+};
+
+TclPlatStubs tclPlatStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+#ifdef __WIN32__
+ Tcl_WinUtfToTChar, /* 0 */
+ Tcl_WinTCharToUtf, /* 1 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ Tcl_MacSetEventProc, /* 0 */
+ Tcl_MacConvertTextResource, /* 1 */
+ Tcl_MacEvalResource, /* 2 */
+ Tcl_MacFindResource, /* 3 */
+ Tcl_GetOSTypeFromObj, /* 4 */
+ Tcl_SetOSTypeObj, /* 5 */
+ Tcl_NewOSTypeObj, /* 6 */
+ strncasecmp, /* 7 */
+ strcasecmp, /* 8 */
+#endif /* MAC_TCL */
+};
+
+static TclStubHooks tclStubHooks = {
+ &tclPlatStubs,
+ &tclIntStubs,
+ &tclIntPlatStubs
+};
+
+TclStubs tclStubs = {
+ TCL_STUB_MAGIC,
+ &tclStubHooks,
+ Tcl_PkgProvideEx, /* 0 */
+ Tcl_PkgRequireEx, /* 1 */
+ Tcl_Panic, /* 2 */
+ Tcl_Alloc, /* 3 */
+ Tcl_Free, /* 4 */
+ Tcl_Realloc, /* 5 */
+ Tcl_DbCkalloc, /* 6 */
+ Tcl_DbCkfree, /* 7 */
+ Tcl_DbCkrealloc, /* 8 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ Tcl_CreateFileHandler, /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 9 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 9 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ Tcl_DeleteFileHandler, /* 10 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 10 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 10 */
+#endif /* MAC_TCL */
+ Tcl_SetTimer, /* 11 */
+ Tcl_Sleep, /* 12 */
+ Tcl_WaitForEvent, /* 13 */
+ Tcl_AppendAllObjTypes, /* 14 */
+ Tcl_AppendStringsToObj, /* 15 */
+ Tcl_AppendToObj, /* 16 */
+ Tcl_ConcatObj, /* 17 */
+ Tcl_ConvertToType, /* 18 */
+ Tcl_DbDecrRefCount, /* 19 */
+ Tcl_DbIncrRefCount, /* 20 */
+ Tcl_DbIsShared, /* 21 */
+ Tcl_DbNewBooleanObj, /* 22 */
+ Tcl_DbNewByteArrayObj, /* 23 */
+ Tcl_DbNewDoubleObj, /* 24 */
+ Tcl_DbNewListObj, /* 25 */
+ Tcl_DbNewLongObj, /* 26 */
+ Tcl_DbNewObj, /* 27 */
+ Tcl_DbNewStringObj, /* 28 */
+ Tcl_DuplicateObj, /* 29 */
+ TclFreeObj, /* 30 */
+ Tcl_GetBoolean, /* 31 */
+ Tcl_GetBooleanFromObj, /* 32 */
+ Tcl_GetByteArrayFromObj, /* 33 */
+ Tcl_GetDouble, /* 34 */
+ Tcl_GetDoubleFromObj, /* 35 */
+ Tcl_GetIndexFromObj, /* 36 */
+ Tcl_GetInt, /* 37 */
+ Tcl_GetIntFromObj, /* 38 */
+ Tcl_GetLongFromObj, /* 39 */
+ Tcl_GetObjType, /* 40 */
+ Tcl_GetStringFromObj, /* 41 */
+ Tcl_InvalidateStringRep, /* 42 */
+ Tcl_ListObjAppendList, /* 43 */
+ Tcl_ListObjAppendElement, /* 44 */
+ Tcl_ListObjGetElements, /* 45 */
+ Tcl_ListObjIndex, /* 46 */
+ Tcl_ListObjLength, /* 47 */
+ Tcl_ListObjReplace, /* 48 */
+ Tcl_NewBooleanObj, /* 49 */
+ Tcl_NewByteArrayObj, /* 50 */
+ Tcl_NewDoubleObj, /* 51 */
+ Tcl_NewIntObj, /* 52 */
+ Tcl_NewListObj, /* 53 */
+ Tcl_NewLongObj, /* 54 */
+ Tcl_NewObj, /* 55 */
+ Tcl_NewStringObj, /* 56 */
+ Tcl_SetBooleanObj, /* 57 */
+ Tcl_SetByteArrayLength, /* 58 */
+ Tcl_SetByteArrayObj, /* 59 */
+ Tcl_SetDoubleObj, /* 60 */
+ Tcl_SetIntObj, /* 61 */
+ Tcl_SetListObj, /* 62 */
+ Tcl_SetLongObj, /* 63 */
+ Tcl_SetObjLength, /* 64 */
+ Tcl_SetStringObj, /* 65 */
+ Tcl_AddErrorInfo, /* 66 */
+ Tcl_AddObjErrorInfo, /* 67 */
+ Tcl_AllowExceptions, /* 68 */
+ Tcl_AppendElement, /* 69 */
+ Tcl_AppendResult, /* 70 */
+ Tcl_AsyncCreate, /* 71 */
+ Tcl_AsyncDelete, /* 72 */
+ Tcl_AsyncInvoke, /* 73 */
+ Tcl_AsyncMark, /* 74 */
+ Tcl_AsyncReady, /* 75 */
+ Tcl_BackgroundError, /* 76 */
+ Tcl_Backslash, /* 77 */
+ Tcl_BadChannelOption, /* 78 */
+ Tcl_CallWhenDeleted, /* 79 */
+ Tcl_CancelIdleCall, /* 80 */
+ Tcl_Close, /* 81 */
+ Tcl_CommandComplete, /* 82 */
+ Tcl_Concat, /* 83 */
+ Tcl_ConvertElement, /* 84 */
+ Tcl_ConvertCountedElement, /* 85 */
+ Tcl_CreateAlias, /* 86 */
+ Tcl_CreateAliasObj, /* 87 */
+ Tcl_CreateChannel, /* 88 */
+ Tcl_CreateChannelHandler, /* 89 */
+ Tcl_CreateCloseHandler, /* 90 */
+ Tcl_CreateCommand, /* 91 */
+ Tcl_CreateEventSource, /* 92 */
+ Tcl_CreateExitHandler, /* 93 */
+ Tcl_CreateInterp, /* 94 */
+ Tcl_CreateMathFunc, /* 95 */
+ Tcl_CreateObjCommand, /* 96 */
+ Tcl_CreateSlave, /* 97 */
+ Tcl_CreateTimerHandler, /* 98 */
+ Tcl_CreateTrace, /* 99 */
+ Tcl_DeleteAssocData, /* 100 */
+ Tcl_DeleteChannelHandler, /* 101 */
+ Tcl_DeleteCloseHandler, /* 102 */
+ Tcl_DeleteCommand, /* 103 */
+ Tcl_DeleteCommandFromToken, /* 104 */
+ Tcl_DeleteEvents, /* 105 */
+ Tcl_DeleteEventSource, /* 106 */
+ Tcl_DeleteExitHandler, /* 107 */
+ Tcl_DeleteHashEntry, /* 108 */
+ Tcl_DeleteHashTable, /* 109 */
+ Tcl_DeleteInterp, /* 110 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ Tcl_DetachPids, /* 111 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ Tcl_DetachPids, /* 111 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 111 */
+#endif /* MAC_TCL */
+ Tcl_DeleteTimerHandler, /* 112 */
+ Tcl_DeleteTrace, /* 113 */
+ Tcl_DontCallWhenDeleted, /* 114 */
+ Tcl_DoOneEvent, /* 115 */
+ Tcl_DoWhenIdle, /* 116 */
+ Tcl_DStringAppend, /* 117 */
+ Tcl_DStringAppendElement, /* 118 */
+ Tcl_DStringEndSublist, /* 119 */
+ Tcl_DStringFree, /* 120 */
+ Tcl_DStringGetResult, /* 121 */
+ Tcl_DStringInit, /* 122 */
+ Tcl_DStringResult, /* 123 */
+ Tcl_DStringSetLength, /* 124 */
+ Tcl_DStringStartSublist, /* 125 */
+ Tcl_Eof, /* 126 */
+ Tcl_ErrnoId, /* 127 */
+ Tcl_ErrnoMsg, /* 128 */
+ Tcl_Eval, /* 129 */
+ Tcl_EvalFile, /* 130 */
+ Tcl_EvalObj, /* 131 */
+ Tcl_EventuallyFree, /* 132 */
+ Tcl_Exit, /* 133 */
+ Tcl_ExposeCommand, /* 134 */
+ Tcl_ExprBoolean, /* 135 */
+ Tcl_ExprBooleanObj, /* 136 */
+ Tcl_ExprDouble, /* 137 */
+ Tcl_ExprDoubleObj, /* 138 */
+ Tcl_ExprLong, /* 139 */
+ Tcl_ExprLongObj, /* 140 */
+ Tcl_ExprObj, /* 141 */
+ Tcl_ExprString, /* 142 */
+ Tcl_Finalize, /* 143 */
+ Tcl_FindExecutable, /* 144 */
+ Tcl_FirstHashEntry, /* 145 */
+ Tcl_Flush, /* 146 */
+ Tcl_FreeResult, /* 147 */
+ Tcl_GetAlias, /* 148 */
+ Tcl_GetAliasObj, /* 149 */
+ Tcl_GetAssocData, /* 150 */
+ Tcl_GetChannel, /* 151 */
+ Tcl_GetChannelBufferSize, /* 152 */
+ Tcl_GetChannelHandle, /* 153 */
+ Tcl_GetChannelInstanceData, /* 154 */
+ Tcl_GetChannelMode, /* 155 */
+ Tcl_GetChannelName, /* 156 */
+ Tcl_GetChannelOption, /* 157 */
+ Tcl_GetChannelType, /* 158 */
+ Tcl_GetCommandInfo, /* 159 */
+ Tcl_GetCommandName, /* 160 */
+ Tcl_GetErrno, /* 161 */
+ Tcl_GetHostName, /* 162 */
+ Tcl_GetInterpPath, /* 163 */
+ Tcl_GetMaster, /* 164 */
+ Tcl_GetNameOfExecutable, /* 165 */
+ Tcl_GetObjResult, /* 166 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ Tcl_GetOpenFile, /* 167 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 167 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 167 */
+#endif /* MAC_TCL */
+ Tcl_GetPathType, /* 168 */
+ Tcl_Gets, /* 169 */
+ Tcl_GetsObj, /* 170 */
+ Tcl_GetServiceMode, /* 171 */
+ Tcl_GetSlave, /* 172 */
+ Tcl_GetStdChannel, /* 173 */
+ Tcl_GetStringResult, /* 174 */
+ Tcl_GetVar, /* 175 */
+ Tcl_GetVar2, /* 176 */
+ Tcl_GlobalEval, /* 177 */
+ Tcl_GlobalEvalObj, /* 178 */
+ Tcl_HideCommand, /* 179 */
+ Tcl_Init, /* 180 */
+ Tcl_InitHashTable, /* 181 */
+ Tcl_InputBlocked, /* 182 */
+ Tcl_InputBuffered, /* 183 */
+ Tcl_InterpDeleted, /* 184 */
+ Tcl_IsSafe, /* 185 */
+ Tcl_JoinPath, /* 186 */
+ Tcl_LinkVar, /* 187 */
+ NULL, /* 188 */
+ Tcl_MakeFileChannel, /* 189 */
+ Tcl_MakeSafe, /* 190 */
+ Tcl_MakeTcpClientChannel, /* 191 */
+ Tcl_Merge, /* 192 */
+ Tcl_NextHashEntry, /* 193 */
+ Tcl_NotifyChannel, /* 194 */
+ Tcl_ObjGetVar2, /* 195 */
+ Tcl_ObjSetVar2, /* 196 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ Tcl_OpenCommandChannel, /* 197 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ Tcl_OpenCommandChannel, /* 197 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 197 */
+#endif /* MAC_TCL */
+ Tcl_OpenFileChannel, /* 198 */
+ Tcl_OpenTcpClient, /* 199 */
+ Tcl_OpenTcpServer, /* 200 */
+ Tcl_Preserve, /* 201 */
+ Tcl_PrintDouble, /* 202 */
+ Tcl_PutEnv, /* 203 */
+ Tcl_PosixError, /* 204 */
+ Tcl_QueueEvent, /* 205 */
+ Tcl_Read, /* 206 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ Tcl_ReapDetachedProcs, /* 207 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ Tcl_ReapDetachedProcs, /* 207 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 207 */
+#endif /* MAC_TCL */
+ Tcl_RecordAndEval, /* 208 */
+ Tcl_RecordAndEvalObj, /* 209 */
+ Tcl_RegisterChannel, /* 210 */
+ Tcl_RegisterObjType, /* 211 */
+ Tcl_RegExpCompile, /* 212 */
+ Tcl_RegExpExec, /* 213 */
+ Tcl_RegExpMatch, /* 214 */
+ Tcl_RegExpRange, /* 215 */
+ Tcl_Release, /* 216 */
+ Tcl_ResetResult, /* 217 */
+ Tcl_ScanElement, /* 218 */
+ Tcl_ScanCountedElement, /* 219 */
+ Tcl_Seek, /* 220 */
+ Tcl_ServiceAll, /* 221 */
+ Tcl_ServiceEvent, /* 222 */
+ Tcl_SetAssocData, /* 223 */
+ Tcl_SetChannelBufferSize, /* 224 */
+ Tcl_SetChannelOption, /* 225 */
+ Tcl_SetCommandInfo, /* 226 */
+ Tcl_SetErrno, /* 227 */
+ Tcl_SetErrorCode, /* 228 */
+ Tcl_SetMaxBlockTime, /* 229 */
+ Tcl_SetPanicProc, /* 230 */
+ Tcl_SetRecursionLimit, /* 231 */
+ Tcl_SetResult, /* 232 */
+ Tcl_SetServiceMode, /* 233 */
+ Tcl_SetObjErrorCode, /* 234 */
+ Tcl_SetObjResult, /* 235 */
+ Tcl_SetStdChannel, /* 236 */
+ Tcl_SetVar, /* 237 */
+ Tcl_SetVar2, /* 238 */
+ Tcl_SignalId, /* 239 */
+ Tcl_SignalMsg, /* 240 */
+ Tcl_SourceRCFile, /* 241 */
+ Tcl_SplitList, /* 242 */
+ Tcl_SplitPath, /* 243 */
+ Tcl_StaticPackage, /* 244 */
+ Tcl_StringMatch, /* 245 */
+ Tcl_Tell, /* 246 */
+ Tcl_TraceVar, /* 247 */
+ Tcl_TraceVar2, /* 248 */
+ Tcl_TranslateFileName, /* 249 */
+ Tcl_Ungets, /* 250 */
+ Tcl_UnlinkVar, /* 251 */
+ Tcl_UnregisterChannel, /* 252 */
+ Tcl_UnsetVar, /* 253 */
+ Tcl_UnsetVar2, /* 254 */
+ Tcl_UntraceVar, /* 255 */
+ Tcl_UntraceVar2, /* 256 */
+ Tcl_UpdateLinkedVar, /* 257 */
+ Tcl_UpVar, /* 258 */
+ Tcl_UpVar2, /* 259 */
+ Tcl_VarEval, /* 260 */
+ Tcl_VarTraceInfo, /* 261 */
+ Tcl_VarTraceInfo2, /* 262 */
+ Tcl_Write, /* 263 */
+ Tcl_WrongNumArgs, /* 264 */
+ Tcl_DumpActiveMemory, /* 265 */
+ Tcl_ValidateAllMemory, /* 266 */
+ Tcl_AppendResultVA, /* 267 */
+ Tcl_AppendStringsToObjVA, /* 268 */
+ Tcl_HashStats, /* 269 */
+ Tcl_ParseVar, /* 270 */
+ Tcl_PkgPresent, /* 271 */
+ Tcl_PkgPresentEx, /* 272 */
+ Tcl_PkgProvide, /* 273 */
+ Tcl_PkgRequire, /* 274 */
+ Tcl_SetErrorCodeVA, /* 275 */
+ Tcl_VarEvalVA, /* 276 */
+ Tcl_WaitPid, /* 277 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ Tcl_PanicVA, /* 278 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ Tcl_PanicVA, /* 278 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ NULL, /* 278 */
+#endif /* MAC_TCL */
+ Tcl_GetVersion, /* 279 */
+ Tcl_InitMemory, /* 280 */
+ Tcl_StackChannel, /* 281 */
+ Tcl_UnstackChannel, /* 282 */
+ Tcl_GetStackedChannel, /* 283 */
+ NULL, /* 284 */
+ NULL, /* 285 */
+ Tcl_AppendObjToObj, /* 286 */
+ Tcl_CreateEncoding, /* 287 */
+ Tcl_CreateThreadExitHandler, /* 288 */
+ Tcl_DeleteThreadExitHandler, /* 289 */
+ Tcl_DiscardResult, /* 290 */
+ Tcl_EvalEx, /* 291 */
+ Tcl_EvalObjv, /* 292 */
+ Tcl_EvalObjEx, /* 293 */
+ Tcl_ExitThread, /* 294 */
+ Tcl_ExternalToUtf, /* 295 */
+ Tcl_ExternalToUtfDString, /* 296 */
+ Tcl_FinalizeThread, /* 297 */
+ Tcl_FinalizeNotifier, /* 298 */
+ Tcl_FreeEncoding, /* 299 */
+ Tcl_GetCurrentThread, /* 300 */
+ Tcl_GetEncoding, /* 301 */
+ Tcl_GetEncodingName, /* 302 */
+ Tcl_GetEncodingNames, /* 303 */
+ Tcl_GetIndexFromObjStruct, /* 304 */
+ Tcl_GetThreadData, /* 305 */
+ Tcl_GetVar2Ex, /* 306 */
+ Tcl_InitNotifier, /* 307 */
+ Tcl_MutexLock, /* 308 */
+ Tcl_MutexUnlock, /* 309 */
+ Tcl_ConditionNotify, /* 310 */
+ Tcl_ConditionWait, /* 311 */
+ Tcl_NumUtfChars, /* 312 */
+ Tcl_ReadChars, /* 313 */
+ Tcl_RestoreResult, /* 314 */
+ Tcl_SaveResult, /* 315 */
+ Tcl_SetSystemEncoding, /* 316 */
+ Tcl_SetVar2Ex, /* 317 */
+ Tcl_ThreadAlert, /* 318 */
+ Tcl_ThreadQueueEvent, /* 319 */
+ Tcl_UniCharAtIndex, /* 320 */
+ Tcl_UniCharToLower, /* 321 */
+ Tcl_UniCharToTitle, /* 322 */
+ Tcl_UniCharToUpper, /* 323 */
+ Tcl_UniCharToUtf, /* 324 */
+ Tcl_UtfAtIndex, /* 325 */
+ Tcl_UtfCharComplete, /* 326 */
+ Tcl_UtfBackslash, /* 327 */
+ Tcl_UtfFindFirst, /* 328 */
+ Tcl_UtfFindLast, /* 329 */
+ Tcl_UtfNext, /* 330 */
+ Tcl_UtfPrev, /* 331 */
+ Tcl_UtfToExternal, /* 332 */
+ Tcl_UtfToExternalDString, /* 333 */
+ Tcl_UtfToLower, /* 334 */
+ Tcl_UtfToTitle, /* 335 */
+ Tcl_UtfToUniChar, /* 336 */
+ Tcl_UtfToUpper, /* 337 */
+ Tcl_WriteChars, /* 338 */
+ Tcl_WriteObj, /* 339 */
+ Tcl_GetString, /* 340 */
+ Tcl_GetDefaultEncodingDir, /* 341 */
+ Tcl_SetDefaultEncodingDir, /* 342 */
+ Tcl_AlertNotifier, /* 343 */
+ Tcl_ServiceModeHook, /* 344 */
+ Tcl_UniCharIsAlnum, /* 345 */
+ Tcl_UniCharIsAlpha, /* 346 */
+ Tcl_UniCharIsDigit, /* 347 */
+ Tcl_UniCharIsLower, /* 348 */
+ Tcl_UniCharIsSpace, /* 349 */
+ Tcl_UniCharIsUpper, /* 350 */
+ Tcl_UniCharIsWordChar, /* 351 */
+ Tcl_UniCharLen, /* 352 */
+ Tcl_UniCharNcmp, /* 353 */
+ Tcl_UniCharToUtfDString, /* 354 */
+ Tcl_UtfToUniCharDString, /* 355 */
+ Tcl_GetRegExpFromObj, /* 356 */
+ Tcl_EvalTokens, /* 357 */
+ Tcl_FreeParse, /* 358 */
+ Tcl_LogCommandInfo, /* 359 */
+ Tcl_ParseBraces, /* 360 */
+ Tcl_ParseCommand, /* 361 */
+ Tcl_ParseExpr, /* 362 */
+ Tcl_ParseQuotedString, /* 363 */
+ Tcl_ParseVarName, /* 364 */
+ Tcl_GetCwd, /* 365 */
+ Tcl_Chdir, /* 366 */
+ Tcl_Access, /* 367 */
+ Tcl_Stat, /* 368 */
+ Tcl_UtfNcmp, /* 369 */
+ Tcl_UtfNcasecmp, /* 370 */
+ Tcl_StringCaseMatch, /* 371 */
+ Tcl_UniCharIsControl, /* 372 */
+ Tcl_UniCharIsGraph, /* 373 */
+ Tcl_UniCharIsPrint, /* 374 */
+ Tcl_UniCharIsPunct, /* 375 */
+ Tcl_RegExpExecObj, /* 376 */
+ Tcl_RegExpGetInfo, /* 377 */
+ Tcl_NewUnicodeObj, /* 378 */
+ Tcl_SetUnicodeObj, /* 379 */
+ Tcl_GetCharLength, /* 380 */
+ Tcl_GetUniChar, /* 381 */
+ Tcl_GetUnicode, /* 382 */
+ Tcl_GetRange, /* 383 */
+ Tcl_AppendUnicodeToObj, /* 384 */
+ Tcl_RegExpMatchObj, /* 385 */
+ Tcl_SetNotifier, /* 386 */
+ Tcl_GetAllocMutex, /* 387 */
+ Tcl_GetChannelNames, /* 388 */
+ Tcl_GetChannelNamesEx, /* 389 */
+ Tcl_ProcObjCmd, /* 390 */
+ Tcl_ConditionFinalize, /* 391 */
+ Tcl_MutexFinalize, /* 392 */
+ Tcl_CreateThread, /* 393 */
+ Tcl_ReadRaw, /* 394 */
+ Tcl_WriteRaw, /* 395 */
+ Tcl_GetTopChannel, /* 396 */
+ Tcl_ChannelBuffered, /* 397 */
+ Tcl_ChannelName, /* 398 */
+ Tcl_ChannelVersion, /* 399 */
+ Tcl_ChannelBlockModeProc, /* 400 */
+ Tcl_ChannelCloseProc, /* 401 */
+ Tcl_ChannelClose2Proc, /* 402 */
+ Tcl_ChannelInputProc, /* 403 */
+ Tcl_ChannelOutputProc, /* 404 */
+ Tcl_ChannelSeekProc, /* 405 */
+ Tcl_ChannelSetOptionProc, /* 406 */
+ Tcl_ChannelGetOptionProc, /* 407 */
+ Tcl_ChannelWatchProc, /* 408 */
+ Tcl_ChannelGetHandleProc, /* 409 */
+ Tcl_ChannelFlushProc, /* 410 */
+ Tcl_ChannelHandlerProc, /* 411 */
+};
+
+/* !END!: Do not edit above this line. */
+
diff --git a/tcl/generic/tclStubLib.c b/tcl/generic/tclStubLib.c
new file mode 100644
index 00000000000..048fdd4d85f
--- /dev/null
+++ b/tcl/generic/tclStubLib.c
@@ -0,0 +1,117 @@
+/*
+ * tclStubLib.c --
+ *
+ * Stub object that will be statically linked into extensions that wish
+ * to access Tcl.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998 Paul Duffin.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * We need to ensure that we use the stub macros so that this file contains
+ * no references to any of the stub functions. This will make it possible
+ * to build an extension that references Tcl_InitStubs but doesn't end up
+ * including the rest of the stub functions.
+ */
+
+#ifndef USE_TCL_STUBS
+#define USE_TCL_STUBS
+#endif
+#undef USE_TCL_STUB_PROCS
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Ensure that Tcl_InitStubs is built as an exported symbol. The other stub
+ * functions should be built as non-exported symbols.
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+TclStubs *tclStubsPtr;
+TclPlatStubs *tclPlatStubsPtr;
+TclIntStubs *tclIntStubsPtr;
+TclIntPlatStubs *tclIntPlatStubsPtr;
+
+static TclStubs * HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));
+
+static TclStubs *
+HasStubSupport (interp)
+ Tcl_Interp *interp;
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
+ return iPtr->stubTable;
+ }
+ interp->result = "This interpreter does not support stubs-enabled extensions.";
+ interp->freeProc = TCL_STATIC;
+
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitStubs --
+ *
+ * Tries to initialise the stub table pointers and ensures that
+ * the correct version of Tcl is loaded.
+ *
+ * Results:
+ * The actual version of Tcl that satisfies the request, or
+ * NULL to indicate that an error occurred.
+ *
+ * Side effects:
+ * Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef Tcl_InitStubs
+#undef Tcl_InitStubs
+#endif
+
+char *
+Tcl_InitStubs (interp, version, exact)
+ Tcl_Interp *interp;
+ char *version;
+ int exact;
+{
+ char *actualVersion;
+ TclStubs *tmp;
+
+ if (!tclStubsPtr) {
+ tclStubsPtr = HasStubSupport(interp);
+ if (!tclStubsPtr) {
+ return NULL;
+ }
+ }
+
+ actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact,
+ (ClientData *) &tmp);
+ if (actualVersion == NULL) {
+ tclStubsPtr = NULL;
+ return NULL;
+ }
+
+ if (tclStubsPtr->hooks) {
+ tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
+ tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
+ tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
+ } else {
+ tclPlatStubsPtr = NULL;
+ tclIntStubsPtr = NULL;
+ tclIntPlatStubsPtr = NULL;
+ }
+
+ return actualVersion;
+}
diff --git a/tcl/generic/tclStubs.c b/tcl/generic/tclStubs.c
new file mode 100644
index 00000000000..f976806506c
--- /dev/null
+++ b/tcl/generic/tclStubs.c
@@ -0,0 +1,3267 @@
+/*
+ * tclStubs.c --
+ *
+ * This file contains the wrapper functions for the platform independent
+ * public Tcl API.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tcl.h"
+
+/*
+ * Undefine function macros that will interfere with the defintions below.
+ */
+
+#undef Tcl_Alloc
+#undef Tcl_Free
+#undef Tcl_Realloc
+#undef Tcl_NewBooleanObj
+#undef Tcl_NewByteArrayObj
+#undef Tcl_NewDoubleObj
+#undef Tcl_NewIntObj
+#undef Tcl_NewListObj
+#undef Tcl_NewLongObj
+#undef Tcl_NewObj
+#undef Tcl_NewStringObj
+#undef Tcl_InitMemory
+#undef Tcl_DumpActiveMemory
+#undef Tcl_ValidateAllMemory
+#undef Tcl_EvalObj
+#undef Tcl_GlobalEvalObj
+#undef Tcl_MutexLock
+#undef Tcl_MutexUnlock
+#undef Tcl_ConditionNotify
+#undef Tcl_ConditionWait
+
+/*
+ * WARNING: This file is automatically generated by the tools/genStubs.tcl
+ * script. Any modifications to the function declarations below should be made
+ * in the generic/tcl.decls script.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+/*
+ * Exported stub functions:
+ */
+
+/* Slot 0 */
+int
+Tcl_PkgProvideEx(interp, name, version, clientData)
+ Tcl_Interp * interp;
+ char * name;
+ char * version;
+ ClientData clientData;
+{
+ return (tclStubsPtr->tcl_PkgProvideEx)(interp, name, version, clientData);
+}
+
+/* Slot 1 */
+char *
+Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
+ Tcl_Interp * interp;
+ char * name;
+ char * version;
+ int exact;
+ ClientData * clientDataPtr;
+{
+ return (tclStubsPtr->tcl_PkgRequireEx)(interp, name, version, exact, clientDataPtr);
+}
+
+/* Slot 2 */
+void
+Tcl_Panic TCL_VARARGS_DEF(char *,format)
+{
+ char * var;
+ va_list argList;
+
+ var = (char *) TCL_VARARGS_START(char *,format,argList);
+
+ (tclStubsPtr->tcl_PanicVA)(var, argList);
+ va_end(argList);
+}
+
+/* Slot 3 */
+char *
+Tcl_Alloc(size)
+ unsigned int size;
+{
+ return (tclStubsPtr->tcl_Alloc)(size);
+}
+
+/* Slot 4 */
+void
+Tcl_Free(ptr)
+ char * ptr;
+{
+ (tclStubsPtr->tcl_Free)(ptr);
+}
+
+/* Slot 5 */
+char *
+Tcl_Realloc(ptr, size)
+ char * ptr;
+ unsigned int size;
+{
+ return (tclStubsPtr->tcl_Realloc)(ptr, size);
+}
+
+/* Slot 6 */
+char *
+Tcl_DbCkalloc(size, file, line)
+ unsigned int size;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbCkalloc)(size, file, line);
+}
+
+/* Slot 7 */
+int
+Tcl_DbCkfree(ptr, file, line)
+ char * ptr;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbCkfree)(ptr, file, line);
+}
+
+/* Slot 8 */
+char *
+Tcl_DbCkrealloc(ptr, size, file, line)
+ char * ptr;
+ unsigned int size;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbCkrealloc)(ptr, size, file, line);
+}
+
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* Slot 9 */
+void
+Tcl_CreateFileHandler(fd, mask, proc, clientData)
+ int fd;
+ int mask;
+ Tcl_FileProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CreateFileHandler)(fd, mask, proc, clientData);
+}
+
+#endif /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* Slot 10 */
+void
+Tcl_DeleteFileHandler(fd)
+ int fd;
+{
+ (tclStubsPtr->tcl_DeleteFileHandler)(fd);
+}
+
+#endif /* UNIX */
+/* Slot 11 */
+void
+Tcl_SetTimer(timePtr)
+ Tcl_Time * timePtr;
+{
+ (tclStubsPtr->tcl_SetTimer)(timePtr);
+}
+
+/* Slot 12 */
+void
+Tcl_Sleep(ms)
+ int ms;
+{
+ (tclStubsPtr->tcl_Sleep)(ms);
+}
+
+/* Slot 13 */
+int
+Tcl_WaitForEvent(timePtr)
+ Tcl_Time * timePtr;
+{
+ return (tclStubsPtr->tcl_WaitForEvent)(timePtr);
+}
+
+/* Slot 14 */
+int
+Tcl_AppendAllObjTypes(interp, objPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+{
+ return (tclStubsPtr->tcl_AppendAllObjTypes)(interp, objPtr);
+}
+
+/* Slot 15 */
+void
+Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,objPtr)
+{
+ Tcl_Obj * var;
+ va_list argList;
+
+ var = (Tcl_Obj *) TCL_VARARGS_START(Tcl_Obj *,objPtr,argList);
+
+ (tclStubsPtr->tcl_AppendStringsToObjVA)(var, argList);
+ va_end(argList);
+}
+
+/* Slot 16 */
+void
+Tcl_AppendToObj(objPtr, bytes, length)
+ Tcl_Obj * objPtr;
+ char * bytes;
+ int length;
+{
+ (tclStubsPtr->tcl_AppendToObj)(objPtr, bytes, length);
+}
+
+/* Slot 17 */
+Tcl_Obj *
+Tcl_ConcatObj(objc, objv)
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ return (tclStubsPtr->tcl_ConcatObj)(objc, objv);
+}
+
+/* Slot 18 */
+int
+Tcl_ConvertToType(interp, objPtr, typePtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ Tcl_ObjType * typePtr;
+{
+ return (tclStubsPtr->tcl_ConvertToType)(interp, objPtr, typePtr);
+}
+
+/* Slot 19 */
+void
+Tcl_DbDecrRefCount(objPtr, file, line)
+ Tcl_Obj * objPtr;
+ char * file;
+ int line;
+{
+ (tclStubsPtr->tcl_DbDecrRefCount)(objPtr, file, line);
+}
+
+/* Slot 20 */
+void
+Tcl_DbIncrRefCount(objPtr, file, line)
+ Tcl_Obj * objPtr;
+ char * file;
+ int line;
+{
+ (tclStubsPtr->tcl_DbIncrRefCount)(objPtr, file, line);
+}
+
+/* Slot 21 */
+int
+Tcl_DbIsShared(objPtr, file, line)
+ Tcl_Obj * objPtr;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbIsShared)(objPtr, file, line);
+}
+
+/* Slot 22 */
+Tcl_Obj *
+Tcl_DbNewBooleanObj(boolValue, file, line)
+ int boolValue;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbNewBooleanObj)(boolValue, file, line);
+}
+
+/* Slot 23 */
+Tcl_Obj *
+Tcl_DbNewByteArrayObj(bytes, length, file, line)
+ unsigned char * bytes;
+ int length;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbNewByteArrayObj)(bytes, length, file, line);
+}
+
+/* Slot 24 */
+Tcl_Obj *
+Tcl_DbNewDoubleObj(doubleValue, file, line)
+ double doubleValue;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbNewDoubleObj)(doubleValue, file, line);
+}
+
+/* Slot 25 */
+Tcl_Obj *
+Tcl_DbNewListObj(objc, objv, file, line)
+ int objc;
+ Tcl_Obj *CONST objv[];
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbNewListObj)(objc, objv, file, line);
+}
+
+/* Slot 26 */
+Tcl_Obj *
+Tcl_DbNewLongObj(longValue, file, line)
+ long longValue;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbNewLongObj)(longValue, file, line);
+}
+
+/* Slot 27 */
+Tcl_Obj *
+Tcl_DbNewObj(file, line)
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbNewObj)(file, line);
+}
+
+/* Slot 28 */
+Tcl_Obj *
+Tcl_DbNewStringObj(bytes, length, file, line)
+ CONST char * bytes;
+ int length;
+ char * file;
+ int line;
+{
+ return (tclStubsPtr->tcl_DbNewStringObj)(bytes, length, file, line);
+}
+
+/* Slot 29 */
+Tcl_Obj *
+Tcl_DuplicateObj(objPtr)
+ Tcl_Obj * objPtr;
+{
+ return (tclStubsPtr->tcl_DuplicateObj)(objPtr);
+}
+
+/* Slot 30 */
+void
+TclFreeObj(objPtr)
+ Tcl_Obj * objPtr;
+{
+ (tclStubsPtr->tclFreeObj)(objPtr);
+}
+
+/* Slot 31 */
+int
+Tcl_GetBoolean(interp, str, boolPtr)
+ Tcl_Interp * interp;
+ char * str;
+ int * boolPtr;
+{
+ return (tclStubsPtr->tcl_GetBoolean)(interp, str, boolPtr);
+}
+
+/* Slot 32 */
+int
+Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ int * boolPtr;
+{
+ return (tclStubsPtr->tcl_GetBooleanFromObj)(interp, objPtr, boolPtr);
+}
+
+/* Slot 33 */
+unsigned char *
+Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
+ Tcl_Obj * objPtr;
+ int * lengthPtr;
+{
+ return (tclStubsPtr->tcl_GetByteArrayFromObj)(objPtr, lengthPtr);
+}
+
+/* Slot 34 */
+int
+Tcl_GetDouble(interp, str, doublePtr)
+ Tcl_Interp * interp;
+ char * str;
+ double * doublePtr;
+{
+ return (tclStubsPtr->tcl_GetDouble)(interp, str, doublePtr);
+}
+
+/* Slot 35 */
+int
+Tcl_GetDoubleFromObj(interp, objPtr, doublePtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ double * doublePtr;
+{
+ return (tclStubsPtr->tcl_GetDoubleFromObj)(interp, objPtr, doublePtr);
+}
+
+/* Slot 36 */
+int
+Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ char ** tablePtr;
+ char * msg;
+ int flags;
+ int * indexPtr;
+{
+ return (tclStubsPtr->tcl_GetIndexFromObj)(interp, objPtr, tablePtr, msg, flags, indexPtr);
+}
+
+/* Slot 37 */
+int
+Tcl_GetInt(interp, str, intPtr)
+ Tcl_Interp * interp;
+ char * str;
+ int * intPtr;
+{
+ return (tclStubsPtr->tcl_GetInt)(interp, str, intPtr);
+}
+
+/* Slot 38 */
+int
+Tcl_GetIntFromObj(interp, objPtr, intPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ int * intPtr;
+{
+ return (tclStubsPtr->tcl_GetIntFromObj)(interp, objPtr, intPtr);
+}
+
+/* Slot 39 */
+int
+Tcl_GetLongFromObj(interp, objPtr, longPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ long * longPtr;
+{
+ return (tclStubsPtr->tcl_GetLongFromObj)(interp, objPtr, longPtr);
+}
+
+/* Slot 40 */
+Tcl_ObjType *
+Tcl_GetObjType(typeName)
+ char * typeName;
+{
+ return (tclStubsPtr->tcl_GetObjType)(typeName);
+}
+
+/* Slot 41 */
+char *
+Tcl_GetStringFromObj(objPtr, lengthPtr)
+ Tcl_Obj * objPtr;
+ int * lengthPtr;
+{
+ return (tclStubsPtr->tcl_GetStringFromObj)(objPtr, lengthPtr);
+}
+
+/* Slot 42 */
+void
+Tcl_InvalidateStringRep(objPtr)
+ Tcl_Obj * objPtr;
+{
+ (tclStubsPtr->tcl_InvalidateStringRep)(objPtr);
+}
+
+/* Slot 43 */
+int
+Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * listPtr;
+ Tcl_Obj * elemListPtr;
+{
+ return (tclStubsPtr->tcl_ListObjAppendList)(interp, listPtr, elemListPtr);
+}
+
+/* Slot 44 */
+int
+Tcl_ListObjAppendElement(interp, listPtr, objPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * listPtr;
+ Tcl_Obj * objPtr;
+{
+ return (tclStubsPtr->tcl_ListObjAppendElement)(interp, listPtr, objPtr);
+}
+
+/* Slot 45 */
+int
+Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * listPtr;
+ int * objcPtr;
+ Tcl_Obj *** objvPtr;
+{
+ return (tclStubsPtr->tcl_ListObjGetElements)(interp, listPtr, objcPtr, objvPtr);
+}
+
+/* Slot 46 */
+int
+Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * listPtr;
+ int index;
+ Tcl_Obj ** objPtrPtr;
+{
+ return (tclStubsPtr->tcl_ListObjIndex)(interp, listPtr, index, objPtrPtr);
+}
+
+/* Slot 47 */
+int
+Tcl_ListObjLength(interp, listPtr, intPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * listPtr;
+ int * intPtr;
+{
+ return (tclStubsPtr->tcl_ListObjLength)(interp, listPtr, intPtr);
+}
+
+/* Slot 48 */
+int
+Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
+ Tcl_Interp * interp;
+ Tcl_Obj * listPtr;
+ int first;
+ int count;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ return (tclStubsPtr->tcl_ListObjReplace)(interp, listPtr, first, count, objc, objv);
+}
+
+/* Slot 49 */
+Tcl_Obj *
+Tcl_NewBooleanObj(boolValue)
+ int boolValue;
+{
+ return (tclStubsPtr->tcl_NewBooleanObj)(boolValue);
+}
+
+/* Slot 50 */
+Tcl_Obj *
+Tcl_NewByteArrayObj(bytes, length)
+ unsigned char * bytes;
+ int length;
+{
+ return (tclStubsPtr->tcl_NewByteArrayObj)(bytes, length);
+}
+
+/* Slot 51 */
+Tcl_Obj *
+Tcl_NewDoubleObj(doubleValue)
+ double doubleValue;
+{
+ return (tclStubsPtr->tcl_NewDoubleObj)(doubleValue);
+}
+
+/* Slot 52 */
+Tcl_Obj *
+Tcl_NewIntObj(intValue)
+ int intValue;
+{
+ return (tclStubsPtr->tcl_NewIntObj)(intValue);
+}
+
+/* Slot 53 */
+Tcl_Obj *
+Tcl_NewListObj(objc, objv)
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ return (tclStubsPtr->tcl_NewListObj)(objc, objv);
+}
+
+/* Slot 54 */
+Tcl_Obj *
+Tcl_NewLongObj(longValue)
+ long longValue;
+{
+ return (tclStubsPtr->tcl_NewLongObj)(longValue);
+}
+
+/* Slot 55 */
+Tcl_Obj *
+Tcl_NewObj()
+{
+ return (tclStubsPtr->tcl_NewObj)();
+}
+
+/* Slot 56 */
+Tcl_Obj *
+Tcl_NewStringObj(bytes, length)
+ CONST char * bytes;
+ int length;
+{
+ return (tclStubsPtr->tcl_NewStringObj)(bytes, length);
+}
+
+/* Slot 57 */
+void
+Tcl_SetBooleanObj(objPtr, boolValue)
+ Tcl_Obj * objPtr;
+ int boolValue;
+{
+ (tclStubsPtr->tcl_SetBooleanObj)(objPtr, boolValue);
+}
+
+/* Slot 58 */
+unsigned char *
+Tcl_SetByteArrayLength(objPtr, length)
+ Tcl_Obj * objPtr;
+ int length;
+{
+ return (tclStubsPtr->tcl_SetByteArrayLength)(objPtr, length);
+}
+
+/* Slot 59 */
+void
+Tcl_SetByteArrayObj(objPtr, bytes, length)
+ Tcl_Obj * objPtr;
+ unsigned char * bytes;
+ int length;
+{
+ (tclStubsPtr->tcl_SetByteArrayObj)(objPtr, bytes, length);
+}
+
+/* Slot 60 */
+void
+Tcl_SetDoubleObj(objPtr, doubleValue)
+ Tcl_Obj * objPtr;
+ double doubleValue;
+{
+ (tclStubsPtr->tcl_SetDoubleObj)(objPtr, doubleValue);
+}
+
+/* Slot 61 */
+void
+Tcl_SetIntObj(objPtr, intValue)
+ Tcl_Obj * objPtr;
+ int intValue;
+{
+ (tclStubsPtr->tcl_SetIntObj)(objPtr, intValue);
+}
+
+/* Slot 62 */
+void
+Tcl_SetListObj(objPtr, objc, objv)
+ Tcl_Obj * objPtr;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ (tclStubsPtr->tcl_SetListObj)(objPtr, objc, objv);
+}
+
+/* Slot 63 */
+void
+Tcl_SetLongObj(objPtr, longValue)
+ Tcl_Obj * objPtr;
+ long longValue;
+{
+ (tclStubsPtr->tcl_SetLongObj)(objPtr, longValue);
+}
+
+/* Slot 64 */
+void
+Tcl_SetObjLength(objPtr, length)
+ Tcl_Obj * objPtr;
+ int length;
+{
+ (tclStubsPtr->tcl_SetObjLength)(objPtr, length);
+}
+
+/* Slot 65 */
+void
+Tcl_SetStringObj(objPtr, bytes, length)
+ Tcl_Obj * objPtr;
+ char * bytes;
+ int length;
+{
+ (tclStubsPtr->tcl_SetStringObj)(objPtr, bytes, length);
+}
+
+/* Slot 66 */
+void
+Tcl_AddErrorInfo(interp, message)
+ Tcl_Interp * interp;
+ CONST char * message;
+{
+ (tclStubsPtr->tcl_AddErrorInfo)(interp, message);
+}
+
+/* Slot 67 */
+void
+Tcl_AddObjErrorInfo(interp, message, length)
+ Tcl_Interp * interp;
+ CONST char * message;
+ int length;
+{
+ (tclStubsPtr->tcl_AddObjErrorInfo)(interp, message, length);
+}
+
+/* Slot 68 */
+void
+Tcl_AllowExceptions(interp)
+ Tcl_Interp * interp;
+{
+ (tclStubsPtr->tcl_AllowExceptions)(interp);
+}
+
+/* Slot 69 */
+void
+Tcl_AppendElement(interp, string)
+ Tcl_Interp * interp;
+ CONST char * string;
+{
+ (tclStubsPtr->tcl_AppendElement)(interp, string);
+}
+
+/* Slot 70 */
+void
+Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,interp)
+{
+ Tcl_Interp * var;
+ va_list argList;
+
+ var = (Tcl_Interp *) TCL_VARARGS_START(Tcl_Interp *,interp,argList);
+
+ (tclStubsPtr->tcl_AppendResultVA)(var, argList);
+ va_end(argList);
+}
+
+/* Slot 71 */
+Tcl_AsyncHandler
+Tcl_AsyncCreate(proc, clientData)
+ Tcl_AsyncProc * proc;
+ ClientData clientData;
+{
+ return (tclStubsPtr->tcl_AsyncCreate)(proc, clientData);
+}
+
+/* Slot 72 */
+void
+Tcl_AsyncDelete(async)
+ Tcl_AsyncHandler async;
+{
+ (tclStubsPtr->tcl_AsyncDelete)(async);
+}
+
+/* Slot 73 */
+int
+Tcl_AsyncInvoke(interp, code)
+ Tcl_Interp * interp;
+ int code;
+{
+ return (tclStubsPtr->tcl_AsyncInvoke)(interp, code);
+}
+
+/* Slot 74 */
+void
+Tcl_AsyncMark(async)
+ Tcl_AsyncHandler async;
+{
+ (tclStubsPtr->tcl_AsyncMark)(async);
+}
+
+/* Slot 75 */
+int
+Tcl_AsyncReady()
+{
+ return (tclStubsPtr->tcl_AsyncReady)();
+}
+
+/* Slot 76 */
+void
+Tcl_BackgroundError(interp)
+ Tcl_Interp * interp;
+{
+ (tclStubsPtr->tcl_BackgroundError)(interp);
+}
+
+/* Slot 77 */
+char
+Tcl_Backslash(src, readPtr)
+ CONST char * src;
+ int * readPtr;
+{
+ return (tclStubsPtr->tcl_Backslash)(src, readPtr);
+}
+
+/* Slot 78 */
+int
+Tcl_BadChannelOption(interp, optionName, optionList)
+ Tcl_Interp * interp;
+ char * optionName;
+ char * optionList;
+{
+ return (tclStubsPtr->tcl_BadChannelOption)(interp, optionName, optionList);
+}
+
+/* Slot 79 */
+void
+Tcl_CallWhenDeleted(interp, proc, clientData)
+ Tcl_Interp * interp;
+ Tcl_InterpDeleteProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CallWhenDeleted)(interp, proc, clientData);
+}
+
+/* Slot 80 */
+void
+Tcl_CancelIdleCall(idleProc, clientData)
+ Tcl_IdleProc * idleProc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CancelIdleCall)(idleProc, clientData);
+}
+
+/* Slot 81 */
+int
+Tcl_Close(interp, chan)
+ Tcl_Interp * interp;
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_Close)(interp, chan);
+}
+
+/* Slot 82 */
+int
+Tcl_CommandComplete(cmd)
+ char * cmd;
+{
+ return (tclStubsPtr->tcl_CommandComplete)(cmd);
+}
+
+/* Slot 83 */
+char *
+Tcl_Concat(argc, argv)
+ int argc;
+ char ** argv;
+{
+ return (tclStubsPtr->tcl_Concat)(argc, argv);
+}
+
+/* Slot 84 */
+int
+Tcl_ConvertElement(src, dst, flags)
+ CONST char * src;
+ char * dst;
+ int flags;
+{
+ return (tclStubsPtr->tcl_ConvertElement)(src, dst, flags);
+}
+
+/* Slot 85 */
+int
+Tcl_ConvertCountedElement(src, length, dst, flags)
+ CONST char * src;
+ int length;
+ char * dst;
+ int flags;
+{
+ return (tclStubsPtr->tcl_ConvertCountedElement)(src, length, dst, flags);
+}
+
+/* Slot 86 */
+int
+Tcl_CreateAlias(slave, slaveCmd, target, targetCmd, argc, argv)
+ Tcl_Interp * slave;
+ char * slaveCmd;
+ Tcl_Interp * target;
+ char * targetCmd;
+ int argc;
+ char ** argv;
+{
+ return (tclStubsPtr->tcl_CreateAlias)(slave, slaveCmd, target, targetCmd, argc, argv);
+}
+
+/* Slot 87 */
+int
+Tcl_CreateAliasObj(slave, slaveCmd, target, targetCmd, objc, objv)
+ Tcl_Interp * slave;
+ char * slaveCmd;
+ Tcl_Interp * target;
+ char * targetCmd;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ return (tclStubsPtr->tcl_CreateAliasObj)(slave, slaveCmd, target, targetCmd, objc, objv);
+}
+
+/* Slot 88 */
+Tcl_Channel
+Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
+ Tcl_ChannelType * typePtr;
+ char * chanName;
+ ClientData instanceData;
+ int mask;
+{
+ return (tclStubsPtr->tcl_CreateChannel)(typePtr, chanName, instanceData, mask);
+}
+
+/* Slot 89 */
+void
+Tcl_CreateChannelHandler(chan, mask, proc, clientData)
+ Tcl_Channel chan;
+ int mask;
+ Tcl_ChannelProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CreateChannelHandler)(chan, mask, proc, clientData);
+}
+
+/* Slot 90 */
+void
+Tcl_CreateCloseHandler(chan, proc, clientData)
+ Tcl_Channel chan;
+ Tcl_CloseProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CreateCloseHandler)(chan, proc, clientData);
+}
+
+/* Slot 91 */
+Tcl_Command
+Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
+ Tcl_Interp * interp;
+ char * cmdName;
+ Tcl_CmdProc * proc;
+ ClientData clientData;
+ Tcl_CmdDeleteProc * deleteProc;
+{
+ return (tclStubsPtr->tcl_CreateCommand)(interp, cmdName, proc, clientData, deleteProc);
+}
+
+/* Slot 92 */
+void
+Tcl_CreateEventSource(setupProc, checkProc, clientData)
+ Tcl_EventSetupProc * setupProc;
+ Tcl_EventCheckProc * checkProc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CreateEventSource)(setupProc, checkProc, clientData);
+}
+
+/* Slot 93 */
+void
+Tcl_CreateExitHandler(proc, clientData)
+ Tcl_ExitProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CreateExitHandler)(proc, clientData);
+}
+
+/* Slot 94 */
+Tcl_Interp *
+Tcl_CreateInterp()
+{
+ return (tclStubsPtr->tcl_CreateInterp)();
+}
+
+/* Slot 95 */
+void
+Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
+ Tcl_Interp * interp;
+ char * name;
+ int numArgs;
+ Tcl_ValueType * argTypes;
+ Tcl_MathProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CreateMathFunc)(interp, name, numArgs, argTypes, proc, clientData);
+}
+
+/* Slot 96 */
+Tcl_Command
+Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
+ Tcl_Interp * interp;
+ char * cmdName;
+ Tcl_ObjCmdProc * proc;
+ ClientData clientData;
+ Tcl_CmdDeleteProc * deleteProc;
+{
+ return (tclStubsPtr->tcl_CreateObjCommand)(interp, cmdName, proc, clientData, deleteProc);
+}
+
+/* Slot 97 */
+Tcl_Interp *
+Tcl_CreateSlave(interp, slaveName, isSafe)
+ Tcl_Interp * interp;
+ char * slaveName;
+ int isSafe;
+{
+ return (tclStubsPtr->tcl_CreateSlave)(interp, slaveName, isSafe);
+}
+
+/* Slot 98 */
+Tcl_TimerToken
+Tcl_CreateTimerHandler(milliseconds, proc, clientData)
+ int milliseconds;
+ Tcl_TimerProc * proc;
+ ClientData clientData;
+{
+ return (tclStubsPtr->tcl_CreateTimerHandler)(milliseconds, proc, clientData);
+}
+
+/* Slot 99 */
+Tcl_Trace
+Tcl_CreateTrace(interp, level, proc, clientData)
+ Tcl_Interp * interp;
+ int level;
+ Tcl_CmdTraceProc * proc;
+ ClientData clientData;
+{
+ return (tclStubsPtr->tcl_CreateTrace)(interp, level, proc, clientData);
+}
+
+/* Slot 100 */
+void
+Tcl_DeleteAssocData(interp, name)
+ Tcl_Interp * interp;
+ char * name;
+{
+ (tclStubsPtr->tcl_DeleteAssocData)(interp, name);
+}
+
+/* Slot 101 */
+void
+Tcl_DeleteChannelHandler(chan, proc, clientData)
+ Tcl_Channel chan;
+ Tcl_ChannelProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_DeleteChannelHandler)(chan, proc, clientData);
+}
+
+/* Slot 102 */
+void
+Tcl_DeleteCloseHandler(chan, proc, clientData)
+ Tcl_Channel chan;
+ Tcl_CloseProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_DeleteCloseHandler)(chan, proc, clientData);
+}
+
+/* Slot 103 */
+int
+Tcl_DeleteCommand(interp, cmdName)
+ Tcl_Interp * interp;
+ char * cmdName;
+{
+ return (tclStubsPtr->tcl_DeleteCommand)(interp, cmdName);
+}
+
+/* Slot 104 */
+int
+Tcl_DeleteCommandFromToken(interp, command)
+ Tcl_Interp * interp;
+ Tcl_Command command;
+{
+ return (tclStubsPtr->tcl_DeleteCommandFromToken)(interp, command);
+}
+
+/* Slot 105 */
+void
+Tcl_DeleteEvents(proc, clientData)
+ Tcl_EventDeleteProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_DeleteEvents)(proc, clientData);
+}
+
+/* Slot 106 */
+void
+Tcl_DeleteEventSource(setupProc, checkProc, clientData)
+ Tcl_EventSetupProc * setupProc;
+ Tcl_EventCheckProc * checkProc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_DeleteEventSource)(setupProc, checkProc, clientData);
+}
+
+/* Slot 107 */
+void
+Tcl_DeleteExitHandler(proc, clientData)
+ Tcl_ExitProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_DeleteExitHandler)(proc, clientData);
+}
+
+/* Slot 108 */
+void
+Tcl_DeleteHashEntry(entryPtr)
+ Tcl_HashEntry * entryPtr;
+{
+ (tclStubsPtr->tcl_DeleteHashEntry)(entryPtr);
+}
+
+/* Slot 109 */
+void
+Tcl_DeleteHashTable(tablePtr)
+ Tcl_HashTable * tablePtr;
+{
+ (tclStubsPtr->tcl_DeleteHashTable)(tablePtr);
+}
+
+/* Slot 110 */
+void
+Tcl_DeleteInterp(interp)
+ Tcl_Interp * interp;
+{
+ (tclStubsPtr->tcl_DeleteInterp)(interp);
+}
+
+/* Slot 111 */
+void
+Tcl_DetachPids(numPids, pidPtr)
+ int numPids;
+ Tcl_Pid * pidPtr;
+{
+ (tclStubsPtr->tcl_DetachPids)(numPids, pidPtr);
+}
+
+/* Slot 112 */
+void
+Tcl_DeleteTimerHandler(token)
+ Tcl_TimerToken token;
+{
+ (tclStubsPtr->tcl_DeleteTimerHandler)(token);
+}
+
+/* Slot 113 */
+void
+Tcl_DeleteTrace(interp, trace)
+ Tcl_Interp * interp;
+ Tcl_Trace trace;
+{
+ (tclStubsPtr->tcl_DeleteTrace)(interp, trace);
+}
+
+/* Slot 114 */
+void
+Tcl_DontCallWhenDeleted(interp, proc, clientData)
+ Tcl_Interp * interp;
+ Tcl_InterpDeleteProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_DontCallWhenDeleted)(interp, proc, clientData);
+}
+
+/* Slot 115 */
+int
+Tcl_DoOneEvent(flags)
+ int flags;
+{
+ return (tclStubsPtr->tcl_DoOneEvent)(flags);
+}
+
+/* Slot 116 */
+void
+Tcl_DoWhenIdle(proc, clientData)
+ Tcl_IdleProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_DoWhenIdle)(proc, clientData);
+}
+
+/* Slot 117 */
+char *
+Tcl_DStringAppend(dsPtr, str, length)
+ Tcl_DString * dsPtr;
+ CONST char * str;
+ int length;
+{
+ return (tclStubsPtr->tcl_DStringAppend)(dsPtr, str, length);
+}
+
+/* Slot 118 */
+char *
+Tcl_DStringAppendElement(dsPtr, string)
+ Tcl_DString * dsPtr;
+ CONST char * string;
+{
+ return (tclStubsPtr->tcl_DStringAppendElement)(dsPtr, string);
+}
+
+/* Slot 119 */
+void
+Tcl_DStringEndSublist(dsPtr)
+ Tcl_DString * dsPtr;
+{
+ (tclStubsPtr->tcl_DStringEndSublist)(dsPtr);
+}
+
+/* Slot 120 */
+void
+Tcl_DStringFree(dsPtr)
+ Tcl_DString * dsPtr;
+{
+ (tclStubsPtr->tcl_DStringFree)(dsPtr);
+}
+
+/* Slot 121 */
+void
+Tcl_DStringGetResult(interp, dsPtr)
+ Tcl_Interp * interp;
+ Tcl_DString * dsPtr;
+{
+ (tclStubsPtr->tcl_DStringGetResult)(interp, dsPtr);
+}
+
+/* Slot 122 */
+void
+Tcl_DStringInit(dsPtr)
+ Tcl_DString * dsPtr;
+{
+ (tclStubsPtr->tcl_DStringInit)(dsPtr);
+}
+
+/* Slot 123 */
+void
+Tcl_DStringResult(interp, dsPtr)
+ Tcl_Interp * interp;
+ Tcl_DString * dsPtr;
+{
+ (tclStubsPtr->tcl_DStringResult)(interp, dsPtr);
+}
+
+/* Slot 124 */
+void
+Tcl_DStringSetLength(dsPtr, length)
+ Tcl_DString * dsPtr;
+ int length;
+{
+ (tclStubsPtr->tcl_DStringSetLength)(dsPtr, length);
+}
+
+/* Slot 125 */
+void
+Tcl_DStringStartSublist(dsPtr)
+ Tcl_DString * dsPtr;
+{
+ (tclStubsPtr->tcl_DStringStartSublist)(dsPtr);
+}
+
+/* Slot 126 */
+int
+Tcl_Eof(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_Eof)(chan);
+}
+
+/* Slot 127 */
+char *
+Tcl_ErrnoId()
+{
+ return (tclStubsPtr->tcl_ErrnoId)();
+}
+
+/* Slot 128 */
+char *
+Tcl_ErrnoMsg(err)
+ int err;
+{
+ return (tclStubsPtr->tcl_ErrnoMsg)(err);
+}
+
+/* Slot 129 */
+int
+Tcl_Eval(interp, string)
+ Tcl_Interp * interp;
+ char * string;
+{
+ return (tclStubsPtr->tcl_Eval)(interp, string);
+}
+
+/* Slot 130 */
+int
+Tcl_EvalFile(interp, fileName)
+ Tcl_Interp * interp;
+ char * fileName;
+{
+ return (tclStubsPtr->tcl_EvalFile)(interp, fileName);
+}
+
+/* Slot 131 */
+int
+Tcl_EvalObj(interp, objPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+{
+ return (tclStubsPtr->tcl_EvalObj)(interp, objPtr);
+}
+
+/* Slot 132 */
+void
+Tcl_EventuallyFree(clientData, freeProc)
+ ClientData clientData;
+ Tcl_FreeProc * freeProc;
+{
+ (tclStubsPtr->tcl_EventuallyFree)(clientData, freeProc);
+}
+
+/* Slot 133 */
+void
+Tcl_Exit(status)
+ int status;
+{
+ (tclStubsPtr->tcl_Exit)(status);
+}
+
+/* Slot 134 */
+int
+Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
+ Tcl_Interp * interp;
+ char * hiddenCmdToken;
+ char * cmdName;
+{
+ return (tclStubsPtr->tcl_ExposeCommand)(interp, hiddenCmdToken, cmdName);
+}
+
+/* Slot 135 */
+int
+Tcl_ExprBoolean(interp, str, ptr)
+ Tcl_Interp * interp;
+ char * str;
+ int * ptr;
+{
+ return (tclStubsPtr->tcl_ExprBoolean)(interp, str, ptr);
+}
+
+/* Slot 136 */
+int
+Tcl_ExprBooleanObj(interp, objPtr, ptr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ int * ptr;
+{
+ return (tclStubsPtr->tcl_ExprBooleanObj)(interp, objPtr, ptr);
+}
+
+/* Slot 137 */
+int
+Tcl_ExprDouble(interp, str, ptr)
+ Tcl_Interp * interp;
+ char * str;
+ double * ptr;
+{
+ return (tclStubsPtr->tcl_ExprDouble)(interp, str, ptr);
+}
+
+/* Slot 138 */
+int
+Tcl_ExprDoubleObj(interp, objPtr, ptr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ double * ptr;
+{
+ return (tclStubsPtr->tcl_ExprDoubleObj)(interp, objPtr, ptr);
+}
+
+/* Slot 139 */
+int
+Tcl_ExprLong(interp, str, ptr)
+ Tcl_Interp * interp;
+ char * str;
+ long * ptr;
+{
+ return (tclStubsPtr->tcl_ExprLong)(interp, str, ptr);
+}
+
+/* Slot 140 */
+int
+Tcl_ExprLongObj(interp, objPtr, ptr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ long * ptr;
+{
+ return (tclStubsPtr->tcl_ExprLongObj)(interp, objPtr, ptr);
+}
+
+/* Slot 141 */
+int
+Tcl_ExprObj(interp, objPtr, resultPtrPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ Tcl_Obj ** resultPtrPtr;
+{
+ return (tclStubsPtr->tcl_ExprObj)(interp, objPtr, resultPtrPtr);
+}
+
+/* Slot 142 */
+int
+Tcl_ExprString(interp, string)
+ Tcl_Interp * interp;
+ char * string;
+{
+ return (tclStubsPtr->tcl_ExprString)(interp, string);
+}
+
+/* Slot 143 */
+void
+Tcl_Finalize()
+{
+ (tclStubsPtr->tcl_Finalize)();
+}
+
+/* Slot 144 */
+void
+Tcl_FindExecutable(argv0)
+ CONST char * argv0;
+{
+ (tclStubsPtr->tcl_FindExecutable)(argv0);
+}
+
+/* Slot 145 */
+Tcl_HashEntry *
+Tcl_FirstHashEntry(tablePtr, searchPtr)
+ Tcl_HashTable * tablePtr;
+ Tcl_HashSearch * searchPtr;
+{
+ return (tclStubsPtr->tcl_FirstHashEntry)(tablePtr, searchPtr);
+}
+
+/* Slot 146 */
+int
+Tcl_Flush(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_Flush)(chan);
+}
+
+/* Slot 147 */
+void
+Tcl_FreeResult(interp)
+ Tcl_Interp * interp;
+{
+ (tclStubsPtr->tcl_FreeResult)(interp);
+}
+
+/* Slot 148 */
+int
+Tcl_GetAlias(interp, slaveCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr)
+ Tcl_Interp * interp;
+ char * slaveCmd;
+ Tcl_Interp ** targetInterpPtr;
+ char ** targetCmdPtr;
+ int * argcPtr;
+ char *** argvPtr;
+{
+ return (tclStubsPtr->tcl_GetAlias)(interp, slaveCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr);
+}
+
+/* Slot 149 */
+int
+Tcl_GetAliasObj(interp, slaveCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv)
+ Tcl_Interp * interp;
+ char * slaveCmd;
+ Tcl_Interp ** targetInterpPtr;
+ char ** targetCmdPtr;
+ int * objcPtr;
+ Tcl_Obj *** objv;
+{
+ return (tclStubsPtr->tcl_GetAliasObj)(interp, slaveCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv);
+}
+
+/* Slot 150 */
+ClientData
+Tcl_GetAssocData(interp, name, procPtr)
+ Tcl_Interp * interp;
+ char * name;
+ Tcl_InterpDeleteProc ** procPtr;
+{
+ return (tclStubsPtr->tcl_GetAssocData)(interp, name, procPtr);
+}
+
+/* Slot 151 */
+Tcl_Channel
+Tcl_GetChannel(interp, chanName, modePtr)
+ Tcl_Interp * interp;
+ char * chanName;
+ int * modePtr;
+{
+ return (tclStubsPtr->tcl_GetChannel)(interp, chanName, modePtr);
+}
+
+/* Slot 152 */
+int
+Tcl_GetChannelBufferSize(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_GetChannelBufferSize)(chan);
+}
+
+/* Slot 153 */
+int
+Tcl_GetChannelHandle(chan, direction, handlePtr)
+ Tcl_Channel chan;
+ int direction;
+ ClientData * handlePtr;
+{
+ return (tclStubsPtr->tcl_GetChannelHandle)(chan, direction, handlePtr);
+}
+
+/* Slot 154 */
+ClientData
+Tcl_GetChannelInstanceData(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_GetChannelInstanceData)(chan);
+}
+
+/* Slot 155 */
+int
+Tcl_GetChannelMode(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_GetChannelMode)(chan);
+}
+
+/* Slot 156 */
+char *
+Tcl_GetChannelName(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_GetChannelName)(chan);
+}
+
+/* Slot 157 */
+int
+Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
+ Tcl_Interp * interp;
+ Tcl_Channel chan;
+ char * optionName;
+ Tcl_DString * dsPtr;
+{
+ return (tclStubsPtr->tcl_GetChannelOption)(interp, chan, optionName, dsPtr);
+}
+
+/* Slot 158 */
+Tcl_ChannelType *
+Tcl_GetChannelType(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_GetChannelType)(chan);
+}
+
+/* Slot 159 */
+int
+Tcl_GetCommandInfo(interp, cmdName, infoPtr)
+ Tcl_Interp * interp;
+ char * cmdName;
+ Tcl_CmdInfo * infoPtr;
+{
+ return (tclStubsPtr->tcl_GetCommandInfo)(interp, cmdName, infoPtr);
+}
+
+/* Slot 160 */
+char *
+Tcl_GetCommandName(interp, command)
+ Tcl_Interp * interp;
+ Tcl_Command command;
+{
+ return (tclStubsPtr->tcl_GetCommandName)(interp, command);
+}
+
+/* Slot 161 */
+int
+Tcl_GetErrno()
+{
+ return (tclStubsPtr->tcl_GetErrno)();
+}
+
+/* Slot 162 */
+char *
+Tcl_GetHostName()
+{
+ return (tclStubsPtr->tcl_GetHostName)();
+}
+
+/* Slot 163 */
+int
+Tcl_GetInterpPath(askInterp, slaveInterp)
+ Tcl_Interp * askInterp;
+ Tcl_Interp * slaveInterp;
+{
+ return (tclStubsPtr->tcl_GetInterpPath)(askInterp, slaveInterp);
+}
+
+/* Slot 164 */
+Tcl_Interp *
+Tcl_GetMaster(interp)
+ Tcl_Interp * interp;
+{
+ return (tclStubsPtr->tcl_GetMaster)(interp);
+}
+
+/* Slot 165 */
+CONST char *
+Tcl_GetNameOfExecutable()
+{
+ return (tclStubsPtr->tcl_GetNameOfExecutable)();
+}
+
+/* Slot 166 */
+Tcl_Obj *
+Tcl_GetObjResult(interp)
+ Tcl_Interp * interp;
+{
+ return (tclStubsPtr->tcl_GetObjResult)(interp);
+}
+
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* Slot 167 */
+int
+Tcl_GetOpenFile(interp, str, write, checkUsage, filePtr)
+ Tcl_Interp * interp;
+ char * str;
+ int write;
+ int checkUsage;
+ ClientData * filePtr;
+{
+ return (tclStubsPtr->tcl_GetOpenFile)(interp, str, write, checkUsage, filePtr);
+}
+
+#endif /* UNIX */
+/* Slot 168 */
+Tcl_PathType
+Tcl_GetPathType(path)
+ char * path;
+{
+ return (tclStubsPtr->tcl_GetPathType)(path);
+}
+
+/* Slot 169 */
+int
+Tcl_Gets(chan, dsPtr)
+ Tcl_Channel chan;
+ Tcl_DString * dsPtr;
+{
+ return (tclStubsPtr->tcl_Gets)(chan, dsPtr);
+}
+
+/* Slot 170 */
+int
+Tcl_GetsObj(chan, objPtr)
+ Tcl_Channel chan;
+ Tcl_Obj * objPtr;
+{
+ return (tclStubsPtr->tcl_GetsObj)(chan, objPtr);
+}
+
+/* Slot 171 */
+int
+Tcl_GetServiceMode()
+{
+ return (tclStubsPtr->tcl_GetServiceMode)();
+}
+
+/* Slot 172 */
+Tcl_Interp *
+Tcl_GetSlave(interp, slaveName)
+ Tcl_Interp * interp;
+ char * slaveName;
+{
+ return (tclStubsPtr->tcl_GetSlave)(interp, slaveName);
+}
+
+/* Slot 173 */
+Tcl_Channel
+Tcl_GetStdChannel(type)
+ int type;
+{
+ return (tclStubsPtr->tcl_GetStdChannel)(type);
+}
+
+/* Slot 174 */
+char *
+Tcl_GetStringResult(interp)
+ Tcl_Interp * interp;
+{
+ return (tclStubsPtr->tcl_GetStringResult)(interp);
+}
+
+/* Slot 175 */
+char *
+Tcl_GetVar(interp, varName, flags)
+ Tcl_Interp * interp;
+ char * varName;
+ int flags;
+{
+ return (tclStubsPtr->tcl_GetVar)(interp, varName, flags);
+}
+
+/* Slot 176 */
+char *
+Tcl_GetVar2(interp, part1, part2, flags)
+ Tcl_Interp * interp;
+ char * part1;
+ char * part2;
+ int flags;
+{
+ return (tclStubsPtr->tcl_GetVar2)(interp, part1, part2, flags);
+}
+
+/* Slot 177 */
+int
+Tcl_GlobalEval(interp, command)
+ Tcl_Interp * interp;
+ char * command;
+{
+ return (tclStubsPtr->tcl_GlobalEval)(interp, command);
+}
+
+/* Slot 178 */
+int
+Tcl_GlobalEvalObj(interp, objPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+{
+ return (tclStubsPtr->tcl_GlobalEvalObj)(interp, objPtr);
+}
+
+/* Slot 179 */
+int
+Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
+ Tcl_Interp * interp;
+ char * cmdName;
+ char * hiddenCmdToken;
+{
+ return (tclStubsPtr->tcl_HideCommand)(interp, cmdName, hiddenCmdToken);
+}
+
+/* Slot 180 */
+int
+Tcl_Init(interp)
+ Tcl_Interp * interp;
+{
+ return (tclStubsPtr->tcl_Init)(interp);
+}
+
+/* Slot 181 */
+void
+Tcl_InitHashTable(tablePtr, keyType)
+ Tcl_HashTable * tablePtr;
+ int keyType;
+{
+ (tclStubsPtr->tcl_InitHashTable)(tablePtr, keyType);
+}
+
+/* Slot 182 */
+int
+Tcl_InputBlocked(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_InputBlocked)(chan);
+}
+
+/* Slot 183 */
+int
+Tcl_InputBuffered(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_InputBuffered)(chan);
+}
+
+/* Slot 184 */
+int
+Tcl_InterpDeleted(interp)
+ Tcl_Interp * interp;
+{
+ return (tclStubsPtr->tcl_InterpDeleted)(interp);
+}
+
+/* Slot 185 */
+int
+Tcl_IsSafe(interp)
+ Tcl_Interp * interp;
+{
+ return (tclStubsPtr->tcl_IsSafe)(interp);
+}
+
+/* Slot 186 */
+char *
+Tcl_JoinPath(argc, argv, resultPtr)
+ int argc;
+ CONST char ** argv;
+ Tcl_DString * resultPtr;
+{
+ return (tclStubsPtr->tcl_JoinPath)(argc, argv, resultPtr);
+}
+
+/* Slot 187 */
+int
+Tcl_LinkVar(interp, varName, addr, type)
+ Tcl_Interp * interp;
+ char * varName;
+ char * addr;
+ int type;
+{
+ return (tclStubsPtr->tcl_LinkVar)(interp, varName, addr, type);
+}
+
+/* Slot 188 is reserved */
+/* Slot 189 */
+Tcl_Channel
+Tcl_MakeFileChannel(handle, mode)
+ ClientData handle;
+ int mode;
+{
+ return (tclStubsPtr->tcl_MakeFileChannel)(handle, mode);
+}
+
+/* Slot 190 */
+int
+Tcl_MakeSafe(interp)
+ Tcl_Interp * interp;
+{
+ return (tclStubsPtr->tcl_MakeSafe)(interp);
+}
+
+/* Slot 191 */
+Tcl_Channel
+Tcl_MakeTcpClientChannel(tcpSocket)
+ ClientData tcpSocket;
+{
+ return (tclStubsPtr->tcl_MakeTcpClientChannel)(tcpSocket);
+}
+
+/* Slot 192 */
+char *
+Tcl_Merge(argc, argv)
+ int argc;
+ char ** argv;
+{
+ return (tclStubsPtr->tcl_Merge)(argc, argv);
+}
+
+/* Slot 193 */
+Tcl_HashEntry *
+Tcl_NextHashEntry(searchPtr)
+ Tcl_HashSearch * searchPtr;
+{
+ return (tclStubsPtr->tcl_NextHashEntry)(searchPtr);
+}
+
+/* Slot 194 */
+void
+Tcl_NotifyChannel(channel, mask)
+ Tcl_Channel channel;
+ int mask;
+{
+ (tclStubsPtr->tcl_NotifyChannel)(channel, mask);
+}
+
+/* Slot 195 */
+Tcl_Obj *
+Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
+ Tcl_Interp * interp;
+ Tcl_Obj * part1Ptr;
+ Tcl_Obj * part2Ptr;
+ int flags;
+{
+ return (tclStubsPtr->tcl_ObjGetVar2)(interp, part1Ptr, part2Ptr, flags);
+}
+
+/* Slot 196 */
+Tcl_Obj *
+Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
+ Tcl_Interp * interp;
+ Tcl_Obj * part1Ptr;
+ Tcl_Obj * part2Ptr;
+ Tcl_Obj * newValuePtr;
+ int flags;
+{
+ return (tclStubsPtr->tcl_ObjSetVar2)(interp, part1Ptr, part2Ptr, newValuePtr, flags);
+}
+
+/* Slot 197 */
+Tcl_Channel
+Tcl_OpenCommandChannel(interp, argc, argv, flags)
+ Tcl_Interp * interp;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ return (tclStubsPtr->tcl_OpenCommandChannel)(interp, argc, argv, flags);
+}
+
+/* Slot 198 */
+Tcl_Channel
+Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
+ Tcl_Interp * interp;
+ char * fileName;
+ char * modeString;
+ int permissions;
+{
+ return (tclStubsPtr->tcl_OpenFileChannel)(interp, fileName, modeString, permissions);
+}
+
+/* Slot 199 */
+Tcl_Channel
+Tcl_OpenTcpClient(interp, port, address, myaddr, myport, async)
+ Tcl_Interp * interp;
+ int port;
+ char * address;
+ char * myaddr;
+ int myport;
+ int async;
+{
+ return (tclStubsPtr->tcl_OpenTcpClient)(interp, port, address, myaddr, myport, async);
+}
+
+/* Slot 200 */
+Tcl_Channel
+Tcl_OpenTcpServer(interp, port, host, acceptProc, callbackData)
+ Tcl_Interp * interp;
+ int port;
+ char * host;
+ Tcl_TcpAcceptProc * acceptProc;
+ ClientData callbackData;
+{
+ return (tclStubsPtr->tcl_OpenTcpServer)(interp, port, host, acceptProc, callbackData);
+}
+
+/* Slot 201 */
+void
+Tcl_Preserve(data)
+ ClientData data;
+{
+ (tclStubsPtr->tcl_Preserve)(data);
+}
+
+/* Slot 202 */
+void
+Tcl_PrintDouble(interp, value, dst)
+ Tcl_Interp * interp;
+ double value;
+ char * dst;
+{
+ (tclStubsPtr->tcl_PrintDouble)(interp, value, dst);
+}
+
+/* Slot 203 */
+int
+Tcl_PutEnv(string)
+ CONST char * string;
+{
+ return (tclStubsPtr->tcl_PutEnv)(string);
+}
+
+/* Slot 204 */
+char *
+Tcl_PosixError(interp)
+ Tcl_Interp * interp;
+{
+ return (tclStubsPtr->tcl_PosixError)(interp);
+}
+
+/* Slot 205 */
+void
+Tcl_QueueEvent(evPtr, position)
+ Tcl_Event * evPtr;
+ Tcl_QueuePosition position;
+{
+ (tclStubsPtr->tcl_QueueEvent)(evPtr, position);
+}
+
+/* Slot 206 */
+int
+Tcl_Read(chan, bufPtr, toRead)
+ Tcl_Channel chan;
+ char * bufPtr;
+ int toRead;
+{
+ return (tclStubsPtr->tcl_Read)(chan, bufPtr, toRead);
+}
+
+/* Slot 207 */
+void
+Tcl_ReapDetachedProcs()
+{
+ (tclStubsPtr->tcl_ReapDetachedProcs)();
+}
+
+/* Slot 208 */
+int
+Tcl_RecordAndEval(interp, cmd, flags)
+ Tcl_Interp * interp;
+ char * cmd;
+ int flags;
+{
+ return (tclStubsPtr->tcl_RecordAndEval)(interp, cmd, flags);
+}
+
+/* Slot 209 */
+int
+Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
+ Tcl_Interp * interp;
+ Tcl_Obj * cmdPtr;
+ int flags;
+{
+ return (tclStubsPtr->tcl_RecordAndEvalObj)(interp, cmdPtr, flags);
+}
+
+/* Slot 210 */
+void
+Tcl_RegisterChannel(interp, chan)
+ Tcl_Interp * interp;
+ Tcl_Channel chan;
+{
+ (tclStubsPtr->tcl_RegisterChannel)(interp, chan);
+}
+
+/* Slot 211 */
+void
+Tcl_RegisterObjType(typePtr)
+ Tcl_ObjType * typePtr;
+{
+ (tclStubsPtr->tcl_RegisterObjType)(typePtr);
+}
+
+/* Slot 212 */
+Tcl_RegExp
+Tcl_RegExpCompile(interp, string)
+ Tcl_Interp * interp;
+ char * string;
+{
+ return (tclStubsPtr->tcl_RegExpCompile)(interp, string);
+}
+
+/* Slot 213 */
+int
+Tcl_RegExpExec(interp, regexp, str, start)
+ Tcl_Interp * interp;
+ Tcl_RegExp regexp;
+ CONST char * str;
+ CONST char * start;
+{
+ return (tclStubsPtr->tcl_RegExpExec)(interp, regexp, str, start);
+}
+
+/* Slot 214 */
+int
+Tcl_RegExpMatch(interp, str, pattern)
+ Tcl_Interp * interp;
+ char * str;
+ char * pattern;
+{
+ return (tclStubsPtr->tcl_RegExpMatch)(interp, str, pattern);
+}
+
+/* Slot 215 */
+void
+Tcl_RegExpRange(regexp, index, startPtr, endPtr)
+ Tcl_RegExp regexp;
+ int index;
+ char ** startPtr;
+ char ** endPtr;
+{
+ (tclStubsPtr->tcl_RegExpRange)(regexp, index, startPtr, endPtr);
+}
+
+/* Slot 216 */
+void
+Tcl_Release(clientData)
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_Release)(clientData);
+}
+
+/* Slot 217 */
+void
+Tcl_ResetResult(interp)
+ Tcl_Interp * interp;
+{
+ (tclStubsPtr->tcl_ResetResult)(interp);
+}
+
+/* Slot 218 */
+int
+Tcl_ScanElement(str, flagPtr)
+ CONST char * str;
+ int * flagPtr;
+{
+ return (tclStubsPtr->tcl_ScanElement)(str, flagPtr);
+}
+
+/* Slot 219 */
+int
+Tcl_ScanCountedElement(str, length, flagPtr)
+ CONST char * str;
+ int length;
+ int * flagPtr;
+{
+ return (tclStubsPtr->tcl_ScanCountedElement)(str, length, flagPtr);
+}
+
+/* Slot 220 */
+int
+Tcl_Seek(chan, offset, mode)
+ Tcl_Channel chan;
+ int offset;
+ int mode;
+{
+ return (tclStubsPtr->tcl_Seek)(chan, offset, mode);
+}
+
+/* Slot 221 */
+int
+Tcl_ServiceAll()
+{
+ return (tclStubsPtr->tcl_ServiceAll)();
+}
+
+/* Slot 222 */
+int
+Tcl_ServiceEvent(flags)
+ int flags;
+{
+ return (tclStubsPtr->tcl_ServiceEvent)(flags);
+}
+
+/* Slot 223 */
+void
+Tcl_SetAssocData(interp, name, proc, clientData)
+ Tcl_Interp * interp;
+ char * name;
+ Tcl_InterpDeleteProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_SetAssocData)(interp, name, proc, clientData);
+}
+
+/* Slot 224 */
+void
+Tcl_SetChannelBufferSize(chan, sz)
+ Tcl_Channel chan;
+ int sz;
+{
+ (tclStubsPtr->tcl_SetChannelBufferSize)(chan, sz);
+}
+
+/* Slot 225 */
+int
+Tcl_SetChannelOption(interp, chan, optionName, newValue)
+ Tcl_Interp * interp;
+ Tcl_Channel chan;
+ char * optionName;
+ char * newValue;
+{
+ return (tclStubsPtr->tcl_SetChannelOption)(interp, chan, optionName, newValue);
+}
+
+/* Slot 226 */
+int
+Tcl_SetCommandInfo(interp, cmdName, infoPtr)
+ Tcl_Interp * interp;
+ char * cmdName;
+ Tcl_CmdInfo * infoPtr;
+{
+ return (tclStubsPtr->tcl_SetCommandInfo)(interp, cmdName, infoPtr);
+}
+
+/* Slot 227 */
+void
+Tcl_SetErrno(err)
+ int err;
+{
+ (tclStubsPtr->tcl_SetErrno)(err);
+}
+
+/* Slot 228 */
+void
+Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,interp)
+{
+ Tcl_Interp * var;
+ va_list argList;
+
+ var = (Tcl_Interp *) TCL_VARARGS_START(Tcl_Interp *,interp,argList);
+
+ (tclStubsPtr->tcl_SetErrorCodeVA)(var, argList);
+ va_end(argList);
+}
+
+/* Slot 229 */
+void
+Tcl_SetMaxBlockTime(timePtr)
+ Tcl_Time * timePtr;
+{
+ (tclStubsPtr->tcl_SetMaxBlockTime)(timePtr);
+}
+
+/* Slot 230 */
+void
+Tcl_SetPanicProc(panicProc)
+ Tcl_PanicProc * panicProc;
+{
+ (tclStubsPtr->tcl_SetPanicProc)(panicProc);
+}
+
+/* Slot 231 */
+int
+Tcl_SetRecursionLimit(interp, depth)
+ Tcl_Interp * interp;
+ int depth;
+{
+ return (tclStubsPtr->tcl_SetRecursionLimit)(interp, depth);
+}
+
+/* Slot 232 */
+void
+Tcl_SetResult(interp, str, freeProc)
+ Tcl_Interp * interp;
+ char * str;
+ Tcl_FreeProc * freeProc;
+{
+ (tclStubsPtr->tcl_SetResult)(interp, str, freeProc);
+}
+
+/* Slot 233 */
+int
+Tcl_SetServiceMode(mode)
+ int mode;
+{
+ return (tclStubsPtr->tcl_SetServiceMode)(mode);
+}
+
+/* Slot 234 */
+void
+Tcl_SetObjErrorCode(interp, errorObjPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * errorObjPtr;
+{
+ (tclStubsPtr->tcl_SetObjErrorCode)(interp, errorObjPtr);
+}
+
+/* Slot 235 */
+void
+Tcl_SetObjResult(interp, resultObjPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * resultObjPtr;
+{
+ (tclStubsPtr->tcl_SetObjResult)(interp, resultObjPtr);
+}
+
+/* Slot 236 */
+void
+Tcl_SetStdChannel(channel, type)
+ Tcl_Channel channel;
+ int type;
+{
+ (tclStubsPtr->tcl_SetStdChannel)(channel, type);
+}
+
+/* Slot 237 */
+char *
+Tcl_SetVar(interp, varName, newValue, flags)
+ Tcl_Interp * interp;
+ char * varName;
+ char * newValue;
+ int flags;
+{
+ return (tclStubsPtr->tcl_SetVar)(interp, varName, newValue, flags);
+}
+
+/* Slot 238 */
+char *
+Tcl_SetVar2(interp, part1, part2, newValue, flags)
+ Tcl_Interp * interp;
+ char * part1;
+ char * part2;
+ char * newValue;
+ int flags;
+{
+ return (tclStubsPtr->tcl_SetVar2)(interp, part1, part2, newValue, flags);
+}
+
+/* Slot 239 */
+char *
+Tcl_SignalId(sig)
+ int sig;
+{
+ return (tclStubsPtr->tcl_SignalId)(sig);
+}
+
+/* Slot 240 */
+char *
+Tcl_SignalMsg(sig)
+ int sig;
+{
+ return (tclStubsPtr->tcl_SignalMsg)(sig);
+}
+
+/* Slot 241 */
+void
+Tcl_SourceRCFile(interp)
+ Tcl_Interp * interp;
+{
+ (tclStubsPtr->tcl_SourceRCFile)(interp);
+}
+
+/* Slot 242 */
+int
+Tcl_SplitList(interp, listStr, argcPtr, argvPtr)
+ Tcl_Interp * interp;
+ CONST char * listStr;
+ int * argcPtr;
+ char *** argvPtr;
+{
+ return (tclStubsPtr->tcl_SplitList)(interp, listStr, argcPtr, argvPtr);
+}
+
+/* Slot 243 */
+void
+Tcl_SplitPath(path, argcPtr, argvPtr)
+ CONST char * path;
+ int * argcPtr;
+ char *** argvPtr;
+{
+ (tclStubsPtr->tcl_SplitPath)(path, argcPtr, argvPtr);
+}
+
+/* Slot 244 */
+void
+Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
+ Tcl_Interp * interp;
+ char * pkgName;
+ Tcl_PackageInitProc * initProc;
+ Tcl_PackageInitProc * safeInitProc;
+{
+ (tclStubsPtr->tcl_StaticPackage)(interp, pkgName, initProc, safeInitProc);
+}
+
+/* Slot 245 */
+int
+Tcl_StringMatch(str, pattern)
+ CONST char * str;
+ CONST char * pattern;
+{
+ return (tclStubsPtr->tcl_StringMatch)(str, pattern);
+}
+
+/* Slot 246 */
+int
+Tcl_Tell(chan)
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_Tell)(chan);
+}
+
+/* Slot 247 */
+int
+Tcl_TraceVar(interp, varName, flags, proc, clientData)
+ Tcl_Interp * interp;
+ char * varName;
+ int flags;
+ Tcl_VarTraceProc * proc;
+ ClientData clientData;
+{
+ return (tclStubsPtr->tcl_TraceVar)(interp, varName, flags, proc, clientData);
+}
+
+/* Slot 248 */
+int
+Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
+ Tcl_Interp * interp;
+ char * part1;
+ char * part2;
+ int flags;
+ Tcl_VarTraceProc * proc;
+ ClientData clientData;
+{
+ return (tclStubsPtr->tcl_TraceVar2)(interp, part1, part2, flags, proc, clientData);
+}
+
+/* Slot 249 */
+char *
+Tcl_TranslateFileName(interp, name, bufferPtr)
+ Tcl_Interp * interp;
+ CONST char * name;
+ Tcl_DString * bufferPtr;
+{
+ return (tclStubsPtr->tcl_TranslateFileName)(interp, name, bufferPtr);
+}
+
+/* Slot 250 */
+int
+Tcl_Ungets(chan, str, len, atHead)
+ Tcl_Channel chan;
+ char * str;
+ int len;
+ int atHead;
+{
+ return (tclStubsPtr->tcl_Ungets)(chan, str, len, atHead);
+}
+
+/* Slot 251 */
+void
+Tcl_UnlinkVar(interp, varName)
+ Tcl_Interp * interp;
+ char * varName;
+{
+ (tclStubsPtr->tcl_UnlinkVar)(interp, varName);
+}
+
+/* Slot 252 */
+int
+Tcl_UnregisterChannel(interp, chan)
+ Tcl_Interp * interp;
+ Tcl_Channel chan;
+{
+ return (tclStubsPtr->tcl_UnregisterChannel)(interp, chan);
+}
+
+/* Slot 253 */
+int
+Tcl_UnsetVar(interp, varName, flags)
+ Tcl_Interp * interp;
+ char * varName;
+ int flags;
+{
+ return (tclStubsPtr->tcl_UnsetVar)(interp, varName, flags);
+}
+
+/* Slot 254 */
+int
+Tcl_UnsetVar2(interp, part1, part2, flags)
+ Tcl_Interp * interp;
+ char * part1;
+ char * part2;
+ int flags;
+{
+ return (tclStubsPtr->tcl_UnsetVar2)(interp, part1, part2, flags);
+}
+
+/* Slot 255 */
+void
+Tcl_UntraceVar(interp, varName, flags, proc, clientData)
+ Tcl_Interp * interp;
+ char * varName;
+ int flags;
+ Tcl_VarTraceProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_UntraceVar)(interp, varName, flags, proc, clientData);
+}
+
+/* Slot 256 */
+void
+Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
+ Tcl_Interp * interp;
+ char * part1;
+ char * part2;
+ int flags;
+ Tcl_VarTraceProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_UntraceVar2)(interp, part1, part2, flags, proc, clientData);
+}
+
+/* Slot 257 */
+void
+Tcl_UpdateLinkedVar(interp, varName)
+ Tcl_Interp * interp;
+ char * varName;
+{
+ (tclStubsPtr->tcl_UpdateLinkedVar)(interp, varName);
+}
+
+/* Slot 258 */
+int
+Tcl_UpVar(interp, frameName, varName, localName, flags)
+ Tcl_Interp * interp;
+ char * frameName;
+ char * varName;
+ char * localName;
+ int flags;
+{
+ return (tclStubsPtr->tcl_UpVar)(interp, frameName, varName, localName, flags);
+}
+
+/* Slot 259 */
+int
+Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
+ Tcl_Interp * interp;
+ char * frameName;
+ char * part1;
+ char * part2;
+ char * localName;
+ int flags;
+{
+ return (tclStubsPtr->tcl_UpVar2)(interp, frameName, part1, part2, localName, flags);
+}
+
+/* Slot 260 */
+int
+Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,interp)
+{
+ Tcl_Interp * var;
+ va_list argList;
+ int resultValue;
+
+ var = (Tcl_Interp *) TCL_VARARGS_START(Tcl_Interp *,interp,argList);
+
+ resultValue = (tclStubsPtr->tcl_VarEvalVA)(var, argList);
+ va_end(argList);
+return resultValue;
+}
+
+/* Slot 261 */
+ClientData
+Tcl_VarTraceInfo(interp, varName, flags, procPtr, prevClientData)
+ Tcl_Interp * interp;
+ char * varName;
+ int flags;
+ Tcl_VarTraceProc * procPtr;
+ ClientData prevClientData;
+{
+ return (tclStubsPtr->tcl_VarTraceInfo)(interp, varName, flags, procPtr, prevClientData);
+}
+
+/* Slot 262 */
+ClientData
+Tcl_VarTraceInfo2(interp, part1, part2, flags, procPtr, prevClientData)
+ Tcl_Interp * interp;
+ char * part1;
+ char * part2;
+ int flags;
+ Tcl_VarTraceProc * procPtr;
+ ClientData prevClientData;
+{
+ return (tclStubsPtr->tcl_VarTraceInfo2)(interp, part1, part2, flags, procPtr, prevClientData);
+}
+
+/* Slot 263 */
+int
+Tcl_Write(chan, s, slen)
+ Tcl_Channel chan;
+ char * s;
+ int slen;
+{
+ return (tclStubsPtr->tcl_Write)(chan, s, slen);
+}
+
+/* Slot 264 */
+void
+Tcl_WrongNumArgs(interp, objc, objv, message)
+ Tcl_Interp * interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+ char * message;
+{
+ (tclStubsPtr->tcl_WrongNumArgs)(interp, objc, objv, message);
+}
+
+/* Slot 265 */
+int
+Tcl_DumpActiveMemory(fileName)
+ char * fileName;
+{
+ return (tclStubsPtr->tcl_DumpActiveMemory)(fileName);
+}
+
+/* Slot 266 */
+void
+Tcl_ValidateAllMemory(file, line)
+ char * file;
+ int line;
+{
+ (tclStubsPtr->tcl_ValidateAllMemory)(file, line);
+}
+
+/* Slot 267 */
+void
+Tcl_AppendResultVA(interp, argList)
+ Tcl_Interp * interp;
+ va_list argList;
+{
+ (tclStubsPtr->tcl_AppendResultVA)(interp, argList);
+}
+
+/* Slot 268 */
+void
+Tcl_AppendStringsToObjVA(objPtr, argList)
+ Tcl_Obj * objPtr;
+ va_list argList;
+{
+ (tclStubsPtr->tcl_AppendStringsToObjVA)(objPtr, argList);
+}
+
+/* Slot 269 */
+char *
+Tcl_HashStats(tablePtr)
+ Tcl_HashTable * tablePtr;
+{
+ return (tclStubsPtr->tcl_HashStats)(tablePtr);
+}
+
+/* Slot 270 */
+char *
+Tcl_ParseVar(interp, str, termPtr)
+ Tcl_Interp * interp;
+ char * str;
+ char ** termPtr;
+{
+ return (tclStubsPtr->tcl_ParseVar)(interp, str, termPtr);
+}
+
+/* Slot 271 */
+char *
+Tcl_PkgPresent(interp, name, version, exact)
+ Tcl_Interp * interp;
+ char * name;
+ char * version;
+ int exact;
+{
+ return (tclStubsPtr->tcl_PkgPresent)(interp, name, version, exact);
+}
+
+/* Slot 272 */
+char *
+Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
+ Tcl_Interp * interp;
+ char * name;
+ char * version;
+ int exact;
+ ClientData * clientDataPtr;
+{
+ return (tclStubsPtr->tcl_PkgPresentEx)(interp, name, version, exact, clientDataPtr);
+}
+
+/* Slot 273 */
+int
+Tcl_PkgProvide(interp, name, version)
+ Tcl_Interp * interp;
+ char * name;
+ char * version;
+{
+ return (tclStubsPtr->tcl_PkgProvide)(interp, name, version);
+}
+
+/* Slot 274 */
+char *
+Tcl_PkgRequire(interp, name, version, exact)
+ Tcl_Interp * interp;
+ char * name;
+ char * version;
+ int exact;
+{
+ return (tclStubsPtr->tcl_PkgRequire)(interp, name, version, exact);
+}
+
+/* Slot 275 */
+void
+Tcl_SetErrorCodeVA(interp, argList)
+ Tcl_Interp * interp;
+ va_list argList;
+{
+ (tclStubsPtr->tcl_SetErrorCodeVA)(interp, argList);
+}
+
+/* Slot 276 */
+int
+Tcl_VarEvalVA(interp, argList)
+ Tcl_Interp * interp;
+ va_list argList;
+{
+ return (tclStubsPtr->tcl_VarEvalVA)(interp, argList);
+}
+
+/* Slot 277 */
+Tcl_Pid
+Tcl_WaitPid(pid, statPtr, options)
+ Tcl_Pid pid;
+ int * statPtr;
+ int options;
+{
+ return (tclStubsPtr->tcl_WaitPid)(pid, statPtr, options);
+}
+
+/* Slot 278 */
+void
+Tcl_PanicVA(format, argList)
+ char * format;
+ va_list argList;
+{
+ (tclStubsPtr->tcl_PanicVA)(format, argList);
+}
+
+/* Slot 279 */
+void
+Tcl_GetVersion(major, minor, patchLevel, type)
+ int * major;
+ int * minor;
+ int * patchLevel;
+ int * type;
+{
+ (tclStubsPtr->tcl_GetVersion)(major, minor, patchLevel, type);
+}
+
+/* Slot 280 is reserved */
+/* Slot 281 is reserved */
+/* Slot 282 is reserved */
+/* Slot 283 is reserved */
+/* Slot 284 is reserved */
+/* Slot 285 is reserved */
+/* Slot 286 */
+void
+Tcl_AppendObjToObj(objPtr, appendObjPtr)
+ Tcl_Obj * objPtr;
+ Tcl_Obj * appendObjPtr;
+{
+ (tclStubsPtr->tcl_AppendObjToObj)(objPtr, appendObjPtr);
+}
+
+/* Slot 287 */
+Tcl_Encoding
+Tcl_CreateEncoding(typePtr)
+ Tcl_EncodingType * typePtr;
+{
+ return (tclStubsPtr->tcl_CreateEncoding)(typePtr);
+}
+
+/* Slot 288 */
+void
+Tcl_CreateThreadExitHandler(proc, clientData)
+ Tcl_ExitProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_CreateThreadExitHandler)(proc, clientData);
+}
+
+/* Slot 289 */
+void
+Tcl_DeleteThreadExitHandler(proc, clientData)
+ Tcl_ExitProc * proc;
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_DeleteThreadExitHandler)(proc, clientData);
+}
+
+/* Slot 290 */
+void
+Tcl_DiscardResult(statePtr)
+ Tcl_SavedResult * statePtr;
+{
+ (tclStubsPtr->tcl_DiscardResult)(statePtr);
+}
+
+/* Slot 291 */
+int
+Tcl_EvalEx(interp, script, numBytes, flags)
+ Tcl_Interp * interp;
+ char * script;
+ int numBytes;
+ int flags;
+{
+ return (tclStubsPtr->tcl_EvalEx)(interp, script, numBytes, flags);
+}
+
+/* Slot 292 */
+int
+Tcl_EvalObjv(interp, objc, objv, flags)
+ Tcl_Interp * interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+ int flags;
+{
+ return (tclStubsPtr->tcl_EvalObjv)(interp, objc, objv, flags);
+}
+
+/* Slot 293 */
+int
+Tcl_EvalObjEx(interp, objPtr, flags)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ int flags;
+{
+ return (tclStubsPtr->tcl_EvalObjEx)(interp, objPtr, flags);
+}
+
+/* Slot 294 */
+void
+Tcl_ExitThread(status)
+ int status;
+{
+ (tclStubsPtr->tcl_ExitThread)(status);
+}
+
+/* Slot 295 */
+int
+Tcl_ExternalToUtf(interp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
+ Tcl_Interp * interp;
+ Tcl_Encoding encoding;
+ CONST char * src;
+ int srcLen;
+ int flags;
+ Tcl_EncodingState * statePtr;
+ char * dst;
+ int dstLen;
+ int * srcReadPtr;
+ int * dstWrotePtr;
+ int * dstCharsPtr;
+{
+ return (tclStubsPtr->tcl_ExternalToUtf)(interp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr);
+}
+
+/* Slot 296 */
+char *
+Tcl_ExternalToUtfDString(encoding, src, srcLen, dsPtr)
+ Tcl_Encoding encoding;
+ CONST char * src;
+ int srcLen;
+ Tcl_DString * dsPtr;
+{
+ return (tclStubsPtr->tcl_ExternalToUtfDString)(encoding, src, srcLen, dsPtr);
+}
+
+/* Slot 297 */
+void
+Tcl_FinalizeThread()
+{
+ (tclStubsPtr->tcl_FinalizeThread)();
+}
+
+/* Slot 298 */
+void
+Tcl_FinalizeNotifier(clientData)
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_FinalizeNotifier)(clientData);
+}
+
+/* Slot 299 */
+void
+Tcl_FreeEncoding(encoding)
+ Tcl_Encoding encoding;
+{
+ (tclStubsPtr->tcl_FreeEncoding)(encoding);
+}
+
+/* Slot 300 */
+Tcl_ThreadId
+Tcl_GetCurrentThread()
+{
+ return (tclStubsPtr->tcl_GetCurrentThread)();
+}
+
+/* Slot 301 */
+Tcl_Encoding
+Tcl_GetEncoding(interp, name)
+ Tcl_Interp * interp;
+ CONST char * name;
+{
+ return (tclStubsPtr->tcl_GetEncoding)(interp, name);
+}
+
+/* Slot 302 */
+char *
+Tcl_GetEncodingName(encoding)
+ Tcl_Encoding encoding;
+{
+ return (tclStubsPtr->tcl_GetEncodingName)(encoding);
+}
+
+/* Slot 303 */
+void
+Tcl_GetEncodingNames(interp)
+ Tcl_Interp * interp;
+{
+ (tclStubsPtr->tcl_GetEncodingNames)(interp);
+}
+
+/* Slot 304 */
+int
+Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr)
+ Tcl_Interp * interp;
+ Tcl_Obj * objPtr;
+ char ** tablePtr;
+ int offset;
+ char * msg;
+ int flags;
+ int * indexPtr;
+{
+ return (tclStubsPtr->tcl_GetIndexFromObjStruct)(interp, objPtr, tablePtr, offset, msg, flags, indexPtr);
+}
+
+/* Slot 305 */
+VOID *
+Tcl_GetThreadData(keyPtr, size)
+ Tcl_ThreadDataKey * keyPtr;
+ int size;
+{
+ return (tclStubsPtr->tcl_GetThreadData)(keyPtr, size);
+}
+
+/* Slot 306 */
+Tcl_Obj *
+Tcl_GetVar2Ex(interp, part1, part2, flags)
+ Tcl_Interp * interp;
+ char * part1;
+ char * part2;
+ int flags;
+{
+ return (tclStubsPtr->tcl_GetVar2Ex)(interp, part1, part2, flags);
+}
+
+/* Slot 307 */
+ClientData
+Tcl_InitNotifier()
+{
+ return (tclStubsPtr->tcl_InitNotifier)();
+}
+
+/* Slot 308 */
+void
+Tcl_MutexLock(mutexPtr)
+ Tcl_Mutex * mutexPtr;
+{
+ (tclStubsPtr->tcl_MutexLock)(mutexPtr);
+}
+
+/* Slot 309 */
+void
+Tcl_MutexUnlock(mutexPtr)
+ Tcl_Mutex * mutexPtr;
+{
+ (tclStubsPtr->tcl_MutexUnlock)(mutexPtr);
+}
+
+/* Slot 310 */
+void
+Tcl_ConditionNotify(condPtr)
+ Tcl_Condition * condPtr;
+{
+ (tclStubsPtr->tcl_ConditionNotify)(condPtr);
+}
+
+/* Slot 311 */
+void
+Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+ Tcl_Condition * condPtr;
+ Tcl_Mutex * mutexPtr;
+ Tcl_Time * timePtr;
+{
+ (tclStubsPtr->tcl_ConditionWait)(condPtr, mutexPtr, timePtr);
+}
+
+/* Slot 312 */
+int
+Tcl_NumUtfChars(src, len)
+ CONST char * src;
+ int len;
+{
+ return (tclStubsPtr->tcl_NumUtfChars)(src, len);
+}
+
+/* Slot 313 */
+int
+Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag)
+ Tcl_Channel channel;
+ Tcl_Obj * objPtr;
+ int charsToRead;
+ int appendFlag;
+{
+ return (tclStubsPtr->tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag);
+}
+
+/* Slot 314 */
+void
+Tcl_RestoreResult(interp, statePtr)
+ Tcl_Interp * interp;
+ Tcl_SavedResult * statePtr;
+{
+ (tclStubsPtr->tcl_RestoreResult)(interp, statePtr);
+}
+
+/* Slot 315 */
+void
+Tcl_SaveResult(interp, statePtr)
+ Tcl_Interp * interp;
+ Tcl_SavedResult * statePtr;
+{
+ (tclStubsPtr->tcl_SaveResult)(interp, statePtr);
+}
+
+/* Slot 316 */
+int
+Tcl_SetSystemEncoding(interp, name)
+ Tcl_Interp * interp;
+ CONST char * name;
+{
+ return (tclStubsPtr->tcl_SetSystemEncoding)(interp, name);
+}
+
+/* Slot 317 */
+Tcl_Obj *
+Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
+ Tcl_Interp * interp;
+ char * part1;
+ char * part2;
+ Tcl_Obj * newValuePtr;
+ int flags;
+{
+ return (tclStubsPtr->tcl_SetVar2Ex)(interp, part1, part2, newValuePtr, flags);
+}
+
+/* Slot 318 */
+void
+Tcl_ThreadAlert(threadId)
+ Tcl_ThreadId threadId;
+{
+ (tclStubsPtr->tcl_ThreadAlert)(threadId);
+}
+
+/* Slot 319 */
+void
+Tcl_ThreadQueueEvent(threadId, evPtr, position)
+ Tcl_ThreadId threadId;
+ Tcl_Event* evPtr;
+ Tcl_QueuePosition position;
+{
+ (tclStubsPtr->tcl_ThreadQueueEvent)(threadId, evPtr, position);
+}
+
+/* Slot 320 */
+Tcl_UniChar
+Tcl_UniCharAtIndex(src, index)
+ CONST char * src;
+ int index;
+{
+ return (tclStubsPtr->tcl_UniCharAtIndex)(src, index);
+}
+
+/* Slot 321 */
+Tcl_UniChar
+Tcl_UniCharToLower(ch)
+ int ch;
+{
+ return (tclStubsPtr->tcl_UniCharToLower)(ch);
+}
+
+/* Slot 322 */
+Tcl_UniChar
+Tcl_UniCharToTitle(ch)
+ int ch;
+{
+ return (tclStubsPtr->tcl_UniCharToTitle)(ch);
+}
+
+/* Slot 323 */
+Tcl_UniChar
+Tcl_UniCharToUpper(ch)
+ int ch;
+{
+ return (tclStubsPtr->tcl_UniCharToUpper)(ch);
+}
+
+/* Slot 324 */
+int
+Tcl_UniCharToUtf(ch, buf)
+ int ch;
+ char * buf;
+{
+ return (tclStubsPtr->tcl_UniCharToUtf)(ch, buf);
+}
+
+/* Slot 325 */
+char *
+Tcl_UtfAtIndex(src, index)
+ CONST char * src;
+ int index;
+{
+ return (tclStubsPtr->tcl_UtfAtIndex)(src, index);
+}
+
+/* Slot 326 */
+int
+Tcl_UtfCharComplete(src, len)
+ CONST char * src;
+ int len;
+{
+ return (tclStubsPtr->tcl_UtfCharComplete)(src, len);
+}
+
+/* Slot 327 */
+int
+Tcl_UtfBackslash(src, readPtr, dst)
+ CONST char * src;
+ int * readPtr;
+ char * dst;
+{
+ return (tclStubsPtr->tcl_UtfBackslash)(src, readPtr, dst);
+}
+
+/* Slot 328 */
+char *
+Tcl_UtfFindFirst(src, ch)
+ CONST char * src;
+ int ch;
+{
+ return (tclStubsPtr->tcl_UtfFindFirst)(src, ch);
+}
+
+/* Slot 329 */
+char *
+Tcl_UtfFindLast(src, ch)
+ CONST char * src;
+ int ch;
+{
+ return (tclStubsPtr->tcl_UtfFindLast)(src, ch);
+}
+
+/* Slot 330 */
+char *
+Tcl_UtfNext(src)
+ CONST char * src;
+{
+ return (tclStubsPtr->tcl_UtfNext)(src);
+}
+
+/* Slot 331 */
+char *
+Tcl_UtfPrev(src, start)
+ CONST char * src;
+ CONST char * start;
+{
+ return (tclStubsPtr->tcl_UtfPrev)(src, start);
+}
+
+/* Slot 332 */
+int
+Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr)
+ Tcl_Interp * interp;
+ Tcl_Encoding encoding;
+ CONST char * src;
+ int srcLen;
+ int flags;
+ Tcl_EncodingState * statePtr;
+ char * dst;
+ int dstLen;
+ int * srcReadPtr;
+ int * dstWrotePtr;
+ int * dstCharsPtr;
+{
+ return (tclStubsPtr->tcl_UtfToExternal)(interp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr);
+}
+
+/* Slot 333 */
+char *
+Tcl_UtfToExternalDString(encoding, src, srcLen, dsPtr)
+ Tcl_Encoding encoding;
+ CONST char * src;
+ int srcLen;
+ Tcl_DString * dsPtr;
+{
+ return (tclStubsPtr->tcl_UtfToExternalDString)(encoding, src, srcLen, dsPtr);
+}
+
+/* Slot 334 */
+int
+Tcl_UtfToLower(src)
+ char * src;
+{
+ return (tclStubsPtr->tcl_UtfToLower)(src);
+}
+
+/* Slot 335 */
+int
+Tcl_UtfToTitle(src)
+ char * src;
+{
+ return (tclStubsPtr->tcl_UtfToTitle)(src);
+}
+
+/* Slot 336 */
+int
+Tcl_UtfToUniChar(src, chPtr)
+ CONST char * src;
+ Tcl_UniChar * chPtr;
+{
+ return (tclStubsPtr->tcl_UtfToUniChar)(src, chPtr);
+}
+
+/* Slot 337 */
+int
+Tcl_UtfToUpper(src)
+ char * src;
+{
+ return (tclStubsPtr->tcl_UtfToUpper)(src);
+}
+
+/* Slot 338 */
+int
+Tcl_WriteChars(chan, src, srcLen)
+ Tcl_Channel chan;
+ CONST char * src;
+ int srcLen;
+{
+ return (tclStubsPtr->tcl_WriteChars)(chan, src, srcLen);
+}
+
+/* Slot 339 */
+int
+Tcl_WriteObj(chan, objPtr)
+ Tcl_Channel chan;
+ Tcl_Obj * objPtr;
+{
+ return (tclStubsPtr->tcl_WriteObj)(chan, objPtr);
+}
+
+/* Slot 340 */
+char *
+Tcl_GetString(objPtr)
+ Tcl_Obj * objPtr;
+{
+ return (tclStubsPtr->tcl_GetString)(objPtr);
+}
+
+/* Slot 341 */
+char *
+Tcl_GetDefaultEncodingDir()
+{
+ return (tclStubsPtr->tcl_GetDefaultEncodingDir)();
+}
+
+/* Slot 342 */
+void
+Tcl_SetDefaultEncodingDir(path)
+ char * path;
+{
+ (tclStubsPtr->tcl_SetDefaultEncodingDir)(path);
+}
+
+/* Slot 343 */
+void
+Tcl_AlertNotifier(clientData)
+ ClientData clientData;
+{
+ (tclStubsPtr->tcl_AlertNotifier)(clientData);
+}
+
+/* Slot 344 */
+void
+Tcl_ServiceModeHook(mode)
+ int mode;
+{
+ (tclStubsPtr->tcl_ServiceModeHook)(mode);
+}
+
+
+/* !END!: Do not edit above this line. */
diff --git a/tcl/generic/tclTest.c b/tcl/generic/tclTest.c
index 49c8fe11296..99f80d68bf1 100644
--- a/tcl/generic/tclTest.c
+++ b/tcl/generic/tclTest.c
@@ -8,6 +8,7 @@
*
* Copyright (c) 1993-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -19,15 +20,14 @@
#include "tclInt.h"
#include "tclPort.h"
+#include "tclRegexp.h"
+#include "tclIO.h"
+#include <locale.h>
/*
* Declare external functions used in Windows tests.
*/
-#if defined(__WIN32__)
-extern TclPlatformType * TclWinGetPlatform _ANSI_ARGS_((void));
-#endif
-
/*
* Dynamic string shared by TestdcallCmd and DelCallbackProc; used
* to collect the results of the various deletion callbacks.
@@ -77,6 +77,24 @@ typedef struct DelCmd {
} DelCmd;
/*
+ * The following is used to keep track of an encoding that invokes a Tcl
+ * command.
+ */
+
+typedef struct TclEncoding {
+ Tcl_Interp *interp;
+ char *toUtfCmd;
+ char *fromUtfCmd;
+} TclEncoding;
+
+/*
+ * The counter below is used to determine if the TestsaveresultFree
+ * routine was called for a result.
+ */
+
+static int freeCount;
+
+/*
* Forward declarations for procedures defined later in this file:
*/
@@ -111,6 +129,17 @@ static void DelCallbackProc _ANSI_ARGS_((ClientData clientData,
static int DelCmdProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
static void DelDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void EncodingFreeProc _ANSI_ARGS_((ClientData clientData));
+static int EncodingToUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static int EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
static void ExitProcEven _ANSI_ARGS_((ClientData clientData));
static void ExitProcOdd _ANSI_ARGS_((ClientData clientData));
static int GetTimesCmd _ANSI_ARGS_((ClientData clientData,
@@ -118,7 +147,10 @@ static int GetTimesCmd _ANSI_ARGS_((ClientData clientData,
static int NoopCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
static int NoopObjCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void PrintParse _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr));
static void SpecialFree _ANSI_ARGS_((char *blockPtr));
static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp));
static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy,
@@ -149,10 +181,22 @@ static int TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestdstringCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
+static int TestencodingObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int TestevalexObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
+static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestfileCmd _ANSI_ARGS_((ClientData dummy,
@@ -170,6 +214,9 @@ static int TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestlinkCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
+static int TestlocaleCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int TestMathFunc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
@@ -182,12 +229,30 @@ static Tcl_Channel TestOpenFileChannelProc2 _ANSI_ARGS_((Tcl_Interp *interp,
char *filename, char *modeString, int permissions));
static Tcl_Channel TestOpenFileChannelProc3 _ANSI_ARGS_((Tcl_Interp *interp,
char *filename, char *modeString, int permissions));
-static int TestPanicCmd _ANSI_ARGS_((ClientData dummy,
+static int TestpanicCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
+static int TestparserObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int TestparsevarObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int TestparsevarnameObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int TestregexpObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void TestregexpXflags _ANSI_ARGS_((char *string,
+ int length, int *cflagsPtr, int *eflagsPtr));
+static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static void TestsaveresultFree _ANSI_ARGS_((char *blockPtr));
static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
-static int TestsetnoerrCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+static int TestsetCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
static int TestsetobjerrorcodeCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
@@ -201,27 +266,30 @@ static int TestsetrecursionlimitCmd _ANSI_ARGS_((
static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestStatProc1 _ANSI_ARGS_((CONST char *path,
- TclStat_ *buf));
+ struct stat *buf));
static int TestStatProc2 _ANSI_ARGS_((CONST char *path,
- TclStat_ *buf));
+ struct stat *buf));
static int TestStatProc3 _ANSI_ARGS_((CONST char *path,
- TclStat_ *buf));
+ struct stat *buf));
static int TeststatprocCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestupvarCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
-static int TestwordendObjCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
+static int TestChannelCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestChannelEventCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
/*
- * External (platform specific) initialization routine:
+ * External (platform specific) initialization routine, these declarations
+ * explicitly don't use EXTERN since this code does not get compiled
+ * into the library:
*/
-EXTERN int TclplatformtestInit _ANSI_ARGS_((
- Tcl_Interp *interp));
+extern int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
/*
*----------------------------------------------------------------------
@@ -234,7 +302,7 @@ EXTERN int TclplatformtestInit _ANSI_ARGS_((
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -256,6 +324,8 @@ Tcltest_Init(interp)
* Create additional commands and math functions for testing Tcl.
*/
+ Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0,
@@ -264,9 +334,9 @@ Tcltest_Init(interp)
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testchannel", TclTestChannelCmd,
+ Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testchannelevent", TclTestChannelEventCmd,
+ Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
@@ -287,12 +357,22 @@ Tcltest_Init(interp)
Tcl_DStringInit(&dstring);
Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testfile", TestfileCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
@@ -306,13 +386,29 @@ Tcltest_Init(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testopenfilechannelproc",
TestopenfilechannelprocCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testsetnoerr", TestsetnoerrCmd,
+ Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
+ (ClientData) TCL_LEAVE_ERR_MSG, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
TestsetobjerrorcodeCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
@@ -328,14 +424,6 @@ Tcltest_Init(interp)
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testwordend", TestwordendObjCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testpanic", TestPanicCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateMathFunc(interp, "T1", 0, (Tcl_ValueType *) NULL, TestMathFunc,
(ClientData) 123);
Tcl_CreateMathFunc(interp, "T2", 0, (Tcl_ValueType *) NULL, TestMathFunc,
@@ -347,6 +435,12 @@ Tcltest_Init(interp)
Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
(ClientData) 0);
+#ifdef TCL_THREADS
+ if (TclThread_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+#endif
+
/*
* And finally add any platform specific test commands.
*/
@@ -382,7 +476,7 @@ TestasyncCmd(dummy, interp, argc, argv)
TestAsyncHandler *asyncPtr, *prevPtr;
int id, code;
static int nextId = 1;
- char buf[30];
+ char buf[TCL_INTEGER_SPACE];
if (argc < 2) {
wrongNumArgs:
@@ -402,7 +496,7 @@ TestasyncCmd(dummy, interp, argc, argv)
strcpy(asyncPtr->command, argv[2]);
asyncPtr->nextPtr = firstHandler;
firstHandler = asyncPtr;
- sprintf(buf, "%d", asyncPtr->id);
+ TclFormatInt(buf, asyncPtr->id);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (strcmp(argv[1], "delete") == 0) {
if (argc == 2) {
@@ -471,11 +565,11 @@ AsyncHandlerProc(clientData, interp, code)
{
TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData;
char *listArgv[4];
- char string[20], *cmd;
+ char string[TCL_INTEGER_SPACE], *cmd;
- sprintf(string, "%d", code);
+ TclFormatInt(string, code);
listArgv[0] = asyncPtr->command;
- listArgv[1] = interp->result;
+ listArgv[1] = Tcl_GetStringResult(interp);
listArgv[2] = string;
listArgv[3] = NULL;
cmd = Tcl_Merge(3, listArgv);
@@ -673,8 +767,7 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
Tcl_AppendElement(interp,
Tcl_GetCommandName(interp, (Tcl_Command) l));
- Tcl_AppendElement(interp,
- Tcl_GetStringFromObj(objPtr, (int *) NULL));
+ Tcl_AppendElement(interp, Tcl_GetString(objPtr));
Tcl_DecrRefCount(objPtr);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
@@ -740,7 +833,7 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
cmdTrace = Tcl_CreateTrace(interp, 50000,
(Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
- result = Tcl_Eval(interp, argv[2]);
+ Tcl_Eval(interp, argv[2]);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be tracetest or deletetest", (char *) NULL);
@@ -954,9 +1047,9 @@ DelCallbackProc(clientData, interp)
Tcl_Interp *interp; /* Interpreter being deleted. */
{
int id = (int) clientData;
- char buffer[10];
+ char buffer[TCL_INTEGER_SPACE];
- sprintf(buffer, "%d", id);
+ TclFormatInt(buffer, id);
Tcl_DStringAppendElement(&delString, buffer);
if (interp != delInterp) {
Tcl_DStringAppendElement(&delString, "bogus interpreter argument!");
@@ -1156,12 +1249,12 @@ TestdstringCmd(dummy, interp, argc, argv)
}
Tcl_DStringGetResult(interp, &dstring);
} else if (strcmp(argv[1], "length") == 0) {
- char buf[30];
+ char buf[TCL_INTEGER_SPACE];
if (argc != 2) {
goto wrongNumArgs;
}
- sprintf(buf, "%d", Tcl_DStringLength(&dstring));
+ TclFormatInt(buf, Tcl_DStringLength(&dstring));
Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (strcmp(argv[1], "result") == 0) {
if (argc != 2) {
@@ -1204,6 +1297,285 @@ static void SpecialFree(blockPtr)
/*
*----------------------------------------------------------------------
*
+ * TestencodingCmd --
+ *
+ * This procedure implements the "testencoding" command. It is used
+ * to test the encoding package.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Load encodings.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestencodingObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tcl_Encoding encoding;
+ int index, length;
+ char *string;
+ TclEncoding *encodingPtr;
+ static char *optionStrings[] = {
+ "create", "delete", "path",
+ NULL
+ };
+ enum options {
+ ENC_CREATE, ENC_DELETE, ENC_PATH
+ };
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case ENC_CREATE: {
+ Tcl_EncodingType type;
+
+ if (objc != 5) {
+ return TCL_ERROR;
+ }
+ encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding));
+ encodingPtr->interp = interp;
+
+ string = Tcl_GetStringFromObj(objv[3], &length);
+ encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1));
+ memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
+
+ string = Tcl_GetStringFromObj(objv[4], &length);
+ encodingPtr->fromUtfCmd = (char *) ckalloc((unsigned) (length + 1));
+ memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
+
+ string = Tcl_GetStringFromObj(objv[2], &length);
+
+ type.encodingName = string;
+ type.toUtfProc = EncodingToUtfProc;
+ type.fromUtfProc = EncodingFromUtfProc;
+ type.freeProc = EncodingFreeProc;
+ type.clientData = (ClientData) encodingPtr;
+ type.nullSize = 1;
+
+ Tcl_CreateEncoding(&type);
+ break;
+ }
+ case ENC_DELETE: {
+ if (objc != 3) {
+ return TCL_ERROR;
+ }
+ encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
+ Tcl_FreeEncoding(encoding);
+ Tcl_FreeEncoding(encoding);
+ break;
+ }
+ case ENC_PATH: {
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, TclGetLibraryPath());
+ } else {
+ TclSetLibraryPath(objv[2]);
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+static int
+EncodingToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* TclEncoding structure. */
+ CONST char *src; /* Source string in specified encoding. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Current state. */
+ char *dst; /* Output buffer. */
+ int dstLen; /* The maximum length of output buffer. */
+ int *srcReadPtr; /* Filled with number of bytes read. */
+ int *dstWrotePtr; /* Filled with number of bytes stored. */
+ int *dstCharsPtr; /* Filled with number of chars stored. */
+{
+ int len;
+ TclEncoding *encodingPtr;
+
+ encodingPtr = (TclEncoding *) clientData;
+ Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd);
+
+ len = strlen(Tcl_GetStringResult(encodingPtr->interp));
+ if (len > dstLen) {
+ len = dstLen;
+ }
+ memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
+ Tcl_ResetResult(encodingPtr->interp);
+
+ *srcReadPtr = srcLen;
+ *dstWrotePtr = len;
+ *dstCharsPtr = len;
+ return TCL_OK;
+}
+static int
+EncodingFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* TclEncoding structure. */
+ CONST char *src; /* Source string in specified encoding. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Current state. */
+ char *dst; /* Output buffer. */
+ int dstLen; /* The maximum length of output buffer. */
+ int *srcReadPtr; /* Filled with number of bytes read. */
+ int *dstWrotePtr; /* Filled with number of bytes stored. */
+ int *dstCharsPtr; /* Filled with number of chars stored. */
+{
+ int len;
+ TclEncoding *encodingPtr;
+
+ encodingPtr = (TclEncoding *) clientData;
+ Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd);
+
+ len = strlen(Tcl_GetStringResult(encodingPtr->interp));
+ if (len > dstLen) {
+ len = dstLen;
+ }
+ memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
+ Tcl_ResetResult(encodingPtr->interp);
+
+ *srcReadPtr = srcLen;
+ *dstWrotePtr = len;
+ *dstCharsPtr = len;
+ return TCL_OK;
+}
+static void
+EncodingFreeProc(clientData)
+ ClientData clientData; /* ClientData associated with type. */
+{
+ TclEncoding *encodingPtr;
+
+ encodingPtr = (TclEncoding *) clientData;
+ ckfree((char *) encodingPtr->toUtfCmd);
+ ckfree((char *) encodingPtr->fromUtfCmd);
+ ckfree((char *) encodingPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestevalexObjCmd --
+ *
+ * This procedure implements the "testevalex" command. It is
+ * used to test Tcl_EvalEx.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestevalexObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Interp *iPtr = (Interp *) interp;
+ int code, oldFlags, length, flags;
+ char *string;
+
+ if (objc == 1) {
+ /*
+ * The command was invoked with no arguments, so just toggle
+ * the flag that determines whether we use Tcl_EvalEx.
+ */
+
+ if (iPtr->flags & USE_EVAL_DIRECT) {
+ iPtr->flags &= ~USE_EVAL_DIRECT;
+ Tcl_SetResult(interp, "disabling direct evaluation", TCL_STATIC);
+ } else {
+ iPtr->flags |= USE_EVAL_DIRECT;
+ Tcl_SetResult(interp, "enabling direct evaluation", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+
+ flags = 0;
+ if (objc == 3) {
+ string = Tcl_GetStringFromObj(objv[2], &length);
+ if (strcmp(string, "global") != 0) {
+ Tcl_AppendResult(interp, "bad value \"", string,
+ "\": must be global", (char *) NULL);
+ return TCL_ERROR;
+ }
+ flags = TCL_EVAL_GLOBAL;
+ } else if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "script ?global?");
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, "xxx", TCL_STATIC);
+
+ /*
+ * Note, we have to set the USE_EVAL_DIRECT flag in the interpreter
+ * in addition to calling Tcl_EvalEx. This is needed so that even nested
+ * commands are evaluated directly.
+ */
+
+ oldFlags = iPtr->flags;
+ iPtr->flags |= USE_EVAL_DIRECT;
+ string = Tcl_GetStringFromObj(objv[1], &length);
+ code = Tcl_EvalEx(interp, string, length, flags);
+ iPtr->flags = (iPtr->flags & ~USE_EVAL_DIRECT)
+ | (oldFlags & USE_EVAL_DIRECT);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestevalobjvObjCmd --
+ *
+ * This procedure implements the "testevalobjv" command. It is
+ * used to test Tcl_EvalObjv.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestevalobjvObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int evalGlobal;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "global word ?word ...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[1], &evalGlobal) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_EvalObjv(interp, objc-2, objv+2,
+ (evalGlobal) ? TCL_EVAL_GLOBAL : 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestexithandlerCmd --
*
* This procedure implements the "testexithandler" command. It is
@@ -1253,7 +1625,7 @@ static void
ExitProcOdd(clientData)
ClientData clientData; /* Integer value to print. */
{
- char buf[100];
+ char buf[16 + TCL_INTEGER_SPACE];
sprintf(buf, "odd %d\n", (int) clientData);
write(1, buf, strlen(buf));
@@ -1263,7 +1635,7 @@ static void
ExitProcEven(clientData)
ClientData clientData; /* Integer value to print. */
{
- char buf[100];
+ char buf[16 + TCL_INTEGER_SPACE];
sprintf(buf, "even %d\n", (int) clientData);
write(1, buf, strlen(buf));
@@ -1294,7 +1666,7 @@ TestexprlongCmd(clientData, interp, argc, argv)
char **argv; /* Argument strings. */
{
long exprResult;
- char buf[30];
+ char buf[4 + TCL_INTEGER_SPACE];
int result;
Tcl_SetResult(interp, "This is a result", TCL_STATIC);
@@ -1459,8 +1831,6 @@ TestinterpdeleteCmd(dummy, interp, argc, argv)
}
slaveToDelete = Tcl_GetSlave(interp, argv[1]);
if (slaveToDelete == (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "could not find interpreter \"",
- argv[1], "\"", (char *) NULL);
return TCL_ERROR;
}
Tcl_DeleteInterp(slaveToDelete);
@@ -1553,11 +1923,11 @@ TestlinkCmd(dummy, interp, argc, argv)
Tcl_UnlinkVar(interp, "string");
created = 0;
} else if (strcmp(argv[1], "get") == 0) {
- sprintf(buffer, "%d", intVar);
+ TclFormatInt(buffer, intVar);
Tcl_AppendElement(interp, buffer);
Tcl_PrintDouble((Tcl_Interp *) NULL, realVar, buffer);
Tcl_AppendElement(interp, buffer);
- sprintf(buffer, "%d", boolVar);
+ TclFormatInt(buffer, boolVar);
Tcl_AppendElement(interp, buffer);
Tcl_AppendElement(interp, (stringVar == NULL) ? "-" : stringVar);
} else if (strcmp(argv[1], "set") == 0) {
@@ -1642,6 +2012,68 @@ TestlinkCmd(dummy, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
+ * TestlocaleCmd --
+ *
+ * This procedure implements the "testlocale" command. It is used
+ * to test the effects of setting different locales in Tcl.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Modifies the current C locale.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestlocaleCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* The argument objects. */
+{
+ int index;
+ char *locale;
+
+ static char *optionStrings[] = {
+ "ctype", "numeric", "time", "collate", "monetary",
+ "all", NULL
+ };
+ static int lcTypes[] = {
+ LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
+ LC_ALL
+ };
+
+ /*
+ * LC_CTYPE, etc. correspond to the indices for the strings.
+ */
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ locale = Tcl_GetString(objv[2]);
+ } else {
+ locale = NULL;
+ }
+ locale = setlocale(lcTypes[index], locale);
+ if (locale) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestMathFunc --
*
* This is a user-defined math procedure to test out math procedures
@@ -1692,8 +2124,8 @@ TestMathFunc2(clientData, interp, args, resultPtr)
ClientData clientData; /* Integer value to return. */
Tcl_Interp *interp; /* Used to report errors. */
Tcl_Value *args; /* Points to an array of two
- * Tcl_Values for the two
- * arguments. */
+ * Tcl_Value structs for the
+ * two arguments. */
Tcl_Value *resultPtr; /* Where to store the result. */
{
int result = TCL_OK;
@@ -1772,6 +2204,640 @@ CleanupTestSetassocdataTests(clientData, interp)
/*
*----------------------------------------------------------------------
*
+ * TestparserObjCmd --
+ *
+ * This procedure implements the "testparser" command. It is
+ * used for testing the new Tcl script parser in Tcl 8.1.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestparserObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* The argument objects. */
+{
+ char *script;
+ int length, dummy;
+ Tcl_Parse parse;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "script length");
+ return TCL_ERROR;
+ }
+ script = Tcl_GetStringFromObj(objv[1], &dummy);
+ if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
+ return TCL_ERROR;
+ }
+ if (length == 0) {
+ length = dummy;
+ }
+ if (Tcl_ParseCommand(interp, script, length, 0, &parse) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (remainder of script: \"");
+ Tcl_AddErrorInfo(interp, parse.term);
+ Tcl_AddErrorInfo(interp, "\")");
+ return TCL_ERROR;
+ }
+
+ /*
+ * The parse completed successfully. Just print out the contents
+ * of the parse structure into the interpreter's result.
+ */
+
+ PrintParse(interp, &parse);
+ Tcl_FreeParse(&parse);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexprparserObjCmd --
+ *
+ * This procedure implements the "testexprparser" command. It is
+ * used for testing the new Tcl expression parser in Tcl 8.1.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestexprparserObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* The argument objects. */
+{
+ char *script;
+ int length, dummy;
+ Tcl_Parse parse;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "expr length");
+ return TCL_ERROR;
+ }
+ script = Tcl_GetStringFromObj(objv[1], &dummy);
+ if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
+ return TCL_ERROR;
+ }
+ if (length == 0) {
+ length = dummy;
+ }
+ if (Tcl_ParseExpr(interp, script, length, &parse) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (remainder of expr: \"");
+ Tcl_AddErrorInfo(interp, parse.term);
+ Tcl_AddErrorInfo(interp, "\")");
+ return TCL_ERROR;
+ }
+
+ /*
+ * The parse completed successfully. Just print out the contents
+ * of the parse structure into the interpreter's result.
+ */
+
+ PrintParse(interp, &parse);
+ Tcl_FreeParse(&parse);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintParse --
+ *
+ * This procedure prints out the contents of a Tcl_Parse structure
+ * in the result of an interpreter.
+ *
+ * Results:
+ * Interp's result is set to a prettily formatted version of the
+ * contents of parsePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintParse(interp, parsePtr)
+ Tcl_Interp *interp; /* Interpreter whose result is to be set to
+ * the contents of a parse structure. */
+ Tcl_Parse *parsePtr; /* Parse structure to print out. */
+{
+ Tcl_Obj *objPtr;
+ char *typeString;
+ Tcl_Token *tokenPtr;
+ int i;
+
+ objPtr = Tcl_GetObjResult(interp);
+ if (parsePtr->commentSize > 0) {
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewStringObj(parsePtr->commentStart,
+ parsePtr->commentSize));
+ } else {
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewStringObj("-", 1));
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewIntObj(parsePtr->numWords));
+ for (i = 0; i < parsePtr->numTokens; i++) {
+ tokenPtr = &parsePtr->tokenPtr[i];
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_WORD:
+ typeString = "word";
+ break;
+ case TCL_TOKEN_SIMPLE_WORD:
+ typeString = "simple";
+ break;
+ case TCL_TOKEN_TEXT:
+ typeString = "text";
+ break;
+ case TCL_TOKEN_BS:
+ typeString = "backslash";
+ break;
+ case TCL_TOKEN_COMMAND:
+ typeString = "command";
+ break;
+ case TCL_TOKEN_VARIABLE:
+ typeString = "variable";
+ break;
+ case TCL_TOKEN_SUB_EXPR:
+ typeString = "subexpr";
+ break;
+ case TCL_TOKEN_OPERATOR:
+ typeString = "operator";
+ break;
+ default:
+ typeString = "??";
+ break;
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewStringObj(typeString, -1));
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewIntObj(tokenPtr->numComponents));
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+ Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
+ -1));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestparsevarObjCmd --
+ *
+ * This procedure implements the "testparsevar" command. It is
+ * used for testing Tcl_ParseVar.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestparsevarObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* The argument objects. */
+{
+ char *name, *value, *termPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName");
+ return TCL_ERROR;
+ }
+ name = Tcl_GetString(objv[1]);
+ value = Tcl_ParseVar(interp, name, &termPtr);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendElement(interp, value);
+ Tcl_AppendElement(interp, termPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestparsevarnameObjCmd --
+ *
+ * This procedure implements the "testparsevarname" command. It is
+ * used for testing the new Tcl script parser in Tcl 8.1.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestparsevarnameObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* The argument objects. */
+{
+ char *script;
+ int append, length, dummy;
+ Tcl_Parse parse;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "script length append");
+ return TCL_ERROR;
+ }
+ script = Tcl_GetStringFromObj(objv[1], &dummy);
+ if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
+ return TCL_ERROR;
+ }
+ if (length == 0) {
+ length = dummy;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[3], &append)) {
+ return TCL_ERROR;
+ }
+ if (Tcl_ParseVarName(interp, script, length, &parse, append) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (remainder of script: \"");
+ Tcl_AddErrorInfo(interp, parse.term);
+ Tcl_AddErrorInfo(interp, "\")");
+ return TCL_ERROR;
+ }
+
+ /*
+ * The parse completed successfully. Just print out the contents
+ * of the parse structure into the interpreter's result.
+ */
+
+ parse.commentSize = 0;
+ parse.commandStart = script + parse.tokenPtr->size;
+ parse.commandSize = 0;
+ PrintParse(interp, &parse);
+ Tcl_FreeParse(&parse);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestregexpObjCmd --
+ *
+ * This procedure implements the "testregexp" command. It is
+ * used to give a direct interface for regexp flags. It's identical
+ * to Tcl_RegexpObjCmd except for the -xflags option, and the
+ * consequences thereof (including the REG_EXPECT kludge).
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TestregexpObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int i, ii, indices, stringLength, match, about;
+ int hasxflags, cflags, eflags;
+ Tcl_RegExp regExpr;
+ char *string;
+ Tcl_Obj *objPtr;
+ Tcl_RegExpInfo info;
+ static char *options[] = {
+ "-indices", "-nocase", "-about", "-expanded",
+ "-line", "-linestop", "-lineanchor",
+ "-xflags",
+ "--", (char *) NULL
+ };
+ enum options {
+ REGEXP_INDICES, REGEXP_NOCASE, REGEXP_ABOUT, REGEXP_EXPANDED,
+ REGEXP_MULTI, REGEXP_NOCROSS, REGEXP_NEWL,
+ REGEXP_XFLAGS,
+ REGEXP_LAST
+ };
+
+ indices = 0;
+ about = 0;
+ cflags = REG_ADVANCED;
+ eflags = 0;
+ hasxflags = 0;
+
+ for (i = 1; i < objc; i++) {
+ char *name;
+ int index;
+
+ name = Tcl_GetString(objv[i]);
+ if (name[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum options) index) {
+ case REGEXP_INDICES: {
+ indices = 1;
+ break;
+ }
+ case REGEXP_NOCASE: {
+ cflags |= REG_ICASE;
+ break;
+ }
+ case REGEXP_ABOUT: {
+ about = 1;
+ break;
+ }
+ case REGEXP_EXPANDED: {
+ cflags |= REG_EXPANDED;
+ break;
+ }
+ case REGEXP_MULTI: {
+ cflags |= REG_NEWLINE;
+ break;
+ }
+ case REGEXP_NOCROSS: {
+ cflags |= REG_NLSTOP;
+ break;
+ }
+ case REGEXP_NEWL: {
+ cflags |= REG_NLANCH;
+ break;
+ }
+ case REGEXP_XFLAGS: {
+ hasxflags = 1;
+ break;
+ }
+ case REGEXP_LAST: {
+ i++;
+ goto endOfForLoop;
+ }
+ }
+ }
+
+ endOfForLoop:
+ if (objc - i < hasxflags + 2 - about) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
+ return TCL_ERROR;
+ }
+ objc -= i;
+ objv += i;
+
+ if (hasxflags) {
+ string = Tcl_GetStringFromObj(objv[0], &stringLength);
+ TestregexpXflags(string, stringLength, &cflags, &eflags);
+ objc--;
+ objv++;
+ }
+
+ regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
+ if (regExpr == NULL) {
+ return TCL_ERROR;
+ }
+ objPtr = objv[1];
+
+ if (about) {
+ if (TclRegAbout(interp, regExpr) < 0) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ match = Tcl_RegExpExecObj(interp, regExpr, objPtr, 0 /* offset */,
+ objc-2 /* nmatches */, eflags);
+
+ if (match < 0) {
+ return TCL_ERROR;
+ }
+ if (match == 0) {
+ /*
+ * Set the interpreter's object result to an integer object w/
+ * value 0.
+ */
+
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+ if (objc > 2 && (cflags&REG_EXPECT) && indices) {
+ char *varName, *value;
+ int start, end;
+ char info[TCL_INTEGER_SPACE * 2];
+
+ varName = Tcl_GetString(objv[2]);
+ TclRegExpRangeUniChar(regExpr, -1, &start, &end);
+ sprintf(info, "%d %d", start, end-1);
+ value = Tcl_SetVar(interp, varName, info, 0);
+ if (value == NULL) {
+ Tcl_AppendResult(interp, "couldn't set variable \"",
+ varName, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * If additional variable names have been specified, return
+ * index information in those variables.
+ */
+
+ objc -= 2;
+ objv += 2;
+
+ Tcl_RegExpGetInfo(regExpr, &info);
+ for (i = 0; i < objc; i++) {
+ int start, end;
+ Tcl_Obj *newPtr, *varPtr, *valuePtr;
+
+ varPtr = objv[i];
+ ii = ((cflags&REG_EXPECT) && i == objc-1) ? -1 : i;
+ if (indices) {
+ Tcl_Obj *objs[2];
+
+ if (ii == -1) {
+ TclRegExpRangeUniChar(regExpr, ii, &start, &end);
+ } else if (ii > info.nsubs) {
+ start = -1;
+ end = -1;
+ } else {
+ start = info.matches[ii].start;
+ end = info.matches[ii].end;
+ }
+
+ /*
+ * Adjust index so it refers to the last character in the
+ * match instead of the first character after the match.
+ */
+
+ if (end >= 0) {
+ end--;
+ }
+
+ objs[0] = Tcl_NewLongObj(start);
+ objs[1] = Tcl_NewLongObj(end);
+
+ newPtr = Tcl_NewListObj(2, objs);
+ } else {
+ if (ii == -1) {
+ TclRegExpRangeUniChar(regExpr, ii, &start, &end);
+ newPtr = Tcl_GetRange(objPtr, start, end);
+ } else if (ii > info.nsubs) {
+ newPtr = Tcl_NewObj();
+ } else {
+ newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
+ info.matches[ii].end - 1);
+ }
+ }
+ valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
+ if (valuePtr == NULL) {
+ Tcl_DecrRefCount(newPtr);
+ Tcl_AppendResult(interp, "couldn't set variable \"",
+ Tcl_GetString(varPtr), "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Set the interpreter's object result to an integer object w/ value 1.
+ */
+
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TestregexpXflags --
+ *
+ * Parse a string of extended regexp flag letters, for testing.
+ *
+ * Results:
+ * No return value (you're on your own for errors here).
+ *
+ * Side effects:
+ * Modifies *cflagsPtr, a regcomp flags word, and *eflagsPtr, a
+ * regexec flags word, as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
+ char *string; /* The string of flags. */
+ int length; /* The length of the string in bytes. */
+ int *cflagsPtr; /* compile flags word */
+ int *eflagsPtr; /* exec flags word */
+{
+ int i;
+ int cflags;
+ int eflags;
+
+ cflags = *cflagsPtr;
+ eflags = *eflagsPtr;
+ for (i = 0; i < length; i++) {
+ switch (string[i]) {
+ case 'a': {
+ cflags |= REG_ADVF;
+ break;
+ }
+ case 'b': {
+ cflags &= ~REG_ADVANCED;
+ break;
+ }
+ case 'e': {
+ cflags &= ~REG_ADVANCED;
+ cflags |= REG_EXTENDED;
+ break;
+ }
+ case 'q': {
+ cflags &= ~REG_ADVANCED;
+ cflags |= REG_QUOTE;
+ break;
+ }
+ case 'o': { /* o for opaque */
+ cflags |= REG_NOSUB;
+ break;
+ }
+ case 's': { /* s for start */
+ cflags |= REG_BOSONLY;
+ break;
+ }
+ case '+': {
+ cflags |= REG_FAKE;
+ break;
+ }
+ case ',': {
+ cflags |= REG_PROGRESS;
+ break;
+ }
+ case '.': {
+ cflags |= REG_DUMP;
+ break;
+ }
+ case ':': {
+ eflags |= REG_MTRACE;
+ break;
+ }
+ case ';': {
+ eflags |= REG_FTRACE;
+ break;
+ }
+ case '^': {
+ eflags |= REG_NOTBOL;
+ break;
+ }
+ case '$': {
+ eflags |= REG_NOTEOL;
+ break;
+ }
+ case 't': {
+ cflags |= REG_EXPECT;
+ break;
+ }
+ case '%': {
+ eflags |= REG_SMALL;
+ break;
+ }
+ }
+ }
+
+ *cflagsPtr = cflags;
+ *eflagsPtr = eflags;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestsetassocdataCmd --
*
* This procedure implements the "testsetassocdata" command. It is used
@@ -2066,46 +3132,6 @@ TestupvarCmd(dummy, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * TestwordendCmd --
- *
- * This procedure implements the "testwordend" command. It is used
- * to test TclWordEnd.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-TestwordendObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* The argument objects. */
-{
- Tcl_Obj *objPtr;
- char *string, *end;
- int length;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "string");
- return TCL_ERROR;
- }
- objPtr = Tcl_GetObjResult(interp);
- string = Tcl_GetStringFromObj(objv[1], &length);
- end = TclWordEnd(string, string+length, 0, NULL);
- Tcl_AppendToObj(objPtr, end, length - (end - string));
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TestsetobjerrorcodeCmd --
*
* This procedure implements the "testsetobjerrorcodeCmd".
@@ -2185,7 +3211,7 @@ TestfeventCmd(clientData, interp, argc, argv)
}
if (interp2 != (Tcl_Interp *) NULL) {
code = Tcl_GlobalEval(interp2, argv[2]);
- interp->result = interp2->result;
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
return code;
} else {
Tcl_AppendResult(interp,
@@ -2220,7 +3246,7 @@ TestfeventCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * TestPanicCmd --
+ * TestpanicCmd --
*
* Calls the panic routine.
*
@@ -2234,7 +3260,7 @@ TestfeventCmd(clientData, interp, argc, argv)
*/
static int
-TestPanicCmd(dummy, interp, argc, argv)
+TestpanicCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
@@ -2416,9 +3442,9 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- name = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+ name = Tcl_GetString(objv[1]);
- arg = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ arg = Tcl_GetString(objv[2]);
if (strcmp(arg, "global") == 0) {
flags = TCL_GLOBAL_ONLY;
} else if (strcmp(arg, "namespace") == 0) {
@@ -2491,7 +3517,7 @@ GetTimesCmd(unused, interp, argc, argv)
Tcl_Obj *objPtr;
Tcl_Obj **objv;
char *s;
- char newString[30];
+ char newString[TCL_INTEGER_SPACE];
/* alloc & free 100000 times */
fprintf(stderr, "alloc & free 100000 6 word items\n");
@@ -2547,12 +3573,12 @@ GetTimesCmd(unused, interp, argc, argv)
fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
ckfree((char *) objv);
- /* TclGetStringFromObj 100000 times */
+ /* TclGetString 100000 times */
fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
objPtr = Tcl_NewStringObj("12345", -1);
TclpGetTime(&start);
for (i = 0; i < 100000; i++) {
- (void) TclGetStringFromObj(objPtr, &n);
+ (void) TclGetString(objPtr);
}
TclpGetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
@@ -2697,51 +3723,46 @@ NoopObjCmd(unused, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TestsetnoerrCmd --
+ * TestsetCmd --
*
- * Implements the "testsetnoerr" cmd that is used when testing
- * the Tcl_Set/GetVar C Api without TCL_LEAVE_ERR_MSG flag
+ * Implements the "testset{err,noerr}" cmds that are used when testing
+ * Tcl_Set/GetVar C Api with/without TCL_LEAVE_ERR_MSG flag
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * None.
+ * Variables may be set.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static int
-TestsetnoerrCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
+TestsetCmd(data, interp, argc, argv)
+ ClientData data; /* Additional flags for Get/SetVar2. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
+ int flags = (int) data;
char *value;
+
if (argc == 2) {
- Tcl_SetResult(interp, "before get", TCL_STATIC);
- value = Tcl_GetVar2(interp, argv[1], (char *) NULL, TCL_PARSE_PART1);
- if (value == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetResult(interp, value, TCL_VOLATILE);
- return TCL_OK;
+ Tcl_SetResult(interp, "before get", TCL_STATIC);
+ value = Tcl_GetVar2(interp, argv[1], (char *) NULL, flags);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, value);
+ return TCL_OK;
} else if (argc == 3) {
- char *m1 = "before set";
- char *message=Tcl_Alloc(strlen(m1)+1);
-
- strcpy(message,m1);
-
- Tcl_SetResult(interp, message, TCL_DYNAMIC);
-
- value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2],
- TCL_PARSE_PART1);
- if (value == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetResult(interp, value, TCL_VOLATILE);
+ Tcl_SetResult(interp, "before set", TCL_STATIC);
+ value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2], flags);
+ if (value == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, value);
return TCL_OK;
} else {
Tcl_AppendResult(interp, "wrong # args: should be \"",
@@ -2753,6 +3774,138 @@ TestsetnoerrCmd(dummy, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
+ * TestsaveresultCmd --
+ *
+ * Implements the "testsaveresult" cmd that is used when testing
+ * the Tcl_SaveResult, Tcl_RestoreResult, and
+ * Tcl_DiscardResult interfaces.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestsaveresultCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ register Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* The argument objects. */
+{
+ int discard, result, index;
+ Tcl_SavedResult state;
+ Tcl_Obj *objPtr;
+ static char *optionStrings[] = {
+ "append", "dynamic", "free", "object", "small", NULL
+ };
+ enum options {
+ RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL
+ };
+
+ /*
+ * Parse arguments
+ */
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type script discard");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ objPtr = NULL; /* Lint. */
+ switch ((enum options) index) {
+ case RESULT_SMALL:
+ Tcl_SetResult(interp, "small result", TCL_VOLATILE);
+ break;
+ case RESULT_APPEND:
+ Tcl_AppendResult(interp, "append result", NULL);
+ break;
+ case RESULT_FREE: {
+ char *buf = ckalloc(200);
+ strcpy(buf, "free result");
+ Tcl_SetResult(interp, buf, TCL_DYNAMIC);
+ break;
+ }
+ case RESULT_DYNAMIC:
+ Tcl_SetResult(interp, "dynamic result", TestsaveresultFree);
+ break;
+ case RESULT_OBJECT:
+ objPtr = Tcl_NewStringObj("object result", -1);
+ Tcl_SetObjResult(interp, objPtr);
+ break;
+ }
+
+ freeCount = 0;
+ Tcl_SaveResult(interp, &state);
+
+ if (((enum options) index) == RESULT_OBJECT) {
+ result = Tcl_EvalObjEx(interp, objv[2], 0);
+ } else {
+ result = Tcl_Eval(interp, Tcl_GetString(objv[2]));
+ }
+
+ if (discard) {
+ Tcl_DiscardResult(&state);
+ } else {
+ Tcl_RestoreResult(interp, &state);
+ result = TCL_OK;
+ }
+
+ switch ((enum options) index) {
+ case RESULT_DYNAMIC: {
+ int present = interp->freeProc == TestsaveresultFree;
+ int called = freeCount;
+ Tcl_AppendElement(interp, called ? "called" : "notCalled");
+ Tcl_AppendElement(interp, present ? "present" : "missing");
+ break;
+ }
+ case RESULT_OBJECT:
+ Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
+ ? "same" : "different");
+ break;
+ default:
+ break;
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsaveresultFree --
+ *
+ * Special purpose freeProc used by TestsaveresultCmd.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Increments the freeCount.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TestsaveresultFree(blockPtr)
+ char *blockPtr;
+{
+ freeCount++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TeststatprocCmd --
*
* Implements the "testTclStatProc" cmd that is used to test the
@@ -2832,7 +3985,7 @@ TeststatprocCmd (dummy, interp, argc, argv)
static int
TestStatProc1(path, buf)
CONST char *path;
- TclStat_ *buf;
+ struct stat *buf;
{
buf->st_size = 1234;
return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
@@ -2842,7 +3995,7 @@ TestStatProc1(path, buf)
static int
TestStatProc2(path, buf)
CONST char *path;
- TclStat_ *buf;
+ struct stat *buf;
{
buf->st_size = 2345;
return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
@@ -2852,7 +4005,7 @@ TestStatProc2(path, buf)
static int
TestStatProc3(path, buf)
CONST char *path;
- TclStat_ *buf;
+ struct stat *buf;
{
buf->st_size = 3456;
return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
@@ -3094,3 +4247,580 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
return (NULL);
}
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestChannelCmd --
+ *
+ * Implements the Tcl "testchannel" debugging command and its
+ * subcommands. This is part of the testing environment.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TestChannelCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Interpreter for result. */
+ int argc; /* Count of additional args. */
+ char **argv; /* Additional arg strings. */
+{
+ char *cmdName; /* Sub command. */
+ Tcl_HashTable *hTblPtr; /* Hash table of channels. */
+ Tcl_HashSearch hSearch; /* Search variable. */
+ Tcl_HashEntry *hPtr; /* Search variable. */
+ Channel *chanPtr; /* The actual channel. */
+ ChannelState *statePtr; /* state info for channel */
+ Tcl_Channel chan; /* The opaque type. */
+ size_t len; /* Length of subcommand string. */
+ int IOQueued; /* How much IO is queued inside channel? */
+ ChannelBuffer *bufPtr; /* For iterating over queued IO. */
+ char buf[TCL_INTEGER_SPACE];/* For sprintf. */
+ int mode; /* rw mode of the channel */
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " subcommand ?additional args..?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ cmdName = argv[1];
+ len = strlen(cmdName);
+
+ chanPtr = (Channel *) NULL;
+
+ if (argc > 2) {
+ chan = Tcl_GetChannel(interp, argv[2], &mode);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+ chanPtr = (Channel *) chan;
+ statePtr = chanPtr->state;
+ chanPtr = statePtr->topChanPtr;
+ chan = (Tcl_Channel) chanPtr;
+ } else {
+ /* lint */
+ statePtr = NULL;
+ chan = NULL;
+ }
+
+ if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " info channelName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, argv[2]);
+ Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, "read");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, "write");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ Tcl_AppendElement(interp, "nonblocking");
+ } else {
+ Tcl_AppendElement(interp, "blocking");
+ }
+ if (statePtr->flags & CHANNEL_LINEBUFFERED) {
+ Tcl_AppendElement(interp, "line");
+ } else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+ Tcl_AppendElement(interp, "none");
+ } else {
+ Tcl_AppendElement(interp, "full");
+ }
+ if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ Tcl_AppendElement(interp, "async_flush");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_EOF) {
+ Tcl_AppendElement(interp, "eof");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & CHANNEL_BLOCKED) {
+ Tcl_AppendElement(interp, "blocked");
+ } else {
+ Tcl_AppendElement(interp, "unblocked");
+ }
+ if (statePtr->inputTranslation == TCL_TRANSLATE_AUTO) {
+ Tcl_AppendElement(interp, "auto");
+ if (statePtr->flags & INPUT_SAW_CR) {
+ Tcl_AppendElement(interp, "saw_cr");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_LF) {
+ Tcl_AppendElement(interp, "lf");
+ Tcl_AppendElement(interp, "");
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+ Tcl_AppendElement(interp, "cr");
+ Tcl_AppendElement(interp, "");
+ } else if (statePtr->inputTranslation == TCL_TRANSLATE_CRLF) {
+ Tcl_AppendElement(interp, "crlf");
+ if (statePtr->flags & INPUT_SAW_CR) {
+ Tcl_AppendElement(interp, "queued_cr");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ }
+ if (statePtr->outputTranslation == TCL_TRANSLATE_AUTO) {
+ Tcl_AppendElement(interp, "auto");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_LF) {
+ Tcl_AppendElement(interp, "lf");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CR) {
+ Tcl_AppendElement(interp, "cr");
+ } else if (statePtr->outputTranslation == TCL_TRANSLATE_CRLF) {
+ Tcl_AppendElement(interp, "crlf");
+ }
+ for (IOQueued = 0, bufPtr = statePtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
+ }
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendElement(interp, buf);
+
+ IOQueued = 0;
+ if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
+ IOQueued = statePtr->curOutPtr->nextAdded -
+ statePtr->curOutPtr->nextRemoved;
+ }
+ for (bufPtr = statePtr->outQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendElement(interp, buf);
+
+ TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
+ Tcl_AppendElement(interp, buf);
+
+ TclFormatInt(buf, statePtr->refCount);
+ Tcl_AppendElement(interp, buf);
+
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'i') &&
+ (strncmp(cmdName, "inputbuffered", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (IOQueued = 0, bufPtr = statePtr->inQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
+ }
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, "read");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, "write");
+ } else {
+ Tcl_AppendElement(interp, "");
+ }
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, statePtr->channelName, (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == (Tcl_HashTable *) NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != (Tcl_HashEntry *) NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'o') &&
+ (strncmp(cmdName, "outputbuffered", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ IOQueued = 0;
+ if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
+ IOQueued = statePtr->curOutPtr->nextAdded -
+ statePtr->curOutPtr->nextRemoved;
+ }
+ for (bufPtr = statePtr->outQueueHead;
+ bufPtr != (ChannelBuffer *) NULL;
+ bufPtr = bufPtr->nextPtr) {
+ IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
+ }
+ TclFormatInt(buf, IOQueued);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'q') &&
+ (strncmp(cmdName, "queuedcr", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendResult(interp,
+ (statePtr->flags & INPUT_SAW_CR) ? "1" : "0",
+ (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == (Tcl_HashTable *) NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != (Tcl_HashEntry *) NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ statePtr = chanPtr->state;
+ if (statePtr->flags & TCL_READABLE) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ }
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ TclFormatInt(buf, statePtr->refCount);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, chanPtr->typePtr->typeName,
+ (char *) NULL);
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
+ hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+ if (hTblPtr == (Tcl_HashTable *) NULL) {
+ return TCL_OK;
+ }
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != (Tcl_HashEntry *) NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
+ statePtr = chanPtr->state;
+ if (statePtr->flags & TCL_WRITABLE) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
+ }
+ }
+ return TCL_OK;
+ }
+
+ if ((cmdName[0] == 't') && (strncmp(cmdName, "transform", len) == 0)) {
+ /*
+ * Syntax: transform channel -command command
+ */
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " transform channelId -command cmd\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[3], "-command") != 0) {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": should be \"-command\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TclChannelTransform(interp, chan,
+ Tcl_NewStringObj(argv[4], -1));
+ }
+
+ if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
+ /*
+ * Syntax: unstack channel
+ */
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " unstack channel\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tcl_UnstackChannel(interp, chan);
+ }
+
+ Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
+ "info, open, readable, writable, transform, unstack",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestChannelEventCmd --
+ *
+ * This procedure implements the "testchannelevent" command. It is
+ * used to test the Tcl channel event mechanism.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Creates, deletes and returns channel event handlers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TestChannelEventCmd(dummy, interp, argc, argv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tcl_Obj *resultListPtr;
+ Channel *chanPtr;
+ ChannelState *statePtr; /* state info for channel */
+ EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
+ char *cmd;
+ int index, i, mask, len;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
+ if (chanPtr == (Channel *) NULL) {
+ return TCL_ERROR;
+ }
+ statePtr = chanPtr->state;
+
+ cmd = argv[2];
+ len = strlen(cmd);
+ if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName add eventSpec script\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[3], "readable") == 0) {
+ mask = TCL_READABLE;
+ } else if (strcmp(argv[3], "writable") == 0) {
+ mask = TCL_WRITABLE;
+ } else if (strcmp(argv[3], "none") == 0) {
+ mask = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad event name \"", argv[3],
+ "\": must be readable, writable, or none", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ esPtr = (EventScriptRecord *) ckalloc((unsigned)
+ sizeof(EventScriptRecord));
+ esPtr->nextPtr = statePtr->scriptRecordPtr;
+ statePtr->scriptRecordPtr = esPtr;
+
+ esPtr->chanPtr = chanPtr;
+ esPtr->interp = interp;
+ esPtr->mask = mask;
+ esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
+ Tcl_IncrRefCount(esPtr->scriptPtr);
+
+ Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+
+ return TCL_OK;
+ }
+
+ if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName delete index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (index < 0) {
+ Tcl_AppendResult(interp, "bad event index: ", argv[3],
+ ": must be nonnegative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (i = 0, esPtr = statePtr->scriptRecordPtr;
+ (i < index) && (esPtr != (EventScriptRecord *) NULL);
+ i++, esPtr = esPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (esPtr == (EventScriptRecord *) NULL) {
+ Tcl_AppendResult(interp, "bad event index ", argv[3],
+ ": out of range", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (esPtr == statePtr->scriptRecordPtr) {
+ statePtr->scriptRecordPtr = esPtr->nextPtr;
+ } else {
+ for (prevEsPtr = statePtr->scriptRecordPtr;
+ (prevEsPtr != (EventScriptRecord *) NULL) &&
+ (prevEsPtr->nextPtr != esPtr);
+ prevEsPtr = prevEsPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (prevEsPtr == (EventScriptRecord *) NULL) {
+ panic("TestChannelEventCmd: damaged event script list");
+ }
+ prevEsPtr->nextPtr = esPtr->nextPtr;
+ }
+ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+ Tcl_DecrRefCount(esPtr->scriptPtr);
+ ckfree((char *) esPtr);
+
+ return TCL_OK;
+ }
+
+ if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName list\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ resultListPtr = Tcl_GetObjResult(interp);
+ for (esPtr = statePtr->scriptRecordPtr;
+ esPtr != (EventScriptRecord *) NULL;
+ esPtr = esPtr->nextPtr) {
+ if (esPtr->mask) {
+ Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+ (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
+ } else {
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ Tcl_NewStringObj("none", -1));
+ }
+ Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
+ }
+ Tcl_SetObjResult(interp, resultListPtr);
+ return TCL_OK;
+ }
+
+ if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName removeall\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (esPtr = statePtr->scriptRecordPtr;
+ esPtr != (EventScriptRecord *) NULL;
+ esPtr = nextEsPtr) {
+ nextEsPtr = esPtr->nextPtr;
+ Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+ Tcl_DecrRefCount(esPtr->scriptPtr);
+ ckfree((char *) esPtr);
+ }
+ statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
+ return TCL_OK;
+ }
+
+ if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName delete index event\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (index < 0) {
+ Tcl_AppendResult(interp, "bad event index: ", argv[3],
+ ": must be nonnegative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (i = 0, esPtr = statePtr->scriptRecordPtr;
+ (i < index) && (esPtr != (EventScriptRecord *) NULL);
+ i++, esPtr = esPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ if (esPtr == (EventScriptRecord *) NULL) {
+ Tcl_AppendResult(interp, "bad event index ", argv[3],
+ ": out of range", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[4], "readable") == 0) {
+ mask = TCL_READABLE;
+ } else if (strcmp(argv[4], "writable") == 0) {
+ mask = TCL_WRITABLE;
+ } else if (strcmp(argv[4], "none") == 0) {
+ mask = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad event name \"", argv[4],
+ "\": must be readable, writable, or none", (char *) NULL);
+ return TCL_ERROR;
+ }
+ esPtr->mask = mask;
+ Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
+ TclChannelEventScriptInvoker, (ClientData) esPtr);
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
+ "add, delete, list, set, or removeall", (char *) NULL);
+ return TCL_ERROR;
+}
+
diff --git a/tcl/generic/tclTestObj.c b/tcl/generic/tclTestObj.c
index e8730e035d5..3f583ff9af3 100644
--- a/tcl/generic/tclTestObj.c
+++ b/tcl/generic/tclTestObj.c
@@ -6,7 +6,8 @@
* types. These commands are not normally included in Tcl
* applications; they're only used for testing.
*
- * Copyright (c) 1995, 1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -57,6 +58,14 @@ static int TestobjCmd _ANSI_ARGS_((ClientData dummy,
static int TeststringobjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+
+typedef struct TestString {
+ int numChars;
+ size_t allocated;
+ size_t uallocated;
+ Tcl_UniChar unicode[2];
+} TestString;
+
/*
*----------------------------------------------------------------------
@@ -68,7 +77,7 @@ static int TeststringobjCmd _ANSI_ARGS_((ClientData dummy,
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Creates and registers several new testing commands.
@@ -128,7 +137,7 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int varIndex, boolValue, length;
+ int varIndex, boolValue;
char *index, *subCmd;
if (objc < 3) {
@@ -137,16 +146,12 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- subCmd = Tcl_GetStringFromObj(objv[1], &length);
+ subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
goto wrongNumArgs;
@@ -196,7 +201,7 @@ TestbooleanobjCmd(clientData, interp, objc, objv)
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+ "bad option \"", Tcl_GetString(objv[1]),
"\": must be set, get, or not", (char *) NULL);
return TCL_ERROR;
}
@@ -227,7 +232,6 @@ TestconvertobjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int length;
char *subCmd;
char buf[20];
@@ -237,11 +241,7 @@ TestconvertobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- subCmd = Tcl_GetStringFromObj(objv[1], &length);
+ subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "double") == 0) {
double d;
@@ -255,7 +255,7 @@ TestconvertobjCmd(clientData, interp, objc, objv)
Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+ "bad option \"", Tcl_GetString(objv[1]),
"\": must be double", (char *) NULL);
return TCL_ERROR;
}
@@ -288,7 +288,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int varIndex, length;
+ int varIndex;
double doubleValue;
char *index, *subCmd, *string;
@@ -298,21 +298,17 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- subCmd = Tcl_GetStringFromObj(objv[1], &length);
+ subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
- string = Tcl_GetStringFromObj(objv[3], &length);
+ string = Tcl_GetString(objv[3]);
if (Tcl_GetDouble(interp, string, &doubleValue) != TCL_OK) {
return TCL_ERROR;
}
@@ -375,7 +371,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv)
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
+ "bad option \"", Tcl_GetString(objv[1]),
"\": must be set, get, mult10, or div10", (char *) NULL);
return TCL_ERROR;
}
@@ -407,11 +403,11 @@ TestindexobjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int allowAbbrev, index, index2, setError, i, dummy, result;
+ int allowAbbrev, index, index2, setError, i, result;
char **argv;
static char *tablePtr[] = {"a", "b", "check", (char *) NULL};
- if ((objc == 3) && (strcmp(Tcl_GetStringFromObj(objv[1], &dummy),
+ if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
"check") == 0)) {
/*
* This code checks to be sure that the results of
@@ -444,13 +440,27 @@ TestindexobjCmd(clientData, interp, objc, objv)
if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
return TCL_ERROR;
}
+
argv = (char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
for (i = 4; i < objc; i++) {
- argv[i-4] = Tcl_GetStringFromObj(objv[i], &dummy);
+ argv[i-4] = Tcl_GetString(objv[i]);
}
argv[objc-4] = NULL;
- result = Tcl_GetIndexFromObj(setError ? interp : NULL, objv[3],
- argv, "token", allowAbbrev ? 0 : TCL_EXACT, &index);
+
+ /*
+ * Tcl_GetIndexFromObj assumes that the table is statically-allocated
+ * so that its address is different for each index object. If we
+ * accidently allocate a table at the same address as that cached in
+ * the index object, clear out the object's cached state.
+ */
+
+ if ((objv[3]->typePtr == Tcl_GetObjType("index"))
+ && (objv[3]->internalRep.twoPtrValue.ptr1 == (VOID *) argv)) {
+ objv[3]->typePtr = NULL;
+ }
+
+ result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
+ argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
ckfree((char *) argv);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
@@ -483,7 +493,7 @@ TestintobjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int intValue, varIndex, length, i;
+ int intValue, varIndex, i;
long longValue;
char *index, *subCmd, *string;
@@ -493,21 +503,17 @@ TestintobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
- subCmd = Tcl_GetStringFromObj(objv[1], &length);
+ subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
- string = Tcl_GetStringFromObj(objv[3], &length);
+ string = Tcl_GetString(objv[3]);
if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
return TCL_ERROR;
}
@@ -531,7 +537,7 @@ TestintobjCmd(clientData, interp, objc, objv)
if (objc != 4) {
goto wrongNumArgs;
}
- string = Tcl_GetStringFromObj(objv[3], &length);
+ string = Tcl_GetString(objv[3]);
if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
return TCL_ERROR;
}
@@ -545,7 +551,7 @@ TestintobjCmd(clientData, interp, objc, objv)
if (objc != 4) {
goto wrongNumArgs;
}
- string = Tcl_GetStringFromObj(objv[3], &length);
+ string = Tcl_GetString(objv[3]);
if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
return TCL_ERROR;
}
@@ -586,6 +592,15 @@ TestintobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
+ } else if (strcmp(subCmd, "get2") == 0) {
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ if (CheckIfVarUnset(interp, varIndex)) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(varPtr[varIndex]);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
} else if (strcmp(subCmd, "inttoobigtest") == 0) {
/*
* If long ints have more bits than ints on this platform, verify
@@ -594,26 +609,24 @@ TestintobjCmd(clientData, interp, objc, objv)
* to fit in an int.
*/
- long maxLong = LONG_MAX;
-
if (objc != 3) {
goto wrongNumArgs;
}
- if (INT_MAX == LONG_MAX) { /* int is same size as long int */
- Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
+#if (INT_MAX == LONG_MAX) /* int is same size as long int */
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
+#else
+ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
+ Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
} else {
- if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetLongObj(varPtr[varIndex], maxLong);
- } else {
- SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
- }
- if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
- return TCL_OK;
- }
- Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
+ SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
+ }
+ if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
+ return TCL_OK;
}
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
+#endif
} else if (strcmp(subCmd, "mult10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
@@ -650,8 +663,9 @@ TestintobjCmd(clientData, interp, objc, objv)
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
- "\": must be set, get, mult10, or div10", (char *) NULL);
+ "bad option \"", Tcl_GetString(objv[1]),
+ "\": must be set, get, get2, mult10, or div10",
+ (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -684,8 +698,6 @@ TestobjCmd(clientData, interp, objc, objv)
int varIndex, destIndex, i;
char *index, *subCmd, *string;
Tcl_ObjType *targetType;
- char buf[20];
- int length;
if (objc < 2) {
wrongNumArgs:
@@ -693,23 +705,19 @@ TestobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- subCmd = Tcl_GetStringFromObj(objv[1], &length);
+ subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "assign") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
- string = Tcl_GetStringFromObj(objv[3], &length);
+ string = Tcl_GetString(objv[3]);
if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -720,14 +728,14 @@ TestobjCmd(clientData, interp, objc, objv)
if (objc != 4) {
goto wrongNumArgs;
}
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
- typeName = Tcl_GetStringFromObj(objv[3], &length);
+ typeName = Tcl_GetString(objv[3]);
if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"no type ", typeName, " found", (char *) NULL);
@@ -742,14 +750,14 @@ TestobjCmd(clientData, interp, objc, objv)
if (objc != 4) {
goto wrongNumArgs;
}
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
- string = Tcl_GetStringFromObj(objv[3], &length);
+ string = Tcl_GetString(objv[3]);
if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -769,30 +777,49 @@ TestobjCmd(clientData, interp, objc, objv)
if (objc != 3) {
goto wrongNumArgs;
}
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
SetVarToObj(varIndex, Tcl_NewObj());
Tcl_SetObjResult(interp, varPtr[varIndex]);
+ } else if (strcmp(subCmd, "objtype") == 0) {
+ char *typeName;
+
+ /*
+ * return an object containing the name of the argument's type
+ * of internal rep. If none exists, return "none".
+ */
+
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ if (objv[2]->typePtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
+ } else {
+ typeName = objv[2]->typePtr->name;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
+ }
} else if (strcmp(subCmd, "refcount") == 0) {
+ char buf[TCL_INTEGER_SPACE];
+
if (objc != 3) {
goto wrongNumArgs;
}
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
- sprintf(buf, "%d", varPtr[varIndex]->refCount);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+ TclFormatInt(buf, varPtr[varIndex]->refCount);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (strcmp(subCmd, "type") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
- index = Tcl_GetStringFromObj(objv[2], &length);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -809,15 +836,16 @@ TestobjCmd(clientData, interp, objc, objv)
if (objc != 2) {
goto wrongNumArgs;
}
- if (Tcl_AppendAllObjTypes(interp, Tcl_GetObjResult(interp)) != TCL_OK) {
+ if (Tcl_AppendAllObjTypes(interp,
+ Tcl_GetObjResult(interp)) != TCL_OK) {
return TCL_ERROR;
}
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"",
- Tcl_GetStringFromObj(objv[1], (int *) NULL),
+ Tcl_GetString(objv[1]),
"\": must be assign, convert, duplicate, freeallvars, ",
- "newobj, objcount, refcount, type, or types",
+ "newobj, objcount, objtype, refcount, type, or types",
(char *) NULL);
return TCL_ERROR;
}
@@ -850,11 +878,12 @@ TeststringobjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int varIndex, option, i, length;
-#define MAX_STRINGS 12
+#define MAX_STRINGS 11
char *index, *string, *strings[MAX_STRINGS+1];
+ TestString *strPtr;
static char *options[] = {
- "append", "appendstrings", "get", "length", "length2",
- "set", "set2", "setlength", (char *) NULL
+ "append", "appendstrings", "get", "get2", "length", "length2",
+ "set", "set2", "setlength", "ualloc", (char *) NULL
};
if (objc < 3) {
@@ -863,7 +892,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- index = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
@@ -892,7 +921,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
if (Tcl_IsShared(varPtr[varIndex])) {
SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
- string = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+ string = Tcl_GetString(objv[3]);
Tcl_AppendToObj(varPtr[varIndex], string, length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
@@ -913,17 +942,11 @@ TeststringobjCmd(clientData, interp, objc, objv)
SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
for (i = 3; i < objc; i++) {
- strings[i-3] = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ strings[i-3] = Tcl_GetString(objv[i]);
}
-#if PURIFY
- for (int cou = objc - 3; cou < MAX_STRINGS; cou++)
- {
- strings[cou] = NULL;
+ for ( ; i < 12 + 3; i++) {
+ strings[i - 3] = NULL;
}
-#else
- strings[objc-3] = NULL;
-#endif /* PURIFY */
-
Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
strings[2], strings[3], strings[4], strings[5],
strings[6], strings[7], strings[8], strings[9],
@@ -939,21 +962,37 @@ TeststringobjCmd(clientData, interp, objc, objv)
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
- case 3: /* length */
+ case 3: /* get2 */
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ if (CheckIfVarUnset(interp, varIndex)) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetString(varPtr[varIndex]);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
+ break;
+ case 4: /* length */
if (objc != 3) {
goto wrongNumArgs;
}
Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
? varPtr[varIndex]->length : -1);
break;
- case 4: /* length2 */
+ case 5: /* length2 */
if (objc != 3) {
goto wrongNumArgs;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
- ? (int) varPtr[varIndex]->internalRep.longValue : -1);
+ if (varPtr[varIndex] != NULL) {
+ strPtr = (TestString *)
+ (varPtr[varIndex])->internalRep.otherValuePtr;
+ length = (int) strPtr->allocated;
+ } else {
+ length = -1;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
break;
- case 5: /* set */
+ case 6: /* set */
if (objc != 4) {
goto wrongNumArgs;
}
@@ -976,13 +1015,13 @@ TeststringobjCmd(clientData, interp, objc, objv)
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
- case 6: /* set2 */
+ case 7: /* set2 */
if (objc != 4) {
goto wrongNumArgs;
}
SetVarToObj(varIndex, objv[3]);
break;
- case 7: /* setlength */
+ case 8: /* setlength */
if (objc != 4) {
goto wrongNumArgs;
}
@@ -993,6 +1032,19 @@ TeststringobjCmd(clientData, interp, objc, objv)
Tcl_SetObjLength(varPtr[varIndex], length);
}
break;
+ case 9: /* ualloc */
+ if (objc != 3) {
+ goto wrongNumArgs;
+ }
+ if (varPtr[varIndex] != NULL) {
+ strPtr = (TestString *)
+ (varPtr[varIndex])->internalRep.otherValuePtr;
+ length = (int) strPtr->uallocated;
+ } else {
+ length = -1;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
+ break;
}
return TCL_OK;
@@ -1094,7 +1146,7 @@ CheckIfVarUnset(interp, varIndex)
int varIndex; /* Index of the test variable to check. */
{
if (varPtr[varIndex] == NULL) {
- char buf[100];
+ char buf[32 + TCL_INTEGER_SPACE];
sprintf(buf, "variable %d is unset (NULL)", varIndex);
Tcl_ResetResult(interp);
diff --git a/tcl/generic/tclThread.c b/tcl/generic/tclThread.c
new file mode 100644
index 00000000000..f7c3a39b786
--- /dev/null
+++ b/tcl/generic/tclThread.c
@@ -0,0 +1,580 @@
+/*
+ * tclThread.c --
+ *
+ * This file implements Platform independent thread operations.
+ * Most of the real work is done in the platform dependent files.
+ *
+ * Copyright (c) 1998 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * There are three classes of synchronization objects:
+ * mutexes, thread data keys, and condition variables.
+ * The following are used to record the memory used for these
+ * objects so they can be finalized.
+ *
+ * These statics are guarded by the mutex in the caller of
+ * TclRememberThreadData, e.g., TclpThreadDataKeyInit
+ */
+
+typedef struct {
+ int num; /* Number of objects remembered */
+ int max; /* Max size of the array */
+ char **list; /* List of pointers */
+} SyncObjRecord;
+
+static SyncObjRecord keyRecord;
+static SyncObjRecord mutexRecord;
+static SyncObjRecord condRecord;
+
+/*
+ * Prototypes of functions used only in this file
+ */
+
+static void RememberSyncObject _ANSI_ARGS_((char *objPtr,
+ SyncObjRecord *recPtr));
+static void ForgetSyncObject _ANSI_ARGS_((char *objPtr,
+ SyncObjRecord *recPtr));
+
+/*
+ * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
+ * specified. Here we undo that so the procedures are defined in the
+ * stubs table.
+ */
+#ifndef TCL_THREADS
+#undef Tcl_MutexLock
+#undef Tcl_MutexUnlock
+#undef Tcl_MutexFinalize
+#undef Tcl_ConditionNotify
+#undef Tcl_ConditionWait
+#undef Tcl_ConditionFinalize
+#endif
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetThreadData --
+ *
+ * This procedure allocates and initializes a chunk of thread
+ * local storage.
+ *
+ * Results:
+ * A thread-specific pointer to the data structure.
+ *
+ * Side effects:
+ * Will allocate memory the first time this thread calls for
+ * this chunk of storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID *
+Tcl_GetThreadData(keyPtr, size)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk */
+ int size; /* Size of storage block */
+{
+ VOID *result;
+#ifdef TCL_THREADS
+
+ /*
+ * See if this is the first thread to init this key.
+ */
+
+ if (*keyPtr == NULL) {
+ TclpThreadDataKeyInit(keyPtr);
+ }
+
+ /*
+ * Initialize the key for this thread.
+ */
+
+ result = TclpThreadDataKeyGet(keyPtr);
+ if (result == NULL) {
+ result = (VOID *)ckalloc((size_t)size);
+ memset(result, 0, (size_t)size);
+ TclpThreadDataKeySet(keyPtr, result);
+ }
+#else
+ if (*keyPtr == NULL) {
+ result = (VOID *)ckalloc((size_t)size);
+ memset((char *)result, 0, (size_t)size);
+ *keyPtr = (Tcl_ThreadDataKey)result;
+ TclRememberDataKey(keyPtr);
+ }
+ result = *(VOID **)keyPtr;
+#endif
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclThreadDataKeyGet --
+ *
+ * This procedure returns a pointer to a block of thread local storage.
+ *
+ * Results:
+ * A thread-specific pointer to the data structure, or NULL
+ * if the memory has not been assigned to this key for this thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID *
+TclThreadDataKeyGet(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+{
+#ifdef TCL_THREADS
+ return (VOID *)TclpThreadDataKeyGet(keyPtr);
+#else
+ char *result = *(char **)keyPtr;
+ return (VOID *)result;
+#endif /* TCL_THREADS */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclThreadDataKeySet --
+ *
+ * This procedure sets a thread local storage pointer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The assigned value will be returned by TclpThreadDataKeyGet.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclThreadDataKeySet(keyPtr, data)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+ VOID *data; /* Thread local storage */
+{
+#ifdef TCL_THREADS
+ if (*keyPtr == NULL) {
+ TclpThreadDataKeyInit(keyPtr);
+ }
+ TclpThreadDataKeySet(keyPtr, data);
+#else
+ *keyPtr = (Tcl_ThreadDataKey)data;
+#endif /* TCL_THREADS */
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RememberSyncObject
+ *
+ * Keep a list of (mutexes/condition variable/data key)
+ * used during finalization.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Add to the appropriate list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RememberSyncObject(objPtr, recPtr)
+ char *objPtr; /* Pointer to sync object */
+ SyncObjRecord *recPtr; /* Record of sync objects */
+{
+ char **newList;
+ int i, j;
+
+ /*
+ * Save the pointer to the allocated object so it can be finalized.
+ * Grow the list of pointers if necessary, copying only non-NULL
+ * pointers to the new list.
+ */
+
+ if (recPtr->num >= recPtr->max) {
+ recPtr->max += 8;
+ newList = (char **)ckalloc(recPtr->max * sizeof(char *));
+ for (i=0,j=0 ; i<recPtr->num ; i++) {
+ if (recPtr->list[i] != NULL) {
+ newList[j++] = recPtr->list[i];
+ }
+ }
+ if (recPtr->list != NULL) {
+ ckfree((char *)recPtr->list);
+ }
+ recPtr->list = newList;
+ recPtr->num = j;
+ }
+ recPtr->list[recPtr->num] = objPtr;
+ recPtr->num++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ForgetSyncObject
+ *
+ * Remove a single object from the list.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Remove from the appropriate list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ForgetSyncObject(objPtr, recPtr)
+ char *objPtr; /* Pointer to sync object */
+ SyncObjRecord *recPtr; /* Record of sync objects */
+{
+ int i;
+
+ for (i=0 ; i<recPtr->num ; i++) {
+ if (objPtr == recPtr->list[i]) {
+ recPtr->list[i] = NULL;
+ return;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRememberMutex
+ *
+ * Keep a list of mutexes used during finalization.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Add to the mutex list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclRememberMutex(mutexPtr)
+ Tcl_Mutex *mutexPtr;
+{
+ RememberSyncObject((char *)mutexPtr, &mutexRecord);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexFinalize
+ *
+ * Finalize a single mutex and remove it from the
+ * list of remembered objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Remove the mutex from the list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexFinalize(mutexPtr)
+ Tcl_Mutex *mutexPtr;
+{
+#ifdef TCL_THREADS
+ TclpFinalizeMutex(mutexPtr);
+#endif
+ ForgetSyncObject((char *)mutexPtr, &mutexRecord);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRememberDataKey
+ *
+ * Keep a list of thread data keys used during finalization.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Add to the key list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclRememberDataKey(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ RememberSyncObject((char *)keyPtr, &keyRecord);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRememberCondition
+ *
+ * Keep a list of condition variables used during finalization.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Add to the condition variable list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclRememberCondition(condPtr)
+ Tcl_Condition *condPtr;
+{
+ RememberSyncObject((char *)condPtr, &condRecord);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionFinalize
+ *
+ * Finalize a single condition variable and remove it from the
+ * list of remembered objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Remove the condition variable from the list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionFinalize(condPtr)
+ Tcl_Condition *condPtr;
+{
+#ifdef TCL_THREADS
+ TclpFinalizeCondition(condPtr);
+#endif
+ ForgetSyncObject((char *)condPtr, &condRecord);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadData --
+ *
+ * This procedure cleans up the thread-local storage. This is
+ * called once for each thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up all thread local storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadData()
+{
+ int i;
+ Tcl_ThreadDataKey *keyPtr;
+
+ TclpMasterLock();
+ for (i=0 ; i<keyRecord.num ; i++) {
+ keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
+#ifdef TCL_THREADS
+ TclpFinalizeThreadData(keyPtr);
+#else
+ if (*keyPtr != NULL) {
+ ckfree((char *)*keyPtr);
+ *keyPtr = NULL;
+ }
+#endif
+ }
+#ifdef TCL_THREADS
+ TclpMasterUnlock();
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeSynchronization --
+ *
+ * This procedure cleans up all synchronization objects:
+ * mutexes, condition variables, and thread-local storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up the memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeSynchronization()
+{
+#ifdef TCL_THREADS
+ Tcl_ThreadDataKey *keyPtr;
+ Tcl_Mutex *mutexPtr;
+ Tcl_Condition *condPtr;
+ int i;
+
+ TclpMasterLock();
+ for (i=0 ; i<keyRecord.num ; i++) {
+ keyPtr = (Tcl_ThreadDataKey *)keyRecord.list[i];
+ TclpFinalizeThreadDataKey(keyPtr);
+ }
+ if (keyRecord.list != NULL) {
+ ckfree((char *)keyRecord.list);
+ keyRecord.list = NULL;
+ }
+ keyRecord.max = 0;
+ keyRecord.num = 0;
+
+ for (i=0 ; i<mutexRecord.num ; i++) {
+ mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
+ if (mutexPtr != NULL) {
+ TclpFinalizeMutex(mutexPtr);
+ }
+ }
+ if (mutexRecord.list != NULL) {
+ ckfree((char *)mutexRecord.list);
+ mutexRecord.list = NULL;
+ }
+ mutexRecord.max = 0;
+ mutexRecord.num = 0;
+
+ for (i=0 ; i<condRecord.num ; i++) {
+ condPtr = (Tcl_Condition *)condRecord.list[i];
+ if (condPtr != NULL) {
+ TclpFinalizeCondition(condPtr);
+ }
+ }
+ if (condRecord.list != NULL) {
+ ckfree((char *)condRecord.list);
+ condRecord.list = NULL;
+ }
+ condRecord.max = 0;
+ condRecord.num = 0;
+
+ TclpMasterUnlock();
+#else
+ if (keyRecord.list != NULL) {
+ ckfree((char *)keyRecord.list);
+ keyRecord.list = NULL;
+ }
+ keyRecord.max = 0;
+ keyRecord.num = 0;
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ExitThread --
+ *
+ * This procedure is called to terminate the current thread.
+ * This should be used by extensions that create threads with
+ * additional interpreters in them.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All thread exit handlers are invoked, then the thread dies.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ExitThread(status)
+ int status;
+{
+ Tcl_FinalizeThread();
+#ifdef TCL_THREADS
+ TclpThreadExit(status);
+#endif
+}
+
+#ifndef TCL_THREADS
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionWait, et al. --
+ *
+ * These noop procedures are provided so the stub table does
+ * not have to be conditionalized for threads. The real
+ * implementations of these functions live in the platform
+ * specific files.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_ConditionWait
+void
+Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+ Tcl_Condition *condPtr; /* Really (pthread_cond_t **) */
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+ Tcl_Time *timePtr; /* Timeout on waiting period */
+{
+}
+
+#undef Tcl_ConditionNotify
+void
+Tcl_ConditionNotify(condPtr)
+ Tcl_Condition *condPtr;
+{
+}
+
+#undef Tcl_MutexLock
+void
+Tcl_MutexLock(mutexPtr)
+ Tcl_Mutex *mutexPtr;
+{
+}
+
+#undef Tcl_MutexUnlock
+void
+Tcl_MutexUnlock(mutexPtr)
+ Tcl_Mutex *mutexPtr;
+{
+}
+#endif
+
diff --git a/tcl/generic/tclThreadTest.c b/tcl/generic/tclThreadTest.c
new file mode 100644
index 00000000000..25a3938a009
--- /dev/null
+++ b/tcl/generic/tclThreadTest.c
@@ -0,0 +1,967 @@
+/*
+ * tclThreadTest.c --
+ *
+ * This file implements the testthread command. Eventually this
+ * should be tclThreadCmd.c
+ * Some of this code is based on work done by Richard Hipp on behalf of
+ * Conservation Through Innovation, Limited, with their permission.
+ *
+ * Copyright (c) 1998 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+#ifdef TCL_THREADS
+/*
+ * Each thread has an single instance of the following structure. There
+ * is one instance of this structure per thread even if that thread contains
+ * multiple interpreters. The interpreter identified by this structure is
+ * the main interpreter for the thread.
+ *
+ * The main interpreter is the one that will process any messages
+ * received by a thread. Any thread can send messages but only the
+ * main interpreter can receive them.
+ */
+
+typedef struct ThreadSpecificData {
+ Tcl_ThreadId threadId; /* Tcl ID for this thread */
+ Tcl_Interp *interp; /* Main interpreter for this thread */
+ int flags; /* See the TP_ defines below... */
+ struct ThreadSpecificData *nextPtr; /* List for "thread names" */
+ struct ThreadSpecificData *prevPtr; /* List for "thread names" */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * This list is used to list all threads that have interpreters.
+ * This is protected by threadMutex.
+ */
+
+static struct ThreadSpecificData *threadList;
+
+/*
+ * The following bit-values are legal for the "flags" field of the
+ * ThreadSpecificData structure.
+ */
+#define TP_Dying 0x001 /* This thread is being cancelled */
+
+/*
+ * An instance of the following structure contains all information that is
+ * passed into a new thread when the thread is created using either the
+ * "thread create" Tcl command or the TclCreateThread() C function.
+ */
+
+typedef struct ThreadCtrl {
+ char *script; /* The TCL command this thread should execute */
+ int flags; /* Initial value of the "flags" field in the
+ * ThreadSpecificData structure for the new thread.
+ * Might contain TP_Detached or TP_TclThread. */
+ Tcl_Condition condWait;
+ /* This condition variable is used to synchronize
+ * the parent and child threads. The child won't run
+ * until it acquires threadMutex, and the parent function
+ * won't complete until signaled on this condition
+ * variable. */
+} ThreadCtrl;
+
+/*
+ * This is the event used to send scripts to other threads.
+ */
+
+typedef struct ThreadEvent {
+ Tcl_Event event; /* Must be first */
+ char *script; /* The script to execute. */
+ struct ThreadEventResult *resultPtr;
+ /* To communicate the result. This is
+ * NULL if we don't care about it. */
+} ThreadEvent;
+
+typedef struct ThreadEventResult {
+ Tcl_Condition done; /* Signaled when the script completes */
+ int code; /* Return value of Tcl_Eval */
+ char *result; /* Result from the script */
+ char *errorInfo; /* Copy of errorInfo variable */
+ char *errorCode; /* Copy of errorCode variable */
+ Tcl_ThreadId srcThreadId; /* Id of sending thread, in case it dies */
+ Tcl_ThreadId dstThreadId; /* Id of target thread, in case it dies */
+ struct ThreadEvent *eventPtr; /* Back pointer */
+ struct ThreadEventResult *nextPtr; /* List for cleanup */
+ struct ThreadEventResult *prevPtr;
+
+} ThreadEventResult;
+
+static ThreadEventResult *resultList;
+
+/*
+ * This is for simple error handling when a thread script exits badly.
+ */
+
+static Tcl_ThreadId errorThreadId;
+static char *errorProcString;
+
+/*
+ * Access to the list of threads and to the thread send results is
+ * guarded by this mutex.
+ */
+
+TCL_DECLARE_MUTEX(threadMutex)
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+EXTERN int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *script));
+EXTERN int TclThreadList _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id,
+ char *script, int wait));
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+Tcl_ThreadCreateType NewThread _ANSI_ARGS_((ClientData clientData));
+static void ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
+static void ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
+static int ThreadEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int mask));
+static void ThreadErrorProc _ANSI_ARGS_((Tcl_Interp *interp));
+static void ThreadFreeProc _ANSI_ARGS_((ClientData clientData));
+static int ThreadDeleteEvent _ANSI_ARGS_((Tcl_Event *eventPtr,
+ ClientData clientData));
+static void ThreadExitProc _ANSI_ARGS_((ClientData clientData));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclThread_Init --
+ *
+ * Initialize the test thread command.
+ *
+ * Results:
+ * TCL_OK if the package was properly initialized.
+ *
+ * Side effects:
+ * Add the "testthread" command to the interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclThread_Init(interp)
+ Tcl_Interp *interp; /* The current Tcl interpreter */
+{
+
+ Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd,
+ (ClientData)NULL ,NULL);
+ if (Tcl_PkgProvide(interp, "Thread", "1.0" ) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ThreadObjCmd --
+ *
+ * This procedure is invoked to process the "testthread" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * thread create
+ * thread send id ?-async? script
+ * thread exit
+ * thread info id
+ * thread names
+ * thread wait
+ * thread errorproc proc
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_ThreadObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ int option;
+ static char *threadOptions[] = {"create", "exit", "id", "names",
+ "send", "wait", "errorproc", (char *) NULL};
+ enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_NAMES,
+ THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC};
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure the initial thread is on the list before doing anything.
+ */
+
+ if (tsdPtr->interp == NULL) {
+ Tcl_MutexLock(&threadMutex);
+ tsdPtr->interp = interp;
+ ListUpdateInner(tsdPtr);
+ Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
+ Tcl_MutexUnlock(&threadMutex);
+ }
+
+ switch ((enum options)option) {
+ case THREAD_CREATE: {
+ char *script;
+ if (objc == 2) {
+ script = "testthread wait"; /* Just enter the event loop */
+ } else if (objc == 3) {
+ script = Tcl_GetString(objv[2]);
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?script?");
+ return TCL_ERROR;
+ }
+ return TclCreateThread(interp, script);
+ }
+ case THREAD_EXIT: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+ ListRemove(NULL);
+ Tcl_ExitThread(0);
+ return TCL_OK;
+ }
+ case THREAD_ID:
+ if (objc == 2) {
+ Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
+ Tcl_SetObjResult(interp, idObj);
+ return TCL_OK;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ case THREAD_NAMES: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ return TclThreadList(interp);
+ }
+ case THREAD_SEND: {
+ long id;
+ char *script;
+ int wait, arg;
+
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script");
+ return TCL_ERROR;
+ }
+ if (objc == 5) {
+ if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
+ Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script");
+ return TCL_ERROR;
+ }
+ wait = 0;
+ arg = 3;
+ } else {
+ wait = 1;
+ arg = 2;
+ }
+ if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ arg++;
+ script = Tcl_GetString(objv[arg]);
+ return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait);
+ }
+ case THREAD_WAIT: {
+ while (1) {
+ (void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
+ }
+ }
+ case THREAD_ERRORPROC: {
+ /*
+ * Arrange for this proc to handle thread death errors.
+ */
+
+ char *proc;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "errorproc proc");
+ return TCL_ERROR;
+ }
+ Tcl_MutexLock(&threadMutex);
+ errorThreadId = Tcl_GetCurrentThread();
+ if (errorProcString) {
+ ckfree(errorProcString);
+ }
+ proc = Tcl_GetString(objv[2]);
+ errorProcString = ckalloc(strlen(proc)+1);
+ strcpy(errorProcString, proc);
+ Tcl_MutexUnlock(&threadMutex);
+ return TCL_OK;
+ }
+ }
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCreateThread --
+ *
+ * This procedure is invoked to create a thread containing an interp to
+ * run a script. This returns after the thread has started executing.
+ *
+ * Results:
+ * A standard Tcl result, which is the thread ID.
+ *
+ * Side effects:
+ * Create a thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TclCreateThread(interp, script)
+ Tcl_Interp *interp; /* Current interpreter. */
+ CONST char *script; /* Script to execute */
+{
+ ThreadCtrl ctrl;
+ Tcl_ThreadId id;
+
+ ctrl.script = (char *) script;
+ ctrl.condWait = NULL;
+ ctrl.flags = 0;
+
+ Tcl_MutexLock(&threadMutex);
+ if (Tcl_CreateThread(&id, NewThread, (ClientData) &ctrl,
+ TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) {
+ Tcl_MutexUnlock(&threadMutex);
+ Tcl_AppendResult(interp,"can't create a new thread",0);
+ ckfree((void*)ctrl.script);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Wait for the thread to start because it is using something on our stack!
+ */
+
+ Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
+ Tcl_MutexUnlock(&threadMutex);
+ Tcl_ConditionFinalize(&ctrl.condWait);
+ Tcl_SetObjResult(interp, Tcl_NewLongObj((long)id));
+ return TCL_OK;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * NewThread --
+ *
+ * This routine is the "main()" for a new thread whose task is to
+ * execute a single TCL script. The argument to this function is
+ * a pointer to a structure that contains the text of the TCL script
+ * to be executed.
+ *
+ * Space to hold the script field of the ThreadControl structure passed
+ * in as the only argument was obtained from malloc() and must be freed
+ * by this function before it exits. Space to hold the ThreadControl
+ * structure itself is released by the calling function, and the
+ * two condition variables in the ThreadControl structure are destroyed
+ * by the calling function. The calling function will destroy the
+ * ThreadControl structure and the condition variable as soon as
+ * ctrlPtr->condWait is signaled, so this routine must make copies of
+ * any data it might need after that point.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * A TCL script is executed in a new thread.
+ *
+ *------------------------------------------------------------------------
+ */
+Tcl_ThreadCreateType
+NewThread(clientData)
+ ClientData clientData;
+{
+ ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ int result;
+ char *threadEvalScript;
+
+ /*
+ * Initialize the interpreter. This should be more general.
+ */
+
+ tsdPtr->interp = Tcl_CreateInterp();
+ result = Tcl_Init(tsdPtr->interp);
+ result = TclThread_Init(tsdPtr->interp);
+
+ /*
+ * Update the list of threads.
+ */
+
+ Tcl_MutexLock(&threadMutex);
+ ListUpdateInner(tsdPtr);
+ /*
+ * We need to keep a pointer to the alloc'ed mem of the script
+ * we are eval'ing, for the case that we exit during evaluation
+ */
+ threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1);
+ strcpy(threadEvalScript, ctrlPtr->script);
+
+ Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
+
+ /*
+ * Notify the parent we are alive.
+ */
+
+ Tcl_ConditionNotify(&ctrlPtr->condWait);
+ Tcl_MutexUnlock(&threadMutex);
+
+ /*
+ * Run the script.
+ */
+
+ Tcl_Preserve((ClientData) tsdPtr->interp);
+ result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
+ if (result != TCL_OK) {
+ ThreadErrorProc(tsdPtr->interp);
+ }
+
+ /*
+ * Clean up.
+ */
+
+ ListRemove(tsdPtr);
+ Tcl_Release((ClientData) tsdPtr->interp);
+ Tcl_DeleteInterp(tsdPtr->interp);
+ Tcl_ExitThread(result);
+
+ TCL_THREAD_CREATE_RETURN;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadErrorProc --
+ *
+ * Send a message to the thread willing to hear about errors.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * Send an event.
+ *
+ *------------------------------------------------------------------------
+ */
+static void
+ThreadErrorProc(interp)
+ Tcl_Interp *interp; /* Interp that failed */
+{
+ Tcl_Channel errChannel;
+ char *errorInfo, *script;
+ char *argv[3];
+ char buf[TCL_DOUBLE_SPACE+1];
+ sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());
+
+ errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
+ if (errorProcString == NULL) {
+ errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ Tcl_WriteChars(errChannel, "Error from thread ", -1);
+ Tcl_WriteChars(errChannel, buf, -1);
+ Tcl_WriteChars(errChannel, "\n", 1);
+ Tcl_WriteChars(errChannel, errorInfo, -1);
+ Tcl_WriteChars(errChannel, "\n", 1);
+ } else {
+ argv[0] = errorProcString;
+ argv[1] = buf;
+ argv[2] = errorInfo;
+ script = Tcl_Merge(3, argv);
+ TclThreadSend(interp, errorThreadId, script, 0);
+ ckfree(script);
+ }
+}
+
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ListUpdateInner --
+ *
+ * Add the thread local storage to the list. This assumes
+ * the caller has obtained the mutex.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * Add the thread local storage to its list.
+ *
+ *------------------------------------------------------------------------
+ */
+static void
+ListUpdateInner(tsdPtr)
+ ThreadSpecificData *tsdPtr;
+{
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ }
+ tsdPtr->threadId = Tcl_GetCurrentThread();
+ tsdPtr->nextPtr = threadList;
+ if (threadList) {
+ threadList->prevPtr = tsdPtr;
+ }
+ tsdPtr->prevPtr = NULL;
+ threadList = tsdPtr;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ListRemove --
+ *
+ * Remove the thread local storage from its list. This grabs the
+ * mutex to protect the list.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * Remove the thread local storage from its list.
+ *
+ *------------------------------------------------------------------------
+ */
+static void
+ListRemove(tsdPtr)
+ ThreadSpecificData *tsdPtr;
+{
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ }
+ Tcl_MutexLock(&threadMutex);
+ if (tsdPtr->prevPtr) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ } else {
+ threadList = tsdPtr->nextPtr;
+ }
+ if (tsdPtr->nextPtr) {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
+ Tcl_MutexUnlock(&threadMutex);
+}
+
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * TclThreadList --
+ *
+ * Return a list of threads running Tcl interpreters.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *------------------------------------------------------------------------
+ */
+int
+TclThreadList(interp)
+ Tcl_Interp *interp;
+{
+ ThreadSpecificData *tsdPtr;
+ Tcl_Obj *listPtr;
+
+ listPtr = Tcl_NewListObj(0, NULL);
+ Tcl_MutexLock(&threadMutex);
+ for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewLongObj((long)tsdPtr->threadId));
+ }
+ Tcl_MutexUnlock(&threadMutex);
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * TclThreadSend --
+ *
+ * Send a script to another thread.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *------------------------------------------------------------------------
+ */
+int
+TclThreadSend(interp, id, script, wait)
+ Tcl_Interp *interp; /* The current interpreter. */
+ Tcl_ThreadId id; /* Thread Id of other interpreter. */
+ char *script; /* The script to evaluate. */
+ int wait; /* If 1, we block for the result. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadEvent *threadEventPtr;
+ ThreadEventResult *resultPtr;
+ int found, code;
+ Tcl_ThreadId threadId = (Tcl_ThreadId) id;
+
+ /*
+ * Verify the thread exists.
+ */
+
+ Tcl_MutexLock(&threadMutex);
+ found = 0;
+ for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
+ if (tsdPtr->threadId == threadId) {
+ found = 1;
+ break;
+ }
+ }
+ if (!found) {
+ Tcl_MutexUnlock(&threadMutex);
+ Tcl_AppendResult(interp, "invalid thread id", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Short circut sends to ourself. Ought to do something with -async,
+ * like run in an idle handler.
+ */
+
+ if (threadId == Tcl_GetCurrentThread()) {
+ Tcl_MutexUnlock(&threadMutex);
+ return Tcl_GlobalEval(interp, script);
+ }
+
+ /*
+ * Create the event for its event queue.
+ */
+
+ threadEventPtr = (ThreadEvent *) ckalloc(sizeof(ThreadEvent));
+ threadEventPtr->script = ckalloc(strlen(script) + 1);
+ strcpy(threadEventPtr->script, script);
+ if (!wait) {
+ resultPtr = threadEventPtr->resultPtr = NULL;
+ } else {
+ resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
+ threadEventPtr->resultPtr = resultPtr;
+
+ /*
+ * Initialize the result fields.
+ */
+
+ resultPtr->done = NULL;
+ resultPtr->code = 0;
+ resultPtr->result = NULL;
+ resultPtr->errorInfo = NULL;
+ resultPtr->errorCode = NULL;
+
+ /*
+ * Maintain the cleanup list.
+ */
+
+ resultPtr->srcThreadId = Tcl_GetCurrentThread();
+ resultPtr->dstThreadId = threadId;
+ resultPtr->eventPtr = threadEventPtr;
+ resultPtr->nextPtr = resultList;
+ if (resultList) {
+ resultList->prevPtr = resultPtr;
+ }
+ resultPtr->prevPtr = NULL;
+ resultList = resultPtr;
+ }
+
+ /*
+ * Queue the event and poke the other thread's notifier.
+ */
+
+ threadEventPtr->event.proc = ThreadEventProc;
+ Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr,
+ TCL_QUEUE_TAIL);
+ Tcl_ThreadAlert(threadId);
+
+ if (!wait) {
+ Tcl_MutexUnlock(&threadMutex);
+ return TCL_OK;
+ }
+
+ /*
+ * Block on the results and then get them.
+ */
+
+ Tcl_ResetResult(interp);
+ while (resultPtr->result == NULL) {
+ Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
+ }
+
+ /*
+ * Unlink result from the result list.
+ */
+
+ if (resultPtr->prevPtr) {
+ resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
+ } else {
+ resultList = resultPtr->nextPtr;
+ }
+ if (resultPtr->nextPtr) {
+ resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
+ }
+ resultPtr->eventPtr = NULL;
+ resultPtr->nextPtr = NULL;
+ resultPtr->prevPtr = NULL;
+
+ Tcl_MutexUnlock(&threadMutex);
+
+ if (resultPtr->code != TCL_OK) {
+ if (resultPtr->errorCode) {
+ Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
+ ckfree(resultPtr->errorCode);
+ }
+ if (resultPtr->errorInfo) {
+ Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
+ ckfree(resultPtr->errorInfo);
+ }
+ }
+ Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
+ Tcl_ConditionFinalize(&resultPtr->done);
+ code = resultPtr->code;
+
+ ckfree((char *) resultPtr);
+
+ return code;
+}
+
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadEventProc --
+ *
+ * Handle the event in the target thread.
+ *
+ * Results:
+ * Returns 1 to indicate that the event was processed.
+ *
+ * Side effects:
+ * Fills out the ThreadEventResult struct.
+ *
+ *------------------------------------------------------------------------
+ */
+int
+ThreadEventProc(evPtr, mask)
+ Tcl_Event *evPtr; /* Really ThreadEvent */
+ int mask;
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr;
+ ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
+ Tcl_Interp *interp = tsdPtr->interp;
+ int code;
+ char *result, *errorCode, *errorInfo;
+
+ if (interp == NULL) {
+ code = TCL_ERROR;
+ result = "no target interp!";
+ errorCode = "THREAD";
+ errorInfo = "";
+ } else {
+ Tcl_Preserve((ClientData) interp);
+ Tcl_ResetResult(interp);
+ Tcl_CreateThreadExitHandler(ThreadFreeProc,
+ (ClientData) threadEventPtr->script);
+ code = Tcl_GlobalEval(interp, threadEventPtr->script);
+ Tcl_DeleteThreadExitHandler(ThreadFreeProc,
+ (ClientData) threadEventPtr->script);
+ result = Tcl_GetStringResult(interp);
+ if (code != TCL_OK) {
+ errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
+ errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
+ } else {
+ errorCode = errorInfo = NULL;
+ }
+ }
+ ckfree(threadEventPtr->script);
+ if (resultPtr) {
+ Tcl_MutexLock(&threadMutex);
+ resultPtr->code = code;
+ resultPtr->result = ckalloc(strlen(result) + 1);
+ strcpy(resultPtr->result, result);
+ if (errorCode != NULL) {
+ resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
+ strcpy(resultPtr->errorCode, errorCode);
+ }
+ if (errorInfo != NULL) {
+ resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
+ strcpy(resultPtr->errorInfo, errorInfo);
+ }
+ Tcl_ConditionNotify(&resultPtr->done);
+ Tcl_MutexUnlock(&threadMutex);
+ }
+ if (interp != NULL) {
+ Tcl_Release((ClientData) interp);
+ }
+ return 1;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadFreeProc --
+ *
+ * This is called from when we are exiting and memory needs
+ * to be freed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Clears up mem specified in ClientData
+ *
+ *------------------------------------------------------------------------
+ */
+ /* ARGSUSED */
+void
+ThreadFreeProc(clientData)
+ ClientData clientData;
+{
+ if (clientData) {
+ ckfree((char *) clientData);
+ }
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadDeleteEvent --
+ *
+ * This is called from the ThreadExitProc to delete memory related
+ * to events that we put on the queue.
+ *
+ * Results:
+ * 1 it was our event and we want it removed, 0 otherwise.
+ *
+ * Side effects:
+ * It cleans up our events in the event queue for this thread.
+ *
+ *------------------------------------------------------------------------
+ */
+ /* ARGSUSED */
+int
+ThreadDeleteEvent(eventPtr, clientData)
+ Tcl_Event *eventPtr; /* Really ThreadEvent */
+ ClientData clientData; /* dummy */
+{
+ if (eventPtr->proc == ThreadEventProc) {
+ ckfree((char *) ((ThreadEvent *) eventPtr)->script);
+ return 1;
+ }
+ /*
+ * If it was NULL, we were in the middle of servicing the event
+ * and it should be removed
+ */
+ return (eventPtr->proc == NULL);
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadExitProc --
+ *
+ * This is called when the thread exits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * It unblocks anyone that is waiting on a send to this thread.
+ * It cleans up any events in the event queue for this thread.
+ *
+ *------------------------------------------------------------------------
+ */
+ /* ARGSUSED */
+void
+ThreadExitProc(clientData)
+ ClientData clientData;
+{
+ char *threadEvalScript = (char *) clientData;
+ ThreadEventResult *resultPtr, *nextPtr;
+ Tcl_ThreadId self = Tcl_GetCurrentThread();
+
+ Tcl_MutexLock(&threadMutex);
+
+ if (threadEvalScript) {
+ ckfree((char *) threadEvalScript);
+ threadEvalScript = NULL;
+ }
+ Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL);
+
+ for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
+ nextPtr = resultPtr->nextPtr;
+ if (resultPtr->srcThreadId == self) {
+ /*
+ * We are going away. By freeing up the result we signal
+ * to the other thread we don't care about the result.
+ */
+ if (resultPtr->prevPtr) {
+ resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
+ } else {
+ resultList = resultPtr->nextPtr;
+ }
+ if (resultPtr->nextPtr) {
+ resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
+ }
+ resultPtr->nextPtr = resultPtr->prevPtr = 0;
+ resultPtr->eventPtr->resultPtr = NULL;
+ ckfree((char *)resultPtr);
+ } else if (resultPtr->dstThreadId == self) {
+ /*
+ * Dang. The target is going away. Unblock the caller.
+ * The result string must be dynamically allocated because
+ * the main thread is going to call free on it.
+ */
+
+ char *msg = "target thread died";
+ resultPtr->result = ckalloc(strlen(msg)+1);
+ strcpy(resultPtr->result, msg);
+ resultPtr->code = TCL_ERROR;
+ Tcl_ConditionNotify(&resultPtr->done);
+ }
+ }
+ Tcl_MutexUnlock(&threadMutex);
+}
+
+#endif /* TCL_THREADS */
+
diff --git a/tcl/generic/tclTimer.c b/tcl/generic/tclTimer.c
index 6e685a8f946..4c39fe23c2a 100644
--- a/tcl/generic/tclTimer.c
+++ b/tcl/generic/tclTimer.c
@@ -16,12 +16,6 @@
#include "tclPort.h"
/*
- * This flag indicates whether this module has been initialized.
- */
-
-static int initialized = 0;
-
-/*
* For each timer callback that's pending there is one record of the following
* type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
* together in a list sorted by time (earliest event first).
@@ -37,12 +31,6 @@ typedef struct TimerHandler {
* end of queue. */
} TimerHandler;
-static TimerHandler *firstTimerHandlerPtr = NULL;
- /* First event in queue. */
-static int lastTimerId; /* Timer identifier of most recently
- * created timer. */
-static int timerPending; /* 1 if a timer event is in the queue. */
-
/*
* The data structure below is used by the "after" command to remember
* the command to be executed later. All of the pending "after" commands
@@ -54,8 +42,7 @@ typedef struct AfterInfo {
/* Pointer to the "tclAfter" assocData for
* the interp in which command will be
* executed. */
- char *command; /* Command to execute. Malloc'ed, so must
- * be freed when structure is deallocated. */
+ Tcl_Obj *commandPtr; /* Command to execute. */
int id; /* Integer identifier for command; used to
* cancel it. */
Tcl_TimerToken token; /* Used to cancel the "after" command. NULL
@@ -96,16 +83,35 @@ typedef struct IdleHandler {
struct IdleHandler *nextPtr;/* Next in list of active handlers. */
} IdleHandler;
-static IdleHandler *idleList;
- /* First in list of all idle handlers. */
-static IdleHandler *lastIdlePtr;
- /* Last in list (or NULL for empty list). */
-static int idleGeneration; /* Used to fill in the "generation" fields
+/*
+ * The timer and idle queues are per-thread because they are associated
+ * with the notifier, which is also per-thread.
+ *
+ * All static variables used in this file are collected into a single
+ * instance of the following structure. For multi-threaded implementations,
+ * there is one instance of this structure for each thread.
+ *
+ * Notice that different structures with the same name appear in other
+ * files. The structure defined below is used in this file only.
+ */
+
+typedef struct ThreadSpecificData {
+ TimerHandler *firstTimerHandlerPtr; /* First event in queue. */
+ int lastTimerId; /* Timer identifier of most recently
+ * created timer. */
+ int timerPending; /* 1 if a timer event is in the queue. */
+ IdleHandler *idleList; /* First in list of all idle handlers. */
+ IdleHandler *lastIdlePtr; /* Last in list (or NULL for empty list). */
+ int idleGeneration; /* Used to fill in the "generation" fields
* of IdleHandler structures. Increments
* each time Tcl_DoOneEvent starts calling
* idle handlers, so that all old handlers
* can be called without calling any of the
* new ones created by old ones. */
+ int afterId; /* For unique identifiers of after events. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
/*
* Prototypes for procedures referenced only in this file:
@@ -116,8 +122,8 @@ static void AfterCleanupProc _ANSI_ARGS_((ClientData clientData,
static void AfterProc _ANSI_ARGS_((ClientData clientData));
static void FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
static AfterInfo * GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,
- char *string));
-static void InitTimer _ANSI_ARGS_((void));
+ Tcl_Obj *commandPtr));
+static ThreadSpecificData *InitTimer _ANSI_ARGS_((void));
static void TimerExitProc _ANSI_ARGS_((ClientData clientData));
static int TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
int flags));
@@ -134,7 +140,7 @@ static void TimerSetupProc _ANSI_ARGS_((ClientData clientData,
* This function initializes the timer module.
*
* Results:
- * None.
+ * A pointer to the thread specific data.
*
* Side effects:
* Registers the idle and timer event sources.
@@ -142,19 +148,18 @@ static void TimerSetupProc _ANSI_ARGS_((ClientData clientData,
*----------------------------------------------------------------------
*/
-static void
+static ThreadSpecificData *
InitTimer()
{
- initialized = 1;
- lastTimerId = 0;
- timerPending = 0;
- idleGeneration = 0;
- firstTimerHandlerPtr = NULL;
- lastIdlePtr = NULL;
- idleList = NULL;
-
- Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
- Tcl_CreateExitHandler(TimerExitProc, NULL);
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
+
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(TimerExitProc, NULL);
+ }
+ return tsdPtr;
}
/*
@@ -179,7 +184,6 @@ TimerExitProc(clientData)
ClientData clientData; /* Not used. */
{
Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
- initialized = 0;
}
/*
@@ -210,10 +214,9 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData)
{
register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
Tcl_Time time;
+ ThreadSpecificData *tsdPtr;
- if (!initialized) {
- InitTimer();
- }
+ tsdPtr = InitTimer();
timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
@@ -228,22 +231,22 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData)
timerHandlerPtr->time.usec -= 1000000;
timerHandlerPtr->time.sec += 1;
}
-
+
/*
* Fill in other fields for the event.
*/
timerHandlerPtr->proc = proc;
timerHandlerPtr->clientData = clientData;
- lastTimerId++;
- timerHandlerPtr->token = (Tcl_TimerToken) lastTimerId;
+ tsdPtr->lastTimerId++;
+ timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;
/*
* Add the event to the queue in the correct position
* (ordered by event firing time).
*/
- for (tPtr2 = firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
+ for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
if ((tPtr2->time.sec > timerHandlerPtr->time.sec)
|| ((tPtr2->time.sec == timerHandlerPtr->time.sec)
@@ -253,12 +256,13 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData)
}
timerHandlerPtr->nextPtr = tPtr2;
if (prevPtr == NULL) {
- firstTimerHandlerPtr = timerHandlerPtr;
+ tsdPtr->firstTimerHandlerPtr = timerHandlerPtr;
} else {
prevPtr->nextPtr = timerHandlerPtr;
}
TimerSetupProc(NULL, TCL_ALL_EVENTS);
+
return timerHandlerPtr->token;
}
@@ -287,15 +291,17 @@ Tcl_DeleteTimerHandler(token)
* Tcl_DeleteTimerHandler. */
{
register TimerHandler *timerHandlerPtr, *prevPtr;
+ ThreadSpecificData *tsdPtr;
- for (timerHandlerPtr = firstTimerHandlerPtr, prevPtr = NULL;
+ tsdPtr = InitTimer();
+ for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
timerHandlerPtr = timerHandlerPtr->nextPtr) {
if (timerHandlerPtr->token != token) {
continue;
}
if (prevPtr == NULL) {
- firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
+ tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
} else {
prevPtr->nextPtr = timerHandlerPtr->nextPtr;
}
@@ -328,9 +334,10 @@ TimerSetupProc(data, flags)
int flags; /* Event flags as passed to Tcl_DoOneEvent. */
{
Tcl_Time blockTime;
+ ThreadSpecificData *tsdPtr = InitTimer();
- if (((flags & TCL_IDLE_EVENTS) && idleList)
- || ((flags & TCL_TIMER_EVENTS) && timerPending)) {
+ if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
+ || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
/*
* There is an idle handler or a pending timer event, so just poll.
*/
@@ -338,14 +345,15 @@ TimerSetupProc(data, flags)
blockTime.sec = 0;
blockTime.usec = 0;
- } else if ((flags & TCL_TIMER_EVENTS) && firstTimerHandlerPtr) {
+ } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
/*
* Compute the timeout for the next timer on the list.
*/
TclpGetTime(&blockTime);
- blockTime.sec = firstTimerHandlerPtr->time.sec - blockTime.sec;
- blockTime.usec = firstTimerHandlerPtr->time.usec - blockTime.usec;
+ blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
+ blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
+ blockTime.usec;
if (blockTime.usec < 0) {
blockTime.sec -= 1;
blockTime.usec += 1000000;
@@ -386,15 +394,17 @@ TimerCheckProc(data, flags)
{
Tcl_Event *timerEvPtr;
Tcl_Time blockTime;
+ ThreadSpecificData *tsdPtr = InitTimer();
- if ((flags & TCL_TIMER_EVENTS) && firstTimerHandlerPtr) {
+ if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
/*
* Compute the timeout for the next timer on the list.
*/
TclpGetTime(&blockTime);
- blockTime.sec = firstTimerHandlerPtr->time.sec - blockTime.sec;
- blockTime.usec = firstTimerHandlerPtr->time.usec - blockTime.usec;
+ blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
+ blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
+ blockTime.usec;
if (blockTime.usec < 0) {
blockTime.sec -= 1;
blockTime.usec += 1000000;
@@ -408,8 +418,9 @@ TimerCheckProc(data, flags)
* If the first timer has expired, stick an event on the queue.
*/
- if (blockTime.sec == 0 && blockTime.usec == 0 && !timerPending) {
- timerPending = 1;
+ if (blockTime.sec == 0 && blockTime.usec == 0 &&
+ !tsdPtr->timerPending) {
+ tsdPtr->timerPending = 1;
timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
timerEvPtr->proc = TimerHandlerEventProc;
Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
@@ -448,6 +459,7 @@ TimerHandlerEventProc(evPtr, flags)
TimerHandler *timerHandlerPtr, **nextPtrPtr;
Tcl_Time time;
int currentTimerId;
+ ThreadSpecificData *tsdPtr = InitTimer();
/*
* Do nothing if timers aren't enabled. This leaves the event on the
@@ -486,12 +498,12 @@ TimerHandlerEventProc(evPtr, flags)
* appearing before later ones.
*/
- timerPending = 0;
- currentTimerId = lastTimerId;
+ tsdPtr->timerPending = 0;
+ currentTimerId = tsdPtr->lastTimerId;
TclpGetTime(&time);
while (1) {
- nextPtrPtr = &firstTimerHandlerPtr;
- timerHandlerPtr = firstTimerHandlerPtr;
+ nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
+ timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
if (timerHandlerPtr == NULL) {
break;
}
@@ -549,22 +561,19 @@ Tcl_DoWhenIdle(proc, clientData)
{
register IdleHandler *idlePtr;
Tcl_Time blockTime;
-
- if (!initialized) {
- InitTimer();
- }
+ ThreadSpecificData *tsdPtr = InitTimer();
idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
idlePtr->proc = proc;
idlePtr->clientData = clientData;
- idlePtr->generation = idleGeneration;
+ idlePtr->generation = tsdPtr->idleGeneration;
idlePtr->nextPtr = NULL;
- if (lastIdlePtr == NULL) {
- idleList = idlePtr;
+ if (tsdPtr->lastIdlePtr == NULL) {
+ tsdPtr->idleList = idlePtr;
} else {
- lastIdlePtr->nextPtr = idlePtr;
+ tsdPtr->lastIdlePtr->nextPtr = idlePtr;
}
- lastIdlePtr = idlePtr;
+ tsdPtr->lastIdlePtr = idlePtr;
blockTime.sec = 0;
blockTime.usec = 0;
@@ -596,8 +605,9 @@ Tcl_CancelIdleCall(proc, clientData)
{
register IdleHandler *idlePtr, *prevPtr;
IdleHandler *nextPtr;
+ ThreadSpecificData *tsdPtr = InitTimer();
- for (prevPtr = NULL, idlePtr = idleList; idlePtr != NULL;
+ for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
while ((idlePtr->proc == proc)
&& (idlePtr->clientData == clientData)) {
@@ -605,12 +615,12 @@ Tcl_CancelIdleCall(proc, clientData)
ckfree((char *) idlePtr);
idlePtr = nextPtr;
if (prevPtr == NULL) {
- idleList = idlePtr;
+ tsdPtr->idleList = idlePtr;
} else {
prevPtr->nextPtr = idlePtr;
}
if (idlePtr == NULL) {
- lastIdlePtr = prevPtr;
+ tsdPtr->lastIdlePtr = prevPtr;
return;
}
}
@@ -643,13 +653,14 @@ TclServiceIdle()
IdleHandler *idlePtr;
int oldGeneration;
Tcl_Time blockTime;
+ ThreadSpecificData *tsdPtr = InitTimer();
- if (idleList == NULL) {
+ if (tsdPtr->idleList == NULL) {
return 0;
}
- oldGeneration = idleGeneration;
- idleGeneration++;
+ oldGeneration = tsdPtr->idleGeneration;
+ tsdPtr->idleGeneration++;
/*
* The code below is trickier than it may look, for the following
@@ -670,18 +681,18 @@ TclServiceIdle()
* change structure during the call.
*/
- for (idlePtr = idleList;
+ for (idlePtr = tsdPtr->idleList;
((idlePtr != NULL)
&& ((oldGeneration - idlePtr->generation) >= 0));
- idlePtr = idleList) {
- idleList = idlePtr->nextPtr;
- if (idleList == NULL) {
- lastIdlePtr = NULL;
+ idlePtr = tsdPtr->idleList) {
+ tsdPtr->idleList = idlePtr->nextPtr;
+ if (tsdPtr->idleList == NULL) {
+ tsdPtr->lastIdlePtr = NULL;
}
(*idlePtr->proc)(idlePtr->clientData);
ckfree((char *) idlePtr);
}
- if (idleList) {
+ if (tsdPtr->idleList) {
blockTime.sec = 0;
blockTime.usec = 0;
Tcl_SetMaxBlockTime(&blockTime);
@@ -716,28 +727,18 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- /*
- * The variable below is used to generate unique identifiers for
- * after commands. This id can wrap around, which can potentially
- * cause problems. However, there are not likely to be problems
- * in practice, because after commands can only be requested to
- * about a month in the future, and wrap-around is unlikely to
- * occur in less than about 1-10 years. Thus it's unlikely that
- * any old ids will still be around when wrap-around occurs.
- */
-
- static int nextId = 1;
int ms;
AfterInfo *afterPtr;
AfterAssocData *assocPtr = (AfterAssocData *) clientData;
Tcl_CmdInfo cmdInfo;
int length;
- char *arg;
- int index, result;
- static char *subCmds[] = {
- "cancel", "idle", "info",
- (char *) NULL};
-
+ char *argString;
+ int index;
+ char buf[16 + TCL_INTEGER_SPACE];
+ static char *afterSubCmds[] = {"cancel", "idle", "info", (char *) NULL};
+ enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
+ ThreadSpecificData *tsdPtr = InitTimer();
+
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
@@ -769,12 +770,17 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
/*
* First lets see if the command was passed a number as the first argument.
*/
-
- arg = Tcl_GetStringFromObj(objv[1], &length);
- if (isdigit(UCHAR(arg[0]))) {
+
+ if (objv[1]->typePtr == &tclIntType) {
+ ms = (int) objv[1]->internalRep.longValue;
+ goto processInteger;
+ }
+ argString = Tcl_GetStringFromObj(objv[1], &length);
+ if (isdigit(UCHAR(argString[0]))) { /* INTL: digit */
if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
return TCL_ERROR;
}
+processInteger:
if (ms < 0) {
ms = 0;
}
@@ -785,77 +791,85 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
afterPtr->assocPtr = assocPtr;
if (objc == 3) {
- arg = Tcl_GetStringFromObj(objv[2], &length);
- afterPtr->command = (char *) ckalloc((unsigned) (length + 1));
- strcpy(afterPtr->command, arg);
+ afterPtr->commandPtr = objv[2];
} else {
- Tcl_Obj *objPtr = Tcl_ConcatObj(objc-2, objv+2);
- arg = Tcl_GetStringFromObj(objPtr, &length);
- afterPtr->command = (char *) ckalloc((unsigned) (length + 1));
- strcpy(afterPtr->command, arg);
- Tcl_DecrRefCount(objPtr);
+ afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
}
- afterPtr->id = nextId;
- nextId += 1;
+ Tcl_IncrRefCount(afterPtr->commandPtr);
+ /*
+ * The variable below is used to generate unique identifiers for
+ * after commands. This id can wrap around, which can potentially
+ * cause problems. However, there are not likely to be problems
+ * in practice, because after commands can only be requested to
+ * about a month in the future, and wrap-around is unlikely to
+ * occur in less than about 1-10 years. Thus it's unlikely that
+ * any old ids will still be around when wrap-around occurs.
+ */
+ afterPtr->id = tsdPtr->afterId;
+ tsdPtr->afterId += 1;
afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
(ClientData) afterPtr);
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
- sprintf(interp->result, "after#%d", afterPtr->id);
+ sprintf(buf, "after#%d", afterPtr->id);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
return TCL_OK;
}
/*
* If it's not a number it must be a subcommand.
*/
- result = Tcl_GetIndexFromObj(NULL, objv[1], subCmds, "option",
- 0, (int *) &index);
- if (result != TCL_OK) {
- Tcl_AppendResult(interp, "bad argument \"", arg,
+
+ if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument",
+ 0, &index) != TCL_OK) {
+ Tcl_AppendResult(interp, "bad argument \"", argString,
"\": must be cancel, idle, info, or a number",
(char *) NULL);
return TCL_ERROR;
}
+ switch ((enum afterSubCmds) index) {
+ case AFTER_CANCEL: {
+ Tcl_Obj *commandPtr;
+ char *command, *tempCommand;
+ int tempLength;
- switch (index) {
- case 0: /* cancel */
- {
- char *arg;
- Tcl_Obj *objPtr = NULL;
-
- if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "id|command");
- return TCL_ERROR;
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "id|command");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ commandPtr = objv[2];
+ } else {
+ commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
+ }
+ command = Tcl_GetStringFromObj(commandPtr, &length);
+ for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
+ afterPtr = afterPtr->nextPtr) {
+ tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
+ &tempLength);
+ if ((length == tempLength)
+ && (memcmp((void*) command, (void*) tempCommand,
+ (unsigned) length) == 0)) {
+ break;
}
- if (objc == 3) {
- arg = Tcl_GetStringFromObj(objv[2], &length);
+ }
+ if (afterPtr == NULL) {
+ afterPtr = GetAfterEvent(assocPtr, commandPtr);
+ }
+ if (objc != 3) {
+ Tcl_DecrRefCount(commandPtr);
+ }
+ if (afterPtr != NULL) {
+ if (afterPtr->token != NULL) {
+ Tcl_DeleteTimerHandler(afterPtr->token);
} else {
- objPtr = Tcl_ConcatObj(objc-2, objv+2);;
- arg = Tcl_GetStringFromObj(objPtr, &length);
- }
- for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
- afterPtr = afterPtr->nextPtr) {
- if (strcmp(afterPtr->command, arg) == 0) {
- break;
- }
- }
- if (afterPtr == NULL) {
- afterPtr = GetAfterEvent(assocPtr, arg);
+ Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
}
- if (objPtr != NULL) {
- Tcl_DecrRefCount(objPtr);
- }
- if (afterPtr != NULL) {
- if (afterPtr->token != NULL) {
- Tcl_DeleteTimerHandler(afterPtr->token);
- } else {
- Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
- }
- FreeAfterPtr(afterPtr);
- }
- break;
+ FreeAfterPtr(afterPtr);
}
- case 1: /* idle */
+ break;
+ }
+ case AFTER_IDLE:
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
return TCL_ERROR;
@@ -863,33 +877,29 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
afterPtr->assocPtr = assocPtr;
if (objc == 3) {
- arg = Tcl_GetStringFromObj(objv[2], &length);
- afterPtr->command = (char *) ckalloc((unsigned) length + 1);
- strcpy(afterPtr->command, arg);
+ afterPtr->commandPtr = objv[2];
} else {
- Tcl_Obj *objPtr = Tcl_ConcatObj(objc-2, objv+2);;
- arg = Tcl_GetStringFromObj(objPtr, &length);
- afterPtr->command = (char *) ckalloc((unsigned) (length + 1));
- strcpy(afterPtr->command, arg);
- Tcl_DecrRefCount(objPtr);
+ afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
}
- afterPtr->id = nextId;
- nextId += 1;
+ Tcl_IncrRefCount(afterPtr->commandPtr);
+ afterPtr->id = tsdPtr->afterId;
+ tsdPtr->afterId += 1;
afterPtr->token = NULL;
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
- sprintf(interp->result, "after#%d", afterPtr->id);
+ sprintf(buf, "after#%d", afterPtr->id);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
break;
- case 2: /* info */
+ case AFTER_INFO: {
+ Tcl_Obj *resultListPtr;
+
if (objc == 2) {
- char buffer[30];
-
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
afterPtr = afterPtr->nextPtr) {
if (assocPtr->interp == interp) {
- sprintf(buffer, "after#%d", afterPtr->id);
- Tcl_AppendElement(interp, buffer);
+ sprintf(buf, "after#%d", afterPtr->id);
+ Tcl_AppendElement(interp, buf);
}
}
return TCL_OK;
@@ -898,17 +908,22 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
Tcl_WrongNumArgs(interp, 2, objv, "?id?");
return TCL_ERROR;
}
- arg = Tcl_GetStringFromObj(objv[2], &length);
- afterPtr = GetAfterEvent(assocPtr, arg);
+ afterPtr = GetAfterEvent(assocPtr, objv[2]);
if (afterPtr == NULL) {
- Tcl_AppendResult(interp, "event \"", arg,
+ Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),
"\" doesn't exist", (char *) NULL);
return TCL_ERROR;
}
- Tcl_AppendElement(interp, afterPtr->command);
- Tcl_AppendElement(interp,
- (afterPtr->token == NULL) ? "idle" : "timer");
+ resultListPtr = Tcl_GetObjResult(interp);
+ Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+ (afterPtr->token == NULL) ? "idle" : "timer", -1));
+ Tcl_SetObjResult(interp, resultListPtr);
break;
+ }
+ default: {
+ panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
+ }
}
return TCL_OK;
}
@@ -923,7 +938,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
*
* Results:
* The return value is either a pointer to an AfterInfo structure,
- * if one is found that corresponds to "string" and is for interp,
+ * if one is found that corresponds to "cmdString" and is for interp,
* or NULL if no corresponding after event can be found.
*
* Side effects:
@@ -933,22 +948,24 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
*/
static AfterInfo *
-GetAfterEvent(assocPtr, string)
+GetAfterEvent(assocPtr, commandPtr)
AfterAssocData *assocPtr; /* Points to "after"-related information for
* this interpreter. */
- char *string; /* Textual identifier for after event, such
- * as "after#6". */
+ Tcl_Obj *commandPtr;
{
+ char *cmdString; /* Textual identifier for after event, such
+ * as "after#6". */
AfterInfo *afterPtr;
int id;
char *end;
- if (strncmp(string, "after#", 6) != 0) {
+ cmdString = Tcl_GetString(commandPtr);
+ if (strncmp(cmdString, "after#", 6) != 0) {
return NULL;
}
- string += 6;
- id = strtoul(string, &end, 10);
- if ((end == string) || (*end != 0)) {
+ cmdString += 6;
+ id = strtoul(cmdString, &end, 10);
+ if ((end == cmdString) || (*end != 0)) {
return NULL;
}
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
@@ -989,6 +1006,8 @@ AfterProc(clientData)
AfterInfo *prevPtr;
int result;
Tcl_Interp *interp;
+ char *script;
+ int numBytes;
/*
* First remove the callback from our list of callbacks; otherwise
@@ -1012,7 +1031,8 @@ AfterProc(clientData)
interp = assocPtr->interp;
Tcl_Preserve((ClientData) interp);
- result = Tcl_GlobalEval(interp, afterPtr->command);
+ script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
+ result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (\"after\" script)");
Tcl_BackgroundError(interp);
@@ -1023,7 +1043,7 @@ AfterProc(clientData)
* Free the memory for the callback.
*/
- ckfree(afterPtr->command);
+ Tcl_DecrRefCount(afterPtr->commandPtr);
ckfree((char *) afterPtr);
}
@@ -1062,7 +1082,7 @@ FreeAfterPtr(afterPtr)
}
prevPtr->nextPtr = afterPtr->nextPtr;
}
- ckfree(afterPtr->command);
+ Tcl_DecrRefCount(afterPtr->commandPtr);
ckfree((char *) afterPtr);
}
@@ -1101,7 +1121,7 @@ AfterCleanupProc(clientData, interp)
} else {
Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
}
- ckfree(afterPtr->command);
+ Tcl_DecrRefCount(afterPtr->commandPtr);
ckfree((char *) afterPtr);
}
ckfree((char *) assocPtr);
diff --git a/tcl/generic/tclUniData.c b/tcl/generic/tclUniData.c
new file mode 100644
index 00000000000..612aba8e864
--- /dev/null
+++ b/tcl/generic/tclUniData.c
@@ -0,0 +1,586 @@
+/*
+ * tclUtfData.c --
+ *
+ * Declarations of Unicode character information tables. This file is
+ * automatically generated by the tools/uniParse.tcl script. Do not
+ * modify this file by hand.
+ *
+ * Copyright (c) 1998 by Scriptics Corporation.
+ * All rights reserved.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * A 16-bit Unicode character is split into two parts in order to index
+ * into the following tables. The lower OFFSET_BITS comprise an offset
+ * into a page of characters. The upper bits comprise the page number.
+ */
+
+#define OFFSET_BITS 5
+
+/*
+ * The pageMap is indexed by page number and returns an alternate page number
+ * that identifies a unique page of characters. Many Unicode characters map
+ * to the same alternate page number.
+ */
+
+static unsigned char pageMap[] = {
+ 0, 1, 2, 3, 0, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
+ 19, 20, 21, 22, 23, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 7, 33,
+ 7, 34, 35, 16, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48,
+ 49, 50, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66,
+ 55, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 77, 78,
+ 81, 82, 77, 16, 16, 16, 16, 83, 84, 85, 16, 86, 87, 88, 16, 89, 90,
+ 91, 92, 93, 94, 16, 16, 16, 16, 16, 16, 16, 95, 96, 97, 47, 47, 98,
+ 47, 47, 99, 47, 100, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 7,
+ 7, 7, 7, 101, 7, 7, 102, 103, 104, 105, 106, 104, 107, 108, 109, 110,
+ 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124,
+ 125, 126, 126, 126, 126, 126, 126, 126, 127, 128, 129, 123, 130, 16,
+ 16, 16, 16, 123, 131, 125, 132, 133, 134, 135, 136, 123, 123, 123,
+ 123, 137, 123, 123, 138, 139, 123, 123, 138, 16, 16, 16, 16, 140, 141,
+ 142, 143, 144, 145, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 146, 147, 83, 47, 148, 83, 47, 149, 150, 151, 47, 47, 152,
+ 16, 16, 16, 153, 154, 155, 156, 154, 157, 158, 159, 123, 123, 123,
+ 160, 123, 123, 161, 159, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 162, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
+ 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 163, 16, 16, 164, 164, 164, 164, 164, 164,
+ 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164,
+ 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164,
+ 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164,
+ 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164,
+ 164, 164, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
+ 165, 165, 165, 165, 165, 165, 47, 47, 47, 47, 47, 47, 47, 47, 47, 166,
+ 16, 16, 16, 16, 16, 16, 167, 168, 169, 47, 47, 170, 171, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 172, 173, 47, 174, 47, 175, 176, 16, 177,
+ 178, 179, 47, 47, 47, 180, 181, 2, 182, 183, 184, 185, 186, 187
+};
+
+/*
+ * The groupMap is indexed by combining the alternate page number with
+ * the page offset and returns a group number that identifies a unique
+ * set of character attributes.
+ */
+
+static unsigned char groupMap[] = {
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8,
+ 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, 7, 7, 3, 3, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 5, 3, 6, 11, 12, 11, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 5, 7, 6, 7, 1, 2, 3, 4, 4, 4, 4, 14, 14, 11, 14, 15, 16,
+ 7, 8, 14, 11, 14, 7, 17, 17, 11, 15, 14, 3, 11, 17, 15, 18, 17, 17,
+ 17, 3, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 7, 10, 10, 10, 10, 10, 10, 10, 15,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 7, 13, 13, 13, 13, 13, 13, 13, 19, 20, 21,
+ 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
+ 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
+ 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 22, 23, 20, 21, 20,
+ 21, 20, 21, 15, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
+ 21, 20, 21, 15, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
+ 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
+ 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 24,
+ 20, 21, 20, 21, 20, 21, 25, 15, 26, 20, 21, 20, 21, 27, 20, 21, 28,
+ 28, 20, 21, 15, 29, 30, 31, 20, 21, 28, 32, 15, 33, 34, 20, 21, 15,
+ 15, 33, 35, 15, 36, 20, 21, 20, 21, 20, 21, 37, 20, 21, 37, 38, 15,
+ 20, 21, 37, 20, 21, 39, 39, 20, 21, 20, 21, 40, 20, 21, 15, 38, 20,
+ 21, 38, 38, 38, 38, 38, 38, 41, 42, 43, 41, 42, 43, 41, 42, 43, 20,
+ 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 44, 20,
+ 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
+ 15, 41, 42, 43, 20, 21, 0, 0, 0, 0, 20, 21, 20, 21, 20, 21, 20, 21,
+ 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
+ 21, 20, 21, 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 45,
+ 46, 15, 47, 47, 15, 48, 15, 49, 15, 15, 15, 15, 47, 15, 15, 50, 15,
+ 15, 15, 15, 51, 52, 15, 15, 15, 15, 15, 52, 15, 15, 53, 15, 15, 54,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 55, 15, 15, 55, 15, 15, 15,
+ 15, 55, 15, 56, 56, 15, 15, 15, 15, 15, 15, 57, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 0, 0, 0, 0, 0, 0, 0, 58, 58, 58, 58, 58, 58, 58, 58, 58, 11, 11, 58,
+ 58, 58, 58, 58, 58, 58, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+ 11, 11, 11, 58, 58, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+ 11, 0, 58, 58, 58, 58, 58, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 60, 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,
+ 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11,
+ 0, 0, 0, 0, 58, 0, 0, 0, 3, 0, 0, 0, 0, 0, 11, 11, 61, 3, 62, 62, 62,
+ 0, 63, 0, 64, 64, 15, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 65, 66,
+ 66, 66, 15, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 67, 13, 13, 13, 13, 13, 13, 13, 13, 13, 68, 69, 69, 0,
+ 70, 71, 72, 72, 72, 73, 74, 0, 0, 0, 72, 0, 72, 0, 72, 0, 72, 0, 20,
+ 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 75, 76, 44, 38,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 77, 77, 77, 77, 77, 77, 77,
+ 77, 77, 77, 77, 77, 0, 77, 77, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 0, 76, 76, 76, 76, 76, 76, 76, 76, 76, 76, 76, 76,
+ 0, 76, 76, 20, 21, 14, 59, 59, 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20,
+ 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 38, 20,
+ 21, 20, 21, 0, 0, 20, 21, 0, 0, 20, 21, 0, 0, 0, 20, 21, 20, 21, 20,
+ 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
+ 20, 21, 20, 21, 20, 21, 0, 0, 20, 21, 20, 21, 20, 21, 20, 21, 0, 0,
+ 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78,
+ 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78,
+ 78, 78, 78, 78, 78, 78, 0, 0, 58, 3, 3, 3, 3, 3, 3, 0, 79, 79, 79,
+ 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79,
+ 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79,
+ 79, 15, 0, 3, 0, 0, 0, 0, 0, 0, 0, 59, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 0, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 0,
+ 59, 59, 59, 3, 59, 3, 59, 59, 3, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 0, 38, 38,
+ 38, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0,
+ 3, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 0, 58, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 59, 59, 59, 59, 59, 59, 59, 59, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3,
+ 3, 3, 3, 0, 0, 59, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 38, 38, 38, 38, 38, 0, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38,
+ 38, 3, 38, 59, 59, 59, 59, 59, 59, 59, 80, 80, 59, 59, 59, 59, 59,
+ 59, 58, 58, 59, 59, 14, 59, 59, 59, 59, 0, 0, 9, 9, 9, 9, 9, 9, 9,
+ 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 59, 59, 81, 0, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 59, 38, 81,
+ 81, 81, 59, 59, 59, 59, 59, 59, 59, 59, 81, 81, 81, 81, 59, 0, 0, 38,
+ 59, 59, 59, 59, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 59,
+ 59, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 59, 81, 81, 0, 38, 38, 38, 38, 38, 38, 38,
+ 38, 0, 0, 38, 38, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38,
+ 38, 38, 0, 38, 0, 0, 0, 38, 38, 38, 38, 0, 0, 59, 0, 81, 81, 81, 59,
+ 59, 59, 59, 0, 0, 81, 81, 0, 0, 81, 81, 59, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 81, 0, 0, 0, 0, 38, 38, 0, 38, 38, 38, 59, 59, 0, 0, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 38, 38, 4, 4, 17, 17, 17, 17, 17, 17, 14, 0, 0, 0,
+ 0, 0, 0, 0, 59, 0, 0, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 38, 38, 0,
+ 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 0,
+ 38, 38, 0, 38, 38, 0, 0, 59, 0, 81, 81, 81, 59, 59, 0, 0, 0, 0, 59,
+ 59, 0, 0, 59, 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38, 38,
+ 38, 0, 38, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 59, 59,
+ 38, 38, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 59, 59, 81, 0, 38,
+ 38, 38, 38, 38, 38, 38, 0, 38, 0, 38, 38, 38, 0, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 0, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 0, 38, 38, 38, 38, 38, 0,
+ 0, 59, 38, 81, 81, 81, 59, 59, 59, 59, 59, 0, 59, 59, 81, 0, 81, 81,
+ 59, 0, 0, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 0, 0,
+ 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38,
+ 38, 38, 38, 38, 0, 38, 38, 0, 0, 38, 38, 38, 38, 0, 0, 59, 38, 81,
+ 59, 81, 59, 59, 59, 0, 0, 0, 81, 81, 0, 0, 81, 81, 59, 0, 0, 0, 0,
+ 0, 0, 0, 0, 59, 81, 0, 0, 0, 0, 38, 38, 0, 38, 38, 38, 0, 0, 0, 0,
+ 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 59, 81, 0, 38, 38, 38, 38, 38, 38, 0, 0, 0, 38, 38,
+ 38, 0, 38, 38, 38, 38, 0, 0, 0, 38, 38, 0, 38, 0, 38, 38, 0, 0, 0,
+ 38, 38, 0, 0, 0, 38, 38, 38, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38,
+ 0, 38, 38, 38, 0, 0, 0, 0, 81, 81, 59, 81, 81, 0, 0, 0, 81, 81, 81,
+ 0, 81, 81, 81, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 81, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 17, 17, 17, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 81, 81, 81, 0, 38, 38, 38, 38,
+ 38, 38, 38, 38, 0, 38, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38, 0, 0, 0, 0,
+ 59, 59, 59, 81, 81, 81, 81, 0, 59, 59, 59, 0, 59, 59, 59, 59, 0, 0,
+ 0, 0, 0, 0, 0, 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38, 0, 0, 0,
+ 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 81, 81, 0, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38,
+ 38, 38, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 0, 38, 38, 38, 38, 38, 0, 0, 0, 0, 81, 59, 81, 81, 81,
+ 81, 81, 0, 59, 81, 81, 0, 81, 81, 59, 59, 0, 0, 0, 0, 0, 0, 0, 81,
+ 81, 0, 0, 0, 0, 0, 0, 0, 38, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 0, 0, 0, 0, 81, 81, 81, 59, 59, 59, 0, 0, 81, 81, 81, 0, 81, 81, 81,
+ 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 81, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 59, 38, 38, 59, 59,
+ 59, 59, 59, 59, 59, 0, 0, 0, 0, 4, 38, 38, 38, 38, 38, 38, 58, 59,
+ 59, 59, 59, 59, 59, 59, 59, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3,
+ 0, 0, 0, 0, 0, 38, 38, 0, 38, 0, 0, 38, 38, 0, 38, 0, 0, 38, 0, 0,
+ 0, 0, 0, 0, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38,
+ 38, 0, 38, 0, 38, 0, 0, 38, 38, 0, 38, 38, 38, 38, 59, 38, 38, 59,
+ 59, 59, 59, 59, 59, 0, 59, 59, 38, 0, 0, 38, 38, 38, 38, 38, 0, 58,
+ 0, 59, 59, 59, 59, 59, 59, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
+ 38, 38, 0, 0, 38, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 14, 14, 14, 14, 14, 59, 59, 14, 14, 14, 14, 14, 14, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 14, 59,
+ 14, 59, 14, 59, 5, 6, 5, 6, 81, 81, 38, 38, 38, 38, 38, 38, 38, 38,
+ 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 0, 0, 0, 0, 0, 0, 0, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 81, 59, 59, 59, 59, 59, 3, 59, 59, 38, 38, 38, 38, 0, 0, 0,
+ 0, 59, 59, 59, 59, 59, 59, 0, 59, 0, 59, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 0, 0, 0, 59, 59,
+ 59, 59, 59, 59, 59, 0, 59, 0, 0, 0, 0, 0, 0, 78, 78, 78, 78, 78, 78,
+ 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78,
+ 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 3, 0, 0, 0, 0,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 0, 38, 38, 38, 38,
+ 0, 0, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 0, 0, 0, 0, 0, 0, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
+ 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 15, 15, 15, 15, 15,
+ 82, 0, 0, 0, 0, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
+ 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 0, 0, 0, 0, 0,
+ 0, 83, 83, 83, 83, 83, 83, 83, 83, 84, 84, 84, 84, 84, 84, 84, 84,
+ 83, 83, 83, 83, 83, 83, 0, 0, 84, 84, 84, 84, 84, 84, 0, 0, 83, 83,
+ 83, 83, 83, 83, 83, 83, 84, 84, 84, 84, 84, 84, 84, 84, 83, 83, 83,
+ 83, 83, 83, 83, 83, 84, 84, 84, 84, 84, 84, 84, 84, 83, 83, 83, 83,
+ 83, 83, 0, 0, 84, 84, 84, 84, 84, 84, 0, 0, 15, 83, 15, 83, 15, 83,
+ 15, 83, 0, 84, 0, 84, 0, 84, 0, 84, 83, 83, 83, 83, 83, 83, 83, 83,
+ 84, 84, 84, 84, 84, 84, 84, 84, 85, 85, 86, 86, 86, 86, 87, 87, 88,
+ 88, 89, 89, 90, 90, 0, 0, 83, 83, 83, 83, 83, 83, 83, 83, 84, 84, 84,
+ 84, 84, 84, 84, 84, 83, 83, 15, 91, 15, 0, 15, 15, 84, 84, 92, 92,
+ 93, 11, 94, 11, 11, 11, 15, 91, 15, 0, 15, 15, 95, 95, 95, 95, 93,
+ 11, 11, 11, 83, 83, 15, 15, 0, 0, 15, 15, 84, 84, 96, 96, 0, 11, 11,
+ 11, 83, 83, 15, 15, 15, 97, 15, 15, 84, 84, 98, 98, 99, 11, 11, 11,
+ 0, 0, 15, 91, 15, 0, 15, 15, 100, 100, 101, 101, 93, 11, 11, 0, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 102, 102, 102, 102, 8, 8, 8, 8, 8,
+ 8, 3, 3, 16, 18, 5, 16, 16, 18, 5, 16, 3, 3, 3, 3, 3, 3, 3, 3, 103,
+ 104, 102, 102, 102, 102, 102, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 16, 18,
+ 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 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, 102, 102, 102, 102, 102, 102, 17, 0, 0, 0, 17, 17, 17, 17, 17,
+ 17, 7, 7, 7, 5, 6, 15, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 7, 7,
+ 7, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 80, 80, 80, 80, 59,
+ 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, 14, 14, 72, 14, 14, 14, 14, 72, 14, 14, 15, 72,
+ 72, 72, 15, 15, 72, 72, 72, 15, 14, 72, 14, 14, 15, 72, 72, 72, 72,
+ 72, 14, 14, 14, 14, 14, 14, 72, 14, 72, 14, 72, 14, 72, 72, 72, 72,
+ 15, 15, 72, 72, 14, 72, 15, 38, 38, 38, 38, 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, 17, 17, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 105, 105, 105, 105, 105, 105, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 106, 106, 106, 106, 106,
+ 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 107, 107, 107,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 7, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 0, 14, 14, 14, 14, 14, 14, 7,
+ 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 14, 14, 14, 5, 6, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 14,
+ 14, 14, 14, 14, 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, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 108, 108, 108, 108, 108, 108, 108,
+ 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
+ 108, 108, 108, 108, 108, 109, 109, 109, 109, 109, 109, 109, 109, 109,
+ 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109,
+ 109, 109, 109, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
+ 0, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 0, 14, 14, 14, 14, 0,
+ 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 0, 14,
+ 14, 14, 14, 0, 0, 0, 14, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14,
+ 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 14, 0, 0, 0, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 0, 2, 3, 3, 3, 14, 58, 38, 107, 5, 6, 5, 6, 5, 6, 5, 6, 5,
+ 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 59, 59, 59, 59, 59, 59, 8, 58, 58, 58, 58,
+ 58, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 59,
+ 59, 11, 11, 58, 58, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 12,
+ 58, 58, 58, 0, 0, 0, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 14, 14, 17, 17,
+ 17, 17, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 17, 17, 17, 17, 17, 17, 17, 17,
+ 17, 17, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 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, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+ 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 38, 38, 38, 38, 38,
+ 38, 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, 38, 38, 38, 38, 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, 110, 110, 110, 110,
+ 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110,
+ 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110,
+ 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111,
+ 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111,
+ 111, 111, 111, 111, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
+ 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
+ 15, 15, 0, 0, 0, 0, 0, 0, 59, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 7, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38,
+ 38, 38, 0, 38, 0, 38, 38, 0, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 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, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 59, 59, 59, 59,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5,
+ 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 0, 0, 0, 0, 3, 3, 3, 3, 12, 12, 12,
+ 3, 3, 3, 0, 3, 3, 3, 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7,
+ 0, 3, 4, 3, 3, 0, 0, 0, 0, 38, 38, 38, 0, 38, 0, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 0, 0, 102, 0, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 3, 3, 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 5, 7, 6, 7, 0, 0, 3, 5, 6, 3, 12, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 58, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 58,
+ 58, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
+ 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0,
+ 38, 38, 38, 38, 38, 38, 0, 0, 38, 38, 38, 38, 38, 38, 0, 0, 38, 38,
+ 38, 38, 38, 38, 0, 0, 38, 38, 38, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0,
+ 14, 7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
+ 14, 0, 0
+};
+
+/*
+ * Each group represents a unique set of character attributes. The attributes
+ * are encoded into a 32-bit value as follows:
+ *
+ * Bits 0-4 Character category: see the constants listed below.
+ *
+ * Bits 5-7 Case delta type: 000 = identity
+ * 010 = add delta for lower
+ * 011 = add delta for lower, add 1 for title
+ * 100 = sutract delta for title/upper
+ * 101 = sub delta for upper, sub 1 for title
+ * 110 = sub delta for upper, add delta for lower
+ *
+ * Bits 8-21 Reserved for future use.
+ *
+ * Bits 22-31 Case delta: delta for case conversions. This should be the
+ * highest field so we can easily sign extend.
+ */
+
+static int groups[] = {
+ 0, 15, 12, 25, 27, 21, 22, 26, 20, 9, 134217793, 28, 19, 134217858,
+ 29, 2, 23, 11, 24, -507510654, 4194369, 4194434, -834666431, 973078658,
+ -507510719, 1258291330, 880803905, 864026689, 859832385, 331350081,
+ 847249473, 851443777, 868220993, 884998209, 876609601, 893386817,
+ 897581121, 914358337, 5, 910164033, 918552641, 8388705, 4194499,
+ 8388770, 331350146, 880803970, 864026754, 859832450, 847249538,
+ 851443842, 868221058, 876609666, 884998274, 893386882, 897581186,
+ 914358402, 910164098, 918552706, 4, 6, -352321338, 159383617,
+ 155189313, 268435521, 264241217, 159383682, 155189378, 130023554,
+ 268435586, 264241282, 260046978, 239075458, 1, 197132418, 226492546,
+ 360710274, 335544450, 335544385, 201326657, 201326722, 7, 8, 247464066,
+ -33554302, -33554367, -310378366, -360710014, -419430270, -536870782,
+ -469761918, -528482174, -37748606, -310378431, -37748671, 155189442,
+ -360710079, -419430335, -29359998, -469761983, -29360063, -536870847,
+ -528482239, 16, 13, 14, 67108938, 67109002, 10, 109051997, 109052061,
+ 18, 17
+};
+
+/*
+ * The following constants are used to determine the category of a
+ * Unicode character.
+ */
+
+#define UNICODE_CATEGORY_MASK 0X1F
+
+enum {
+ UNASSIGNED,
+ UPPERCASE_LETTER,
+ LOWERCASE_LETTER,
+ TITLECASE_LETTER,
+ MODIFIER_LETTER,
+ OTHER_LETTER,
+ NON_SPACING_MARK,
+ ENCLOSING_MARK,
+ COMBINING_SPACING_MARK,
+ DECIMAL_DIGIT_NUMBER,
+ LETTER_NUMBER,
+ OTHER_NUMBER,
+ SPACE_SEPARATOR,
+ LINE_SEPARATOR,
+ PARAGRAPH_SEPARATOR,
+ CONTROL,
+ FORMAT,
+ PRIVATE_USE,
+ SURROGATE,
+ CONNECTOR_PUNCTUATION,
+ DASH_PUNCTUATION,
+ OPEN_PUNCTUATION,
+ CLOSE_PUNCTUATION,
+ INITIAL_QUOTE_PUNCTUATION,
+ FINAL_QUOTE_PUNCTUATION,
+ OTHER_PUNCTUATION,
+ MATH_SYMBOL,
+ CURRENCY_SYMBOL,
+ MODIFIER_SYMBOL,
+ OTHER_SYMBOL
+};
+
+/*
+ * The following macros extract the fields of the character info. The
+ * GetDelta() macro is complicated because we can't rely on the C compiler
+ * to do sign extension on right shifts.
+ */
+
+#define GetCaseType(info) (((info) & 0xE0) >> 5)
+#define GetCategory(info) ((info) & 0x1F)
+#define GetDelta(infO) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
+
+/*
+ * This macro extracts the information about a character from the
+ * Unicode character tables.
+ */
+
+#define GetUniCharInfo(ch) (groups[groupMap[(pageMap[(((int)(ch)) & 0xffff) >> OFFSET_BITS] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))]])
+
diff --git a/tcl/generic/tclUtf.c b/tcl/generic/tclUtf.c
new file mode 100644
index 00000000000..5f6826ddf01
--- /dev/null
+++ b/tcl/generic/tclUtf.c
@@ -0,0 +1,1586 @@
+/*
+ * tclUtf.c --
+ *
+ * Routines for manipulating UTF-8 strings.
+ *
+ * Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+
+/*
+ * Include the static character classification tables and macros.
+ */
+
+#include "tclUniData.c"
+
+/*
+ * The following macros are used for fast character category tests. The
+ * x_BITS values are shifted right by the category value to determine whether
+ * the given category is included in the set.
+ */
+
+#define ALPHA_BITS ((1 << UPPERCASE_LETTER) | (1 << LOWERCASE_LETTER) \
+ | (1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) | (1 << OTHER_LETTER))
+
+#define DIGIT_BITS (1 << DECIMAL_DIGIT_NUMBER)
+
+#define SPACE_BITS ((1 << SPACE_SEPARATOR) | (1 << LINE_SEPARATOR) \
+ | (1 << PARAGRAPH_SEPARATOR))
+
+#define CONNECTOR_BITS (1 << CONNECTOR_PUNCTUATION)
+
+#define PRINT_BITS (ALPHA_BITS | DIGIT_BITS | SPACE_BITS | \
+ (1 << NON_SPACING_MARK) | (1 << ENCLOSING_MARK) | \
+ (1 << COMBINING_SPACING_MARK) | (1 << LETTER_NUMBER) | \
+ (1 << OTHER_NUMBER) | (1 << CONNECTOR_PUNCTUATION) | \
+ (1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
+ (1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
+ (1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION) | \
+ (1 << MATH_SYMBOL) | (1 << CURRENCY_SYMBOL) | \
+ (1 << MODIFIER_SYMBOL) | (1 << OTHER_SYMBOL))
+
+#define PUNCT_BITS ((1 << CONNECTOR_PUNCTUATION) | \
+ (1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
+ (1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
+ (1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION))
+
+/*
+ * Unicode characters less than this value are represented by themselves
+ * in UTF-8 strings.
+ */
+
+#define UNICODE_SELF 0x80
+
+/*
+ * The following structures are used when mapping between Unicode (UCS-2)
+ * and UTF-8.
+ */
+
+CONST unsigned char totalBytes[256] = {
+ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+ 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
+ 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
+#if TCL_UTF_MAX > 3
+ 4,4,4,4,4,4,4,4,
+#else
+ 1,1,1,1,1,1,1,1,
+#endif
+#if TCL_UTF_MAX > 4
+ 5,5,5,5,
+#else
+ 1,1,1,1,
+#endif
+#if TCL_UTF_MAX > 5
+ 6,6,6,6
+#else
+ 1,1,1,1
+#endif
+};
+
+/*
+ * Procedures used only in this module.
+ */
+
+static int UtfCount _ANSI_ARGS_((int ch));
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * UtfCount --
+ *
+ * Find the number of bytes in the Utf character "ch".
+ *
+ * Results:
+ * The return values is the number of bytes in the Utf character "ch".
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+UtfCount(ch)
+ int ch; /* The Tcl_UniChar whose size is returned. */
+{
+ if ((ch > 0) && (ch < UNICODE_SELF)) {
+ return 1;
+ }
+ if (ch <= 0x7FF) {
+ return 2;
+ }
+ if (ch <= 0xFFFF) {
+ return 3;
+ }
+#if TCL_UTF_MAX > 3
+ if (ch <= 0x1FFFFF) {
+ return 4;
+ }
+ if (ch <= 0x3FFFFFF) {
+ return 5;
+ }
+ if (ch <= 0x7FFFFFFF) {
+ return 6;
+ }
+#endif
+ return 3;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UniCharToUtf --
+ *
+ * Store the given Tcl_UniChar as a sequence of UTF-8 bytes in the
+ * provided buffer. Equivalent to Plan 9 runetochar().
+ *
+ * Results:
+ * The return values is the number of bytes in the buffer that
+ * were consumed.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+INLINE int
+Tcl_UniCharToUtf(ch, str)
+ int ch; /* The Tcl_UniChar to be stored in the
+ * buffer. */
+ char *str; /* Buffer in which the UTF-8 representation
+ * of the Tcl_UniChar is stored. Buffer must
+ * be large enough to hold the UTF-8 character
+ * (at most TCL_UTF_MAX bytes). */
+{
+ if ((ch > 0) && (ch < UNICODE_SELF)) {
+ str[0] = (char) ch;
+ return 1;
+ }
+ if (ch <= 0x7FF) {
+ str[1] = (char) ((ch | 0x80) & 0xBF);
+ str[0] = (char) ((ch >> 6) | 0xC0);
+ return 2;
+ }
+ if (ch <= 0xFFFF) {
+ three:
+ str[2] = (char) ((ch | 0x80) & 0xBF);
+ str[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
+ str[0] = (char) ((ch >> 12) | 0xE0);
+ return 3;
+ }
+
+#if TCL_UTF_MAX > 3
+ if (ch <= 0x1FFFFF) {
+ str[3] = (char) ((ch | 0x80) & 0xBF);
+ str[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
+ str[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
+ str[0] = (char) ((ch >> 18) | 0xF0);
+ return 4;
+ }
+ if (ch <= 0x3FFFFFF) {
+ str[4] = (char) ((ch | 0x80) & 0xBF);
+ str[3] = (char) (((ch >> 6) | 0x80) & 0xBF);
+ str[2] = (char) (((ch >> 12) | 0x80) & 0xBF);
+ str[1] = (char) (((ch >> 18) | 0x80) & 0xBF);
+ str[0] = (char) ((ch >> 24) | 0xF8);
+ return 5;
+ }
+ if (ch <= 0x7FFFFFFF) {
+ str[5] = (char) ((ch | 0x80) & 0xBF);
+ str[4] = (char) (((ch >> 6) | 0x80) & 0xBF);
+ str[3] = (char) (((ch >> 12) | 0x80) & 0xBF);
+ str[2] = (char) (((ch >> 18) | 0x80) & 0xBF);
+ str[1] = (char) (((ch >> 24) | 0x80) & 0xBF);
+ str[0] = (char) ((ch >> 30) | 0xFC);
+ return 6;
+ }
+#endif
+
+ ch = 0xFFFD;
+ goto three;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UniCharToUtfDString --
+ *
+ * Convert the given Unicode string to UTF-8.
+ *
+ * Results:
+ * The return value is a pointer to the UTF-8 representation of the
+ * Unicode string. Storage for the return value is appended to the
+ * end of dsPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+Tcl_UniCharToUtfDString(wString, numChars, dsPtr)
+ CONST Tcl_UniChar *wString; /* Unicode string to convert to UTF-8. */
+ int numChars; /* Length of Unicode string in Tcl_UniChars
+ * (must be >= 0). */
+ Tcl_DString *dsPtr; /* UTF-8 representation of string is
+ * appended to this previously initialized
+ * DString. */
+{
+ CONST Tcl_UniChar *w, *wEnd;
+ char *p, *string;
+ int oldLength;
+
+ /*
+ * UTF-8 string length in bytes will be <= Unicode string length *
+ * TCL_UTF_MAX.
+ */
+
+ oldLength = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, (oldLength + numChars + 1) * TCL_UTF_MAX);
+ string = Tcl_DStringValue(dsPtr) + oldLength;
+
+ p = string;
+ wEnd = wString + numChars;
+ for (w = wString; w < wEnd; ) {
+ p += Tcl_UniCharToUtf(*w, p);
+ w++;
+ }
+ Tcl_DStringSetLength(dsPtr, oldLength + (p - string));
+
+ return string;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfToUniChar --
+ *
+ * Extract the Tcl_UniChar represented by the UTF-8 string. Bad
+ * UTF-8 sequences are converted to valid Tcl_UniChars and processing
+ * continues. Equivalent to Plan 9 chartorune().
+ *
+ * The caller must ensure that the source buffer is long enough that
+ * this routine does not run off the end and dereference non-existent
+ * memory looking for trail bytes. If the source buffer is known to
+ * be '\0' terminated, this cannot happen. Otherwise, the caller
+ * should call Tcl_UtfCharComplete() before calling this routine to
+ * ensure that enough bytes remain in the string.
+ *
+ * Results:
+ * *chPtr is filled with the Tcl_UniChar, and the return value is the
+ * number of bytes from the UTF-8 string that were consumed.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfToUniChar(str, chPtr)
+ register CONST char *str; /* The UTF-8 string. */
+ register Tcl_UniChar *chPtr; /* Filled with the Tcl_UniChar represented
+ * by the UTF-8 string. */
+{
+ register int byte;
+
+ /*
+ * Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones.
+ */
+
+ byte = *((unsigned char *) str);
+ if (byte < 0xC0) {
+ /*
+ * Handles properly formed UTF-8 characters between 0x01 and 0x7F.
+ * Also treats \0 and naked trail bytes 0x80 to 0xBF as valid
+ * characters representing themselves.
+ */
+
+ *chPtr = (Tcl_UniChar) byte;
+ return 1;
+ } else if (byte < 0xE0) {
+ if ((str[1] & 0xC0) == 0x80) {
+ /*
+ * Two-byte-character lead-byte followed by a trail-byte.
+ */
+
+ *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (str[1] & 0x3F));
+ return 2;
+ }
+ /*
+ * A two-byte-character lead-byte not followed by trail-byte
+ * represents itself.
+ */
+
+ *chPtr = (Tcl_UniChar) byte;
+ return 1;
+ } else if (byte < 0xF0) {
+ if (((str[1] & 0xC0) == 0x80) && ((str[2] & 0xC0) == 0x80)) {
+ /*
+ * Three-byte-character lead byte followed by two trail bytes.
+ */
+
+ *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
+ | ((str[1] & 0x3F) << 6) | (str[2] & 0x3F));
+ return 3;
+ }
+ /*
+ * A three-byte-character lead-byte not followed by two trail-bytes
+ * represents itself.
+ */
+
+ *chPtr = (Tcl_UniChar) byte;
+ return 1;
+ }
+#if TCL_UTF_MAX > 3
+ else {
+ int ch, total, trail;
+
+ total = totalBytes[byte];
+ trail = total - 1;
+ if (trail > 0) {
+ ch = byte & (0x3F >> trail);
+ do {
+ str++;
+ if ((*str & 0xC0) != 0x80) {
+ *chPtr = byte;
+ return 1;
+ }
+ ch <<= 6;
+ ch |= (*str & 0x3F);
+ trail--;
+ } while (trail > 0);
+ *chPtr = ch;
+ return total;
+ }
+ }
+#endif
+
+ *chPtr = (Tcl_UniChar) byte;
+ return 1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfToUniCharDString --
+ *
+ * Convert the UTF-8 string to Unicode.
+ *
+ * Results:
+ * The return value is a pointer to the Unicode representation of the
+ * UTF-8 string. Storage for the return value is appended to the
+ * end of dsPtr. The Unicode string is terminated with a Unicode
+ * NULL character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_UniChar *
+Tcl_UtfToUniCharDString(string, length, dsPtr)
+ CONST char *string; /* UTF-8 string to convert to Unicode. */
+ int length; /* Length of UTF-8 string in bytes, or -1
+ * for strlen(). */
+ Tcl_DString *dsPtr; /* Unicode representation of string is
+ * appended to this previously initialized
+ * DString. */
+{
+ Tcl_UniChar *w, *wString;
+ CONST char *p, *end;
+ int oldLength;
+
+ if (length < 0) {
+ length = strlen(string);
+ }
+
+ /*
+ * Unicode string length in Tcl_UniChars will be <= UTF-8 string length
+ * in bytes.
+ */
+
+ oldLength = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr,
+ (int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
+ wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
+
+ w = wString;
+ end = string + length;
+ for (p = string; p < end; ) {
+ p += Tcl_UtfToUniChar(p, w);
+ w++;
+ }
+ *w = '\0';
+ Tcl_DStringSetLength(dsPtr,
+ (oldLength + ((char *) w - (char *) wString)));
+
+ return wString;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfCharComplete --
+ *
+ * Determine if the UTF-8 string of the given length is long enough
+ * to be decoded by Tcl_UtfToUniChar(). This does not ensure that the
+ * UTF-8 string is properly formed. Equivalent to Plan 9 fullrune().
+ *
+ * Results:
+ * The return value is 0 if the string is not long enough, non-zero
+ * otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfCharComplete(str, len)
+ CONST char *str; /* String to check if first few bytes
+ * contain a complete UTF-8 character. */
+ int len; /* Length of above string in bytes. */
+{
+ int ch;
+
+ ch = *((unsigned char *) str);
+ return len >= totalBytes[ch];
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_NumUtfChars --
+ *
+ * Returns the number of characters (not bytes) in the UTF-8 string,
+ * not including the terminating NULL byte. This is equivalent to
+ * Plan 9 utflen() and utfnlen().
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_NumUtfChars(str, len)
+ register CONST char *str; /* The UTF-8 string to measure. */
+ int len; /* The length of the string in bytes, or -1
+ * for strlen(string). */
+{
+ Tcl_UniChar ch;
+ register Tcl_UniChar *chPtr = &ch;
+ register int n;
+ int i;
+
+ /*
+ * The separate implementations are faster.
+ */
+
+ i = 0;
+ if (len < 0) {
+ while (1) {
+ str += Tcl_UtfToUniChar(str, chPtr);
+ if (ch == '\0') {
+ break;
+ }
+ i++;
+ }
+ } else {
+ while (len > 0) {
+ n = Tcl_UtfToUniChar(str, chPtr);
+ len -= n;
+ str += n;
+ i++;
+ }
+ }
+ return i;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfFindFirst --
+ *
+ * Returns a pointer to the first occurance of the given Tcl_UniChar
+ * in the NULL-terminated UTF-8 string. The NULL terminator is
+ * considered part of the UTF-8 string. Equivalent to Plan 9
+ * utfrune().
+ *
+ * Results:
+ * As above. If the Tcl_UniChar does not exist in the given string,
+ * the return value is NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+char *
+Tcl_UtfFindFirst(string, ch)
+ CONST char *string; /* The UTF-8 string to be searched. */
+ int ch; /* The Tcl_UniChar to search for. */
+{
+ int len;
+ Tcl_UniChar find;
+
+ while (1) {
+ len = Tcl_UtfToUniChar(string, &find);
+ if (find == ch) {
+ return (char *) string;
+ }
+ if (*string == '\0') {
+ return NULL;
+ }
+ string += len;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfFindLast --
+ *
+ * Returns a pointer to the last occurance of the given Tcl_UniChar
+ * in the NULL-terminated UTF-8 string. The NULL terminator is
+ * considered part of the UTF-8 string. Equivalent to Plan 9
+ * utfrrune().
+ *
+ * Results:
+ * As above. If the Tcl_UniChar does not exist in the given string,
+ * the return value is NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+Tcl_UtfFindLast(string, ch)
+ CONST char *string; /* The UTF-8 string to be searched. */
+ int ch; /* The Tcl_UniChar to search for. */
+{
+ int len;
+ Tcl_UniChar find;
+ CONST char *last;
+
+ last = NULL;
+ while (1) {
+ len = Tcl_UtfToUniChar(string, &find);
+ if (find == ch) {
+ last = string;
+ }
+ if (*string == '\0') {
+ break;
+ }
+ string += len;
+ }
+ return (char *) last;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfNext --
+ *
+ * Given a pointer to some current location in a UTF-8 string,
+ * move forward one character. The caller must ensure that they
+ * are not asking for the next character after the last character
+ * in the string.
+ *
+ * Results:
+ * The return value is the pointer to the next character in
+ * the UTF-8 string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+Tcl_UtfNext(str)
+ CONST char *str; /* The current location in the string. */
+{
+ Tcl_UniChar ch;
+
+ return (char *) str + Tcl_UtfToUniChar(str, &ch);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfPrev --
+ *
+ * Given a pointer to some current location in a UTF-8 string,
+ * move backwards one character.
+ *
+ * Results:
+ * The return value is a pointer to the previous character in the
+ * UTF-8 string. If the current location was already at the
+ * beginning of the string, the return value will also be a
+ * pointer to the beginning of the string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+Tcl_UtfPrev(str, start)
+ CONST char *str; /* The current location in the string. */
+ CONST char *start; /* Pointer to the beginning of the
+ * string, to avoid going backwards too
+ * far. */
+{
+ CONST char *look;
+ int i, byte;
+
+ str--;
+ look = str;
+ for (i = 0; i < TCL_UTF_MAX; i++) {
+ if (look < start) {
+ if (str < start) {
+ str = start;
+ }
+ break;
+ }
+ byte = *((unsigned char *) look);
+ if (byte < 0x80) {
+ break;
+ }
+ if (byte >= 0xC0) {
+ if (totalBytes[byte] != i + 1) {
+ break;
+ }
+ return (char *) look;
+ }
+ look--;
+ }
+ return (char *) str;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UniCharAtIndex --
+ *
+ * Returns the Unicode character represented at the specified
+ * character (not byte) position in the UTF-8 string.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_UniChar
+Tcl_UniCharAtIndex(src, index)
+ register CONST char *src; /* The UTF-8 string to dereference. */
+ register int index; /* The position of the desired character. */
+{
+ Tcl_UniChar ch;
+
+ while (index >= 0) {
+ index--;
+ src += Tcl_UtfToUniChar(src, &ch);
+ }
+ return ch;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfAtIndex --
+ *
+ * Returns a pointer to the specified character (not byte) position
+ * in the UTF-8 string.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+Tcl_UtfAtIndex(src, index)
+ register CONST char *src; /* The UTF-8 string. */
+ register int index; /* The position of the desired character. */
+{
+ Tcl_UniChar ch;
+
+ while (index > 0) {
+ index--;
+ src += Tcl_UtfToUniChar(src, &ch);
+ }
+ return (char *) src;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_UtfBackslash --
+ *
+ * Figure out how to handle a backslash sequence.
+ *
+ * Results:
+ * Stores the bytes represented by the backslash sequence in dst and
+ * returns the number of bytes written to dst. At most TCL_UTF_MAX
+ * bytes are written to dst; dst must have been large enough to accept
+ * those bytes. If readPtr isn't NULL then it is filled in with a
+ * count of the number of bytes in the backslash sequence.
+ *
+ * Side effects:
+ * The maximum number of bytes it takes to represent a Unicode
+ * character in UTF-8 is guaranteed to be less than the number of
+ * bytes used to express the backslash sequence that represents
+ * that Unicode character. If the target buffer into which the
+ * caller is going to store the bytes that represent the Unicode
+ * character is at least as large as the source buffer from which
+ * the backslashed sequence was extracted, no buffer overruns should
+ * occur.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfBackslash(src, readPtr, dst)
+ CONST char *src; /* Points to the backslash character of
+ * a backslash sequence. */
+ int *readPtr; /* Fill in with number of characters read
+ * from src, unless NULL. */
+ char *dst; /* Filled with the bytes represented by the
+ * backslash sequence. */
+{
+ register CONST char *p = src+1;
+ int result, count, n;
+ char buf[TCL_UTF_MAX];
+
+ if (dst == NULL) {
+ dst = buf;
+ }
+
+ count = 2;
+ switch (*p) {
+ /*
+ * Note: in the conversions below, use absolute values (e.g.,
+ * 0xa) rather than symbolic values (e.g. \n) that get converted
+ * by the compiler. It's possible that compilers on some
+ * platforms will do the symbolic conversions differently, which
+ * could result in non-portable Tcl scripts.
+ */
+
+ case 'a':
+ result = 0x7;
+ break;
+ case 'b':
+ result = 0x8;
+ break;
+ case 'f':
+ result = 0xc;
+ break;
+ case 'n':
+ result = 0xa;
+ break;
+ case 'r':
+ result = 0xd;
+ break;
+ case 't':
+ result = 0x9;
+ break;
+ case 'v':
+ result = 0xb;
+ break;
+ case 'x':
+ if (isxdigit(UCHAR(p[1]))) { /* INTL: digit */
+ char *end;
+
+ result = (unsigned char) strtoul(p+1, &end, 16);
+ count = end - src;
+ } else {
+ count = 2;
+ result = 'x';
+ }
+ break;
+ case 'u':
+ result = 0;
+ for (count = 0; count < 4; count++) {
+ p++;
+ if (!isxdigit(UCHAR(*p))) { /* INTL: digit */
+ break;
+ }
+ n = *p - '0';
+ if (n > 9) {
+ n = n + '0' + 10 - 'A';
+ }
+ if (n > 16) {
+ n = n + 'A' - 'a';
+ }
+ result = (result << 4) + n;
+ }
+ if (count == 0) {
+ result = 'u';
+ }
+ count += 2;
+ break;
+
+ case '\n':
+ do {
+ p++;
+ } while ((*p == ' ') || (*p == '\t'));
+ result = ' ';
+ count = p - src;
+ break;
+ case 0:
+ result = '\\';
+ count = 1;
+ break;
+ default:
+ /*
+ * Check for an octal number \oo?o?
+ */
+ if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
+ result = (unsigned char)(*p - '0');
+ p++;
+ if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */
+ break;
+ }
+ count = 3;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ p++;
+ if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */
+ break;
+ }
+ count = 4;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ break;
+ }
+ result = *p;
+ count = 2;
+ break;
+ }
+
+ if (readPtr != NULL) {
+ *readPtr = count;
+ }
+ return Tcl_UniCharToUtf(result, dst);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UtfToUpper --
+ *
+ * Convert lowercase characters to uppercase characters in a UTF
+ * string in place. The conversion may shrink the UTF string.
+ *
+ * Results:
+ * Returns the number of bytes in the resulting string
+ * excluding the trailing null.
+ *
+ * Side effects:
+ * Writes a terminating null after the last converted character.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfToUpper(str)
+ char *str; /* String to convert in place. */
+{
+ Tcl_UniChar ch, upChar;
+ char *src, *dst;
+ int bytes;
+
+ /*
+ * Iterate over the string until we hit the terminating null.
+ */
+
+ src = dst = str;
+ while (*src) {
+ bytes = Tcl_UtfToUniChar(src, &ch);
+ upChar = Tcl_UniCharToUpper(ch);
+
+ /*
+ * To keep badly formed Utf strings from getting inflated by
+ * the conversion (thereby causing a segfault), only copy the
+ * upper case char to dst if its size is <= the original char.
+ */
+
+ if (bytes < UtfCount(upChar)) {
+ memcpy(dst, src, (size_t) bytes);
+ dst += bytes;
+ } else {
+ dst += Tcl_UniCharToUtf(upChar, dst);
+ }
+ src += bytes;
+ }
+ *dst = '\0';
+ return (dst - str);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UtfToLower --
+ *
+ * Convert uppercase characters to lowercase characters in a UTF
+ * string in place. The conversion may shrink the UTF string.
+ *
+ * Results:
+ * Returns the number of bytes in the resulting string
+ * excluding the trailing null.
+ *
+ * Side effects:
+ * Writes a terminating null after the last converted character.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfToLower(str)
+ char *str; /* String to convert in place. */
+{
+ Tcl_UniChar ch, lowChar;
+ char *src, *dst;
+ int bytes;
+
+ /*
+ * Iterate over the string until we hit the terminating null.
+ */
+
+ src = dst = str;
+ while (*src) {
+ bytes = Tcl_UtfToUniChar(src, &ch);
+ lowChar = Tcl_UniCharToLower(ch);
+
+ /*
+ * To keep badly formed Utf strings from getting inflated by
+ * the conversion (thereby causing a segfault), only copy the
+ * lower case char to dst if its size is <= the original char.
+ */
+
+ if (bytes < UtfCount(lowChar)) {
+ memcpy(dst, src, (size_t) bytes);
+ dst += bytes;
+ } else {
+ dst += Tcl_UniCharToUtf(lowChar, dst);
+ }
+ src += bytes;
+ }
+ *dst = '\0';
+ return (dst - str);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UtfToTitle --
+ *
+ * Changes the first character of a UTF string to title case or
+ * uppercase and the rest of the string to lowercase. The
+ * conversion happens in place and may shrink the UTF string.
+ *
+ * Results:
+ * Returns the number of bytes in the resulting string
+ * excluding the trailing null.
+ *
+ * Side effects:
+ * Writes a terminating null after the last converted character.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfToTitle(str)
+ char *str; /* String to convert in place. */
+{
+ Tcl_UniChar ch, titleChar, lowChar;
+ char *src, *dst;
+ int bytes;
+
+ /*
+ * Capitalize the first character and then lowercase the rest of the
+ * characters until we get to a null.
+ */
+
+ src = dst = str;
+
+ if (*src) {
+ bytes = Tcl_UtfToUniChar(src, &ch);
+ titleChar = Tcl_UniCharToTitle(ch);
+
+ if (bytes < UtfCount(titleChar)) {
+ memcpy(dst, src, (size_t) bytes);
+ dst += bytes;
+ } else {
+ dst += Tcl_UniCharToUtf(titleChar, dst);
+ }
+ src += bytes;
+ }
+ while (*src) {
+ bytes = Tcl_UtfToUniChar(src, &ch);
+ lowChar = Tcl_UniCharToLower(ch);
+
+ if (bytes < UtfCount(lowChar)) {
+ memcpy(dst, src, (size_t) bytes);
+ dst += bytes;
+ } else {
+ dst += Tcl_UniCharToUtf(lowChar, dst);
+ }
+ src += bytes;
+ }
+ *dst = '\0';
+ return (dst - str);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UtfNcmp --
+ *
+ * Compare at most n UTF chars of string cs to string ct. Both cs
+ * and ct are assumed to be at least n UTF chars long.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfNcmp(cs, ct, n)
+ CONST char *cs; /* UTF string to compare to ct. */
+ CONST char *ct; /* UTF string cs is compared to. */
+ unsigned long n; /* Number of UTF chars to compare. */
+{
+ Tcl_UniChar ch1, ch2;
+ /*
+ * Another approach that should work is:
+ * return memcmp(cs, ct, (unsigned) (Tcl_UtfAtIndex(cs, n) - cs));
+ * That assumes that ct is a properly formed UTF, so we will just
+ * be comparing the bytes that compromise those strings to the
+ * char length n.
+ */
+ while (n-- > 0) {
+ /*
+ * n must be interpreted as chars, not bytes.
+ * This should be called only when both strings are of
+ * at least n chars long (no need for \0 check)
+ */
+ cs += Tcl_UtfToUniChar(cs, &ch1);
+ ct += Tcl_UtfToUniChar(ct, &ch2);
+ if (ch1 != ch2) {
+ return (ch1 - ch2);
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UtfNcasecmp --
+ *
+ * Compare at most n UTF chars of string cs to string ct case
+ * insensitive. Both cs and ct are assumed to be at least n
+ * UTF chars long.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UtfNcasecmp(cs, ct, n)
+ CONST char *cs; /* UTF string to compare to ct. */
+ CONST char *ct; /* UTF string cs is compared to. */
+ unsigned long n; /* Number of UTF chars to compare. */
+{
+ Tcl_UniChar ch1, ch2;
+ while (n-- > 0) {
+ /*
+ * n must be interpreted as chars, not bytes.
+ * This should be called only when both strings are of
+ * at least n chars long (no need for \0 check)
+ */
+ cs += Tcl_UtfToUniChar(cs, &ch1);
+ ct += Tcl_UtfToUniChar(ct, &ch2);
+ if (ch1 != ch2) {
+ ch1 = Tcl_UniCharToLower(ch1);
+ ch2 = Tcl_UniCharToLower(ch2);
+ if (ch1 != ch2) {
+ return (ch1 - ch2);
+ }
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharToUpper --
+ *
+ * Compute the uppercase equivalent of the given Unicode character.
+ *
+ * Results:
+ * Returns the uppercase Unicode character.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_UniChar
+Tcl_UniCharToUpper(ch)
+ int ch; /* Unicode character to convert. */
+{
+ int info = GetUniCharInfo(ch);
+
+ if (GetCaseType(info) & 0x04) {
+ return (Tcl_UniChar) (ch - GetDelta(info));
+ } else {
+ return ch;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharToLower --
+ *
+ * Compute the lowercase equivalent of the given Unicode character.
+ *
+ * Results:
+ * Returns the lowercase Unicode character.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_UniChar
+Tcl_UniCharToLower(ch)
+ int ch; /* Unicode character to convert. */
+{
+ int info = GetUniCharInfo(ch);
+
+ if (GetCaseType(info) & 0x02) {
+ return (Tcl_UniChar) (ch + GetDelta(info));
+ } else {
+ return ch;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharToTitle --
+ *
+ * Compute the titlecase equivalent of the given Unicode character.
+ *
+ * Results:
+ * Returns the titlecase Unicode character.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_UniChar
+Tcl_UniCharToTitle(ch)
+ int ch; /* Unicode character to convert. */
+{
+ int info = GetUniCharInfo(ch);
+ int mode = GetCaseType(info);
+
+ if (mode & 0x1) {
+ /*
+ * Subtract or add one depending on the original case.
+ */
+
+ return (Tcl_UniChar) (ch + ((mode & 0x4) ? -1 : 1));
+ } else if (mode == 0x4) {
+ return (Tcl_UniChar) (ch - GetDelta(info));
+ } else {
+ return ch;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharLen --
+ *
+ * Find the length of a UniChar string. The str input must be null
+ * terminated.
+ *
+ * Results:
+ * Returns the length of str in UniChars (not bytes).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharLen(str)
+ Tcl_UniChar *str; /* Unicode string to find length of. */
+{
+ int len = 0;
+
+ while (*str != '\0') {
+ len++;
+ str++;
+ }
+ return len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharNcmp --
+ *
+ * Compare at most n unichars of string cs to string ct. Both cs
+ * and ct are assumed to be at least n unichars long.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharNcmp(cs, ct, n)
+ CONST Tcl_UniChar *cs; /* Unicode string to compare to ct. */
+ CONST Tcl_UniChar *ct; /* Unicode string cs is compared to. */
+ unsigned long n; /* Number of unichars to compare. */
+{
+ for ( ; n != 0; n--, cs++, ct++) {
+ if (*cs != *ct) {
+ return *cs - *ct;
+ }
+ if (*cs == '\0') {
+ break;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsAlnum --
+ *
+ * Test if a character is an alphanumeric Unicode character.
+ *
+ * Results:
+ * Returns 1 if character is alphanumeric.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsAlnum(ch)
+ int ch; /* Unicode character to test. */
+{
+ register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
+
+ return (((ALPHA_BITS | DIGIT_BITS) >> category) & 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsAlpha --
+ *
+ * Test if a character is an alphabetic Unicode character.
+ *
+ * Results:
+ * Returns 1 if character is alphabetic.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsAlpha(ch)
+ int ch; /* Unicode character to test. */
+{
+ register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
+ return ((ALPHA_BITS >> category) & 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsControl --
+ *
+ * Test if a character is a Unicode control character.
+ *
+ * Results:
+ * Returns non-zero if character is a control.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsControl(ch)
+ int ch; /* Unicode character to test. */
+{
+ return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == CONTROL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsDigit --
+ *
+ * Test if a character is a numeric Unicode character.
+ *
+ * Results:
+ * Returns non-zero if character is a digit.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsDigit(ch)
+ int ch; /* Unicode character to test. */
+{
+ return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK)
+ == DECIMAL_DIGIT_NUMBER);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsGraph --
+ *
+ * Test if a character is any Unicode print character except space.
+ *
+ * Results:
+ * Returns non-zero if character is printable, but not space.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsGraph(ch)
+ int ch; /* Unicode character to test. */
+{
+ register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
+ return (((PRINT_BITS >> category) & 1) && ((unsigned char) ch != ' '));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsLower --
+ *
+ * Test if a character is a lowercase Unicode character.
+ *
+ * Results:
+ * Returns non-zero if character is lowercase.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsLower(ch)
+ int ch; /* Unicode character to test. */
+{
+ return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == LOWERCASE_LETTER);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsPrint --
+ *
+ * Test if a character is a Unicode print character.
+ *
+ * Results:
+ * Returns non-zero if character is printable.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsPrint(ch)
+ int ch; /* Unicode character to test. */
+{
+ register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
+ return ((PRINT_BITS >> category) & 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsPunct --
+ *
+ * Test if a character is a Unicode punctuation character.
+ *
+ * Results:
+ * Returns non-zero if character is punct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsPunct(ch)
+ int ch; /* Unicode character to test. */
+{
+ register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
+ return ((PUNCT_BITS >> category) & 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsSpace --
+ *
+ * Test if a character is a whitespace Unicode character.
+ *
+ * Results:
+ * Returns non-zero if character is a space.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsSpace(ch)
+ int ch; /* Unicode character to test. */
+{
+ register int category;
+
+ /*
+ * If the character is within the first 127 characters, just use the
+ * standard C function, otherwise consult the Unicode table.
+ */
+
+ if (ch < 0x80) {
+ return isspace(UCHAR(ch)); /* INTL: ISO space */
+ } else {
+ category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
+ return ((SPACE_BITS >> category) & 1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsUpper --
+ *
+ * Test if a character is a uppercase Unicode character.
+ *
+ * Results:
+ * Returns non-zero if character is uppercase.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsUpper(ch)
+ int ch; /* Unicode character to test. */
+{
+ return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == UPPERCASE_LETTER);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharIsWordChar --
+ *
+ * Test if a character is alphanumeric or a connector punctuation
+ * mark.
+ *
+ * Results:
+ * Returns 1 if character is a word character.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharIsWordChar(ch)
+ int ch; /* Unicode character to test. */
+{
+ register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
+
+ return (((ALPHA_BITS | DIGIT_BITS | CONNECTOR_BITS) >> category) & 1);
+}
diff --git a/tcl/generic/tclUtil.c b/tcl/generic/tclUtil.c
index ef60a9d4755..041036b80fd 100644
--- a/tcl/generic/tclUtil.c
+++ b/tcl/generic/tclUtil.c
@@ -5,7 +5,7 @@
* commands.
*
* Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -22,8 +22,9 @@
* know. The value of the variable is set by the procedure
* Tcl_FindExecutable. The storage space is dynamically allocated.
*/
-
+
char *tclExecutableName = NULL;
+char *tclNativeExecutableName = NULL;
/*
* The following values are used in the flags returned by Tcl_ScanElement
@@ -51,8 +52,6 @@ char *tclExecutableName = NULL;
* floating-point values to strings. This information is linked to all
* of the tcl_precision variables in all interpreters via the procedure
* TclPrecTraceProc.
- *
- * NOTE: these variables are not thread-safe.
*/
static char precisionString[10] = "12";
@@ -61,14 +60,8 @@ static char precisionString[10] = "12";
static char precisionFormat[10] = "%.12g";
/* The format string actually used in calls
* to sprintf. */
+TCL_DECLARE_MUTEX(precisionMutex)
-
-/*
- * Function prototypes for local procedures in this file:
- */
-
-static void SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
- int newSpace));
/*
*----------------------------------------------------------------------
@@ -82,7 +75,7 @@ static void SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
* The return value is normally TCL_OK, which means that the
* element was successfully located. If TCL_ERROR is returned
* it means that list didn't have proper list structure;
- * interp->result contains a more detailed error message.
+ * the interp's result contains a more detailed error message.
*
* If TCL_OK is returned, then *elementPtr will be set to point to the
* first element of list, and *nextPtr will be set to point to the
@@ -110,13 +103,13 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
Tcl_Interp *interp; /* Interpreter to use for error reporting.
* If NULL, then no error message is left
* after errors. */
- char *list; /* Points to the first byte of a string
+ CONST char *list; /* Points to the first byte of a string
* containing a Tcl list with zero or more
* elements (possibly in braces). */
int listLength; /* Number of bytes in the list's string. */
- char **elementPtr; /* Where to put address of first significant
+ CONST char **elementPtr; /* Where to put address of first significant
* character in first element of list. */
- char **nextPtr; /* Fill in with location of character just
+ CONST char **nextPtr; /* Fill in with location of character just
* after all white space following end of
* argument (next arg or end of list). */
int *sizePtr; /* If non-zero, fill in with size of
@@ -125,26 +118,23 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
* to indicate that arg was/wasn't
* in braces. */
{
- char *p = list;
- char *elemStart; /* Points to first byte of first element. */
- char *limit; /* Points just after list's last byte. */
+ CONST char *p = list;
+ CONST char *elemStart; /* Points to first byte of first element. */
+ CONST char *limit; /* Points just after list's last byte. */
int openBraces = 0; /* Brace nesting level during parse. */
int inQuotes = 0;
- int size = 0; /* Init. avoids compiler warning. */
+ int size = 0; /* lint. */
int numChars;
- char *p2;
+ CONST char *p2;
/*
* Skim off leading white space and check for an opening brace or
* quote. We treat embedded NULLs in the list as bytes belonging to
- * a list element. Note: use of "isascii" below and elsewhere in this
- * procedure is a temporary hack (7/27/90) because Mx uses characters
- * with the high-order bit set for some things. This should probably
- * be changed back eventually, or all of Tcl should call isascii.
+ * a list element.
*/
limit = (list + listLength);
- while ((p < limit) && (isspace(UCHAR(*p)))) {
+ while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
p++;
}
if (p == limit) { /* no element found */
@@ -193,7 +183,8 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
} else if (openBraces == 1) {
size = (p - elemStart);
p++;
- if ((p >= limit) || isspace(UCHAR(*p))) {
+ if ((p >= limit)
+ || isspace(UCHAR(*p))) { /* INTL: ISO space. */
goto done;
}
@@ -205,7 +196,8 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
char buf[100];
p2 = p;
- while ((p2 < limit) && (!isspace(UCHAR(*p2)))
+ while ((p2 < limit)
+ && (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
&& (p2 < p+20)) {
p2++;
}
@@ -224,7 +216,7 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
case '\\': {
- (void) Tcl_Backslash(p, &numChars);
+ Tcl_UtfBackslash(p, &numChars, NULL);
p += (numChars - 1);
break;
}
@@ -254,7 +246,8 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
if (inQuotes) {
size = (p - elemStart);
p++;
- if ((p >= limit) || isspace(UCHAR(*p))) {
+ if ((p >= limit)
+ || isspace(UCHAR(*p))) { /* INTL: ISO space */
goto done;
}
@@ -266,7 +259,8 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
char buf[100];
p2 = p;
- while ((p2 < limit) && (!isspace(UCHAR(*p2)))
+ while ((p2 < limit)
+ && (!isspace(UCHAR(*p2))) /* INTL: ISO space */
&& (p2 < p+20)) {
p2++;
}
@@ -305,7 +299,7 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
}
done:
- while ((p < limit) && (isspace(UCHAR(*p)))) {
+ while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
p++;
}
*elementPtr = elemStart;
@@ -339,20 +333,21 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
int
TclCopyAndCollapse(count, src, dst)
int count; /* Number of characters to copy from src. */
- char *src; /* Copy from here... */
+ CONST char *src; /* Copy from here... */
char *dst; /* ... to here. */
{
- char c;
+ register char c;
int numRead;
int newCount = 0;
+ int backslashCount;
for (c = *src; count > 0; src++, c = *src, count--) {
if (c == '\\') {
- *dst = Tcl_Backslash(src, &numRead);
- dst++;
+ backslashCount = Tcl_UtfBackslash(src, &numRead, dst);
+ dst += backslashCount;
+ newCount += backslashCount;
src += numRead-1;
count -= numRead-1;
- newCount++;
} else {
*dst = c;
dst++;
@@ -374,7 +369,7 @@ TclCopyAndCollapse(count, src, dst)
* The return value is normally TCL_OK, which means that
* the list was successfully split up. If TCL_ERROR is
* returned, it means that "list" didn't have proper list
- * structure; interp->result will contain a more detailed
+ * structure; the interp's result will contain a more detailed
* error message.
*
* *argvPtr will be filled in with the address of an array
@@ -397,16 +392,17 @@ int
Tcl_SplitList(interp, list, argcPtr, argvPtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting.
* If NULL, no error message is left. */
- char *list; /* Pointer to string with list structure. */
+ CONST char *list; /* Pointer to string with list structure. */
int *argcPtr; /* Pointer to location to fill in with
* the number of elements in the list. */
char ***argvPtr; /* Pointer to place to store pointer to
* array of pointers to list elements. */
{
char **argv;
+ CONST char *l;
char *p;
int length, size, i, result, elSize, brace;
- char *element;
+ CONST char *element;
/*
* Figure out how much space to allocate. There must be enough
@@ -415,18 +411,18 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
* the number of space characters in the list.
*/
- for (size = 1, p = list; *p != 0; p++) {
- if (isspace(UCHAR(*p))) {
+ for (size = 1, l = list; *l != 0; l++) {
+ if (isspace(UCHAR(*l))) { /* INTL: ISO space. */
size++;
}
}
size++; /* Leave space for final NULL pointer. */
argv = (char **) ckalloc((unsigned)
- ((size * sizeof(char *)) + (p - list) + 1));
+ ((size * sizeof(char *)) + (l - list) + 1));
length = strlen(list);
for (i = 0, p = ((char *) argv) + size*sizeof(char *);
*list != 0; i++) {
- char *prevList = list;
+ CONST char *prevList = list;
result = TclFindElement(interp, list, length, &element,
&list, &elSize, &brace);
@@ -489,9 +485,9 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
int
Tcl_ScanElement(string, flagPtr)
- CONST char *string; /* String to convert to Tcl list element. */
- int *flagPtr; /* Where to store information to guide
- * Tcl_ConvertCountedElement. */
+ register CONST char *string; /* String to convert to list element. */
+ register int *flagPtr; /* Where to store information to guide
+ * Tcl_ConvertCountedElement. */
{
return Tcl_ScanCountedElement(string, -1, flagPtr);
}
@@ -529,7 +525,7 @@ Tcl_ScanCountedElement(string, length, flagPtr)
* Tcl_ConvertElement. */
{
int flags, nestingLevel;
- CONST char *p, *lastChar;
+ register CONST char *p, *lastChar;
/*
* This procedure and Tcl_ConvertElement together do two things:
@@ -585,7 +581,7 @@ Tcl_ScanCountedElement(string, length, flagPtr)
if ((p == lastChar) || (*p == '{') || (*p == '"')) {
flags |= USE_BRACES;
}
- for ( ; p != lastChar; p++) {
+ for ( ; p < lastChar; p++) {
switch (*p) {
case '{':
nestingLevel++;
@@ -613,7 +609,7 @@ Tcl_ScanCountedElement(string, length, flagPtr)
} else {
int size;
- (void) Tcl_Backslash(p, &size);
+ Tcl_UtfBackslash(p, &size, NULL);
p += size-1;
flags |= USE_BRACES;
}
@@ -657,9 +653,9 @@ Tcl_ScanCountedElement(string, length, flagPtr)
int
Tcl_ConvertElement(src, dst, flags)
- CONST char *src; /* Source information for list element. */
- char *dst; /* Place to put list-ified element. */
- int flags; /* Flags produced by Tcl_ScanElement. */
+ register CONST char *src; /* Source information for list element. */
+ register char *dst; /* Place to put list-ified element. */
+ register int flags; /* Flags produced by Tcl_ScanElement. */
{
return Tcl_ConvertCountedElement(src, -1, dst, flags);
}
@@ -689,13 +685,13 @@ Tcl_ConvertElement(src, dst, flags)
int
Tcl_ConvertCountedElement(src, length, dst, flags)
- CONST char *src; /* Source information for list element. */
+ register CONST char *src; /* Source information for list element. */
int length; /* Number of bytes in src, or -1. */
char *dst; /* Place to put list-ified element. */
int flags; /* Flags produced by Tcl_ScanElement. */
{
- char *p = dst;
- CONST char *lastChar;
+ register char *p = dst;
+ register CONST char *lastChar;
/*
* See the comment block at the beginning of the Tcl_ScanElement
@@ -876,6 +872,40 @@ Tcl_Merge(argc, argv)
/*
*----------------------------------------------------------------------
*
+ * Tcl_Backslash --
+ *
+ * Figure out how to handle a backslash sequence.
+ *
+ * Results:
+ * The return value is the character that should be substituted
+ * in place of the backslash sequence that starts at src. If
+ * readPtr isn't NULL then it is filled in with a count of the
+ * number of characters in the backslash sequence.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char
+Tcl_Backslash(src, readPtr)
+ CONST char *src; /* Points to the backslash character of
+ * a backslash sequence. */
+ int *readPtr; /* Fill in with number of characters read
+ * from src, unless NULL. */
+{
+ char buf[TCL_UTF_MAX];
+ Tcl_UniChar ch;
+
+ Tcl_UtfBackslash(src, readPtr, buf);
+ Tcl_UtfToUniChar(buf, &ch);
+ return (char) ch;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_Concat --
*
* Concatenate a set of strings into a single large string.
@@ -920,13 +950,14 @@ Tcl_Concat(argc, argv)
*/
element = argv[i];
- while (isspace(UCHAR(*element))) {
+ while (isspace(UCHAR(*element))) { /* INTL: ISO space. */
element++;
}
for (length = strlen(element);
- (length > 0) && (isspace(UCHAR(element[length-1])))
+ (length > 0)
+ && (isspace(UCHAR(element[length-1]))) /* INTL: ISO space. */
&& ((length < 2) || (element[length-2] != '\\'));
- length--) {
+ length--) {
/* Null loop body. */
}
if (length == 0) {
@@ -974,10 +1005,42 @@ Tcl_ConcatObj(objc, objv)
char *concatStr;
Tcl_Obj *objPtr;
+ /*
+ * Check first to see if all the items are of list type. If so,
+ * we will concat them together as lists, and return a list object.
+ * This is only valid when the lists have no current string
+ * representation, since we don't know what the original type was.
+ * An original string rep may have lost some whitespace info when
+ * converted which could be important.
+ */
+ for (i = 0; i < objc; i++) {
+ objPtr = objv[i];
+ if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {
+ break;
+ }
+ }
+ if (i == objc) {
+ Tcl_Obj **listv;
+ int listc;
+
+ objPtr = Tcl_NewListObj(0, NULL);
+ for (i = 0; i < objc; i++) {
+ /*
+ * Tcl_ListObjAppendList could be used here, but this saves
+ * us a bit of type checking (since we've already done it)
+ * Use of INT_MAX tells us to always put the new stuff on
+ * the end. It will be set right in Tcl_ListObjReplace.
+ */
+ Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);
+ Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);
+ }
+ return objPtr;
+ }
+
allocSize = 0;
for (i = 0; i < objc; i++) {
objPtr = objv[i];
- element = TclGetStringFromObj(objPtr, &length);
+ element = Tcl_GetStringFromObj(objPtr, &length);
if ((element != NULL) && (length > 0)) {
allocSize += (length + 1);
}
@@ -1007,8 +1070,9 @@ Tcl_ConcatObj(objc, objv)
p = concatStr;
for (i = 0; i < objc; i++) {
objPtr = objv[i];
- element = TclGetStringFromObj(objPtr, &elemLength);
- while ((elemLength > 0) && (isspace(UCHAR(*element)))) {
+ element = Tcl_GetStringFromObj(objPtr, &elemLength);
+ while ((elemLength > 0)
+ && (isspace(UCHAR(*element)))) { /* INTL: ISO space. */
element++;
elemLength--;
}
@@ -1020,7 +1084,7 @@ Tcl_ConcatObj(objc, objv)
*/
while ((elemLength > 0)
- && isspace(UCHAR(element[elemLength-1]))
+ && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO space. */
&& ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
elemLength--;
}
@@ -1068,26 +1132,31 @@ Tcl_ConcatObj(objc, objv)
int
Tcl_StringMatch(string, pattern)
- char *string; /* String. */
- char *pattern; /* Pattern, which may contain special
+ CONST char *string; /* String. */
+ CONST char *pattern; /* Pattern, which may contain special
* characters. */
{
- char c2;
-
+ int p, s;
+ CONST char *pstart = pattern;
+
while (1) {
- /* See if we're at the end of both the pattern and the string.
- * If so, we succeeded. If we're at the end of the pattern
- * but not at the end of the string, we failed.
+ p = *pattern;
+ s = *string;
+
+ /*
+ * See if we're at the end of both the pattern and the string. If
+ * so, we succeeded. If we're at the end of the pattern but not at
+ * the end of the string, we failed.
*/
- if (*pattern == 0) {
- if (*string == 0) {
+ if (p == '\0') {
+ if (s == '\0') {
return 1;
} else {
return 0;
}
}
- if ((*string == 0) && (*pattern != '*')) {
+ if ((s == '\0') && (p != '*')) {
return 0;
}
@@ -1097,28 +1166,32 @@ Tcl_StringMatch(string, pattern)
* match or we reach the end of the string.
*/
- if (*pattern == '*') {
- pattern += 1;
- if (*pattern == 0) {
+ if (p == '*') {
+ pattern++;
+ if (*pattern == '\0') {
return 1;
}
while (1) {
if (Tcl_StringMatch(string, pattern)) {
return 1;
}
- if (*string == 0) {
+ if (*string == '\0') {
return 0;
}
- string += 1;
+ string++;
}
}
-
+
/* Check for a "?" as the next pattern character. It matches
* any single character.
*/
- if (*pattern == '?') {
- goto thisCharOK;
+ if (p == '?') {
+ Tcl_UniChar ch;
+
+ pattern++;
+ string += Tcl_UtfToUniChar(string, &ch);
+ continue;
}
/* Check for a "[" as the next pattern character. It is followed
@@ -1126,901 +1199,229 @@ Tcl_StringMatch(string, pattern)
* (two characters separated by "-").
*/
- if (*pattern == '[') {
- pattern += 1;
+ if (p == '[') {
+ Tcl_UniChar ch, startChar, endChar;
+
+ pattern++;
+ string += Tcl_UtfToUniChar(string, &ch);
+
while (1) {
- if ((*pattern == ']') || (*pattern == 0)) {
+ if ((*pattern == ']') || (*pattern == '\0')) {
return 0;
}
- if (*pattern == *string) {
- break;
- }
- if (pattern[1] == '-') {
- c2 = pattern[2];
- if (c2 == 0) {
+ pattern += Tcl_UtfToUniChar(pattern, &startChar);
+ if (*pattern == '-') {
+ pattern++;
+ if (*pattern == '\0') {
return 0;
}
- if ((*pattern <= *string) && (c2 >= *string)) {
- break;
- }
- if ((*pattern >= *string) && (c2 <= *string)) {
+ pattern += Tcl_UtfToUniChar(pattern, &endChar);
+ if (((startChar <= ch) && (ch <= endChar))
+ || ((endChar <= ch) && (ch <= startChar))) {
+ /*
+ * Matches ranges of form [a-z] or [z-a].
+ */
+
break;
}
- pattern += 2;
+ } else if (startChar == ch) {
+ break;
}
- pattern += 1;
}
while (*pattern != ']') {
- if (*pattern == 0) {
- pattern--;
+ if (*pattern == '\0') {
+ pattern = Tcl_UtfPrev(pattern, pstart);
break;
}
- pattern += 1;
+ pattern++;
}
- goto thisCharOK;
+ pattern++;
+ continue;
}
- /* If the next pattern character is '/', just strip off the '/'
+ /* If the next pattern character is '\', just strip off the '\'
* so we do exact matching on the character that follows.
*/
- if (*pattern == '\\') {
- pattern += 1;
- if (*pattern == 0) {
+ if (p == '\\') {
+ pattern++;
+ p = *pattern;
+ if (p == '\0') {
return 0;
}
}
/* There's no special character. Just make sure that the next
- * characters of each string match.
+ * bytes of each string match.
*/
- if (*pattern != *string) {
+ if (s != p) {
return 0;
}
-
- thisCharOK: pattern += 1;
- string += 1;
+ pattern++;
+ string++;
}
}
/*
*----------------------------------------------------------------------
*
- * Tcl_SetResult --
- *
- * Arrange for "string" to be the Tcl return value.
- *
- * Results:
- * None.
- *
- * Side effects:
- * interp->result is left pointing either to "string" (if "copy" is 0)
- * or to a copy of string. Also, the object result is reset.
+ * Tcl_StringCaseMatch --
*
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetResult(interp, string, freeProc)
- Tcl_Interp *interp; /* Interpreter with which to associate the
- * return value. */
- char *string; /* Value to be returned. If NULL, the
- * result is set to an empty string. */
- Tcl_FreeProc *freeProc; /* Gives information about the string:
- * TCL_STATIC, TCL_VOLATILE, or the address
- * of a Tcl_FreeProc such as free. */
-{
- Interp *iPtr = (Interp *) interp;
- int length;
- Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
- char *oldResult = iPtr->result;
-
- if (string == NULL) {
- iPtr->resultSpace[0] = 0;
- iPtr->result = iPtr->resultSpace;
- iPtr->freeProc = 0;
- } else if (freeProc == TCL_VOLATILE) {
- length = strlen(string);
- if (length > TCL_RESULT_SIZE) {
- iPtr->result = (char *) ckalloc((unsigned) length+1);
- iPtr->freeProc = TCL_DYNAMIC;
- } else {
- iPtr->result = iPtr->resultSpace;
- iPtr->freeProc = 0;
- }
- strcpy(iPtr->result, string);
- } else {
- iPtr->result = string;
- iPtr->freeProc = freeProc;
- }
-
- /*
- * If the old result was dynamically-allocated, free it up. Do it
- * here, rather than at the beginning, in case the new result value
- * was part of the old result value.
- */
-
- if (oldFreeProc != 0) {
- if ((oldFreeProc == TCL_DYNAMIC)
- || (oldFreeProc == (Tcl_FreeProc *) free)) {
- ckfree(oldResult);
- } else {
- (*oldFreeProc)(oldResult);
- }
- }
-
- /*
- * Reset the object result since we just set the string result.
- */
-
- TclResetObjResult(iPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetStringResult --
- *
- * Returns an interpreter's result value as a string.
+ * See if a particular string matches a particular pattern.
+ * Allows case insensitivity.
*
* Results:
- * The interpreter's result as a string.
+ * The return value is 1 if string matches pattern, and
+ * 0 otherwise. The matching operation permits the following
+ * special characters in the pattern: *?\[] (see the manual
+ * entry for details on what these mean).
*
* Side effects:
- * If the string result is empty, the object result is moved to the
- * string result, then the object result is reset.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-Tcl_GetStringResult(interp)
- Tcl_Interp *interp; /* Interpreter whose result to return. */
-{
- /*
- * If the string result is empty, move the object result to the
- * string result, then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
- */
-
- if (*(interp->result) == 0) {
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
- TCL_VOLATILE);
- }
- return interp->result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetObjResult --
- *
- * Arrange for objPtr to be an interpreter's result value.
- *
- * Results:
* None.
*
- * Side effects:
- * interp->objResultPtr is left pointing to the object referenced
- * by objPtr. The object's reference count is incremented since
- * there is now a new reference to it. The reference count for any
- * old objResultPtr value is decremented. Also, the string result
- * is reset.
- *
*----------------------------------------------------------------------
*/
-void
-Tcl_SetObjResult(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter with which to associate the
- * return object value. */
- Tcl_Obj *objPtr; /* Tcl object to be returned. If NULL, the
- * obj result is made an empty string
- * object. */
+int
+Tcl_StringCaseMatch(string, pattern, nocase)
+ CONST char *string; /* String. */
+ CONST char *pattern; /* Pattern, which may contain special
+ * characters. */
+ int nocase; /* 0 for case sensitive, 1 for insensitive */
{
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj *oldObjResult = iPtr->objResultPtr;
-
- iPtr->objResultPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* since interp result is a reference */
-
- /*
- * We wait until the end to release the old object result, in case
- * we are setting the result to itself.
- */
+ int p, s;
+ CONST char *pstart = pattern;
+ Tcl_UniChar ch1, ch2;
- TclDecrRefCount(oldObjResult);
-
- /*
- * Reset the string result since we just set the result object.
- */
-
- if (iPtr->freeProc != NULL) {
- if ((iPtr->freeProc == TCL_DYNAMIC)
- || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
- ckfree(iPtr->result);
- } else {
- (*iPtr->freeProc)(iPtr->result);
- }
- iPtr->freeProc = 0;
- }
- iPtr->result = iPtr->resultSpace;
- iPtr->resultSpace[0] = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetObjResult --
- *
- * Returns an interpreter's result value as a Tcl object. The object's
- * reference count is not modified; the caller must do that if it
- * needs to hold on to a long-term reference to it.
- *
- * Results:
- * The interpreter's result as an object.
- *
- * Side effects:
- * If the interpreter has a non-empty string result, the result object
- * is either empty or stale because some procedure set interp->result
- * directly. If so, the string result is moved to the result object
- * then the string result is reset.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-Tcl_GetObjResult(interp)
- Tcl_Interp *interp; /* Interpreter whose result to return. */
-{
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj *objResultPtr;
- int length;
-
- /*
- * If the string result is non-empty, move the string result to the
- * object result, then reset the string result.
- */
-
- if (*(iPtr->result) != 0) {
- TclResetObjResult(iPtr);
+ while (1) {
+ p = *pattern;
+ s = *string;
- objResultPtr = iPtr->objResultPtr;
- length = strlen(iPtr->result);
- TclInitStringRep(objResultPtr, iPtr->result, length);
+ /*
+ * See if we're at the end of both the pattern and the string. If
+ * so, we succeeded. If we're at the end of the pattern but not at
+ * the end of the string, we failed.
+ */
- if (iPtr->freeProc != NULL) {
- if ((iPtr->freeProc == TCL_DYNAMIC)
- || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
- ckfree(iPtr->result);
- } else {
- (*iPtr->freeProc)(iPtr->result);
- }
- iPtr->freeProc = 0;
+ if (p == '\0') {
+ return (s == '\0');
}
- iPtr->result = iPtr->resultSpace;
- iPtr->resultSpace[0] = 0;
- }
- return iPtr->objResultPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AppendResult --
- *
- * Append a variable number of strings onto the interpreter's string
- * result.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The result of the interpreter given by the first argument is
- * extended by the strings given by the second and following arguments
- * (up to a terminating NULL argument).
- *
- * If the string result is empty, the object result is moved to the
- * string result, then the object result is reset.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
-{
- va_list argList;
- Interp *iPtr;
- char *string;
- int newSpace;
-
- /*
- * If the string result is empty, move the object result to the
- * string result, then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
- */
-
- iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
- if (*(iPtr->result) == 0) {
- Tcl_SetResult((Tcl_Interp *) iPtr,
- TclGetStringFromObj(Tcl_GetObjResult((Tcl_Interp *) iPtr),
- (int *) NULL),
- TCL_VOLATILE);
- }
-
- /*
- * Scan through all the arguments to see how much space is needed.
- */
-
- newSpace = 0;
- while (1) {
- string = va_arg(argList, char *);
- if (string == NULL) {
- break;
+ if ((s == '\0') && (p != '*')) {
+ return 0;
}
- newSpace += strlen(string);
- }
- va_end(argList);
-
- /*
- * If the append buffer isn't already setup and large enough to hold
- * the new data, set it up.
- */
- if ((iPtr->result != iPtr->appendResult)
- || (iPtr->appendResult[iPtr->appendUsed] != 0)
- || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
- SetupAppendBuffer(iPtr, newSpace);
- }
-
- /*
- * Now go through all the argument strings again, copying them into the
- * buffer.
- */
-
- TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
- while (1) {
- string = va_arg(argList, char *);
- if (string == NULL) {
- break;
+ /* Check for a "*" as the next pattern character. It matches
+ * any substring. We handle this by calling ourselves
+ * recursively for each postfix of string, until either we
+ * match or we reach the end of the string.
+ */
+
+ if (p == '*') {
+ pattern++;
+ if (*pattern == '\0') {
+ return 1;
+ }
+ while (1) {
+ if (Tcl_StringCaseMatch(string, pattern, nocase)) {
+ return 1;
+ }
+ if (*string == '\0') {
+ return 0;
+ }
+ string++;
+ }
}
- strcpy(iPtr->appendResult + iPtr->appendUsed, string);
- iPtr->appendUsed += strlen(string);
- }
- va_end(argList);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AppendElement --
- *
- * Convert a string to a valid Tcl list element and append it to the
- * result (which is ostensibly a list).
- *
- * Results:
- * None.
- *
- * Side effects:
- * The result in the interpreter given by the first argument is
- * extended with a list element converted from string. A separator
- * space is added before the converted list element unless the current
- * result is empty, contains the single character "{", or ends in " {".
- *
- * If the string result is empty, the object result is moved to the
- * string result, then the object result is reset.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_AppendElement(interp, string)
- Tcl_Interp *interp; /* Interpreter whose result is to be
- * extended. */
- char *string; /* String to convert to list element and
- * add to result. */
-{
- Interp *iPtr = (Interp *) interp;
- char *dst;
- int size;
- int flags;
-
- /*
- * If the string result is empty, move the object result to the
- * string result, then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
- */
-
- if (*(iPtr->result) == 0) {
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
- TCL_VOLATILE);
- }
-
- /*
- * See how much space is needed, and grow the append buffer if
- * needed to accommodate the list element.
- */
-
- size = Tcl_ScanElement(string, &flags) + 1;
- if ((iPtr->result != iPtr->appendResult)
- || (iPtr->appendResult[iPtr->appendUsed] != 0)
- || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
- SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
- }
-
- /*
- * Convert the string into a list element and copy it to the
- * buffer that's forming, with a space separator if needed.
- */
- dst = iPtr->appendResult + iPtr->appendUsed;
- if (TclNeedSpace(iPtr->appendResult, dst)) {
- iPtr->appendUsed++;
- *dst = ' ';
- dst++;
- }
- iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetupAppendBuffer --
- *
- * This procedure makes sure that there is an append buffer properly
- * initialized, if necessary, from the interpreter's result, and
- * that it has at least enough room to accommodate newSpace new
- * bytes of information.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SetupAppendBuffer(iPtr, newSpace)
- Interp *iPtr; /* Interpreter whose result is being set up. */
- int newSpace; /* Make sure that at least this many bytes
- * of new information may be added. */
-{
- int totalSpace;
-
- /*
- * Make the append buffer larger, if that's necessary, then copy the
- * result into the append buffer and make the append buffer the official
- * Tcl result.
- */
-
- if (iPtr->result != iPtr->appendResult) {
- /*
- * If an oversized buffer was used recently, then free it up
- * so we go back to a smaller buffer. This avoids tying up
- * memory forever after a large operation.
+ /* Check for a "?" as the next pattern character. It matches
+ * any single character.
*/
- if (iPtr->appendAvl > 500) {
- ckfree(iPtr->appendResult);
- iPtr->appendResult = NULL;
- iPtr->appendAvl = 0;
+ if (p == '?') {
+ pattern++;
+ string += Tcl_UtfToUniChar(string, &ch1);
+ continue;
}
- iPtr->appendUsed = strlen(iPtr->result);
- } else if (iPtr->result[iPtr->appendUsed] != 0) {
- /*
- * Most likely someone has modified a result created by
- * Tcl_AppendResult et al. so that it has a different size.
- * Just recompute the size.
- */
- iPtr->appendUsed = strlen(iPtr->result);
- }
-
- totalSpace = newSpace + iPtr->appendUsed;
- if (totalSpace >= iPtr->appendAvl) {
- char *new;
+ /* Check for a "[" as the next pattern character. It is followed
+ * by a list of characters that are acceptable, or by a range
+ * (two characters separated by "-").
+ */
+
+ if (p == '[') {
+ Tcl_UniChar startChar, endChar;
- if (totalSpace < 100) {
- totalSpace = 200;
- } else {
- totalSpace *= 2;
- }
- new = (char *) ckalloc((unsigned) totalSpace);
- strcpy(new, iPtr->result);
- if (iPtr->appendResult != NULL) {
- ckfree(iPtr->appendResult);
- }
- iPtr->appendResult = new;
- iPtr->appendAvl = totalSpace;
- } else if (iPtr->result != iPtr->appendResult) {
- strcpy(iPtr->appendResult, iPtr->result);
- }
-
- Tcl_FreeResult((Tcl_Interp *) iPtr);
- iPtr->result = iPtr->appendResult;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FreeResult --
- *
- * This procedure frees up the memory associated with an interpreter's
- * string result. It also resets the interpreter's result object.
- * Tcl_FreeResult is most commonly used when a procedure is about to
- * replace one result value with another.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Frees the memory associated with interp's string result and sets
- * interp->freeProc to zero, but does not change interp->result or
- * clear error state. Resets interp's result object to an unshared
- * empty object.
- *
- *----------------------------------------------------------------------
- */
+ pattern++;
+ string += Tcl_UtfToUniChar(string, &ch1);
+ if (nocase) {
+ ch1 = Tcl_UniCharToLower(ch1);
+ }
+ while (1) {
+ if ((*pattern == ']') || (*pattern == '\0')) {
+ return 0;
+ }
+ pattern += Tcl_UtfToUniChar(pattern, &startChar);
+ if (nocase) {
+ startChar = Tcl_UniCharToLower(startChar);
+ }
+ if (*pattern == '-') {
+ pattern++;
+ if (*pattern == '\0') {
+ return 0;
+ }
+ pattern += Tcl_UtfToUniChar(pattern, &endChar);
+ if (nocase) {
+ endChar = Tcl_UniCharToLower(endChar);
+ }
+ if (((startChar <= ch1) && (ch1 <= endChar))
+ || ((endChar <= ch1) && (ch1 <= startChar))) {
+ /*
+ * Matches ranges of form [a-z] or [z-a].
+ */
-void
-Tcl_FreeResult(interp)
- Tcl_Interp *interp; /* Interpreter for which to free result. */
-{
- Interp *iPtr = (Interp *) interp;
-
- if (iPtr->freeProc != NULL) {
- if ((iPtr->freeProc == TCL_DYNAMIC)
- || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
- ckfree(iPtr->result);
- } else {
- (*iPtr->freeProc)(iPtr->result);
+ break;
+ }
+ } else if (startChar == ch1) {
+ break;
+ }
+ }
+ while (*pattern != ']') {
+ if (*pattern == '\0') {
+ pattern = Tcl_UtfPrev(pattern, pstart);
+ break;
+ }
+ pattern++;
+ }
+ pattern++;
+ continue;
}
- iPtr->freeProc = 0;
- }
- TclResetObjResult(iPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ResetResult --
- *
- * This procedure resets both the interpreter's string and object
- * results.
- *
- * Results:
- * None.
- *
- * Side effects:
- * It resets the result object to an unshared empty object. It
- * then restores the interpreter's string result area to its default
- * initialized state, freeing up any memory that may have been
- * allocated. It also clears any error information for the interpreter.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_ResetResult(interp)
- Tcl_Interp *interp; /* Interpreter for which to clear result. */
-{
- Interp *iPtr = (Interp *) interp;
-
- TclResetObjResult(iPtr);
-
- Tcl_FreeResult(interp);
- iPtr->result = iPtr->resultSpace;
- iPtr->resultSpace[0] = 0;
-
- iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetErrorCode --
- *
- * This procedure is called to record machine-readable information
- * about an error that is about to be returned.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The errorCode global variable is modified to hold all of the
- * arguments to this procedure, in a list form with each argument
- * becoming one element of the list. A flag is set internally
- * to remember that errorCode has been set, so the variable doesn't
- * get set automatically when the error is returned.
- *
- *----------------------------------------------------------------------
- */
- /* VARARGS2 */
-void
-Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
-{
- va_list argList;
- char *string;
- int flags;
- Interp *iPtr;
-
- /*
- * Scan through the arguments one at a time, appending them to
- * $errorCode as list elements.
- */
-
- iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
- flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
- while (1) {
- string = va_arg(argList, char *);
- if (string == NULL) {
- break;
+ /* If the next pattern character is '\', just strip off the '\'
+ * so we do exact matching on the character that follows.
+ */
+
+ if (p == '\\') {
+ pattern++;
+ p = *pattern;
+ if (p == '\0') {
+ return 0;
+ }
}
- (void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
- (char *) NULL, string, flags);
- flags |= TCL_APPEND_VALUE;
- }
- va_end(argList);
- iPtr->flags |= ERROR_CODE_SET;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetObjErrorCode --
- *
- * This procedure is called to record machine-readable information
- * about an error that is about to be returned. The caller should
- * build a list object up and pass it to this routine.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The errorCode global variable is modified to be the new value.
- * A flag is set internally to remember that errorCode has been
- * set, so the variable doesn't get set automatically when the
- * error is returned.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetObjErrorCode(interp, errorObjPtr)
- Tcl_Interp *interp;
- Tcl_Obj *errorObjPtr;
-{
- Tcl_Obj *namePtr;
- Interp *iPtr;
-
- namePtr = Tcl_NewStringObj("errorCode", -1);
- iPtr = (Interp *) interp;
- Tcl_ObjSetVar2(interp, namePtr, (Tcl_Obj *) NULL, errorObjPtr,
- TCL_GLOBAL_ONLY);
- iPtr->flags |= ERROR_CODE_SET;
- Tcl_DecrRefCount(namePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_RegExpCompile --
- *
- * Compile a regular expression into a form suitable for fast
- * matching. This procedure retains a small cache of pre-compiled
- * regular expressions in the interpreter, in order to avoid
- * compilation costs as much as possible.
- *
- * Results:
- * The return value is a pointer to the compiled form of string,
- * suitable for passing to Tcl_RegExpExec. This compiled form
- * is only valid up until the next call to this procedure, so
- * don't keep these around for a long time! If an error occurred
- * while compiling the pattern, then NULL is returned and an error
- * message is left in interp->result.
- *
- * Side effects:
- * The cache of compiled regexp's in interp will be modified to
- * hold information for string, if such information isn't already
- * present in the cache.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_RegExp
-Tcl_RegExpCompile(interp, string)
- Tcl_Interp *interp; /* For use in error reporting. */
- char *string; /* String for which to produce
- * compiled regular expression. */
-{
- Interp *iPtr = (Interp *) interp;
- int i, length;
- regexp *result;
-
- length = strlen(string);
- for (i = 0; i < NUM_REGEXPS; i++) {
- if ((length == iPtr->patLengths[i])
- && (strcmp(string, iPtr->patterns[i]) == 0)) {
- /*
- * Move the matched pattern to the first slot in the
- * cache and shift the other patterns down one position.
- */
-
- if (i != 0) {
- int j;
- char *cachedString;
- cachedString = iPtr->patterns[i];
- result = iPtr->regexps[i];
- for (j = i-1; j >= 0; j--) {
- iPtr->patterns[j+1] = iPtr->patterns[j];
- iPtr->patLengths[j+1] = iPtr->patLengths[j];
- iPtr->regexps[j+1] = iPtr->regexps[j];
- }
- iPtr->patterns[0] = cachedString;
- iPtr->patLengths[0] = length;
- iPtr->regexps[0] = result;
+ /* There's no special character. Just make sure that the next
+ * bytes of each string match.
+ */
+
+ string += Tcl_UtfToUniChar(string, &ch1);
+ pattern += Tcl_UtfToUniChar(pattern, &ch2);
+ if (nocase) {
+ if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
+ return 0;
}
- return (Tcl_RegExp) iPtr->regexps[0];
+ } else if (ch1 != ch2) {
+ return 0;
}
}
-
- /*
- * No match in the cache. Compile the string and add it to the
- * cache.
- */
-
- TclRegError((char *) NULL);
- result = TclRegComp(string);
- if (TclGetRegError() != NULL) {
- Tcl_AppendResult(interp,
- "couldn't compile regular expression pattern: ",
- TclGetRegError(), (char *) NULL);
- return NULL;
- }
- if (iPtr->patterns[NUM_REGEXPS-1] != NULL) {
- ckfree(iPtr->patterns[NUM_REGEXPS-1]);
- ckfree((char *) iPtr->regexps[NUM_REGEXPS-1]);
- }
- for (i = NUM_REGEXPS - 2; i >= 0; i--) {
- iPtr->patterns[i+1] = iPtr->patterns[i];
- iPtr->patLengths[i+1] = iPtr->patLengths[i];
- iPtr->regexps[i+1] = iPtr->regexps[i];
- }
- iPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
- strcpy(iPtr->patterns[0], string);
- iPtr->patLengths[0] = length;
- iPtr->regexps[0] = result;
- return (Tcl_RegExp) result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_RegExpExec --
- *
- * Execute the regular expression matcher using a compiled form
- * of a regular expression and save information about any match
- * that is found.
- *
- * Results:
- * If an error occurs during the matching operation then -1
- * is returned and interp->result contains an error message.
- * Otherwise the return value is 1 if a matching range is
- * found and 0 if there is no matching range.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_RegExpExec(interp, re, string, start)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- Tcl_RegExp re; /* Compiled regular expression; must have
- * been returned by previous call to
- * Tcl_RegExpCompile. */
- char *string; /* String against which to match re. */
- char *start; /* If string is part of a larger string,
- * this identifies beginning of larger
- * string, so that "^" won't match. */
-{
- int match;
-
- regexp *regexpPtr = (regexp *) re;
- TclRegError((char *) NULL);
- match = TclRegExec(regexpPtr, string, start);
- if (TclGetRegError() != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error while matching regular expression: ",
- TclGetRegError(), (char *) NULL);
- return -1;
- }
- return match;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_RegExpRange --
- *
- * Returns pointers describing the range of a regular expression match,
- * or one of the subranges within the match.
- *
- * Results:
- * The variables at *startPtr and *endPtr are modified to hold the
- * addresses of the endpoints of the range given by index. If the
- * specified range doesn't exist then NULLs are returned.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_RegExpRange(re, index, startPtr, endPtr)
- Tcl_RegExp re; /* Compiled regular expression that has
- * been passed to Tcl_RegExpExec. */
- int index; /* 0 means give the range of the entire
- * match, > 0 means give the range of
- * a matching subrange. Must be no greater
- * than NSUBEXP. */
- char **startPtr; /* Store address of first character in
- * (sub-) range here. */
- char **endPtr; /* Store address of character just after last
- * in (sub-) range here. */
-{
- regexp *regexpPtr = (regexp *) re;
-
- if (index >= NSUBEXP) {
- *startPtr = *endPtr = NULL;
- } else {
- *startPtr = regexpPtr->startp[index];
- *endPtr = regexpPtr->endp[index];
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_RegExpMatch --
- *
- * See if a string matches a regular expression.
- *
- * Results:
- * If an error occurs during the matching operation then -1
- * is returned and interp->result contains an error message.
- * Otherwise the return value is 1 if "string" matches "pattern"
- * and 0 otherwise.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_RegExpMatch(interp, string, pattern)
- Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* String. */
- char *pattern; /* Regular expression to match against
- * string. */
-{
- Tcl_RegExp re;
-
- re = Tcl_RegExpCompile(interp, pattern);
- if (re == NULL) {
- return -1;
- }
- return Tcl_RegExpExec(interp, re, string, string);
}
/*
@@ -2048,7 +1449,7 @@ Tcl_DStringInit(dsPtr)
dsPtr->string = dsPtr->staticSpace;
dsPtr->length = 0;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
- dsPtr->staticSpace[0] = 0;
+ dsPtr->staticSpace[0] = '\0';
}
/*
@@ -2079,7 +1480,7 @@ Tcl_DStringAppend(dsPtr, string, length)
* up to null at end. */
{
int newSize;
- char *newString, *dst;
+ char *dst;
CONST char *end;
if (length < 0) {
@@ -2094,14 +1495,18 @@ Tcl_DStringAppend(dsPtr, string, length)
*/
if (newSize >= dsPtr->spaceAvl) {
- dsPtr->spaceAvl = newSize*2;
- newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
- memcpy((VOID *) newString, (VOID *) dsPtr->string,
- (size_t) dsPtr->length);
- if (dsPtr->string != dsPtr->staticSpace) {
- ckfree(dsPtr->string);
+ dsPtr->spaceAvl = newSize * 2;
+ if (dsPtr->string == dsPtr->staticSpace) {
+ char *newString;
+
+ newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+ memcpy((VOID *) newString, (VOID *) dsPtr->string,
+ (size_t) dsPtr->length);
+ dsPtr->string = newString;
+ } else {
+ dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
+ (size_t) dsPtr->spaceAvl);
}
- dsPtr->string = newString;
}
/*
@@ -2143,7 +1548,7 @@ Tcl_DStringAppendElement(dsPtr, string)
* null-terminated. */
{
int newSize, flags;
- char *dst, *newString;
+ char *dst;
newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;
@@ -2157,14 +1562,18 @@ Tcl_DStringAppendElement(dsPtr, string)
*/
if (newSize >= dsPtr->spaceAvl) {
- dsPtr->spaceAvl = newSize*2;
- newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
- memcpy((VOID *) newString, (VOID *) dsPtr->string,
- (size_t) dsPtr->length);
- if (dsPtr->string != dsPtr->staticSpace) {
- ckfree(dsPtr->string);
+ dsPtr->spaceAvl = newSize * 2;
+ if (dsPtr->string == dsPtr->staticSpace) {
+ char *newString;
+
+ newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+ memcpy((VOID *) newString, (VOID *) dsPtr->string,
+ (size_t) dsPtr->length);
+ dsPtr->string = newString;
+ } else {
+ dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
+ (size_t) dsPtr->spaceAvl);
}
- dsPtr->string = newString;
}
/*
@@ -2207,27 +1616,41 @@ Tcl_DStringSetLength(dsPtr, length)
Tcl_DString *dsPtr; /* Structure describing dynamic string. */
int length; /* New length for dynamic string. */
{
+ int newsize;
+
if (length < 0) {
length = 0;
}
if (length >= dsPtr->spaceAvl) {
- char *newString;
-
- dsPtr->spaceAvl = length+1;
- newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
-
/*
- * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
- * to a larger buffer, since there may be embedded NULLs in the
- * string in some cases.
+ * There are two interesting cases here. In the first case, the user
+ * may be trying to allocate a large buffer of a specific size. It
+ * would be wasteful to overallocate that buffer, so we just allocate
+ * enough for the requested size plus the trailing null byte. In the
+ * second case, we are growing the buffer incrementally, so we need
+ * behavior similar to Tcl_DStringAppend. The requested length will
+ * usually be a small delta above the current spaceAvl, so we'll end up
+ * doubling the old size. This won't grow the buffer quite as quickly,
+ * but it should be close enough.
*/
- memcpy((VOID *) newString, (VOID *) dsPtr->string,
- (size_t) dsPtr->length);
- if (dsPtr->string != dsPtr->staticSpace) {
- ckfree(dsPtr->string);
+ newsize = dsPtr->spaceAvl * 2;
+ if (length < newsize) {
+ dsPtr->spaceAvl = newsize;
+ } else {
+ dsPtr->spaceAvl = length + 1;
+ }
+ if (dsPtr->string == dsPtr->staticSpace) {
+ char *newString;
+
+ newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+ memcpy((VOID *) newString, (VOID *) dsPtr->string,
+ (size_t) dsPtr->length);
+ dsPtr->string = newString;
+ } else {
+ dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
+ (size_t) dsPtr->spaceAvl);
}
- dsPtr->string = newString;
}
dsPtr->length = length;
dsPtr->string[length] = 0;
@@ -2248,8 +1671,7 @@ Tcl_DStringSetLength(dsPtr, length)
* The previous contents of the dynamic string are lost, and
* the new value is an empty string.
*
- *----------------------------------------------------------------------
- */
+ *---------------------------------------------------------------------- */
void
Tcl_DStringFree(dsPtr)
@@ -2261,7 +1683,7 @@ Tcl_DStringFree(dsPtr)
dsPtr->string = dsPtr->staticSpace;
dsPtr->length = 0;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
- dsPtr->staticSpace[0] = 0;
+ dsPtr->staticSpace[0] = '\0';
}
/*
@@ -2305,7 +1727,7 @@ Tcl_DStringResult(interp, dsPtr)
dsPtr->string = dsPtr->staticSpace;
dsPtr->length = 0;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
- dsPtr->staticSpace[0] = 0;
+ dsPtr->staticSpace[0] = '\0';
}
/*
@@ -2343,12 +1765,10 @@ Tcl_DStringGetResult(interp, dsPtr)
/*
* If the string result is empty, move the object result to the
* string result, then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
*/
if (*(iPtr->result) == 0) {
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
@@ -2465,9 +1885,12 @@ Tcl_PrintDouble(interp, value, dst)
* must have at least TCL_DOUBLE_SPACE
* characters. */
{
- char *p;
+ char *p, c;
+ Tcl_UniChar ch;
+ Tcl_MutexLock(&precisionMutex);
sprintf(dst, precisionFormat, value);
+ Tcl_MutexUnlock(&precisionMutex);
/*
* If the ASCII result looks like an integer, add ".0" so that it
@@ -2475,8 +1898,10 @@ Tcl_PrintDouble(interp, value, dst)
* values from being converted to integers unintentionally.
*/
- for (p = dst; *p != 0; p++) {
- if ((*p == '.') || (isalpha(UCHAR(*p)))) {
+ for (p = dst; *p != 0; ) {
+ p += Tcl_UtfToUniChar(p, &ch);
+ c = UCHAR(ch);
+ if ((c == '.') || isalpha(UCHAR(c))) { /* INTL: ISO only. */
return;
}
}
@@ -2537,9 +1962,12 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
* out of date.
*/
+ Tcl_MutexLock(&precisionMutex);
+
if (flags & TCL_TRACE_READS) {
Tcl_SetVar2(interp, name1, name2, precisionString,
flags & TCL_GLOBAL_ONLY);
+ Tcl_MutexUnlock(&precisionMutex);
return (char *) NULL;
}
@@ -2553,6 +1981,7 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
if (Tcl_IsSafe(interp)) {
Tcl_SetVar2(interp, name1, name2, precisionString,
flags & TCL_GLOBAL_ONLY);
+ Tcl_MutexUnlock(&precisionMutex);
return "can't modify precision from a safe interpreter";
}
value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
@@ -2564,10 +1993,12 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
(end == value) || (*end != 0)) {
Tcl_SetVar2(interp, name1, name2, precisionString,
flags & TCL_GLOBAL_ONLY);
+ Tcl_MutexUnlock(&precisionMutex);
return "improper value for precision";
}
TclFormatInt(precisionString, prec);
sprintf(precisionFormat, "%%.%dg", prec);
+ Tcl_MutexUnlock(&precisionMutex);
return (char *) NULL;
}
@@ -2610,7 +2041,8 @@ TclNeedSpace(start, end)
}
end--;
if (*end != '{') {
- if (isspace(UCHAR(*end)) && ((end == start) || (end[-1] != '\\'))) {
+ if (isspace(UCHAR(*end)) /* INTL: ISO space. */
+ && ((end == start) || (end[-1] != '\\'))) {
return 0;
}
return 1;
@@ -2621,7 +2053,7 @@ TclNeedSpace(start, end)
}
end--;
} while (*end == '{');
- if (isspace(UCHAR(*end))) {
+ if (isspace(UCHAR(*end))) { /* INTL: ISO space. */
return 0;
}
return 1;
@@ -2662,7 +2094,17 @@ TclFormatInt(buffer, n)
char *digits = "0123456789";
/*
- * Check first whether "n" is the maximum negative value. This is
+ * Check first whether "n" is zero.
+ */
+
+ if (n == 0) {
+ buffer[0] = '0';
+ buffer[1] = 0;
+ return 1;
+ }
+
+ /*
+ * Check whether "n" is the maximum negative value. This is
* -2^(m-1) for an m-bit word, and has no positive equivalent;
* negating it produces the same value.
*/
@@ -2724,22 +2166,41 @@ TclFormatInt(buffer, n)
*/
int
-TclLooksLikeInt(p)
- char *p; /* Pointer to string. */
+TclLooksLikeInt(bytes, length)
+ register char *bytes; /* Points to first byte of the string. */
+ int length; /* Number of bytes in the string. If < 0
+ * bytes up to the first null byte are
+ * considered (if they may appear in an
+ * integer). */
{
- while (isspace(UCHAR(*p))) {
+ register char *p, *end;
+
+ if (length < 0) {
+ length = (bytes? strlen(bytes) : 0);
+ }
+ end = (bytes + length);
+
+ p = bytes;
+ while ((p < end) && isspace(UCHAR(*p))) { /* INTL: ISO space. */
p++;
}
+ if (p == end) {
+ return 0;
+ }
+
if ((*p == '+') || (*p == '-')) {
p++;
}
- if (!isdigit(UCHAR(*p))) {
+ if ((p == end) || !isdigit(UCHAR(*p))) { /* INTL: digit */
return 0;
}
p++;
- while (isdigit(UCHAR(*p))) {
+ while ((p < end) && isdigit(UCHAR(*p))) { /* INTL: digit */
p++;
}
+ if (p == end) {
+ return 1;
+ }
if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
return 1;
}
@@ -2753,13 +2214,14 @@ TclLooksLikeInt(p)
*
* This procedure returns an integer corresponding to the list index
* held in a Tcl object. The Tcl object's value is expected to be
- * either an integer or the string "end".
+ * either an integer or a string of the form "end([+-]integer)?".
*
* Results:
* The return value is normally TCL_OK, which means that the index was
* successfully stored into the location referenced by "indexPtr". If
* the Tcl object referenced by "objPtr" has the value "end", the
- * value stored is "endValue". If "objPtr"s values is not "end" and
+ * value stored is "endValue". If "objPtr"s values is not of the form
+ * "end([+-]integer)?" and
* can not be converted to an integer, TCL_ERROR is returned and, if
* "interp" is non-NULL, an error message is left in the interpreter's
* result object.
@@ -2773,51 +2235,117 @@ TclLooksLikeInt(p)
int
TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
* If NULL, then no error message is left
* after errors. */
- Tcl_Obj *objPtr; /* Points to an object containing either
+ Tcl_Obj *objPtr; /* Points to an object containing either
* "end" or an integer. */
- int endValue; /* The value to be stored at "indexPtr" if
+ int endValue; /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
- int *indexPtr; /* Location filled in with an integer
+ int *indexPtr; /* Location filled in with an integer
* representing an index. */
{
- Interp *iPtr = (Interp *) interp;
char *bytes;
- int index, length, result;
+ int length, offset;
- /*
- * THIS FAILS IF THE INDEX OBJECT'S STRING REP CONTAINS NULLS.
- */
-
if (objPtr->typePtr == &tclIntType) {
*indexPtr = (int)objPtr->internalRep.longValue;
return TCL_OK;
}
-
- bytes = TclGetStringFromObj(objPtr, &length);
- if ((*bytes == 'e')
- && (strncmp(bytes, "end", (unsigned) length) == 0)) {
- index = endValue;
+
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+
+ if ((*bytes != 'e') || (strncmp(bytes, "end",
+ (size_t)((length > 3) ? 3 : length)) != 0)) {
+ if (Tcl_GetIntFromObj(NULL, objPtr, &offset) != TCL_OK) {
+ goto intforindex_error;
+ }
+ *indexPtr = offset;
+ return TCL_OK;
+ }
+
+ if (length <= 3) {
+ *indexPtr = endValue;
+ } else if (bytes[3] == '-') {
+ /*
+ * This is our limited string expression evaluator
+ */
+ if (Tcl_GetInt(interp, bytes+3, &offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *indexPtr = endValue + offset;
} else {
- result = Tcl_GetIntFromObj((Tcl_Interp *) NULL, objPtr, &index);
- if (result != TCL_OK) {
- if (iPtr != NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad index \"", bytes,
- "\": must be integer or \"end\"", (char *) NULL);
- }
- return result;
+ intforindex_error:
+ if ((Interp *)interp != NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad index \"", bytes,
+ "\": must be integer or end?-integer?", (char *) NULL);
+ TclCheckBadOctal(interp, bytes);
}
+ return TCL_ERROR;
}
- *indexPtr = index;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * TclCheckBadOctal --
+ *
+ * This procedure checks for a bad octal value and appends a
+ * meaningful error to the interp's result.
+ *
+ * Results:
+ * 1 if the argument was a bad octal, else 0.
+ *
+ * Side effects:
+ * The interpreter's result is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCheckBadOctal(interp, value)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ * If NULL, then no error message is left
+ * after errors. */
+ char *value; /* String to check. */
+{
+ register char *p = value;
+
+ /*
+ * A frequent mistake is invalid octal values due to an unwanted
+ * leading zero. Try to generate a meaningful error message.
+ */
+
+ while (isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ p++;
+ }
+ if (*p == '+' || *p == '-') {
+ p++;
+ }
+ if (*p == '0') {
+ while (isdigit(UCHAR(*p))) { /* INTL: digit. */
+ p++;
+ }
+ while (isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ p++;
+ }
+ if (*p == '\0') {
+ /* Reached end of string */
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, " (looks like invalid octal number)",
+ (char *) NULL);
+ }
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetNameOfExecutable --
*
* This procedure simply returns a pointer to the internal full
@@ -2841,3 +2369,103 @@ Tcl_GetNameOfExecutable()
{
return (tclExecutableName);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCwd --
+ *
+ * This function replaces the library version of getcwd().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the current
+ * directory, or NULL if the current directory could not be
+ * determined. If NULL is returned, an error message is left in the
+ * interp's result. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetCwd(interp, cwdPtr)
+ Tcl_Interp *interp;
+ Tcl_DString *cwdPtr;
+{
+ return TclpGetCwd(interp, cwdPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Chdir --
+ *
+ * This function replaces the library version of chdir().
+ *
+ * Results:
+ * See chdir() documentation.
+ *
+ * Side effects:
+ * See chdir() documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Chdir(dirName)
+ CONST char *dirName;
+{
+ return TclpChdir(dirName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Access --
+ *
+ * This function replaces the library version of access().
+ *
+ * Results:
+ * See access() documentation.
+ *
+ * Side effects:
+ * See access() documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Access(path, mode)
+ CONST char *path; /* Path of file to access (UTF-8). */
+ int mode; /* Permission setting. */
+{
+ return TclAccess(path, mode);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Stat --
+ *
+ * This function replaces the library version of stat().
+ *
+ * Results:
+ * See stat() documentation.
+ *
+ * Side effects:
+ * See stat() documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Stat(path, bufPtr)
+ CONST char *path; /* Path of file to stat (in UTF-8). */
+ struct stat *bufPtr; /* Filled with results of stat call. */
+{
+ return TclStat(path, bufPtr);
+}
diff --git a/tcl/generic/tclVar.c b/tcl/generic/tclVar.c
index e191087e674..fce00ab6138 100644
--- a/tcl/generic/tclVar.c
+++ b/tcl/generic/tclVar.c
@@ -9,6 +9,7 @@
*
* Copyright (c) 1987-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -28,9 +29,11 @@ static char *noSuchVar = "no such variable";
static char *isArray = "variable is array";
static char *needArray = "variable isn't array";
static char *noSuchElement = "no such element in array";
-static char *danglingUpvar = "upvar refers to element in deleted array";
+static char *danglingElement = "upvar refers to element in deleted array";
+static char *danglingVar = "upvar refers to variable in deleted namespace";
static char *badNamespace = "parent namespace doesn't exist";
static char *missingName = "missing variable name";
+static char *isArrayElement = "name refers to an element in an array";
/*
* Forward references to procedures defined later in this file:
@@ -75,9 +78,7 @@ static void VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
*
* If the variable isn't found and creation wasn't specified, or some
* other error occurs, NULL is returned and an error message is left in
- * interp->result if TCL_LEAVE_ERR_MSG is set in flags. (The result
- * isn't put in interp->objResultPtr because this procedure is used
- * by so many string-based routines.)
+ * the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
*
* Note: it's possible for the variable returned to be VAR_UNDEFINED
* even if createPart1 or createPart2 are 1 (these only cause the hash
@@ -97,17 +98,13 @@ Var *
TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
arrayPtrPtr)
Tcl_Interp *interp; /* Interpreter to use for lookup. */
- char *part1; /* If part2 isn't NULL, this is the name of
- * an array. Otherwise, if the
- * TCL_PARSE_PART1 flag bit is set this
+ register char *part1; /* If part2 isn't NULL, this is the name of
+ * an array. Otherwise, this
* is a full variable name that could
- * include a parenthesized array elemnt. If
- * TCL_PARSE_PART1 isn't present, then
- * this is the name of a scalar variable. */
+ * include a parenthesized array element. */
char *part2; /* Name of element within array, or NULL. */
int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * TCL_LEAVE_ERR_MSG, and
- * TCL_PARSE_PART1 bits matter. */
+ * and TCL_LEAVE_ERR_MSG bits matter. */
char *msg; /* Verb to use in error messages, e.g.
* "read" or "set". Only needed if
* TCL_LEAVE_ERR_MSG is set in flags. */
@@ -153,33 +150,38 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
varNsPtr = NULL; /* set non-NULL if a nonlocal variable */
/*
- * If the name hasn't been parsed into array name and index yet,
- * do it now.
+ * Parse part1 into array name and index.
+ * Always check if part1 is an array element name and allow it only if
+ * part2 is not given.
+ * (if one does not care about creating array elements that can't be used
+ * from tcl, and prefer slightly better performance, one can put
+ * the following in an if (part2 == NULL) { ... } block and remove
+ * the part2's test and error reporting or move that code in array set)
*/
elName = part2;
- if (flags & TCL_PARSE_PART1) {
- for (p = part1; ; p++) {
- if (*p == 0) {
- elName = NULL;
- break;
- }
- if (*p == '(') {
- openParen = p;
- do {
- p++;
- } while (*p != '\0');
- p--;
- if (*p == ')') {
- closeParen = p;
- *openParen = 0;
- elName = openParen+1;
- } else {
+ for (p = part1; *p ; p++) {
+ if (*p == '(') {
+ openParen = p;
+ do {
+ p++;
+ } while (*p != '\0');
+ p--;
+ if (*p == ')') {
+ if (part2 != NULL) {
openParen = NULL;
- elName = NULL;
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ VarErrMsg(interp, part1, part2, msg, needArray);
+ }
+ goto done;
}
- break;
+ closeParen = p;
+ *openParen = 0;
+ elName = openParen+1;
+ } else {
+ openParen = NULL;
}
+ break;
}
}
@@ -191,8 +193,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
*/
if ((flags & TCL_GLOBAL_ONLY) != 0 || iPtr->varFramePtr == NULL) {
cxtNsPtr = iPtr->globalNsPtr;
- }
- else {
+ } else {
cxtNsPtr = iPtr->varFramePtr->nsPtr;
}
@@ -201,7 +202,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
if (cxtNsPtr->varResProc) {
result = (*cxtNsPtr->varResProc)(interp, part1,
- (Tcl_Namespace *) cxtNsPtr, flags, &var);
+ (Tcl_Namespace *) cxtNsPtr, flags, &var);
} else {
result = TCL_CONTINUE;
}
@@ -209,7 +210,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
while (result == TCL_CONTINUE && resPtr) {
if (resPtr->varResProc) {
result = (*resPtr->varResProc)(interp, part1,
- (Tcl_Namespace *) cxtNsPtr, flags, &var);
+ (Tcl_Namespace *) cxtNsPtr, flags, &var);
}
resPtr = resPtr->nextPtr;
}
@@ -217,8 +218,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
if (result == TCL_OK) {
varPtr = (Var *) var;
goto lookupVarPart2;
- }
- else if (result != TCL_CONTINUE) {
+ } else if (result != TCL_CONTINUE) {
return (Var *) NULL;
}
}
@@ -241,39 +241,25 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
*/
if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
- || (varFramePtr == NULL)
- || !varFramePtr->isProcCallFrame
- || (strstr(part1, "::") != NULL)) {
+ || (varFramePtr == NULL)
+ || !varFramePtr->isProcCallFrame
+ || (strstr(part1, "::") != NULL)) {
char *tail;
+ /*
+ * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable,
+ * or otherwise generate our own error!
+ */
var = Tcl_FindNamespaceVar(interp, part1, (Tcl_Namespace *) NULL,
- flags);
+ flags & ~TCL_LEAVE_ERR_MSG);
if (var != (Tcl_Var) NULL) {
varPtr = (Var *) var;
}
if (varPtr == NULL) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_ResetResult(interp);
- }
if (createPart1) { /* var wasn't found so create it */
- result = TclGetNamespaceForQualName(interp, part1,
- (Namespace *) NULL, flags, &varNsPtr, &dummy1Ptr,
- &dummy2Ptr, &tail);
- if (result != TCL_OK) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- /*
- * Move the interpreter's object result to the
- * string result, then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REP HAS NULLS.
- */
-
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp),
- (int *) NULL),
- TCL_VOLATILE);
- }
- goto done;
- }
+ TclGetNamespaceForQualName(interp, part1, (Namespace *) NULL,
+ flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
+
if (varNsPtr == NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
VarErrMsg(interp, part1, part2, msg, badNamespace);
@@ -307,7 +293,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
for (i = 0; i < localCt; i++) {
if (!TclIsVarTemporary(localPtr)) {
- char *localName = localVarPtr->name;
+ register char *localName = localVarPtr->name;
if ((part1[0] == localName[0])
&& (part1Len == localPtr->nameLength)
&& (strcmp(part1, localName) == 0)) {
@@ -323,7 +309,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
if (createPart1) {
if (tablePtr == NULL) {
tablePtr = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
+ ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
varFramePtr->varTablePtr = tablePtr;
}
@@ -352,7 +338,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
}
}
-lookupVarPart2:
+ lookupVarPart2:
if (openParen != NULL) {
*openParen = '(';
openParen = NULL;
@@ -389,10 +375,23 @@ lookupVarPart2:
varPtr = NULL;
goto done;
}
+
+ /*
+ * Make sure we are not resurrecting a namespace variable from a
+ * deleted namespace!
+ */
+ if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ VarErrMsg(interp, part1, part2, msg, danglingVar);
+ }
+ varPtr = NULL;
+ goto done;
+ }
+
TclSetVarArray(varPtr);
TclClearVarUndefined(varPtr);
varPtr->value.tablePtr =
- (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
} else if (!TclIsVarArray(varPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
@@ -453,7 +452,7 @@ lookupVarPart2:
* The return value points to the current value of varName as a string.
* If the variable is not defined or can't be read because of a clash
* in array usage then a NULL pointer is returned and an error message
- * is left in interp->result if the TCL_LEAVE_ERR_MSG flag is set.
+ * is left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set.
* Note: the return value is only valid up until the next change to the
* variable; if you depend on the value lasting longer than that, then
* make yourself a private copy.
@@ -473,8 +472,7 @@ Tcl_GetVar(interp, varName, flags)
* TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
* bits. */
{
- return Tcl_GetVar2(interp, varName, (char *) NULL,
- (flags | TCL_PARSE_PART1));
+ return Tcl_GetVar2(interp, varName, (char *) NULL, flags);
}
/*
@@ -489,7 +487,7 @@ Tcl_GetVar(interp, varName, flags)
* The return value points to the current value of the variable given
* by part1 and part2 as a string. If the specified variable doesn't
* exist, or if there is a clash in array usage, then NULL is returned
- * and a message will be left in interp->result if the
+ * and a message will be left in the interp's result if the
* TCL_LEAVE_ERR_MSG flag is set. Note: the return value is only valid
* up until the next change to the variable; if you depend on the value
* lasting longer than that, then make yourself a private copy.
@@ -509,53 +507,17 @@ Tcl_GetVar2(interp, part1, part2, flags)
char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY, TCL_LEAVE_ERR_MSG,
- * and TCL_PARSE_PART1 bits. */
+ * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG
+ * bits. */
{
- register Tcl_Obj *part1Ptr;
- register Tcl_Obj *part2Ptr = NULL;
Tcl_Obj *objPtr;
- int length;
-
- length = strlen(part1);
- TclNewObj(part1Ptr);
- TclInitStringRep(part1Ptr, part1, length);
- Tcl_IncrRefCount(part1Ptr);
- if (part2 != NULL) {
- length = strlen(part2);
- TclNewObj(part2Ptr);
- TclInitStringRep(part2Ptr, part2, length);
- Tcl_IncrRefCount(part2Ptr);
- }
-
- objPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
-
- TclDecrRefCount(part1Ptr); /* done with the part1 name object */
- if (part2Ptr != NULL) {
- TclDecrRefCount(part2Ptr); /* and the part2 name object */
- }
-
+ objPtr = Tcl_GetVar2Ex(interp, part1, part2, flags);
if (objPtr == NULL) {
- /*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
- */
-
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
- TCL_VOLATILE);
return NULL;
}
-
- /*
- * THIS FAILS IF Tcl_ObjGetVar2's RESULT'S STRING REP HAS A NULL BYTE.
- */
-
- return TclGetStringFromObj(objPtr, (int *) NULL);
+ return TclGetString(objPtr);
}
-
/*
*----------------------------------------------------------------------
*
@@ -593,20 +555,57 @@ Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
* TCL_LEAVE_ERR_MSG, and
* TCL_PARSE_PART1 bits. */
{
+ char *part1, *part2;
+
+ part1 = Tcl_GetString(part1Ptr);
+ if (part2Ptr != NULL) {
+ part2 = Tcl_GetString(part2Ptr);
+ } else {
+ part2 = NULL;
+ }
+
+ return Tcl_GetVar2Ex(interp, part1, part2, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetVar2Ex --
+ *
+ * Return the value of a Tcl variable as a Tcl object, given a
+ * two-part name consisting of array name and element within array.
+ *
+ * Results:
+ * The return value points to the current object value of the variable
+ * given by part1Ptr and part2Ptr. If the specified variable doesn't
+ * exist, or if there is a clash in array usage, then NULL is returned
+ * and a message will be left in the interpreter's result if the
+ * TCL_LEAVE_ERR_MSG flag is set.
+ *
+ * Side effects:
+ * The ref count for the returned object is _not_ incremented to
+ * reflect the returned reference; if you want to keep a reference to
+ * the object you must increment its ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_GetVar2Ex(interp, part1, part2, flags)
+ Tcl_Interp *interp; /* Command interpreter in which variable is
+ * to be looked up. */
+ char *part1; /* Name of an array (if part2 is non-NULL)
+ * or the name of a variable. */
+ char *part2; /* If non-NULL, gives the name of an element
+ * in the array part1. */
+ int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
+ * and TCL_LEAVE_ERR_MSG bits. */
+{
Interp *iPtr = (Interp *) interp;
register Var *varPtr;
Var *arrayPtr;
- char *part1, *msg;
- char *part2 = NULL;
-
- /*
- * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
- */
+ char *msg;
- part1 = TclGetStringFromObj(part1Ptr, (int *) NULL);
- if (part2Ptr != NULL) {
- part2 = TclGetStringFromObj(part2Ptr, (int *) NULL);
- }
varPtr = TclLookupVar(interp, part1, part2, flags, "read",
/*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
@@ -620,7 +619,7 @@ Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
if ((varPtr->tracePtr != NULL)
|| ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
- (flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_READS);
+ (flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY)) | TCL_TRACE_READS);
if (msg != NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
VarErrMsg(interp, part1, part2, "read", msg);
@@ -689,7 +688,7 @@ Tcl_Obj *
TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- int localIndex; /* Index of variable in procedure's array
+ register int localIndex; /* Index of variable in procedure's array
* of local variables. */
int leaveErrorMsg; /* 1 if to leave an error message in
* interpreter's result on an error.
@@ -702,26 +701,25 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
* the current procedure's frame, if any,
* unless an "uplevel" is executing. */
Var *compiledLocals = varFramePtr->compiledLocals;
- Var *varPtr; /* Points to the variable's in-frame Var
+ register Var *varPtr; /* Points to the variable's in-frame Var
* structure. */
char *varName; /* Name of the local variable. */
char *msg;
#ifdef TCL_COMPILE_DEBUG
- Proc *procPtr = varFramePtr->procPtr;
- int localCt = procPtr->numCompiledLocals;
+ int localCt = varFramePtr->procPtr->numCompiledLocals;
if (compiledLocals == NULL) {
fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x, no compiled locals\n",
- localIndex, (unsigned int) varFramePtr);
+ localIndex, (unsigned int) varFramePtr);
panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
- (unsigned int) varFramePtr);
+ (unsigned int) varFramePtr);
}
if ((localIndex < 0) || (localIndex >= localCt)) {
fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x with %i locals\n",
- localIndex, (unsigned int) varFramePtr, localCt);
+ localIndex, (unsigned int) varFramePtr, localCt);
panic("TclGetIndexedScalar: bad local index %i in frame 0x%x",
- localIndex, (unsigned int) varFramePtr);
+ localIndex, (unsigned int) varFramePtr);
}
#endif /* TCL_COMPILE_DEBUG */
@@ -745,7 +743,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
if (varPtr->tracePtr != NULL) {
msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL,
- TCL_TRACE_READS);
+ TCL_TRACE_READS);
if (msg != NULL) {
if (leaveErrorMsg) {
VarErrMsg(interp, varName, NULL, "read", msg);
@@ -767,6 +765,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
msg = noSuchVar;
}
VarErrMsg(interp, varName, NULL, "read", msg);
+
}
return NULL;
}
@@ -833,23 +832,19 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
if (compiledLocals == NULL) {
fprintf(stderr, "\nTclGetElementOfIndexedArray: can't get element of local %i in frame 0x%x, no compiled locals\n",
- localIndex, (unsigned int) varFramePtr);
+ localIndex, (unsigned int) varFramePtr);
panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
- (unsigned int) varFramePtr);
+ (unsigned int) varFramePtr);
}
if ((localIndex < 0) || (localIndex >= localCt)) {
fprintf(stderr, "\nTclGetIndexedScalar: can't get element of local %i in frame 0x%x with %i locals\n",
- localIndex, (unsigned int) varFramePtr, localCt);
+ localIndex, (unsigned int) varFramePtr, localCt);
panic("TclGetElementOfIndexedArray: bad local index %i in frame 0x%x",
- localIndex, (unsigned int) varFramePtr);
+ localIndex, (unsigned int) varFramePtr);
}
#endif /* TCL_COMPILE_DEBUG */
- /*
- * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- elem = Tcl_GetStringFromObj(elemPtr, (int *) NULL);
+ elem = TclGetString(elemPtr);
arrayPtr = &(compiledLocals[localIndex]);
arrayName = arrayPtr->name;
@@ -947,7 +942,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
/*
*----------------------------------------------------------------------
*
- * Tcl_SetCmd --
+ * Tcl_SetObjCmd --
*
* This procedure is invoked to process the "set" Tcl command.
* See the user documentation for details on what it does.
@@ -963,35 +958,32 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
/* ARGSUSED */
int
-Tcl_SetCmd(dummy, interp, argc, argv)
+Tcl_SetObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- if (argc == 2) {
- char *value;
+ Tcl_Obj *varValueObj;
- value = Tcl_GetVar2(interp, argv[1], (char *) NULL,
- TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1);
- if (value == NULL) {
+ if (objc == 2) {
+ varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+ if (varValueObj == NULL) {
return TCL_ERROR;
}
- Tcl_SetResult(interp, value, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, varValueObj);
return TCL_OK;
- } else if (argc == 3) {
- char *result;
+ } else if (objc == 3) {
- result = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2],
- TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1);
- if (result == NULL) {
+ varValueObj = Tcl_ObjSetVar2(interp, objv[1], NULL, objv[2],
+ TCL_LEAVE_ERR_MSG);
+ if (varValueObj == NULL) {
return TCL_ERROR;
}
- Tcl_SetResult(interp, result, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, varValueObj);
return TCL_OK;
} else {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " varName ?newValue?\"", (char *) NULL);
+ Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?");
return TCL_ERROR;
}
}
@@ -1008,7 +1000,7 @@ Tcl_SetCmd(dummy, interp, argc, argv)
* representation of the variable's new value. The caller must not
* modify this string. If the write operation was disallowed then NULL
* is returned; if the TCL_LEAVE_ERR_MSG flag is set, then an
- * explanatory message will be left in interp->result. Note that the
+ * explanatory message will be left in the interp's result. Note that the
* returned string may not be the same as newValue; this is because
* variable traces may modify the variable's value.
*
@@ -1031,8 +1023,7 @@ Tcl_SetVar(interp, varName, newValue, flags)
* TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
* TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
{
- return Tcl_SetVar2(interp, varName, (char *) NULL, newValue,
- (flags | TCL_PARSE_PART1));
+ return Tcl_SetVar2(interp, varName, (char *) NULL, newValue, flags);
}
/*
@@ -1051,7 +1042,7 @@ Tcl_SetVar(interp, varName, newValue, flags)
* modify this string. If the write operation was disallowed because an
* array was expected but not found (or vice versa), then NULL is
* returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
- * message will be left in interp->result. Note that the returned
+ * message will be left in the interp's result. Note that the returned
* string may not be the same as newValue; this is because variable
* traces may modify the variable's value.
*
@@ -1075,70 +1066,86 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags)
int flags; /* Various flags that tell how to set value:
* any of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
- * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or
- * TCL_PARSE_PART1. */
+ * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG */
{
register Tcl_Obj *valuePtr;
- register Tcl_Obj *part1Ptr;
- register Tcl_Obj *part2Ptr = NULL;
Tcl_Obj *varValuePtr;
- int length;
/*
* Create an object holding the variable's new value and use
- * Tcl_ObjSetVar2 to actually set the variable.
+ * Tcl_SetVar2Ex to actually set the variable.
*/
- length = newValue ? strlen(newValue) : 0;
- TclNewObj(valuePtr);
- TclInitStringRep(valuePtr, newValue, length);
+ valuePtr = Tcl_NewStringObj(newValue, -1);
Tcl_IncrRefCount(valuePtr);
- length = strlen(part1) ;
- TclNewObj(part1Ptr);
- TclInitStringRep(part1Ptr, part1, length);
- Tcl_IncrRefCount(part1Ptr);
-
- if (part2 != NULL) {
- length = strlen(part2);
- TclNewObj(part2Ptr);
- TclInitStringRep(part2Ptr, part2, length);
- Tcl_IncrRefCount(part2Ptr);
- }
-
- varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr,
- flags);
-
- TclDecrRefCount(part1Ptr); /* done with the part1 name object */
- if (part2Ptr != NULL) {
- TclDecrRefCount(part2Ptr); /* and the part2 name object */
- }
+ varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
Tcl_DecrRefCount(valuePtr); /* done with the object */
if (varValuePtr == NULL) {
- /*
- * Move the interpreter's object result to the string result,
- * then reset the object result.
- * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
- */
-
- Tcl_SetResult(interp,
- TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
- TCL_VOLATILE);
return NULL;
}
+ return TclGetString(varValuePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ObjSetVar2 --
+ *
+ * This function is the same as Tcl_SetVar2Ex below, except the
+ * variable names are passed in Tcl object instead of strings.
+ *
+ * Results:
+ * Returns a pointer to the Tcl_Obj holding the new value of the
+ * variable. If the write operation was disallowed because an array was
+ * expected but not found (or vice versa), then NULL is returned; if
+ * the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will
+ * be left in the interpreter's result. Note that the returned object
+ * may not be the same one referenced by newValuePtr; this is because
+ * variable traces may modify the variable's value.
+ *
+ * Side effects:
+ * The value of the given variable is set. If either the array or the
+ * entry didn't exist then a new variable is created.
- /*
- * THIS FAILS IF Tcl_ObjSetVar2's RESULT'S STRING REP HAS A NULL BYTE.
- */
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
+ Tcl_Interp *interp; /* Command interpreter in which variable is
+ * to be found. */
+ register Tcl_Obj *part1Ptr; /* Points to an object holding the name of
+ * an array (if part2 is non-NULL) or the
+ * name of a variable. */
+ register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding
+ * the name of an element in the array
+ * part1Ptr. */
+ Tcl_Obj *newValuePtr; /* New value for variable. */
+ int flags; /* Various flags that tell how to set value:
+ * any of TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+ * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or
+ * TCL_PARSE_PART1. */
+{
+ char *part1, *part2;
- return TclGetStringFromObj(varValuePtr, (int *) NULL);
+ part1 = Tcl_GetString(part1Ptr);
+ if (part2Ptr != NULL) {
+ part2 = Tcl_GetString(part2Ptr);
+ } else {
+ part2 = NULL;
+ }
+
+ return Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags);
}
/*
*----------------------------------------------------------------------
*
- * Tcl_ObjSetVar2 --
+ * Tcl_SetVar2Ex --
*
* Given a two-part variable name, which may refer either to a scalar
* variable or an element of an array, change the value of the variable
@@ -1162,7 +1169,7 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags)
* and incremented for its new value. If the new value for the variable
* is not the same one referenced by newValuePtr (perhaps as a result
* of a variable trace), then newValuePtr's ref count is left unchanged
- * by Tcl_ObjSetVar2. newValuePtr's ref count is also left unchanged if
+ * by Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if
* we are appending it as a string value: that is, if "flags" includes
* TCL_APPEND_VALUE but not TCL_LIST_ELEMENT.
*
@@ -1174,40 +1181,27 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags)
*/
Tcl_Obj *
-Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
+Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be found. */
- register Tcl_Obj *part1Ptr; /* Points to an object holding the name of
- * an array (if part2 is non-NULL) or the
- * name of a variable. */
- register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding
- * the name of an element in the array
- * part1Ptr. */
+ char *part1; /* Name of an array (if part2 is non-NULL)
+ * or the name of a variable. */
+ char *part2; /* If non-NULL, gives the name of an element
+ * in the array part1. */
Tcl_Obj *newValuePtr; /* New value for variable. */
int flags; /* Various flags that tell how to set value:
* any of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
- * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG, or
- * TCL_PARSE_PART1. */
+ * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */
{
Interp *iPtr = (Interp *) interp;
register Var *varPtr;
Var *arrayPtr;
Tcl_Obj *oldValuePtr;
Tcl_Obj *resultPtr = NULL;
- char *part1, *bytes;
- char *part2 = NULL;
+ char *bytes;
int length, result;
- /*
- * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- part1 = TclGetStringFromObj(part1Ptr, (int *) NULL);
- if (part2Ptr != NULL) {
- part2 = TclGetStringFromObj(part2Ptr, (int *) NULL);
- }
-
varPtr = TclLookupVar(interp, part1, part2, flags, "set",
/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
@@ -1216,15 +1210,19 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
/*
* If the variable is in a hashtable and its hPtr field is NULL, then we
- * have an upvar to an array element where the array was deleted,
- * leaving the element dangling at the end of the upvar. Generate an
- * error (allowing the variable to be reset would screw up our storage
- * allocation and is meaningless anyway).
+ * may have an upvar to an array element where the array was deleted
+ * or an upvar to a namespace variable whose namespace was deleted.
+ * Generate an error (allowing the variable to be reset would screw up
+ * our storage allocation and is meaningless anyway).
*/
if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, "set", danglingUpvar);
+ if (TclIsVarArrayElement(varPtr)) {
+ VarErrMsg(interp, part1, part2, "set", danglingElement);
+ } else {
+ VarErrMsg(interp, part1, part2, "set", danglingVar);
+ }
}
return NULL;
}
@@ -1266,12 +1264,12 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
if (oldValuePtr == NULL) {
TclNewObj(oldValuePtr);
varPtr->value.objPtr = oldValuePtr;
- Tcl_IncrRefCount(oldValuePtr); /* since var is reference */
+ Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */
} else if (Tcl_IsShared(oldValuePtr)) {
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
Tcl_DecrRefCount(oldValuePtr);
oldValuePtr = varPtr->value.objPtr;
- Tcl_IncrRefCount(oldValuePtr); /* since var is reference */
+ Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */
}
result = Tcl_ListObjAppendElement(interp, oldValuePtr,
newValuePtr);
@@ -1294,7 +1292,7 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
oldValuePtr = varPtr->value.objPtr;
Tcl_IncrRefCount(oldValuePtr); /* since var is ref */
}
- Tcl_AppendToObj(oldValuePtr, bytes, length);
+ Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
}
}
} else {
@@ -1314,7 +1312,7 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
neededBytes = Tcl_ScanElement(bytes, &listFlags);
oldValuePtr = Tcl_NewObj();
oldValuePtr->bytes = (char *)
- ckalloc((unsigned) (neededBytes + 1));
+ ckalloc((unsigned) (neededBytes + 1));
oldValuePtr->length = Tcl_ConvertElement(bytes,
oldValuePtr->bytes, listFlags);
varPtr->value.objPtr = oldValuePtr;
@@ -1340,7 +1338,7 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
if ((varPtr->tracePtr != NULL)
|| ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
char *msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_WRITES);
+ (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_WRITES);
if (msg != NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
VarErrMsg(interp, part1, part2, "set", msg);
@@ -1441,15 +1439,15 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg)
if (compiledLocals == NULL) {
fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x, no compiled locals\n",
- localIndex, (unsigned int) varFramePtr);
+ localIndex, (unsigned int) varFramePtr);
panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
- (unsigned int) varFramePtr);
+ (unsigned int) varFramePtr);
}
if ((localIndex < 0) || (localIndex >= localCt)) {
fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x with %i locals\n",
- localIndex, (unsigned int) varFramePtr, localCt);
+ localIndex, (unsigned int) varFramePtr, localCt);
panic("TclSetIndexedScalar: bad local index %i in frame 0x%x",
- localIndex, (unsigned int) varFramePtr);
+ localIndex, (unsigned int) varFramePtr);
}
#endif /* TCL_COMPILE_DEBUG */
@@ -1469,15 +1467,19 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg)
/*
* If the variable is in a hashtable and its hPtr field is NULL, then we
- * have an upvar to an array element where the array was deleted,
- * leaving the element dangling at the end of the upvar. Generate an
- * error (allowing the variable to be reset would screw up our storage
- * allocation and is meaningless anyway).
+ * may have an upvar to an array element where the array was deleted
+ * or an upvar to a namespace variable whose namespace was deleted.
+ * Generate an error (allowing the variable to be reset would screw up
+ * our storage allocation and is meaningless anyway).
*/
if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
if (leaveErrorMsg) {
- VarErrMsg(interp, varName, NULL, "set", danglingUpvar);
+ if (TclIsVarArrayElement(varPtr)) {
+ VarErrMsg(interp, varName, NULL, "set", danglingElement);
+ } else {
+ VarErrMsg(interp, varName, NULL, "set", danglingVar);
+ }
}
return NULL;
}
@@ -1622,23 +1624,19 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr,
if (compiledLocals == NULL) {
fprintf(stderr, "\nTclSetElementOfIndexedArray: can't set element of local %i in frame 0x%x, no compiled locals\n",
- localIndex, (unsigned int) varFramePtr);
+ localIndex, (unsigned int) varFramePtr);
panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
- (unsigned int) varFramePtr);
+ (unsigned int) varFramePtr);
}
if ((localIndex < 0) || (localIndex >= localCt)) {
fprintf(stderr, "\nTclSetIndexedScalar: can't set elememt of local %i in frame 0x%x with %i locals\n",
- localIndex, (unsigned int) varFramePtr, localCt);
+ localIndex, (unsigned int) varFramePtr, localCt);
panic("TclSetElementOfIndexedArray: bad local index %i in frame 0x%x",
- localIndex, (unsigned int) varFramePtr);
+ localIndex, (unsigned int) varFramePtr);
}
#endif /* TCL_COMPILE_DEBUG */
- /*
- * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- elem = Tcl_GetStringFromObj(elemPtr, (int *) NULL);
+ elem = TclGetString(elemPtr);
arrayPtr = &(compiledLocals[localIndex]);
arrayName = arrayPtr->name;
@@ -1654,13 +1652,32 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr,
}
/*
+ * If the variable is in a hashtable and its hPtr field is NULL, then we
+ * may have an upvar to an array element where the array was deleted
+ * or an upvar to a namespace variable whose namespace was deleted.
+ * Generate an error (allowing the variable to be reset would screw up
+ * our storage allocation and is meaningless anyway).
+ */
+
+ if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
+ if (leaveErrorMsg) {
+ if (TclIsVarArrayElement(arrayPtr)) {
+ VarErrMsg(interp, arrayName, elem, "set", danglingElement);
+ } else {
+ VarErrMsg(interp, arrayName, elem, "set", danglingVar);
+ }
+ }
+ goto errorReturn;
+ }
+
+ /*
* Make sure we're dealing with an array.
*/
if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
TclSetVarArray(arrayPtr);
arrayPtr->value.tablePtr =
- (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
TclClearVarUndefined(arrayPtr);
} else if (!TclIsVarArray(arrayPtr)) {
@@ -1783,7 +1800,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr,
*/
Tcl_Obj *
-TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed)
+TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be found. */
Tcl_Obj *part1Ptr; /* Points to an object holding the name of
@@ -1793,8 +1810,10 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed)
* the name of an element in the array
* part1Ptr. */
long incrAmount; /* Amount to be added to variable. */
- int part1NotParsed; /* 1 if part1 hasn't yet been parsed into
- * an array name and index (if any). */
+ int flags; /* Various flags that tell how to incr value:
+ * any of TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+ * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
{
register Tcl_Obj *varValuePtr;
Tcl_Obj *resultPtr;
@@ -1802,13 +1821,8 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed)
* so we must increment a copy (i.e. copy
* on write). */
long i;
- int flags, result;
+ int result;
- flags = TCL_LEAVE_ERR_MSG;
- if (part1NotParsed) {
- flags |= TCL_PARSE_PART1;
- }
-
varValuePtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
if (varValuePtr == NULL) {
Tcl_AddObjErrorInfo(interp,
@@ -1841,8 +1855,7 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed)
* Store the variable's new value and run any write traces.
*/
- resultPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, varValuePtr,
- flags);
+ resultPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, varValuePtr, flags);
if (resultPtr == NULL) {
return NULL;
}
@@ -1891,7 +1904,7 @@ TclIncrIndexedScalar(interp, localIndex, incrAmount)
int result;
varValuePtr = TclGetIndexedScalar(interp, localIndex,
- /*leaveErrorMsg*/ 1);
+ /*leaveErrorMsg*/ 1);
if (varValuePtr == NULL) {
Tcl_AddObjErrorInfo(interp,
"\n (reading value of variable to increment)", -1);
@@ -1925,7 +1938,7 @@ TclIncrIndexedScalar(interp, localIndex, incrAmount)
*/
resultPtr = TclSetIndexedScalar(interp, localIndex, varValuePtr,
- /*leaveErrorMsg*/ 1);
+ /*leaveErrorMsg*/ 1);
if (resultPtr == NULL) {
return NULL;
}
@@ -1978,7 +1991,7 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
int result;
varValuePtr = TclGetElementOfIndexedArray(interp, localIndex, elemPtr,
- /*leaveErrorMsg*/ 1);
+ /*leaveErrorMsg*/ 1);
if (varValuePtr == NULL) {
Tcl_AddObjErrorInfo(interp,
"\n (reading value of variable to increment)", -1);
@@ -2012,8 +2025,8 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
*/
resultPtr = TclSetElementOfIndexedArray(interp, localIndex, elemPtr,
- varValuePtr,
- /*leaveErrorMsg*/ 1);
+ varValuePtr,
+ /*leaveErrorMsg*/ 1);
if (resultPtr == NULL) {
return NULL;
}
@@ -2031,7 +2044,7 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
* Returns TCL_OK if the variable was successfully deleted, TCL_ERROR
* if the variable can't be unset. In the event of an error,
* if the TCL_LEAVE_ERR_MSG flag is set then an error message
- * is left in interp->result.
+ * is left in the interp's result.
*
* Side effects:
* If varName is defined as a local or global variable in interp,
@@ -2051,8 +2064,7 @@ Tcl_UnsetVar(interp, varName, flags)
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
* TCL_LEAVE_ERR_MSG. */
{
- return Tcl_UnsetVar2(interp, varName, (char *) NULL,
- (flags | TCL_PARSE_PART1));
+ return Tcl_UnsetVar2(interp, varName, (char *) NULL, flags);
}
/*
@@ -2066,7 +2078,7 @@ Tcl_UnsetVar(interp, varName, flags)
* Returns TCL_OK if the variable was successfully deleted, TCL_ERROR
* if the variable can't be unset. In the event of an error,
* if the TCL_LEAVE_ERR_MSG flag is set then an error message
- * is left in interp->result.
+ * is left in the interp's result.
*
* Side effects:
* If part1 and part2 indicate a local or global variable in interp,
@@ -2084,8 +2096,7 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
char *part2; /* Name of element within array or NULL. */
int flags; /* OR-ed combination of any of
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * TCL_LEAVE_ERR_MSG, or
- * TCL_PARSE_PART1. */
+ * TCL_LEAVE_ERR_MSG. */
{
Var dummyVar;
Var *varPtr, *dummyVarPtr;
@@ -2141,14 +2152,14 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
varPtr->refCount++;
dummyVar.flags &= ~VAR_TRACE_ACTIVE;
(void) CallTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1)) | TCL_TRACE_UNSETS);
+ (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
while (dummyVar.tracePtr != NULL) {
VarTrace *tracePtr = dummyVar.tracePtr;
dummyVar.tracePtr = tracePtr->nextPtr;
ckfree((char *) tracePtr);
}
for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
activePtr->nextTracePtr = NULL;
}
@@ -2165,8 +2176,23 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
dummyVarPtr = &dummyVar;
if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) {
+ /*
+ * Deleting the elements of the array may cause traces to be fired
+ * on those elements. Before deleting them, bump the reference count
+ * of the array, so that if those trace procs make a global or upvar
+ * link to the array, the array is not deleted when the call stack
+ * gets popped (we will delete the array ourselves later in this
+ * function).
+ *
+ * Bumping the count can lead to the odd situation that elements of the
+ * array are being deleted when the array still exists, but since the
+ * array is about to be removed anyway, that shouldn't really matter.
+ */
+ varPtr->refCount++;
DeleteArray(iPtr, part1, dummyVarPtr,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+ (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+ /* Decr ref count */
+ varPtr->refCount--;
}
if (TclIsVarScalar(dummyVarPtr)
&& (dummyVarPtr->value.objPtr != NULL)) {
@@ -2176,9 +2202,7 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
}
/*
- * If the variable was a namespace variable, decrement its reference
- * count. We are in the process of destroying its namespace so that
- * namespace will no longer "refer" to the variable.
+ * If the variable was a namespace variable, decrement its reference count.
*/
if (varPtr->flags & VAR_NAMESPACE_VAR) {
@@ -2242,8 +2266,8 @@ Tcl_TraceVar(interp, varName, flags, proc, clientData)
* invoked upon varName. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
- return Tcl_TraceVar2(interp, varName, (char *) NULL,
- (flags | TCL_PARSE_PART1), proc, clientData);
+ return Tcl_TraceVar2(interp, varName, (char *) NULL,
+ flags, proc, clientData);
}
/*
@@ -2278,8 +2302,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
int flags; /* OR-ed collection of bits, including any
* of TCL_TRACE_READS, TCL_TRACE_WRITES,
* TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY and
- * TCL_PARSE_PART1. */
+ * and TCL_NAMESPACE_ONLY. */
Tcl_VarTraceProc *proc; /* Procedure to call when specified ops are
* invoked upon varName. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
@@ -2301,7 +2324,8 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
tracePtr->traceProc = proc;
tracePtr->clientData = clientData;
tracePtr->flags =
- flags & (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS);
+ flags & (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+ TCL_TRACE_ARRAY);
tracePtr->nextPtr = varPtr->tracePtr;
varPtr->tracePtr = tracePtr;
return TCL_OK;
@@ -2338,8 +2362,7 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData)
Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
- Tcl_UntraceVar2(interp, varName, (char *) NULL,
- (flags | TCL_PARSE_PART1), proc, clientData);
+ Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);
}
/*
@@ -2371,8 +2394,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
* current trace, including any of
* TCL_TRACE_READS, TCL_TRACE_WRITES,
* TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY and
- * TCL_PARSE_PART1. */
+ * and TCL_NAMESPACE_ONLY. */
Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */
ClientData clientData; /* Arbitrary argument to pass to proc. */
{
@@ -2383,16 +2405,17 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
ActiveVarTrace *activePtr;
varPtr = TclLookupVar(interp, part1, part2,
- flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1),
+ flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),
/*msg*/ (char *) NULL,
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (varPtr == NULL) {
return;
}
- flags &= (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS);
+ flags &= (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+ TCL_TRACE_ARRAY);
for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ;
- prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+ prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
if (tracePtr == NULL) {
return;
}
@@ -2409,7 +2432,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
*/
for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->nextTracePtr == tracePtr) {
activePtr->nextTracePtr = tracePtr->nextPtr;
}
@@ -2462,8 +2485,8 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
- int flags; /* 0, TCL_GLOBAL_ONLY, or
- * TCL_NAMESPACE_ONLY. */
+ int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY (can be 0). */
Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */
ClientData prevClientData; /* If non-NULL, gives last value returned
* by this procedure, so this call will
@@ -2472,7 +2495,7 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
* first trace. */
{
return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
- (flags | TCL_PARSE_PART1), proc, prevClientData);
+ flags, proc, prevClientData);
}
/*
@@ -2500,8 +2523,7 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
* trace applies to scalar variable or array
* as-a-whole. */
int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY, and
- * TCL_PARSE_PART1. */
+ * TCL_NAMESPACE_ONLY. */
Tcl_VarTraceProc *proc; /* Procedure assocated with trace. */
ClientData prevClientData; /* If non-NULL, gives last value returned
* by this procedure, so this call will
@@ -2513,7 +2535,7 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
Var *varPtr, *arrayPtr;
varPtr = TclLookupVar(interp, part1, part2,
- flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_PARSE_PART1),
+ flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),
/*msg*/ (char *) NULL,
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (varPtr == NULL) {
@@ -2576,13 +2598,9 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
}
for (i = 1; i < objc; i++) {
- /*
- * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
- */
-
- name = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ name = TclGetString(objv[i]);
if (Tcl_UnsetVar2(interp, name, (char *) NULL,
- (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1)) != TCL_OK) {
+ TCL_LEAVE_ERR_MSG) != TCL_OK) {
return TCL_ERROR;
}
}
@@ -2623,24 +2641,20 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
return TCL_ERROR;
}
-
if (objc == 2) {
- varValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+ varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (varValuePtr == NULL) {
return TCL_ERROR;
}
} else {
for (i = 2; i < objc; i++) {
varValuePtr = Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- objv[i],
- (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+ objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG));
if (varValuePtr == NULL) {
return TCL_ERROR;
}
}
}
-
Tcl_SetObjResult(interp, varValuePtr);
return TCL_OK;
}
@@ -2679,10 +2693,9 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
return TCL_ERROR;
}
-
if (objc == 2) {
newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+ (TCL_LEAVE_ERR_MSG));
if (newValuePtr == NULL) {
/*
* The variable doesn't exist yet. Just create it with an empty
@@ -2691,7 +2704,7 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
Tcl_Obj *nullObjPtr = Tcl_NewObj();
newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
- nullObjPtr, (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+ nullObjPtr, TCL_LEAVE_ERR_MSG);
if (newValuePtr == NULL) {
Tcl_DecrRefCount(nullObjPtr); /* free unneeded object */
return TCL_ERROR;
@@ -2699,7 +2712,7 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
}
} else {
/*
- * We have arguments to append. We used to call Tcl_ObjSetVar2 to
+ * We have arguments to append. We used to call Tcl_SetVar2 to
* append each argument one at a time to ensure that traces were run
* for each append step. We now append the arguments all at once
* because it's faster. Note that a read trace and a write trace for
@@ -2710,8 +2723,7 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
createdNewObj = 0;
createVar = 1;
- varValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- TCL_PARSE_PART1);
+ varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (varValuePtr == NULL) {
/*
* We couldn't read the old value: either the var doesn't yet
@@ -2719,13 +2731,13 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
* create it with Tcl_ObjSetVar2 below.
*/
- char *name, *p;
+ char *p, *varName;
int nameBytes, i;
- name = TclGetStringFromObj(objv[1], &nameBytes);
- for (i = 0, p = name; i < nameBytes; i++, p++) {
+ varName = Tcl_GetStringFromObj(objv[1], &nameBytes);
+ for (i = 0, p = varName; i < nameBytes; i++, p++) {
if (*p == '(') {
- p = (name + nameBytes-1);
+ p = (varName + nameBytes-1);
if (*p == ')') { /* last char is ')' => array ref */
createVar = 0;
}
@@ -2765,7 +2777,7 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
if (numRequired > listRepPtr->maxElemCount) {
int newMax = (2 * numRequired);
Tcl_Obj **newElemPtrs = (Tcl_Obj **)
- ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
+ ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
memcpy((VOID *) newElemPtrs, (VOID *) elemPtrs,
(size_t) (numElems * sizeof(Tcl_Obj *)));
@@ -2798,8 +2810,8 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
* was new and we didn't create the variable.
*/
- newValuePtr = Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- varValuePtr, (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
+ newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
+ TCL_LEAVE_ERR_MSG);
if (newValuePtr == NULL) {
if (createdNewObj && !createVar) {
Tcl_DecrRefCount(varValuePtr); /* free unneeded obj */
@@ -2849,16 +2861,18 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
enum {ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET,
ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
- ARRAY_STARTSEARCH};
- static char *arrayOptions[] = {"anymore", "donesearch", "exists",
- "get", "names", "nextelement", "set", "size", "startsearch",
- (char *) NULL};
+ ARRAY_STARTSEARCH, ARRAY_UNSET};
+ static char *arrayOptions[] = {
+ "anymore", "donesearch", "exists", "get", "names", "nextelement",
+ "set", "size", "startsearch", "unset", (char *) NULL
+ };
+ Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
Tcl_HashEntry *hPtr;
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
int notArray;
- char *varName;
+ char *varName, *msg;
int index, result;
@@ -2867,17 +2881,16 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option", 0, &index)
- != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option",
+ 0, &index) != TCL_OK) {
return TCL_ERROR;
}
/*
* Locate the array variable (and it better be an array).
- * THIS FAILS IF A NAME OBJECT'S STRING REP HAS A NULL BYTE.
*/
- varName = TclGetStringFromObj(objv[2], (int *) NULL);
+ varName = TclGetString(objv[2]);
varPtr = TclLookupVar(interp, varName, (char *) NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
@@ -2886,7 +2899,22 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
|| TclIsVarUndefined(varPtr)) {
notArray = 1;
}
-
+
+ /*
+ * Special array trace used to keep the env array in sync for
+ * array names, array get, etc.
+ */
+
+ if (varPtr != NULL && varPtr->tracePtr != NULL) {
+ msg = CallTraces(iPtr, arrayPtr, varPtr, varName, NULL,
+ (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
+ TCL_TRACE_ARRAY));
+ if (msg != NULL) {
+ VarErrMsg(interp, varName, NULL, "trace array", msg);
+ return TCL_ERROR;
+ }
+ }
+
switch (index) {
case ARRAY_ANYMORE: {
ArraySearch *searchPtr;
@@ -2900,7 +2928,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
if (notArray) {
goto error;
}
- searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+ searchId = Tcl_GetString(objv[3]);
searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
if (searchPtr == NULL) {
return TCL_ERROR;
@@ -2935,7 +2963,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
if (notArray) {
goto error;
}
- searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+ searchId = Tcl_GetString(objv[3]);
searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
if (searchPtr == NULL) {
return TCL_ERROR;
@@ -2944,7 +2972,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
varPtr->searchPtr = searchPtr->nextPtr;
} else {
for (prevPtr = varPtr->searchPtr; ;
- prevPtr = prevPtr->nextPtr) {
+ prevPtr = prevPtr->nextPtr) {
if (prevPtr->nextPtr == searchPtr) {
prevPtr->nextPtr = searchPtr->nextPtr;
break;
@@ -2977,10 +3005,10 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
return TCL_OK;
}
if (objc == 4) {
- pattern = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+ pattern = TclGetString(objv[3]);
}
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
if (TclIsVarUndefined(varPtr2)) {
continue;
@@ -3028,10 +3056,10 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
return TCL_OK;
}
if (objc == 4) {
- pattern = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+ pattern = Tcl_GetString(objv[3]);
}
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
if (TclIsVarUndefined(varPtr2)) {
continue;
@@ -3044,7 +3072,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
namePtr = Tcl_NewStringObj(name, -1);
result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
if (result != TCL_OK) {
- Tcl_DecrRefCount(namePtr); /* free unneeded name object */
+ Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
return result;
}
}
@@ -3063,7 +3091,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
if (notArray) {
goto error;
}
- searchId = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+ searchId = Tcl_GetString(objv[3]);
searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
if (searchPtr == NULL) {
return TCL_ERROR;
@@ -3090,73 +3118,11 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
break;
}
case ARRAY_SET: {
- Tcl_Obj **elemPtrs;
- int listLen, i, result;
-
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
return TCL_ERROR;
}
- result = Tcl_ListObjGetElements(interp, objv[3], &listLen,
- &elemPtrs);
- if (result != TCL_OK) {
- return result;
- }
- if (listLen & 1) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "list must have an even number of elements", -1);
- return TCL_ERROR;
- }
- if (listLen > 0) {
- for (i = 0; i < listLen; i += 2) {
- if (Tcl_ObjSetVar2(interp, objv[2], elemPtrs[i],
- elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- break;
- }
- }
- return result;
- }
-
- /*
- * The list is empty make sure we have an array, or create
- * one if necessary.
- */
-
- if (varPtr != NULL) {
- if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
- /*
- * Already an array, done.
- */
-
- return TCL_OK;
- }
- if (TclIsVarArrayElement(varPtr) ||
- !TclIsVarUndefined(varPtr)) {
- /*
- * Either an array element, or a scalar: lose!
- */
-
- VarErrMsg(interp, varName, (char *)NULL, "array set",
- needArray);
- return TCL_ERROR;
- }
- } else {
- /*
- * Create variable for new array.
- */
-
- varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, 0,
- /*createPart1*/ 1, /*createPart2*/ 0,
- &arrayPtr);
- }
- TclSetVarArray(varPtr);
- TclClearVarUndefined(varPtr);
- varPtr->value.tablePtr =
- (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
- return TCL_OK;
+ return(TclArraySet(interp, objv[2], objv[3]));
}
case ARRAY_SIZE: {
Tcl_HashSearch search;
@@ -3171,7 +3137,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
if (!notArray) {
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr,
&search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
if (TclIsVarUndefined(varPtr2)) {
continue;
@@ -3198,12 +3164,12 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
Tcl_AppendStringsToObj(resultPtr, "s-1-", varName,
(char *) NULL);
} else {
- char string[20];
+ char string[TCL_INTEGER_SPACE];
searchPtr->id = varPtr->searchPtr->id + 1;
TclFormatInt(string, searchPtr->id);
Tcl_AppendStringsToObj(resultPtr, "s-", string, "-", varName,
- (char *) NULL);
+ (char *) NULL);
}
searchPtr->varPtr = varPtr;
searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
@@ -3212,6 +3178,46 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
varPtr->searchPtr = searchPtr;
break;
}
+ case ARRAY_UNSET: {
+ Tcl_HashSearch search;
+ Var *varPtr2;
+ char *pattern = NULL;
+ char *name;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+ return TCL_ERROR;
+ }
+ if (notArray) {
+ return TCL_OK;
+ }
+ if (objc == 3) {
+ /*
+ * When no pattern is given, just unset the whole array
+ */
+ if (Tcl_UnsetVar2(interp, varName, (char *) NULL, 0)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ pattern = Tcl_GetString(objv[3]);
+ for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr,
+ &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+ if (TclIsVarUndefined(varPtr2)) {
+ continue;
+ }
+ name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
+ if (Tcl_StringMatch(name, pattern) &&
+ (Tcl_UnsetVar2(interp, varName, name, 0)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ break;
+ }
}
return TCL_OK;
@@ -3224,6 +3230,124 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * TclArraySet --
+ *
+ * Set the elements of an array. If there are no elements to
+ * set, create an empty array. This routine is used by the
+ * Tcl_ArrayObjCmd and by the TclSetupEnv routine.
+ *
+ * Results:
+ * A standard Tcl result object.
+ *
+ * Side effects:
+ * A variable will be created if one does not already exist.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclArraySet(interp, arrayNameObj, arrayElemObj)
+ Tcl_Interp *interp; /* Current interpreter. */
+ Tcl_Obj *arrayNameObj; /* The array name. */
+ Tcl_Obj *arrayElemObj; /* The array elements list. If this is
+ * NULL, create an empty array. */
+{
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj **elemPtrs;
+ int result, elemLen, i;
+ char *varName, *p;
+
+ varName = TclGetString(arrayNameObj);
+ for (p = varName; *p ; p++) {
+ if (*p == '(') {
+ do {
+ p++;
+ } while (*p != '\0');
+ p--;
+ if (*p == ')') {
+ VarErrMsg(interp, varName, NULL, "set", needArray);
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+
+ varPtr = TclLookupVar(interp, varName, (char *) NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ if (arrayElemObj != NULL) {
+ result = Tcl_ListObjGetElements(interp, arrayElemObj,
+ &elemLen, &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (elemLen & 1) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "list must have an even number of elements", -1);
+ return TCL_ERROR;
+ }
+ if (elemLen > 0) {
+ for (i = 0; i < elemLen; i += 2) {
+ if (Tcl_ObjSetVar2(interp, arrayNameObj, elemPtrs[i],
+ elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ break;
+ }
+ }
+ return result;
+ }
+ }
+
+ /*
+ * The list is empty make sure we have an array, or create
+ * one if necessary.
+ */
+
+ if (varPtr != NULL) {
+ if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
+ /*
+ * Already an array, done.
+ */
+
+ return TCL_OK;
+ }
+ if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
+ /*
+ * Either an array element, or a scalar: lose!
+ */
+
+ VarErrMsg(interp, varName, (char *)NULL, "array set", needArray);
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * Create variable for new array.
+ */
+
+ varPtr = TclLookupVar(interp, varName, (char *) NULL,
+ TCL_LEAVE_ERR_MSG, "set",
+ /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
+
+ /*
+ * Still couldn't do it - this can occur if a non-existent
+ * namespace was specified
+ */
+ if (varPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ TclSetVarArray(varPtr);
+ TclClearVarUndefined(varPtr);
+ varPtr->value.tablePtr =
+ (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* MakeUpvar --
*
* This procedure does all of the work of the "global" and "upvar"
@@ -3262,7 +3386,7 @@ MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags)
Tcl_HashTable *tablePtr;
Namespace *nsPtr, *altNsPtr, *dummyNsPtr;
char *tail;
- int new, result;
+ int new;
/*
* Find "other" in "framePtr". If not looking up other in just the
@@ -3301,21 +3425,18 @@ MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags)
varFramePtr = iPtr->varFramePtr;
if ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
- || (varFramePtr == NULL)
- || !varFramePtr->isProcCallFrame
- || (strstr(myName, "::") != NULL)) {
- result = TclGetNamespaceForQualName((Tcl_Interp *) iPtr, myName,
- (Namespace *) NULL, (myFlags | TCL_LEAVE_ERR_MSG),
- &nsPtr, &altNsPtr, &dummyNsPtr, &tail);
- if (result != TCL_OK) {
- return result;
- }
+ || (varFramePtr == NULL)
+ || !varFramePtr->isProcCallFrame
+ || (strstr(myName, "::") != NULL)) {
+ TclGetNamespaceForQualName((Tcl_Interp *) iPtr, myName,
+ (Namespace *) NULL, myFlags, &nsPtr, &altNsPtr, &dummyNsPtr, &tail);
+
if (nsPtr == NULL) {
nsPtr = altNsPtr;
}
if (nsPtr == NULL) {
Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
- myName, "\": unknown namespace", (char *) NULL);
+ myName, "\": unknown namespace", (char *) NULL);
return TCL_ERROR;
}
@@ -3408,11 +3529,11 @@ MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags)
}
} else if (!TclIsVarUndefined(varPtr)) {
Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" already exists", (char *) NULL);
+ "\" already exists", (char *) NULL);
return TCL_ERROR;
} else if (varPtr->tracePtr != NULL) {
Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" has traces: can't use for upvar", (char *) NULL);
+ "\" has traces: can't use for upvar", (char *) NULL);
return TCL_ERROR;
}
}
@@ -3433,7 +3554,7 @@ MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags)
*
* Results:
* A standard Tcl completion code. If an error occurs then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* The variable in frameName whose name is given by varName becomes
@@ -3506,7 +3627,7 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
*
* Results:
* A standard Tcl completion code. If an error occurs then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* The variable in frameName whose name is given by part1 and
@@ -3645,7 +3766,7 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv)
*/
objPtr = objv[i];
- varName = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+ varName = TclGetString(objPtr);
/*
* The variable name might have a scope qualifier, but the name for
@@ -3719,7 +3840,7 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- char *varName, *tail;
+ char *varName, *tail, *cp;
Var *varPtr, *arrayPtr;
Tcl_Obj *varValuePtr;
int i, result;
@@ -3730,10 +3851,20 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
* it if necessary.
*/
- varName = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ varName = TclGetString(objv[i]);
varPtr = TclLookupVar(interp, varName, (char *) NULL,
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
+
+ if (arrayPtr != NULL) {
+ /*
+ * Variable cannot be an element in an array. If arrayPtr is
+ * non-null, it is, so throw up an error and return.
+ */
+ VarErrMsg(interp, varName, NULL, "define", isArrayElement);
+ return TCL_ERROR;
+ }
+
if (varPtr == NULL) {
return TCL_ERROR;
}
@@ -3758,8 +3889,8 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
*/
if (i+1 < objc) { /* a value was specified */
- varValuePtr = Tcl_ObjSetVar2(interp, objv[i], (Tcl_Obj *) NULL,
- objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
+ varValuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, objv[i+1],
+ (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
if (varValuePtr == NULL) {
return TCL_ERROR;
}
@@ -3775,17 +3906,17 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
/*
* varName might have a scope qualifier, but the name for the
* local "link" variable must be the simple name at the tail.
+ *
+ * Locate tail in one pass: drop any prefix after two *or more*
+ * consecutive ":" characters).
*/
- for (tail = varName; *tail != '\0'; tail++) {
- /* empty body */
- }
- while ((tail > varName)
- && ((*tail != ':') || (*(tail-1) != ':'))) {
- tail--;
- }
- if (*tail == ':') {
- tail++;
+ for (tail = cp = varName; *cp != '\0'; ) {
+ if (*cp++ == ':') {
+ while (*cp == ':') {
+ tail = ++cp;
+ }
+ }
}
/*
@@ -3845,10 +3976,10 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
/*
* Find the call frame containing each of the "other variables" to be
- * linked to. FAILS IF objv[1]'s STRING REP CONTAINS NULLS.
+ * linked to.
*/
- frameSpec = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+ frameSpec = TclGetString(objv[1]);
result = TclGetFrame(interp, frameSpec, &framePtr);
if (result == -1) {
return TCL_ERROR;
@@ -3866,8 +3997,8 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
*/
for ( ; objc > 0; objc -= 2, objv += 2) {
- myVarName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
- otherVarName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+ myVarName = TclGetString(objv[1]);
+ otherVarName = TclGetString(objv[0]);
for (p = otherVarName; *p != 0; p++) {
if (*p == '(') {
char *openParen = p;
@@ -3939,9 +4070,7 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
* indicates what's happening to variable,
* plus other stuff like TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY, and
- * TCL_INTERP_DESTROYED. May also contain
- * TCL_PARSE_PART1, which should not be
- * passed through to callbacks. */
+ * TCL_INTERP_DESTROYED. */
{
register VarTrace *tracePtr;
ActiveVarTrace active;
@@ -3970,11 +4099,8 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
*/
copiedName = 0;
- if (flags & TCL_PARSE_PART1) {
- for (p = part1; ; p++) {
- if (*p == 0) {
- break;
- }
+ if (part2 == NULL) {
+ for (p = part1; *p ; p++) {
if (*p == '(') {
openParen = p;
do {
@@ -3985,7 +4111,7 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
Tcl_DStringInit(&nameCopy);
Tcl_DStringAppend(&nameCopy, part1, (p-part1));
part2 = Tcl_DStringValue(&nameCopy)
- + (openParen + 1 - part1);
+ + (openParen + 1 - part1);
part2[-1] = 0;
part1 = Tcl_DStringValue(&nameCopy);
copiedName = 1;
@@ -3994,7 +4120,6 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
}
}
}
- flags &= ~TCL_PARSE_PART1;
/*
* Invoke traces on the array containing the variable, if relevant.
@@ -4007,7 +4132,7 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
arrayPtr->refCount++;
active.varPtr = arrayPtr;
for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL;
- tracePtr = active.nextTracePtr) {
+ tracePtr = active.nextTracePtr) {
active.nextTracePtr = tracePtr->nextPtr;
if (!(tracePtr->flags & flags)) {
continue;
@@ -4033,7 +4158,7 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
}
active.varPtr = varPtr;
for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
- tracePtr = active.nextTracePtr) {
+ tracePtr = active.nextTracePtr) {
active.nextTracePtr = tracePtr->nextPtr;
if (!(tracePtr->flags & flags)) {
continue;
@@ -4116,7 +4241,7 @@ NewVar()
* Results:
* The return value is a pointer to the array search indicated
* by string, or NULL if there isn't one. If NULL is returned,
- * interp->result contains an error message.
+ * the interp's result contains an error message.
*
* Side effects:
* None.
@@ -4165,7 +4290,7 @@ ParseSearchId(interp, varPtr, varName, string)
*/
for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
- searchPtr = searchPtr->nextPtr) {
+ searchPtr = searchPtr->nextPtr) {
if (searchPtr->id == id) {
return searchPtr;
}
@@ -4255,7 +4380,7 @@ TclDeleteVars(iPtr, tablePtr)
}
for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr = Tcl_NextHashEntry(&search)) {
varPtr = (Var *) Tcl_GetHashValue(hPtr);
/*
@@ -4296,8 +4421,7 @@ TclDeleteVars(iPtr, tablePtr)
Tcl_IncrRefCount(objPtr); /* until done with traces */
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
(void) CallTraces(iPtr, (Var *) NULL, varPtr,
- Tcl_GetStringFromObj(objPtr, (int *) NULL),
- (char *) NULL, flags);
+ Tcl_GetString(objPtr), (char *) NULL, flags);
Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
while (varPtr->tracePtr != NULL) {
@@ -4306,7 +4430,7 @@ TclDeleteVars(iPtr, tablePtr)
ckfree((char *) tracePtr);
}
for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
activePtr->nextTracePtr = NULL;
}
@@ -4430,7 +4554,7 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
ckfree((char *) tracePtr);
}
for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
activePtr->nextTracePtr = NULL;
}
@@ -4500,7 +4624,7 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
DeleteSearches(varPtr);
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
elPtr = (Var *) Tcl_GetHashValue(hPtr);
if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
objPtr = elPtr->value.objPtr;
@@ -4518,7 +4642,7 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
ckfree((char *) tracePtr);
}
for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
- activePtr = activePtr->nextPtr) {
+ activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == elPtr) {
activePtr->nextTracePtr = NULL;
}
@@ -4595,7 +4719,7 @@ CleanupVar(varPtr, arrayPtr)
* None.
*
* Side effects:
- * Interp->result is reset to hold a message identifying the
+ * The interp's result is set to hold a message identifying the
* variable given by part1 and part2 and describing why the
* variable operation failed.
*
@@ -4612,9 +4736,73 @@ VarErrMsg(interp, part1, part2, operation, reason)
{
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
- (char *) NULL);
+ (char *) NULL);
if (part2 != NULL) {
Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
}
Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceVarExists --
+ *
+ * This is called from info exists. We need to trigger read
+ * and/or array traces because they may end up creating a
+ * variable that doesn't currently exist.
+ *
+ * Results:
+ * A pointer to the Var structure, or NULL.
+ *
+ * Side effects:
+ * May fill in error messages in the interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Var *
+TclVarTraceExists(interp, varName)
+ Tcl_Interp *interp; /* The interpreter */
+ char *varName; /* The variable name */
+{
+ Var *varPtr;
+ Var *arrayPtr;
+ char *msg;
+
+ /*
+ * The choice of "create" flag values is delicate here, and
+ * matches the semantics of GetVar. Things are still not perfect,
+ * however, because if you do "info exists x" you get a varPtr
+ * and therefore trigger traces. However, if you do
+ * "info exists x(i)", then you only get a varPtr if x is already
+ * known to be an array. Otherwise you get NULL, and no trace
+ * is triggered. This matches Tcl 7.6 semantics.
+ */
+
+ varPtr = TclLookupVar(interp, varName, (char *) NULL,
+ 0, "access",
+ /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ return NULL;
+ }
+ if ((varPtr != NULL) &&
+ ((varPtr->tracePtr != NULL)
+ || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
+ msg = CallTraces((Interp *)interp, arrayPtr, varPtr, varName,
+ (char *) NULL, TCL_TRACE_READS);
+ if (msg != NULL) {
+ /*
+ * If the variable doesn't exist anymore and no-one's using
+ * it, then free up the relevant structures and hash table entries.
+ */
+
+ if (TclIsVarUndefined(varPtr)) {
+ CleanupVar(varPtr, arrayPtr);
+ }
+ return NULL;
+ }
+ }
+ return varPtr;
+}
diff --git a/tcl/library/auto.tcl b/tcl/library/auto.tcl
new file mode 100644
index 00000000000..37a47a201cb
--- /dev/null
+++ b/tcl/library/auto.tcl
@@ -0,0 +1,587 @@
+# auto.tcl --
+#
+# utility procs formerly in init.tcl dealing with auto execution
+# of commands and can be auto loaded themselves.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1998 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# auto_reset --
+#
+# Destroy all cached information for auto-loading and auto-execution,
+# so that the information gets recomputed the next time it's needed.
+# Also delete any procedures that are listed in the auto-load index
+# except those defined in this file.
+#
+# Arguments:
+# None.
+
+proc auto_reset {} {
+ global auto_execs auto_index auto_oldpath
+ foreach p [info procs] {
+ if {[info exists auto_index($p)] && ![string match auto_* $p]
+ && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
+ tcl_findLibrary pkg_compareExtension
+ tclMacPkgSearch tclPkgUnknown} $p] < 0)} {
+ rename $p {}
+ }
+ }
+ catch {unset auto_execs}
+ catch {unset auto_index}
+ catch {unset auto_oldpath}
+}
+
+# tcl_findLibrary --
+#
+# This is a utility for extensions that searches for a library directory
+# using a canonical searching algorithm. A side effect is to source
+# the initialization script and set a global library variable.
+#
+# Arguments:
+# basename Prefix of the directory name, (e.g., "tk")
+# version Version number of the package, (e.g., "8.0")
+# patch Patchlevel of the package, (e.g., "8.0.3")
+# initScript Initialization script to source (e.g., tk.tcl)
+# enVarName environment variable to honor (e.g., TK_LIBRARY)
+# varName Global variable to set when done (e.g., tk_library)
+# CYGNUS LOCAL: We have funny things like gdb having different library
+# names before & after install (and neither of them is gdb
+# or gdb$version...
+# srcLibName The name of the library directory in the build tree (assumed to be
+# under the basename directory.
+# instLibName The name of the installed library directory
+# pkgName The package name (for cases like Itcl where you have
+# several subpackages under one package...
+# debug_startup Run the startup proc through debugger_eval?
+
+proc tcl_findLibrary {basename version patch initScript
+ enVarName varName {srcLibName {}} {instLibName {}}
+ {pkgName {}} {debug_startup 0}} {
+ upvar #0 $varName the_library
+ global env errorInfo
+
+ set dirs {}
+ set errors {}
+ # The C application may have hardwired a path, which we honor
+
+ if {[info exist the_library] && [string compare $the_library {}]} {
+ lappend dirs $the_library
+ } else {
+
+ # Do the canonical search
+
+ # 1. From an environment variable, if it exists
+
+ if {[info exists env($enVarName)]} {
+ lappend dirs $env($enVarName)
+ }
+
+ # 2. Relative to the Tcl library
+
+ if {$srcLibName == ""} {
+ set srcLibName library
+ }
+ if {$instLibName == ""} {
+ set instLibName $basename$version
+ }
+
+ lappend dirs [file join [file dirname [info library]] \
+ $basename$version]
+
+ set parentDir [file dirname [file dirname [info nameofexecutable]]]
+ set grandParentDir [file dirname $parentDir]
+ lappend dirs [file join $parentDir lib $basename$version]
+ lappend dirs [file join $grandParentDir lib $basename$version]
+ lappend dirs [file join $parentDir library]
+ lappend dirs [file join $grandParentDir library]
+ if {![regexp {.*[ab][0-9]*} $patch ver]} {
+ set ver $version
+ }
+ lappend dirs [file join $grandParentDir $basename$ver library]
+ lappend dirs [file join [file dirname $grandParentDir] $basename$ver library]
+ }
+
+ foreach i $dirs {
+ set the_library $i
+ set file [file join $i $initScript]
+
+ # source everything when in a safe interpreter because
+ # we have a source command, but no file exists command
+
+ if {[interp issafe] || [file exists $file]} {
+ if {$debug_startup} {
+
+ if {![catch {uplevel \#0 debugger_eval [list [list source $file]]} msg]} {
+ return
+ } else {
+ append errors "$file: $msg\n$errorInfo\n"
+ }
+ } else {
+ if {![catch {uplevel \#0 [list source $file]} msg]} {
+ return
+ } else {
+ append errors "$file: $msg\n$errorInfo\n"
+ }
+ }
+ }
+ }
+ set msg "Can't find a usable $initScript in the following directories: \n"
+ append msg " $dirs\n\n"
+ append msg "$errors\n\n"
+ append msg "This probably means that $basename wasn't installed properly.\n"
+ error $msg
+}
+
+# ----------------------------------------------------------------------
+# auto_mkindex
+# ----------------------------------------------------------------------
+# The following procedures are used to generate the tclIndex file
+# from Tcl source files. They use a special safe interpreter to
+# parse Tcl source files, writing out index entries as "proc"
+# commands are encountered. This implementation won't work in a
+# safe interpreter, since a safe interpreter can't create the
+# special parser and mess with its commands.
+
+if {[interp issafe]} {
+ return ;# Stop sourcing the file here
+}
+
+# auto_mkindex --
+# Regenerate a tclIndex file from Tcl source files. Takes as argument
+# the name of the directory in which the tclIndex file is to be placed,
+# followed by any number of glob patterns to use in that directory to
+# locate all of the relevant files.
+#
+# Arguments:
+# dir - Name of the directory in which to create an index.
+# args - Any number of additional arguments giving the
+# names of files within dir. If no additional
+# are given auto_mkindex will look for *.tcl.
+
+proc auto_mkindex {dir args} {
+ global errorCode errorInfo
+
+ if {[interp issafe]} {
+ error "can't generate index within safe interpreter"
+ }
+
+ set oldDir [pwd]
+ cd $dir
+ set dir [pwd]
+
+ append index "# Tcl autoload index file, version 2.0\n"
+ append index "# This file is generated by the \"auto_mkindex\" command\n"
+ append index "# and sourced to set up indexing information for one or\n"
+ append index "# more commands. Typically each line is a command that\n"
+ append index "# sets an element in the auto_index array, where the\n"
+ append index "# element name is the name of a command and the value is\n"
+ append index "# a script that loads the command.\n\n"
+ if {$args == ""} {
+ set args *.tcl
+ }
+
+ auto_mkindex_parser::init
+ foreach file [eval glob $args] {
+ if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
+ append index $msg
+ } else {
+ set code $errorCode
+ set info $errorInfo
+ cd $oldDir
+ error $msg $info $code
+ }
+ }
+ auto_mkindex_parser::cleanup
+
+ set fid [open "tclIndex" w]
+ puts -nonewline $fid $index
+ close $fid
+ cd $oldDir
+}
+
+# Original version of auto_mkindex that just searches the source
+# code for "proc" at the beginning of the line.
+
+proc auto_mkindex_old {dir args} {
+ global errorCode errorInfo
+ set oldDir [pwd]
+ cd $dir
+ set dir [pwd]
+ append index "# Tcl autoload index file, version 2.0\n"
+ append index "# This file is generated by the \"auto_mkindex\" command\n"
+ append index "# and sourced to set up indexing information for one or\n"
+ append index "# more commands. Typically each line is a command that\n"
+ append index "# sets an element in the auto_index array, where the\n"
+ append index "# element name is the name of a command and the value is\n"
+ append index "# a script that loads the command.\n\n"
+ if {[string equal $args ""]} {
+ set args *.tcl
+ }
+ foreach file [eval glob $args] {
+ set f ""
+ set error [catch {
+ set f [open $file]
+ while {[gets $f line] >= 0} {
+ if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
+ set procName [lindex [auto_qualify $procName "::"] 0]
+ append index "set [list auto_index($procName)]"
+ append index " \[list source \[file join \$dir [list $file]\]\]\n"
+ }
+ }
+ close $f
+ } msg]
+ if {$error} {
+ set code $errorCode
+ set info $errorInfo
+ catch {close $f}
+ cd $oldDir
+ error $msg $info $code
+ }
+ }
+ set f ""
+ set error [catch {
+ set f [open tclIndex w]
+ puts -nonewline $f $index
+ close $f
+ cd $oldDir
+ } msg]
+ if {$error} {
+ set code $errorCode
+ set info $errorInfo
+ catch {close $f}
+ cd $oldDir
+ error $msg $info $code
+ }
+}
+
+# Create a safe interpreter that can be used to parse Tcl source files
+# generate a tclIndex file for autoloading. This interp contains
+# commands for things that need index entries. Each time a command
+# is executed, it writes an entry out to the index file.
+
+namespace eval auto_mkindex_parser {
+ variable parser "" ;# parser used to build index
+ variable index "" ;# maintains index as it is built
+ variable scriptFile "" ;# name of file being processed
+ variable contextStack "" ;# stack of namespace scopes
+ variable imports "" ;# keeps track of all imported cmds
+ variable initCommands "" ;# list of commands that create aliases
+
+ proc init {} {
+ variable parser
+ variable initCommands
+
+ if {![interp issafe]} {
+ set parser [interp create -safe]
+ $parser hide info
+ $parser hide rename
+ $parser hide proc
+ $parser hide namespace
+ $parser hide eval
+ $parser hide puts
+ $parser invokehidden namespace delete ::
+ $parser invokehidden proc unknown {args} {}
+
+ # We'll need access to the "namespace" command within the
+ # interp. Put it back, but move it out of the way.
+
+ $parser expose namespace
+ $parser invokehidden rename namespace _%@namespace
+ $parser expose eval
+ $parser invokehidden rename eval _%@eval
+
+ # Install all the registered psuedo-command implementations
+
+ foreach cmd $initCommands {
+ eval $cmd
+ }
+ }
+ }
+ proc cleanup {} {
+ variable parser
+ interp delete $parser
+ unset parser
+ }
+}
+
+# auto_mkindex_parser::mkindex --
+#
+# Used by the "auto_mkindex" command to create a "tclIndex" file for
+# the given Tcl source file. Executes the commands in the file, and
+# handles things like the "proc" command by adding an entry for the
+# index file. Returns a string that represents the index file.
+#
+# Arguments:
+# file Name of Tcl source file to be indexed.
+
+proc auto_mkindex_parser::mkindex {file} {
+ variable parser
+ variable index
+ variable scriptFile
+ variable contextStack
+ variable imports
+
+ set scriptFile $file
+
+ set fid [open $file]
+ set contents [read $fid]
+ close $fid
+
+ # There is one problem with sourcing files into the safe
+ # interpreter: references like "$x" will fail since code is not
+ # really being executed and variables do not really exist.
+ # To avoid this, we replace all $ with \0 (literally, the null char)
+ # later, when getting proc names we will have to reverse this replacement,
+ # in case there were any $ in the proc name. This will cause a problem
+ # if somebody actually tries to have a \0 in their proc name. Too bad
+ # for them.
+ regsub -all {\$} $contents "\0" contents
+
+ set index ""
+ set contextStack ""
+ set imports ""
+
+ $parser eval $contents
+
+ foreach name $imports {
+ catch {$parser eval [list _%@namespace forget $name]}
+ }
+ return $index
+}
+
+# auto_mkindex_parser::hook command
+#
+# Registers a Tcl command to evaluate when initializing the
+# slave interpreter used by the mkindex parser.
+# The command is evaluated in the master interpreter, and can
+# use the variable auto_mkindex_parser::parser to get to the slave
+
+proc auto_mkindex_parser::hook {cmd} {
+ variable initCommands
+
+ lappend initCommands $cmd
+}
+
+# auto_mkindex_parser::slavehook command
+#
+# Registers a Tcl command to evaluate when initializing the
+# slave interpreter used by the mkindex parser.
+# The command is evaluated in the slave interpreter.
+
+proc auto_mkindex_parser::slavehook {cmd} {
+ variable initCommands
+
+ # The $parser variable is defined to be the name of the
+ # slave interpreter when this command is used later.
+
+ lappend initCommands "\$parser eval [list $cmd]"
+}
+
+# auto_mkindex_parser::command --
+#
+# Registers a new command with the "auto_mkindex_parser" interpreter
+# that parses Tcl files. These commands are fake versions of things
+# like the "proc" command. When you execute them, they simply write
+# out an entry to a "tclIndex" file for auto-loading.
+#
+# This procedure allows extensions to register their own commands
+# with the auto_mkindex facility. For example, a package like
+# [incr Tcl] might register a "class" command so that class definitions
+# could be added to a "tclIndex" file for auto-loading.
+#
+# Arguments:
+# name Name of command recognized in Tcl files.
+# arglist Argument list for command.
+# body Implementation of command to handle indexing.
+
+proc auto_mkindex_parser::command {name arglist body} {
+ hook [list auto_mkindex_parser::commandInit $name $arglist $body]
+}
+
+# auto_mkindex_parser::commandInit --
+#
+# This does the actual work set up by auto_mkindex_parser::command
+# This is called when the interpreter used by the parser is created.
+#
+# Arguments:
+# name Name of command recognized in Tcl files.
+# arglist Argument list for command.
+# body Implementation of command to handle indexing.
+
+proc auto_mkindex_parser::commandInit {name arglist body} {
+ variable parser
+
+ set ns [namespace qualifiers $name]
+ set tail [namespace tail $name]
+ if {[string equal $ns ""]} {
+ set fakeName "[namespace current]::_%@fake_$tail"
+ } else {
+ set fakeName "_%@fake_$name"
+ regsub -all {::} $fakeName "_" fakeName
+ set fakeName "[namespace current]::$fakeName"
+ }
+ proc $fakeName $arglist $body
+
+ # YUK! Tcl won't let us alias fully qualified command names,
+ # so we can't handle names like "::itcl::class". Instead,
+ # we have to build procs with the fully qualified names, and
+ # have the procs point to the aliases.
+
+ if {[regexp {::} $name]} {
+ set exportCmd [list _%@namespace export [namespace tail $name]]
+ $parser eval [list _%@namespace eval $ns $exportCmd]
+
+ # The following proc definition does not work if you
+ # want to tolerate space or something else diabolical
+ # in the procedure name, (i.e., space in $alias)
+ # The following does not work:
+ # "_%@eval {$alias} \$args"
+ # because $alias gets concat'ed to $args.
+ # The following does not work because $cmd is somehow undefined
+ # "set cmd {$alias} \; _%@eval {\$cmd} \$args"
+ # A gold star to someone that can make test
+ # autoMkindex-3.3 work properly
+
+ set alias [namespace tail $fakeName]
+ $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
+ $parser alias $alias $fakeName
+ } else {
+ $parser alias $name $fakeName
+ }
+ return
+}
+
+# auto_mkindex_parser::fullname --
+# Used by commands like "proc" within the auto_mkindex parser.
+# Returns the qualified namespace name for the "name" argument.
+# If the "name" does not start with "::", elements are added from
+# the current namespace stack to produce a qualified name. Then,
+# the name is examined to see whether or not it should really be
+# qualified. If the name has more than the leading "::", it is
+# returned as a fully qualified name. Otherwise, it is returned
+# as a simple name. That way, the Tcl autoloader will recognize
+# it properly.
+#
+# Arguments:
+# name - Name that is being added to index.
+
+proc auto_mkindex_parser::fullname {name} {
+ variable contextStack
+
+ if {![string match ::* $name]} {
+ foreach ns $contextStack {
+ set name "${ns}::$name"
+ if {[string match ::* $name]} {
+ break
+ }
+ }
+ }
+
+ if {[string equal [namespace qualifiers $name] ""]} {
+ set name [namespace tail $name]
+ } elseif {![string match ::* $name]} {
+ set name "::$name"
+ }
+
+ # Earlier, mkindex replaced all $'s with \0. Now, we have to reverse
+ # that replacement.
+ regsub -all "\0" $name "\$" name
+ return $name
+}
+
+# Register all of the procedures for the auto_mkindex parser that
+# will build the "tclIndex" file.
+
+# AUTO MKINDEX: proc name arglist body
+# Adds an entry to the auto index list for the given procedure name.
+
+auto_mkindex_parser::command proc {name args} {
+ variable index
+ variable scriptFile
+ # Do some fancy reformatting on the "source" call to handle platform
+ # differences with respect to pathnames. Use format just so that the
+ # command is a little easier to read (otherwise it'd be full of
+ # backslashed dollar signs, etc.
+ append index [list set auto_index([fullname $name])] \
+ [format { [list source [file join $dir %s]]} \
+ [file split $scriptFile]] "\n"
+}
+
+# Conditionally add support for Tcl byte code files. There are some
+# tricky details here. First, we need to get the tbcload library
+# initialized in the current interpreter. We cannot load tbcload into the
+# slave until we have done so because it needs access to the tcl_patchLevel
+# variable. Second, because the package index file may defer loading the
+# library until we invoke a command, we need to explicitly invoke auto_load
+# to force it to be loaded. This should be a noop if the package has
+# already been loaded
+
+auto_mkindex_parser::hook {
+ if {![catch {package require tbcload}]} {
+ if {[llength [info commands tbcload::bcproc]] == 0} {
+ auto_load tbcload::bcproc
+ }
+ load {} tbcload $auto_mkindex_parser::parser
+
+ # AUTO MKINDEX: tbcload::bcproc name arglist body
+ # Adds an entry to the auto index list for the given pre-compiled
+ # procedure name.
+
+ auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
+ variable index
+ variable scriptFile
+ # Do some nice reformatting of the "source" call, to get around
+ # path differences on different platforms. We use the format
+ # command just so that the code is a little easier to read.
+ append index [list set auto_index([fullname $name])] \
+ [format { [list source [file join $dir %s]]} \
+ [file split $scriptFile]] "\n"
+ }
+ }
+}
+
+# AUTO MKINDEX: namespace eval name command ?arg arg...?
+# Adds the namespace name onto the context stack and evaluates the
+# associated body of commands.
+#
+# AUTO MKINDEX: namespace import ?-force? pattern ?pattern...?
+# Performs the "import" action in the parser interpreter. This is
+# important for any commands contained in a namespace that affect
+# the index. For example, a script may say "itcl::class ...",
+# or it may import "itcl::*" and then say "class ...". This
+# procedure does the import operation, but keeps track of imported
+# patterns so we can remove the imports later.
+
+auto_mkindex_parser::command namespace {op args} {
+ switch -- $op {
+ eval {
+ variable parser
+ variable contextStack
+
+ set name [lindex $args 0]
+ set args [lrange $args 1 end]
+
+ set contextStack [linsert $contextStack 0 $name]
+ $parser eval [list _%@namespace eval $name] $args
+ set contextStack [lrange $contextStack 1 end]
+ }
+ import {
+ variable parser
+ variable imports
+ foreach pattern $args {
+ if {[string compare $pattern "-force"]} {
+ lappend imports $pattern
+ }
+ }
+ catch {$parser eval "_%@namespace import $args"}
+ }
+ }
+}
+
+return
diff --git a/tcl/library/dde1.0/pkgIndex.tcl b/tcl/library/dde1.0/pkgIndex.tcl
new file mode 100755
index 00000000000..62777593152
--- /dev/null
+++ b/tcl/library/dde1.0/pkgIndex.tcl
@@ -0,0 +1 @@
+package ifneeded dde 1.0 "load [list [file join $dir tcldde81.dll]] dde"
diff --git a/tcl/library/dde1.1/pkgIndex.tcl b/tcl/library/dde1.1/pkgIndex.tcl
new file mode 100644
index 00000000000..f818736326f
--- /dev/null
+++ b/tcl/library/dde1.1/pkgIndex.tcl
@@ -0,0 +1,5 @@
+if {[info exists tcl_platform(debug)]} {
+ package ifneeded dde 1.1 [list load [file join $dir tcldde83d.dll] dde]
+} else {
+ package ifneeded dde 1.1 [list load [file join $dir tcldde83.dll] dde]
+}
diff --git a/tcl/library/encoding/ascii.enc b/tcl/library/encoding/ascii.enc
new file mode 100644
index 00000000000..e0320b8c589
--- /dev/null
+++ b/tcl/library/encoding/ascii.enc
@@ -0,0 +1,20 @@
+# Encoding file: ascii, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/big5.enc b/tcl/library/encoding/big5.enc
new file mode 100644
index 00000000000..26179f43d34
--- /dev/null
+++ b/tcl/library/encoding/big5.enc
@@ -0,0 +1,1516 @@
+# Encoding file: big5, multi-byte
+M
+003F 0 89
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3000FF0C30013002FF0E2022FF1BFF1AFF1FFF01FE3020262025FE50FF64FE52
+00B7FE54FE55FE56FE57FF5C2013FE312014FE33FFFDFE34FE4FFF08FF09FE35
+FE36FF5BFF5DFE37FE3830143015FE39FE3A30103011FE3BFE3C300A300BFE3D
+FE3E30083009FE3FFE40300C300DFE41FE42300E300FFE43FE44FE59FE5A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FE5BFE5CFE5DFE5E20182019201C201D301D301E20352032FF03FF06FF0A
+203B00A7300325CB25CF25B325B225CE2606260525C725C625A125A025BD25BC
+32A32105203EFFFDFF3FFFFDFE49FE4AFE4DFE4EFE4BFE4CFE5FFE60FE61FF0B
+FF0D00D700F700B1221AFF1CFF1EFF1D226622672260221E22522261FE62FE63
+FE64FE65FE66223C2229222A22A52220221F22BF33D233D1222B222E22352234
+26402642264126092191219321902192219621972199219822252223FFFD0000
+A2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FFFDFF0FFF3CFF0400A5301200A200A3FF05FF2021032109FE69FE6AFE6B33D5
+339C339D339E33CE33A1338E338F33C400B05159515B515E515D5161516355E7
+74E97CCE25812582258325842585258625872588258F258E258D258C258B258A
+2589253C2534252C2524251C2594250025022595250C251025142518256D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000256E2570256F2550255E256A256125E225E325E525E4257125722573FF10
+FF11FF12FF13FF14FF15FF16FF17FF18FF192160216121622163216421652166
+216721682169302130223023302430253026302730283029FFFD5344FFFDFF21
+FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2FFF30FF31
+FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF41FF42FF43FF44FF45FF46FF47
+FF48FF49FF4AFF4BFF4CFF4DFF4EFF4FFF50FF51FF52FF53FF54FF55FF560000
+A3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FF57FF58FF59FF5A039103920393039403950396039703980399039A039B039C
+039D039E039F03A003A103A303A403A503A603A703A803A903B103B203B303B4
+03B503B603B703B803B903BA03BB03BC03BD03BE03BF03C003C103C303C403C5
+03C603C703C803C931053106310731083109310A310B310C310D310E310F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00003110311131123113311431153116311731183119311A311B311C311D311E
+311F312031213122312331243125312631273128312902D902C902CA02C702CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E004E594E014E034E434E5D4E864E8C4EBA513F5165516B51E052005201529B
+53155341535C53C84E094E0B4E084E0A4E2B4E3851E14E454E484E5F4E5E4E8E
+4EA15140520352FA534353C953E3571F58EB5915592759735B505B515B535BF8
+5C0F5C225C385C715DDD5DE55DF15DF25DF35DFE5E725EFE5F0B5F13624D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E114E104E0D4E2D4E304E394E4B5C394E884E914E954E924E944EA24EC1
+4EC04EC34EC64EC74ECD4ECA4ECB4EC4514351415167516D516E516C519751F6
+52065207520852FB52FE52FF53165339534853475345535E538453CB53CA53CD
+58EC5929592B592A592D5B545C115C245C3A5C6F5DF45E7B5EFF5F145F155FC3
+62086236624B624E652F6587659765A465B965E566F0670867286B206B626B79
+6BCB6BD46BDB6C0F6C34706B722A7236723B72477259725B72AC738B4E190000
+A5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E164E154E144E184E3B4E4D4E4F4E4E4EE54ED84ED44ED54ED64ED74EE34EE4
+4ED94EDE514551445189518A51AC51F951FA51F8520A52A0529F530553065317
+531D4EDF534A534953615360536F536E53BB53EF53E453F353EC53EE53E953E8
+53FC53F853F553EB53E653EA53F253F153F053E553ED53FB56DB56DA59160000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000592E5931597459765B555B835C3C5DE85DE75DE65E025E035E735E7C5F01
+5F185F175FC5620A625362546252625165A565E6672E672C672A672B672D6B63
+6BCD6C116C106C386C416C406C3E72AF7384738974DC74E67518751F75287529
+7530753175327533758B767D76AE76BF76EE77DB77E277F3793A79BE7A747ACB
+4E1E4E1F4E524E534E694E994EA44EA64EA54EFF4F094F194F0A4F154F0D4F10
+4F114F0F4EF24EF64EFB4EF04EF34EFD4F014F0B514951475146514851680000
+A6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5171518D51B0521752115212520E521652A3530853215320537053715409540F
+540C540A54105401540B54045411540D54085403540E5406541256E056DE56DD
+573357305728572D572C572F57295919591A59375938598459785983597D5979
+598259815B575B585B875B885B855B895BFA5C165C795DDE5E065E765E740000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F0F5F1B5FD95FD6620E620C620D62106263625B6258653665E965E865EC
+65ED66F266F36709673D6734673167356B216B646B7B6C166C5D6C576C596C5F
+6C606C506C556C616C5B6C4D6C4E7070725F725D767E7AF97C737CF87F367F8A
+7FBD80018003800C80128033807F8089808B808C81E381EA81F381FC820C821B
+821F826E8272827E866B8840884C8863897F96214E324EA84F4D4F4F4F474F57
+4F5E4F344F5B4F554F304F504F514F3D4F3A4F384F434F544F3C4F464F630000
+A7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4F5C4F604F2F4F4E4F364F594F5D4F484F5A514C514B514D517551B651B75225
+52245229522A522852AB52A952AA52AC532353735375541D542D541E543E5426
+544E542754465443543354485442541B5429544A5439543B5438542E54355436
+5420543C54405431542B541F542C56EA56F056E456EB574A57515740574D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005747574E573E5750574F573B58EF593E599D599259A8599E59A359995996
+598D59A45993598A59A55B5D5B5C5B5A5B5B5B8C5B8B5B8F5C2C5C405C415C3F
+5C3E5C905C915C945C8C5DEB5E0C5E8F5E875E8A5EF75F045F1F5F645F625F77
+5F795FD85FCC5FD75FCD5FF15FEB5FF85FEA6212621162846297629662806276
+6289626D628A627C627E627962736292626F6298626E62956293629162866539
+653B653865F166F4675F674E674F67506751675C6756675E6749674667600000
+A8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+675367576B656BCF6C426C5E6C996C816C886C896C856C9B6C6A6C7A6C906C70
+6C8C6C686C966C926C7D6C836C726C7E6C746C866C766C8D6C946C986C827076
+707C707D707872627261726072C472C27396752C752B75377538768276EF77E3
+79C179C079BF7A767CFB7F5580968093809D8098809B809A80B2826F82920000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000828B828D898B89D28A008C378C468C558C9D8D648D708DB38EAB8ECA8F9B
+8FB08FC28FC68FC58FC45DE1909190A290AA90A690A3914991C691CC9632962E
+9631962A962C4E264E564E734E8B4E9B4E9E4EAB4EAC4F6F4F9D4F8D4F734F7F
+4F6C4F9B4F8B4F864F834F704F754F884F694F7B4F964F7E4F8F4F914F7A5154
+51525155516951775176517851BD51FD523B52385237523A5230522E52365241
+52BE52BB5352535453535351536653775378537953D653D453D7547354750000
+A9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5496547854955480547B5477548454925486547C549054715476548C549A5462
+5468548B547D548E56FA57835777576A5769576157665764577C591C59495947
+59485944595459BE59BB59D459B959AE59D159C659D059CD59CB59D359CA59AF
+59B359D259C55B5F5B645B635B975B9A5B985B9C5B995B9B5C1A5C485C450000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C465CB75CA15CB85CA95CAB5CB15CB35E185E1A5E165E155E1B5E115E78
+5E9A5E975E9C5E955E965EF65F265F275F295F805F815F7F5F7C5FDD5FE05FFD
+5FF55FFF600F6014602F60356016602A6015602160276029602B601B62166215
+623F623E6240627F62C962CC62C462BF62C262B962D262DB62AB62D362D462CB
+62C862A862BD62BC62D062D962C762CD62B562DA62B162D862D662D762C662AC
+62CE653E65A765BC65FA66146613660C66066602660E6600660F6615660A0000
+AA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6607670D670B676D678B67956771679C677367776787679D6797676F6770677F
+6789677E67906775679A6793677C676A67726B236B666B676B7F6C136C1B6CE3
+6CE86CF36CB16CCC6CE56CB36CBD6CBE6CBC6CE26CAB6CD56CD36CB86CC46CB9
+6CC16CAE6CD76CC56CF16CBF6CBB6CE16CDB6CCA6CAC6CEF6CDC6CD66CE00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007095708E7092708A7099722C722D723872487267726972C072CE72D972D7
+72D073A973A8739F73AB73A5753D759D7599759A768476C276F276F477E577FD
+793E7940794179C979C87A7A7A797AFA7CFE7F547F8C7F8B800580BA80A580A2
+80B180A180AB80A980B480AA80AF81E581FE820D82B3829D829982AD82BD829F
+82B982B182AC82A582AF82B882A382B082BE82B7864E8671521D88688ECB8FCE
+8FD48FD190B590B890B190B691C791D195779580961C9640963F963B96440000
+AB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+964296B996E89752975E4E9F4EAD4EAE4FE14FB54FAF4FBF4FE04FD14FCF4FDD
+4FC34FB64FD84FDF4FCA4FD74FAE4FD04FC44FC24FDA4FCE4FDE4FB751575192
+519151A0524E5243524A524D524C524B524752C752C952C352C1530D5357537B
+539A53DB54AC54C054A854CE54C954B854A654B354C754C254BD54AA54C10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054C454C854AF54AB54B154BB54A954A754BF56FF5782578B57A057A357A2
+57CE57AE579359555951594F594E595059DC59D859FF59E359E85A0359E559EA
+59DA59E65A0159FB5B695BA35BA65BA45BA25BA55C015C4E5C4F5C4D5C4B5CD9
+5CD25DF75E1D5E255E1F5E7D5EA05EA65EFA5F085F2D5F655F885F855F8A5F8B
+5F875F8C5F896012601D60206025600E6028604D60706068606260466043606C
+606B606A6064624162DC6316630962FC62ED630162EE62FD630762F162F70000
+AC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62EF62EC62FE62F463116302653F654565AB65BD65E26625662D66206627662F
+661F66286631662466F767FF67D367F167D467D067EC67B667AF67F567E967EF
+67C467D167B467DA67E567B867CF67DE67F367B067D967E267DD67D26B6A6B83
+6B866BB56BD26BD76C1F6CC96D0B6D326D2A6D416D256D0C6D316D1E6D170000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D3B6D3D6D3E6D366D1B6CF56D396D276D386D296D2E6D356D0E6D2B70AB
+70BA70B370AC70AF70AD70B870AE70A472307272726F727472E972E072E173B7
+73CA73BB73B273CD73C073B3751A752D754F754C754E754B75AB75A475A575A2
+75A3767876867687768876C876C676C376C5770176F976F87709770B76FE76FC
+770777DC78027814780C780D794679497948794779B979BA79D179D279CB7A7F
+7A817AFF7AFD7C7D7D027D057D007D097D077D047D067F387F8E7FBF80040000
+AD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8010800D8011803680D680E580DA80C380C480CC80E180DB80CE80DE80E480DD
+81F4822282E78303830582E382DB82E6830482E58302830982D282D782F18301
+82DC82D482D182DE82D382DF82EF830686508679867B867A884D886B898189D4
+8A088A028A038C9E8CA08D748D738DB48ECD8ECC8FF08FE68FE28FEA8FE50000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008FED8FEB8FE48FE890CA90CE90C190C3914B914A91CD95829650964B964C
+964D9762976997CB97ED97F3980198A898DB98DF999699994E584EB3500C500D
+50234FEF502650254FF8502950165006503C501F501A501250114FFA50005014
+50284FF15021500B501950184FF34FEE502D502A4FFE502B5009517C51A451A5
+51A251CD51CC51C651CB5256525C5254525B525D532A537F539F539D53DF54E8
+55105501553754FC54E554F2550654FA551454E954ED54E1550954EE54EA0000
+AE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54E65527550754FD550F5703570457C257D457CB57C35809590F59575958595A
+5A115A185A1C5A1F5A1B5A1359EC5A205A235A295A255A0C5A095B6B5C585BB0
+5BB35BB65BB45BAE5BB55BB95BB85C045C515C555C505CED5CFD5CFB5CEA5CE8
+5CF05CF65D015CF45DEE5E2D5E2B5EAB5EAD5EA75F315F925F915F9060590000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006063606560506055606D6069606F6084609F609A608D6094608C60856096
+624762F3630862FF634E633E632F635563426346634F6349633A6350633D632A
+632B6328634D634C65486549659965C165C566426649664F66436652664C6645
+664166F867146715671768216838684868466853683968426854682968B36817
+684C6851683D67F468506840683C6843682A68456813681868416B8A6B896BB7
+6C236C276C286C266C246CF06D6A6D956D886D876D666D786D776D596D930000
+AF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6D6C6D896D6E6D5A6D746D696D8C6D8A6D796D856D656D9470CA70D870E470D9
+70C870CF7239727972FC72F972FD72F872F7738673ED740973EE73E073EA73DE
+7554755D755C755A755975BE75C575C775B275B375BD75BC75B975C275B8768B
+76B076CA76CD76CE7729771F7720772877E9783078277838781D783478370000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007825782D7820781F7832795579507960795F7956795E795D7957795A79E4
+79E379E779DF79E679E979D87A847A887AD97B067B117C897D217D177D0B7D0A
+7D207D227D147D107D157D1A7D1C7D0D7D197D1B7F3A7F5F7F947FC57FC18006
+8018801580198017803D803F80F1810280F0810580ED80F4810680F880F38108
+80FD810A80FC80EF81ED81EC82008210822A822B8228822C82BB832B83528354
+834A83388350834983358334834F833283398336831783408331832883430000
+B0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8654868A86AA869386A486A9868C86A3869C8870887788818882887D88798A18
+8A108A0E8A0C8A158A0A8A178A138A168A0F8A118C488C7A8C798CA18CA28D77
+8EAC8ED28ED48ECF8FB1900190068FF790008FFA8FF490038FFD90058FF89095
+90E190DD90E29152914D914C91D891DD91D791DC91D995839662966396610000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000965B965D96649658965E96BB98E299AC9AA89AD89B259B329B3C4E7E507A
+507D505C50475043504C505A504950655076504E5055507550745077504F500F
+506F506D515C519551F0526A526F52D252D952D852D55310530F5319533F5340
+533E53C366FC5546556A55665544555E55615543554A55315556554F5555552F
+55645538552E555C552C55635533554155575708570B570957DF5805580A5806
+57E057E457FA5802583557F757F9592059625A365A415A495A665A6A5A400000
+B1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A3C5A625A5A5A465A4A5B705BC75BC55BC45BC25BBF5BC65C095C085C075C60
+5C5C5C5D5D075D065D0E5D1B5D165D225D115D295D145D195D245D275D175DE2
+5E385E365E335E375EB75EB85EB65EB55EBE5F355F375F575F6C5F695F6B5F97
+5F995F9E5F985FA15FA05F9C607F60A3608960A060A860CB60B460E660BD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060C560BB60B560DC60BC60D860D560C660DF60B860DA60C7621A621B6248
+63A063A76372639663A263A563776367639863AA637163A963896383639B636B
+63A863846388639963A163AC6392638F6380637B63696368637A655D65566551
+65596557555F654F655865556554659C659B65AC65CF65CB65CC65CE665D665A
+666466686666665E66F952D7671B688168AF68A2689368B5687F687668B168A7
+689768B0688368C468AD688668856894689D68A8689F68A168826B326BBA0000
+B2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6BEB6BEC6C2B6D8E6DBC6DF36DD96DB26DE16DCC6DE46DFB6DFA6E056DC76DCB
+6DAF6DD16DAE6DDE6DF96DB86DF76DF56DC56DD26E1A6DB56DDA6DEB6DD86DEA
+6DF16DEE6DE86DC66DC46DAA6DEC6DBF6DE670F97109710A70FD70EF723D727D
+7281731C731B73167313731973877405740A7403740673FE740D74E074F60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000074F7751C75227565756675627570758F75D475D575B575CA75CD768E76D4
+76D276DB7737773E773C77367738773A786B7843784E79657968796D79FB7A92
+7A957B207B287B1B7B2C7B267B197B1E7B2E7C927C977C957D467D437D717D2E
+7D397D3C7D407D307D337D447D2F7D427D327D317F3D7F9E7F9A7FCC7FCE7FD2
+801C804A8046812F81168123812B81298130812482028235823782368239838E
+839E8398837883A2839683BD83AB8392838A8393838983A08377837B837C0000
+B3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+838683A786555F6A86C786C086B686C486B586C686CB86B186AF86C98853889E
+888888AB88928896888D888B8993898F8A2A8A1D8A238A258A318A2D8A1F8A1B
+8A228C498C5A8CA98CAC8CAB8CA88CAA8CA78D678D668DBE8DBA8EDB8EDF9019
+900D901A90179023901F901D90109015901E9020900F90229016901B90140000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090E890ED90FD915791CE91F591E691E391E791ED91E99589966A96759673
+96789670967496769677966C96C096EA96E97AE07ADF980298039B5A9CE59E75
+9E7F9EA59EBB50A2508D508550995091508050965098509A670051F152725274
+5275526952DE52DD52DB535A53A5557B558055A7557C558A559D55985582559C
+55AA55945587558B558355B355AE559F553E55B2559A55BB55AC55B1557E5589
+55AB5599570D582F582A58345824583058315821581D582058F958FA59600000
+B4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A775A9A5A7F5A925A9B5AA75B735B715BD25BCC5BD35BD05C0A5C0B5C315D4C
+5D505D345D475DFD5E455E3D5E405E435E7E5ECA5EC15EC25EC45F3C5F6D5FA9
+5FAA5FA860D160E160B260B660E0611C612360FA611560F060FB60F4616860F1
+610E60F6610961006112621F624963A3638C63CF63C063E963C963C663CD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000063D263E363D063E163D663ED63EE637663F463EA63DB645263DA63F9655E
+6566656265636591659065AF666E667066746676666F6691667A667E667766FE
+66FF671F671D68FA68D568E068D868D7690568DF68F568EE68E768F968D268F2
+68E368CB68CD690D6912690E68C968DA696E68FB6B3E6B3A6B3D6B986B966BBC
+6BEF6C2E6C2F6C2C6E2F6E386E546E216E326E676E4A6E206E256E236E1B6E5B
+6E586E246E566E6E6E2D6E266E6F6E346E4D6E3A6E2C6E436E1D6E3E6ECB0000
+B5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6E896E196E4E6E636E446E726E696E5F7119711A7126713071217136716E711C
+724C728472807336732573347329743A742A743374227425743574367434742F
+741B7426742875257526756B756A75E275DB75E375D975D875DE75E0767B767C
+7696769376B476DC774F77ED785D786C786F7A0D7A087A0B7A057A007A980000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A977A967AE57AE37B497B567B467B507B527B547B4D7B4B7B4F7B517C9F
+7CA57D5E7D507D687D557D2B7D6E7D727D617D667D627D707D7355847FD47FD5
+800B8052808581558154814B8151814E81398146813E814C815381748212821C
+83E9840383F8840D83E083C5840B83C183EF83F183F48457840A83F0840C83CC
+83FD83F283CA8438840E840483DC840783D483DF865B86DF86D986ED86D486DB
+86E486D086DE885788C188C288B1898389968A3B8A608A558A5E8A3C8A410000
+B6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8A548A5B8A508A468A348A3A8A368A568C618C828CAF8CBC8CB38CBD8CC18CBB
+8CC08CB48CB78CB68CBF8CB88D8A8D858D818DCE8DDD8DCB8DDA8DD18DCC8DDB
+8DC68EFB8EF88EFC8F9C902E90359031903890329036910290F5910990FE9163
+916591CF9214921592239209921E920D9210920792119594958F958B95910000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000095939592958E968A968E968B967D96859686968D9672968496C196C596C4
+96C696C796EF96F297CC98059806980898E798EA98EF98E998F298ED99AE99AD
+9EC39ECD9ED14E8250AD50B550B250B350C550BE50AC50B750BB50AF50C7527F
+5277527D52DF52E652E452E252E3532F55DF55E855D355E655CE55DC55C755D1
+55E355E455EF55DA55E155C555C655E555C957125713585E585158585857585A
+5854586B584C586D584A58625852584B59675AC15AC95ACC5ABE5ABD5ABC0000
+B7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5AB35AC25AB25D695D6F5E4C5E795EC95EC85F125F595FAC5FAE611A610F6148
+611F60F3611B60F961016108614E614C6144614D613E61346127610D61066137
+622162226413643E641E642A642D643D642C640F641C6414640D643664166417
+6406656C659F65B06697668966876688669666846698668D67036994696D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000695A697769606954697569306982694A6968696B695E695369796986695D
+6963695B6B476B726BC06BBF6BD36BFD6EA26EAF6ED36EB66EC26E906E9D6EC7
+6EC56EA56E986EBC6EBA6EAB6ED16E966E9C6EC46ED46EAA6EA76EB4714E7159
+7169716471497167715C716C7166714C7165715E714671687156723A72527337
+7345733F733E746F745A7455745F745E7441743F7459745B745C757675787600
+75F0760175F275F175FA75FF75F475F376DE76DF775B776B7766775E77630000
+B8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7779776A776C775C77657768776277EE788E78B078977898788C7889787C7891
+7893787F797A797F7981842C79BD7A1C7A1A7A207A147A1F7A1E7A9F7AA07B77
+7BC07B607B6E7B677CB17CB37CB57D937D797D917D817D8F7D5B7F6E7F697F6A
+7F727FA97FA87FA480568058808680848171817081788165816E8173816B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008179817A81668205824784828477843D843184758466846B8449846C845B
+843C8435846184638469846D8446865E865C865F86F9871387088707870086FE
+86FB870287038706870A885988DF88D488D988DC88D888DD88E188CA88D588D2
+899C89E38A6B8A728A738A668A698A708A878A7C8A638AA08A718A858A6D8A62
+8A6E8A6C8A798A7B8A3E8A688C628C8A8C898CCA8CC78CC88CC48CB28CC38CC2
+8CC58DE18DDF8DE88DEF8DF38DFA8DEA8DE48DE68EB28F038F098EFE8F0A0000
+B9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8F9F8FB2904B904A905390429054903C905590509047904F904E904D9051903E
+904191129117916C916A916991C9923792579238923D9240923E925B924B9264
+925192349249924D92459239923F925A959896989694969596CD96CB96C996CA
+96F796FB96F996F6975697749776981098119813980A9812980C98FC98F40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000098FD98FE99B399B199B49AE19CE99E829F0E9F139F2050E750EE50E550D6
+50ED50DA50D550CF50D150F150CE50E9516251F352835282533153AD55FE5600
+561B561755FD561456065609560D560E55F75616561F5608561055F657185716
+5875587E58835893588A58795885587D58FD592559225924596A59695AE15AE6
+5AE95AD75AD65AD85AE35B755BDE5BE75BE15BE55BE65BE85BE25BE45BDF5C0D
+5C625D845D875E5B5E635E555E575E545ED35ED65F0A5F465F705FB961470000
+BA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+613F614B617761626163615F615A61586175622A64876458645464A46478645F
+647A645164676434646D647B657265A165D765D666A266A8669D699C69A86995
+69C169AE69D369CB699B69B769BB69AB69B469D069CD69AD69CC69A669C369A3
+6B496B4C6C336F336F146EFE6F136EF46F296F3E6F206F2C6F0F6F026F220000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006EFF6EEF6F066F316F386F326F236F156F2B6F2F6F886F2A6EEC6F016EF2
+6ECC6EF771947199717D718A71847192723E729272967344735074647463746A
+7470746D750475917627760D760B7609761376E176E37784777D777F776178C1
+789F78A778B378A978A3798E798F798D7A2E7A317AAA7AA97AED7AEF7BA17B95
+7B8B7B757B977B9D7B947B8F7BB87B877B847CB97CBD7CBE7DBB7DB07D9C7DBD
+7DBE7DA07DCA7DB47DB27DB17DBA7DA27DBF7DB57DB87DAD7DD27DC77DAC0000
+BB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7F707FE07FE17FDF805E805A808781508180818F8188818A817F818281E781FA
+82078214821E824B84C984BF84C684C48499849E84B2849C84CB84B884C084D3
+849084BC84D184CA873F871C873B872287258734871887558737872988F38902
+88F488F988F888FD88E8891A88EF8AA68A8C8A9E8AA38A8D8AA18A938AA40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008AAA8AA58AA88A988A918A9A8AA78C6A8C8D8C8C8CD38CD18CD28D6B8D99
+8D958DFC8F148F128F158F138FA390609058905C90639059905E9062905D905B
+91199118911E917591789177917492789280928592989296927B9293929C92A8
+927C929195A195A895A995A395A595A49699969C969B96CC96D29700977C9785
+97F69817981898AF98B199039905990C990999C19AAF9AB09AE69B419B429CF4
+9CF69CF39EBC9F3B9F4A5104510050FB50F550F9510251085109510551DC0000
+BC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+528752885289528D528A52F053B2562E563B56395632563F563456295653564E
+565756745636562F56305880589F589E58B3589C58AE58A958A6596D5B095AFB
+5B0B5AF55B0C5B085BEE5BEC5BE95BEB5C645C655D9D5D945E625E5F5E615EE2
+5EDA5EDF5EDD5EE35EE05F485F715FB75FB561766167616E615D615561820000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000617C6170616B617E61A7619061AB618E61AC619A61A4619461AE622E6469
+646F6479649E64B26488649064B064A56493649564A9649264AE64AD64AB649A
+64AC649964A264B365756577657866AE66AB66B466B16A236A1F69E86A016A1E
+6A1969FD6A216A136A0A69F36A026A0569ED6A116B506B4E6BA46BC56BC66F3F
+6F7C6F846F516F666F546F866F6D6F5B6F786F6E6F8E6F7A6F706F646F976F58
+6ED56F6F6F606F5F719F71AC71B171A87256729B734E73577469748B74830000
+BD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+747E7480757F76207629761F7624762676217622769A76BA76E4778E7787778C
+7791778B78CB78C578BA78CA78BE78D578BC78D07A3F7A3C7A407A3D7A377A3B
+7AAF7AAE7BAD7BB17BC47BB47BC67BC77BC17BA07BCC7CCA7DE07DF47DEF7DFB
+7DD87DEC7DDD7DE87DE37DDA7DDE7DE97D9E7DD97DF27DF97F757F777FAF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007FE98026819B819C819D81A0819A81988517853D851A84EE852C852D8513
+851185238521851484EC852584FF850687828774877687608766877887688759
+8757874C8753885B885D89108907891289138915890A8ABC8AD28AC78AC48A95
+8ACB8AF88AB28AC98AC28ABF8AB08AD68ACD8AB68AB98ADB8C4C8C4E8C6C8CE0
+8CDE8CE68CE48CEC8CED8CE28CE38CDC8CEA8CE18D6D8D9F8DA38E2B8E108E1D
+8E228E0F8E298E1F8E218E1E8EBA8F1D8F1B8F1F8F298F268F2A8F1C8F1E0000
+BE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8F259069906E9068906D90779130912D9127913191879189918B918392C592BB
+92B792EA92AC92E492C192B392BC92D292C792F092B295AD95B1970497069707
+97099760978D978B978F9821982B981C98B3990A99139912991899DD99D099DF
+99DB99D199D599D299D99AB79AEE9AEF9B279B459B449B779B6F9D069D090000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009D039EA99EBE9ECE58A89F5251125118511451105115518051AA51DD5291
+529352F35659566B5679566956645678566A566856655671566F566C56625676
+58C158BE58C758C5596E5B1D5B345B785BF05C0E5F4A61B2619161A9618A61CD
+61B661BE61CA61C8623064C564C164CB64BB64BC64DA64C464C764C264CD64BF
+64D264D464BE657466C666C966B966C466C766B86A3D6A386A3A6A596A6B6A58
+6A396A446A626A616A4B6A476A356A5F6A486B596B776C056FC26FB16FA10000
+BF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6FC36FA46FC16FA76FB36FC06FB96FB66FA66FA06FB471BE71C971D071D271C8
+71D571B971CE71D971DC71C371C47368749C74A37498749F749E74E2750C750D
+76347638763A76E776E577A0779E779F77A578E878DA78EC78E779A67A4D7A4E
+7A467A4C7A4B7ABA7BD97C117BC97BE47BDB7BE17BE97BE67CD57CD67E0A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007E117E087E1B7E237E1E7E1D7E097E107F797FB27FF07FF17FEE802881B3
+81A981A881FB820882588259854A855985488568856985438549856D856A855E
+8783879F879E87A2878D8861892A89328925892B892189AA89A68AE68AFA8AEB
+8AF18B008ADC8AE78AEE8AFE8B018B028AF78AED8AF38AF68AFC8C6B8C6D8C93
+8CF48E448E318E348E428E398E358F3B8F2F8F388F338FA88FA6907590749078
+9072907C907A913491929320933692F89333932F932292FC932B9304931A0000
+C0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9310932693219315932E931995BB96A796A896AA96D5970E97119716970D9713
+970F975B975C9766979898309838983B9837982D9839982499109928991E991B
+9921991A99ED99E299F19AB89ABC9AFB9AED9B289B919D159D239D269D289D12
+9D1B9ED89ED49F8D9F9C512A511F5121513252F5568E56805690568556870000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000568F58D558D358D158CE5B305B2A5B245B7A5C375C685DBC5DBA5DBD5DB8
+5E6B5F4C5FBD61C961C261C761E661CB6232623464CE64CA64D864E064F064E6
+64EC64F164E264ED6582658366D966D66A806A946A846AA26A9C6ADB6AA36A7E
+6A976A906AA06B5C6BAE6BDA6C086FD86FF16FDF6FE06FDB6FE46FEB6FEF6F80
+6FEC6FE16FE96FD56FEE6FF071E771DF71EE71E671E571ED71EC71F471E07235
+72467370737274A974B074A674A876467642764C76EA77B377AA77B077AC0000
+C1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+77A777AD77EF78F778FA78F478EF790179A779AA7A577ABF7C077C0D7BFE7BF7
+7C0C7BE07CE07CDC7CDE7CE27CDF7CD97CDD7E2E7E3E7E467E377E327E437E2B
+7E3D7E317E457E417E347E397E487E357E3F7E2F7F447FF37FFC807180728070
+806F807381C681C381BA81C281C081BF81BD81C981BE81E88209827185AA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008584857E859C8591859485AF859B858785A8858A866787C087D187B387D2
+87C687AB87BB87BA87C887CB893B893689448938893D89AC8B0E8B178B198B1B
+8B0A8B208B1D8B048B108C418C3F8C738CFA8CFD8CFC8CF88CFB8DA88E498E4B
+8E488E4A8F448F3E8F428F458F3F907F907D9084908190829080913991A3919E
+919C934D938293289375934A9365934B9318937E936C935B9370935A935495CA
+95CB95CC95C895C696B196B896D6971C971E97A097D3984698B699359A010000
+C2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+99FF9BAE9BAB9BAA9BAD9D3B9D3F9E8B9ECF9EDE9EDC9EDD9EDB9F3E9F4B53E2
+569556AE58D958D85B385F5D61E3623364F464F264FE650664FA64FB64F765B7
+66DC67266AB36AAC6AC36ABB6AB86AC26AAE6AAF6B5F6B786BAF7009700B6FFE
+70066FFA7011700F71FB71FC71FE71F87377737574A774BF7515765676580000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000765277BD77BF77BB77BC790E79AE7A617A627A607AC47AC57C2B7C277C2A
+7C1E7C237C217CE77E547E557E5E7E5A7E617E527E597F487FF97FFB80778076
+81CD81CF820A85CF85A985CD85D085C985B085BA85B985A687EF87EC87F287E0
+898689B289F48B288B398B2C8B2B8C508D058E598E638E668E648E5F8E558EC0
+8F498F4D90879083908891AB91AC91D09394938A939693A293B393AE93AC93B0
+9398939A939795D495D695D095D596E296DC96D996DB96DE972497A397A60000
+C3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+97AD97F9984D984F984C984E985398BA993E993F993D992E99A59A0E9AC19B03
+9B069B4F9B4E9B4D9BCA9BC99BFD9BC89BC09D519D5D9D609EE09F159F2C5133
+56A558DE58DF58E25BF59F905EEC61F261F761F661F56500650F66E066DD6AE5
+6ADD6ADA6AD3701B701F7028701A701D701570187206720D725872A273780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000737A74BD74CA74E375877586765F766177C7791979B17A6B7A697C3E7C3F
+7C387C3D7C377C407E6B7E6D7E797E697E6A7F857E737FB67FB97FB881D885E9
+85DD85EA85D585E485E585F787FB8805880D87F987FE8960895F8956895E8B41
+8B5C8B588B498B5A8B4E8B4F8B468B598D088D0A8E7C8E728E878E768E6C8E7A
+8E748F548F4E8FAD908A908B91B191AE93E193D193DF93C393C893DC93DD93D6
+93E293CD93D893E493D793E895DC96B496E3972A9727976197DC97FB985E0000
+C4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9858985B98BC994599499A169A199B0D9BE89BE79BD69BDB9D899D619D729D6A
+9D6C9E929E979E939EB452F856A856B756B656B456BC58E45B405B435B7D5BF6
+5DC961F861FA65186514651966E667276AEC703E703070327210737B74CF7662
+76657926792A792C792B7AC77AF67C4C7C437C4D7CEF7CF08FAE7E7D7E7C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007E827F4C800081DA826685FB85F9861185FA8606860B8607860A88148815
+896489BA89F88B708B6C8B668B6F8B5F8B6B8D0F8D0D8E898E818E858E8291B4
+91CB9418940393FD95E1973098C49952995199A89A2B9A309A379A359C139C0D
+9E799EB59EE89F2F9F5F9F639F615137513856C156C056C259145C6C5DCD61FC
+61FE651D651C659566E96AFB6B046AFA6BB2704C721B72A774D674D4766977D3
+7C507E8F7E8C7FBC8617862D861A882388228821881F896A896C89BD8B740000
+C5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B778B7D8D138E8A8E8D8E8B8F5F8FAF91BA942E94339435943A94389432942B
+95E297389739973297FF9867986599579A459A439A409A3E9ACF9B549B519C2D
+9C259DAF9DB49DC29DB89E9D9EEF9F199F5C9F669F67513C513B56C856CA56C9
+5B7F5DD45DD25F4E61FF65246B0A6B6170517058738074E4758A766E766C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000079B37C607C5F807E807D81DF8972896F89FC8B808D168D178E918E938F61
+9148944494519452973D973E97C397C1986B99559A559A4D9AD29B1A9C499C31
+9C3E9C3B9DD39DD79F349F6C9F6A9F9456CC5DD662006523652B652A66EC6B10
+74DA7ACA7C647C637C657E937E967E9481E28638863F88318B8A9090908F9463
+946094649768986F995C9A5A9A5B9A579AD39AD49AD19C549C579C569DE59E9F
+9EF456D158E9652C705E7671767277D77F507F888836883988628B938B920000
+C6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B9682778D1B91C0946A97429748974497C698709A5F9B229B589C5F9DF99DFA
+9E7C9E7D9F079F779F725EF36B1670637C6C7C6E883B89C08EA191C194729470
+9871995E9AD69B239ECC706477DA8B9A947797C99A629A657E9C8B9C8EAA91C5
+947D947E947C9C779C789EF78C54947F9E1A72289A6A9B319E1B9E1E7C720000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030FE309D309E3005304130423043304430453046304730483049304A304B
+304C304D304E304F3050305130523053305430553056305730583059305A305B
+305C305D305E305F3060306130623063306430653066306730683069306A306B
+306C306D306E306F3070307130723073307430753076307730783079307A307B
+307C307D307E307F3080308130823083308430853086308730883089308A308B
+308C308D308E308F309030913092309330A130A230A330A430A530A630A70000
+C7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30A830A930AA30AB30AC30AD30AE30AF30B030B130B230B330B430B530B630B7
+30B830B930BA30BB30BC30BD30BE30BF30C030C130C230C330C430C530C630C7
+30C830C930CA30CB30CC30CD30CE30CF30D030D130D230D330D430D530D630D7
+30D830D930DA30DB30DC30DD30DE30DF30E030E130E230E330E430E530E60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030E730E830E930EA30EB30EC30ED30EE30EF30F030F130F230F330F430F5
+30F60414041504010416041704180419041A041B041C04230424042504260427
+04280429042A042B042C042D042E042F04300431043204330434043504510436
+043704380439043A043B043C043D043E043F0440044104420443044404450446
+044704480449044A044B044C044D044E044F2460246124622463246424652466
+246724682469247424752476247724782479247A247B247C247D000000000000
+C9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E424E5C51F5531A53824E074E0C4E474E8D56D7FA0C5C6E5F734E0F51874E0E
+4E2E4E934EC24EC94EC8519852FC536C53B957205903592C5C105DFF65E16BB3
+6BCC6C14723F4E314E3C4EE84EDC4EE94EE14EDD4EDA520C531C534C57225723
+5917592F5B815B845C125C3B5C745C735E045E805E825FC9620962506C150000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006C366C436C3F6C3B72AE72B0738A79B8808A961E4F0E4F184F2C4EF54F14
+4EF14F004EF74F084F1D4F024F054F224F134F044EF44F1251B1521352095210
+52A65322531F534D538A540756E156DF572E572A5734593C5980597C5985597B
+597E5977597F5B565C155C255C7C5C7A5C7B5C7E5DDF5E755E845F025F1A5F74
+5FD55FD45FCF625C625E626462616266626262596260625A626565EF65EE673E
+67396738673B673A673F673C67336C186C466C526C5C6C4F6C4A6C546C4B0000
+CA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6C4C7071725E72B472B5738E752A767F7A757F518278827C8280827D827F864D
+897E909990979098909B909496229624962096234F564F3B4F624F494F534F64
+4F3E4F674F524F5F4F414F584F2D4F334F3F4F61518F51B9521C521E522152AD
+52AE530953635372538E538F54305437542A545454455419541C542554180000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000543D544F544154285424544756EE56E756E557415745574C5749574B5752
+5906594059A6599859A05997598E59A25990598F59A759A15B8E5B925C285C2A
+5C8D5C8F5C885C8B5C895C925C8A5C865C935C955DE05E0A5E0E5E8B5E895E8C
+5E885E8D5F055F1D5F785F765FD25FD15FD05FED5FE85FEE5FF35FE15FE45FE3
+5FFA5FEF5FF75FFB60005FF4623A6283628C628E628F629462876271627B627A
+6270628162886277627D62726274653765F065F465F365F265F5674567470000
+CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67596755674C6748675D674D675A674B6BD06C196C1A6C786C676C6B6C846C8B
+6C8F6C716C6F6C696C9A6C6D6C876C956C9C6C666C736C656C7B6C8E7074707A
+726372BF72BD72C372C672C172BA72C573957397739373947392753A75397594
+75957681793D80348095809980908092809C8290828F8285828E829182930000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000828A828382848C788FC98FBF909F90A190A5909E90A790A096309628962F
+962D4E334F984F7C4F854F7D4F804F874F764F744F894F844F774F4C4F974F6A
+4F9A4F794F814F784F904F9C4F944F9E4F924F824F954F6B4F6E519E51BC51BE
+5235523252335246523152BC530A530B533C539253945487547F548154915482
+5488546B547A547E5465546C54745466548D546F546154605498546354675464
+56F756F9576F5772576D576B57715770577657805775577B5773577457620000
+CC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5768577D590C594559B559BA59CF59CE59B259CC59C159B659BC59C359D659B1
+59BD59C059C859B459C75B625B655B935B955C445C475CAE5CA45CA05CB55CAF
+5CA85CAC5C9F5CA35CAD5CA25CAA5CA75C9D5CA55CB65CB05CA65E175E145E19
+5F285F225F235F245F545F825F7E5F7D5FDE5FE5602D602660196032600B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006034600A60176033601A601E602C6022600D6010602E60136011600C6009
+601C6214623D62AD62B462D162BE62AA62B662CA62AE62B362AF62BB62A962B0
+62B8653D65A865BB660965FC66046612660865FB6603660B660D660565FD6611
+661066F6670A6785676C678E67926776677B6798678667846774678D678C677A
+679F679167996783677D67816778677967946B256B806B7E6BDE6C1D6C936CEC
+6CEB6CEE6CD96CB66CD46CAD6CE76CB76CD06CC26CBA6CC36CC66CED6CF20000
+CD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6CD26CDD6CB46C8A6C9D6C806CDE6CC06D306CCD6CC76CB06CF96CCF6CE96CD1
+709470987085709370867084709170967082709A7083726A72D672CB72D872C9
+72DC72D272D472DA72CC72D173A473A173AD73A673A273A073AC739D74DD74E8
+753F7540753E758C759876AF76F376F176F076F577F877FC77F977FB77FA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077F77942793F79C57A787A7B7AFB7C757CFD8035808F80AE80A380B880B5
+80AD822082A082C082AB829A8298829B82B582A782AE82BC829E82BA82B482A8
+82A182A982C282A482C382B682A28670866F866D866E8C568FD28FCB8FD38FCD
+8FD68FD58FD790B290B490AF90B390B09639963D963C963A96434FCD4FC54FD3
+4FB24FC94FCB4FC14FD44FDC4FD94FBB4FB34FDB4FC74FD64FBA4FC04FB94FEC
+5244524952C052C2533D537C539753965399539854BA54A154AD54A554CF0000
+CE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54C3830D54B754AE54D654B654C554C654A0547054BC54A254BE547254DE54B0
+57B5579E579F57A4578C5797579D579B57945798578F579957A5579A579558F4
+590D595359E159DE59EE5A0059F159DD59FA59FD59FC59F659E459F259F759DB
+59E959F359F559E059FE59F459ED5BA85C4C5CD05CD85CCC5CD75CCB5CDB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005CDE5CDA5CC95CC75CCA5CD65CD35CD45CCF5CC85CC65CCE5CDF5CF85DF9
+5E215E225E235E205E245EB05EA45EA25E9B5EA35EA55F075F2E5F565F866037
+603960546072605E6045605360476049605B604C60406042605F602460446058
+6066606E6242624362CF630D630B62F5630E630362EB62F9630F630C62F862F6
+63006313631462FA631562FB62F06541654365AA65BF6636662166326635661C
+662666226633662B663A661D66346639662E670F671067C167F267C867BA0000
+CF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67DC67BB67F867D867C067B767C567EB67E467DF67B567CD67B367F767F667EE
+67E367C267B967CE67E767F067B267FC67C667ED67CC67AE67E667DB67FA67C9
+67CA67C367EA67CB6B286B826B846BB66BD66BD86BE06C206C216D286D346D2D
+6D1F6D3C6D3F6D126D0A6CDA6D336D046D196D3A6D1A6D116D006D1D6D420000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D016D186D376D036D0F6D406D076D206D2C6D086D226D096D1070B7709F
+70BE70B170B070A170B470B570A972417249724A726C72707273726E72CA72E4
+72E872EB72DF72EA72E672E3738573CC73C273C873C573B973B673B573B473EB
+73BF73C773BE73C373C673B873CB74EC74EE752E7547754875A775AA767976C4
+7708770377047705770A76F776FB76FA77E777E878067811781278057810780F
+780E780978037813794A794C794B7945794479D579CD79CF79D679CE7A800000
+D0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7A7E7AD17B007B017C7A7C787C797C7F7C807C817D037D087D017F587F917F8D
+7FBE8007800E800F8014803780D880C780E080D180C880C280D080C580E380D9
+80DC80CA80D580C980CF80D780E680CD81FF8221829482D982FE82F9830782E8
+830082D5833A82EB82D682F482EC82E182F282F5830C82FB82F682F082EA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000082E482E082FA82F382ED86778674867C86738841884E8867886A886989D3
+8A048A078D728FE38FE18FEE8FE090F190BD90BF90D590C590BE90C790CB90C8
+91D491D39654964F96519653964A964E501E50055007501350225030501B4FF5
+4FF450335037502C4FF64FF75017501C502050275035502F5031500E515A5194
+519351CA51C451C551C851CE5261525A5252525E525F5255526252CD530E539E
+552654E25517551254E754F354E4551A54FF5504550854EB5511550554F10000
+D1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+550A54FB54F754F854E0550E5503550B5701570257CC583257D557D257BA57C6
+57BD57BC57B857B657BF57C757D057B957C1590E594A5A195A165A2D5A2E5A15
+5A0F5A175A0A5A1E5A335B6C5BA75BAD5BAC5C035C565C545CEC5CFF5CEE5CF1
+5CF75D005CF95E295E285EA85EAE5EAA5EAC5F335F305F67605D605A60670000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000604160A26088608060926081609D60836095609B60976087609C608E6219
+624662F263106356632C634463456336634363E46339634B634A633C63296341
+6334635863546359632D63476333635A63516338635763406348654A654665C6
+65C365C465C2664A665F6647665167126713681F681A684968326833683B684B
+684F68166831681C6835682B682D682F684E68446834681D6812681468266828
+682E684D683A682568206B2C6B2F6B2D6B316B346B6D80826B886BE66BE40000
+D2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6BE86BE36BE26BE76C256D7A6D636D646D766D0D6D616D926D586D626D6D6D6F
+6D916D8D6DEF6D7F6D866D5E6D676D606D976D706D7C6D5F6D826D986D2F6D68
+6D8B6D7E6D806D846D166D836D7B6D7D6D756D9070DC70D370D170DD70CB7F39
+70E270D770D270DE70E070D470CD70C570C670C770DA70CE70E1724272780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000072777276730072FA72F472FE72F672F372FB730173D373D973E573D673BC
+73E773E373E973DC73D273DB73D473DD73DA73D773D873E874DE74DF74F474F5
+7521755B755F75B075C175BB75C475C075BF75B675BA768A76C9771D771B7710
+771377127723771177157719771A772277277823782C78227835782F7828782E
+782B782178297833782A78317954795B794F795C79537952795179EB79EC79E0
+79EE79ED79EA79DC79DE79DD7A867A897A857A8B7A8C7A8A7A877AD87B100000
+D3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7B047B137B057B0F7B087B0A7B0E7B097B127C847C917C8A7C8C7C887C8D7C85
+7D1E7D1D7D117D0E7D187D167D137D1F7D127D0F7D0C7F5C7F617F5E7F607F5D
+7F5B7F967F927FC37FC27FC08016803E803980FA80F280F980F5810180FB8100
+8201822F82258333832D83448319835183258356833F83418326831C83220000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008342834E831B832A8308833C834D8316832483208337832F832983478345
+834C8353831E832C834B832783488653865286A286A88696868D8691869E8687
+86978686868B869A868586A5869986A186A786958698868E869D869086948843
+8844886D88758876887288808871887F886F8883887E8874887C8A128C478C57
+8C7B8CA48CA38D768D788DB58DB78DB68ED18ED38FFE8FF590028FFF8FFB9004
+8FFC8FF690D690E090D990DA90E390DF90E590D890DB90D790DC90E491500000
+D4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+914E914F91D591E291DA965C965F96BC98E39ADF9B2F4E7F5070506A5061505E
+50605053504B505D50725048504D5041505B504A506250155045505F5069506B
+5063506450465040506E50735057505151D0526B526D526C526E52D652D3532D
+539C55755576553C554D55505534552A55515562553655355530555255450000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000550C55325565554E55395548552D553B5540554B570A570757FB581457E2
+57F657DC57F4580057ED57FD580857F8580B57F357CF580757EE57E357F257E5
+57EC57E1580E57FC581057E75801580C57F157E957F0580D5804595C5A605A58
+5A555A675A5E5A385A355A6D5A505A5F5A655A6C5A535A645A575A435A5D5A52
+5A445A5B5A485A8E5A3E5A4D5A395A4C5A705A695A475A515A565A425A5C5B72
+5B6E5BC15BC05C595D1E5D0B5D1D5D1A5D205D0C5D285D0D5D265D255D0F0000
+D5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5D305D125D235D1F5D2E5E3E5E345EB15EB45EB95EB25EB35F365F385F9B5F96
+5F9F608A6090608660BE60B060BA60D360D460CF60E460D960DD60C860B160DB
+60B760CA60BF60C360CD60C063326365638A6382637D63BD639E63AD639D6397
+63AB638E636F63876390636E63AF6375639C636D63AE637C63A4633B639F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006378638563816391638D6370655365CD66656661665B6659665C66626718
+687968876890689C686D686E68AE68AB6956686F68A368AC68A96875687468B2
+688F68776892687C686B687268AA68806871687E689B6896688B68A0688968A4
+6878687B6891688C688A687D6B366B336B376B386B916B8F6B8D6B8E6B8C6C2A
+6DC06DAB6DB46DB36E746DAC6DE96DE26DB76DF66DD46E006DC86DE06DDF6DD6
+6DBE6DE56DDC6DDD6DDB6DF46DCA6DBD6DED6DF06DBA6DD56DC26DCF6DC90000
+D6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6DD06DF26DD36DFD6DD76DCD6DE36DBB70FA710D70F7711770F4710C70F07104
+70F3711070FC70FF71067113710070F870F6710B7102710E727E727B727C727F
+731D7317730773117318730A730872FF730F731E738873F673F873F574047401
+73FD7407740073FA73FC73FF740C740B73F474087564756375CE75D275CF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075CB75CC75D175D0768F768976D37739772F772D7731773277347733773D
+7725773B7735784878527849784D784A784C782678457850796479677969796A
+7963796B796179BB79FA79F879F679F77A8F7A947A907B357B477B347B257B30
+7B227B247B337B187B2A7B1D7B317B2B7B2D7B2F7B327B387B1A7B237C947C98
+7C967CA37D357D3D7D387D367D3A7D457D2C7D297D417D477D3E7D3F7D4A7D3B
+7D287F637F957F9C7F9D7F9B7FCA7FCB7FCD7FD07FD17FC77FCF7FC9801F0000
+D7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+801E801B804780438048811881258119811B812D811F812C811E812181158127
+811D8122821182388233823A823482328274839083A383A8838D837A837383A4
+8374838F8381839583998375839483A9837D8383838C839D839B83AA838B837E
+83A583AF8388839783B0837F83A6838783AE8376839A8659865686BF86B70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000086C286C186C586BA86B086C886B986B386B886CC86B486BB86BC86C386BD
+86BE88528889889588A888A288AA889A889188A1889F889888A78899889B8897
+88A488AC888C8893888E898289D689D989D58A308A278A2C8A1E8C398C3B8C5C
+8C5D8C7D8CA58D7D8D7B8D798DBC8DC28DB98DBF8DC18ED88EDE8EDD8EDC8ED7
+8EE08EE19024900B9011901C900C902190EF90EA90F090F490F290F390D490EB
+90EC90E991569158915A9153915591EC91F491F191F391F891E491F991EA0000
+D8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+91EB91F791E891EE957A95869588967C966D966B9671966F96BF976A980498E5
+9997509B50955094509E508B50A35083508C508E509D5068509C509250825087
+515F51D45312531153A453A7559155A855A555AD5577564555A255935588558F
+55B5558155A3559255A4557D558C55A6557F559555A1558E570C582958370000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005819581E58275823582857F558485825581C581B5833583F5836582E5839
+5838582D582C583B59615AAF5A945A9F5A7A5AA25A9E5A785AA65A7C5AA55AAC
+5A955AAE5A375A845A8A5A975A835A8B5AA95A7B5A7D5A8C5A9C5A8F5A935A9D
+5BEA5BCD5BCB5BD45BD15BCA5BCE5C0C5C305D375D435D6B5D415D4B5D3F5D35
+5D515D4E5D555D335D3A5D525D3D5D315D595D425D395D495D385D3C5D325D36
+5D405D455E445E415F585FA65FA55FAB60C960B960CC60E260CE60C461140000
+D9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+60F2610A6116610560F5611360F860FC60FE60C161036118611D611060FF6104
+610B624A639463B163B063CE63E563E863EF63C3649D63F363CA63E063F663D5
+63F263F5646163DF63BE63DD63DC63C463D863D363C263C763CC63CB63C863F0
+63D763D965326567656A6564655C65686565658C659D659E65AE65D065D20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000667C666C667B668066716679666A66726701690C68D3690468DC692A68EC
+68EA68F1690F68D668F768EB68E468F66913691068F368E1690768CC69086970
+68B4691168EF68C6691468F868D068FD68FC68E8690B690A691768CE68C868DD
+68DE68E668F468D1690668D468E96915692568C76B396B3B6B3F6B3C6B946B97
+6B996B956BBD6BF06BF26BF36C306DFC6E466E476E1F6E496E886E3C6E3D6E45
+6E626E2B6E3F6E416E5D6E736E1C6E336E4B6E406E516E3B6E036E2E6E5E0000
+DA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6E686E5C6E616E316E286E606E716E6B6E396E226E306E536E656E276E786E64
+6E776E556E796E526E666E356E366E5A7120711E712F70FB712E713171237125
+71227132711F7128713A711B724B725A7288728972867285728B7312730B7330
+73227331733373277332732D732673237335730C742E742C7430742B74160000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000741A7421742D743174247423741D74297420743274FB752F756F756C75E7
+75DA75E175E675DD75DF75E475D77695769276DA774677477744774D7745774A
+774E774B774C77DE77EC786078647865785C786D7871786A786E787078697868
+785E786279747973797279707A027A0A7A037A0C7A047A997AE67AE47B4A7B3B
+7B447B487B4C7B4E7B407B587B457CA27C9E7CA87CA17D587D6F7D637D537D56
+7D677D6A7D4F7D6D7D5C7D6B7D527D547D697D517D5F7D4E7F3E7F3F7F650000
+DB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7F667FA27FA07FA17FD78051804F805080FE80D48143814A8152814F8147813D
+814D813A81E681EE81F781F881F98204823C823D823F8275833B83CF83F98423
+83C083E8841283E783E483FC83F6841083C683C883EB83E383BF840183DD83E5
+83D883FF83E183CB83CE83D683F583C98409840F83DE8411840683C283F30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000083D583FA83C783D183EA841383C383EC83EE83C483FB83D783E2841B83DB
+83FE86D886E286E686D386E386DA86EA86DD86EB86DC86EC86E986D786E886D1
+88488856885588BA88D788B988B888C088BE88B688BC88B788BD88B2890188C9
+89958998899789DD89DA89DB8A4E8A4D8A398A598A408A578A588A448A458A52
+8A488A518A4A8A4C8A4F8C5F8C818C808CBA8CBE8CB08CB98CB58D848D808D89
+8DD88DD38DCD8DC78DD68DDC8DCF8DD58DD98DC88DD78DC58EEF8EF78EFA0000
+DC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8EF98EE68EEE8EE58EF58EE78EE88EF68EEB8EF18EEC8EF48EE9902D9034902F
+9106912C910490FF90FC910890F990FB9101910091079105910391619164915F
+916291609201920A92259203921A9226920F920C9200921291FF91FD92069204
+92279202921C92249219921792059216957B958D958C95909687967E96880000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000096899683968096C296C896C396F196F0976C9770976E980798A998EB9CE6
+9EF94E834E844EB650BD50BF50C650AE50C450CA50B450C850C250B050C150BA
+50B150CB50C950B650B851D7527A5278527B527C55C355DB55CC55D055CB55CA
+55DD55C055D455C455E955BF55D2558D55CF55D555E255D655C855F255CD55D9
+55C25714585358685864584F584D5849586F5855584E585D58595865585B583D
+5863587158FC5AC75AC45ACB5ABA5AB85AB15AB55AB05ABF5AC85ABB5AC60000
+DD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5AB75AC05ACA5AB45AB65ACD5AB95A905BD65BD85BD95C1F5C335D715D635D4A
+5D655D725D6C5D5E5D685D675D625DF05E4F5E4E5E4A5E4D5E4B5EC55ECC5EC6
+5ECB5EC75F405FAF5FAD60F76149614A612B614561366132612E6146612F614F
+612961406220916862236225622463C563F163EB641064126409642064240000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000064336443641F641564186439643764226423640C64266430642864416435
+642F640A641A644064256427640B63E7641B642E6421640E656F659265D36686
+668C66956690668B668A66996694667867206966695F6938694E69626971693F
+6945696A6939694269576959697A694869496935696C6933693D696568F06978
+693469696940696F69446976695869416974694C693B694B6937695C694F6951
+69326952692F697B693C6B466B456B436B426B486B416B9BFA0D6BFB6BFC0000
+DE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6BF96BF76BF86E9B6ED66EC86E8F6EC06E9F6E936E946EA06EB16EB96EC66ED2
+6EBD6EC16E9E6EC96EB76EB06ECD6EA66ECF6EB26EBE6EC36EDC6ED86E996E92
+6E8E6E8D6EA46EA16EBF6EB36ED06ECA6E976EAE6EA371477154715271637160
+7141715D716271727178716A7161714271587143714B7170715F715071530000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007144714D715A724F728D728C72917290728E733C7342733B733A7340734A
+73497444744A744B7452745174577440744F7450744E74427446744D745474E1
+74FF74FE74FD751D75797577698375EF760F760375F775FE75FC75F975F87610
+75FB75F675ED75F575FD769976B576DD7755775F776077527756775A77697767
+77547759776D77E07887789A7894788F788478957885788678A1788378797899
+78807896787B797C7982797D79797A117A187A197A127A177A157A227A130000
+DF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7A1B7A107AA37AA27A9E7AEB7B667B647B6D7B747B697B727B657B737B717B70
+7B617B787B767B637CB27CB47CAF7D887D867D807D8D7D7F7D857D7A7D8E7D7B
+7D837D7C7D8C7D947D847D7D7D927F6D7F6B7F677F687F6C7FA67FA57FA77FDB
+7FDC8021816481608177815C8169815B816281726721815E81768167816F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081448161821D8249824482408242824584F1843F845684768479848F848D
+846584518440848684678430844D847D845A845984748473845D8507845E8437
+843A8434847A8443847884328445842983D9844B842F8442842D845F84708439
+844E844C8452846F84C5848E843B8447843684338468847E8444842B84608454
+846E8450870B870486F7870C86FA86D686F5874D86F8870E8709870186F6870D
+870588D688CB88CD88CE88DE88DB88DA88CC88D08985899B89DF89E589E40000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+89E189E089E289DC89E68A768A868A7F8A618A3F8A778A828A848A758A838A81
+8A748A7A8C3C8C4B8C4A8C658C648C668C868C848C858CCC8D688D698D918D8C
+8D8E8D8F8D8D8D938D948D908D928DF08DE08DEC8DF18DEE8DD08DE98DE38DE2
+8DE78DF28DEB8DF48F068EFF8F018F008F058F078F088F028F0B9052903F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090449049903D9110910D910F911191169114910B910E916E916F92489252
+9230923A926692339265925E9283922E924A9246926D926C924F92609267926F
+92369261927092319254926392509272924E9253924C92569232959F959C959E
+959B969296939691969796CE96FA96FD96F896F59773977797789772980F980D
+980E98AC98F698F999AF99B299B099B59AAD9AAB9B5B9CEA9CED9CE79E809EFD
+50E650D450D750E850F350DB50EA50DD50E450D350EC50F050EF50E350E00000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+51D85280528152E952EB533053AC56275615560C561255FC560F561C56015613
+560255FA561D560455FF55F95889587C5890589858865881587F5874588B587A
+58875891588E587658825888587B5894588F58FE596B5ADC5AEE5AE55AD55AEA
+5ADA5AED5AEB5AF35AE25AE05ADB5AEC5ADE5ADD5AD95AE85ADF5B775BE00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005BE35C635D825D805D7D5D865D7A5D815D775D8A5D895D885D7E5D7C5D8D
+5D795D7F5E585E595E535ED85ED15ED75ECE5EDC5ED55ED95ED25ED45F445F43
+5F6F5FB6612C61286141615E61716173615261536172616C618061746154617A
+615B6165613B616A6161615662296227622B642B644D645B645D647464766472
+6473647D6475646664A6644E6482645E645C644B645364606450647F643F646C
+646B645964656477657365A066A166A0669F67056704672269B169B669C90000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+69A069CE699669B069AC69BC69916999698E69A7698D69A969BE69AF69BF69C4
+69BD69A469D469B969CA699A69CF69B3699369AA69A1699E69D96997699069C2
+69B569A569C66B4A6B4D6B4B6B9E6B9F6BA06BC36BC46BFE6ECE6EF56EF16F03
+6F256EF86F376EFB6F2E6F096F4E6F196F1A6F276F186F3B6F126EED6F0A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006F366F736EF96EEE6F2D6F406F306F3C6F356EEB6F076F0E6F436F056EFD
+6EF66F396F1C6EFC6F3A6F1F6F0D6F1E6F086F21718771907189718071857182
+718F717B718671817197724472537297729572937343734D7351734C74627473
+7471747574727467746E750075027503757D759076167608760C76157611760A
+761476B87781777C77857782776E7780776F777E778378B278AA78B478AD78A8
+787E78AB789E78A578A078AC78A278A47998798A798B79967995799479930000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+79977988799279907A2B7A4A7A307A2F7A287A267AA87AAB7AAC7AEE7B887B9C
+7B8A7B917B907B967B8D7B8C7B9B7B8E7B857B9852847B997BA47B827CBB7CBF
+7CBC7CBA7DA77DB77DC27DA37DAA7DC17DC07DC57D9D7DCE7DC47DC67DCB7DCC
+7DAF7DB97D967DBC7D9F7DA67DAE7DA97DA17DC97F737FE27FE37FE57FDE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008024805D805C8189818681838187818D818C818B8215849784A484A1849F
+84BA84CE84C284AC84AE84AB84B984B484C184CD84AA849A84B184D0849D84A7
+84BB84A2849484C784CC849B84A984AF84A884D6849884B684CF84A084D784D4
+84D284DB84B084918661873387238728876B8740872E871E87218719871B8743
+872C8741873E874687208732872A872D873C8712873A87318735874287268727
+87388724871A8730871188F788E788F188F288FA88FE88EE88FC88F688FB0000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+88F088EC88EB899D89A1899F899E89E989EB89E88AAB8A998A8B8A928A8F8A96
+8C3D8C688C698CD58CCF8CD78D968E098E028DFF8E0D8DFD8E0A8E038E078E06
+8E058DFE8E008E048F108F118F0E8F0D9123911C91209122911F911D911A9124
+9121911B917A91729179917392A592A49276929B927A92A0929492AA928D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000092A6929A92AB92799297927F92A392EE928E9282929592A2927D928892A1
+928A9286928C929992A7927E928792A9929D928B922D969E96A196FF9758977D
+977A977E978397809782977B97849781977F97CE97CD981698AD98AE99029900
+9907999D999C99C399B999BB99BA99C299BD99C79AB19AE39AE79B3E9B3F9B60
+9B619B5F9CF19CF29CF59EA750FF5103513050F85106510750F650FE510B510C
+50FD510A528B528C52F152EF56485642564C56355641564A5649564656580000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+565A56405633563D562C563E5638562A563A571A58AB589D58B158A058A358AF
+58AC58A558A158FF5AFF5AF45AFD5AF75AF65B035AF85B025AF95B015B075B05
+5B0F5C675D995D975D9F5D925DA25D935D955DA05D9C5DA15D9A5D9E5E695E5D
+5E605E5C7DF35EDB5EDE5EE15F495FB2618B6183617961B161B061A261890000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000619B619361AF61AD619F619261AA61A1618D616661B3622D646E64706496
+64A064856497649C648F648B648A648C64A3649F646864B164986576657A6579
+657B65B265B366B566B066A966B266B766AA66AF6A006A066A1769E569F86A15
+69F169E46A2069FF69EC69E26A1B6A1D69FE6A2769F269EE6A1469F769E76A40
+6A0869E669FB6A0D69FC69EB6A096A046A186A256A0F69F66A266A0769F46A16
+6B516BA56BA36BA26BA66C016C006BFF6C026F416F266F7E6F876FC66F920000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F8D6F896F8C6F626F4F6F856F5A6F966F766F6C6F826F556F726F526F506F57
+6F946F936F5D6F006F616F6B6F7D6F676F906F536F8B6F696F7F6F956F636F77
+6F6A6F7B71B271AF719B71B071A0719A71A971B5719D71A5719E71A471A171AA
+719C71A771B37298729A73587352735E735F7360735D735B7361735A73590000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000736274877489748A74867481747D74857488747C747975087507757E7625
+761E7619761D761C7623761A7628761B769C769D769E769B778D778F77897788
+78CD78BB78CF78CC78D178CE78D478C878C378C478C9799A79A179A0799C79A2
+799B6B767A397AB27AB47AB37BB77BCB7BBE7BAC7BCE7BAF7BB97BCA7BB57CC5
+7CC87CCC7CCB7DF77DDB7DEA7DE77DD77DE17E037DFA7DE67DF67DF17DF07DEE
+7DDF7F767FAC7FB07FAD7FED7FEB7FEA7FEC7FE67FE88064806781A3819F0000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+819E819581A2819981978216824F825382528250824E82518524853B850F8500
+8529850E8509850D851F850A8527851C84FB852B84FA8508850C84F4852A84F2
+851584F784EB84F384FC851284EA84E9851684FE8528851D852E850284FD851E
+84F68531852684E784E884F084EF84F9851885208530850B8519852F86620000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000875687638764877787E1877387588754875B87528761875A8751875E876D
+876A8750874E875F875D876F876C877A876E875C8765874F877B877587628767
+8769885A8905890C8914890B891789188919890689168911890E890989A289A4
+89A389ED89F089EC8ACF8AC68AB88AD38AD18AD48AD58ABB8AD78ABE8AC08AC5
+8AD88AC38ABA8ABD8AD98C3E8C4D8C8F8CE58CDF8CD98CE88CDA8CDD8CE78DA0
+8D9C8DA18D9B8E208E238E258E248E2E8E158E1B8E168E118E198E268E270000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E148E128E188E138E1C8E178E1A8F2C8F248F188F1A8F208F238F168F179073
+9070906F9067906B912F912B9129912A91329126912E91859186918A91819182
+9184918092D092C392C492C092D992B692CF92F192DF92D892E992D792DD92CC
+92EF92C292E892CA92C892CE92E692CD92D592C992E092DE92E792D192D30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000092B592E192C692B4957C95AC95AB95AE95B096A496A296D3970597089702
+975A978A978E978897D097CF981E981D9826982998289820981B982798B29908
+98FA9911991499169917991599DC99CD99CF99D399D499CE99C999D699D899CB
+99D799CC9AB39AEC9AEB9AF39AF29AF19B469B439B679B749B719B669B769B75
+9B709B689B649B6C9CFC9CFA9CFD9CFF9CF79D079D009CF99CFB9D089D059D04
+9E839ED39F0F9F10511C51135117511A511151DE533453E156705660566E0000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+567356665663566D5672565E5677571C571B58C858BD58C958BF58BA58C258BC
+58C65B175B195B1B5B215B145B135B105B165B285B1A5B205B1E5BEF5DAC5DB1
+5DA95DA75DB55DB05DAE5DAA5DA85DB25DAD5DAF5DB45E675E685E665E6F5EE9
+5EE75EE65EE85EE55F4B5FBC619D61A8619661C561B461C661C161CC61BA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000061BF61B8618C64D764D664D064CF64C964BD648964C364DB64F364D96533
+657F657C65A266C866BE66C066CA66CB66CF66BD66BB66BA66CC67236A346A66
+6A496A676A326A686A3E6A5D6A6D6A766A5B6A516A286A5A6A3B6A3F6A416A6A
+6A646A506A4F6A546A6F6A696A606A3C6A5E6A566A556A4D6A4E6A466B556B54
+6B566BA76BAA6BAB6BC86BC76C046C036C066FAD6FCB6FA36FC76FBC6FCE6FC8
+6F5E6FC46FBD6F9E6FCA6FA870046FA56FAE6FBA6FAC6FAA6FCF6FBF6FB80000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6FA26FC96FAB6FCD6FAF6FB26FB071C571C271BF71B871D671C071C171CB71D4
+71CA71C771CF71BD71D871BC71C671DA71DB729D729E736973667367736C7365
+736B736A747F749A74A074947492749574A1750B7580762F762D7631763D7633
+763C76357632763076BB76E6779A779D77A1779C779B77A277A3779577990000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000779778DD78E978E578EA78DE78E378DB78E178E278ED78DF78E079A47A44
+7A487A477AB67AB87AB57AB17AB77BDE7BE37BE77BDD7BD57BE57BDA7BE87BF9
+7BD47BEA7BE27BDC7BEB7BD87BDF7CD27CD47CD77CD07CD17E127E217E177E0C
+7E1F7E207E137E0E7E1C7E157E1A7E227E0B7E0F7E167E0D7E147E257E247F43
+7F7B7F7C7F7A7FB17FEF802A8029806C81B181A681AE81B981B581AB81B081AC
+81B481B281B781A781F282558256825785568545856B854D8553856185580000
+EB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+854085468564854185628544855185478563853E855B8571854E856E85758555
+85678560858C8566855D85548565856C866386658664879B878F879787938792
+87888781879687988779878787A3878587908791879D87848794879C879A8789
+891E89268930892D892E89278931892289298923892F892C891F89F18AE00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008AE28AF28AF48AF58ADD8B148AE48ADF8AF08AC88ADE8AE18AE88AFF8AEF
+8AFB8C918C928C908CF58CEE8CF18CF08CF38D6C8D6E8DA58DA78E338E3E8E38
+8E408E458E368E3C8E3D8E418E308E3F8EBD8F368F2E8F358F328F398F378F34
+90769079907B908690FA913391359136919391909191918D918F9327931E9308
+931F9306930F937A9338933C931B9323931293019346932D930E930D92CB931D
+92FA9325931392F992F793349302932492FF932993399335932A9314930C0000
+EC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+930B92FE9309930092FB931695BC95CD95BE95B995BA95B695BF95B595BD96A9
+96D4970B9712971097999797979497F097F89835982F98329924991F99279929
+999E99EE99EC99E599E499F099E399EA99E999E79AB99ABF9AB49ABB9AF69AFA
+9AF99AF79B339B809B859B879B7C9B7E9B7B9B829B939B929B909B7A9B950000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009B7D9B889D259D179D209D1E9D149D299D1D9D189D229D109D199D1F9E88
+9E869E879EAE9EAD9ED59ED69EFA9F129F3D51265125512251245120512952F4
+5693568C568D568656845683567E5682567F568158D658D458CF58D25B2D5B25
+5B325B235B2C5B275B265B2F5B2E5B7B5BF15BF25DB75E6C5E6A5FBE5FBB61C3
+61B561BC61E761E061E561E461E861DE64EF64E964E364EB64E464E865816580
+65B665DA66D26A8D6A966A816AA56A896A9F6A9B6AA16A9E6A876A936A8E0000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A956A836AA86AA46A916A7F6AA66A9A6A856A8C6A926B5B6BAD6C096FCC6FA9
+6FF46FD46FE36FDC6FED6FE76FE66FDE6FF26FDD6FE26FE871E171F171E871F2
+71E471F071E27373736E736F749774B274AB749074AA74AD74B174A574AF7510
+75117512750F7584764376487649764776A476E977B577AB77B277B777B60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077B477B177A877F078F378FD790278FB78FC78F2790578F978FE790479AB
+79A87A5C7A5B7A567A587A547A5A7ABE7AC07AC17C057C0F7BF27C007BFF7BFB
+7C0E7BF47C0B7BF37C027C097C037C017BF87BFD7C067BF07BF17C107C0A7CE8
+7E2D7E3C7E427E3398487E387E2A7E497E407E477E297E4C7E307E3B7E367E44
+7E3A7F457F7F7F7E7F7D7FF47FF2802C81BB81C481CC81CA81C581C781BC81E9
+825B825A825C85838580858F85A7859585A0858B85A3857B85A4859A859E0000
+EE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8577857C858985A1857A85788557858E85968586858D8599859D858185A28582
+858885858579857685988590859F866887BE87AA87AD87C587B087AC87B987B5
+87BC87AE87C987C387C287CC87B787AF87C487CA87B487B687BF87B887BD87DE
+87B289358933893C893E894189528937894289AD89AF89AE89F289F38B1E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008B188B168B118B058B0B8B228B0F8B128B158B078B0D8B088B068B1C8B13
+8B1A8C4F8C708C728C718C6F8C958C948CF98D6F8E4E8E4D8E538E508E4C8E47
+8F438F409085907E9138919A91A2919B9199919F91A1919D91A093A1938393AF
+936493569347937C9358935C93769349935093519360936D938F934C936A9379
+935793559352934F93719377937B9361935E936393679380934E935995C795C0
+95C995C395C595B796AE96B096AC9720971F9718971D9719979A97A1979C0000
+EF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+979E979D97D597D497F198419844984A9849984598439925992B992C992A9933
+9932992F992D99319930999899A399A19A0299FA99F499F799F999F899F699FB
+99FD99FE99FC9A039ABE9AFE9AFD9B019AFC9B489B9A9BA89B9E9B9B9BA69BA1
+9BA59BA49B869BA29BA09BAF9D339D419D679D369D2E9D2F9D319D389D300000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009D459D429D439D3E9D379D409D3D7FF59D2D9E8A9E899E8D9EB09EC89EDA
+9EFB9EFF9F249F239F229F549FA05131512D512E5698569C5697569A569D5699
+59705B3C5C695C6A5DC05E6D5E6E61D861DF61ED61EE61F161EA61F061EB61D6
+61E964FF650464FD64F86501650364FC659465DB66DA66DB66D86AC56AB96ABD
+6AE16AC66ABA6AB66AB76AC76AB46AAD6B5E6BC96C0B7007700C700D70017005
+7014700E6FFF70006FFB70266FFC6FF7700A720171FF71F9720371FD73760000
+F0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74B874C074B574C174BE74B674BB74C275147513765C76647659765076537657
+765A76A676BD76EC77C277BA78FF790C79137914790979107912791179AD79AC
+7A5F7C1C7C297C197C207C1F7C2D7C1D7C267C287C227C257C307E5C7E507E56
+7E637E587E627E5F7E517E607E577E537FB57FB37FF77FF8807581D181D20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081D0825F825E85B485C685C085C385C285B385B585BD85C785C485BF85CB
+85CE85C885C585B185B685D2862485B885B785BE866987E787E687E287DB87EB
+87EA87E587DF87F387E487D487DC87D387ED87D887E387A487D787D9880187F4
+87E887DD8953894B894F894C89468950895189498B2A8B278B238B338B308B35
+8B478B2F8B3C8B3E8B318B258B378B268B368B2E8B248B3B8B3D8B3A8C428C75
+8C998C988C978CFE8D048D028D008E5C8E628E608E578E568E5E8E658E670000
+F1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E5B8E5A8E618E5D8E698E548F468F478F488F4B9128913A913B913E91A891A5
+91A791AF91AA93B5938C939293B7939B939D938993A7938E93AA939E93A69395
+93889399939F938D93B1939193B293A493A893B493A393A595D295D395D196B3
+96D796DA5DC296DF96D896DD97239722972597AC97AE97A897AB97A497AA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000097A297A597D797D997D697D897FA98509851985298B89941993C993A9A0F
+9A0B9A099A0D9A049A119A0A9A059A079A069AC09ADC9B089B049B059B299B35
+9B4A9B4C9B4B9BC79BC69BC39BBF9BC19BB59BB89BD39BB69BC49BB99BBD9D5C
+9D539D4F9D4A9D5B9D4B9D599D569D4C9D579D529D549D5F9D589D5A9E8E9E8C
+9EDF9F019F009F169F259F2B9F2A9F299F289F4C9F5551345135529652F753B4
+56AB56AD56A656A756AA56AC58DA58DD58DB59125B3D5B3E5B3F5DC35E700000
+F2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5FBF61FB65076510650D6509650C650E658465DE65DD66DE6AE76AE06ACC6AD1
+6AD96ACB6ADF6ADC6AD06AEB6ACF6ACD6ADE6B606BB06C0C7019702770207016
+702B702170227023702970177024701C702A720C720A72077202720572A572A6
+72A472A372A174CB74C574B774C37516766077C977CA77C477F1791D791B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007921791C7917791E79B07A677A687C337C3C7C397C2C7C3B7CEC7CEA7E76
+7E757E787E707E777E6F7E7A7E727E747E687F4B7F4A7F837F867FB77FFD7FFE
+807881D781D582648261826385EB85F185ED85D985E185E885DA85D785EC85F2
+85F885D885DF85E385DC85D185F085E685EF85DE85E2880087FA880387F687F7
+8809880C880B880687FC880887FF880A88028962895A895B89578961895C8958
+895D8959898889B789B689F68B508B488B4A8B408B538B568B548B4B8B550000
+F3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B518B428B528B578C438C778C768C9A8D068D078D098DAC8DAA8DAD8DAB8E6D
+8E788E738E6A8E6F8E7B8EC28F528F518F4F8F508F538FB49140913F91B091AD
+93DE93C793CF93C293DA93D093F993EC93CC93D993A993E693CA93D493EE93E3
+93D593C493CE93C093D293E7957D95DA95DB96E19729972B972C972897260000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000097B397B797B697DD97DE97DF985C9859985D985798BF98BD98BB98BE9948
+9947994399A699A79A1A9A159A259A1D9A249A1B9A229A209A279A239A1E9A1C
+9A149AC29B0B9B0A9B0E9B0C9B379BEA9BEB9BE09BDE9BE49BE69BE29BF09BD4
+9BD79BEC9BDC9BD99BE59BD59BE19BDA9D779D819D8A9D849D889D719D809D78
+9D869D8B9D8C9D7D9D6B9D749D759D709D699D859D739D7B9D829D6F9D799D7F
+9D879D689E949E919EC09EFC9F2D9F409F419F4D9F569F579F58533756B20000
+F4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+56B556B358E35B455DC65DC75EEE5EEF5FC05FC161F9651765166515651365DF
+66E866E366E46AF36AF06AEA6AE86AF96AF16AEE6AEF703C7035702F70377034
+703170427038703F703A70397040703B703370417213721472A8737D737C74BA
+76AB76AA76BE76ED77CC77CE77CF77CD77F27925792379277928792479290000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000079B27A6E7A6C7A6D7AF77C497C487C4A7C477C457CEE7E7B7E7E7E817E80
+7FBA7FFF807981DB81D9820B82688269862285FF860185FE861B860085F68604
+86098605860C85FD8819881088118817881388168963896689B989F78B608B6A
+8B5D8B688B638B658B678B6D8DAE8E868E888E848F598F568F578F558F588F5A
+908D9143914191B791B591B291B3940B941393FB9420940F941493FE94159410
+94289419940D93F5940093F79407940E9416941293FA940993F8940A93FF0000
+F5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+93FC940C93F69411940695DE95E095DF972E972F97B997BB97FD97FE98609862
+9863985F98C198C29950994E9959994C994B99539A329A349A319A2C9A2A9A36
+9A299A2E9A389A2D9AC79ACA9AC69B109B129B119C0B9C089BF79C059C129BF8
+9C409C079C0E9C069C179C149C099D9F9D999DA49D9D9D929D989D909D9B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009DA09D949D9C9DAA9D979DA19D9A9DA29DA89D9E9DA39DBF9DA99D969DA6
+9DA79E999E9B9E9A9EE59EE49EE79EE69F309F2E9F5B9F609F5E9F5D9F599F91
+513A51395298529756C356BD56BE5B485B475DCB5DCF5EF161FD651B6B026AFC
+6B036AF86B0070437044704A7048704970457046721D721A7219737E7517766A
+77D0792D7931792F7C547C537CF27E8A7E877E887E8B7E867E8D7F4D7FBB8030
+81DD8618862A8626861F8623861C86198627862E862186208629861E86250000
+F6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8829881D881B88208824881C882B884A896D8969896E896B89FA8B798B788B45
+8B7A8B7B8D108D148DAF8E8E8E8C8F5E8F5B8F5D91469144914591B9943F943B
+94369429943D943C94309439942A9437942C9440943195E595E495E39735973A
+97BF97E1986498C998C698C0995899569A399A3D9A469A449A429A419A3A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009A3F9ACD9B159B179B189B169B3A9B529C2B9C1D9C1C9C2C9C239C289C29
+9C249C219DB79DB69DBC9DC19DC79DCA9DCF9DBE9DC59DC39DBB9DB59DCE9DB9
+9DBA9DAC9DC89DB19DAD9DCC9DB39DCD9DB29E7A9E9C9EEB9EEE9EED9F1B9F18
+9F1A9F319F4E9F659F649F924EB956C656C556CB59715B4B5B4C5DD55DD15EF2
+65216520652665226B0B6B086B096C0D7055705670577052721E721F72A9737F
+74D874D574D974D7766D76AD793579B47A707A717C577C5C7C597C5B7C5A0000
+F7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7CF47CF17E917F4F7F8781DE826B863486358633862C86328636882C88288826
+882A8825897189BF89BE89FB8B7E8B848B828B868B858B7F8D158E958E948E9A
+8E928E908E968E978F608F629147944C9450944A944B944F9447944594489449
+9446973F97E3986A986998CB9954995B9A4E9A539A549A4C9A4F9A489A4A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009A499A529A509AD09B199B2B9B3B9B569B559C469C489C3F9C449C399C33
+9C419C3C9C379C349C329C3D9C369DDB9DD29DDE9DDA9DCB9DD09DDC9DD19DDF
+9DE99DD99DD89DD69DF59DD59DDD9EB69EF09F359F339F329F429F6B9F959FA2
+513D529958E858E759725B4D5DD8882F5F4F62016203620465296525659666EB
+6B116B126B0F6BCA705B705A7222738273817383767077D47C677C667E95826C
+863A86408639863C8631863B863E88308832882E883389768974897389FE0000
+F8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B8C8B8E8B8B8B888C458D198E988F648F6391BC94629455945D9457945E97C4
+97C598009A569A599B1E9B1F9B209C529C589C509C4A9C4D9C4B9C559C599C4C
+9C4E9DFB9DF79DEF9DE39DEB9DF89DE49DF69DE19DEE9DE69DF29DF09DE29DEC
+9DF49DF39DE89DED9EC29ED09EF29EF39F069F1C9F389F379F369F439F4F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009F719F709F6E9F6F56D356CD5B4E5C6D652D66ED66EE6B13705F7061705D
+7060722374DB74E577D5793879B779B67C6A7E977F89826D8643883888378835
+884B8B948B958E9E8E9F8EA08E9D91BE91BD91C2946B9468946996E597469743
+974797C797E59A5E9AD59B599C639C679C669C629C5E9C609E029DFE9E079E03
+9E069E059E009E019E099DFF9DFD9E049EA09F1E9F469F749F759F7656D4652E
+65B86B186B196B176B1A7062722672AA77D877D979397C697C6B7CF67E9A0000
+F9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7E987E9B7E9981E081E18646864786488979897A897C897B89FF8B988B998EA5
+8EA48EA3946E946D946F9471947397499872995F9C689C6E9C6D9E0B9E0D9E10
+9E0F9E129E119EA19EF59F099F479F789F7B9F7A9F79571E70667C6F883C8DB2
+8EA691C394749478947694759A609C749C739C719C759E149E139EF69F0A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009FA4706870657CF7866A883E883D883F8B9E8C9C8EA98EC9974B98739874
+98CC996199AB9A649A669A679B249E159E179F4862076B1E7227864C8EA89482
+948094819A699A689B2E9E197229864B8B9F94839C799EB776759A6B9C7A9E1D
+7069706A9EA49F7E9F499F980000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/cp1250.enc b/tcl/library/encoding/cp1250.enc
new file mode 100644
index 00000000000..934539a56b2
--- /dev/null
+++ b/tcl/library/encoding/cp1250.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1250, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00800081201A0083201E2026202020210088203001602039015A0164017D0179
+009020182019201C201D202220132014009821220161203A015B0165017E017A
+00A002C702D8014100A4010400A600A700A800A9015E00AB000000AD00AE017B
+00B000B102DB014200B400B500B600B700B80105015F00BB013D02DD013E017C
+015400C100C2010200C40139010600C7010C00C9011800CB011A00CD00CE010E
+01100143014700D300D4015000D600D70158016E00DA017000DC00DD016200DF
+015500E100E2010300E4013A010700E7010D00E9011900EB011B00ED00EE010F
+01110144014800F300F4015100F600F70159016F00FA017100FC00FD016302D9
diff --git a/tcl/library/encoding/cp1251.enc b/tcl/library/encoding/cp1251.enc
new file mode 100644
index 00000000000..7daed16e5fc
--- /dev/null
+++ b/tcl/library/encoding/cp1251.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1251, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+04020403201A0453201E2026202020210088203004092039040A040C040B040F
+045220182019201C201D202220132014009821220459203A045A045C045B045F
+00A0040E045E040800A4049000A600A7040100A9040400AB00AC00AD00AE0407
+00B000B104060456049100B500B600B704512116045400BB0458040504550457
+0410041104120413041404150416041704180419041A041B041C041D041E041F
+0420042104220423042404250426042704280429042A042B042C042D042E042F
+0430043104320433043404350436043704380439043A043B043C043D043E043F
+0440044104420443044404450446044704480449044A044B044C044D044E044F
diff --git a/tcl/library/encoding/cp1252.enc b/tcl/library/encoding/cp1252.enc
new file mode 100644
index 00000000000..fe55a4694bf
--- /dev/null
+++ b/tcl/library/encoding/cp1252.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1252, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00800081201A0192201E20262020202102C62030016020390152008D008E008F
+009020182019201C201D20222013201402DC21220161203A0153009D009E0178
+00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
+00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
+00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
+00D000D100D200D300D400D500D600D700D800D900DA00DB00DC00DD00DE00DF
+00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
+00F000F100F200F300F400F500F600F700F800F900FA00FB00FC00FD00FE00FF
diff --git a/tcl/library/encoding/cp1253.enc b/tcl/library/encoding/cp1253.enc
new file mode 100644
index 00000000000..a934bc9a48f
--- /dev/null
+++ b/tcl/library/encoding/cp1253.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1253, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00800081201A0192201E20262020202100882030008A2039008C008D008E008F
+009020182019201C201D20222013201400982122009A203A009C009D009E009F
+00A00385038600A300A400A500A600A700A800A9000000AB00AC00AD00AE2015
+00B000B100B200B3038400B500B600B703880389038A00BB038C00BD038E038F
+0390039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A1000003A303A403A503A603A703A803A903AA03AB03AC03AD03AE03AF
+03B003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C203C303C403C503C603C703C803C903CA03CB03CC03CD03CE0000
diff --git a/tcl/library/encoding/cp1254.enc b/tcl/library/encoding/cp1254.enc
new file mode 100644
index 00000000000..d8553a2a73b
--- /dev/null
+++ b/tcl/library/encoding/cp1254.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1254, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00800081201A0192201E20262020202102C62030016020390152008D008E008F
+009020182019201C201D20222013201402DC21220161203A0153009D009E0178
+00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
+00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
+00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
+011E00D100D200D300D400D500D600D700D800D900DA00DB00DC0130015E00DF
+00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
+011F00F100F200F300F400F500F600F700F800F900FA00FB00FC0131015F00FF
diff --git a/tcl/library/encoding/cp1255.enc b/tcl/library/encoding/cp1255.enc
new file mode 100644
index 00000000000..275c0169636
--- /dev/null
+++ b/tcl/library/encoding/cp1255.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1255, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00800081201A0192201E20262020202102C62030008A2039008C008D008E008F
+009020182019201C201D20222013201402DC2122009A203A009C009D009E009F
+00A0000000A200A320AA00A500A600A700A800A9000000AB00AC00AD00AE00AF
+00B000B100B200B300B400B500B600B7000000B9000000BB00BC00BD00BE0000
+05B005B105B205B305B405B505B605B705B805B905BA05BB05BC05BD05BE05BF
+05C005C105C205C305F005F105F2000000000000000000000000000000000000
+05D005D105D205D305D405D505D605D705D805D905DA05DB05DC05DD05DE05DF
+05E005E105E205E305E405E505E605E705E805E905EA00000000200E200F0000
diff --git a/tcl/library/encoding/cp1256.enc b/tcl/library/encoding/cp1256.enc
new file mode 100644
index 00000000000..1a9d8a6c652
--- /dev/null
+++ b/tcl/library/encoding/cp1256.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1256, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080067E201A0192201E20262020202102C62030008A2039015206860698008F
+06AF20182019201C201D20222013201400982122009A203A0153200C200D009F
+00A0060C00A200A300A400A500A600A700A800A9000000AB00AC00AD00AE00AF
+00B000B100B200B300B400B500B600B700B800B9061B00BB00BC00BD00BE061F
+0000062106220623062406250626062706280629062A062B062C062D062E062F
+063006310632063306340635063600D7063706380639063A0640064106420643
+00E0064400E2064506460647064800E700E800E900EA00EB0649064A00EE00EF
+064B064C064D064E00F4064F065000F7065100F9065200FB00FC200E200F0000
diff --git a/tcl/library/encoding/cp1257.enc b/tcl/library/encoding/cp1257.enc
new file mode 100644
index 00000000000..4aab0c663b0
--- /dev/null
+++ b/tcl/library/encoding/cp1257.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1257, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00800081201A0083201E20262020202100882030008A2039008C00A802C700B8
+009020182019201C201D20222013201400982122009A203A009C00AF02DB009F
+00A0000000A200A300A4000000A600A700D800A9015600AB00AC00AD00AE00C6
+00B000B100B200B300B400B500B600B700F800B9015700BB00BC00BD00BE00E6
+0104012E0100010600C400C501180112010C00C90179011601220136012A013B
+01600143014500D3014C00D500D600D701720141015A016A00DC017B017D00DF
+0105012F0101010700E400E501190113010D00E9017A011701230137012B013C
+01610144014600F3014D00F500F600F701730142015B016B00FC017C017E02D9
diff --git a/tcl/library/encoding/cp1258.enc b/tcl/library/encoding/cp1258.enc
new file mode 100644
index 00000000000..8c1fce89954
--- /dev/null
+++ b/tcl/library/encoding/cp1258.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp1258, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00800081201A0192201E20262020202102C62030008A20390152008D008E008F
+009020182019201C201D20222013201402DC2122009A203A0153009D009E0178
+00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
+00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
+00C000C100C2010200C400C500C600C700C800C900CA00CB034000CD00CE00CF
+011000D1030900D300D401A000D600D700D800D900DA00DB00DC01AF030300DF
+00E000E100E2010300E400E500E600E700E800E900EA00EB034100ED00EE00EF
+011100F1032300F300F401A100F600F700F800F900FA00FB00FC01B020AB00FF
diff --git a/tcl/library/encoding/cp437.enc b/tcl/library/encoding/cp437.enc
new file mode 100644
index 00000000000..ecae4e65403
--- /dev/null
+++ b/tcl/library/encoding/cp437.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp437, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00A200A300A520A70192
+00E100ED00F300FA00F100D100AA00BA00BF231000AC00BD00BC00A100AB00BB
+259125922593250225242561256225562555256325512557255D255C255B2510
+25142534252C251C2500253C255E255F255A25542569256625602550256C2567
+2568256425652559255825522553256B256A2518250C25882584258C25902580
+03B100DF039303C003A303C300B503C403A6039803A903B4221E03C603B52229
+226100B1226522642320232100F7224800B0221900B7221A207F00B225A000A0
diff --git a/tcl/library/encoding/cp737.enc b/tcl/library/encoding/cp737.enc
new file mode 100644
index 00000000000..5b59661ea42
--- /dev/null
+++ b/tcl/library/encoding/cp737.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp737, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+039103920393039403950396039703980399039A039B039C039D039E039F03A0
+03A103A303A403A503A603A703A803A903B103B203B303B403B503B603B703B8
+03B903BA03BB03BC03BD03BE03BF03C003C103C303C203C403C503C603C703C8
+259125922593250225242561256225562555256325512557255D255C255B2510
+25142534252C251C2500253C255E255F255A25542569256625602550256C2567
+2568256425652559255825522553256B256A2518250C25882584258C25902580
+03C903AC03AD03AE03CA03AF03CC03CD03CB03CE038603880389038A038C038E
+038F00B12265226403AA03AB00F7224800B0221900B7221A207F00B225A000A0
diff --git a/tcl/library/encoding/cp775.enc b/tcl/library/encoding/cp775.enc
new file mode 100644
index 00000000000..71b65c32219
--- /dev/null
+++ b/tcl/library/encoding/cp775.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp775, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+010600FC00E9010100E4012300E501070142011301560157012B017900C400C5
+00C900E600C6014D00F6012200A2015A015B00D600DC00F800A300D800D700A4
+0100012A00F3017B017C017A201D00A600A900AE00AC00BD00BC014100AB00BB
+259125922593250225240104010C01180116256325512557255D012E01602510
+25142534252C251C2500253C0172016A255A25542569256625602550256C017D
+0105010D01190117012F01610173016B017E2518250C25882584258C25902580
+00D300DF014C014300F500D500B5014401360137013B013C0146011201452019
+00AD00B1201C00BE00B600A700F7201E00B0221900B700B900B300B225A000A0
diff --git a/tcl/library/encoding/cp850.enc b/tcl/library/encoding/cp850.enc
new file mode 100644
index 00000000000..4e7a90d725f
--- /dev/null
+++ b/tcl/library/encoding/cp850.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp850, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
+00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
+00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
diff --git a/tcl/library/encoding/cp852.enc b/tcl/library/encoding/cp852.enc
new file mode 100644
index 00000000000..f34899eec54
--- /dev/null
+++ b/tcl/library/encoding/cp852.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp852, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E4016F010700E7014200EB0150015100EE017900C40106
+00C90139013A00F400F6013D013E015A015B00D600DC01640165014100D7010D
+00E100ED00F300FA01040105017D017E0118011900AC017A010C015F00AB00BB
+2591259225932502252400C100C2011A015E256325512557255D017B017C2510
+25142534252C251C2500253C01020103255A25542569256625602550256C00A4
+01110110010E00CB010F014700CD00CE011B2518250C258825840162016E2580
+00D300DF00D401430144014801600161015400DA0155017000FD00DD016300B4
+00AD02DD02DB02C702D800A700F700B800B000A802D901710158015925A000A0
diff --git a/tcl/library/encoding/cp855.enc b/tcl/library/encoding/cp855.enc
new file mode 100644
index 00000000000..4d58b86cc2f
--- /dev/null
+++ b/tcl/library/encoding/cp855.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp855, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0452040204530403045104010454040404550405045604060457040704580408
+04590409045A040A045B040B045C040C045E040E045F040F044E042E044A042A
+0430041004310411044604260434041404350415044404240433041300AB00BB
+259125922593250225240445042504380418256325512557255D043904192510
+25142534252C251C2500253C043A041A255A25542569256625602550256C00A4
+043B041B043C041C043D041D043E041E043F2518250C25882584041F044F2580
+042F044004200441042104420422044304230436041604320412044C042C2116
+00AD044B042B0437041704480428044D042D044904290447042700A725A000A0
diff --git a/tcl/library/encoding/cp857.enc b/tcl/library/encoding/cp857.enc
new file mode 100644
index 00000000000..b42ed55713a
--- /dev/null
+++ b/tcl/library/encoding/cp857.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp857, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE013100C400C5
+00C900E600C600F400F600F200FB00F9013000D600DC00F800A300D8015E015F
+00E100ED00F300FA00F100D1011E011F00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00BA00AA00CA00CB00C8000000CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B5000000D700DA00DB00D900EC00FF00AF00B4
+00AD00B1000000BE00B600A700F700B800B000A800B700B900B300B225A000A0
diff --git a/tcl/library/encoding/cp860.enc b/tcl/library/encoding/cp860.enc
new file mode 100644
index 00000000000..871943b3718
--- /dev/null
+++ b/tcl/library/encoding/cp860.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp860, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E300E000C100E700EA00CA00E800CD00D400EC00C300C2
+00C900C000C800F400F500F200DA00F900CC00D500DC00A200A300D920A700D3
+00E100ED00F300FA00F100D100AA00BA00BF00D200AC00BD00BC00A100AB00BB
+259125922593250225242561256225562555256325512557255D255C255B2510
+25142534252C251C2500253C255E255F255A25542569256625602550256C2567
+2568256425652559255825522553256B256A2518250C25882584258C25902580
+03B100DF039303C003A303C300B503C403A6039803A903B4221E03C603B52229
+226100B1226522642320232100F7224800B0221900B7221A207F00B225A000A0
diff --git a/tcl/library/encoding/cp861.enc b/tcl/library/encoding/cp861.enc
new file mode 100644
index 00000000000..3f8f605e510
--- /dev/null
+++ b/tcl/library/encoding/cp861.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp861, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800D000F000DE00C400C5
+00C900E600C600F400F600FE00FB00DD00FD00D600DC00F800A300D820A70192
+00E100ED00F300FA00C100CD00D300DA00BF231000AC00BD00BC00A100AB00BB
+259125922593250225242561256225562555256325512557255D255C255B2510
+25142534252C251C2500253C255E255F255A25542569256625602550256C2567
+2568256425652559255825522553256B256A2518250C25882584258C25902580
+03B100DF039303C003A303C300B503C403A6039803A903B4221E03C603B52229
+226100B1226522642320232100F7224800B0221900B7221A207F00B225A000A0
diff --git a/tcl/library/encoding/cp862.enc b/tcl/library/encoding/cp862.enc
new file mode 100644
index 00000000000..5f9d16cc298
--- /dev/null
+++ b/tcl/library/encoding/cp862.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp862, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+05D005D105D205D305D405D505D605D705D805D905DA05DB05DC05DD05DE05DF
+05E005E105E205E305E405E505E605E705E805E905EA00A200A300A520A70192
+00E100ED00F300FA00F100D100AA00BA00BF231000AC00BD00BC00A100AB00BB
+259125922593250225242561256225562555256325512557255D255C255B2510
+25142534252C251C2500253C255E255F255A25542569256625602550256C2567
+2568256425652559255825522553256B256A2518250C25882584258C25902580
+03B100DF039303C003A303C300B503C403A6039803A903B4221E03C603B52229
+226100B1226522642320232100F7224800B0221900B7221A207F00B225A000A0
diff --git a/tcl/library/encoding/cp863.enc b/tcl/library/encoding/cp863.enc
new file mode 100644
index 00000000000..c8b8686f814
--- /dev/null
+++ b/tcl/library/encoding/cp863.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp863, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200C200E000B600E700EA00EB00E800EF00EE201700C000A7
+00C900C800CA00F400CB00CF00FB00F900A400D400DC00A200A300D900DB0192
+00A600B400F300FA00A800B800B300AF00CE231000AC00BD00BC00BE00AB00BB
+259125922593250225242561256225562555256325512557255D255C255B2510
+25142534252C251C2500253C255E255F255A25542569256625602550256C2567
+2568256425652559255825522553256B256A2518250C25882584258C25902580
+03B100DF039303C003A303C300B503C403A6039803A903B4221E03C603B52229
+226100B1226522642320232100F7224800B0221900B7221A207F00B225A000A0
diff --git a/tcl/library/encoding/cp864.enc b/tcl/library/encoding/cp864.enc
new file mode 100644
index 00000000000..71f9e62b1f9
--- /dev/null
+++ b/tcl/library/encoding/cp864.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp864, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+00200021002200230024066A0026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00B000B72219221A259225002502253C2524252C251C25342510250C25142518
+03B2221E03C600B100BD00BC224800AB00BBFEF7FEF8009B009CFEFBFEFC009F
+00A000ADFE8200A300A4FE8400000000FE8EFE8FFE95FE99060CFE9DFEA1FEA5
+0660066106620663066406650666066706680669FED1061BFEB1FEB5FEB9061F
+00A2FE80FE81FE83FE85FECAFE8BFE8DFE91FE93FE97FE9BFE9FFEA3FEA7FEA9
+FEABFEADFEAFFEB3FEB7FEBBFEBFFEC1FEC5FECBFECF00A600AC00F700D7FEC9
+0640FED3FED7FEDBFEDFFEE3FEE7FEEBFEEDFEEFFEF3FEBDFECCFECEFECDFEE1
+FE7D0651FEE5FEE9FEECFEF0FEF2FED0FED5FEF5FEF6FEDDFED9FEF125A00000
diff --git a/tcl/library/encoding/cp865.enc b/tcl/library/encoding/cp865.enc
new file mode 100644
index 00000000000..543da9c5f38
--- /dev/null
+++ b/tcl/library/encoding/cp865.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp865, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D820A70192
+00E100ED00F300FA00F100D100AA00BA00BF231000AC00BD00BC00A100AB00A4
+259125922593250225242561256225562555256325512557255D255C255B2510
+25142534252C251C2500253C255E255F255A25542569256625602550256C2567
+2568256425652559255825522553256B256A2518250C25882584258C25902580
+03B100DF039303C003A303C300B503C403A6039803A903B4221E03C603B52229
+226100B1226522642320232100F7224800B0221900B7221A207F00B225A000A0
diff --git a/tcl/library/encoding/cp866.enc b/tcl/library/encoding/cp866.enc
new file mode 100644
index 00000000000..b851cf5b8c6
--- /dev/null
+++ b/tcl/library/encoding/cp866.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp866, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0410041104120413041404150416041704180419041A041B041C041D041E041F
+0420042104220423042404250426042704280429042A042B042C042D042E042F
+0430043104320433043404350436043704380439043A043B043C043D043E043F
+259125922593250225242561256225562555256325512557255D255C255B2510
+25142534252C251C2500253C255E255F255A25542569256625602550256C2567
+2568256425652559255825522553256B256A2518250C25882584258C25902580
+0440044104420443044404450446044704480449044A044B044C044D044E044F
+040104510404045404070457040E045E00B0221900B7221A211600A425A000A0
diff --git a/tcl/library/encoding/cp869.enc b/tcl/library/encoding/cp869.enc
new file mode 100644
index 00000000000..9fd2929079c
--- /dev/null
+++ b/tcl/library/encoding/cp869.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp869, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850386008700B700AC00A620182019038820150389
+038A03AA038C00930094038E03AB00A9038F00B200B303AC00A303AD03AE03AF
+03CA039003CC03CD039103920393039403950396039700BD0398039900AB00BB
+25912592259325022524039A039B039C039D256325512557255D039E039F2510
+25142534252C251C2500253C03A003A1255A25542569256625602550256C03A3
+03A403A503A603A703A803A903B103B203B32518250C2588258403B403B52580
+03B603B703B803B903BA03BB03BC03BD03BE03BF03C003C103C303C203C40384
+00AD00B103C503C603C700A703C8038500B000A803C903CB03B003CE25A000A0
diff --git a/tcl/library/encoding/cp874.enc b/tcl/library/encoding/cp874.enc
new file mode 100644
index 00000000000..cdcca32af14
--- /dev/null
+++ b/tcl/library/encoding/cp874.enc
@@ -0,0 +1,20 @@
+# Encoding file: cp874, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008420260086008700880089008A008B008C008D008E008F
+009020182019201C201D20222013201400980099009A009B009C009D009E009F
+00A00E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
+0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
+0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F
+0E300E310E320E330E340E350E360E370E380E390E3A00000000000000000E3F
+0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D0E4E0E4F
+0E500E510E520E530E540E550E560E570E580E590E5A0E5B0000000000000000
diff --git a/tcl/library/encoding/cp932.enc b/tcl/library/encoding/cp932.enc
new file mode 100644
index 00000000000..027f7d8c270
--- /dev/null
+++ b/tcl/library/encoding/cp932.enc
@@ -0,0 +1,785 @@
+# Encoding file: cp932, multi-byte
+M
+003F 0 46
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080000000000000000000850086000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+81
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+300030013002FF0CFF0E30FBFF1AFF1BFF1FFF01309B309C00B4FF4000A8FF3E
+FFE3FF3F30FD30FE309D309E30034EDD30053006300730FC20152010FF0FFF3C
+FF5E2225FF5C2026202520182019201C201DFF08FF0930143015FF3BFF3DFF5B
+FF5D30083009300A300B300C300D300E300F30103011FF0BFF0D00B100D70000
+00F7FF1D2260FF1CFF1E22662267221E22342642264000B0203220332103FFE5
+FF04FFE0FFE1FF05FF03FF06FF0AFF2000A72606260525CB25CF25CE25C725C6
+25A125A025B325B225BD25BC203B301221922190219121933013000000000000
+000000000000000000000000000000002208220B2286228722822283222A2229
+0000000000000000000000000000000022272228FFE221D221D4220022030000
+0000000000000000000000000000000000000000222022A52312220222072261
+2252226A226B221A223D221D2235222B222C0000000000000000000000000000
+212B2030266F266D266A2020202100B6000000000000000025EF000000000000
+82
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000FF10
+FF11FF12FF13FF14FF15FF16FF17FF18FF190000000000000000000000000000
+FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2FFF30
+FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3A000000000000000000000000
+0000FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5A00000000000000003041
+30423043304430453046304730483049304A304B304C304D304E304F30503051
+30523053305430553056305730583059305A305B305C305D305E305F30603061
+30623063306430653066306730683069306A306B306C306D306E306F30703071
+30723073307430753076307730783079307A307B307C307D307E307F30803081
+30823083308430853086308730883089308A308B308C308D308E308F30903091
+3092309300000000000000000000000000000000000000000000000000000000
+83
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF30B0
+30B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF30C0
+30C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF30D0
+30D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF0000
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000391
+03920393039403950396039703980399039A039B039C039D039E039F03A003A1
+03A303A403A503A603A703A803A90000000000000000000000000000000003B1
+03B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF03C003C1
+03C303C403C503C603C703C803C9000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+84
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+04100411041204130414041504010416041704180419041A041B041C041D041E
+041F0420042104220423042404250426042704280429042A042B042C042D042E
+042F000000000000000000000000000000000000000000000000000000000000
+04300431043204330434043504510436043704380439043A043B043C043D0000
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000002500
+2502250C251025182514251C252C25242534253C25012503250F2513251B2517
+25232533252B253B254B2520252F25282537253F251D25302525253825420000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+87
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+2460246124622463246424652466246724682469246A246B246C246D246E246F
+2470247124722473216021612162216321642165216621672168216900003349
+33143322334D331833273303333633513357330D33263323332B334A333B339C
+339D339E338E338F33C433A100000000000000000000000000000000337B0000
+301D301F211633CD212132A432A532A632A732A8323132323239337E337D337C
+22522261222B222E2211221A22A52220221F22BF22352229222A000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+88
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000004E9C
+55165A03963F54C0611B632859F690228475831C7A5060AA63E16E2565ED8466
+82A69BF56893572765A162715B9B59D0867B98F47D627DBE9B8E62167C9F88B7
+5B895EB563096697684895C7978D674F4EE54F0A4F4D4F9D504956F2593759D4
+5A015C0960DF610F61706613690570BA754F757079FB7DAD7DEF80C3840E8863
+8B029055907A533B4E954EA557DF80B290C178EF4E0058F16EA290387A328328
+828B9C2F5141537054BD54E156E059FB5F1598F26DEB80E4852D000000000000
+89
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9662967096A097FB540B53F35B8770CF7FBD8FC296E8536F9D5C7ABA4E117893
+81FC6E26561855046B1D851A9C3B59E553A96D6674DC958F56424E91904B96F2
+834F990C53E155B65B305F71662066F368046C386CF36D29745B76C87A4E9834
+82F1885B8A6092ED6DB275AB76CA99C560A68B018D8A95B2698E53AD51860000
+5712583059445BB45EF6602863A963F46CBF6F14708E7114715971D5733F7E01
+827682D185979060925B9D1B586965BC6C5A752551F9592E59655F805FDC62BC
+65FA6A2A6B276BB4738B7FC189569D2C9D0E9EC45CA16C96837B51045C4B61B6
+81C6687672614E594FFA537860696E297A4F97F34E0B53164EEE4F554F3D4FA1
+4F7352A053EF5609590F5AC15BB65BE179D16687679C67B66B4C6CB3706B73C2
+798D79BE7A3C7B8782B182DB8304837783EF83D387668AB256298CA88FE6904E
+971E868A4FC45CE862117259753B81E582BD86FE8CC096C5991399D54ECB4F1A
+89E356DE584A58CA5EFB5FEB602A6094606261D0621262D06539000000000000
+8A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9B41666668B06D777070754C76867D7582A587F9958B968E8C9D51F152BE5916
+54B35BB35D16616869826DAF788D84CB88578A7293A79AB86D6C99A886D957A3
+67FF86CE920E5283568754045ED362E164B9683C68386BBB737278BA7A6B899A
+89D28D6B8F0390ED95A3969497695B665CB3697D984D984E639B7B206A2B0000
+6A7F68B69C0D6F5F5272559D607062EC6D3B6E076ED1845B89108F444E149C39
+53F6691B6A3A9784682A515C7AC384B291DC938C565B9D286822830584317CA5
+520882C574E64E7E4F8351A05BD2520A52D852E75DFB559A582A59E65B8C5B98
+5BDB5E725E7960A3611F616361BE63DB656267D1685368FA6B3E6B536C576F22
+6F976F4574B0751876E3770B7AFF7BA17C217DE97F367FF0809D8266839E89B3
+8ACC8CAB908494519593959195A2966597D3992882184E38542B5CB85DCC73A9
+764C773C5CA97FEB8D0B96C19811985498584F014F0E5371559C566857FA5947
+5B095BC45C905E0C5E7E5FCC63EE673A65D765E2671F68CB68C4000000000000
+8B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A5F5E306BC56C176C7D757F79485B637A007D005FBD898F8A188CB48D778ECC
+8F1D98E29A0E9B3C4E80507D510059935B9C622F628064EC6B3A72A075917947
+7FA987FB8ABC8B7063AC83CA97A05409540355AB68546A588A70782767759ECD
+53745BA2811A865090064E184E454EC74F1153CA54385BAE5F13602565510000
+673D6C426C726CE3707874037A767AAE7B087D1A7CFE7D6665E7725B53BB5C45
+5DE862D262E063196E20865A8A318DDD92F86F0179A69B5A4EA84EAB4EAC4F9B
+4FA050D151477AF6517151F653545321537F53EB55AC58835CE15F375F4A602F
+6050606D631F65596A4B6CC172C272ED77EF80F881058208854E90F793E197FF
+99579A5A4EF051DD5C2D6681696D5C4066F26975738968507C8150C552E45747
+5DFE932665A46B236B3D7434798179BD7B4B7DCA82B983CC887F895F8B398FD1
+91D1541F92804E5D503653E5533A72D7739677E982E68EAF99C699C899D25177
+611A865E55B07A7A50765BD3904796854E326ADB91E75C515C48000000000000
+8C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63987A9F6C9397748F617AAA718A96887C8268177E706851936C52F2541B85AB
+8A137FA48ECD90E15366888879414FC250BE521151445553572D73EA578B5951
+5F625F8460756176616761A963B2643A656C666F68426E1375667A3D7CFB7D4C
+7D997E4B7F6B830E834A86CD8A088A638B668EFD981A9D8F82B88FCE9BE80000
+5287621F64836FC09699684150916B206C7A6F547A747D5088408A2367084EF6
+503950265065517C5238526355A7570F58055ACC5EFA61B261F862F36372691C
+6A29727D72AC732E7814786F7D79770C80A9898B8B198CE28ED290639375967A
+98559A139E785143539F53B35E7B5F266E1B6E90738473FE7D4382378A008AFA
+96504E4E500B53E4547C56FA59D15B645DF15EAB5F276238654567AF6E5672D0
+7CCA88B480A180E183F0864E8A878DE8923796C798679F134E944E924F0D5348
+5449543E5A2F5F8C5FA1609F68A76A8E745A78818A9E8AA48B7791904E5E9BC9
+4EA44F7C4FAF501950165149516C529F52B952FE539A53E35411000000000000
+8D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+540E5589575157A2597D5B545B5D5B8F5DE55DE75DF75E785E835E9A5EB75F18
+6052614C629762D863A7653B6602664366F4676D6821689769CB6C5F6D2A6D69
+6E2F6E9D75327687786C7A3F7CE07D057D187D5E7DB18015800380AF80B18154
+818F822A8352884C88618B1B8CA28CFC90CA91759271783F92FC95A4964D0000
+980599999AD89D3B525B52AB53F7540858D562F76FE08C6A8F5F9EB9514B523B
+544A56FD7A4091779D609ED273446F09817075115FFD60DA9AA872DB8FBC6B64
+98034ECA56F0576458BE5A5A606861C7660F6606683968B16DF775D57D3A826E
+9B424E9B4F5053C955065D6F5DE65DEE67FB6C99747378028A50939688DF5750
+5EA7632B50B550AC518D670054C9585E59BB5BB05F69624D63A1683D6B736E08
+707D91C7728078157826796D658E7D3083DC88C18F09969B5264572867507F6A
+8CA151B45742962A583A698A80B454B25D0E57FC78959DFA4F5C524A548B643E
+6628671467F57A847B567D22932F685C9BAD7B395319518A5237000000000000
+8E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5BDF62F664AE64E6672D6BBA85A996D176909BD6634C93069BAB76BF66524E09
+509853C25C7160E864926563685F71E673CA75237B977E8286958B838CDB9178
+991065AC66AB6B8B4ED54ED44F3A4F7F523A53F853F255E356DB58EB59CB59C9
+59FF5B505C4D5E025E2B5FD7601D6307652F5B5C65AF65BD65E8679D6B620000
+6B7B6C0F7345794979C17CF87D197D2B80A2810281F389968A5E8A698A668A8C
+8AEE8CC78CDC96CC98FC6B6F4E8B4F3C4F8D51505B575BFA6148630166426B21
+6ECB6CBB723E74BD75D478C1793A800C803381EA84948F9E6C509E7F5F0F8B58
+9D2B7AFA8EF85B8D96EB4E0353F157F759315AC95BA460896E7F6F0675BE8CEA
+5B9F85007BE0507267F4829D5C61854A7E1E820E51995C0463688D66659C716E
+793E7D1780058B1D8ECA906E86C790AA501F52FA5C3A6753707C7235914C91C8
+932B82E55BC25F3160F94E3B53D65B88624B67316B8A72E973E07A2E816B8DA3
+91529996511253D7546A5BFF63886A397DAC970056DA53CE5468000000000000
+8F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B975C315DDE4FEE610162FE6D3279C079CB7D427E4D7FD281ED821F84908846
+89728B908E748F2F9031914B916C96C6919C4EC04F4F514553415F93620E67D4
+6C416E0B73637E2691CD928353D459195BBF6DD1795D7E2E7C9B587E719F51FA
+88538FF04FCA5CFB662577AC7AE3821C99FF51C65FAA65EC696F6B896DF30000
+6E966F6476FE7D145DE190759187980651E6521D6240669166D96E1A5EB67DD2
+7F7266F885AF85F78AF852A953D959735E8F5F90605592E4966450B7511F52DD
+5320534753EC54E8554655315617596859BE5A3C5BB55C065C0F5C115C1A5E84
+5E8A5EE05F70627F628462DB638C63776607660C662D6676677E68A26A1F6A35
+6CBC6D886E096E58713C7126716775C77701785D7901796579F07AE07B117CA7
+7D39809683D6848B8549885D88F38A1F8A3C8A548A738C618CDE91A49266937E
+9418969C97984E0A4E084E1E4E575197527057CE583458CC5B225E3860C564FE
+676167566D4472B675737A6384B88B7291B89320563157F498FE000000000000
+90
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62ED690D6B9671ED7E548077827289E698DF87558FB15C3B4F384FE14FB55507
+5A205BDD5BE95FC3614E632F65B0664B68EE699B6D786DF1753375B9771F795E
+79E67D3381E382AF85AA89AA8A3A8EAB8F9B903291DD97074EBA4EC152035875
+58EC5C0B751A5C3D814E8A0A8FC59663976D7B258ACF9808916256F353A80000
+9017543957825E2563A86C34708A77617C8B7FE088709042915493109318968F
+745E9AC45D075D69657067A28DA896DB636E6749691983C5981796C088FE6F84
+647A5BF84E16702C755D662F51C4523652E259D35F8160276210653F6574661F
+667468F268166B636E057272751F76DB7CBE805658F088FD897F8AA08A938ACB
+901D91929752975965897A0E810696BB5E2D60DC621A65A56614679077F37A4D
+7C4D7E3E810A8CAC8D648DE18E5F78A9520762D963A5644262988A2D7A837BC0
+8AAC96EA7D76820C87494ED95148534353605BA35C025C165DDD6226624764B0
+681368346CC96D456D1767D36F5C714E717D65CB7A7F7BAD7DDA000000000000
+91
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7E4A7FA8817A821B823985A68A6E8CCE8DF59078907792AD929195839BAE524D
+55846F387136516879857E5581B37CCE564C58515CA863AA66FE66FD695A72D9
+758F758E790E795679DF7C977D207D4486078A34963B90619F2050E7527553CC
+53E2500955AA58EE594F723D5B8B5C64531D60E360F3635C6383633F63BB0000
+64CD65E966F95DE369CD69FD6F1571E54E8975E976F87A937CDF7DCF7D9C8061
+83498358846C84BC85FB88C58D709001906D9397971C9A1250CF5897618E81D3
+85358D0890204FC3507452475373606F6349675F6E2C8DB3901F4FD75C5E8CCA
+65CF7D9A53528896517663C35B585B6B5C0A640D6751905C4ED6591A592A6C70
+8A51553E581559A560F0625367C182356955964099C49A284F5358065BFE8010
+5CB15E2F5F856020614B623466FF6CF06EDE80CE817F82D4888B8CB89000902E
+968A9EDB9BDB4EE353F059277B2C918D984C9DF96EDD7027535355445B856258
+629E62D36CA26FEF74228A1794386FC18AFE833851E786F853EA000000000000
+92
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53E94F4690548FB0596A81315DFD7AEA8FBF68DA8C3772F89C486A3D8AB04E39
+53585606576662C563A265E66B4E6DE16E5B70AD77ED7AEF7BAA7DBB803D80C6
+86CB8A95935B56E358C75F3E65AD66966A806BB575378AC7502477E557305F1B
+6065667A6C6075F47A1A7F6E81F48718904599B37BC9755C7AF97B5184C40000
+901079E97A9283365AE177404E2D4EF25B995FE062BD663C67F16CE8866B8877
+8A3B914E92F399D06A177026732A82E784578CAF4E01514651CB558B5BF55E16
+5E335E815F145F355F6B5FB461F2631166A2671D6F6E7252753A773A80748139
+817887768ABF8ADC8D858DF3929A957798029CE552C5635776F467156C8873CD
+8CC393AE96736D25589C690E69CC8FFD939A75DB901A585A680263B469FB4F43
+6F2C67D88FBB85267DB49354693F6F70576A58F75B2C7D2C722A540A91E39DB4
+4EAD4F4E505C507552438C9E544858245B9A5E1D5E955EAD5EF75F1F608C62B5
+633A63D068AF6C407887798E7A0B7DE082478A028AE68E449013000000000000
+93
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+90B8912D91D89F0E6CE5645864E265756EF476847B1B906993D16EBA54F25FB9
+64A48F4D8FED92445178586B59295C555E976DFB7E8F751C8CBC8EE2985B70B9
+4F1D6BBF6FB1753096FB514E54105835585759AC5C605F926597675C6E21767B
+83DF8CED901490FD934D7825783A52AA5EA6571F597460125012515A51AC0000
+51CD520055105854585859575B955CF65D8B60BC6295642D6771684368BC68DF
+76D76DD86E6F6D9B706F71C85F5375D879777B497B547B527CD67D7152308463
+856985E48A0E8B048C468E0F9003900F94199676982D9A3095D850CD52D5540C
+58025C0E61A7649E6D1E77B37AE580F48404905392855CE09D07533F5F975FB3
+6D9C7279776379BF7BE46BD272EC8AAD68036A6151F87A8169345C4A9CF682EB
+5BC59149701E56785C6F60C765666C8C8C5A90419813545166C7920D594890A3
+51854E4D51EA85998B0E7058637A934B696299B47E047577535769608EDF96E3
+6C5D4E8C5C3C5F108FE953028CD1808986795EFF65E54E735165000000000000
+94
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59825C3F97EE4EFB598A5FCD8A8D6FE179B079625BE78471732B71B15E745FF5
+637B649A71C37C984E435EFC4E4B57DC56A260A96FC37D0D80FD813381BF8FB2
+899786A45DF4628A64AD898767776CE26D3E743678345A467F7582AD99AC4FF3
+5EC362DD63926557676F76C3724C80CC80BA8F29914D500D57F95A9268850000
+6973716472FD8CB758F28CE0966A9019877F79E477E784294F2F5265535A62CD
+67CF6CCA767D7B947C95823685848FEB66DD6F2072067E1B83AB99C19EA651FD
+7BB178727BB880877B486AE85E61808C75517560516B92626E8C767A91979AEA
+4F107F70629C7B4F95A59CE9567A585986E496BC4F345224534A53CD53DB5E06
+642C6591677F6C3E6C4E724872AF73ED75547E41822C85E98CA97BC491C67169
+981298EF633D6669756A76E478D0854386EE532A5351542659835E875F7C60B2
+6249627962AB65906BD46CCC75B276AE789179D87DCB7F7780A588AB8AB98CBB
+907F975E98DB6A0B7C3850995C3E5FAE67876BD8743577097F8E000000000000
+95
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9F3B67CA7A175339758B9AED5F66819D83F180985F3C5FC575627B46903C6867
+59EB5A9B7D10767E8B2C4FF55F6A6A196C376F0274E2796888688A558C795EDF
+63CF75C579D282D7932892F2849C86ED9C2D54C15F6C658C6D5C70158CA78CD3
+983B654F74F64E0D4ED857E0592B5A665BCC51A85E035E9C6016627665770000
+65A7666E6D6E72367B268150819A82998B5C8CA08CE68D74961C96444FAE64AB
+6B66821E8461856A90E85C01695398A8847A85574F0F526F5FA95E45670D798F
+8179890789866DF55F1762556CB84ECF72699B925206543B567458B361A4626E
+711A596E7C897CDE7D1B96F06587805E4E194F75517558405E635E735F0A67C4
+4E26853D9589965B7C73980150FB58C1765678A7522577A585117B86504F5909
+72477BC77DE88FBA8FD4904D4FBF52C95A295F0197AD4FDD821792EA57036355
+6B69752B88DC8F147A4252DF58936155620A66AE6BCD7C3F83E950234FF85305
+5446583159495B9D5CF05CEF5D295E9662B16367653E65B9670B000000000000
+96
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6CD56CE170F978327E2B80DE82B3840C84EC870289128A2A8C4A90A692D298FD
+9CF39D6C4E4F4EA1508D5256574A59A85E3D5FD85FD9623F66B4671B67D068D2
+51927D2180AA81A88B008C8C8CBF927E96325420982C531750D5535C58A864B2
+6734726777667A4691E652C36CA16B8658005E4C5954672C7FFB51E176C60000
+646978E89B549EBB57CB59B96627679A6BCE54E969D95E55819C67959BAA67FE
+9C52685D4EA64FE353C862B9672B6CAB8FC44FAD7E6D9EBF4E0761626E806F2B
+85135473672A9B455DF37B955CAC5BC6871C6E4A84D17A14810859997C8D6C11
+772052D959227121725F77DB97279D61690B5A7F5A1851A5540D547D660E76DF
+8FF792989CF459EA725D6EC5514D68C97DBF7DEC97629EBA64786A2183025984
+5B5F6BDB731B76F27DB280178499513267289ED976EE676252FF99055C24623B
+7C7E8CB0554F60B67D0B958053014E5F51B6591C723A803691CE5F2577E25384
+5F797D0485AC8A338E8D975667F385AE9453610961086CB97652000000000000
+97
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8AED8F38552F4F51512A52C753CB5BA55E7D60A0618263D6670967DA6E676D8C
+733673377531795088D58A98904A909190F596C4878D59154E884F594E0E8A89
+8F3F981050AD5E7C59965BB95EB863DA63FA64C166DC694A69D86D0B6EB67194
+75287AAF7F8A8000844984C989818B218E0A9065967D990A617E62916B320000
+6C836D747FCC7FFC6DC07F8587BA88F8676583B1983C96F76D1B7D61843D916A
+4E7153755D506B046FEB85CD862D89A75229540F5C65674E68A87406748375E2
+88CF88E191CC96E296785F8B73877ACB844E63A0756552896D416E9C74097559
+786B7C9296867ADC9F8D4FB6616E65C5865C4E864EAE50DA4E2151CC5BEE6599
+68816DBC731F764277AD7A1C7CE7826F8AD2907C91CF96759818529B7DD1502B
+539867976DCB71D0743381E88F2A96A39C579E9F746058416D997D2F985E4EE4
+4F364F8B51B752B15DBA601C73B2793C82D3923496B796F6970A9E979F6266A6
+6B74521752A370C888C25EC9604B61906F2371497C3E7DF4806F000000000000
+98
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+84EE9023932C54429B6F6AD370898CC28DEF973252B45A415ECA5F046717697C
+69946D6A6F0F726272FC7BED8001807E874B90CE516D9E937984808B93328AD6
+502D548C8A716B6A8CC4810760D167A09DF24E994E989C108A6B85C185686900
+6E7E789781550000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000005F0C
+4E104E154E2A4E314E364E3C4E3F4E424E564E584E824E858C6B4E8A82125F0D
+4E8E4E9E4E9F4EA04EA24EB04EB34EB64ECE4ECD4EC44EC64EC24ED74EDE4EED
+4EDF4EF74F094F5A4F304F5B4F5D4F574F474F764F884F8F4F984F7B4F694F70
+4F914F6F4F864F9651184FD44FDF4FCE4FD84FDB4FD14FDA4FD04FE44FE5501A
+50285014502A502550054F1C4FF650215029502C4FFE4FEF5011500650435047
+6703505550505048505A5056506C50785080509A508550B450B2000000000000
+99
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50C950CA50B350C250D650DE50E550ED50E350EE50F950F55109510151025116
+51155114511A5121513A5137513C513B513F51405152514C515451627AF85169
+516A516E5180518256D8518C5189518F519151935195519651A451A651A251A9
+51AA51AB51B351B151B251B051B551BD51C551C951DB51E0865551E951ED0000
+51F051F551FE5204520B5214520E5227522A522E52335239524F5244524B524C
+525E5254526A527452695273527F527D528D529452925271528852918FA88FA7
+52AC52AD52BC52B552C152CD52D752DE52E352E698ED52E052F352F552F852F9
+530653087538530D5310530F5315531A5323532F533153335338534053465345
+4E175349534D51D6535E5369536E5918537B53775382539653A053A653A553AE
+53B053B653C37C1296D953DF66FC71EE53EE53E853ED53FA5401543D5440542C
+542D543C542E54365429541D544E548F5475548E545F5471547754705492547B
+5480547654845490548654C754A254B854A554AC54C454C854A8000000000000
+9A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54AB54C254A454BE54BC54D854E554E6550F551454FD54EE54ED54FA54E25539
+55405563554C552E555C55455556555755385533555D5599558054AF558A559F
+557B557E5598559E55AE557C558355A9558755A855DA55C555DF55C455DC55E4
+55D4561455F7561655FE55FD561B55F9564E565071DF56345636563256380000
+566B5664562F566C566A56865680568A56A05694568F56A556AE56B656B456C2
+56BC56C156C356C056C856CE56D156D356D756EE56F9570056FF570457095708
+570B570D57135718571655C7571C572657375738574E573B5740574F576957C0
+57885761577F5789579357A057B357A457AA57B057C357C657D457D257D3580A
+57D657E3580B5819581D587258215862584B58706BC05852583D5879588558B9
+589F58AB58BA58DE58BB58B858AE58C558D358D158D758D958D858E558DC58E4
+58DF58EF58FA58F958FB58FC58FD5902590A5910591B68A65925592C592D5932
+5938593E7AD259555950594E595A5958596259605967596C5969000000000000
+9B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59785981599D4F5E4FAB59A359B259C659E859DC598D59D959DA5A255A1F5A11
+5A1C5A095A1A5A405A6C5A495A355A365A625A6A5A9A5ABC5ABE5ACB5AC25ABD
+5AE35AD75AE65AE95AD65AFA5AFB5B0C5B0B5B165B325AD05B2A5B365B3E5B43
+5B455B405B515B555B5A5B5B5B655B695B705B735B755B7865885B7A5B800000
+5B835BA65BB85BC35BC75BC95BD45BD05BE45BE65BE25BDE5BE55BEB5BF05BF6
+5BF35C055C075C085C0D5C135C205C225C285C385C395C415C465C4E5C535C50
+5C4F5B715C6C5C6E4E625C765C795C8C5C915C94599B5CAB5CBB5CB65CBC5CB7
+5CC55CBE5CC75CD95CE95CFD5CFA5CED5D8C5CEA5D0B5D155D175D5C5D1F5D1B
+5D115D145D225D1A5D195D185D4C5D525D4E5D4B5D6C5D735D765D875D845D82
+5DA25D9D5DAC5DAE5DBD5D905DB75DBC5DC95DCD5DD35DD25DD65DDB5DEB5DF2
+5DF55E0B5E1A5E195E115E1B5E365E375E445E435E405E4E5E575E545E5F5E62
+5E645E475E755E765E7A9EBC5E7F5EA05EC15EC25EC85ED05ECF000000000000
+9C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5ED65EE35EDD5EDA5EDB5EE25EE15EE85EE95EEC5EF15EF35EF05EF45EF85EFE
+5F035F095F5D5F5C5F0B5F115F165F295F2D5F385F415F485F4C5F4E5F2F5F51
+5F565F575F595F615F6D5F735F775F835F825F7F5F8A5F885F915F875F9E5F99
+5F985FA05FA85FAD5FBC5FD65FFB5FE45FF85FF15FDD60B35FFF602160600000
+601960106029600E6031601B6015602B6026600F603A605A6041606A6077605F
+604A6046604D6063604360646042606C606B60596081608D60E76083609A6084
+609B60966097609260A7608B60E160B860E060D360B45FF060BD60C660B560D8
+614D6115610660F660F7610060F460FA6103612160FB60F1610D610E6147613E
+61286127614A613F613C612C6134613D614261446173617761586159615A616B
+6174616F61656171615F615D6153617561996196618761AC6194619A618A6191
+61AB61AE61CC61CA61C961F761C861C361C661BA61CB7F7961CD61E661E361F6
+61FA61F461FF61FD61FC61FE620062086209620D620C6214621B000000000000
+9D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+621E6221622A622E6230623262336241624E625E6263625B62606268627C6282
+6289627E62926293629662D46283629462D762D162BB62CF62FF62C664D462C8
+62DC62CC62CA62C262C7629B62C9630C62EE62F163276302630862EF62F56350
+633E634D641C634F6396638E638063AB637663A3638F6389639F63B5636B0000
+636963BE63E963C063C663E363C963D263F663C4641664346406641364266436
+651D64176428640F6467646F6476644E652A6495649364A564A9648864BC64DA
+64D264C564C764BB64D864C264F164E7820964E064E162AC64E364EF652C64F6
+64F464F264FA650064FD6518651C650565246523652B65346535653765366538
+754B654865566555654D6558655E655D65726578658265838B8A659B659F65AB
+65B765C365C665C165C465CC65D265DB65D965E065E165F16772660A660365FB
+6773663566366634661C664F664466496641665E665D666466676668665F6662
+667066836688668E668966846698669D66C166B966C966BE66BC000000000000
+9E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+66C466B866D666DA66E0663F66E666E966F066F566F7670F6716671E67266727
+9738672E673F67366741673867376746675E67606759676367646789677067A9
+677C676A678C678B67A667A1678567B767EF67B467EC67B367E967B867E467DE
+67DD67E267EE67B967CE67C667E76A9C681E684668296840684D6832684E0000
+68B3682B685968636877687F689F688F68AD6894689D689B68836AAE68B96874
+68B568A068BA690F688D687E690168CA690868D86922692668E1690C68CD68D4
+68E768D569366912690468D768E3692568F968E068EF6928692A691A69236921
+68C669796977695C6978696B6954697E696E69396974693D695969306961695E
+695D6981696A69B269AE69D069BF69C169D369BE69CE5BE869CA69DD69BB69C3
+69A76A2E699169A0699C699569B469DE69E86A026A1B69FF6B0A69F969F269E7
+6A0569B16A1E69ED6A1469EB6A0A6A126AC16A236A136A446A0C6A726A366A78
+6A476A626A596A666A486A386A226A906A8D6AA06A846AA26AA3000000000000
+9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A9786176ABB6AC36AC26AB86AB36AAC6ADE6AD16ADF6AAA6ADA6AEA6AFB6B05
+86166AFA6B126B169B316B1F6B386B3776DC6B3998EE6B476B436B496B506B59
+6B546B5B6B5F6B616B786B796B7F6B806B846B836B8D6B986B956B9E6BA46BAA
+6BAB6BAF6BB26BB16BB36BB76BBC6BC66BCB6BD36BDF6BEC6BEB6BF36BEF0000
+9EBE6C086C136C146C1B6C246C236C5E6C556C626C6A6C826C8D6C9A6C816C9B
+6C7E6C686C736C926C906CC46CF16CD36CBD6CD76CC56CDD6CAE6CB16CBE6CBA
+6CDB6CEF6CD96CEA6D1F884D6D366D2B6D3D6D386D196D356D336D126D0C6D63
+6D936D646D5A6D796D596D8E6D956FE46D856DF96E156E0A6DB56DC76DE66DB8
+6DC66DEC6DDE6DCC6DE86DD26DC56DFA6DD96DE46DD56DEA6DEE6E2D6E6E6E2E
+6E196E726E5F6E3E6E236E6B6E2B6E766E4D6E1F6E436E3A6E4E6E246EFF6E1D
+6E386E826EAA6E986EC96EB76ED36EBD6EAF6EC46EB26ED46ED56E8F6EA56EC2
+6E9F6F416F11704C6EEC6EF86EFE6F3F6EF26F316EEF6F326ECC000000000000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F3E6F136EF76F866F7A6F786F816F806F6F6F5B6FF36F6D6F826F7C6F586F8E
+6F916FC26F666FB36FA36FA16FA46FB96FC66FAA6FDF6FD56FEC6FD46FD86FF1
+6FEE6FDB7009700B6FFA70117001700F6FFE701B701A6F74701D7018701F7030
+703E7032705170637099709270AF70F170AC70B870B370AE70DF70CB70DD0000
+70D9710970FD711C711971657155718871667162714C7156716C718F71FB7184
+719571A871AC71D771B971BE71D271C971D471CE71E071EC71E771F571FC71F9
+71FF720D7210721B7228722D722C72307232723B723C723F72407246724B7258
+7274727E7282728172877292729672A272A772B972B272C372C672C472CE72D2
+72E272E072E172F972F7500F7317730A731C7316731D7334732F73297325733E
+734E734F9ED87357736A7368737073787375737B737A73C873B373CE73BB73C0
+73E573EE73DE74A27405746F742573F87432743A7455743F745F74597441745C
+746974707463746A7476747E748B749E74A774CA74CF74D473F1000000000000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74E074E374E774E974EE74F274F074F174F874F7750475037505750C750E750D
+75157513751E7526752C753C7544754D754A7549755B7546755A756975647567
+756B756D75787576758675877574758A758975827594759A759D75A575A375C2
+75B375C375B575BD75B875BC75B175CD75CA75D275D975E375DE75FE75FF0000
+75FC760175F075FA75F275F3760B760D7609761F762776207621762276247634
+7630763B764776487646765C76587661766276687669766A7667766C76707672
+76767678767C768076837688768B768E769676937699769A76B076B476B876B9
+76BA76C276CD76D676D276DE76E176E576E776EA862F76FB7708770777047729
+7724771E77257726771B773777387747775A7768776B775B7765777F777E7779
+778E778B779177A0779E77B077B677B977BF77BC77BD77BB77C777CD77D777DA
+77DC77E377EE77FC780C781279267820792A7845788E78747886787C789A788C
+78A378B578AA78AF78D178C678CB78D478BE78BC78C578CA78EC000000000000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+78E778DA78FD78F47907791279117919792C792B794079607957795F795A7955
+7953797A797F798A799D79A79F4B79AA79AE79B379B979BA79C979D579E779EC
+79E179E37A087A0D7A187A197A207A1F79807A317A3B7A3E7A377A437A577A49
+7A617A627A699F9D7A707A797A7D7A887A977A957A987A967AA97AC87AB00000
+7AB67AC57AC47ABF90837AC77ACA7ACD7ACF7AD57AD37AD97ADA7ADD7AE17AE2
+7AE67AED7AF07B027B0F7B0A7B067B337B187B197B1E7B357B287B367B507B7A
+7B047B4D7B0B7B4C7B457B757B657B747B677B707B717B6C7B6E7B9D7B987B9F
+7B8D7B9C7B9A7B8B7B927B8F7B5D7B997BCB7BC17BCC7BCF7BB47BC67BDD7BE9
+7C117C147BE67BE57C607C007C077C137BF37BF77C177C0D7BF67C237C277C2A
+7C1F7C377C2B7C3D7C4C7C437C547C4F7C407C507C587C5F7C647C567C657C6C
+7C757C837C907CA47CAD7CA27CAB7CA17CA87CB37CB27CB17CAE7CB97CBD7CC0
+7CC57CC27CD87CD27CDC7CE29B3B7CEF7CF27CF47CF67CFA7D06000000000000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7D027D1C7D157D0A7D457D4B7D2E7D327D3F7D357D467D737D567D4E7D727D68
+7D6E7D4F7D637D937D897D5B7D8F7D7D7D9B7DBA7DAE7DA37DB57DC77DBD7DAB
+7E3D7DA27DAF7DDC7DB87D9F7DB07DD87DDD7DE47DDE7DFB7DF27DE17E057E0A
+7E237E217E127E317E1F7E097E0B7E227E467E667E3B7E357E397E437E370000
+7E327E3A7E677E5D7E567E5E7E597E5A7E797E6A7E697E7C7E7B7E837DD57E7D
+8FAE7E7F7E887E897E8C7E927E907E937E947E967E8E7E9B7E9C7F387F3A7F45
+7F4C7F4D7F4E7F507F517F557F547F587F5F7F607F687F697F677F787F827F86
+7F837F887F877F8C7F947F9E7F9D7F9A7FA37FAF7FB27FB97FAE7FB67FB88B71
+7FC57FC67FCA7FD57FD47FE17FE67FE97FF37FF998DC80068004800B80128018
+8019801C80218028803F803B804A804680528058805A805F8062806880738072
+807080768079807D807F808480868085809B8093809A80AD519080AC80DB80E5
+80D980DD80C480DA80D6810980EF80F1811B81298123812F814B000000000000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+968B8146813E8153815180FC8171816E81658166817481838188818A81808182
+81A0819581A481A3815F819381A981B081B581BE81B881BD81C081C281BA81C9
+81CD81D181D981D881C881DA81DF81E081E781FA81FB81FE8201820282058207
+820A820D821082168229822B82388233824082598258825D825A825F82640000
+82628268826A826B822E827182778278827E828D829282AB829F82BB82AC82E1
+82E382DF82D282F482F382FA8393830382FB82F982DE830682DC830982D98335
+83348316833283318340833983508345832F832B831783188385839A83AA839F
+83A283968323838E8387838A837C83B58373837583A0838983A883F4841383EB
+83CE83FD840383D8840B83C183F7840783E083F2840D8422842083BD84388506
+83FB846D842A843C855A84848477846B84AD846E848284698446842C846F8479
+843584CA846284B984BF849F84D984CD84BB84DA84D084C184C684D684A18521
+84FF84F485178518852C851F8515851484FC8540856385588548000000000000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+85418602854B8555858085A485888591858A85A8856D8594859B85EA8587859C
+8577857E859085C985BA85CF85B985D085D585DD85E585DC85F9860A8613860B
+85FE85FA86068622861A8630863F864D4E558654865F86678671869386A386A9
+86AA868B868C86B686AF86C486C686B086C9882386AB86D486DE86E986EC0000
+86DF86DB86EF8712870687088700870386FB87118709870D86F9870A8734873F
+8737873B87258729871A8760875F8778874C874E877487578768876E87598753
+8763876A880587A2879F878287AF87CB87BD87C087D096D687AB87C487B387C7
+87C687BB87EF87F287E0880F880D87FE87F687F7880E87D28811881688158822
+88218831883688398827883B8844884288528859885E8862886B8881887E889E
+8875887D88B5887288828897889288AE889988A2888D88A488B088BF88B188C3
+88C488D488D888D988DD88F9890288FC88F488E888F28904890C890A89138943
+891E8925892A892B89418944893B89368938894C891D8960895E000000000000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+89668964896D896A896F89748977897E89838988898A8993899889A189A989A6
+89AC89AF89B289BA89BD89BF89C089DA89DC89DD89E789F489F88A038A168A10
+8A0C8A1B8A1D8A258A368A418A5B8A528A468A488A7C8A6D8A6C8A628A858A82
+8A848AA88AA18A918AA58AA68A9A8AA38AC48ACD8AC28ADA8AEB8AF38AE70000
+8AE48AF18B148AE08AE28AF78ADE8ADB8B0C8B078B1A8AE18B168B108B178B20
+8B3397AB8B268B2B8B3E8B288B418B4C8B4F8B4E8B498B568B5B8B5A8B6B8B5F
+8B6C8B6F8B748B7D8B808B8C8B8E8B928B938B968B998B9A8C3A8C418C3F8C48
+8C4C8C4E8C508C558C628C6C8C788C7A8C828C898C858C8A8C8D8C8E8C948C7C
+8C98621D8CAD8CAA8CBD8CB28CB38CAE8CB68CC88CC18CE48CE38CDA8CFD8CFA
+8CFB8D048D058D0A8D078D0F8D0D8D109F4E8D138CCD8D148D168D678D6D8D71
+8D738D818D998DC28DBE8DBA8DCF8DDA8DD68DCC8DDB8DCB8DEA8DEB8DDF8DE3
+8DFC8E088E098DFF8E1D8E1E8E108E1F8E428E358E308E348E4A000000000000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E478E498E4C8E508E488E598E648E608E2A8E638E558E768E728E7C8E818E87
+8E858E848E8B8E8A8E938E918E948E998EAA8EA18EAC8EB08EC68EB18EBE8EC5
+8EC88ECB8EDB8EE38EFC8EFB8EEB8EFE8F0A8F058F158F128F198F138F1C8F1F
+8F1B8F0C8F268F338F3B8F398F458F428F3E8F4C8F498F468F4E8F578F5C0000
+8F628F638F648F9C8F9F8FA38FAD8FAF8FB78FDA8FE58FE28FEA8FEF90878FF4
+90058FF98FFA901190159021900D901E9016900B90279036903590398FF8904F
+905090519052900E9049903E90569058905E9068906F907696A890729082907D
+90819080908A9089908F90A890AF90B190B590E290E4624890DB910291129119
+91329130914A9156915891639165916991739172918B9189918291A291AB91AF
+91AA91B591B491BA91C091C191C991CB91D091D691DF91E191DB91FC91F591F6
+921E91FF9214922C92159211925E925792459249926492489295923F924B9250
+929C92969293929B925A92CF92B992B792E9930F92FA9344932E000000000000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+93199322931A9323933A9335933B935C9360937C936E935693B093AC93AD9394
+93B993D693D793E893E593D893C393DD93D093C893E4941A9414941394039407
+94109436942B94359421943A944194529444945B94609462945E946A92299470
+94759477947D945A947C947E9481947F95829587958A95949596959895990000
+95A095A895A795AD95BC95BB95B995BE95CA6FF695C395CD95CC95D595D495D6
+95DC95E195E595E296219628962E962F9642964C964F964B9677965C965E965D
+965F96669672966C968D96989695969796AA96A796B196B296B096B496B696B8
+96B996CE96CB96C996CD894D96DC970D96D596F99704970697089713970E9711
+970F971697199724972A97309739973D973E97449746974897429749975C9760
+97649766976852D2976B977197799785977C9781977A9786978B978F9790979C
+97A897A697A397B397B497C397C697C897CB97DC97ED9F4F97F27ADF97F697F5
+980F980C9838982498219837983D9846984F984B986B986F9870000000000000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+98719874987398AA98AF98B198B698C498C398C698E998EB9903990999129914
+99189921991D991E99249920992C992E993D993E9942994999459950994B9951
+9952994C99559997999899A599AD99AE99BC99DF99DB99DD99D899D199ED99EE
+99F199F299FB99F89A019A0F9A0599E29A199A2B9A379A459A429A409A430000
+9A3E9A559A4D9A5B9A579A5F9A629A659A649A699A6B9A6A9AAD9AB09ABC9AC0
+9ACF9AD19AD39AD49ADE9ADF9AE29AE39AE69AEF9AEB9AEE9AF49AF19AF79AFB
+9B069B189B1A9B1F9B229B239B259B279B289B299B2A9B2E9B2F9B329B449B43
+9B4F9B4D9B4E9B519B589B749B939B839B919B969B979B9F9BA09BA89BB49BC0
+9BCA9BB99BC69BCF9BD19BD29BE39BE29BE49BD49BE19C3A9BF29BF19BF09C15
+9C149C099C139C0C9C069C089C129C0A9C049C2E9C1B9C259C249C219C309C47
+9C329C469C3E9C5A9C609C679C769C789CE79CEC9CF09D099D089CEB9D039D06
+9D2A9D269DAF9D239D1F9D449D159D129D419D3F9D3E9D469D48000000000000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9D5D9D5E9D649D519D509D599D729D899D879DAB9D6F9D7A9D9A9DA49DA99DB2
+9DC49DC19DBB9DB89DBA9DC69DCF9DC29DD99DD39DF89DE69DED9DEF9DFD9E1A
+9E1B9E1E9E759E799E7D9E819E889E8B9E8C9E929E959E919E9D9EA59EA99EB8
+9EAA9EAD97619ECC9ECE9ECF9ED09ED49EDC9EDE9EDD9EE09EE59EE89EEF0000
+9EF49EF69EF79EF99EFB9EFC9EFD9F079F0876B79F159F219F2C9F3E9F4A9F52
+9F549F639F5F9F609F619F669F679F6C9F6A9F779F729F769F959F9C9FA0582F
+69C79059746451DC719900000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7E8A891C9348928884DC4FC970BB663168C892F966FB5F454E284EE14EFC4F00
+4F034F394F564F924F8A4F9A4F944FCD504050224FFF501E5046507050425094
+50F450D8514A5164519D51BE51EC5215529C52A652C052DB5300530753245372
+539353B253DDFA0E549C548A54A954FF55865759576557AC57C857C7FA0F0000
+FA10589E58B2590B5953595B595D596359A459BA5B565BC0752F5BD85BEC5C1E
+5CA65CBA5CF55D275D53FA115D425D6D5DB85DB95DD05F215F345F675FB75FDE
+605D6085608A60DE60D5612060F26111613761306198621362A663F56460649D
+64CE654E66006615663B6609662E661E6624666566576659FA126673669966A0
+66B266BF66FA670EF929676667BB685267C06801684468CFFA136968FA146998
+69E26A306A6B6A466A736A7E6AE26AE46BD66C3F6C5C6C866C6F6CDA6D046D87
+6D6F6D966DAC6DCF6DF86DF26DFC6E396E5C6E276E3C6EBF6F886FB56FF57005
+70077028708570AB710F7104715C71467147FA1571C171FE72B1000000000000
+EE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+72BE7324FA16737773BD73C973D673E373D2740773F57426742A7429742E7462
+7489749F7501756F7682769C769E769B76A6FA17774652AF7821784E7864787A
+7930FA18FA19FA1A7994FA1B799B7AD17AE7FA1C7AEB7B9EFA1D7D487D5C7DB7
+7DA07DD67E527F477FA1FA1E83018362837F83C783F6844884B4855385590000
+856BFA1F85B0FA20FA21880788F58A128A378A798AA78ABE8ADFFA228AF68B53
+8B7F8CF08CF48D128D76FA238ECFFA24FA25906790DEFA269115912791DA91D7
+91DE91ED91EE91E491E592069210920A923A9240923C924E9259925192399267
+92A79277927892E792D792D992D0FA2792D592E092D39325932192FBFA28931E
+92FF931D93029370935793A493C693DE93F89431944594489592F9DCFA29969D
+96AF9733973B9743974D974F9751975598579865FA2AFA2B9927FA2C999E9A4E
+9AD99ADC9B759B729B8F9BB19BBB9C009D709D6BFA2D9E199ED1000000002170
+217121722173217421752176217721782179FFE2FFE4FF07FF02000000000000
+FA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+2170217121722173217421752176217721782179216021612162216321642165
+2166216721682169FFE2FFE4FF07FF0232312116212122357E8A891C93489288
+84DC4FC970BB663168C892F966FB5F454E284EE14EFC4F004F034F394F564F92
+4F8A4F9A4F944FCD504050224FFF501E504650705042509450F450D8514A0000
+5164519D51BE51EC5215529C52A652C052DB5300530753245372539353B253DD
+FA0E549C548A54A954FF55865759576557AC57C857C7FA0FFA10589E58B2590B
+5953595B595D596359A459BA5B565BC0752F5BD85BEC5C1E5CA65CBA5CF55D27
+5D53FA115D425D6D5DB85DB95DD05F215F345F675FB75FDE605D6085608A60DE
+60D5612060F26111613761306198621362A663F56460649D64CE654E66006615
+663B6609662E661E6624666566576659FA126673669966A066B266BF66FA670E
+F929676667BB685267C06801684468CFFA136968FA14699869E26A306A6B6A46
+6A736A7E6AE26AE46BD66C3F6C5C6C866C6F6CDA6D046D876D6F000000000000
+FB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6D966DAC6DCF6DF86DF26DFC6E396E5C6E276E3C6EBF6F886FB56FF570057007
+7028708570AB710F7104715C71467147FA1571C171FE72B172BE7324FA167377
+73BD73C973D673E373D2740773F57426742A7429742E74627489749F7501756F
+7682769C769E769B76A6FA17774652AF7821784E7864787A7930FA18FA190000
+FA1A7994FA1B799B7AD17AE7FA1C7AEB7B9EFA1D7D487D5C7DB77DA07DD67E52
+7F477FA1FA1E83018362837F83C783F6844884B485538559856BFA1F85B0FA20
+FA21880788F58A128A378A798AA78ABE8ADFFA228AF68B538B7F8CF08CF48D12
+8D76FA238ECFFA24FA25906790DEFA269115912791DA91D791DE91ED91EE91E4
+91E592069210920A923A9240923C924E925992519239926792A79277927892E7
+92D792D992D0FA2792D592E092D39325932192FBFA28931E92FF931D93029370
+935793A493C693DE93F89431944594489592F9DCFA29969D96AF9733973B9743
+974D974F9751975598579865FA2AFA2B9927FA2C999E9A4E9AD9000000000000
+FC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9ADC9B759B729B8F9BB19BBB9C009D709D6BFA2D9E199ED10000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/cp936.enc b/tcl/library/encoding/cp936.enc
new file mode 100644
index 00000000000..53d975c48f4
--- /dev/null
+++ b/tcl/library/encoding/cp936.enc
@@ -0,0 +1,2162 @@
+# Encoding file: cp936, multi-byte
+M
+003F 0 127
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+81
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E024E044E054E064E0F4E124E174E1F4E204E214E234E264E294E2E4E2F4E31
+4E334E354E374E3C4E404E414E424E444E464E4A4E514E554E574E5A4E5B4E62
+4E634E644E654E674E684E6A4E6B4E6C4E6D4E6E4E6F4E724E744E754E764E77
+4E784E794E7A4E7B4E7C4E7D4E7F4E804E814E824E834E844E854E874E8A0000
+4E904E964E974E994E9C4E9D4E9E4EA34EAA4EAF4EB04EB14EB44EB64EB74EB8
+4EB94EBC4EBD4EBE4EC84ECC4ECF4ED04ED24EDA4EDB4EDC4EE04EE24EE64EE7
+4EE94EED4EEE4EEF4EF14EF44EF84EF94EFA4EFC4EFE4F004F024F034F044F05
+4F064F074F084F0B4F0C4F124F134F144F154F164F1C4F1D4F214F234F284F29
+4F2C4F2D4F2E4F314F334F354F374F394F3B4F3E4F3F4F404F414F424F444F45
+4F474F484F494F4A4F4B4F4C4F524F544F564F614F624F664F684F6A4F6B4F6D
+4F6E4F714F724F754F774F784F794F7A4F7D4F804F814F824F854F864F874F8A
+4F8C4F8E4F904F924F934F954F964F984F994F9A4F9C4F9E4F9F4FA14FA20000
+82
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4FA44FAB4FAD4FB04FB14FB24FB34FB44FB64FB74FB84FB94FBA4FBB4FBC4FBD
+4FBE4FC04FC14FC24FC64FC74FC84FC94FCB4FCC4FCD4FD24FD34FD44FD54FD6
+4FD94FDB4FE04FE24FE44FE54FE74FEB4FEC4FF04FF24FF44FF54FF64FF74FF9
+4FFB4FFC4FFD4FFF5000500150025003500450055006500750085009500A0000
+500B500E501050115013501550165017501B501D501E50205022502350245027
+502B502F5030503150325033503450355036503750385039503B503D503F5040
+504150425044504550465049504A504B504D5050505150525053505450565057
+50585059505B505D505E505F506050615062506350645066506750685069506A
+506B506D506E506F50705071507250735074507550785079507A507C507D5081
+508250835084508650875089508A508B508C508E508F50905091509250935094
+50955096509750985099509A509B509C509D509E509F50A050A150A250A450A6
+50AA50AB50AD50AE50AF50B050B150B350B450B550B650B750B850B950BC0000
+83
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50BD50BE50BF50C050C150C250C350C450C550C650C750C850C950CA50CB50CC
+50CD50CE50D050D150D250D350D450D550D750D850D950DB50DC50DD50DE50DF
+50E050E150E250E350E450E550E850E950EA50EB50EF50F050F150F250F450F6
+50F750F850F950FA50FC50FD50FE50FF51005101510251035104510551080000
+5109510A510C510D510E510F511051115113511451155116511751185119511A
+511B511C511D511E511F512051225123512451255126512751285129512A512B
+512C512D512E512F5130513151325133513451355136513751385139513A513B
+513C513D513E51425147514A514C514E514F515051525153515751585159515B
+515D515E515F5160516151635164516651675169516A516F5172517A517E517F
+5183518451865187518A518B518E518F51905191519351945198519A519D519E
+519F51A151A351A651A751A851A951AA51AD51AE51B451B851B951BA51BE51BF
+51C151C251C351C551C851CA51CD51CE51D051D251D351D451D551D651D70000
+84
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+51D851D951DA51DC51DE51DF51E251E351E551E651E751E851E951EA51EC51EE
+51F151F251F451F751FE520452055209520B520C520F5210521352145215521C
+521E521F522152225223522552265227522A522C522F5231523252345235523C
+523E524452455246524752485249524B524E524F525252535255525752580000
+5259525A525B525D525F526052625263526452665268526B526C526D526E5270
+52715273527452755276527752785279527A527B527C527E5280528352845285
+528652875289528A528B528C528D528E528F5291529252945295529652975298
+5299529A529C52A452A552A652A752AE52AF52B052B452B552B652B752B852B9
+52BA52BB52BC52BD52C052C152C252C452C552C652C852CA52CC52CD52CE52CF
+52D152D352D452D552D752D952DA52DB52DC52DD52DE52E052E152E252E352E5
+52E652E752E852E952EA52EB52EC52ED52EE52EF52F152F252F352F452F552F6
+52F752F852FB52FC52FD530153025303530453075309530A530B530C530E0000
+85
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53115312531353145318531B531C531E531F532253245325532753285329532B
+532C532D532F533053315332533353345335533653375338533C533D53405342
+53445346534B534C534D5350535453585359535B535D53655368536A536C536D
+537253765379537B537C537D537E53805381538353875388538A538E538F0000
+53905391539253935394539653975399539B539C539E53A053A153A453A753AA
+53AB53AC53AD53AF53B053B153B253B353B453B553B753B853B953BA53BC53BD
+53BE53C053C353C453C553C653C753CE53CF53D053D253D353D553DA53DC53DD
+53DE53E153E253E753F453FA53FE53FF5400540254055407540B541454185419
+541A541C542254245425542A5430543354365437543A543D543F544154425444
+544554475449544C544D544E544F5451545A545D545E545F5460546154635465
+54675469546A546B546C546D546E546F547054745479547A547E547F54815483
+5485548754885489548A548D5491549354975498549C549E549F54A054A10000
+86
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54A254A554AE54B054B254B554B654B754B954BA54BC54BE54C354C554CA54CB
+54D654D854DB54E054E154E254E354E454EB54EC54EF54F054F154F454F554F6
+54F754F854F954FB54FE550055025503550455055508550A550B550C550D550E
+5512551355155516551755185519551A551C551D551E551F5521552555260000
+55285529552B552D553255345535553655385539553A553B553D554055425545
+55475548554B554C554D554E554F5551555255535554555755585559555A555B
+555D555E555F55605562556355685569556B556F557055715572557355745579
+557A557D557F55855586558C558D558E559055925593559555965597559A559B
+559E55A055A155A255A355A455A555A655A855A955AA55AB55AC55AD55AE55AF
+55B055B255B455B655B855BA55BC55BF55C055C155C255C355C655C755C855CA
+55CB55CE55CF55D055D555D755D855D955DA55DB55DE55E055E255E755E955ED
+55EE55F055F155F455F655F855F955FA55FB55FC55FF56025603560456050000
+87
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+56065607560A560B560D561056115612561356145615561656175619561A561C
+561D5620562156225625562656285629562A562B562E562F5630563356355637
+5638563A563C563D563E5640564156425643564456455646564756485649564A
+564B564F565056515652565356555656565A565B565D565E565F566056610000
+5663566556665667566D566E566F56705672567356745675567756785679567A
+567D567E567F56805681568256835684568756885689568A568B568C568D5690
+56915692569456955696569756985699569A569B569C569D569E569F56A056A1
+56A256A456A556A656A756A856A956AA56AB56AC56AD56AE56B056B156B256B3
+56B456B556B656B856B956BA56BB56BD56BE56BF56C056C156C256C356C456C5
+56C656C756C856C956CB56CC56CD56CE56CF56D056D156D256D356D556D656D8
+56D956DC56E356E556E656E756E856E956EA56EC56EE56EF56F256F356F656F7
+56F856FB56FC57005701570257055707570B570C570D570E570F571057110000
+88
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+57125713571457155716571757185719571A571B571D571E5720572157225724
+572557265727572B5731573257345735573657375738573C573D573F57415743
+57445745574657485749574B5752575357545755575657585759576257635765
+5767576C576E5770577157725774577557785779577A577D577E577F57800000
+5781578757885789578A578D578E578F57905791579457955796579757985799
+579A579C579D579E579F57A557A857AA57AC57AF57B057B157B357B557B657B7
+57B957BA57BB57BC57BD57BE57BF57C057C157C457C557C657C757C857C957CA
+57CC57CD57D057D157D357D657D757DB57DC57DE57E157E257E357E557E657E7
+57E857E957EA57EB57EC57EE57F057F157F257F357F557F657F757FB57FC57FE
+57FF580158035804580558085809580A580C580E580F58105812581358145816
+58175818581A581B581C581D581F5822582358255826582758285829582B582C
+582D582E582F58315832583358345836583758385839583A583B583C583D0000
+89
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+583E583F584058415842584358455846584758485849584A584B584E584F5850
+585258535855585658575859585A585B585C585D585F58605861586258635864
+5866586758685869586A586D586E586F58705871587258735874587558765877
+58785879587A587B587C587D587F58825884588658875888588A588B588C0000
+588D588E588F5890589158945895589658975898589B589C589D58A058A158A2
+58A358A458A558A658A758AA58AB58AC58AD58AE58AF58B058B158B258B358B4
+58B558B658B758B858B958BA58BB58BD58BE58BF58C058C258C358C458C658C7
+58C858C958CA58CB58CC58CD58CE58CF58D058D258D358D458D658D758D858D9
+58DA58DB58DC58DD58DE58DF58E058E158E258E358E558E658E758E858E958EA
+58ED58EF58F158F258F458F558F758F858FA58FB58FC58FD58FE58FF59005901
+59035905590659085909590A590B590C590E591059115912591359175918591B
+591D591E592059215922592359265928592C59305932593359355936593B0000
+8A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+593D593E593F5940594359455946594A594C594D5950595259535959595B595C
+595D595E595F5961596359645966596759685969596A596B596C596D596E596F
+59705971597259755977597A597B597C597E597F598059855989598B598C598E
+598F59905991599459955998599A599B599C599D599F59A059A159A259A60000
+59A759AC59AD59B059B159B359B459B559B659B759B859BA59BC59BD59BF59C0
+59C159C259C359C459C559C759C859C959CC59CD59CE59CF59D559D659D959DB
+59DE59DF59E059E159E259E459E659E759E959EA59EB59ED59EE59EF59F059F1
+59F259F359F459F559F659F759F859FA59FC59FD59FE5A005A025A0A5A0B5A0D
+5A0E5A0F5A105A125A145A155A165A175A195A1A5A1B5A1D5A1E5A215A225A24
+5A265A275A285A2A5A2B5A2C5A2D5A2E5A2F5A305A335A355A375A385A395A3A
+5A3B5A3D5A3E5A3F5A415A425A435A445A455A475A485A4B5A4C5A4D5A4E5A4F
+5A505A515A525A535A545A565A575A585A595A5B5A5C5A5D5A5E5A5F5A600000
+8B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A615A635A645A655A665A685A695A6B5A6C5A6D5A6E5A6F5A705A715A725A73
+5A785A795A7B5A7C5A7D5A7E5A805A815A825A835A845A855A865A875A885A89
+5A8A5A8B5A8C5A8D5A8E5A8F5A905A915A935A945A955A965A975A985A995A9C
+5A9D5A9E5A9F5AA05AA15AA25AA35AA45AA55AA65AA75AA85AA95AAB5AAC0000
+5AAD5AAE5AAF5AB05AB15AB45AB65AB75AB95ABA5ABB5ABC5ABD5ABF5AC05AC3
+5AC45AC55AC65AC75AC85ACA5ACB5ACD5ACE5ACF5AD05AD15AD35AD55AD75AD9
+5ADA5ADB5ADD5ADE5ADF5AE25AE45AE55AE75AE85AEA5AEC5AED5AEE5AEF5AF0
+5AF25AF35AF45AF55AF65AF75AF85AF95AFA5AFB5AFC5AFD5AFE5AFF5B005B01
+5B025B035B045B055B065B075B085B0A5B0B5B0C5B0D5B0E5B0F5B105B115B12
+5B135B145B155B185B195B1A5B1B5B1C5B1D5B1E5B1F5B205B215B225B235B24
+5B255B265B275B285B295B2A5B2B5B2C5B2D5B2E5B2F5B305B315B335B355B36
+5B385B395B3A5B3B5B3C5B3D5B3E5B3F5B415B425B435B445B455B465B470000
+8C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B485B495B4A5B4B5B4C5B4D5B4E5B4F5B525B565B5E5B605B615B675B685B6B
+5B6D5B6E5B6F5B725B745B765B775B785B795B7B5B7C5B7E5B7F5B825B865B8A
+5B8D5B8E5B905B915B925B945B965B9F5BA75BA85BA95BAC5BAD5BAE5BAF5BB1
+5BB25BB75BBA5BBB5BBC5BC05BC15BC35BC85BC95BCA5BCB5BCD5BCE5BCF0000
+5BD15BD45BD55BD65BD75BD85BD95BDA5BDB5BDC5BE05BE25BE35BE65BE75BE9
+5BEA5BEB5BEC5BED5BEF5BF15BF25BF35BF45BF55BF65BF75BFD5BFE5C005C02
+5C035C055C075C085C0B5C0C5C0D5C0E5C105C125C135C175C195C1B5C1E5C1F
+5C205C215C235C265C285C295C2A5C2B5C2D5C2E5C2F5C305C325C335C355C36
+5C375C435C445C465C475C4C5C4D5C525C535C545C565C575C585C5A5C5B5C5C
+5C5D5C5F5C625C645C675C685C695C6A5C6B5C6C5C6D5C705C725C735C745C75
+5C765C775C785C7B5C7C5C7D5C7E5C805C835C845C855C865C875C895C8A5C8B
+5C8E5C8F5C925C935C955C9D5C9E5C9F5CA05CA15CA45CA55CA65CA75CA80000
+8D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5CAA5CAE5CAF5CB05CB25CB45CB65CB95CBA5CBB5CBC5CBE5CC05CC25CC35CC5
+5CC65CC75CC85CC95CCA5CCC5CCD5CCE5CCF5CD05CD15CD35CD45CD55CD65CD7
+5CD85CDA5CDB5CDC5CDD5CDE5CDF5CE05CE25CE35CE75CE95CEB5CEC5CEE5CEF
+5CF15CF25CF35CF45CF55CF65CF75CF85CF95CFA5CFC5CFD5CFE5CFF5D000000
+5D015D045D055D085D095D0A5D0B5D0C5D0D5D0F5D105D115D125D135D155D17
+5D185D195D1A5D1C5D1D5D1F5D205D215D225D235D255D285D2A5D2B5D2C5D2F
+5D305D315D325D335D355D365D375D385D395D3A5D3B5D3C5D3F5D405D415D42
+5D435D445D455D465D485D495D4D5D4E5D4F5D505D515D525D535D545D555D56
+5D575D595D5A5D5C5D5E5D5F5D605D615D625D635D645D655D665D675D685D6A
+5D6D5D6E5D705D715D725D735D755D765D775D785D795D7A5D7B5D7C5D7D5D7E
+5D7F5D805D815D835D845D855D865D875D885D895D8A5D8B5D8C5D8D5D8E5D8F
+5D905D915D925D935D945D955D965D975D985D9A5D9B5D9C5D9E5D9F5DA00000
+8E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5DA15DA25DA35DA45DA55DA65DA75DA85DA95DAA5DAB5DAC5DAD5DAE5DAF5DB0
+5DB15DB25DB35DB45DB55DB65DB85DB95DBA5DBB5DBC5DBD5DBE5DBF5DC05DC1
+5DC25DC35DC45DC65DC75DC85DC95DCA5DCB5DCC5DCE5DCF5DD05DD15DD25DD3
+5DD45DD55DD65DD75DD85DD95DDA5DDC5DDF5DE05DE35DE45DEA5DEC5DED0000
+5DF05DF55DF65DF85DF95DFA5DFB5DFC5DFF5E005E045E075E095E0A5E0B5E0D
+5E0E5E125E135E175E1E5E1F5E205E215E225E235E245E255E285E295E2A5E2B
+5E2C5E2F5E305E325E335E345E355E365E395E3A5E3E5E3F5E405E415E435E46
+5E475E485E495E4A5E4B5E4D5E4E5E4F5E505E515E525E535E565E575E585E59
+5E5A5E5C5E5D5E5F5E605E635E645E655E665E675E685E695E6A5E6B5E6C5E6D
+5E6E5E6F5E705E715E755E775E795E7E5E815E825E835E855E885E895E8C5E8D
+5E8E5E925E985E9B5E9D5EA15EA25EA35EA45EA85EA95EAA5EAB5EAC5EAE5EAF
+5EB05EB15EB25EB45EBA5EBB5EBC5EBD5EBF5EC05EC15EC25EC35EC45EC50000
+8F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5EC65EC75EC85ECB5ECC5ECD5ECE5ECF5ED05ED45ED55ED75ED85ED95EDA5EDC
+5EDD5EDE5EDF5EE05EE15EE25EE35EE45EE55EE65EE75EE95EEB5EEC5EED5EEE
+5EEF5EF05EF15EF25EF35EF55EF85EF95EFB5EFC5EFD5F055F065F075F095F0C
+5F0D5F0E5F105F125F145F165F195F1A5F1C5F1D5F1E5F215F225F235F240000
+5F285F2B5F2C5F2E5F305F325F335F345F355F365F375F385F3B5F3D5F3E5F3F
+5F415F425F435F445F455F465F475F485F495F4A5F4B5F4C5F4D5F4E5F4F5F51
+5F545F595F5A5F5B5F5C5F5E5F5F5F605F635F655F675F685F6B5F6E5F6F5F72
+5F745F755F765F785F7A5F7D5F7E5F7F5F835F865F8D5F8E5F8F5F915F935F94
+5F965F9A5F9B5F9D5F9E5F9F5FA05FA25FA35FA45FA55FA65FA75FA95FAB5FAC
+5FAF5FB05FB15FB25FB35FB45FB65FB85FB95FBA5FBB5FBE5FBF5FC05FC15FC2
+5FC75FC85FCA5FCB5FCE5FD35FD45FD55FDA5FDB5FDC5FDE5FDF5FE25FE35FE5
+5FE65FE85FE95FEC5FEF5FF05FF25FF35FF45FF65FF75FF95FFA5FFC60070000
+90
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+60086009600B600C60106011601360176018601A601E601F602260236024602C
+602D602E603060316032603360346036603760386039603A603D603E60406044
+60456046604760486049604A604C604E604F605160536054605660576058605B
+605C605E605F6060606160656066606E60716072607460756077607E60800000
+608160826085608660876088608A608B608E608F609060916093609560976098
+6099609C609E60A160A260A460A560A760A960AA60AE60B060B360B560B660B7
+60B960BA60BD60BE60BF60C060C160C260C360C460C760C860C960CC60CD60CE
+60CF60D060D260D360D460D660D760D960DB60DE60E160E260E360E460E560EA
+60F160F260F560F760F860FB60FC60FD60FE60FF61026103610461056107610A
+610B610C611061116112611361146116611761186119611B611C611D611E6121
+6122612561286129612A612C612D612E612F6130613161326133613461356136
+613761386139613A613B613C613D613E61406141614261436144614561460000
+91
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+61476149614B614D614F61506152615361546156615761586159615A615B615C
+615E615F6160616161636164616561666169616A616B616C616D616E616F6171
+617261736174617661786179617A617B617C617D617E617F6180618161826183
+618461856186618761886189618A618C618D618F619061916192619361950000
+6196619761986199619A619B619C619E619F61A061A161A261A361A461A561A6
+61AA61AB61AD61AE61AF61B061B161B261B361B461B561B661B861B961BA61BB
+61BC61BD61BF61C061C161C361C461C561C661C761C961CC61CD61CE61CF61D0
+61D361D561D661D761D861D961DA61DB61DC61DD61DE61DF61E061E161E261E3
+61E461E561E761E861E961EA61EB61EC61ED61EE61EF61F061F161F261F361F4
+61F661F761F861F961FA61FB61FC61FD61FE6200620162026203620462056207
+6209621362146219621C621D621E622062236226622762286229622B622D622F
+6230623162326235623662386239623A623B623C6242624462456246624A0000
+92
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+624F62506255625662576259625A625C625D625E625F62606261626262646265
+6268627162726274627562776278627A627B627D628162826283628562866287
+6288628B628C628D628E628F629062946299629C629D629E62A362A662A762A9
+62AA62AD62AE62AF62B062B262B362B462B662B762B862BA62BE62C062C10000
+62C362CB62CF62D162D562DD62DE62E062E162E462EA62EB62F062F262F562F8
+62F962FA62FB63006303630463056306630A630B630C630D630F631063126313
+63146315631763186319631C632663276329632C632D632E6330633163336334
+6335633663376338633B633C633E633F63406341634463476348634A63516352
+635363546356635763586359635A635B635C635D63606364636563666368636A
+636B636C636F6370637263736374637563786379637C637D637E637F63816383
+638463856386638B638D639163936394639563976399639A639B639C639D639E
+639F63A163A463A663AB63AF63B163B263B563B663B963BB63BD63BF63C00000
+93
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63C163C263C363C563C763C863CA63CB63CC63D163D363D463D563D763D863D9
+63DA63DB63DC63DD63DF63E263E463E563E663E763E863EB63EC63EE63EF63F0
+63F163F363F563F763F963FA63FB63FC63FE640364046406640764086409640A
+640D640E6411641264156416641764186419641A641D641F6422642364240000
+6425642764286429642B642E642F643064316432643364356436643764386439
+643B643C643E6440644264436449644B644C644D644E644F6450645164536455
+645664576459645A645B645C645D645F64606461646264636464646564666468
+646A646B646C646E646F64706471647264736474647564766477647B647C647D
+647E647F648064816483648664886489648A648B648C648D648E648F64906493
+649464976498649A649B649C649D649F64A064A164A264A364A564A664A764A8
+64AA64AB64AF64B164B264B364B464B664B964BB64BD64BE64BF64C164C364C4
+64C664C764C864C964CA64CB64CC64CF64D164D364D464D564D664D964DA0000
+94
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+64DB64DC64DD64DF64E064E164E364E564E764E864E964EA64EB64EC64ED64EE
+64EF64F064F164F264F364F464F564F664F764F864F964FA64FB64FC64FD64FE
+64FF65016502650365046505650665076508650A650B650C650D650E650F6510
+6511651365146515651665176519651A651B651C651D651E651F652065210000
+6522652365246526652765286529652A652C652D65306531653265336537653A
+653C653D6540654165426543654465466547654A654B654D654E655065526553
+655465576558655A655C655F6560656165646565656765686569656A656D656E
+656F657165736575657665786579657A657B657C657D657E657F658065816582
+658365846585658665886589658A658D658E658F65926594659565966598659A
+659D659E65A065A265A365A665A865AA65AC65AE65B165B265B365B465B565B6
+65B765B865BA65BB65BE65BF65C065C265C765C865C965CA65CD65D065D165D3
+65D465D565D865D965DA65DB65DC65DD65DE65DF65E165E365E465EA65EB0000
+95
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+65F265F365F465F565F865F965FB65FC65FD65FE65FF66016604660566076608
+6609660B660D661066116612661666176618661A661B661C661E662166226623
+662466266629662A662B662C662E663066326633663766386639663A663B663D
+663F66406642664466456646664766486649664A664D664E6650665166580000
+6659665B665C665D665E666066626663666566676669666A666B666C666D6671
+66726673667566786679667B667C667D667F6680668166836685668666886689
+668A668B668D668E668F6690669266936694669566986699669A669B669C669E
+669F66A066A166A266A366A466A566A666A966AA66AB66AC66AD66AF66B066B1
+66B266B366B566B666B766B866BA66BB66BC66BD66BF66C066C166C266C366C4
+66C566C666C766C866C966CA66CB66CC66CD66CE66CF66D066D166D266D366D4
+66D566D666D766D866DA66DE66DF66E066E166E266E366E466E566E766E866EA
+66EB66EC66ED66EE66EF66F166F566F666F866FA66FB66FD6701670267030000
+96
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6704670567066707670C670E670F671167126713671667186719671A671C671E
+67206721672267236724672567276729672E6730673267336736673767386739
+673B673C673E673F6741674467456747674A674B674D67526754675567576758
+6759675A675B675D67626763676467666767676B676C676E6771677467760000
+67786779677A677B677D678067826783678567866788678A678C678D678E678F
+679167926793679467966799679B679F67A067A167A467A667A967AC67AE67B1
+67B267B467B967BA67BB67BC67BD67BE67BF67C067C267C567C667C767C867C9
+67CA67CB67CC67CD67CE67D567D667D767DB67DF67E167E367E467E667E767E8
+67EA67EB67ED67EE67F267F567F667F767F867F967FA67FB67FC67FE68016802
+680368046806680D681068126814681568186819681A681B681C681E681F6820
+6822682368246825682668276828682B682C682D682E682F6830683168346835
+6836683A683B683F6847684B684D684F68526856685768586859685A685B0000
+97
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+685C685D685E685F686A686C686D686E686F6870687168726873687568786879
+687A687B687C687D687E687F688068826884688768886889688A688B688C688D
+688E68906891689268946895689668986899689A689B689C689D689E689F68A0
+68A168A368A468A568A968AA68AB68AC68AE68B168B268B468B668B768B80000
+68B968BA68BB68BC68BD68BE68BF68C168C368C468C568C668C768C868CA68CC
+68CE68CF68D068D168D368D468D668D768D968DB68DC68DD68DE68DF68E168E2
+68E468E568E668E768E868E968EA68EB68EC68ED68EF68F268F368F468F668F7
+68F868FB68FD68FE68FF69006902690369046906690769086909690A690C690F
+69116913691469156916691769186919691A691B691C691D691E692169226923
+69256926692769286929692A692B692C692E692F693169326933693569366937
+6938693A693B693C693E694069416943694469456946694769486949694A694B
+694C694D694E694F69506951695269536955695669586959695B695C695F0000
+98
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6961696269646965696769686969696A696C696D696F69706972697369746975
+6976697A697B697D697E697F698169836985698A698B698C698E698F69906991
+69926993699669976999699A699D699E699F69A069A169A269A369A469A569A6
+69A969AA69AC69AE69AF69B069B269B369B569B669B869B969BA69BC69BD0000
+69BE69BF69C069C269C369C469C569C669C769C869C969CB69CD69CF69D169D2
+69D369D569D669D769D869D969DA69DC69DD69DE69E169E269E369E469E569E6
+69E769E869E969EA69EB69EC69EE69EF69F069F169F369F469F569F669F769F8
+69F969FA69FB69FC69FE6A006A016A026A036A046A056A066A076A086A096A0B
+6A0C6A0D6A0E6A0F6A106A116A126A136A146A156A166A196A1A6A1B6A1C6A1D
+6A1E6A206A226A236A246A256A266A276A296A2B6A2C6A2D6A2E6A306A326A33
+6A346A366A376A386A396A3A6A3B6A3C6A3F6A406A416A426A436A456A466A48
+6A496A4A6A4B6A4C6A4D6A4E6A4F6A516A526A536A546A556A566A576A5A0000
+99
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A5C6A5D6A5E6A5F6A606A626A636A646A666A676A686A696A6A6A6B6A6C6A6D
+6A6E6A6F6A706A726A736A746A756A766A776A786A7A6A7B6A7D6A7E6A7F6A81
+6A826A836A856A866A876A886A896A8A6A8B6A8C6A8D6A8F6A926A936A946A95
+6A966A986A996A9A6A9B6A9C6A9D6A9E6A9F6AA16AA26AA36AA46AA56AA60000
+6AA76AA86AAA6AAD6AAE6AAF6AB06AB16AB26AB36AB46AB56AB66AB76AB86AB9
+6ABA6ABB6ABC6ABD6ABE6ABF6AC06AC16AC26AC36AC46AC56AC66AC76AC86AC9
+6ACA6ACB6ACC6ACD6ACE6ACF6AD06AD16AD26AD36AD46AD56AD66AD76AD86AD9
+6ADA6ADB6ADC6ADD6ADE6ADF6AE06AE16AE26AE36AE46AE56AE66AE76AE86AE9
+6AEA6AEB6AEC6AED6AEE6AEF6AF06AF16AF26AF36AF46AF56AF66AF76AF86AF9
+6AFA6AFB6AFC6AFD6AFE6AFF6B006B016B026B036B046B056B066B076B086B09
+6B0A6B0B6B0C6B0D6B0E6B0F6B106B116B126B136B146B156B166B176B186B19
+6B1A6B1B6B1C6B1D6B1E6B1F6B256B266B286B296B2A6B2B6B2C6B2D6B2E0000
+9A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6B2F6B306B316B336B346B356B366B386B3B6B3C6B3D6B3F6B406B416B426B44
+6B456B486B4A6B4B6B4D6B4E6B4F6B506B516B526B536B546B556B566B576B58
+6B5A6B5B6B5C6B5D6B5E6B5F6B606B616B686B696B6B6B6C6B6D6B6E6B6F6B70
+6B716B726B736B746B756B766B776B786B7A6B7D6B7E6B7F6B806B856B880000
+6B8C6B8E6B8F6B906B916B946B956B976B986B996B9C6B9D6B9E6B9F6BA06BA2
+6BA36BA46BA56BA66BA76BA86BA96BAB6BAC6BAD6BAE6BAF6BB06BB16BB26BB6
+6BB86BB96BBA6BBB6BBC6BBD6BBE6BC06BC36BC46BC66BC76BC86BC96BCA6BCC
+6BCE6BD06BD16BD86BDA6BDC6BDD6BDE6BDF6BE06BE26BE36BE46BE56BE66BE7
+6BE86BE96BEC6BED6BEE6BF06BF16BF26BF46BF66BF76BF86BFA6BFB6BFC6BFE
+6BFF6C006C016C026C036C046C086C096C0A6C0B6C0C6C0E6C126C176C1C6C1D
+6C1E6C206C236C256C2B6C2C6C2D6C316C336C366C376C396C3A6C3B6C3C6C3E
+6C3F6C436C446C456C486C4B6C4C6C4D6C4E6C4F6C516C526C536C566C580000
+9B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6C596C5A6C626C636C656C666C676C6B6C6C6C6D6C6E6C6F6C716C736C756C77
+6C786C7A6C7B6C7C6C7F6C806C846C876C8A6C8B6C8D6C8E6C916C926C956C96
+6C976C986C9A6C9C6C9D6C9E6CA06CA26CA86CAC6CAF6CB06CB46CB56CB66CB7
+6CBA6CC06CC16CC26CC36CC66CC76CC86CCB6CCD6CCE6CCF6CD16CD26CD80000
+6CD96CDA6CDC6CDD6CDF6CE46CE66CE76CE96CEC6CED6CF26CF46CF96CFF6D00
+6D026D036D056D066D086D096D0A6D0D6D0F6D106D116D136D146D156D166D18
+6D1C6D1D6D1F6D206D216D226D236D246D266D286D296D2C6D2D6D2F6D306D34
+6D366D376D386D3A6D3F6D406D426D446D496D4C6D506D556D566D576D586D5B
+6D5D6D5F6D616D626D646D656D676D686D6B6D6C6D6D6D706D716D726D736D75
+6D766D796D7A6D7B6D7D6D7E6D7F6D806D816D836D846D866D876D8A6D8B6D8D
+6D8F6D906D926D966D976D986D996D9A6D9C6DA26DA56DAC6DAD6DB06DB16DB3
+6DB46DB66DB76DB96DBA6DBB6DBC6DBD6DBE6DC16DC26DC36DC86DC96DCA0000
+9C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6DCD6DCE6DCF6DD06DD26DD36DD46DD56DD76DDA6DDB6DDC6DDF6DE26DE36DE5
+6DE76DE86DE96DEA6DED6DEF6DF06DF26DF46DF56DF66DF86DFA6DFD6DFE6DFF
+6E006E016E026E036E046E066E076E086E096E0B6E0F6E126E136E156E186E19
+6E1B6E1C6E1E6E1F6E226E266E276E286E2A6E2C6E2E6E306E316E336E350000
+6E366E376E396E3B6E3C6E3D6E3E6E3F6E406E416E426E456E466E476E486E49
+6E4A6E4B6E4C6E4F6E506E516E526E556E576E596E5A6E5C6E5D6E5E6E606E61
+6E626E636E646E656E666E676E686E696E6A6E6C6E6D6E6F6E706E716E726E73
+6E746E756E766E776E786E796E7A6E7B6E7C6E7D6E806E816E826E846E876E88
+6E8A6E8B6E8C6E8D6E8E6E916E926E936E946E956E966E976E996E9A6E9B6E9D
+6E9E6EA06EA16EA36EA46EA66EA86EA96EAB6EAC6EAD6EAE6EB06EB36EB56EB8
+6EB96EBC6EBE6EBF6EC06EC36EC46EC56EC66EC86EC96ECA6ECC6ECD6ECE6ED0
+6ED26ED66ED86ED96EDB6EDC6EDD6EE36EE76EEA6EEB6EEC6EED6EEE6EEF0000
+9D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6EF06EF16EF26EF36EF56EF66EF76EF86EFA6EFB6EFC6EFD6EFE6EFF6F006F01
+6F036F046F056F076F086F0A6F0B6F0C6F0D6F0E6F106F116F126F166F176F18
+6F196F1A6F1B6F1C6F1D6F1E6F1F6F216F226F236F256F266F276F286F2C6F2E
+6F306F326F346F356F376F386F396F3A6F3B6F3C6F3D6F3F6F406F416F420000
+6F436F446F456F486F496F4A6F4C6F4E6F4F6F506F516F526F536F546F556F56
+6F576F596F5A6F5B6F5D6F5F6F606F616F636F646F656F676F686F696F6A6F6B
+6F6C6F6F6F706F716F736F756F766F776F796F7B6F7D6F7E6F7F6F806F816F82
+6F836F856F866F876F8A6F8B6F8F6F906F916F926F936F946F956F966F976F98
+6F996F9A6F9B6F9D6F9E6F9F6FA06FA26FA36FA46FA56FA66FA86FA96FAA6FAB
+6FAC6FAD6FAE6FAF6FB06FB16FB26FB46FB56FB76FB86FBA6FBB6FBC6FBD6FBE
+6FBF6FC16FC36FC46FC56FC66FC76FC86FCA6FCB6FCC6FCD6FCE6FCF6FD06FD3
+6FD46FD56FD66FD76FD86FD96FDA6FDB6FDC6FDD6FDF6FE26FE36FE46FE50000
+9E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6FE66FE76FE86FE96FEA6FEB6FEC6FED6FF06FF16FF26FF36FF46FF56FF66FF7
+6FF86FF96FFA6FFB6FFC6FFD6FFE6FFF70007001700270037004700570067007
+70087009700A700B700C700D700E700F70107012701370147015701670177018
+7019701C701D701E701F702070217022702470257026702770287029702A0000
+702B702C702D702E702F70307031703270337034703670377038703A703B703C
+703D703E703F7040704170427043704470457046704770487049704A704B704D
+704E7050705170527053705470557056705770587059705A705B705C705D705F
+7060706170627063706470657066706770687069706A706E7071707270737074
+70777079707A707B707D7081708270837084708670877088708B708C708D708F
+70907091709370977098709A709B709E709F70A070A170A270A370A470A570A6
+70A770A870A970AA70B070B270B470B570B670BA70BE70BF70C470C570C670C7
+70C970CB70CC70CD70CE70CF70D070D170D270D370D470D570D670D770DA0000
+9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+70DC70DD70DE70E070E170E270E370E570EA70EE70F070F170F270F370F470F5
+70F670F870FA70FB70FC70FE70FF710071017102710371047105710671077108
+710B710C710D710E710F7111711271147117711B711C711D711E711F71207121
+7122712371247125712771287129712A712B712C712D712E7132713371340000
+7135713771387139713A713B713C713D713E713F714071417142714371447146
+714771487149714B714D714F7150715171527153715471557156715771587159
+715A715B715D715F716071617162716371657169716A716B716C716D716F7170
+717171747175717671777179717B717C717E717F718071817182718371857186
+718771887189718B718C718D718E7190719171927193719571967197719A719B
+719C719D719E71A171A271A371A471A571A671A771A971AA71AB71AD71AE71AF
+71B071B171B271B471B671B771B871BA71BB71BC71BD71BE71BF71C071C171C2
+71C471C571C671C771C871C971CA71CB71CC71CD71CF71D071D171D271D30000
+A0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+71D671D771D871D971DA71DB71DC71DD71DE71DF71E171E271E371E471E671E8
+71E971EA71EB71EC71ED71EF71F071F171F271F371F471F571F671F771F871FA
+71FB71FC71FD71FE71FF720072017202720372047205720772087209720A720B
+720C720D720E720F7210721172127213721472157216721772187219721A0000
+721B721C721E721F722072217222722372247225722672277229722B722D722E
+722F723272337234723A723C723E72407241724272437244724572467249724A
+724B724E724F7250725172537254725572577258725A725C725E726072637264
+72657268726A726B726C726D7270727172737274727672777278727B727C727D
+7282728372857286728772887289728C728E7290729172937294729572967297
+72987299729A729B729C729D729E72A072A172A272A372A472A572A672A772A8
+72A972AA72AB72AE72B172B272B372B572BA72BB72BC72BD72BE72BF72C072C5
+72C672C772C972CA72CB72CC72CF72D172D372D472D572D672D872DA72DB0000
+A1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030003001300200B702C902C700A8300330052014FF5E2016202620182019
+201C201D3014301530083009300A300B300C300D300E300F3016301730103011
+00B100D700F72236222722282211220F222A222922082237221A22A522252220
+23122299222B222E2261224C2248223D221D2260226E226F22642265221E2235
+22342642264000B0203220332103FF0400A4FFE0FFE1203000A7211626062605
+25CB25CF25CE25C725C625A125A025B325B2203B219221902191219330130000
+A2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000217021712172217321742175217621772178217900000000000000000000
+000024882489248A248B248C248D248E248F2490249124922493249424952496
+249724982499249A249B247424752476247724782479247A247B247C247D247E
+247F248024812482248324842485248624872460246124622463246424652466
+2467246824690000000032203221322232233224322532263227322832290000
+00002160216121622163216421652166216721682169216A216B000000000000
+A3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF01FF02FF03FFE5FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F
+FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFF3CFF3DFF3EFF3F
+FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000
+A4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+A5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+A6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+FE35FE36FE39FE3AFE3FFE40FE3DFE3EFE41FE42FE43FE4400000000FE3BFE3C
+FE37FE38FE310000FE33FE340000000000000000000000000000000000000000
+A7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000004100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+A8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+02CA02CB02D920132015202520352105210921962197219821992215221F2223
+22522266226722BF2550255125522553255425552556255725582559255A255B
+255C255D255E255F2560256125622563256425652566256725682569256A256B
+256C256D256E256F257025712572257325812582258325842585258625870000
+25882589258A258B258C258D258E258F25932594259525BC25BD25E225E325E4
+25E5260922953012301D301E0000000000000000000000000000000000000000
+0000010100E101CE00E0011300E9011B00E8012B00ED01D000EC014D00F301D2
+00F2016B00FA01D400F901D601D801DA01DC00FC00EA02510000014401480000
+0261000000000000000031053106310731083109310A310B310C310D310E310F
+3110311131123113311431153116311731183119311A311B311C311D311E311F
+3120312131223123312431253126312731283129000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30213022302330243025302630273028302932A3338E338F339C339D339E33A1
+33C433CE33D133D233D5FE30FFE2FFE400002121323100002010000000000000
+30FC309B309C30FD30FE3006309D309EFE49FE4AFE4BFE4CFE4DFE4EFE4FFE50
+FE51FE52FE54FE55FE56FE57FE59FE5AFE5BFE5CFE5DFE5EFE5FFE60FE610000
+FE62FE63FE64FE65FE66FE68FE69FE6AFE6B0000000000000000000000000000
+0000000000000000000000003007000000000000000000000000000000000000
+00000000000000002500250125022503250425052506250725082509250A250B
+250C250D250E250F2510251125122513251425152516251725182519251A251B
+251C251D251E251F2520252125222523252425252526252725282529252A252B
+252C252D252E252F2530253125322533253425352536253725382539253A253B
+253C253D253E253F2540254125422543254425452546254725482549254A254B
+0000000000000000000000000000000000000000000000000000000000000000
+AA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+72DC72DD72DF72E272E372E472E572E672E772EA72EB72F572F672F972FD72FE
+72FF73007302730473057306730773087309730B730C730D730F731073117312
+731473187319731A731F732073237324732673277328732D732F733073327333
+73357336733A733B733C733D7340734173427343734473457346734773480000
+7349734A734B734C734E734F7351735373547355735673587359735A735B735C
+735D735E735F736173627363736473657366736773687369736A736B736E7370
+7371000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+AB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+73727373737473757376737773787379737A737B737C737D737F738073817382
+7383738573867388738A738C738D738F73907392739373947395739773987399
+739A739C739D739E73A073A173A373A473A573A673A773A873AA73AC73AD73B1
+73B473B573B673B873B973BC73BD73BE73BF73C173C373C473C573C673C70000
+73CB73CC73CE73D273D373D473D573D673D773D873DA73DB73DC73DD73DF73E1
+73E273E373E473E673E873EA73EB73EC73EE73EF73F073F173F373F473F573F6
+73F7000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+AC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+73F873F973FA73FB73FC73FD73FE73FF740074017402740474077408740B740C
+740D740E741174127413741474157416741774187419741C741D741E741F7420
+74217423742474277429742B742D742F74317432743774387439743A743B743D
+743E743F744074427443744474457446744774487449744A744B744C744D0000
+744E744F7450745174527453745474567458745D746074617462746374647465
+7466746774687469746A746B746C746E746F7471747274737474747574787479
+747A000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+AD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+747B747C747D747F748274847485748674887489748A748C748D748F74917492
+7493749474957496749774987499749A749B749D749F74A074A174A274A374A4
+74A574A674AA74AB74AC74AD74AE74AF74B074B174B274B374B474B574B674B7
+74B874B974BB74BC74BD74BE74BF74C074C174C274C374C474C574C674C70000
+74C874C974CA74CB74CC74CD74CE74CF74D074D174D374D474D574D674D774D8
+74D974DA74DB74DD74DF74E174E574E774E874E974EA74EB74EC74ED74F074F1
+74F2000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+AE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74F374F574F874F974FA74FB74FC74FD74FE7500750175027503750575067507
+75087509750A750B750C750E751075127514751575167517751B751D751E7520
+752175227523752475267527752A752E753475367539753C753D753F75417542
+75437544754675477549754A754D755075517552755375557556755775580000
+755D755E755F75607561756275637564756775687569756B756C756D756E756F
+757075717573757575767577757A757B757C757D757E75807581758275847585
+7587000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+AF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+75887589758A758C758D758E7590759375957598759B759C759E75A275A675A7
+75A875A975AA75AD75B675B775BA75BB75BF75C075C175C675CB75CC75CE75CF
+75D075D175D375D775D975DA75DC75DD75DF75E075E175E575E975EC75ED75EE
+75EF75F275F375F575F675F775F875FA75FB75FD75FE76027604760676070000
+76087609760B760D760E760F76117612761376147616761A761C761D761E7621
+762376277628762C762E762F76317632763676377639763A763B763D76417642
+7644000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+B0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+76457646764776487649764A764B764E764F7650765176527653765576577658
+7659765A765B765D765F766076617662766476657666766776687669766A766C
+766D766E767076717672767376747675767676777679767A767C767F76807681
+768376857689768A768C768D768F769076927694769576977698769A769B0000
+769C769D769E769F76A076A176A276A376A576A676A776A876A976AA76AB76AC
+76AD76AF76B076B376B576B676B776B876B976BA76BB76BC76BD76BE76C076C1
+76C3554A963F57C3632854CE550954C07691764C853C77EE827E788D72319698
+978D6C285B894FFA630966975CB880FA684880AE660276CE51F9655671AC7FF1
+888450B2596561CA6FB382AD634C625253ED54277B06516B75A45DF462D48DCB
+9776628A8019575D97387F627238767D67CF767E64464F708D2562DC7A176591
+73ED642C6273822C9881677F7248626E62CC4F3474E3534A529E7ECA90A65E2E
+6886699C81807ED168D278C5868C9551508D8C2482DE80DE5305891252650000
+B1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+76C476C776C976CB76CC76D376D576D976DA76DC76DD76DE76E076E176E276E3
+76E476E676E776E876E976EA76EB76EC76ED76F076F376F576F676F776FA76FB
+76FD76FF77007702770377057706770A770C770E770F77107711771277137714
+7715771677177718771B771C771D771E77217723772477257727772A772B0000
+772C772E773077317732773377347739773B773D773E773F7742774477457746
+77487749774A774B774C774D774E774F77527753775477557756775777587759
+775C858496F94FDD582199715B9D62B162A566B48C799C8D7206676F789160B2
+535153178F8880CC8D1D94A1500D72C8590760EB711988AB595482EF672C7B28
+5D297EF7752D6CF58E668FF8903C9F3B6BD491197B145F7C78A784D6853D6BD5
+6BD96BD65E015E8775F995ED655D5F0A5FC58F9F58C181C2907F965B97AD8FB9
+7F168D2C62414FBF53D8535E8FA88FA98FAB904D68075F6A819888689CD6618B
+522B762A5F6C658C6FD26EE85BBE6448517551B067C44E1979C9997C70B30000
+B2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+775D775E775F7760776477677769776A776D776E776F77707771777277737774
+7775777677777778777A777B777C7781778277837786778777887789778A778B
+778F77907793779477957796779777987799779A779B779C779D779E77A177A3
+77A477A677A877AB77AD77AE77AF77B177B277B477B677B777B877B977BA0000
+77BC77BE77C077C177C277C377C477C577C677C777C877C977CA77CB77CC77CE
+77CF77D077D177D277D377D477D577D677D877D977DA77DD77DE77DF77E077E1
+77E475C55E7673BB83E064AD62E894B56CE2535A52C3640F94C27B944F2F5E1B
+82368116818A6E246CCA9A736355535C54FA886557E04E0D5E036B657C3F90E8
+601664E6731C88C16750624D8D22776C8E2991C75F6983DC8521991053C28695
+6B8B60ED60E8707F82CD82314ED36CA785CF64CD7CD969FD66F9834953957B56
+4FA7518C6D4B5C428E6D63D253C9832C833667E578B4643D5BDF5C945DEE8BE7
+62C667F48C7A640063BA8749998B8C177F2094F24EA7961098A4660C73160000
+B3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+77E677E877EA77EF77F077F177F277F477F577F777F977FA77FB77FC78037804
+7805780678077808780A780B780E780F7810781378157819781B781E78207821
+782278247828782A782B782E782F78317832783378357836783D783F78417842
+78437844784678487849784A784B784D784F78517853785478587859785A0000
+785B785C785E785F7860786178627863786478657866786778687869786F7870
+78717872787378747875787678787879787A787B787D787E787F788078817882
+7883573A5C1D5E38957F507F80A05382655E7545553150218D856284949E671D
+56326F6E5DE2543570928F66626F64A463A35F7B6F8890F481E38FB05C186668
+5FF16C8996488D81886C649179F057CE6A59621054484E587A0B60E96F848BDA
+627F901E9A8B79E4540375F4630153196C608FDF5F1B9A70803B9F7F4F885C3A
+8D647FC565A570BD514551B2866B5D075BA062BD916C75748E0C7A2061017B79
+4EC77EF877854E1181ED521D51FA6A7153A88E87950496CF6EC19664695A0000
+B4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7884788578867888788A788B788F789078927894789578967899789D789E78A0
+78A278A478A678A878A978AA78AB78AC78AD78AE78AF78B578B678B778B878BA
+78BB78BC78BD78BF78C078C278C378C478C678C778C878CC78CD78CE78CF78D1
+78D278D378D678D778D878DA78DB78DC78DD78DE78DF78E078E178E278E30000
+78E478E578E678E778E978EA78EB78ED78EE78EF78F078F178F378F578F678F8
+78F978FB78FC78FD78FE78FF79007902790379047906790779087909790A790B
+790C784050A877D7641089E6590463E35DDD7A7F693D4F20823955984E3275AE
+7A975E625E8A95EF521B5439708A6376952457826625693F918755076DF37EAF
+882262337EF075B5832878C196CC8F9E614874F78BCD6B64523A8D506B21806A
+847156F153064ECE4E1B51D17C97918B7C074FC38E7F7BE17A9C64675D1450AC
+810676017CB96DEC7FE067515B585BF878CB64AE641363AA632B9519642D8FBE
+7B5476296253592754466B7950A362345E266B864EE38D37888B5F85902E0000
+B5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+790D790E790F791079117912791479157916791779187919791A791B791C791D
+791F792079217922792379257926792779287929792A792B792C792D792E792F
+793079317932793379357936793779387939793D793F79427943794479457947
+794A794B794C794D794E794F7950795179527954795579587959796179630000
+796479667969796A796B796C796E79707971797279737974797579767979797B
+797C797D797E797F798279837986798779887989798B798C798D798E79907991
+79926020803D62C54E39535590F863B880C665E66C2E4F4660EE6DE18BDE5F39
+86CB5F536321515A83616863520063638E4850125C9B79775BFC52307A3B60BC
+905376D75FB75F9776848E6C706F767B7B4977AA51F3909358244F4E6EF48FEA
+654C7B1B72C46DA47FDF5AE162B55E95573084827B2C5E1D5F1F90127F1498A0
+63826EC7789870B95178975B57AB75354F4375385E9760E659606DC06BBF7889
+53FC96D551CB52016389540A94938C038DCC7239789F87768FED8C0D53E00000
+B6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7993799479957996799779987999799B799C799D799E799F79A079A179A279A3
+79A479A579A679A879A979AA79AB79AC79AD79AE79AF79B079B179B279B479B5
+79B679B779B879BC79BF79C279C479C579C779C879CA79CC79CE79CF79D079D3
+79D479D679D779D979DA79DB79DC79DD79DE79E079E179E279E579E879EA0000
+79EC79EE79F179F279F379F479F579F679F779F979FA79FC79FE79FF7A017A04
+7A057A077A087A097A0A7A0C7A0F7A107A117A127A137A157A167A187A197A1B
+7A1C4E0176EF53EE948998769F0E952D5B9A8BA24E224E1C51AC846361C252A8
+680B4F97606B51BB6D1E515C6296659796618C46901775D890FD77636BD2728A
+72EC8BFB583577798D4C675C9540809A5EA66E2159927AEF77ED953B6BB565AD
+7F0E58065151961F5BF958A954288E726566987F56E4949D76FE9041638754C6
+591A593A579B8EB267358DFA8235524160F0581586FE5CE89E454FC4989D8BB9
+5A2560765384627C904F9102997F6069800C513F80335C1499756D314E8C0000
+B7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7A1D7A1F7A217A227A247A257A267A277A287A297A2A7A2B7A2C7A2D7A2E7A2F
+7A307A317A327A347A357A367A387A3A7A3E7A407A417A427A437A447A457A47
+7A487A497A4A7A4B7A4C7A4D7A4E7A4F7A507A527A537A547A557A567A587A59
+7A5A7A5B7A5C7A5D7A5E7A5F7A607A617A627A637A647A657A667A677A680000
+7A697A6A7A6B7A6C7A6D7A6E7A6F7A717A727A737A757A7B7A7C7A7D7A7E7A82
+7A857A877A897A8A7A8B7A8C7A8E7A8F7A907A937A947A997A9A7A9B7A9E7AA1
+7AA28D3053D17F5A7B4F4F104E4F96006CD573D085E95E06756A7FFB6A0A77FE
+94927E4151E170E653CD8FD483038D2972AF996D6CDB574A82B365B980AA623F
+963259A84EFF8BBF7EBA653E83F2975E556198DE80A5532A8BFD542080BA5E9F
+6CB88D3982AC915A54296C1B52067EB7575F711A6C7E7C89594B4EFD5FFF6124
+7CAA4E305C0167AB87025CF0950B98CE75AF70FD902251AF7F1D8BBD594951E4
+4F5B5426592B657780A45B75627662C28F905E456C1F7B264F0F4FD8670D0000
+B8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7AA37AA47AA77AA97AAA7AAB7AAE7AAF7AB07AB17AB27AB47AB57AB67AB77AB8
+7AB97ABA7ABB7ABC7ABD7ABE7AC07AC17AC27AC37AC47AC57AC67AC77AC87AC9
+7ACA7ACC7ACD7ACE7ACF7AD07AD17AD27AD37AD47AD57AD77AD87ADA7ADB7ADC
+7ADD7AE17AE27AE47AE77AE87AE97AEA7AEB7AEC7AEE7AF07AF17AF27AF30000
+7AF47AF57AF67AF77AF87AFB7AFC7AFE7B007B017B027B057B077B097B0C7B0D
+7B0E7B107B127B137B167B177B187B1A7B1C7B1D7B1F7B217B227B237B277B29
+7B2D6D6E6DAA798F88B15F17752B629A8F854FEF91DC65A7812F81515E9C8150
+8D74526F89868D4B590D50854ED8961C723681798D1F5BCC8BA3964459877F1A
+54905676560E8BE565396982949976D66E895E727518674667D17AFF809D8D76
+611F79C665628D635188521A94A27F38809B7EB25C976E2F67607BD9768B9AD8
+818F7F947CD5641E95507A3F544A54E56B4C640162089E3D80F3759952729769
+845B683C86E49601969494EC4E2A54047ED968398DDF801566F45E9A7FB90000
+B9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7B2F7B307B327B347B357B367B377B397B3B7B3D7B3F7B407B417B427B437B44
+7B467B487B4A7B4D7B4E7B537B557B577B597B5C7B5E7B5F7B617B637B647B65
+7B667B677B687B697B6A7B6B7B6C7B6D7B6F7B707B737B747B767B787B7A7B7C
+7B7D7B7F7B817B827B837B847B867B877B887B897B8A7B8B7B8C7B8E7B8F0000
+7B917B927B937B967B987B997B9A7B9B7B9E7B9F7BA07BA37BA47BA57BAE7BAF
+7BB07BB27BB37BB57BB67BB77BB97BBA7BBB7BBC7BBD7BBE7BBF7BC07BC27BC3
+7BC457C2803F68975DE5653B529F606D9F9A4F9B8EAC516C5BAB5F135DE96C5E
+62F18D21517194A952FE6C9F82DF72D757A267848D2D591F8F9C83C754957B8D
+4F306CBD5B6459D19F1353E486CA9AA88C3780A16545987E56FA96C7522E74DC
+52505BE1630289024E5662D0602A68FA51735B9851A089C27BA199867F5060EF
+704C8D2F51495E7F901B747089C4572D78455F529F9F95FA8F689B3C8BE17678
+684267DC8DEA8D35523D8F8A6EDA68CD950590ED56FD679C88F98FC754C80000
+BA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7BC57BC87BC97BCA7BCB7BCD7BCE7BCF7BD07BD27BD47BD57BD67BD77BD87BDB
+7BDC7BDE7BDF7BE07BE27BE37BE47BE77BE87BE97BEB7BEC7BED7BEF7BF07BF2
+7BF37BF47BF57BF67BF87BF97BFA7BFB7BFD7BFF7C007C017C027C037C047C05
+7C067C087C097C0A7C0D7C0E7C107C117C127C137C147C157C177C187C190000
+7C1A7C1B7C1C7C1D7C1E7C207C217C227C237C247C257C287C297C2B7C2C7C2D
+7C2E7C2F7C307C317C327C337C347C357C367C377C397C3A7C3B7C3C7C3D7C3E
+7C429AB85B696D776C264EA55BB39A87916361A890AF97E9542B6DB55BD251FD
+558A7F557FF064BC634D65F161BE608D710A6C576C49592F676D822A58D5568E
+8C6A6BEB90DD597D801753F76D695475559D837783CF683879BE548C4F555408
+76D28C8996026CB36DB88D6B89109E648D3A563F9ED175D55F8872E0606854FC
+4EA86A2A886160528F7054C470D886799E3F6D2A5B8F5F187EA255894FAF7334
+543C539A5019540E547C4E4E5FFD745A58F6846B80E1877472D07CCA6E560000
+BB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7C437C447C457C467C477C487C497C4A7C4B7C4C7C4E7C4F7C507C517C527C53
+7C547C557C567C577C587C597C5A7C5B7C5C7C5D7C5E7C5F7C607C617C627C63
+7C647C657C667C677C687C697C6A7C6B7C6C7C6D7C6E7C6F7C707C717C727C75
+7C767C777C787C797C7A7C7E7C7F7C807C817C827C837C847C857C867C870000
+7C887C8A7C8B7C8C7C8D7C8E7C8F7C907C937C947C967C997C9A7C9B7CA07CA1
+7CA37CA67CA77CA87CA97CAB7CAC7CAD7CAF7CB07CB47CB57CB67CB77CB87CBA
+7CBB5F27864E552C62A44E926CAA623782B154D7534E733E6ED1753B52125316
+8BDD69D05F8A60006DEE574F6B2273AF68538FD87F13636260A3552475EA8C62
+71156DA35BA65E7B8352614C9EC478FA87577C27768751F060F6714C66435E4C
+604D8C0E707063258F895FBD606286D456DE6BC160946167534960E066668D3F
+79FD4F1A70E96C478BB38BF27ED88364660F5A5A9B426D516DF78C416D3B4F19
+706B83B7621660D1970D8D27797851FB573E57FA673A75787A3D79EF7B950000
+BC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7CBF7CC07CC27CC37CC47CC67CC97CCB7CCE7CCF7CD07CD17CD27CD37CD47CD8
+7CDA7CDB7CDD7CDE7CE17CE27CE37CE47CE57CE67CE77CE97CEA7CEB7CEC7CED
+7CEE7CF07CF17CF27CF37CF47CF57CF67CF77CF97CFA7CFC7CFD7CFE7CFF7D00
+7D017D027D037D047D057D067D077D087D097D0B7D0C7D0D7D0E7D0F7D100000
+7D117D127D137D147D157D167D177D187D197D1A7D1B7D1C7D1D7D1E7D1F7D21
+7D237D247D257D267D287D297D2A7D2C7D2D7D2E7D307D317D327D337D347D35
+7D36808C99658FF96FC08BA59E2159EC7EE97F095409678168D88F917C4D96C6
+53CA602575BE6C7253735AC97EA7632451E0810A5DF184DF628051805B634F0E
+796D524260B86D4E5BC45BC28BA18BB065E25FCC964559937EE77EAA560967B7
+59394F735BB652A0835A988A8D3E753294BE50477A3C4EF767B69A7E5AC16B7C
+76D1575A5C167B3A95F4714E517C80A9827059787F04832768C067EC78B17877
+62E363617B804FED526A51CF835069DB92748DF58D3189C1952E7BAD4EF60000
+BD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7D377D387D397D3A7D3B7D3C7D3D7D3E7D3F7D407D417D427D437D447D457D46
+7D477D487D497D4A7D4B7D4C7D4D7D4E7D4F7D507D517D527D537D547D557D56
+7D577D587D597D5A7D5B7D5C7D5D7D5E7D5F7D607D617D627D637D647D657D66
+7D677D687D697D6A7D6B7D6C7D6D7D6F7D707D717D727D737D747D757D760000
+7D787D797D7A7D7B7D7C7D7D7D7E7D7F7D807D817D827D837D847D857D867D87
+7D887D897D8A7D8B7D8C7D8D7D8E7D8F7D907D917D927D937D947D957D967D97
+7D98506582305251996F6E106E856DA75EFA50F559DC5C066D466C5F7586848B
+686859568BB253209171964D854969127901712680F64EA490CA6D479A845A07
+56BC640594F077EB4FA5811A72E189D2997A7F347EDE527F655991758F7F8F83
+53EB7A9663ED63A5768679F888579636622A52AB8282685467706377776B7AED
+6D017ED389E359D0621285C982A5754C501F4ECB75A58BEB5C4A5DFE7B4B65A4
+91D14ECA6D25895F7D2795264EC58C288FDB9773664B79818FD170EC6D780000
+BE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7D997D9A7D9B7D9C7D9D7D9E7D9F7DA07DA17DA27DA37DA47DA57DA77DA87DA9
+7DAA7DAB7DAC7DAD7DAF7DB07DB17DB27DB37DB47DB57DB67DB77DB87DB97DBA
+7DBB7DBC7DBD7DBE7DBF7DC07DC17DC27DC37DC47DC57DC67DC77DC87DC97DCA
+7DCB7DCC7DCD7DCE7DCF7DD07DD17DD27DD37DD47DD57DD67DD77DD87DD90000
+7DDA7DDB7DDC7DDD7DDE7DDF7DE07DE17DE27DE37DE47DE57DE67DE77DE87DE9
+7DEA7DEB7DEC7DED7DEE7DEF7DF07DF17DF27DF37DF47DF57DF67DF77DF87DF9
+7DFA5C3D52B283465162830E775B66769CB84EAC60CA7CBE7CB37ECF4E958B66
+666F988897595883656C955C5F8475C997567ADF7ADE51C070AF7A9863EA7A76
+7EA0739697ED4E4570784E5D915253A9655165E781FC8205548E5C31759A97A0
+62D872D975BD5C459A7983CA5C40548077E94E3E6CAE805A62D2636E5DE85177
+8DDD8E1E952F4FF153E560E770AC526763509E435A1F5026773753777EE26485
+652B628963985014723589C951B38BC07EDD574783CC94A7519B541B5CFB0000
+BF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7DFB7DFC7DFD7DFE7DFF7E007E017E027E037E047E057E067E077E087E097E0A
+7E0B7E0C7E0D7E0E7E0F7E107E117E127E137E147E157E167E177E187E197E1A
+7E1B7E1C7E1D7E1E7E1F7E207E217E227E237E247E257E267E277E287E297E2A
+7E2B7E2C7E2D7E2E7E2F7E307E317E327E337E347E357E367E377E387E390000
+7E3A7E3C7E3D7E3E7E3F7E407E427E437E447E457E467E487E497E4A7E4B7E4C
+7E4D7E4E7E4F7E507E517E527E537E547E557E567E577E587E597E5A7E5B7E5C
+7E5D4FCA7AE36D5A90E19A8F55805496536154AF5F0063E9697751EF6168520A
+582A52D8574E780D770B5EB761777CE0625B62974EA27095800362F770E49760
+577782DB67EF68F578D5989779D158F354B353EF6E34514B523B5BA28BFE80AF
+554357A660735751542D7A7A60505B5463A762A053E362635BC767AF54ED7A9F
+82E691775E9388E4593857AE630E8DE880EF57577B774FA95FEB5BBD6B3E5321
+7B5072C2684677FF773665F751B54E8F76D45CBF7AA58475594E9B4150800000
+C0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7E5E7E5F7E607E617E627E637E647E657E667E677E687E697E6A7E6B7E6C7E6D
+7E6E7E6F7E707E717E727E737E747E757E767E777E787E797E7A7E7B7E7C7E7D
+7E7E7E7F7E807E817E837E847E857E867E877E887E897E8A7E8B7E8C7E8D7E8E
+7E8F7E907E917E927E937E947E957E967E977E987E997E9A7E9C7E9D7E9E0000
+7EAE7EB47EBB7EBC7ED67EE47EEC7EF97F0A7F107F1E7F377F397F3B7F3C7F3D
+7F3E7F3F7F407F417F437F467F477F487F497F4A7F4B7F4C7F4D7F4E7F4F7F52
+7F53998861276E8357646606634656F062EC62695ED39614578362C955878721
+814A8FA3556683B167658D5684DD5A6A680F62E67BEE961151706F9C8C3063FD
+89C861D27F0670C26EE57405699472FC5ECA90CE67176D6A635E52B372628001
+4F6C59E5916A70D96D9D52D24E5096F7956D857E78CA7D2F5121579264C2808B
+7C7B6CEA68F1695E51B7539868A872819ECE7BF172F879BB6F137406674E91CC
+9CA4793C83898354540F68174E3D538952B1783E5386522950884F8B4FD00000
+C1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7F567F597F5B7F5C7F5D7F5E7F607F637F647F657F667F677F6B7F6C7F6D7F6F
+7F707F737F757F767F777F787F7A7F7B7F7C7F7D7F7F7F807F827F837F847F85
+7F867F877F887F897F8B7F8D7F8F7F907F917F927F937F957F967F977F987F99
+7F9B7F9C7FA07FA27FA37FA57FA67FA87FA97FAA7FAB7FAC7FAD7FAE7FB10000
+7FB37FB47FB57FB67FB77FBA7FBB7FBE7FC07FC27FC37FC47FC67FC77FC87FC9
+7FCB7FCD7FCF7FD07FD17FD27FD37FD67FD77FD97FDA7FDB7FDC7FDD7FDE7FE2
+7FE375E27ACB7C926CA596B6529B748354E94FE9805483B28FDE95705EC9601C
+6D9F5E18655B813894FE604B70BC7EC37CAE51C968817CB1826F4E248F8691CF
+667E4EAE8C0564A9804A50DA759771CE5BE58FBD6F664E86648295635ED66599
+521788C270C852A3730E7433679778F797164E3490BB9CDE6DCB51DB8D41541D
+62CE73B283F196F69F8494C34F367F9A51CC707596755CAD988653E64EE46E9C
+740969B4786B998F7559521876246D4167F3516D9F99804B54997B3C7ABF0000
+C2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7FE47FE77FE87FEA7FEB7FEC7FED7FEF7FF27FF47FF57FF67FF77FF87FF97FFA
+7FFD7FFE7FFF8002800780088009800A800E800F80118013801A801B801D801E
+801F802180238024802B802C802D802E802F8030803280348039803A803C803E
+8040804180448045804780488049804E804F8050805180538055805680570000
+8059805B805C805D805E805F806080618062806380648065806680678068806B
+806C806D806E806F807080728073807480758076807780788079807A807B807C
+807D9686578462E29647697C5A0464027BD36F0F964B82A6536298855E907089
+63B35364864F9C819E93788C97328DEF8D429E7F6F5E79845F559646622E9A74
+541594DD4FA365C55C655C617F1586516C2F5F8B73876EE47EFF5CE6631B5B6A
+6EE653754E7163A0756562A18F6E4F264ED16CA67EB68BBA841D87BA7F57903B
+95237BA99AA188F8843D6D1B9A867EDC59889EBB739B780186829A6C9A82561B
+541757CB4E709EA653568FC881097792999286EE6EE1851366FC61626F2B0000
+C3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+807E8081808280858088808A808D808E808F8090809180928094809580978099
+809E80A380A680A780A880AC80B080B380B580B680B880B980BB80C580C780C8
+80C980CA80CB80CF80D080D180D280D380D480D580D880DF80E080E280E380E6
+80EE80F580F780F980FB80FE80FF8100810181038104810581078108810B0000
+810C811581178119811B811C811D811F81208121812281238124812581268127
+81288129812A812B812D812E813081338134813581378139813A813B813C813D
+813F8C298292832B76F26C135FD983BD732B8305951A6BDB77DB94C6536F8302
+51925E3D8C8C8D384E4873AB679A68859176970971646CA177095A9295416BCF
+7F8E66275BD059B95A9A95E895F74EEC840C84996AAC76DF9530731B68A65B5F
+772F919A97617CDC8FF78C1C5F257C7379D889C56CCC871C5BC65E4268C97720
+7EF55195514D52C95A297F05976282D763CF778485D079D26E3A5E9959998511
+706D6C1162BF76BF654F60AF95FD660E879F9E2394ED540D547D8C2C64780000
+C4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+81408141814281438144814581478149814D814E814F8152815681578158815B
+815C815D815E815F816181628163816481668168816A816B816C816F81728173
+81758176817781788181818381848185818681878189818B818C818D818E8190
+8192819381948195819681978199819A819E819F81A081A181A281A481A50000
+81A781A981AB81AC81AD81AE81AF81B081B181B281B481B581B681B781B881B9
+81BC81BD81BE81BF81C481C581C781C881C981CB81CD81CE81CF81D081D181D2
+81D3647986116A21819C78E864699B5462B9672B83AB58A89ED86CAB6F205BDE
+964C8C0B725F67D062C772614EA959C66BCD589366AE5E5552DF6155672876EE
+776672677A4662FF54EA545094A090A35A1C7EB36C164E435976801059485357
+753796BE56CA63208111607C95F96DD65462998151855AE980FD59AE9713502A
+6CE55C3C62DF4F60533F817B90066EBA852B62C85E7478BE64B5637B5FF55A18
+917F9E1F5C3F634F80425B7D556E954A954D6D8560A867E072DE51DD5B810000
+C5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+81D481D581D681D781D881D981DA81DB81DC81DD81DE81DF81E081E181E281E4
+81E581E681E881E981EB81EE81EF81F081F181F281F581F681F781F881F981FA
+81FD81FF8203820782088209820A820B820E820F821182138215821682178218
+8219821A821D822082248225822682278229822E8232823A823C823D823F0000
+8240824182428243824582468248824A824C824D824E82508251825282538254
+8255825682578259825B825C825D825E82608261826282638264826582668267
+826962E76CDE725B626D94AE7EBD81136D53519C5F04597452AA601259736696
+8650759F632A61E67CEF8BFA54E66B279E256BB485D5545550766CA4556A8DB4
+722C5E156015743662CD6392724C5F986E436D3E65006F5876D878D076FC7554
+522453DB4E535E9E65C1802A80D6629B5486522870AE888D8DD16CE1547880DA
+57F988F48D54966A914D4F696C9B55B776C6783062A870F96F8E5F6D84EC68DA
+787C7BF781A8670B9E4F636778B0576F78129739627962AB528874356BD70000
+C6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+826A826B826C826D82718275827682778278827B827C82808281828382858286
+82878289828C82908293829482958296829A829B829E82A082A282A382A782B2
+82B582B682BA82BB82BC82BF82C082C282C382C582C682C982D082D682D982DA
+82DD82E282E782E882E982EA82EC82ED82EE82F082F282F382F582F682F80000
+82FA82FC82FD82FE82FF8300830A830B830D831083128313831683188319831D
+831E831F83208321832283238324832583268329832A832E833083328337833B
+833D5564813E75B276AE533975DE50FB5C418B6C7BC7504F72479A9798D86F02
+74E27968648777A562FC98918D2B54C180584E52576A82F9840D5E7351ED74F6
+8BC45C4F57616CFC98875A4678349B448FEB7C955256625194FA4EC683868461
+83E984B257D467345703666E6D668C3166DD7011671F6B3A6816621A59BB4E03
+51C46F0667D26C8F517668CB59476B6775665D0E81109F5065D7794879419A91
+8D775C824E5E4F01542F5951780C56686C148FC45F036C7D6CE38BAB63900000
+C7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+833E833F83418342834483458348834A834B834C834D834E8353835583568357
+83588359835D836283708371837283738374837583768379837A837E837F8380
+838183828383838483878388838A838B838C838D838F83908391839483958396
+83978399839A839D839F83A183A283A383A483A583A683A783AC83AD83AE0000
+83AF83B583BB83BE83BF83C283C383C483C683C883C983CB83CD83CE83D083D1
+83D283D383D583D783D983DA83DB83DE83E283E383E483E683E783E883EB83EC
+83ED60706D3D72756266948E94C553438FC17B7E4EDF8C264E7E9ED494B194B3
+524D6F5C90636D458C3458115D4C6B206B4967AA545B81547F8C589985375F3A
+62A26A47953965726084686577A74E544FA85DE7979864AC7FD85CED4FCF7A8D
+520783044E14602F7A8394A64FB54EB279E6743452E482B964D279BD5BDD6C81
+97528F7B6C22503E537F6E0564CE66746C3060C598778BF75E86743C7A7779CB
+4E1890B174036C4256DA914B6CC58D8B533A86C666F28EAF5C489A716E200000
+C8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+83EE83EF83F383F483F583F683F783FA83FB83FC83FE83FF8400840284058407
+84088409840A84108412841384148415841684178419841A841B841E841F8420
+8421842284238429842A842B842C842D842E842F843084328433843484358436
+84378439843A843B843E843F8440844184428443844484458447844884490000
+844A844B844C844D844E844F8450845284538454845584568458845D845E845F
+8460846284648465846684678468846A846E846F84708472847484778479847B
+847C53D65A369F8B8DA353BB570898A76743919B6CC9516875CA62F372AC5238
+529D7F3A7094763853749E4A69B7786E96C088D97FA4713671C3518967D374E4
+58E4651856B78BA9997662707ED560F970ED58EC4EC14EBA5FCD97E74EFB8BA4
+5203598A7EAB62544ECD65E5620E833884C98363878D71946EB65BB97ED25197
+63C967D480898339881551125B7A59828FB14E736C5D516589258F6F962E854A
+745E951095F06DA682E55F3164926D128428816E9CC3585E8D5B4E0953C10000
+C9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+847D847E847F848084818483848484858486848A848D848F8490849184928493
+8494849584968498849A849B849D849E849F84A084A284A384A484A584A684A7
+84A884A984AA84AB84AC84AD84AE84B084B184B384B584B684B784BB84BC84BE
+84C084C284C384C584C684C784C884CB84CC84CE84CF84D284D484D584D70000
+84D884D984DA84DB84DC84DE84E184E284E484E784E884E984EA84EB84ED84EE
+84EF84F184F284F384F484F584F684F784F884F984FA84FB84FD84FE85008501
+85024F1E6563685155D34E2764149A9A626B5AC2745F82726DA968EE50E7838E
+7802674052396C997EB150BB5565715E7B5B665273CA82EB67495C715220717D
+886B95EA965564C58D6181B355846C5562477F2E58924F2455468D4F664C4E0A
+5C1A88F368A2634E7A0D70E7828D52FA97F65C1154E890B57ECD59628D4A86C7
+820C820D8D6664445C0461516D89793E8BBE78377533547B4F388EAB6DF15A20
+7EC5795E6C885BA15A76751A80BE614E6E1758F0751F7525727253477EF30000
+CA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8503850485058506850785088509850A850B850D850E850F8510851285148515
+851685188519851B851C851D851E852085228523852485258526852785288529
+852A852D852E852F8530853185328533853485358536853E853F854085418542
+8544854585468547854B854C854D854E854F8550855185528553855485550000
+85578558855A855B855C855D855F85608561856285638565856685678569856A
+856B856C856D856E856F8570857185738575857685778578857C857D857F8580
+8581770176DB526980DC57235E08593172EE65BD6E7F8BD75C388671534177F3
+62FE65F64EC098DF86805B9E8BC653F277E24F7F5C4E9A7659CB5F0F793A58EB
+4E1667FF4E8B62ED8A93901D52BF662F55DC566C90024ED54F8D91CA99706C0F
+5E0260435BA489C68BD56536624B99965B885BFF6388552E53D77626517D852C
+67A268B36B8A62928F9353D482126DD1758F4E668D4E5B70719F85AF669166D9
+7F7287009ECD9F205C5E672F8FF06811675F620D7AD658855EB665706F310000
+CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+85828583858685888589858A858B858C858D858E859085918592859385948595
+8596859785988599859A859D859E859F85A085A185A285A385A585A685A785A9
+85AB85AC85AD85B185B285B385B485B585B685B885BA85BB85BC85BD85BE85BF
+85C085C285C385C485C585C685C785C885CA85CB85CC85CD85CE85D185D20000
+85D485D685D785D885D985DA85DB85DD85DE85DF85E085E185E285E385E585E6
+85E785E885EA85EB85EC85ED85EE85EF85F085F185F285F385F485F585F685F7
+85F860555237800D6454887075295E05681362F4971C53CC723D8C016C347761
+7A0E542E77AC987A821C8BF47855671470C165AF64955636601D79C153F84E1D
+6B7B80865BFA55E356DB4F3A4F3C99725DF3677E80386002988290015B8B8BBC
+8BF5641C825864DE55FD82CF91654FD77D20901F7C9F50F358516EAF5BBF8BC9
+80839178849C7B97867D968B968F7EE59AD3788E5C817A57904296A7795F5B59
+635F7B0B84D168AD55067F2974107D2295016240584C4ED65B83597958540000
+CC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+85F985FA85FC85FD85FE860086018602860386048606860786088609860A860B
+860C860D860E860F86108612861386148615861786188619861A861B861C861D
+861E861F86208621862286238624862586268628862A862B862C862D862E862F
+863086318632863386348635863686378639863A863B863D863E863F86400000
+864186428643864486458646864786488649864A864B864C8652865386558656
+865786588659865B865C865D865F866086618663866486658666866786688669
+866A736D631E8E4B8E0F80CE82D462AC53F06CF0915E592A60016C70574D644A
+8D2A762B6EE9575B6A8075F06F6D8C2D8C0857666BEF889278B363A253F970AD
+6C645858642A580268E0819B55107CD650188EBA6DCC8D9F70EB638F6D9B6ED4
+7EE68404684390036DD896768BA85957727985E4817E75BC8A8A68AF52548E22
+951163D098988E44557C4F5366FF568F60D56D9552435C4959296DFB586B7530
+751C606C82148146631167618FE2773A8DF38D3494C15E165385542C70C30000
+CD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+866D866F86708672867386748675867686778678868386848685868686878688
+8689868E868F86908691869286948696869786988699869A869B869E869F86A0
+86A186A286A586A686AB86AD86AE86B286B386B786B886B986BB86BC86BD86BE
+86BF86C186C286C386C586C886CC86CD86D286D386D586D686D786DA86DC0000
+86DD86E086E186E286E386E586E686E786E886EA86EB86EC86EF86F586F686F7
+86FA86FB86FC86FD86FF8701870487058706870B870C870E870F871087118714
+87166C405EF7505C4EAD5EAD633A8247901A6850916E77B3540C94DC5F647AE5
+687663457B527EDF75DB507762955934900F51F879C37A8156FE5F9290146D82
+5C60571F541051546E4D56E263A89893817F8715892A9000541E5C6F81C062D6
+625881319E3596409A6E9A7C692D59A562D3553E631654C786D96D3C5A0374E6
+889C6B6A59168C4C5F2F6E7E73A9987D4E3870F75B8C7897633D665A769660CB
+5B9B5A494E0781556C6A738B4EA167897F515F8065FA671B5FD859845A010000
+CE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8719871B871D871F87208724872687278728872A872B872C872D872F87308732
+87338735873687388739873A873C873D8740874187428743874487458746874A
+874B874D874F8750875187528754875587568758875A875B875C875D875E875F
+876187628766876787688769876A876B876C876D876F87718772877387750000
+877787788779877A877F878087818784878687878789878A878C878E878F8790
+8791879287948795879687988799879A879B879C879D879E87A087A187A287A3
+87A45DCD5FAE537197E68FDD684556F4552F60DF4E3A6F4D7EF482C7840E59D4
+4F1F4F2A5C3E7EAC672A851A5473754F80C355829B4F4F4D6E2D8C135C096170
+536B761F6E29868A658795FB7EB9543B7A337D0A95EE55E17FC174EE631D8717
+6DA17A9D621165A1536763E16C835DEB545C94A84E4C6C618BEC5C4B65E0829C
+68A7543E54346BCB6B664E9463425348821E4F0D4FAE575E620A96FE66647269
+52FF52A1609F8BEF661471996790897F785277FD6670563B54389521727A0000
+CF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+87A587A687A787A987AA87AE87B087B187B287B487B687B787B887B987BB87BC
+87BE87BF87C187C287C387C487C587C787C887C987CC87CD87CE87CF87D087D4
+87D587D687D787D887D987DA87DC87DD87DE87DF87E187E287E387E487E687E7
+87E887E987EB87EC87ED87EF87F087F187F287F387F487F587F687F787F80000
+87FA87FB87FC87FD87FF880088018802880488058806880788088809880B880C
+880D880E880F8810881188128814881788188819881A881C881D881E881F8820
+88237A00606F5E0C6089819D591560DC718470EF6EAA6C5072806A8488AD5E2D
+4E605AB3559C94E36D177CFB9699620F7EC6778E867E5323971E8F9666875CE1
+4FA072ED4E0B53A6590F54136380952851484ED99C9C7EA454B88D2488548237
+95F26D8E5F265ACC663E966973B0732E53BF817A99857FA15BAA967796507EBF
+76F853A2957699997BB189446E584E617FD479658BE660F354CD4EAB98795DF7
+6A6150CF54118C618427785D9704524A54EE56A395006D885BB56DC666530000
+D0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+882488258826882788288829882A882B882C882D882E882F8830883188338834
+8835883688378838883A883B883D883E883F8841884288438846884788488849
+884A884B884E884F8850885188528853885588568858885A885B885C885D885E
+885F886088668867886A886D886F8871887388748875887688788879887A0000
+887B887C88808883888688878889888A888C888E888F88908891889388948895
+889788988899889A889B889D889E889F88A088A188A388A588A688A788A888A9
+88AA5C0F5B5D6821809655787B11654869544E9B6B47874E978B534F631F643A
+90AA659C80C18C10519968B0537887F961C86CC46CFB8C225C5185AA82AF950C
+6B238F9B65B05FFB5FC34FE18845661F8165732960FA51745211578B5F6290A2
+884C91925E78674F602759D3514451F680F853086C7996C4718A4F114FEE7F9E
+673D55C5950879C088967EE3589F620C9700865A5618987B5F908BB884C49157
+53D965ED5E8F755C60647D6E5A7F7EEA7EED8F6955A75BA360AC65CB73840000
+D1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+88AC88AE88AF88B088B288B388B488B588B688B888B988BA88BB88BD88BE88BF
+88C088C388C488C788C888CA88CB88CC88CD88CF88D088D188D388D688D788DA
+88DB88DC88DD88DE88E088E188E688E788E988EA88EB88EC88ED88EE88EF88F2
+88F588F688F788FA88FB88FD88FF890089018903890489058906890789080000
+8909890B890C890D890E890F891189148915891689178918891C891D891E891F
+89208922892389248926892789288929892C892D892E892F8931893289338935
+89379009766377297EDA9774859B5B667A7496EA884052CB718F5FAA65EC8BE2
+5BFB9A6F5DE16B896C5B8BAD8BAF900A8FC5538B62BC9E269E2D54404E2B82BD
+7259869C5D1688596DAF96C554D14E9A8BB6710954BD960970DF6DF976D04E25
+781487125CA95EF68A00989C960E708E6CBF594463A9773C884D6F1482735830
+71D5538C781A96C155015F6671305BB48C1A9A8C6B83592E9E2F79E76768626C
+4F6F75A17F8A6D0B96336C274EF075D2517B68376F3E90808170599674760000
+D2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+89388939893A893B893C893D893E893F89408942894389458946894789488949
+894A894B894C894D894E894F8950895189528953895489558956895789588959
+895A895B895C895D896089618962896389648965896789688969896A896B896C
+896D896E896F8970897189728973897489758976897789788979897A897C0000
+897D897E8980898289848985898789888989898A898B898C898D898E898F8990
+899189928993899489958996899789988999899A899B899C899D899E899F89A0
+89A164475C2790657A918C2359DA54AC8200836F898180006930564E80367237
+91CE51B64E5F987563964E1A53F666F3814B591C6DB24E0058F9533B63D694F1
+4F9D4F0A886398905937905779FB4EEA80F075916C825B9C59E85F5D69058681
+501A5DF24E5977E34EE5827A6291661390915C794EBF5F7981C69038808475AB
+4EA688D4610F6BC55FC64E4976CA6EA28BE38BAE8C0A8BD15F027FFC7FCC7ECE
+8335836B56E06BB797F3963459FB541F94F66DEB5BC5996E5C395F1596900000
+D3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+89A289A389A489A589A689A789A889A989AA89AB89AC89AD89AE89AF89B089B1
+89B289B389B489B589B689B789B889B989BA89BB89BC89BD89BE89BF89C089C3
+89CD89D389D489D589D789D889D989DB89DD89DF89E089E189E289E489E789E8
+89E989EA89EC89ED89EE89F089F189F289F489F589F689F789F889F989FA0000
+89FB89FC89FD89FE89FF8A018A028A038A048A058A068A088A098A0A8A0B8A0C
+8A0D8A0E8A0F8A108A118A128A138A148A158A168A178A188A198A1A8A1B8A1C
+8A1D537082F16A315A749E705E947F2883B984248425836787478FCE8D6276C8
+5F719896786C662054DF62E54F6381C375C85EB896CD8E0A86F9548F6CF36D8C
+6C38607F52C775285E7D4F1860A05FE75C24753190AE94C072B96CB96E389149
+670953CB53F34F5191C98BF153C85E7C8FC26DE44E8E76C26986865E611A8206
+4F594FDE903E9C7C61096E1D6E1496854E885A3196E84E0E5C7F79B95B878BED
+7FBD738957DF828B90C15401904755BB5CEA5FA161086B3272F180B28A890000
+D4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8A1E8A1F8A208A218A228A238A248A258A268A278A288A298A2A8A2B8A2C8A2D
+8A2E8A2F8A308A318A328A338A348A358A368A378A388A398A3A8A3B8A3C8A3D
+8A3F8A408A418A428A438A448A458A468A478A498A4A8A4B8A4C8A4D8A4E8A4F
+8A508A518A528A538A548A558A568A578A588A598A5A8A5B8A5C8A5D8A5E0000
+8A5F8A608A618A628A638A648A658A668A678A688A698A6A8A6B8A6C8A6D8A6E
+8A6F8A708A718A728A738A748A758A768A778A788A7A8A7B8A7C8A7D8A7E8A7F
+8A806D745BD388D598848C6B9A6D9E336E0A51A4514357A38881539F63F48F95
+56ED54585706733F6E907F188FDC82D1613F6028966266F07EA68D8A8DC394A5
+5CB37CA4670860A6960580184E9190E75300966851418FD08574915D665597F5
+5B55531D78386742683D54C9707E5BB08F7D518D572854B1651266828D5E8D43
+810F846C906D7CDF51FF85FB67A365E96FA186A48E81566A90207682707671E5
+8D2362E952196CFD8D3C600E589E618E66FE8D60624E55B36E23672D8F670000
+D5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8A818A828A838A848A858A868A878A888A8B8A8C8A8D8A8E8A8F8A908A918A92
+8A948A958A968A978A988A998A9A8A9B8A9C8A9D8A9E8A9F8AA08AA18AA28AA3
+8AA48AA58AA68AA78AA88AA98AAA8AAB8AAC8AAD8AAE8AAF8AB08AB18AB28AB3
+8AB48AB58AB68AB78AB88AB98ABA8ABB8ABC8ABD8ABE8ABF8AC08AC18AC20000
+8AC38AC48AC58AC68AC78AC88AC98ACA8ACB8ACC8ACD8ACE8ACF8AD08AD18AD2
+8AD38AD48AD58AD68AD78AD88AD98ADA8ADB8ADC8ADD8ADE8ADF8AE08AE18AE2
+8AE394E195F87728680569A8548B4E4D70B88BC86458658B5B857A84503A5BE8
+77BB6BE18A797C986CBE76CF65A98F975D2D5C5586386808536062187AD96E5B
+7EFD6A1F7AE05F706F335F20638C6DA867564E085E108D264ED780C07634969C
+62DB662D627E6CBC8D7571677F695146808753EC906E629854F286F08F998005
+951785178FD96D5973CD659F771F7504782781FB8D1E94884FA6679575B98BCA
+9707632F9547963584B8632377415F8172F04E896014657462EF6B63653F0000
+D6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8AE48AE58AE68AE78AE88AE98AEA8AEB8AEC8AED8AEE8AEF8AF08AF18AF28AF3
+8AF48AF58AF68AF78AF88AF98AFA8AFB8AFC8AFD8AFE8AFF8B008B018B028B03
+8B048B058B068B088B098B0A8B0B8B0C8B0D8B0E8B0F8B108B118B128B138B14
+8B158B168B178B188B198B1A8B1B8B1C8B1D8B1E8B1F8B208B218B228B230000
+8B248B258B278B288B298B2A8B2B8B2C8B2D8B2E8B2F8B308B318B328B338B34
+8B358B368B378B388B398B3A8B3B8B3C8B3D8B3E8B3F8B408B418B428B438B44
+8B455E2775C790D18BC1829D679D652F5431871877E580A281026C414E4B7EC7
+804C76F4690D6B966267503C4F84574063076B628DBE53EA65E87EB85FD7631A
+63B781F381F47F6E5E1C5CD95236667A79E97A1A8D28709975D46EDE6CBB7A92
+4E2D76C55FE0949F88777EC879CD80BF91CD4EF24F17821F54685DDE6D328BCC
+7CA58F7480985E1A549276B15B99663C9AA473E0682A86DB6731732A8BF88BDB
+90107AF970DB716E62C477A956314E3B845767F152A986C08D2E94F87B510000
+D7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B468B478B488B498B4A8B4B8B4C8B4D8B4E8B4F8B508B518B528B538B548B55
+8B568B578B588B598B5A8B5B8B5C8B5D8B5E8B5F8B608B618B628B638B648B65
+8B678B688B698B6A8B6B8B6D8B6E8B6F8B708B718B728B738B748B758B768B77
+8B788B798B7A8B7B8B7C8B7D8B7E8B7F8B808B818B828B838B848B858B860000
+8B878B888B898B8A8B8B8B8C8B8D8B8E8B8F8B908B918B928B938B948B958B96
+8B978B988B998B9A8B9B8B9C8B9D8B9E8B9F8BAC8BB18BBB8BC78BD08BEA8C09
+8C1E4F4F6CE8795D9A7B6293722A62FD4E1378168F6C64B08D5A7BC668695E84
+88C55986649E58EE72B6690E95258FFD8D5857607F008C0651C6634962D95353
+684C74228301914C55447740707C6D4A517954A88D4459FF6ECB6DC45B5C7D2B
+4ED47C7D6ED35B5081EA6E0D5B579B0368D58E2A5B977EFC603B7EB590B98D70
+594F63CD79DF8DB3535265CF79568BC5963B7EC494BB7E825634918967007F6A
+5C0A907566285DE64F5067DE505A4F5C57505EA7000000000000000000000000
+D8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8C388C398C3A8C3B8C3C8C3D8C3E8C3F8C408C428C438C448C458C488C4A8C4B
+8C4D8C4E8C4F8C508C518C528C538C548C568C578C588C598C5B8C5C8C5D8C5E
+8C5F8C608C638C648C658C668C678C688C698C6C8C6D8C6E8C6F8C708C718C72
+8C748C758C768C778C7B8C7C8C7D8C7E8C7F8C808C818C838C848C868C870000
+8C888C8B8C8D8C8E8C8F8C908C918C928C938C958C968C978C998C9A8C9B8C9C
+8C9D8C9E8C9F8CA08CA18CA28CA38CA48CA58CA68CA78CA88CA98CAA8CAB8CAC
+8CAD4E8D4E0C51404E105EFF53454E154E984E1E9B325B6C56694E2879BA4E3F
+53154E47592D723B536E6C1056DF80E499976BD3777E9F174E364E9F9F104E5C
+4E694E9382885B5B556C560F4EC4538D539D53A353A553AE97658D5D531A53F5
+5326532E533E8D5C5366536352025208520E522D5233523F5240524C525E5261
+525C84AF527D528252815290529351827F544EBB4EC34EC94EC24EE84EE14EEB
+4EDE4F1B4EF34F224F644EF54F254F274F094F2B4F5E4F6765384F5A4F5D0000
+D9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8CAE8CAF8CB08CB18CB28CB38CB48CB58CB68CB78CB88CB98CBA8CBB8CBC8CBD
+8CBE8CBF8CC08CC18CC28CC38CC48CC58CC68CC78CC88CC98CCA8CCB8CCC8CCD
+8CCE8CCF8CD08CD18CD28CD38CD48CD58CD68CD78CD88CD98CDA8CDB8CDC8CDD
+8CDE8CDF8CE08CE18CE28CE38CE48CE58CE68CE78CE88CE98CEA8CEB8CEC0000
+8CED8CEE8CEF8CF08CF18CF28CF38CF48CF58CF68CF78CF88CF98CFA8CFB8CFC
+8CFD8CFE8CFF8D008D018D028D038D048D058D068D078D088D098D0A8D0B8D0C
+8D0D4F5F4F574F324F3D4F764F744F914F894F834F8F4F7E4F7B4FAA4F7C4FAC
+4F944FE64FE84FEA4FC54FDA4FE34FDC4FD14FDF4FF85029504C4FF3502C500F
+502E502D4FFE501C500C50255028507E504350555048504E506C507B50A550A7
+50A950BA50D6510650ED50EC50E650EE5107510B4EDD6C3D4F584F654FCE9FA0
+6C467C74516E5DFD9EC999985181591452F9530D8A07531051EB591951554EA0
+51564EB3886E88A44EB5811488D279805B3488037FB851AB51B151BD51BC0000
+DA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8D0E8D0F8D108D118D128D138D148D158D168D178D188D198D1A8D1B8D1C8D20
+8D518D528D578D5F8D658D688D698D6A8D6C8D6E8D6F8D718D728D788D798D7A
+8D7B8D7C8D7D8D7E8D7F8D808D828D838D868D878D888D898D8C8D8D8D8E8D8F
+8D908D928D938D958D968D978D988D998D9A8D9B8D9C8D9D8D9E8DA08DA10000
+8DA28DA48DA58DA68DA78DA88DA98DAA8DAB8DAC8DAD8DAE8DAF8DB08DB28DB6
+8DB78DB98DBB8DBD8DC08DC18DC28DC58DC78DC88DC98DCA8DCD8DD08DD28DD3
+8DD451C7519651A251A58BA08BA68BA78BAA8BB48BB58BB78BC28BC38BCB8BCF
+8BCE8BD28BD38BD48BD68BD88BD98BDC8BDF8BE08BE48BE88BE98BEE8BF08BF3
+8BF68BF98BFC8BFF8C008C028C048C078C0C8C0F8C118C128C148C158C168C19
+8C1B8C188C1D8C1F8C208C218C258C278C2A8C2B8C2E8C2F8C328C338C358C36
+5369537A961D962296219631962A963D963C964296499654965F9667966C9672
+96749688968D969796B09097909B909D909990AC90A190B490B390B690BA0000
+DB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8DD58DD88DD98DDC8DE08DE18DE28DE58DE68DE78DE98DED8DEE8DF08DF18DF2
+8DF48DF68DFC8DFE8DFF8E008E018E028E038E048E068E078E088E0B8E0D8E0E
+8E108E118E128E138E158E168E178E188E198E1A8E1B8E1C8E208E218E248E25
+8E268E278E288E2B8E2D8E308E328E338E348E368E378E388E3B8E3C8E3E0000
+8E3F8E438E458E468E4C8E4D8E4E8E4F8E508E538E548E558E568E578E588E5A
+8E5B8E5C8E5D8E5E8E5F8E608E618E628E638E648E658E678E688E6A8E6B8E6E
+8E7190B890B090CF90C590BE90D090C490C790D390E690E290DC90D790DB90EB
+90EF90FE91049122911E91239131912F913991439146520D594252A252AC52AD
+52BE54FF52D052D652F053DF71EE77CD5EF451F551FC9B2F53B65F01755A5DEF
+574C57A957A1587E58BC58C558D15729572C572A57335739572E572F575C573B
+574257695785576B5786577C577B5768576D5776577357AD57A4578C57B257CF
+57A757B4579357A057D557D857DA57D957D257B857F457EF57F857E457DD0000
+DC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E738E758E778E788E798E7A8E7B8E7D8E7E8E808E828E838E848E868E888E89
+8E8A8E8B8E8C8E8D8E8E8E918E928E938E958E968E978E988E998E9A8E9B8E9D
+8E9F8EA08EA18EA28EA38EA48EA58EA68EA78EA88EA98EAA8EAD8EAE8EB08EB1
+8EB38EB48EB58EB68EB78EB88EB98EBB8EBC8EBD8EBE8EBF8EC08EC18EC20000
+8EC38EC48EC58EC68EC78EC88EC98ECA8ECB8ECC8ECD8ECF8ED08ED18ED28ED3
+8ED48ED58ED68ED78ED88ED98EDA8EDB8EDC8EDD8EDE8EDF8EE08EE18EE28EE3
+8EE4580B580D57FD57ED5800581E5819584458205865586C58815889589A5880
+99A89F1961FF8279827D827F828F828A82A88284828E82918297829982AB82B8
+82BE82B082C882CA82E3829882B782AE82CB82CC82C182A982B482A182AA829F
+82C482CE82A482E1830982F782E4830F830782DC82F482D282D8830C82FB82D3
+8311831A83068314831582E082D5831C8351835B835C83088392833C83348331
+839B835E832F834F83478343835F834083178360832D833A8333836683650000
+DD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8EE58EE68EE78EE88EE98EEA8EEB8EEC8EED8EEE8EEF8EF08EF18EF28EF38EF4
+8EF58EF68EF78EF88EF98EFA8EFB8EFC8EFD8EFE8EFF8F008F018F028F038F04
+8F058F068F078F088F098F0A8F0B8F0C8F0D8F0E8F0F8F108F118F128F138F14
+8F158F168F178F188F198F1A8F1B8F1C8F1D8F1E8F1F8F208F218F228F230000
+8F248F258F268F278F288F298F2A8F2B8F2C8F2D8F2E8F2F8F308F318F328F33
+8F348F358F368F378F388F398F3A8F3B8F3C8F3D8F3E8F3F8F408F418F428F43
+8F448368831B8369836C836A836D836E83B0837883B383B483A083AA8393839C
+8385837C83B683A9837D83B8837B8398839E83A883BA83BC83C1840183E583D8
+58078418840B83DD83FD83D6841C84388411840683D483DF840F840383F883F9
+83EA83C583C0842683F083E1845C8451845A8459847384878488847A84898478
+843C844684698476848C848E8431846D84C184CD84D084E684BD84D384CA84BF
+84BA84E084A184B984B4849784E584E3850C750D853884F08539851F853A0000
+DE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8F458F468F478F488F498F4A8F4B8F4C8F4D8F4E8F4F8F508F518F528F538F54
+8F558F568F578F588F598F5A8F5B8F5C8F5D8F5E8F5F8F608F618F628F638F64
+8F658F6A8F808F8C8F928F9D8FA08FA18FA28FA48FA58FA68FA78FAA8FAC8FAD
+8FAE8FAF8FB28FB38FB48FB58FB78FB88FBA8FBB8FBC8FBF8FC08FC38FC60000
+8FC98FCA8FCB8FCC8FCD8FCF8FD28FD68FD78FDA8FE08FE18FE38FE78FEC8FEF
+8FF18FF28FF48FF58FF68FFA8FFB8FFC8FFE8FFF90079008900C900E90139015
+90188556853B84FF84FC8559854885688564855E857A77A285438572857B85A4
+85A88587858F857985AE859C858585B985B785B085D385C185DC85FF86278605
+86298616863C5EFE5F08593C594180375955595A5958530F5C225C255C2C5C34
+624C626A629F62BB62CA62DA62D762EE632262F66339634B634363AD63F66371
+637A638E63B4636D63AC638A636963AE63BC63F263F863E063FF63C463DE63CE
+645263C663BE64456441640B641B6420640C64266421645E6484646D64960000
+DF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9019901C902390249025902790289029902A902B902C90309031903290339034
+90379039903A903D903F904090439045904690489049904A904B904C904E9054
+905590569059905A905C905D905E905F906090619064906690679069906A906B
+906C906F90709071907290739076907790789079907A907B907C907E90810000
+90849085908690879089908A908C908D908E908F90909092909490969098909A
+909C909E909F90A090A490A590A790A890A990AB90AD90B290B790BC90BD90BF
+90C0647A64B764B8649964BA64C064D064D764E464E265096525652E5F0B5FD2
+75195F11535F53F153FD53E953E853FB541254165406544B5452545354545456
+54435421545754595423543254825494547754715464549A549B548454765466
+549D54D054AD54C254B454D254A754A654D354D4547254A354D554BB54BF54CC
+54D954DA54DC54A954AA54A454DD54CF54DE551B54E7552054FD551454F35522
+5523550F55115527552A5567558F55B55549556D55415555553F5550553C0000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+90C290C390C690C890C990CB90CC90CD90D290D490D590D690D890D990DA90DE
+90DF90E090E390E490E590E990EA90EC90EE90F090F190F290F390F590F690F7
+90F990FA90FB90FC90FF91009101910391059106910791089109910A910B910C
+910D910E910F911091119112911391149115911691179118911A911B911C0000
+911D911F91209121912491259126912791289129912A912B912C912D912E9130
+9132913391349135913691379138913A913B913C913D913E913F914091419142
+91445537555655755576557755335530555C558B55D2558355B155B955885581
+559F557E55D65591557B55DF55BD55BE5594559955EA55F755C9561F55D155EB
+55EC55D455E655DD55C455EF55E555F255F355CC55CD55E855F555E48F94561E
+5608560C56015624562355FE56005627562D565856395657562C564D56625659
+565C564C5654568656645671566B567B567C5685569356AF56D456D756DD56E1
+56F556EB56F956FF5704570A5709571C5E0F5E195E145E115E315E3B5E3C0000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9145914791489151915391549155915691589159915B915C915F916091669167
+9168916B916D9173917A917B917C9180918191829183918491869188918A918E
+918F9193919491959196919791989199919C919D919E919F91A091A191A491A5
+91A691A791A891A991AB91AC91B091B191B291B391B691B791B891B991BB0000
+91BC91BD91BE91BF91C091C191C291C391C491C591C691C891CB91D091D291D3
+91D491D591D691D791D891D991DA91DB91DD91DE91DF91E091E191E291E391E4
+91E55E375E445E545E5B5E5E5E615C8C5C7A5C8D5C905C965C885C985C995C91
+5C9A5C9C5CB55CA25CBD5CAC5CAB5CB15CA35CC15CB75CC45CD25CE45CCB5CE5
+5D025D035D275D265D2E5D245D1E5D065D1B5D585D3E5D345D3D5D6C5D5B5D6F
+5D5D5D6B5D4B5D4A5D695D745D825D995D9D8C735DB75DC55F735F775F825F87
+5F895F8C5F955F995F9C5FA85FAD5FB55FBC88625F6172AD72B072B472B772B8
+72C372C172CE72CD72D272E872EF72E972F272F472F7730172F3730372FA0000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+91E691E791E891E991EA91EB91EC91ED91EE91EF91F091F191F291F391F491F5
+91F691F791F891F991FA91FB91FC91FD91FE91FF920092019202920392049205
+9206920792089209920A920B920C920D920E920F921092119212921392149215
+9216921792189219921A921B921C921D921E921F922092219222922392240000
+92259226922792289229922A922B922C922D922E922F92309231923292339234
+92359236923792389239923A923B923C923D923E923F92409241924292439244
+924572FB731773137321730A731E731D7315732273397325732C733873317350
+734D73577360736C736F737E821B592598E7592459029963996799689969996A
+996B996C99749977997D998099849987998A998D999099919993999499955E80
+5E915E8B5E965EA55EA05EB95EB55EBE5EB38D535ED25ED15EDB5EE85EEA81BA
+5FC45FC95FD65FCF60035FEE60045FE15FE45FFE600560065FEA5FED5FF86019
+60356026601B600F600D6029602B600A603F602160786079607B607A60420000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9246924792489249924A924B924C924D924E924F925092519252925392549255
+9256925792589259925A925B925C925D925E925F926092619262926392649265
+9266926792689269926A926B926C926D926E926F927092719272927392759276
+927792789279927A927B927C927D927E927F9280928192829283928492850000
+9286928792889289928A928B928C928D928F9290929192929293929492959296
+929792989299929A929B929C929D929E929F92A092A192A292A392A492A592A6
+92A7606A607D6096609A60AD609D60836092608C609B60EC60BB60B160DD60D8
+60C660DA60B4612061266115612360F46100610E612B614A617561AC619461A7
+61B761D461F55FDD96B395E995EB95F195F395F595F695FC95FE960396049606
+9608960A960B960C960D960F96129615961696179619961A4E2C723F62156C35
+6C546C5C6C4A6CA36C856C906C946C8C6C686C696C746C766C866CA96CD06CD4
+6CAD6CF76CF86CF16CD76CB26CE06CD66CFA6CEB6CEE6CB16CD36CEF6CFE0000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+92A892A992AA92AB92AC92AD92AF92B092B192B292B392B492B592B692B792B8
+92B992BA92BB92BC92BD92BE92BF92C092C192C292C392C492C592C692C792C9
+92CA92CB92CC92CD92CE92CF92D092D192D292D392D492D592D692D792D892D9
+92DA92DB92DC92DD92DE92DF92E092E192E292E392E492E592E692E792E80000
+92E992EA92EB92EC92ED92EE92EF92F092F192F292F392F492F592F692F792F8
+92F992FA92FB92FC92FD92FE92FF930093019302930393049305930693079308
+93096D396D276D0C6D436D486D076D046D196D0E6D2B6D4D6D2E6D356D1A6D4F
+6D526D546D336D916D6F6D9E6DA06D5E6D936D946D5C6D606D7C6D636E1A6DC7
+6DC56DDE6E0E6DBF6DE06E116DE66DDD6DD96E166DAB6E0C6DAE6E2B6E6E6E4E
+6E6B6EB26E5F6E866E536E546E326E256E446EDF6EB16E986EE06F2D6EE26EA5
+6EA76EBD6EBB6EB76ED76EB46ECF6E8F6EC26E9F6F626F466F476F246F156EF9
+6F2F6F366F4B6F746F2A6F096F296F896F8D6F8C6F786F726F7C6F7A6FD10000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+930A930B930C930D930E930F9310931193129313931493159316931793189319
+931A931B931C931D931E931F9320932193229323932493259326932793289329
+932A932B932C932D932E932F9330933193329333933493359336933793389339
+933A933B933C933D933F93409341934293439344934593469347934893490000
+934A934B934C934D934E934F9350935193529353935493559356935793589359
+935A935B935C935D935E935F9360936193629363936493659366936793689369
+936B6FC96FA76FB96FB66FC26FE16FEE6FDE6FE06FEF701A7023701B70397035
+704F705E5B805B845B955B935BA55BB8752F9A9E64345BE45BEE89305BF08E47
+8B078FB68FD38FD58FE58FEE8FE48FE98FE68FF38FE890059004900B90269011
+900D9016902190359036902D902F9044905190529050906890589062905B66B9
+9074907D908290889083908B5F505F575F565F585C3B54AB5C505C595B715C63
+5C667FBC5F2A5F295F2D82745F3C9B3B5C6E59815983598D59A959AA59A30000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+936C936D936E936F9370937193729373937493759376937793789379937A937B
+937C937D937E937F9380938193829383938493859386938793889389938A938B
+938C938D938E9390939193929393939493959396939793989399939A939B939C
+939D939E939F93A093A193A293A393A493A593A693A793A893A993AA93AB0000
+93AC93AD93AE93AF93B093B193B293B393B493B593B693B793B893B993BA93BB
+93BC93BD93BE93BF93C093C193C293C393C493C593C693C793C893C993CB93CC
+93CD599759CA59AB599E59A459D259B259AF59D759BE5A055A0659DD5A0859E3
+59D859F95A0C5A095A325A345A115A235A135A405A675A4A5A555A3C5A625A75
+80EC5AAA5A9B5A775A7A5ABE5AEB5AB25AD25AD45AB85AE05AE35AF15AD65AE6
+5AD85ADC5B095B175B165B325B375B405C155C1C5B5A5B655B735B515B535B62
+9A759A779A789A7A9A7F9A7D9A809A819A859A889A8A9A909A929A939A969A98
+9A9B9A9C9A9D9A9F9AA09AA29AA39AA59AA77E9F7EA17EA37EA57EA87EA90000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+93CE93CF93D093D193D293D393D493D593D793D893D993DA93DB93DC93DD93DE
+93DF93E093E193E293E393E493E593E693E793E893E993EA93EB93EC93ED93EE
+93EF93F093F193F293F393F493F593F693F793F893F993FA93FB93FC93FD93FE
+93FF9400940194029403940494059406940794089409940A940B940C940D0000
+940E940F9410941194129413941494159416941794189419941A941B941C941D
+941E941F9420942194229423942494259426942794289429942A942B942C942D
+942E7EAD7EB07EBE7EC07EC17EC27EC97ECB7ECC7ED07ED47ED77EDB7EE07EE1
+7EE87EEB7EEE7EEF7EF17EF27F0D7EF67EFA7EFB7EFE7F017F027F037F077F08
+7F0B7F0C7F0F7F117F127F177F197F1C7F1B7F1F7F217F227F237F247F257F26
+7F277F2A7F2B7F2C7F2D7F2F7F307F317F327F337F355E7A757F5DDB753E9095
+738E739173AE73A2739F73CF73C273D173B773B373C073C973C873E573D9987C
+740A73E973E773DE73BA73F2740F742A745B7426742574287430742E742C0000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+942F9430943194329433943494359436943794389439943A943B943C943D943F
+9440944194429443944494459446944794489449944A944B944C944D944E944F
+9450945194529453945494559456945794589459945A945B945C945D945E945F
+9460946194629463946494659466946794689469946A946C946D946E946F0000
+9470947194729473947494759476947794789479947A947B947C947D947E947F
+9480948194829483948494919496949894C794CF94D394D494DA94E694FB951C
+9520741B741A7441745C7457745574597477746D747E749C748E748074817487
+748B749E74A874A9749074A774D274BA97EA97EB97EC674C6753675E67486769
+67A56787676A6773679867A7677567A8679E67AD678B6777677C67F0680967D8
+680A67E967B0680C67D967B567DA67B367DD680067C367B867E2680E67C167FD
+6832683368606861684E6862684468646883681D68556866684168676840683E
+684A6849682968B5688F687468776893686B68C2696E68FC691F692068F90000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+95279533953D95439548954B9555955A9560956E95749575957795789579957A
+957B957C957D957E9580958195829583958495859586958795889589958A958B
+958C958D958E958F9590959195929593959495959596959795989599959A959B
+959C959D959E959F95A095A195A295A395A495A595A695A795A895A995AA0000
+95AB95AC95AD95AE95AF95B095B195B295B395B495B595B695B795B895B995BA
+95BB95BC95BD95BE95BF95C095C195C295C395C495C595C695C795C895C995CA
+95CB692468F0690B6901695768E369106971693969606942695D6984696B6980
+69986978693469CC6987698869CE6989696669636979699B69A769BB69AB69AD
+69D469B169C169CA69DF699569E0698D69FF6A2F69ED6A176A186A6569F26A44
+6A3E6AA06A506A5B6A356A8E6A796A3D6A286A586A7C6A916A906AA96A976AAB
+733773526B816B826B876B846B926B936B8D6B9A6B9B6BA16BAA8F6B8F6D8F71
+8F728F738F758F768F788F778F798F7A8F7C8F7E8F818F828F848F878F8B0000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+95CC95CD95CE95CF95D095D195D295D395D495D595D695D795D895D995DA95DB
+95DC95DD95DE95DF95E095E195E295E395E495E595E695E795EC95FF96079613
+9618961B961E96209623962496259626962796289629962B962C962D962F9630
+963796389639963A963E96419643964A964E964F965196529653965696570000
+96589659965A965C965D965E9660966396659666966B966D966E966F96709671
+967396789679967A967B967C967D967E967F9680968196829683968496879689
+968A8F8D8F8E8F8F8F988F9A8ECE620B6217621B621F6222622162256224622C
+81E774EF74F474FF750F75117513653465EE65EF65F0660A6619677266036615
+6600708566F7661D66346631663666358006665F66546641664F665666616657
+66776684668C66A7669D66BE66DB66DC66E666E98D328D338D368D3B8D3D8D40
+8D458D468D488D498D478D4D8D558D5989C789CA89CB89CC89CE89CF89D089D1
+726E729F725D7266726F727E727F7284728B728D728F72926308633263B00000
+EB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+968C968E96919692969396959696969A969B969D969E969F96A096A196A296A3
+96A496A596A696A896A996AA96AB96AC96AD96AE96AF96B196B296B496B596B7
+96B896BA96BB96BF96C296C396C896CA96CB96D096D196D396D496D696D796D8
+96D996DA96DB96DC96DD96DE96DF96E196E296E396E496E596E696E796EB0000
+96EC96ED96EE96F096F196F296F496F596F896FA96FB96FC96FD96FF97029703
+9705970A970B970C97109711971297149715971797189719971A971B971D971F
+9720643F64D880046BEA6BF36BFD6BF56BF96C056C076C066C0D6C156C186C19
+6C1A6C216C296C246C2A6C3265356555656B724D72527256723086625216809F
+809C809380BC670A80BD80B180AB80AD80B480B780E780E880E980EA80DB80C2
+80C480D980CD80D7671080DD80EB80F180F480ED810D810E80F280FC67158112
+8C5A8136811E812C811881328148814C815381748159815A817181608169817C
+817D816D8167584D5AB58188818281916ED581A381AA81CC672681CA81BB0000
+EC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+972197229723972497259726972797289729972B972C972E972F973197339734
+973597369737973A973B973C973D973F97409741974297439744974597469747
+97489749974A974B974C974D974E974F975097519754975597579758975A975C
+975D975F97639764976697679768976A976B976C976D976E976F977097710000
+97729775977797789779977A977B977D977E977F978097819782978397849786
+978797889789978A978C978E978F979097939795979697979799979A979B979C
+979D81C181A66B246B376B396B436B466B5998D198D298D398D598D998DA6BB3
+5F406BC289F365909F51659365BC65C665C465C365CC65CE65D265D67080709C
+7096709D70BB70C070B770AB70B170E870CA711071137116712F71317173715C
+716871457172714A7178717A719871B371B571A871A071E071D471E771F9721D
+7228706C7118716671B9623E623D624362486249793B794079467949795B795C
+7953795A796279577960796F7967797A7985798A799A79A779B35FD15FD00000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+979E979F97A197A297A497A597A697A797A897A997AA97AC97AE97B097B197B3
+97B597B697B797B897B997BA97BB97BC97BD97BE97BF97C097C197C297C397C4
+97C597C697C797C897C997CA97CB97CC97CD97CE97CF97D097D197D297D397D4
+97D597D697D797D897D997DA97DB97DC97DD97DE97DF97E097E197E297E30000
+97E497E597E897EE97EF97F097F197F297F497F797F897F997FA97FB97FC97FD
+97FE97FF9800980198029803980498059806980798089809980A980B980C980D
+980E603C605D605A606760416059606360AB6106610D615D61A9619D61CB61D1
+62068080807F6C936CF66DFC77F677F87800780978177818781165AB782D781C
+781D7839783A783B781F783C7825782C78237829784E786D7856785778267850
+7847784C786A789B7893789A7887789C78A178A378B278B978A578D478D978C9
+78EC78F2790578F479137924791E79349F9B9EF99EFB9EFC76F17704770D76F9
+77077708771A77227719772D7726773577387750775177477743775A77680000
+EE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+980F9810981198129813981498159816981798189819981A981B981C981D981E
+981F9820982198229823982498259826982798289829982A982B982C982D982E
+982F9830983198329833983498359836983798389839983A983B983C983D983E
+983F9840984198429843984498459846984798489849984A984B984C984D0000
+984E984F9850985198529853985498559856985798589859985A985B985C985D
+985E985F9860986198629863986498659866986798689869986A986B986C986D
+986E77627765777F778D777D7780778C7791779F77A077B077B577BD753A7540
+754E754B7548755B7572757975837F587F617F5F8A487F687F747F717F797F81
+7F7E76CD76E58832948594869487948B948A948C948D948F9490949494979495
+949A949B949C94A394A494AB94AA94AD94AC94AF94B094B294B494B694B794B8
+94B994BA94BC94BD94BF94C494C894C994CA94CB94CC94CD94CE94D094D194D2
+94D594D694D794D994D894DB94DE94DF94E094E294E494E594E794E894EA0000
+EF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+986F98709871987298739874988B988E98929895989998A398A898A998AA98AB
+98AC98AD98AE98AF98B098B198B298B398B498B598B698B798B898B998BA98BB
+98BC98BD98BE98BF98C098C198C298C398C498C598C698C798C898C998CA98CB
+98CC98CD98CF98D098D498D698D798DB98DC98DD98E098E198E298E398E40000
+98E598E698E998EA98EB98EC98ED98EE98EF98F098F198F298F398F498F598F6
+98F798F898F998FA98FB98FC98FD98FE98FF9900990199029903990499059906
+990794E994EB94EE94EF94F394F494F594F794F994FC94FD94FF950395029506
+95079509950A950D950E950F951295139514951595169518951B951D951E951F
+9522952A952B9529952C953195329534953695379538953C953E953F95429535
+9544954595469549954C954E954F9552955395549556955795589559955B955E
+955F955D95619562956495659566956795689569956A956B956C956F95719572
+9573953A77E777EC96C979D579ED79E379EB7A065D477A037A027A1E7A140000
+F0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+99089909990A990B990C990E990F991199129913991499159916991799189919
+991A991B991C991D991E991F9920992199229923992499259926992799289929
+992A992B992C992D992F9930993199329933993499359936993799389939993A
+993B993C993D993E993F99409941994299439944994599469947994899490000
+994A994B994C994D994E994F99509951995299539956995799589959995A995B
+995C995D995E995F99609961996299649966997399789979997B997E99829983
+99897A397A377A519ECF99A57A707688768E7693769976A474DE74E0752C9E20
+9E229E289E299E2A9E2B9E2C9E329E319E369E389E379E399E3A9E3E9E419E42
+9E449E469E479E489E499E4B9E4C9E4E9E519E559E579E5A9E5B9E5C9E5E9E63
+9E669E679E689E699E6A9E6B9E6C9E719E6D9E7375927594759675A0759D75AC
+75A375B375B475B875C475B175B075C375C275D675CD75E375E875E675E475EB
+75E7760375F175FC75FF761076007605760C7617760A76257618761576190000
+F1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+998C998E999A999B999C999D999E999F99A099A199A299A399A499A699A799A9
+99AA99AB99AC99AD99AE99AF99B099B199B299B399B499B599B699B799B899B9
+99BA99BB99BC99BD99BE99BF99C099C199C299C399C499C599C699C799C899C9
+99CA99CB99CC99CD99CE99CF99D099D199D299D399D499D599D699D799D80000
+99D999DA99DB99DC99DD99DE99DF99E099E199E299E399E499E599E699E799E8
+99E999EA99EB99EC99ED99EE99EF99F099F199F299F399F499F599F699F799F8
+99F9761B763C762276207640762D7630763F76357643763E7633764D765E7654
+765C7656766B766F7FCA7AE67A787A797A807A867A887A957AA67AA07AAC7AA8
+7AAD7AB3886488698872887D887F888288A288C688B788BC88C988E288CE88E3
+88E588F1891A88FC88E888FE88F0892189198913891B890A8934892B89368941
+8966897B758B80E576B276B477DC801280148016801C80208022802580268027
+802980288031800B803580438046804D80528069807189839878988098830000
+F2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+99FA99FB99FC99FD99FE99FF9A009A019A029A039A049A059A069A079A089A09
+9A0A9A0B9A0C9A0D9A0E9A0F9A109A119A129A139A149A159A169A179A189A19
+9A1A9A1B9A1C9A1D9A1E9A1F9A209A219A229A239A249A259A269A279A289A29
+9A2A9A2B9A2C9A2D9A2E9A2F9A309A319A329A339A349A359A369A379A380000
+9A399A3A9A3B9A3C9A3D9A3E9A3F9A409A419A429A439A449A459A469A479A48
+9A499A4A9A4B9A4C9A4D9A4E9A4F9A509A519A529A539A549A559A569A579A58
+9A599889988C988D988F9894989A989B989E989F98A198A298A598A6864D8654
+866C866E867F867A867C867B86A8868D868B86AC869D86A786A386AA869386A9
+86B686C486B586CE86B086BA86B186AF86C986CF86B486E986F186F286ED86F3
+86D0871386DE86F486DF86D886D18703870786F88708870A870D87098723873B
+871E8725872E871A873E87488734873187298737873F87828722877D877E877B
+87608770874C876E878B87538763877C876487598765879387AF87A887D20000
+F3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9A5A9A5B9A5C9A5D9A5E9A5F9A609A619A629A639A649A659A669A679A689A69
+9A6A9A6B9A729A839A899A8D9A8E9A949A959A999AA69AA99AAA9AAB9AAC9AAD
+9AAE9AAF9AB29AB39AB49AB59AB99ABB9ABD9ABE9ABF9AC39AC49AC69AC79AC8
+9AC99ACA9ACD9ACE9ACF9AD09AD29AD49AD59AD69AD79AD99ADA9ADB9ADC0000
+9ADD9ADE9AE09AE29AE39AE49AE59AE79AE89AE99AEA9AEC9AEE9AF09AF19AF2
+9AF39AF49AF59AF69AF79AF89AFA9AFC9AFD9AFE9AFF9B009B019B029B049B05
+9B0687C68788878587AD8797878387AB87E587AC87B587B387CB87D387BD87D1
+87C087CA87DB87EA87E087EE8816881387FE880A881B88218839883C7F367F42
+7F447F4582107AFA7AFD7B087B037B047B157B0A7B2B7B0F7B477B387B2A7B19
+7B2E7B317B207B257B247B337B3E7B1E7B587B5A7B457B757B4C7B5D7B607B6E
+7B7B7B627B727B717B907BA67BA77BB87BAC7B9D7BA87B857BAA7B9C7BA27BAB
+7BB47BD17BC17BCC7BDD7BDA7BE57BE67BEA7C0C7BFE7BFC7C0F7C167C0B0000
+F4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9B079B099B0A9B0B9B0C9B0D9B0E9B109B119B129B149B159B169B179B189B19
+9B1A9B1B9B1C9B1D9B1E9B209B219B229B249B259B269B279B289B299B2A9B2B
+9B2C9B2D9B2E9B309B319B339B349B359B369B379B389B399B3A9B3D9B3E9B3F
+9B409B469B4A9B4B9B4C9B4E9B509B529B539B559B569B579B589B599B5A0000
+9B5B9B5C9B5D9B5E9B5F9B609B619B629B639B649B659B669B679B689B699B6A
+9B6B9B6C9B6D9B6E9B6F9B709B719B729B739B749B759B769B779B789B799B7A
+9B7B7C1F7C2A7C267C387C417C4081FE82018202820481EC8844822182228223
+822D822F8228822B8238823B82338234823E82448249824B824F825A825F8268
+887E8885888888D888DF895E7F9D7F9F7FA77FAF7FB07FB27C7C65497C917C9D
+7C9C7C9E7CA27CB27CBC7CBD7CC17CC77CCC7CCD7CC87CC57CD77CE8826E66A8
+7FBF7FCE7FD57FE57FE17FE67FE97FEE7FF37CF87D777DA67DAE7E477E9B9EB8
+9EB48D738D848D948D918DB18D678D6D8C478C49914A9150914E914F91640000
+F5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9B7C9B7D9B7E9B7F9B809B819B829B839B849B859B869B879B889B899B8A9B8B
+9B8C9B8D9B8E9B8F9B909B919B929B939B949B959B969B979B989B999B9A9B9B
+9B9C9B9D9B9E9B9F9BA09BA19BA29BA39BA49BA59BA69BA79BA89BA99BAA9BAB
+9BAC9BAD9BAE9BAF9BB09BB19BB29BB39BB49BB59BB69BB79BB89BB99BBA0000
+9BBB9BBC9BBD9BBE9BBF9BC09BC19BC29BC39BC49BC59BC69BC79BC89BC99BCA
+9BCB9BCC9BCD9BCE9BCF9BD09BD19BD29BD39BD49BD59BD69BD79BD89BD99BDA
+9BDB9162916191709169916F917D917E917291749179918C91859190918D9191
+91A291A391AA91AD91AE91AF91B591B491BA8C559E7E8DB88DEB8E058E598E69
+8DB58DBF8DBC8DBA8DC48DD68DD78DDA8DDE8DCE8DCF8DDB8DC68DEC8DF78DF8
+8DE38DF98DFB8DE48E098DFD8E148E1D8E1F8E2C8E2E8E238E2F8E3A8E408E39
+8E358E3D8E318E498E418E428E518E528E4A8E708E768E7C8E6F8E748E858E8F
+8E948E908E9C8E9E8C788C828C8A8C858C988C94659B89D689DE89DA89DC0000
+F6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9BDC9BDD9BDE9BDF9BE09BE19BE29BE39BE49BE59BE69BE79BE89BE99BEA9BEB
+9BEC9BED9BEE9BEF9BF09BF19BF29BF39BF49BF59BF69BF79BF89BF99BFA9BFB
+9BFC9BFD9BFE9BFF9C009C019C029C039C049C059C069C079C089C099C0A9C0B
+9C0C9C0D9C0E9C0F9C109C119C129C139C149C159C169C179C189C199C1A0000
+9C1B9C1C9C1D9C1E9C1F9C209C219C229C239C249C259C269C279C289C299C2A
+9C2B9C2C9C2D9C2E9C2F9C309C319C329C339C349C359C369C379C389C399C3A
+9C3B89E589EB89EF8A3E8B26975396E996F396EF970697019708970F970E972A
+972D9730973E9F809F839F859F869F879F889F899F8A9F8C9EFE9F0B9F0D96B9
+96BC96BD96CE96D277BF96E0928E92AE92C8933E936A93CA938F943E946B9C7F
+9C829C859C869C879C887A239C8B9C8E9C909C919C929C949C959C9A9C9B9C9E
+9C9F9CA09CA19CA29CA39CA59CA69CA79CA89CA99CAB9CAD9CAE9CB09CB19CB2
+9CB39CB49CB59CB69CB79CBA9CBB9CBC9CBD9CC49CC59CC69CC79CCA9CCB0000
+F7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9C3C9C3D9C3E9C3F9C409C419C429C439C449C459C469C479C489C499C4A9C4B
+9C4C9C4D9C4E9C4F9C509C519C529C539C549C559C569C579C589C599C5A9C5B
+9C5C9C5D9C5E9C5F9C609C619C629C639C649C659C669C679C689C699C6A9C6B
+9C6C9C6D9C6E9C6F9C709C719C729C739C749C759C769C779C789C799C7A0000
+9C7B9C7D9C7E9C809C839C849C899C8A9C8C9C8F9C939C969C979C989C999C9D
+9CAA9CAC9CAF9CB99CBE9CBF9CC09CC19CC29CC89CC99CD19CD29CDA9CDB9CE0
+9CE19CCC9CCD9CCE9CCF9CD09CD39CD49CD59CD79CD89CD99CDC9CDD9CDF9CE2
+977C978597919792979497AF97AB97A397B297B49AB19AB09AB79E589AB69ABA
+9ABC9AC19AC09AC59AC29ACB9ACC9AD19B459B439B479B499B489B4D9B5198E8
+990D992E995599549ADF9AE19AE69AEF9AEB9AFB9AED9AF99B089B0F9B139B1F
+9B239EBD9EBE7E3B9E829E879E889E8B9E9293D69E9D9E9F9EDB9EDC9EDD9EE0
+9EDF9EE29EE99EE79EE59EEA9EEF9F229F2C9F2F9F399F379F3D9F3E9F440000
+F8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9CE39CE49CE59CE69CE79CE89CE99CEA9CEB9CEC9CED9CEE9CEF9CF09CF19CF2
+9CF39CF49CF59CF69CF79CF89CF99CFA9CFB9CFC9CFD9CFE9CFF9D009D019D02
+9D039D049D059D069D079D089D099D0A9D0B9D0C9D0D9D0E9D0F9D109D119D12
+9D139D149D159D169D179D189D199D1A9D1B9D1C9D1D9D1E9D1F9D209D210000
+9D229D239D249D259D269D279D289D299D2A9D2B9D2C9D2D9D2E9D2F9D309D31
+9D329D339D349D359D369D379D389D399D3A9D3B9D3C9D3D9D3E9D3F9D409D41
+9D42000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+F9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9D439D449D459D469D479D489D499D4A9D4B9D4C9D4D9D4E9D4F9D509D519D52
+9D539D549D559D569D579D589D599D5A9D5B9D5C9D5D9D5E9D5F9D609D619D62
+9D639D649D659D669D679D689D699D6A9D6B9D6C9D6D9D6E9D6F9D709D719D72
+9D739D749D759D769D779D789D799D7A9D7B9D7C9D7D9D7E9D7F9D809D810000
+9D829D839D849D859D869D879D889D899D8A9D8B9D8C9D8D9D8E9D8F9D909D91
+9D929D939D949D959D969D979D989D999D9A9D9B9D9C9D9D9D9E9D9F9DA09DA1
+9DA2000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9DA39DA49DA59DA69DA79DA89DA99DAA9DAB9DAC9DAD9DAE9DAF9DB09DB19DB2
+9DB39DB49DB59DB69DB79DB89DB99DBA9DBB9DBC9DBD9DBE9DBF9DC09DC19DC2
+9DC39DC49DC59DC69DC79DC89DC99DCA9DCB9DCC9DCD9DCE9DCF9DD09DD19DD2
+9DD39DD49DD59DD69DD79DD89DD99DDA9DDB9DDC9DDD9DDE9DDF9DE09DE10000
+9DE29DE39DE49DE59DE69DE79DE89DE99DEA9DEB9DEC9DED9DEE9DEF9DF09DF1
+9DF29DF39DF49DF59DF69DF79DF89DF99DFA9DFB9DFC9DFD9DFE9DFF9E009E01
+9E02000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9E039E049E059E069E079E089E099E0A9E0B9E0C9E0D9E0E9E0F9E109E119E12
+9E139E149E159E169E179E189E199E1A9E1B9E1C9E1D9E1E9E249E279E2E9E30
+9E349E3B9E3C9E409E4D9E509E529E539E549E569E599E5D9E5F9E609E619E62
+9E659E6E9E6F9E729E749E759E769E779E789E799E7A9E7B9E7C9E7D9E800000
+9E819E839E849E859E869E899E8A9E8C9E8D9E8E9E8F9E909E919E949E959E96
+9E979E989E999E9A9E9B9E9C9E9E9EA09EA19EA29EA39EA49EA59EA79EA89EA9
+9EAA000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9EAB9EAC9EAD9EAE9EAF9EB09EB19EB29EB39EB59EB69EB79EB99EBA9EBC9EBF
+9EC09EC19EC29EC39EC59EC69EC79EC89ECA9ECB9ECC9ED09ED29ED39ED59ED6
+9ED79ED99EDA9EDE9EE19EE39EE49EE69EE89EEB9EEC9EED9EEE9EF09EF19EF2
+9EF39EF49EF59EF69EF79EF89EFA9EFD9EFF9F009F019F029F039F049F050000
+9F069F079F089F099F0A9F0C9F0F9F119F129F149F159F169F189F1A9F1B9F1C
+9F1D9F1E9F1F9F219F239F249F259F269F279F289F299F2A9F2B9F2D9F2E9F30
+9F31000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9F329F339F349F359F369F389F3A9F3C9F3F9F409F419F429F439F459F469F47
+9F489F499F4A9F4B9F4C9F4D9F4E9F4F9F529F539F549F559F569F579F589F59
+9F5A9F5B9F5C9F5D9F5E9F5F9F609F619F629F639F649F659F669F679F689F69
+9F6A9F6B9F6C9F6D9F6E9F6F9F709F719F729F739F749F759F769F779F780000
+9F799F7A9F7B9F7C9F7D9F7E9F819F829F8D9F8E9F8F9F909F919F929F939F94
+9F959F969F979F989F9C9F9D9F9E9FA19FA29FA39FA49FA5F92CF979F995F9E7
+F9F1000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FA0CFA0DFA0EFA0FFA11FA13FA14FA18FA1FFA20FA21FA23FA24FA27FA28FA29
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/cp949.enc b/tcl/library/encoding/cp949.enc
new file mode 100644
index 00000000000..697fc6f94e0
--- /dev/null
+++ b/tcl/library/encoding/cp949.enc
@@ -0,0 +1,2128 @@
+# Encoding file: cp949, multi-byte
+M
+003F 0 125
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+81
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AC02AC03AC05AC06AC0BAC0CAC0DAC0EAC0FAC18AC1EAC1FAC21AC22AC23
+AC25AC26AC27AC28AC29AC2AAC2BAC2EAC32AC33AC3400000000000000000000
+0000AC35AC36AC37AC3AAC3BAC3DAC3EAC3FAC41AC42AC43AC44AC45AC46AC47
+AC48AC49AC4AAC4CAC4EAC4FAC50AC51AC52AC53AC5500000000000000000000
+0000AC56AC57AC59AC5AAC5BAC5DAC5EAC5FAC60AC61AC62AC63AC64AC65AC66
+AC67AC68AC69AC6AAC6BAC6CAC6DAC6EAC6FAC72AC73AC75AC76AC79AC7BAC7C
+AC7DAC7EAC7FAC82AC87AC88AC8DAC8EAC8FAC91AC92AC93AC95AC96AC97AC98
+AC99AC9AAC9BAC9EACA2ACA3ACA4ACA5ACA6ACA7ACABACADACAEACB1ACB2ACB3
+ACB4ACB5ACB6ACB7ACBAACBEACBFACC0ACC2ACC3ACC5ACC6ACC7ACC9ACCAACCB
+ACCDACCEACCFACD0ACD1ACD2ACD3ACD4ACD6ACD8ACD9ACDAACDBACDCACDDACDE
+ACDFACE2ACE3ACE5ACE6ACE9ACEBACEDACEEACF2ACF4ACF7ACF8ACF9ACFAACFB
+ACFEACFFAD01AD02AD03AD05AD07AD08AD09AD0AAD0BAD0EAD10AD12AD130000
+82
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AD14AD15AD16AD17AD19AD1AAD1BAD1DAD1EAD1FAD21AD22AD23AD24AD25
+AD26AD27AD28AD2AAD2BAD2EAD2FAD30AD31AD32AD3300000000000000000000
+0000AD36AD37AD39AD3AAD3BAD3DAD3EAD3FAD40AD41AD42AD43AD46AD48AD4A
+AD4BAD4CAD4DAD4EAD4FAD51AD52AD53AD55AD56AD5700000000000000000000
+0000AD59AD5AAD5BAD5CAD5DAD5EAD5FAD60AD62AD64AD65AD66AD67AD68AD69
+AD6AAD6BAD6EAD6FAD71AD72AD77AD78AD79AD7AAD7EAD80AD83AD84AD85AD86
+AD87AD8AAD8BAD8DAD8EAD8FAD91AD92AD93AD94AD95AD96AD97AD98AD99AD9A
+AD9BAD9EAD9FADA0ADA1ADA2ADA3ADA5ADA6ADA7ADA8ADA9ADAAADABADACADAD
+ADAEADAFADB0ADB1ADB2ADB3ADB4ADB5ADB6ADB8ADB9ADBAADBBADBCADBDADBE
+ADBFADC2ADC3ADC5ADC6ADC7ADC9ADCAADCBADCCADCDADCEADCFADD2ADD4ADD5
+ADD6ADD7ADD8ADD9ADDAADDBADDDADDEADDFADE1ADE2ADE3ADE5ADE6ADE7ADE8
+ADE9ADEAADEBADECADEDADEEADEFADF0ADF1ADF2ADF3ADF4ADF5ADF6ADF70000
+83
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000ADFAADFBADFDADFEAE02AE03AE04AE05AE06AE07AE0AAE0CAE0EAE0FAE10
+AE11AE12AE13AE15AE16AE17AE18AE19AE1AAE1BAE1C00000000000000000000
+0000AE1DAE1EAE1FAE20AE21AE22AE23AE24AE25AE26AE27AE28AE29AE2AAE2B
+AE2CAE2DAE2EAE2FAE32AE33AE35AE36AE39AE3BAE3C00000000000000000000
+0000AE3DAE3EAE3FAE42AE44AE47AE48AE49AE4BAE4FAE51AE52AE53AE55AE57
+AE58AE59AE5AAE5BAE5EAE62AE63AE64AE66AE67AE6AAE6BAE6DAE6EAE6FAE71
+AE72AE73AE74AE75AE76AE77AE7AAE7EAE7FAE80AE81AE82AE83AE86AE87AE88
+AE89AE8AAE8BAE8DAE8EAE8FAE90AE91AE92AE93AE94AE95AE96AE97AE98AE99
+AE9AAE9BAE9CAE9DAE9EAE9FAEA0AEA1AEA2AEA3AEA4AEA5AEA6AEA7AEA8AEA9
+AEAAAEABAEACAEADAEAEAEAFAEB0AEB1AEB2AEB3AEB4AEB5AEB6AEB7AEB8AEB9
+AEBAAEBBAEBFAEC1AEC2AEC3AEC5AEC6AEC7AEC8AEC9AECAAECBAECEAED2AED3
+AED4AED5AED6AED7AEDAAEDBAEDDAEDEAEDFAEE0AEE1AEE2AEE3AEE4AEE50000
+84
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AEE6AEE7AEE9AEEAAEECAEEEAEEFAEF0AEF1AEF2AEF3AEF5AEF6AEF7AEF9
+AEFAAEFBAEFDAEFEAEFFAF00AF01AF02AF03AF04AF0500000000000000000000
+0000AF06AF09AF0AAF0BAF0CAF0EAF0FAF11AF12AF13AF14AF15AF16AF17AF18
+AF19AF1AAF1BAF1CAF1DAF1EAF1FAF20AF21AF22AF2300000000000000000000
+0000AF24AF25AF26AF27AF28AF29AF2AAF2BAF2EAF2FAF31AF33AF35AF36AF37
+AF38AF39AF3AAF3BAF3EAF40AF44AF45AF46AF47AF4AAF4BAF4CAF4DAF4EAF4F
+AF51AF52AF53AF54AF55AF56AF57AF58AF59AF5AAF5BAF5EAF5FAF60AF61AF62
+AF63AF66AF67AF68AF69AF6AAF6BAF6CAF6DAF6EAF6FAF70AF71AF72AF73AF74
+AF75AF76AF77AF78AF7AAF7BAF7CAF7DAF7EAF7FAF81AF82AF83AF85AF86AF87
+AF89AF8AAF8BAF8CAF8DAF8EAF8FAF92AF93AF94AF96AF97AF98AF99AF9AAF9B
+AF9DAF9EAF9FAFA0AFA1AFA2AFA3AFA4AFA5AFA6AFA7AFA8AFA9AFAAAFABAFAC
+AFADAFAEAFAFAFB0AFB1AFB2AFB3AFB4AFB5AFB6AFB7AFBAAFBBAFBDAFBE0000
+85
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AFBFAFC1AFC2AFC3AFC4AFC5AFC6AFCAAFCCAFCFAFD0AFD1AFD2AFD3AFD5
+AFD6AFD7AFD8AFD9AFDAAFDBAFDDAFDEAFDFAFE0AFE100000000000000000000
+0000AFE2AFE3AFE4AFE5AFE6AFE7AFEAAFEBAFECAFEDAFEEAFEFAFF2AFF3AFF5
+AFF6AFF7AFF9AFFAAFFBAFFCAFFDAFFEAFFFB002B00300000000000000000000
+0000B005B006B007B008B009B00AB00BB00DB00EB00FB011B012B013B015B016
+B017B018B019B01AB01BB01EB01FB020B021B022B023B024B025B026B027B029
+B02AB02BB02CB02DB02EB02FB030B031B032B033B034B035B036B037B038B039
+B03AB03BB03CB03DB03EB03FB040B041B042B043B046B047B049B04BB04DB04F
+B050B051B052B056B058B05AB05BB05CB05EB05FB060B061B062B063B064B065
+B066B067B068B069B06AB06BB06CB06DB06EB06FB070B071B072B073B074B075
+B076B077B078B079B07AB07BB07EB07FB081B082B083B085B086B087B088B089
+B08AB08BB08EB090B092B093B094B095B096B097B09BB09DB09EB0A3B0A40000
+86
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B0A5B0A6B0A7B0AAB0B0B0B2B0B6B0B7B0B9B0BAB0BBB0BDB0BEB0BFB0C0
+B0C1B0C2B0C3B0C6B0CAB0CBB0CCB0CDB0CEB0CFB0D200000000000000000000
+0000B0D3B0D5B0D6B0D7B0D9B0DAB0DBB0DCB0DDB0DEB0DFB0E1B0E2B0E3B0E4
+B0E6B0E7B0E8B0E9B0EAB0EBB0ECB0EDB0EEB0EFB0F000000000000000000000
+0000B0F1B0F2B0F3B0F4B0F5B0F6B0F7B0F8B0F9B0FAB0FBB0FCB0FDB0FEB0FF
+B100B101B102B103B104B105B106B107B10AB10DB10EB10FB111B114B115B116
+B117B11AB11EB11FB120B121B122B126B127B129B12AB12BB12DB12EB12FB130
+B131B132B133B136B13AB13BB13CB13DB13EB13FB142B143B145B146B147B149
+B14AB14BB14CB14DB14EB14FB152B153B156B157B159B15AB15BB15DB15EB15F
+B161B162B163B164B165B166B167B168B169B16AB16BB16CB16DB16EB16FB170
+B171B172B173B174B175B176B177B17AB17BB17DB17EB17FB181B183B184B185
+B186B187B18AB18CB18EB18FB190B191B195B196B197B199B19AB19BB19D0000
+87
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B19EB19FB1A0B1A1B1A2B1A3B1A4B1A5B1A6B1A7B1A9B1AAB1ABB1ACB1AD
+B1AEB1AFB1B0B1B1B1B2B1B3B1B4B1B5B1B6B1B7B1B800000000000000000000
+0000B1B9B1BAB1BBB1BCB1BDB1BEB1BFB1C0B1C1B1C2B1C3B1C4B1C5B1C6B1C7
+B1C8B1C9B1CAB1CBB1CDB1CEB1CFB1D1B1D2B1D3B1D500000000000000000000
+0000B1D6B1D7B1D8B1D9B1DAB1DBB1DEB1E0B1E1B1E2B1E3B1E4B1E5B1E6B1E7
+B1EAB1EBB1EDB1EEB1EFB1F1B1F2B1F3B1F4B1F5B1F6B1F7B1F8B1FAB1FCB1FE
+B1FFB200B201B202B203B206B207B209B20AB20DB20EB20FB210B211B212B213
+B216B218B21AB21BB21CB21DB21EB21FB221B222B223B224B225B226B227B228
+B229B22AB22BB22CB22DB22EB22FB230B231B232B233B235B236B237B238B239
+B23AB23BB23DB23EB23FB240B241B242B243B244B245B246B247B248B249B24A
+B24BB24CB24DB24EB24FB250B251B252B253B254B255B256B257B259B25AB25B
+B25DB25EB25FB261B262B263B264B265B266B267B26AB26BB26CB26DB26E0000
+88
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B26FB270B271B272B273B276B277B278B279B27AB27BB27DB27EB27FB280
+B281B282B283B286B287B288B28AB28BB28CB28DB28E00000000000000000000
+0000B28FB292B293B295B296B297B29BB29CB29DB29EB29FB2A2B2A4B2A7B2A8
+B2A9B2ABB2ADB2AEB2AFB2B1B2B2B2B3B2B5B2B6B2B700000000000000000000
+0000B2B8B2B9B2BAB2BBB2BCB2BDB2BEB2BFB2C0B2C1B2C2B2C3B2C4B2C5B2C6
+B2C7B2CAB2CBB2CDB2CEB2CFB2D1B2D3B2D4B2D5B2D6B2D7B2DAB2DCB2DEB2DF
+B2E0B2E1B2E3B2E7B2E9B2EAB2F0B2F1B2F2B2F6B2FCB2FDB2FEB302B303B305
+B306B307B309B30AB30BB30CB30DB30EB30FB312B316B317B318B319B31AB31B
+B31DB31EB31FB320B321B322B323B324B325B326B327B328B329B32AB32BB32C
+B32DB32EB32FB330B331B332B333B334B335B336B337B338B339B33AB33BB33C
+B33DB33EB33FB340B341B342B343B344B345B346B347B348B349B34AB34BB34C
+B34DB34EB34FB350B351B352B353B357B359B35AB35DB360B361B362B3630000
+89
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B366B368B36AB36CB36DB36FB372B373B375B376B377B379B37AB37BB37C
+B37DB37EB37FB382B386B387B388B389B38AB38BB38D00000000000000000000
+0000B38EB38FB391B392B393B395B396B397B398B399B39AB39BB39CB39DB39E
+B39FB3A2B3A3B3A4B3A5B3A6B3A7B3A9B3AAB3ABB3AD00000000000000000000
+0000B3AEB3AFB3B0B3B1B3B2B3B3B3B4B3B5B3B6B3B7B3B8B3B9B3BAB3BBB3BC
+B3BDB3BEB3BFB3C0B3C1B3C2B3C3B3C6B3C7B3C9B3CAB3CDB3CFB3D1B3D2B3D3
+B3D6B3D8B3DAB3DCB3DEB3DFB3E1B3E2B3E3B3E5B3E6B3E7B3E9B3EAB3EBB3EC
+B3EDB3EEB3EFB3F0B3F1B3F2B3F3B3F4B3F5B3F6B3F7B3F8B3F9B3FAB3FBB3FD
+B3FEB3FFB400B401B402B403B404B405B406B407B408B409B40AB40BB40CB40D
+B40EB40FB411B412B413B414B415B416B417B419B41AB41BB41DB41EB41FB421
+B422B423B424B425B426B427B42AB42CB42DB42EB42FB430B431B432B433B435
+B436B437B438B439B43AB43BB43CB43DB43EB43FB440B441B442B443B4440000
+8A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B445B446B447B448B449B44AB44BB44CB44DB44EB44FB452B453B455B456
+B457B459B45AB45BB45CB45DB45EB45FB462B464B46600000000000000000000
+0000B467B468B469B46AB46BB46DB46EB46FB470B471B472B473B474B475B476
+B477B478B479B47AB47BB47CB47DB47EB47FB481B48200000000000000000000
+0000B483B484B485B486B487B489B48AB48BB48CB48DB48EB48FB490B491B492
+B493B494B495B496B497B498B499B49AB49BB49CB49EB49FB4A0B4A1B4A2B4A3
+B4A5B4A6B4A7B4A9B4AAB4ABB4ADB4AEB4AFB4B0B4B1B4B2B4B3B4B4B4B6B4B8
+B4BAB4BBB4BCB4BDB4BEB4BFB4C1B4C2B4C3B4C5B4C6B4C7B4C9B4CAB4CBB4CC
+B4CDB4CEB4CFB4D1B4D2B4D3B4D4B4D6B4D7B4D8B4D9B4DAB4DBB4DEB4DFB4E1
+B4E2B4E5B4E7B4E8B4E9B4EAB4EBB4EEB4F0B4F2B4F3B4F4B4F5B4F6B4F7B4F9
+B4FAB4FBB4FCB4FDB4FEB4FFB500B501B502B503B504B505B506B507B508B509
+B50AB50BB50CB50DB50EB50FB510B511B512B513B516B517B519B51AB51D0000
+8B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B51EB51FB520B521B522B523B526B52BB52CB52DB52EB52FB532B533B535
+B536B537B539B53AB53BB53CB53DB53EB53FB542B54600000000000000000000
+0000B547B548B549B54AB54EB54FB551B552B553B555B556B557B558B559B55A
+B55BB55EB562B563B564B565B566B567B568B569B56A00000000000000000000
+0000B56BB56CB56DB56EB56FB570B571B572B573B574B575B576B577B578B579
+B57AB57BB57CB57DB57EB57FB580B581B582B583B584B585B586B587B588B589
+B58AB58BB58CB58DB58EB58FB590B591B592B593B594B595B596B597B598B599
+B59AB59BB59CB59DB59EB59FB5A2B5A3B5A5B5A6B5A7B5A9B5ACB5ADB5AEB5AF
+B5B2B5B6B5B7B5B8B5B9B5BAB5BEB5BFB5C1B5C2B5C3B5C5B5C6B5C7B5C8B5C9
+B5CAB5CBB5CEB5D2B5D3B5D4B5D5B5D6B5D7B5D9B5DAB5DBB5DCB5DDB5DEB5DF
+B5E0B5E1B5E2B5E3B5E4B5E5B5E6B5E7B5E8B5E9B5EAB5EBB5EDB5EEB5EFB5F0
+B5F1B5F2B5F3B5F4B5F5B5F6B5F7B5F8B5F9B5FAB5FBB5FCB5FDB5FEB5FF0000
+8C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B600B601B602B603B604B605B606B607B608B609B60AB60BB60CB60DB60E
+B60FB612B613B615B616B617B619B61AB61BB61CB61D00000000000000000000
+0000B61EB61FB620B621B622B623B624B626B627B628B629B62AB62BB62DB62E
+B62FB630B631B632B633B635B636B637B638B639B63A00000000000000000000
+0000B63BB63CB63DB63EB63FB640B641B642B643B644B645B646B647B649B64A
+B64BB64CB64DB64EB64FB650B651B652B653B654B655B656B657B658B659B65A
+B65BB65CB65DB65EB65FB660B661B662B663B665B666B667B669B66AB66BB66C
+B66DB66EB66FB670B671B672B673B674B675B676B677B678B679B67AB67BB67C
+B67DB67EB67FB680B681B682B683B684B685B686B687B688B689B68AB68BB68C
+B68DB68EB68FB690B691B692B693B694B695B696B697B698B699B69AB69BB69E
+B69FB6A1B6A2B6A3B6A5B6A6B6A7B6A8B6A9B6AAB6ADB6AEB6AFB6B0B6B2B6B3
+B6B4B6B5B6B6B6B7B6B8B6B9B6BAB6BBB6BCB6BDB6BEB6BFB6C0B6C1B6C20000
+8D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B6C3B6C4B6C5B6C6B6C7B6C8B6C9B6CAB6CBB6CCB6CDB6CEB6CFB6D0B6D1
+B6D2B6D3B6D5B6D6B6D7B6D8B6D9B6DAB6DBB6DCB6DD00000000000000000000
+0000B6DEB6DFB6E0B6E1B6E2B6E3B6E4B6E5B6E6B6E7B6E8B6E9B6EAB6EBB6EC
+B6EDB6EEB6EFB6F1B6F2B6F3B6F5B6F6B6F7B6F9B6FA00000000000000000000
+0000B6FBB6FCB6FDB6FEB6FFB702B703B704B706B707B708B709B70AB70BB70C
+B70DB70EB70FB710B711B712B713B714B715B716B717B718B719B71AB71BB71C
+B71DB71EB71FB720B721B722B723B724B725B726B727B72AB72BB72DB72EB731
+B732B733B734B735B736B737B73AB73CB73DB73EB73FB740B741B742B743B745
+B746B747B749B74AB74BB74DB74EB74FB750B751B752B753B756B757B758B759
+B75AB75BB75CB75DB75EB75FB761B762B763B765B766B767B769B76AB76BB76C
+B76DB76EB76FB772B774B776B777B778B779B77AB77BB77EB77FB781B782B783
+B785B786B787B788B789B78AB78BB78EB793B794B795B79AB79BB79DB79E0000
+8E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B79FB7A1B7A2B7A3B7A4B7A5B7A6B7A7B7AAB7AEB7AFB7B0B7B1B7B2B7B3
+B7B6B7B7B7B9B7BAB7BBB7BCB7BDB7BEB7BFB7C0B7C100000000000000000000
+0000B7C2B7C3B7C4B7C5B7C6B7C8B7CAB7CBB7CCB7CDB7CEB7CFB7D0B7D1B7D2
+B7D3B7D4B7D5B7D6B7D7B7D8B7D9B7DAB7DBB7DCB7DD00000000000000000000
+0000B7DEB7DFB7E0B7E1B7E2B7E3B7E4B7E5B7E6B7E7B7E8B7E9B7EAB7EBB7EE
+B7EFB7F1B7F2B7F3B7F5B7F6B7F7B7F8B7F9B7FAB7FBB7FEB802B803B804B805
+B806B80AB80BB80DB80EB80FB811B812B813B814B815B816B817B81AB81CB81E
+B81FB820B821B822B823B826B827B829B82AB82BB82DB82EB82FB830B831B832
+B833B836B83AB83BB83CB83DB83EB83FB841B842B843B845B846B847B848B849
+B84AB84BB84CB84DB84EB84FB850B852B854B855B856B857B858B859B85AB85B
+B85EB85FB861B862B863B865B866B867B868B869B86AB86BB86EB870B872B873
+B874B875B876B877B879B87AB87BB87DB87EB87FB880B881B882B883B8840000
+8F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B885B886B887B888B889B88AB88BB88CB88EB88FB890B891B892B893B894
+B895B896B897B898B899B89AB89BB89CB89DB89EB89F00000000000000000000
+0000B8A0B8A1B8A2B8A3B8A4B8A5B8A6B8A7B8A9B8AAB8ABB8ACB8ADB8AEB8AF
+B8B1B8B2B8B3B8B5B8B6B8B7B8B9B8BAB8BBB8BCB8BD00000000000000000000
+0000B8BEB8BFB8C2B8C4B8C6B8C7B8C8B8C9B8CAB8CBB8CDB8CEB8CFB8D1B8D2
+B8D3B8D5B8D6B8D7B8D8B8D9B8DAB8DBB8DCB8DEB8E0B8E2B8E3B8E4B8E5B8E6
+B8E7B8EAB8EBB8EDB8EEB8EFB8F1B8F2B8F3B8F4B8F5B8F6B8F7B8FAB8FCB8FE
+B8FFB900B901B902B903B905B906B907B908B909B90AB90BB90CB90DB90EB90F
+B910B911B912B913B914B915B916B917B919B91AB91BB91CB91DB91EB91FB921
+B922B923B924B925B926B927B928B929B92AB92BB92CB92DB92EB92FB930B931
+B932B933B934B935B936B937B938B939B93AB93BB93EB93FB941B942B943B945
+B946B947B948B949B94AB94BB94DB94EB950B952B953B954B955B956B9570000
+90
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B95AB95BB95DB95EB95FB961B962B963B964B965B966B967B96AB96CB96E
+B96FB970B971B972B973B976B977B979B97AB97BB97D00000000000000000000
+0000B97EB97FB980B981B982B983B986B988B98BB98CB98FB990B991B992B993
+B994B995B996B997B998B999B99AB99BB99CB99DB99E00000000000000000000
+0000B99FB9A0B9A1B9A2B9A3B9A4B9A5B9A6B9A7B9A8B9A9B9AAB9ABB9AEB9AF
+B9B1B9B2B9B3B9B5B9B6B9B7B9B8B9B9B9BAB9BBB9BEB9C0B9C2B9C3B9C4B9C5
+B9C6B9C7B9CAB9CBB9CDB9D3B9D4B9D5B9D6B9D7B9DAB9DCB9DFB9E0B9E2B9E6
+B9E7B9E9B9EAB9EBB9EDB9EEB9EFB9F0B9F1B9F2B9F3B9F6B9FBB9FCB9FDB9FE
+B9FFBA02BA03BA04BA05BA06BA07BA09BA0ABA0BBA0CBA0DBA0EBA0FBA10BA11
+BA12BA13BA14BA16BA17BA18BA19BA1ABA1BBA1CBA1DBA1EBA1FBA20BA21BA22
+BA23BA24BA25BA26BA27BA28BA29BA2ABA2BBA2CBA2DBA2EBA2FBA30BA31BA32
+BA33BA34BA35BA36BA37BA3ABA3BBA3DBA3EBA3FBA41BA43BA44BA45BA460000
+91
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BA47BA4ABA4CBA4FBA50BA51BA52BA56BA57BA59BA5ABA5BBA5DBA5EBA5F
+BA60BA61BA62BA63BA66BA6ABA6BBA6CBA6DBA6EBA6F00000000000000000000
+0000BA72BA73BA75BA76BA77BA79BA7ABA7BBA7CBA7DBA7EBA7FBA80BA81BA82
+BA86BA88BA89BA8ABA8BBA8DBA8EBA8FBA90BA91BA9200000000000000000000
+0000BA93BA94BA95BA96BA97BA98BA99BA9ABA9BBA9CBA9DBA9EBA9FBAA0BAA1
+BAA2BAA3BAA4BAA5BAA6BAA7BAAABAADBAAEBAAFBAB1BAB3BAB4BAB5BAB6BAB7
+BABABABCBABEBABFBAC0BAC1BAC2BAC3BAC5BAC6BAC7BAC9BACABACBBACCBACD
+BACEBACFBAD0BAD1BAD2BAD3BAD4BAD5BAD6BAD7BADABADBBADCBADDBADEBADF
+BAE0BAE1BAE2BAE3BAE4BAE5BAE6BAE7BAE8BAE9BAEABAEBBAECBAEDBAEEBAEF
+BAF0BAF1BAF2BAF3BAF4BAF5BAF6BAF7BAF8BAF9BAFABAFBBAFDBAFEBAFFBB01
+BB02BB03BB05BB06BB07BB08BB09BB0ABB0BBB0CBB0EBB10BB12BB13BB14BB15
+BB16BB17BB19BB1ABB1BBB1DBB1EBB1FBB21BB22BB23BB24BB25BB26BB270000
+92
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BB28BB2ABB2CBB2DBB2EBB2FBB30BB31BB32BB33BB37BB39BB3ABB3FBB40
+BB41BB42BB43BB46BB48BB4ABB4BBB4CBB4EBB51BB5200000000000000000000
+0000BB53BB55BB56BB57BB59BB5ABB5BBB5CBB5DBB5EBB5FBB60BB62BB64BB65
+BB66BB67BB68BB69BB6ABB6BBB6DBB6EBB6FBB70BB7100000000000000000000
+0000BB72BB73BB74BB75BB76BB77BB78BB79BB7ABB7BBB7CBB7DBB7EBB7FBB80
+BB81BB82BB83BB84BB85BB86BB87BB89BB8ABB8BBB8DBB8EBB8FBB91BB92BB93
+BB94BB95BB96BB97BB98BB99BB9ABB9BBB9CBB9DBB9EBB9FBBA0BBA1BBA2BBA3
+BBA5BBA6BBA7BBA9BBAABBABBBADBBAEBBAFBBB0BBB1BBB2BBB3BBB5BBB6BBB8
+BBB9BBBABBBBBBBCBBBDBBBEBBBFBBC1BBC2BBC3BBC5BBC6BBC7BBC9BBCABBCB
+BBCCBBCDBBCEBBCFBBD1BBD2BBD4BBD5BBD6BBD7BBD8BBD9BBDABBDBBBDCBBDD
+BBDEBBDFBBE0BBE1BBE2BBE3BBE4BBE5BBE6BBE7BBE8BBE9BBEABBEBBBECBBED
+BBEEBBEFBBF0BBF1BBF2BBF3BBF4BBF5BBF6BBF7BBFABBFBBBFDBBFEBC010000
+93
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BC03BC04BC05BC06BC07BC0ABC0EBC10BC12BC13BC19BC1ABC20BC21BC22
+BC23BC26BC28BC2ABC2BBC2CBC2EBC2FBC32BC33BC3500000000000000000000
+0000BC36BC37BC39BC3ABC3BBC3CBC3DBC3EBC3FBC42BC46BC47BC48BC4ABC4B
+BC4EBC4FBC51BC52BC53BC54BC55BC56BC57BC58BC5900000000000000000000
+0000BC5ABC5BBC5CBC5EBC5FBC60BC61BC62BC63BC64BC65BC66BC67BC68BC69
+BC6ABC6BBC6CBC6DBC6EBC6FBC70BC71BC72BC73BC74BC75BC76BC77BC78BC79
+BC7ABC7BBC7CBC7DBC7EBC7FBC80BC81BC82BC83BC86BC87BC89BC8ABC8DBC8F
+BC90BC91BC92BC93BC96BC98BC9BBC9CBC9DBC9EBC9FBCA2BCA3BCA5BCA6BCA9
+BCAABCABBCACBCADBCAEBCAFBCB2BCB6BCB7BCB8BCB9BCBABCBBBCBEBCBFBCC1
+BCC2BCC3BCC5BCC6BCC7BCC8BCC9BCCABCCBBCCCBCCEBCD2BCD3BCD4BCD6BCD7
+BCD9BCDABCDBBCDDBCDEBCDFBCE0BCE1BCE2BCE3BCE4BCE5BCE6BCE7BCE8BCE9
+BCEABCEBBCECBCEDBCEEBCEFBCF0BCF1BCF2BCF3BCF7BCF9BCFABCFBBCFD0000
+94
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BCFEBCFFBD00BD01BD02BD03BD06BD08BD0ABD0BBD0CBD0DBD0EBD0FBD11
+BD12BD13BD15BD16BD17BD18BD19BD1ABD1BBD1CBD1D00000000000000000000
+0000BD1EBD1FBD20BD21BD22BD23BD25BD26BD27BD28BD29BD2ABD2BBD2DBD2E
+BD2FBD30BD31BD32BD33BD34BD35BD36BD37BD38BD3900000000000000000000
+0000BD3ABD3BBD3CBD3DBD3EBD3FBD41BD42BD43BD44BD45BD46BD47BD4ABD4B
+BD4DBD4EBD4FBD51BD52BD53BD54BD55BD56BD57BD5ABD5BBD5CBD5DBD5EBD5F
+BD60BD61BD62BD63BD65BD66BD67BD69BD6ABD6BBD6CBD6DBD6EBD6FBD70BD71
+BD72BD73BD74BD75BD76BD77BD78BD79BD7ABD7BBD7CBD7DBD7EBD7FBD82BD83
+BD85BD86BD8BBD8CBD8DBD8EBD8FBD92BD94BD96BD97BD98BD9BBD9DBD9EBD9F
+BDA0BDA1BDA2BDA3BDA5BDA6BDA7BDA8BDA9BDAABDABBDACBDADBDAEBDAFBDB1
+BDB2BDB3BDB4BDB5BDB6BDB7BDB9BDBABDBBBDBCBDBDBDBEBDBFBDC0BDC1BDC2
+BDC3BDC4BDC5BDC6BDC7BDC8BDC9BDCABDCBBDCCBDCDBDCEBDCFBDD0BDD10000
+95
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BDD2BDD3BDD6BDD7BDD9BDDABDDBBDDDBDDEBDDFBDE0BDE1BDE2BDE3BDE4
+BDE5BDE6BDE7BDE8BDEABDEBBDECBDEDBDEEBDEFBDF100000000000000000000
+0000BDF2BDF3BDF5BDF6BDF7BDF9BDFABDFBBDFCBDFDBDFEBDFFBE01BE02BE04
+BE06BE07BE08BE09BE0ABE0BBE0EBE0FBE11BE12BE1300000000000000000000
+0000BE15BE16BE17BE18BE19BE1ABE1BBE1EBE20BE21BE22BE23BE24BE25BE26
+BE27BE28BE29BE2ABE2BBE2CBE2DBE2EBE2FBE30BE31BE32BE33BE34BE35BE36
+BE37BE38BE39BE3ABE3BBE3CBE3DBE3EBE3FBE40BE41BE42BE43BE46BE47BE49
+BE4ABE4BBE4DBE4FBE50BE51BE52BE53BE56BE58BE5CBE5DBE5EBE5FBE62BE63
+BE65BE66BE67BE69BE6BBE6CBE6DBE6EBE6FBE72BE76BE77BE78BE79BE7ABE7E
+BE7FBE81BE82BE83BE85BE86BE87BE88BE89BE8ABE8BBE8EBE92BE93BE94BE95
+BE96BE97BE9ABE9BBE9CBE9DBE9EBE9FBEA0BEA1BEA2BEA3BEA4BEA5BEA6BEA7
+BEA9BEAABEABBEACBEADBEAEBEAFBEB0BEB1BEB2BEB3BEB4BEB5BEB6BEB70000
+96
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BEB8BEB9BEBABEBBBEBCBEBDBEBEBEBFBEC0BEC1BEC2BEC3BEC4BEC5BEC6
+BEC7BEC8BEC9BECABECBBECCBECDBECEBECFBED2BED300000000000000000000
+0000BED5BED6BED9BEDABEDBBEDCBEDDBEDEBEDFBEE1BEE2BEE6BEE7BEE8BEE9
+BEEABEEBBEEDBEEEBEEFBEF0BEF1BEF2BEF3BEF4BEF500000000000000000000
+0000BEF6BEF7BEF8BEF9BEFABEFBBEFCBEFDBEFEBEFFBF00BF02BF03BF04BF05
+BF06BF07BF0ABF0BBF0CBF0DBF0EBF0FBF10BF11BF12BF13BF14BF15BF16BF17
+BF1ABF1EBF1FBF20BF21BF22BF23BF24BF25BF26BF27BF28BF29BF2ABF2BBF2C
+BF2DBF2EBF2FBF30BF31BF32BF33BF34BF35BF36BF37BF38BF39BF3ABF3BBF3C
+BF3DBF3EBF3FBF42BF43BF45BF46BF47BF49BF4ABF4BBF4CBF4DBF4EBF4FBF52
+BF53BF54BF56BF57BF58BF59BF5ABF5BBF5CBF5DBF5EBF5FBF60BF61BF62BF63
+BF64BF65BF66BF67BF68BF69BF6ABF6BBF6CBF6DBF6EBF6FBF70BF71BF72BF73
+BF74BF75BF76BF77BF78BF79BF7ABF7BBF7CBF7DBF7EBF7FBF80BF81BF820000
+97
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BF83BF84BF85BF86BF87BF88BF89BF8ABF8BBF8CBF8DBF8EBF8FBF90BF91
+BF92BF93BF95BF96BF97BF98BF99BF9ABF9BBF9CBF9D00000000000000000000
+0000BF9EBF9FBFA0BFA1BFA2BFA3BFA4BFA5BFA6BFA7BFA8BFA9BFAABFABBFAC
+BFADBFAEBFAFBFB1BFB2BFB3BFB4BFB5BFB6BFB7BFB800000000000000000000
+0000BFB9BFBABFBBBFBCBFBDBFBEBFBFBFC0BFC1BFC2BFC3BFC4BFC6BFC7BFC8
+BFC9BFCABFCBBFCEBFCFBFD1BFD2BFD3BFD5BFD6BFD7BFD8BFD9BFDABFDBBFDD
+BFDEBFE0BFE2BFE3BFE4BFE5BFE6BFE7BFE8BFE9BFEABFEBBFECBFEDBFEEBFEF
+BFF0BFF1BFF2BFF3BFF4BFF5BFF6BFF7BFF8BFF9BFFABFFBBFFCBFFDBFFEBFFF
+C000C001C002C003C004C005C006C007C008C009C00AC00BC00CC00DC00EC00F
+C010C011C012C013C014C015C016C017C018C019C01AC01BC01CC01DC01EC01F
+C020C021C022C023C024C025C026C027C028C029C02AC02BC02CC02DC02EC02F
+C030C031C032C033C034C035C036C037C038C039C03AC03BC03DC03EC03F0000
+98
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C040C041C042C043C044C045C046C047C048C049C04AC04BC04CC04DC04E
+C04FC050C052C053C054C055C056C057C059C05AC05B00000000000000000000
+0000C05DC05EC05FC061C062C063C064C065C066C067C06AC06BC06CC06DC06E
+C06FC070C071C072C073C074C075C076C077C078C07900000000000000000000
+0000C07AC07BC07CC07DC07EC07FC080C081C082C083C084C085C086C087C088
+C089C08AC08BC08CC08DC08EC08FC092C093C095C096C097C099C09AC09BC09C
+C09DC09EC09FC0A2C0A4C0A6C0A7C0A8C0A9C0AAC0ABC0AEC0B1C0B2C0B7C0B8
+C0B9C0BAC0BBC0BEC0C2C0C3C0C4C0C6C0C7C0CAC0CBC0CDC0CEC0CFC0D1C0D2
+C0D3C0D4C0D5C0D6C0D7C0DAC0DEC0DFC0E0C0E1C0E2C0E3C0E6C0E7C0E9C0EA
+C0EBC0EDC0EEC0EFC0F0C0F1C0F2C0F3C0F6C0F8C0FAC0FBC0FCC0FDC0FEC0FF
+C101C102C103C105C106C107C109C10AC10BC10CC10DC10EC10FC111C112C113
+C114C116C117C118C119C11AC11BC121C122C125C128C129C12AC12BC12E0000
+99
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C132C133C134C135C137C13AC13BC13DC13EC13FC141C142C143C144C145
+C146C147C14AC14EC14FC150C151C152C153C156C15700000000000000000000
+0000C159C15AC15BC15DC15EC15FC160C161C162C163C166C16AC16BC16CC16D
+C16EC16FC171C172C173C175C176C177C179C17AC17B00000000000000000000
+0000C17CC17DC17EC17FC180C181C182C183C184C186C187C188C189C18AC18B
+C18FC191C192C193C195C197C198C199C19AC19BC19EC1A0C1A2C1A3C1A4C1A6
+C1A7C1AAC1ABC1ADC1AEC1AFC1B1C1B2C1B3C1B4C1B5C1B6C1B7C1B8C1B9C1BA
+C1BBC1BCC1BEC1BFC1C0C1C1C1C2C1C3C1C5C1C6C1C7C1C9C1CAC1CBC1CDC1CE
+C1CFC1D0C1D1C1D2C1D3C1D5C1D6C1D9C1DAC1DBC1DCC1DDC1DEC1DFC1E1C1E2
+C1E3C1E5C1E6C1E7C1E9C1EAC1EBC1ECC1EDC1EEC1EFC1F2C1F4C1F5C1F6C1F7
+C1F8C1F9C1FAC1FBC1FEC1FFC201C202C203C205C206C207C208C209C20AC20B
+C20EC210C212C213C214C215C216C217C21AC21BC21DC21EC221C222C2230000
+9A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C224C225C226C227C22AC22CC22EC230C233C235C236C237C238C239C23A
+C23BC23CC23DC23EC23FC240C241C242C243C244C24500000000000000000000
+0000C246C247C249C24AC24BC24CC24DC24EC24FC252C253C255C256C257C259
+C25AC25BC25CC25DC25EC25FC261C262C263C264C26600000000000000000000
+0000C267C268C269C26AC26BC26EC26FC271C272C273C275C276C277C278C279
+C27AC27BC27EC280C282C283C284C285C286C287C28AC28BC28CC28DC28EC28F
+C291C292C293C294C295C296C297C299C29AC29CC29EC29FC2A0C2A1C2A2C2A3
+C2A6C2A7C2A9C2AAC2ABC2AEC2AFC2B0C2B1C2B2C2B3C2B6C2B8C2BAC2BBC2BC
+C2BDC2BEC2BFC2C0C2C1C2C2C2C3C2C4C2C5C2C6C2C7C2C8C2C9C2CAC2CBC2CC
+C2CDC2CEC2CFC2D0C2D1C2D2C2D3C2D4C2D5C2D6C2D7C2D8C2D9C2DAC2DBC2DE
+C2DFC2E1C2E2C2E5C2E6C2E7C2E8C2E9C2EAC2EEC2F0C2F2C2F3C2F4C2F5C2F7
+C2FAC2FDC2FEC2FFC301C302C303C304C305C306C307C30AC30BC30EC30F0000
+9B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C310C311C312C316C317C319C31AC31BC31DC31EC31FC320C321C322C323
+C326C327C32AC32BC32CC32DC32EC32FC330C331C33200000000000000000000
+0000C333C334C335C336C337C338C339C33AC33BC33CC33DC33EC33FC340C341
+C342C343C344C346C347C348C349C34AC34BC34CC34D00000000000000000000
+0000C34EC34FC350C351C352C353C354C355C356C357C358C359C35AC35BC35C
+C35DC35EC35FC360C361C362C363C364C365C366C367C36AC36BC36DC36EC36F
+C371C373C374C375C376C377C37AC37BC37EC37FC380C381C382C383C385C386
+C387C389C38AC38BC38DC38EC38FC390C391C392C393C394C395C396C397C398
+C399C39AC39BC39CC39DC39EC39FC3A0C3A1C3A2C3A3C3A4C3A5C3A6C3A7C3A8
+C3A9C3AAC3ABC3ACC3ADC3AEC3AFC3B0C3B1C3B2C3B3C3B4C3B5C3B6C3B7C3B8
+C3B9C3BAC3BBC3BCC3BDC3BEC3BFC3C1C3C2C3C3C3C4C3C5C3C6C3C7C3C8C3C9
+C3CAC3CBC3CCC3CDC3CEC3CFC3D0C3D1C3D2C3D3C3D4C3D5C3D6C3D7C3DA0000
+9C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C3DBC3DDC3DEC3E1C3E3C3E4C3E5C3E6C3E7C3EAC3EBC3ECC3EEC3EFC3F0
+C3F1C3F2C3F3C3F6C3F7C3F9C3FAC3FBC3FCC3FDC3FE00000000000000000000
+0000C3FFC400C401C402C403C404C405C406C407C409C40AC40BC40CC40DC40E
+C40FC411C412C413C414C415C416C417C418C419C41A00000000000000000000
+0000C41BC41CC41DC41EC41FC420C421C422C423C425C426C427C428C429C42A
+C42BC42DC42EC42FC431C432C433C435C436C437C438C439C43AC43BC43EC43F
+C440C441C442C443C444C445C446C447C449C44AC44BC44CC44DC44EC44FC450
+C451C452C453C454C455C456C457C458C459C45AC45BC45CC45DC45EC45FC460
+C461C462C463C466C467C469C46AC46BC46DC46EC46FC470C471C472C473C476
+C477C478C47AC47BC47CC47DC47EC47FC481C482C483C484C485C486C487C488
+C489C48AC48BC48CC48DC48EC48FC490C491C492C493C495C496C497C498C499
+C49AC49BC49DC49EC49FC4A0C4A1C4A2C4A3C4A4C4A5C4A6C4A7C4A8C4A90000
+9D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C4AAC4ABC4ACC4ADC4AEC4AFC4B0C4B1C4B2C4B3C4B4C4B5C4B6C4B7C4B9
+C4BAC4BBC4BDC4BEC4BFC4C0C4C1C4C2C4C3C4C4C4C500000000000000000000
+0000C4C6C4C7C4C8C4C9C4CAC4CBC4CCC4CDC4CEC4CFC4D0C4D1C4D2C4D3C4D4
+C4D5C4D6C4D7C4D8C4D9C4DAC4DBC4DCC4DDC4DEC4DF00000000000000000000
+0000C4E0C4E1C4E2C4E3C4E4C4E5C4E6C4E7C4E8C4EAC4EBC4ECC4EDC4EEC4EF
+C4F2C4F3C4F5C4F6C4F7C4F9C4FBC4FCC4FDC4FEC502C503C504C505C506C507
+C508C509C50AC50BC50DC50EC50FC511C512C513C515C516C517C518C519C51A
+C51BC51DC51EC51FC520C521C522C523C524C525C526C527C52AC52BC52DC52E
+C52FC531C532C533C534C535C536C537C53AC53CC53EC53FC540C541C542C543
+C546C547C54BC54FC550C551C552C556C55AC55BC55CC55FC562C563C565C566
+C567C569C56AC56BC56CC56DC56EC56FC572C576C577C578C579C57AC57BC57E
+C57FC581C582C583C585C586C588C589C58AC58BC58EC590C592C593C5940000
+9E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C596C599C59AC59BC59DC59EC59FC5A1C5A2C5A3C5A4C5A5C5A6C5A7C5A8
+C5AAC5ABC5ACC5ADC5AEC5AFC5B0C5B1C5B2C5B3C5B600000000000000000000
+0000C5B7C5BAC5BFC5C0C5C1C5C2C5C3C5CBC5CDC5CFC5D2C5D3C5D5C5D6C5D7
+C5D9C5DAC5DBC5DCC5DDC5DEC5DFC5E2C5E4C5E6C5E700000000000000000000
+0000C5E8C5E9C5EAC5EBC5EFC5F1C5F2C5F3C5F5C5F8C5F9C5FAC5FBC602C603
+C604C609C60AC60BC60DC60EC60FC611C612C613C614C615C616C617C61AC61D
+C61EC61FC620C621C622C623C626C627C629C62AC62BC62FC631C632C636C638
+C63AC63CC63DC63EC63FC642C643C645C646C647C649C64AC64BC64CC64DC64E
+C64FC652C656C657C658C659C65AC65BC65EC65FC661C662C663C664C665C666
+C667C668C669C66AC66BC66DC66EC670C672C673C674C675C676C677C67AC67B
+C67DC67EC67FC681C682C683C684C685C686C687C68AC68CC68EC68FC690C691
+C692C693C696C697C699C69AC69BC69DC69EC69FC6A0C6A1C6A2C6A3C6A60000
+9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C6A8C6AAC6ABC6ACC6ADC6AEC6AFC6B2C6B3C6B5C6B6C6B7C6BBC6BCC6BD
+C6BEC6BFC6C2C6C4C6C6C6C7C6C8C6C9C6CAC6CBC6CE00000000000000000000
+0000C6CFC6D1C6D2C6D3C6D5C6D6C6D7C6D8C6D9C6DAC6DBC6DEC6DFC6E2C6E3
+C6E4C6E5C6E6C6E7C6EAC6EBC6EDC6EEC6EFC6F1C6F200000000000000000000
+0000C6F3C6F4C6F5C6F6C6F7C6FAC6FBC6FCC6FEC6FFC700C701C702C703C706
+C707C709C70AC70BC70DC70EC70FC710C711C712C713C716C718C71AC71BC71C
+C71DC71EC71FC722C723C725C726C727C729C72AC72BC72CC72DC72EC72FC732
+C734C736C738C739C73AC73BC73EC73FC741C742C743C745C746C747C748C749
+C74BC74EC750C759C75AC75BC75DC75EC75FC761C762C763C764C765C766C767
+C769C76AC76CC76DC76EC76FC770C771C772C773C776C777C779C77AC77BC77F
+C780C781C782C786C78BC78CC78DC78FC792C793C795C799C79BC79CC79DC79E
+C79FC7A2C7A7C7A8C7A9C7AAC7ABC7AEC7AFC7B1C7B2C7B3C7B5C7B6C7B70000
+A0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C7B8C7B9C7BAC7BBC7BEC7C2C7C3C7C4C7C5C7C6C7C7C7CAC7CBC7CDC7CF
+C7D1C7D2C7D3C7D4C7D5C7D6C7D7C7D9C7DAC7DBC7DC00000000000000000000
+0000C7DEC7DFC7E0C7E1C7E2C7E3C7E5C7E6C7E7C7E9C7EAC7EBC7EDC7EEC7EF
+C7F0C7F1C7F2C7F3C7F4C7F5C7F6C7F7C7F8C7F9C7FA00000000000000000000
+0000C7FBC7FCC7FDC7FEC7FFC802C803C805C806C807C809C80BC80CC80DC80E
+C80FC812C814C817C818C819C81AC81BC81EC81FC821C822C823C825C826C827
+C828C829C82AC82BC82EC830C832C833C834C835C836C837C839C83AC83BC83D
+C83EC83FC841C842C843C844C845C846C847C84AC84BC84EC84FC850C851C852
+C853C855C856C857C858C859C85AC85BC85CC85DC85EC85FC860C861C862C863
+C864C865C866C867C868C869C86AC86BC86CC86DC86EC86FC872C873C875C876
+C877C879C87BC87CC87DC87EC87FC882C884C888C889C88AC88EC88FC890C891
+C892C893C895C896C897C898C899C89AC89BC89CC89EC8A0C8A2C8A3C8A40000
+A1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C8A5C8A6C8A7C8A9C8AAC8ABC8ACC8ADC8AEC8AFC8B0C8B1C8B2C8B3C8B4
+C8B5C8B6C8B7C8B8C8B9C8BAC8BBC8BEC8BFC8C0C8C100000000000000000000
+0000C8C2C8C3C8C5C8C6C8C7C8C9C8CAC8CBC8CDC8CEC8CFC8D0C8D1C8D2C8D3
+C8D6C8D8C8DAC8DBC8DCC8DDC8DEC8DFC8E2C8E3C8E500000000000000000000
+0000C8E6C8E7C8E8C8E9C8EAC8EBC8ECC8EDC8EEC8EFC8F0C8F1C8F2C8F3C8F4
+C8F6C8F7C8F8C8F9C8FAC8FBC8FEC8FFC901C902C903C907C908C909C90AC90B
+C90E30003001300200B72025202600A8300300AD20152225FF3C223C20182019
+201C201D3014301530083009300A300B300C300D300E300F3010301100B100D7
+00F7226022642265221E223400B0203220332103212BFFE0FFE1FFE526422640
+222022A52312220222072261225200A7203B2606260525CB25CF25CE25C725C6
+25A125A025B325B225BD25BC219221902191219321943013226A226B221A223D
+221D2235222B222C2208220B2286228722822283222A222922272228FFE20000
+A2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C910C912C913C914C915C916C917C919C91AC91BC91CC91DC91EC91FC920
+C921C922C923C924C925C926C927C928C929C92AC92B00000000000000000000
+0000C92DC92EC92FC930C931C932C933C935C936C937C938C939C93AC93BC93C
+C93DC93EC93FC940C941C942C943C944C945C946C94700000000000000000000
+0000C948C949C94AC94BC94CC94DC94EC94FC952C953C955C956C957C959C95A
+C95BC95CC95DC95EC95FC962C964C965C966C967C968C969C96AC96BC96DC96E
+C96F21D221D42200220300B4FF5E02C702D802DD02DA02D900B802DB00A100BF
+02D0222E2211220F00A42109203025C125C025B725B626642660266126652667
+2663229925C825A325D025D1259225A425A525A825A725A625A92668260F260E
+261C261E00B62020202121952197219921962198266D2669266A266C327F321C
+211633C7212233C233D821210000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C971C972C973C975C976C977C978C979C97AC97BC97DC97EC97FC980C981
+C982C983C984C985C986C987C98AC98BC98DC98EC98F00000000000000000000
+0000C991C992C993C994C995C996C997C99AC99CC99EC99FC9A0C9A1C9A2C9A3
+C9A4C9A5C9A6C9A7C9A8C9A9C9AAC9ABC9ACC9ADC9AE00000000000000000000
+0000C9AFC9B0C9B1C9B2C9B3C9B4C9B5C9B6C9B7C9B8C9B9C9BAC9BBC9BCC9BD
+C9BEC9BFC9C2C9C3C9C5C9C6C9C9C9CBC9CCC9CDC9CEC9CFC9D2C9D4C9D7C9D8
+C9DBFF01FF02FF03FF04FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F
+FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFFE6FF3DFF3EFF3F
+FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000
+A4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C9DEC9DFC9E1C9E3C9E5C9E6C9E8C9E9C9EAC9EBC9EEC9F2C9F3C9F4C9F5
+C9F6C9F7C9FAC9FBC9FDC9FEC9FFCA01CA02CA03CA0400000000000000000000
+0000CA05CA06CA07CA0ACA0ECA0FCA10CA11CA12CA13CA15CA16CA17CA19CA1A
+CA1BCA1CCA1DCA1ECA1FCA20CA21CA22CA23CA24CA2500000000000000000000
+0000CA26CA27CA28CA2ACA2BCA2CCA2DCA2ECA2FCA30CA31CA32CA33CA34CA35
+CA36CA37CA38CA39CA3ACA3BCA3CCA3DCA3ECA3FCA40CA41CA42CA43CA44CA45
+CA46313131323133313431353136313731383139313A313B313C313D313E313F
+3140314131423143314431453146314731483149314A314B314C314D314E314F
+3150315131523153315431553156315731583159315A315B315C315D315E315F
+3160316131623163316431653166316731683169316A316B316C316D316E316F
+3170317131723173317431753176317731783179317A317B317C317D317E317F
+3180318131823183318431853186318731883189318A318B318C318D318E0000
+A5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CA47CA48CA49CA4ACA4BCA4ECA4FCA51CA52CA53CA55CA56CA57CA58CA59
+CA5ACA5BCA5ECA62CA63CA64CA65CA66CA67CA69CA6A00000000000000000000
+0000CA6BCA6CCA6DCA6ECA6FCA70CA71CA72CA73CA74CA75CA76CA77CA78CA79
+CA7ACA7BCA7CCA7ECA7FCA80CA81CA82CA83CA85CA8600000000000000000000
+0000CA87CA88CA89CA8ACA8BCA8CCA8DCA8ECA8FCA90CA91CA92CA93CA94CA95
+CA96CA97CA99CA9ACA9BCA9CCA9DCA9ECA9FCAA0CAA1CAA2CAA3CAA4CAA5CAA6
+CAA7217021712172217321742175217621772178217900000000000000000000
+2160216121622163216421652166216721682169000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+A6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CAA8CAA9CAAACAABCAACCAADCAAECAAFCAB0CAB1CAB2CAB3CAB4CAB5CAB6
+CAB7CAB8CAB9CABACABBCABECABFCAC1CAC2CAC3CAC500000000000000000000
+0000CAC6CAC7CAC8CAC9CACACACBCACECAD0CAD2CAD4CAD5CAD6CAD7CADACADB
+CADCCADDCADECADFCAE1CAE2CAE3CAE4CAE5CAE6CAE700000000000000000000
+0000CAE8CAE9CAEACAEBCAEDCAEECAEFCAF0CAF1CAF2CAF3CAF5CAF6CAF7CAF8
+CAF9CAFACAFBCAFCCAFDCAFECAFFCB00CB01CB02CB03CB04CB05CB06CB07CB09
+CB0A25002502250C251025182514251C252C25242534253C25012503250F2513
+251B251725232533252B253B254B2520252F25282537253F251D253025252538
+254225122511251A251925162515250E250D251E251F25212522252625272529
+252A252D252E25312532253525362539253A253D253E25402541254325442545
+2546254725482549254A00000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CB0BCB0CCB0DCB0ECB0FCB11CB12CB13CB15CB16CB17CB19CB1ACB1BCB1C
+CB1DCB1ECB1FCB22CB23CB24CB25CB26CB27CB28CB2900000000000000000000
+0000CB2ACB2BCB2CCB2DCB2ECB2FCB30CB31CB32CB33CB34CB35CB36CB37CB38
+CB39CB3ACB3BCB3CCB3DCB3ECB3FCB40CB42CB43CB4400000000000000000000
+0000CB45CB46CB47CB4ACB4BCB4DCB4ECB4FCB51CB52CB53CB54CB55CB56CB57
+CB5ACB5BCB5CCB5ECB5FCB60CB61CB62CB63CB65CB66CB67CB68CB69CB6ACB6B
+CB6C3395339633972113339833C433A333A433A533A63399339A339B339C339D
+339E339F33A033A133A233CA338D338E338F33CF3388338933C833A733A833B0
+33B133B233B333B433B533B633B733B833B93380338133823383338433BA33BB
+33BC33BD33BE33BF33903391339233933394212633C033C1338A338B338C33D6
+33C533AD33AE33AF33DB33A933AA33AB33AC33DD33D033D333C333C933DC33C6
+0000000000000000000000000000000000000000000000000000000000000000
+A8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CB6DCB6ECB6FCB70CB71CB72CB73CB74CB75CB76CB77CB7ACB7BCB7CCB7D
+CB7ECB7FCB80CB81CB82CB83CB84CB85CB86CB87CB8800000000000000000000
+0000CB89CB8ACB8BCB8CCB8DCB8ECB8FCB90CB91CB92CB93CB94CB95CB96CB97
+CB98CB99CB9ACB9BCB9DCB9ECB9FCBA0CBA1CBA2CBA300000000000000000000
+0000CBA4CBA5CBA6CBA7CBA8CBA9CBAACBABCBACCBADCBAECBAFCBB0CBB1CBB2
+CBB3CBB4CBB5CBB6CBB7CBB9CBBACBBBCBBCCBBDCBBECBBFCBC0CBC1CBC2CBC3
+CBC400C600D000AA0126000001320000013F014100D8015200BA00DE0166014A
+00003260326132623263326432653266326732683269326A326B326C326D326E
+326F3270327132723273327432753276327732783279327A327B24D024D124D2
+24D324D424D524D624D724D824D924DA24DB24DC24DD24DE24DF24E024E124E2
+24E324E424E524E624E724E824E9246024612462246324642465246624672468
+2469246A246B246C246D246E00BD2153215400BC00BE215B215C215D215E0000
+A9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CBC5CBC6CBC7CBC8CBC9CBCACBCBCBCCCBCDCBCECBCFCBD0CBD1CBD2CBD3
+CBD5CBD6CBD7CBD8CBD9CBDACBDBCBDCCBDDCBDECBDF00000000000000000000
+0000CBE0CBE1CBE2CBE3CBE5CBE6CBE8CBEACBEBCBECCBEDCBEECBEFCBF0CBF1
+CBF2CBF3CBF4CBF5CBF6CBF7CBF8CBF9CBFACBFBCBFC00000000000000000000
+0000CBFDCBFECBFFCC00CC01CC02CC03CC04CC05CC06CC07CC08CC09CC0ACC0B
+CC0ECC0FCC11CC12CC13CC15CC16CC17CC18CC19CC1ACC1BCC1ECC1FCC20CC23
+CC2400E6011100F001270131013301380140014200F8015300DF00FE0167014B
+01493200320132023203320432053206320732083209320A320B320C320D320E
+320F3210321132123213321432153216321732183219321A321B249C249D249E
+249F24A024A124A224A324A424A524A624A724A824A924AA24AB24AC24AD24AE
+24AF24B024B124B224B324B424B5247424752476247724782479247A247B247C
+247D247E247F24802481248200B900B200B32074207F20812082208320840000
+AA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CC25CC26CC2ACC2BCC2DCC2FCC31CC32CC33CC34CC35CC36CC37CC3ACC3F
+CC40CC41CC42CC43CC46CC47CC49CC4ACC4BCC4DCC4E00000000000000000000
+0000CC4FCC50CC51CC52CC53CC56CC5ACC5BCC5CCC5DCC5ECC5FCC61CC62CC63
+CC65CC67CC69CC6ACC6BCC6CCC6DCC6ECC6FCC71CC7200000000000000000000
+0000CC73CC74CC76CC77CC78CC79CC7ACC7BCC7CCC7DCC7ECC7FCC80CC81CC82
+CC83CC84CC85CC86CC87CC88CC89CC8ACC8BCC8CCC8DCC8ECC8FCC90CC91CC92
+CC93304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+AB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CC94CC95CC96CC97CC9ACC9BCC9DCC9ECC9FCCA1CCA2CCA3CCA4CCA5CCA6
+CCA7CCAACCAECCAFCCB0CCB1CCB2CCB3CCB6CCB7CCB900000000000000000000
+0000CCBACCBBCCBDCCBECCBFCCC0CCC1CCC2CCC3CCC6CCC8CCCACCCBCCCCCCCD
+CCCECCCFCCD1CCD2CCD3CCD5CCD6CCD7CCD8CCD9CCDA00000000000000000000
+0000CCDBCCDCCCDDCCDECCDFCCE0CCE1CCE2CCE3CCE5CCE6CCE7CCE8CCE9CCEA
+CCEBCCEDCCEECCEFCCF1CCF2CCF3CCF4CCF5CCF6CCF7CCF8CCF9CCFACCFBCCFC
+CCFD30A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+AC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CCFECCFFCD00CD02CD03CD04CD05CD06CD07CD0ACD0BCD0DCD0ECD0FCD11
+CD12CD13CD14CD15CD16CD17CD1ACD1CCD1ECD1FCD2000000000000000000000
+0000CD21CD22CD23CD25CD26CD27CD29CD2ACD2BCD2DCD2ECD2FCD30CD31CD32
+CD33CD34CD35CD36CD37CD38CD3ACD3BCD3CCD3DCD3E00000000000000000000
+0000CD3FCD40CD41CD42CD43CD44CD45CD46CD47CD48CD49CD4ACD4BCD4CCD4D
+CD4ECD4FCD50CD51CD52CD53CD54CD55CD56CD57CD58CD59CD5ACD5BCD5DCD5E
+CD5F04100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+AD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CD61CD62CD63CD65CD66CD67CD68CD69CD6ACD6BCD6ECD70CD72CD73CD74
+CD75CD76CD77CD79CD7ACD7BCD7CCD7DCD7ECD7FCD8000000000000000000000
+0000CD81CD82CD83CD84CD85CD86CD87CD89CD8ACD8BCD8CCD8DCD8ECD8FCD90
+CD91CD92CD93CD96CD97CD99CD9ACD9BCD9DCD9ECD9F00000000000000000000
+0000CDA0CDA1CDA2CDA3CDA6CDA8CDAACDABCDACCDADCDAECDAFCDB1CDB2CDB3
+CDB4CDB5CDB6CDB7CDB8CDB9CDBACDBBCDBCCDBDCDBECDBFCDC0CDC1CDC2CDC3
+CDC5000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+AE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CDC6CDC7CDC8CDC9CDCACDCBCDCDCDCECDCFCDD1CDD2CDD3CDD4CDD5CDD6
+CDD7CDD8CDD9CDDACDDBCDDCCDDDCDDECDDFCDE0CDE100000000000000000000
+0000CDE2CDE3CDE4CDE5CDE6CDE7CDE9CDEACDEBCDEDCDEECDEFCDF1CDF2CDF3
+CDF4CDF5CDF6CDF7CDFACDFCCDFECDFFCE00CE01CE0200000000000000000000
+0000CE03CE05CE06CE07CE09CE0ACE0BCE0DCE0ECE0FCE10CE11CE12CE13CE15
+CE16CE17CE18CE1ACE1BCE1CCE1DCE1ECE1FCE22CE23CE25CE26CE27CE29CE2A
+CE2B000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+AF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CE2CCE2DCE2ECE2FCE32CE34CE36CE37CE38CE39CE3ACE3BCE3CCE3DCE3E
+CE3FCE40CE41CE42CE43CE44CE45CE46CE47CE48CE4900000000000000000000
+0000CE4ACE4BCE4CCE4DCE4ECE4FCE50CE51CE52CE53CE54CE55CE56CE57CE5A
+CE5BCE5DCE5ECE62CE63CE64CE65CE66CE67CE6ACE6C00000000000000000000
+0000CE6ECE6FCE70CE71CE72CE73CE76CE77CE79CE7ACE7BCE7DCE7ECE7FCE80
+CE81CE82CE83CE86CE88CE8ACE8BCE8CCE8DCE8ECE8FCE92CE93CE95CE96CE97
+CE99000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+B0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CE9ACE9BCE9CCE9DCE9ECE9FCEA2CEA6CEA7CEA8CEA9CEAACEABCEAECEAF
+CEB0CEB1CEB2CEB3CEB4CEB5CEB6CEB7CEB8CEB9CEBA00000000000000000000
+0000CEBBCEBCCEBDCEBECEBFCEC0CEC2CEC3CEC4CEC5CEC6CEC7CEC8CEC9CECA
+CECBCECCCECDCECECECFCED0CED1CED2CED3CED4CED500000000000000000000
+0000CED6CED7CED8CED9CEDACEDBCEDCCEDDCEDECEDFCEE0CEE1CEE2CEE3CEE6
+CEE7CEE9CEEACEEDCEEECEEFCEF0CEF1CEF2CEF3CEF6CEFACEFBCEFCCEFDCEFE
+CEFFAC00AC01AC04AC07AC08AC09AC0AAC10AC11AC12AC13AC14AC15AC16AC17
+AC19AC1AAC1BAC1CAC1DAC20AC24AC2CAC2DAC2FAC30AC31AC38AC39AC3CAC40
+AC4BAC4DAC54AC58AC5CAC70AC71AC74AC77AC78AC7AAC80AC81AC83AC84AC85
+AC86AC89AC8AAC8BAC8CAC90AC94AC9CAC9DAC9FACA0ACA1ACA8ACA9ACAAACAC
+ACAFACB0ACB8ACB9ACBBACBCACBDACC1ACC4ACC8ACCCACD5ACD7ACE0ACE1ACE4
+ACE7ACE8ACEAACECACEFACF0ACF1ACF3ACF5ACF6ACFCACFDAD00AD04AD060000
+B1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CF02CF03CF05CF06CF07CF09CF0ACF0BCF0CCF0DCF0ECF0FCF12CF14CF16
+CF17CF18CF19CF1ACF1BCF1DCF1ECF1FCF21CF22CF2300000000000000000000
+0000CF25CF26CF27CF28CF29CF2ACF2BCF2ECF32CF33CF34CF35CF36CF37CF39
+CF3ACF3BCF3CCF3DCF3ECF3FCF40CF41CF42CF43CF4400000000000000000000
+0000CF45CF46CF47CF48CF49CF4ACF4BCF4CCF4DCF4ECF4FCF50CF51CF52CF53
+CF56CF57CF59CF5ACF5BCF5DCF5ECF5FCF60CF61CF62CF63CF66CF68CF6ACF6B
+CF6CAD0CAD0DAD0FAD11AD18AD1CAD20AD29AD2CAD2DAD34AD35AD38AD3CAD44
+AD45AD47AD49AD50AD54AD58AD61AD63AD6CAD6DAD70AD73AD74AD75AD76AD7B
+AD7CAD7DAD7FAD81AD82AD88AD89AD8CAD90AD9CAD9DADA4ADB7ADC0ADC1ADC4
+ADC8ADD0ADD1ADD3ADDCADE0ADE4ADF8ADF9ADFCADFFAE00AE01AE08AE09AE0B
+AE0DAE14AE30AE31AE34AE37AE38AE3AAE40AE41AE43AE45AE46AE4AAE4CAE4D
+AE4EAE50AE54AE56AE5CAE5DAE5FAE60AE61AE65AE68AE69AE6CAE70AE780000
+B2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CF6DCF6ECF6FCF72CF73CF75CF76CF77CF79CF7ACF7BCF7CCF7DCF7ECF7F
+CF81CF82CF83CF84CF86CF87CF88CF89CF8ACF8BCF8D00000000000000000000
+0000CF8ECF8FCF90CF91CF92CF93CF94CF95CF96CF97CF98CF99CF9ACF9BCF9C
+CF9DCF9ECF9FCFA0CFA2CFA3CFA4CFA5CFA6CFA7CFA900000000000000000000
+0000CFAACFABCFACCFADCFAECFAFCFB1CFB2CFB3CFB4CFB5CFB6CFB7CFB8CFB9
+CFBACFBBCFBCCFBDCFBECFBFCFC0CFC1CFC2CFC3CFC5CFC6CFC7CFC8CFC9CFCA
+CFCBAE79AE7BAE7CAE7DAE84AE85AE8CAEBCAEBDAEBEAEC0AEC4AECCAECDAECF
+AED0AED1AED8AED9AEDCAEE8AEEBAEEDAEF4AEF8AEFCAF07AF08AF0DAF10AF2C
+AF2DAF30AF32AF34AF3CAF3DAF3FAF41AF42AF43AF48AF49AF50AF5CAF5DAF64
+AF65AF79AF80AF84AF88AF90AF91AF95AF9CAFB8AFB9AFBCAFC0AFC7AFC8AFC9
+AFCBAFCDAFCEAFD4AFDCAFE8AFE9AFF0AFF1AFF4AFF8B000B001B004B00CB010
+B014B01CB01DB028B044B045B048B04AB04CB04EB053B054B055B057B0590000
+B3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CFCCCFCDCFCECFCFCFD0CFD1CFD2CFD3CFD4CFD5CFD6CFD7CFD8CFD9CFDA
+CFDBCFDCCFDDCFDECFDFCFE2CFE3CFE5CFE6CFE7CFE900000000000000000000
+0000CFEACFEBCFECCFEDCFEECFEFCFF2CFF4CFF6CFF7CFF8CFF9CFFACFFBCFFD
+CFFECFFFD001D002D003D005D006D007D008D009D00A00000000000000000000
+0000D00BD00CD00DD00ED00FD010D012D013D014D015D016D017D019D01AD01B
+D01CD01DD01ED01FD020D021D022D023D024D025D026D027D028D029D02AD02B
+D02CB05DB07CB07DB080B084B08CB08DB08FB091B098B099B09AB09CB09FB0A0
+B0A1B0A2B0A8B0A9B0ABB0ACB0ADB0AEB0AFB0B1B0B3B0B4B0B5B0B8B0BCB0C4
+B0C5B0C7B0C8B0C9B0D0B0D1B0D4B0D8B0E0B0E5B108B109B10BB10CB110B112
+B113B118B119B11BB11CB11DB123B124B125B128B12CB134B135B137B138B139
+B140B141B144B148B150B151B154B155B158B15CB160B178B179B17CB180B182
+B188B189B18BB18DB192B193B194B198B19CB1A8B1CCB1D0B1D4B1DCB1DD0000
+B4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D02ED02FD030D031D032D033D036D037D039D03AD03BD03DD03ED03FD040
+D041D042D043D046D048D04AD04BD04CD04DD04ED04F00000000000000000000
+0000D051D052D053D055D056D057D059D05AD05BD05CD05DD05ED05FD061D062
+D063D064D065D066D067D068D069D06AD06BD06ED06F00000000000000000000
+0000D071D072D073D075D076D077D078D079D07AD07BD07ED07FD080D082D083
+D084D085D086D087D088D089D08AD08BD08CD08DD08ED08FD090D091D092D093
+D094B1DFB1E8B1E9B1ECB1F0B1F9B1FBB1FDB204B205B208B20BB20CB214B215
+B217B219B220B234B23CB258B25CB260B268B269B274B275B27CB284B285B289
+B290B291B294B298B299B29AB2A0B2A1B2A3B2A5B2A6B2AAB2ACB2B0B2B4B2C8
+B2C9B2CCB2D0B2D2B2D8B2D9B2DBB2DDB2E2B2E4B2E5B2E6B2E8B2EBB2ECB2ED
+B2EEB2EFB2F3B2F4B2F5B2F7B2F8B2F9B2FAB2FBB2FFB300B301B304B308B310
+B311B313B314B315B31CB354B355B356B358B35BB35CB35EB35FB364B3650000
+B5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D095D096D097D098D099D09AD09BD09CD09DD09ED09FD0A0D0A1D0A2D0A3
+D0A6D0A7D0A9D0AAD0ABD0ADD0AED0AFD0B0D0B1D0B200000000000000000000
+0000D0B3D0B6D0B8D0BAD0BBD0BCD0BDD0BED0BFD0C2D0C3D0C5D0C6D0C7D0CA
+D0CBD0CCD0CDD0CED0CFD0D2D0D6D0D7D0D8D0D9D0DA00000000000000000000
+0000D0DBD0DED0DFD0E1D0E2D0E3D0E5D0E6D0E7D0E8D0E9D0EAD0EBD0EED0F2
+D0F3D0F4D0F5D0F6D0F7D0F9D0FAD0FBD0FCD0FDD0FED0FFD100D101D102D103
+D104B367B369B36BB36EB370B371B374B378B380B381B383B384B385B38CB390
+B394B3A0B3A1B3A8B3ACB3C4B3C5B3C8B3CBB3CCB3CEB3D0B3D4B3D5B3D7B3D9
+B3DBB3DDB3E0B3E4B3E8B3FCB410B418B41CB420B428B429B42BB434B450B451
+B454B458B460B461B463B465B46CB480B488B49DB4A4B4A8B4ACB4B5B4B7B4B9
+B4C0B4C4B4C8B4D0B4D5B4DCB4DDB4E0B4E3B4E4B4E6B4ECB4EDB4EFB4F1B4F8
+B514B515B518B51BB51CB524B525B527B528B529B52AB530B531B534B5380000
+B6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D105D106D107D108D109D10AD10BD10CD10ED10FD110D111D112D113D114
+D115D116D117D118D119D11AD11BD11CD11DD11ED11F00000000000000000000
+0000D120D121D122D123D124D125D126D127D128D129D12AD12BD12CD12DD12E
+D12FD132D133D135D136D137D139D13BD13CD13DD13E00000000000000000000
+0000D13FD142D146D147D148D149D14AD14BD14ED14FD151D152D153D155D156
+D157D158D159D15AD15BD15ED160D162D163D164D165D166D167D169D16AD16B
+D16DB540B541B543B544B545B54BB54CB54DB550B554B55CB55DB55FB560B561
+B5A0B5A1B5A4B5A8B5AAB5ABB5B0B5B1B5B3B5B4B5B5B5BBB5BCB5BDB5C0B5C4
+B5CCB5CDB5CFB5D0B5D1B5D8B5ECB610B611B614B618B625B62CB634B648B664
+B668B69CB69DB6A0B6A4B6ABB6ACB6B1B6D4B6F0B6F4B6F8B700B701B705B728
+B729B72CB72FB730B738B739B73BB744B748B74CB754B755B760B764B768B770
+B771B773B775B77CB77DB780B784B78CB78DB78FB790B791B792B796B7970000
+B7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D16ED16FD170D171D172D173D174D175D176D177D178D179D17AD17BD17D
+D17ED17FD180D181D182D183D185D186D187D189D18A00000000000000000000
+0000D18BD18CD18DD18ED18FD190D191D192D193D194D195D196D197D198D199
+D19AD19BD19CD19DD19ED19FD1A2D1A3D1A5D1A6D1A700000000000000000000
+0000D1A9D1AAD1ABD1ACD1ADD1AED1AFD1B2D1B4D1B6D1B7D1B8D1B9D1BBD1BD
+D1BED1BFD1C1D1C2D1C3D1C4D1C5D1C6D1C7D1C8D1C9D1CAD1CBD1CCD1CDD1CE
+D1CFB798B799B79CB7A0B7A8B7A9B7ABB7ACB7ADB7B4B7B5B7B8B7C7B7C9B7EC
+B7EDB7F0B7F4B7FCB7FDB7FFB800B801B807B808B809B80CB810B818B819B81B
+B81DB824B825B828B82CB834B835B837B838B839B840B844B851B853B85CB85D
+B860B864B86CB86DB86FB871B878B87CB88DB8A8B8B0B8B4B8B8B8C0B8C1B8C3
+B8C5B8CCB8D0B8D4B8DDB8DFB8E1B8E8B8E9B8ECB8F0B8F8B8F9B8FBB8FDB904
+B918B920B93CB93DB940B944B94CB94FB951B958B959B95CB960B968B9690000
+B8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D1D0D1D1D1D2D1D3D1D4D1D5D1D6D1D7D1D9D1DAD1DBD1DCD1DDD1DED1DF
+D1E0D1E1D1E2D1E3D1E4D1E5D1E6D1E7D1E8D1E9D1EA00000000000000000000
+0000D1EBD1ECD1EDD1EED1EFD1F0D1F1D1F2D1F3D1F5D1F6D1F7D1F9D1FAD1FB
+D1FCD1FDD1FED1FFD200D201D202D203D204D205D20600000000000000000000
+0000D208D20AD20BD20CD20DD20ED20FD211D212D213D214D215D216D217D218
+D219D21AD21BD21CD21DD21ED21FD220D221D222D223D224D225D226D227D228
+D229B96BB96DB974B975B978B97CB984B985B987B989B98AB98DB98EB9ACB9AD
+B9B0B9B4B9BCB9BDB9BFB9C1B9C8B9C9B9CCB9CEB9CFB9D0B9D1B9D2B9D8B9D9
+B9DBB9DDB9DEB9E1B9E3B9E4B9E5B9E8B9ECB9F4B9F5B9F7B9F8B9F9B9FABA00
+BA01BA08BA15BA38BA39BA3CBA40BA42BA48BA49BA4BBA4DBA4EBA53BA54BA55
+BA58BA5CBA64BA65BA67BA68BA69BA70BA71BA74BA78BA83BA84BA85BA87BA8C
+BAA8BAA9BAABBAACBAB0BAB2BAB8BAB9BABBBABDBAC4BAC8BAD8BAD9BAFC0000
+B9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D22AD22BD22ED22FD231D232D233D235D236D237D238D239D23AD23BD23E
+D240D242D243D244D245D246D247D249D24AD24BD24C00000000000000000000
+0000D24DD24ED24FD250D251D252D253D254D255D256D257D258D259D25AD25B
+D25DD25ED25FD260D261D262D263D265D266D267D26800000000000000000000
+0000D269D26AD26BD26CD26DD26ED26FD270D271D272D273D274D275D276D277
+D278D279D27AD27BD27CD27DD27ED27FD282D283D285D286D287D289D28AD28B
+D28CBB00BB04BB0DBB0FBB11BB18BB1CBB20BB29BB2BBB34BB35BB36BB38BB3B
+BB3CBB3DBB3EBB44BB45BB47BB49BB4DBB4FBB50BB54BB58BB61BB63BB6CBB88
+BB8CBB90BBA4BBA8BBACBBB4BBB7BBC0BBC4BBC8BBD0BBD3BBF8BBF9BBFCBBFF
+BC00BC02BC08BC09BC0BBC0CBC0DBC0FBC11BC14BC15BC16BC17BC18BC1BBC1C
+BC1DBC1EBC1FBC24BC25BC27BC29BC2DBC30BC31BC34BC38BC40BC41BC43BC44
+BC45BC49BC4CBC4DBC50BC5DBC84BC85BC88BC8BBC8CBC8EBC94BC95BC970000
+BA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D28DD28ED28FD292D293D294D296D297D298D299D29AD29BD29DD29ED29F
+D2A1D2A2D2A3D2A5D2A6D2A7D2A8D2A9D2AAD2ABD2AD00000000000000000000
+0000D2AED2AFD2B0D2B2D2B3D2B4D2B5D2B6D2B7D2BAD2BBD2BDD2BED2C1D2C3
+D2C4D2C5D2C6D2C7D2CAD2CCD2CDD2CED2CFD2D0D2D100000000000000000000
+0000D2D2D2D3D2D5D2D6D2D7D2D9D2DAD2DBD2DDD2DED2DFD2E0D2E1D2E2D2E3
+D2E6D2E7D2E8D2E9D2EAD2EBD2ECD2EDD2EED2EFD2F2D2F3D2F5D2F6D2F7D2F9
+D2FABC99BC9ABCA0BCA1BCA4BCA7BCA8BCB0BCB1BCB3BCB4BCB5BCBCBCBDBCC0
+BCC4BCCDBCCFBCD0BCD1BCD5BCD8BCDCBCF4BCF5BCF6BCF8BCFCBD04BD05BD07
+BD09BD10BD14BD24BD2CBD40BD48BD49BD4CBD50BD58BD59BD64BD68BD80BD81
+BD84BD87BD88BD89BD8ABD90BD91BD93BD95BD99BD9ABD9CBDA4BDB0BDB8BDD4
+BDD5BDD8BDDCBDE9BDF0BDF4BDF8BE00BE03BE05BE0CBE0DBE10BE14BE1CBE1D
+BE1FBE44BE45BE48BE4CBE4EBE54BE55BE57BE59BE5ABE5BBE60BE61BE640000
+BB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D2FBD2FCD2FDD2FED2FFD302D304D306D307D308D309D30AD30BD30FD311
+D312D313D315D317D318D319D31AD31BD31ED322D32300000000000000000000
+0000D324D326D327D32AD32BD32DD32ED32FD331D332D333D334D335D336D337
+D33AD33ED33FD340D341D342D343D346D347D348D34900000000000000000000
+0000D34AD34BD34CD34DD34ED34FD350D351D352D353D354D355D356D357D358
+D359D35AD35BD35CD35DD35ED35FD360D361D362D363D364D365D366D367D368
+D369BE68BE6ABE70BE71BE73BE74BE75BE7BBE7CBE7DBE80BE84BE8CBE8DBE8F
+BE90BE91BE98BE99BEA8BED0BED1BED4BED7BED8BEE0BEE3BEE4BEE5BEECBF01
+BF08BF09BF18BF19BF1BBF1CBF1DBF40BF41BF44BF48BF50BF51BF55BF94BFB0
+BFC5BFCCBFCDBFD0BFD4BFDCBFDFBFE1C03CC051C058C05CC060C068C069C090
+C091C094C098C0A0C0A1C0A3C0A5C0ACC0ADC0AFC0B0C0B3C0B4C0B5C0B6C0BC
+C0BDC0BFC0C0C0C1C0C5C0C8C0C9C0CCC0D0C0D8C0D9C0DBC0DCC0DDC0E40000
+BC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D36AD36BD36CD36DD36ED36FD370D371D372D373D374D375D376D377D378
+D379D37AD37BD37ED37FD381D382D383D385D386D38700000000000000000000
+0000D388D389D38AD38BD38ED392D393D394D395D396D397D39AD39BD39DD39E
+D39FD3A1D3A2D3A3D3A4D3A5D3A6D3A7D3AAD3ACD3AE00000000000000000000
+0000D3AFD3B0D3B1D3B2D3B3D3B5D3B6D3B7D3B9D3BAD3BBD3BDD3BED3BFD3C0
+D3C1D3C2D3C3D3C6D3C7D3CAD3CBD3CCD3CDD3CED3CFD3D1D3D2D3D3D3D4D3D5
+D3D6C0E5C0E8C0ECC0F4C0F5C0F7C0F9C100C104C108C110C115C11CC11DC11E
+C11FC120C123C124C126C127C12CC12DC12FC130C131C136C138C139C13CC140
+C148C149C14BC14CC14DC154C155C158C15CC164C165C167C168C169C170C174
+C178C185C18CC18DC18EC190C194C196C19CC19DC19FC1A1C1A5C1A8C1A9C1AC
+C1B0C1BDC1C4C1C8C1CCC1D4C1D7C1D8C1E0C1E4C1E8C1F0C1F1C1F3C1FCC1FD
+C200C204C20CC20DC20FC211C218C219C21CC21FC220C228C229C22BC22D0000
+BD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D3D7D3D9D3DAD3DBD3DCD3DDD3DED3DFD3E0D3E2D3E4D3E5D3E6D3E7D3E8
+D3E9D3EAD3EBD3EED3EFD3F1D3F2D3F3D3F5D3F6D3F700000000000000000000
+0000D3F8D3F9D3FAD3FBD3FED400D402D403D404D405D406D407D409D40AD40B
+D40CD40DD40ED40FD410D411D412D413D414D415D41600000000000000000000
+0000D417D418D419D41AD41BD41CD41ED41FD420D421D422D423D424D425D426
+D427D428D429D42AD42BD42CD42DD42ED42FD430D431D432D433D434D435D436
+D437C22FC231C232C234C248C250C251C254C258C260C265C26CC26DC270C274
+C27CC27DC27FC281C288C289C290C298C29BC29DC2A4C2A5C2A8C2ACC2ADC2B4
+C2B5C2B7C2B9C2DCC2DDC2E0C2E3C2E4C2EBC2ECC2EDC2EFC2F1C2F6C2F8C2F9
+C2FBC2FCC300C308C309C30CC30DC313C314C315C318C31CC324C325C328C329
+C345C368C369C36CC370C372C378C379C37CC37DC384C388C38CC3C0C3D8C3D9
+C3DCC3DFC3E0C3E2C3E8C3E9C3EDC3F4C3F5C3F8C408C410C424C42CC4300000
+BE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D438D439D43AD43BD43CD43DD43ED43FD441D442D443D445D446D447D448
+D449D44AD44BD44CD44DD44ED44FD450D451D452D45300000000000000000000
+0000D454D455D456D457D458D459D45AD45BD45DD45ED45FD461D462D463D465
+D466D467D468D469D46AD46BD46CD46ED470D471D47200000000000000000000
+0000D473D474D475D476D477D47AD47BD47DD47ED481D483D484D485D486D487
+D48AD48CD48ED48FD490D491D492D493D495D496D497D498D499D49AD49BD49C
+D49DC434C43CC43DC448C464C465C468C46CC474C475C479C480C494C49CC4B8
+C4BCC4E9C4F0C4F1C4F4C4F8C4FAC4FFC500C501C50CC510C514C51CC528C529
+C52CC530C538C539C53BC53DC544C545C548C549C54AC54CC54DC54EC553C554
+C555C557C558C559C55DC55EC560C561C564C568C570C571C573C574C575C57C
+C57DC580C584C587C58CC58DC58FC591C595C597C598C59CC5A0C5A9C5B4C5B5
+C5B8C5B9C5BBC5BCC5BDC5BEC5C4C5C5C5C6C5C7C5C8C5C9C5CAC5CCC5CE0000
+BF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D49ED49FD4A0D4A1D4A2D4A3D4A4D4A5D4A6D4A7D4A8D4AAD4ABD4ACD4AD
+D4AED4AFD4B0D4B1D4B2D4B3D4B4D4B5D4B6D4B7D4B800000000000000000000
+0000D4B9D4BAD4BBD4BCD4BDD4BED4BFD4C0D4C1D4C2D4C3D4C4D4C5D4C6D4C7
+D4C8D4C9D4CAD4CBD4CDD4CED4CFD4D1D4D2D4D3D4D500000000000000000000
+0000D4D6D4D7D4D8D4D9D4DAD4DBD4DDD4DED4E0D4E1D4E2D4E3D4E4D4E5D4E6
+D4E7D4E9D4EAD4EBD4EDD4EED4EFD4F1D4F2D4F3D4F4D4F5D4F6D4F7D4F9D4FA
+D4FCC5D0C5D1C5D4C5D8C5E0C5E1C5E3C5E5C5ECC5EDC5EEC5F0C5F4C5F6C5F7
+C5FCC5FDC5FEC5FFC600C601C605C606C607C608C60CC610C618C619C61BC61C
+C624C625C628C62CC62DC62EC630C633C634C635C637C639C63BC640C641C644
+C648C650C651C653C654C655C65CC65DC660C66CC66FC671C678C679C67CC680
+C688C689C68BC68DC694C695C698C69CC6A4C6A5C6A7C6A9C6B0C6B1C6B4C6B8
+C6B9C6BAC6C0C6C1C6C3C6C5C6CCC6CDC6D0C6D4C6DCC6DDC6E0C6E1C6E80000
+C0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D4FED4FFD500D501D502D503D505D506D507D509D50AD50BD50DD50ED50F
+D510D511D512D513D516D518D519D51AD51BD51CD51D00000000000000000000
+0000D51ED51FD520D521D522D523D524D525D526D527D528D529D52AD52BD52C
+D52DD52ED52FD530D531D532D533D534D535D536D53700000000000000000000
+0000D538D539D53AD53BD53ED53FD541D542D543D545D546D547D548D549D54A
+D54BD54ED550D552D553D554D555D556D557D55AD55BD55DD55ED55FD561D562
+D563C6E9C6ECC6F0C6F8C6F9C6FDC704C705C708C70CC714C715C717C719C720
+C721C724C728C730C731C733C735C737C73CC73DC740C744C74AC74CC74DC74F
+C751C752C753C754C755C756C757C758C75CC760C768C76BC774C775C778C77C
+C77DC77EC783C784C785C787C788C789C78AC78EC790C791C794C796C797C798
+C79AC7A0C7A1C7A3C7A4C7A5C7A6C7ACC7ADC7B0C7B4C7BCC7BDC7BFC7C0C7C1
+C7C8C7C9C7CCC7CEC7D0C7D8C7DDC7E4C7E8C7ECC800C801C804C808C80A0000
+C1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D564D566D567D56AD56CD56ED56FD570D571D572D573D576D577D579D57A
+D57BD57DD57ED57FD580D581D582D583D586D58AD58B00000000000000000000
+0000D58CD58DD58ED58FD591D592D593D594D595D596D597D598D599D59AD59B
+D59CD59DD59ED59FD5A0D5A1D5A2D5A3D5A4D5A6D5A700000000000000000000
+0000D5A8D5A9D5AAD5ABD5ACD5ADD5AED5AFD5B0D5B1D5B2D5B3D5B4D5B5D5B6
+D5B7D5B8D5B9D5BAD5BBD5BCD5BDD5BED5BFD5C0D5C1D5C2D5C3D5C4D5C5D5C6
+D5C7C810C811C813C815C816C81CC81DC820C824C82CC82DC82FC831C838C83C
+C840C848C849C84CC84DC854C870C871C874C878C87AC880C881C883C885C886
+C887C88BC88CC88DC894C89DC89FC8A1C8A8C8BCC8BDC8C4C8C8C8CCC8D4C8D5
+C8D7C8D9C8E0C8E1C8E4C8F5C8FCC8FDC900C904C905C906C90CC90DC90FC911
+C918C92CC934C950C951C954C958C960C961C963C96CC970C974C97CC988C989
+C98CC990C998C999C99BC99DC9C0C9C1C9C4C9C7C9C8C9CAC9D0C9D1C9D30000
+C2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D5CAD5CBD5CDD5CED5CFD5D1D5D3D5D4D5D5D5D6D5D7D5DAD5DCD5DED5DF
+D5E0D5E1D5E2D5E3D5E6D5E7D5E9D5EAD5EBD5EDD5EE00000000000000000000
+0000D5EFD5F0D5F1D5F2D5F3D5F6D5F8D5FAD5FBD5FCD5FDD5FED5FFD602D603
+D605D606D607D609D60AD60BD60CD60DD60ED60FD61200000000000000000000
+0000D616D617D618D619D61AD61BD61DD61ED61FD621D622D623D625D626D627
+D628D629D62AD62BD62CD62ED62FD630D631D632D633D634D635D636D637D63A
+D63BC9D5C9D6C9D9C9DAC9DCC9DDC9E0C9E2C9E4C9E7C9ECC9EDC9EFC9F0C9F1
+C9F8C9F9C9FCCA00CA08CA09CA0BCA0CCA0DCA14CA18CA29CA4CCA4DCA50CA54
+CA5CCA5DCA5FCA60CA61CA68CA7DCA84CA98CABCCABDCAC0CAC4CACCCACDCACF
+CAD1CAD3CAD8CAD9CAE0CAECCAF4CB08CB10CB14CB18CB20CB21CB41CB48CB49
+CB4CCB50CB58CB59CB5DCB64CB78CB79CB9CCBB8CBD4CBE4CBE7CBE9CC0CCC0D
+CC10CC14CC1CCC1DCC21CC22CC27CC28CC29CC2CCC2ECC30CC38CC39CC3B0000
+C3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D63DD63ED63FD641D642D643D644D646D647D64AD64CD64ED64FD650D652
+D653D656D657D659D65AD65BD65DD65ED65FD660D66100000000000000000000
+0000D662D663D664D665D666D668D66AD66BD66CD66DD66ED66FD672D673D675
+D676D677D678D679D67AD67BD67CD67DD67ED67FD68000000000000000000000
+0000D681D682D684D686D687D688D689D68AD68BD68ED68FD691D692D693D695
+D696D697D698D699D69AD69BD69CD69ED6A0D6A2D6A3D6A4D6A5D6A6D6A7D6A9
+D6AACC3CCC3DCC3ECC44CC45CC48CC4CCC54CC55CC57CC58CC59CC60CC64CC66
+CC68CC70CC75CC98CC99CC9CCCA0CCA8CCA9CCABCCACCCADCCB4CCB5CCB8CCBC
+CCC4CCC5CCC7CCC9CCD0CCD4CCE4CCECCCF0CD01CD08CD09CD0CCD10CD18CD19
+CD1BCD1DCD24CD28CD2CCD39CD5CCD60CD64CD6CCD6DCD6FCD71CD78CD88CD94
+CD95CD98CD9CCDA4CDA5CDA7CDA9CDB0CDC4CDCCCDD0CDE8CDECCDF0CDF8CDF9
+CDFBCDFDCE04CE08CE0CCE14CE19CE20CE21CE24CE28CE30CE31CE33CE350000
+C4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D6ABD6ADD6AED6AFD6B1D6B2D6B3D6B4D6B5D6B6D6B7D6B8D6BAD6BCD6BD
+D6BED6BFD6C0D6C1D6C2D6C3D6C6D6C7D6C9D6CAD6CB00000000000000000000
+0000D6CDD6CED6CFD6D0D6D2D6D3D6D5D6D6D6D8D6DAD6DBD6DCD6DDD6DED6DF
+D6E1D6E2D6E3D6E5D6E6D6E7D6E9D6EAD6EBD6ECD6ED00000000000000000000
+0000D6EED6EFD6F1D6F2D6F3D6F4D6F6D6F7D6F8D6F9D6FAD6FBD6FED6FFD701
+D702D703D705D706D707D708D709D70AD70BD70CD70DD70ED70FD710D712D713
+D714CE58CE59CE5CCE5FCE60CE61CE68CE69CE6BCE6DCE74CE75CE78CE7CCE84
+CE85CE87CE89CE90CE91CE94CE98CEA0CEA1CEA3CEA4CEA5CEACCEADCEC1CEE4
+CEE5CEE8CEEBCEECCEF4CEF5CEF7CEF8CEF9CF00CF01CF04CF08CF10CF11CF13
+CF15CF1CCF20CF24CF2CCF2DCF2FCF30CF31CF38CF54CF55CF58CF5CCF64CF65
+CF67CF69CF70CF71CF74CF78CF80CF85CF8CCFA1CFA8CFB0CFC4CFE0CFE1CFE4
+CFE8CFF0CFF1CFF3CFF5CFFCD000D004D011D018D02DD034D035D038D03C0000
+C5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D715D716D717D71AD71BD71DD71ED71FD721D722D723D724D725D726D727
+D72AD72CD72ED72FD730D731D732D733D736D737D73900000000000000000000
+0000D73AD73BD73DD73ED73FD740D741D742D743D745D746D748D74AD74BD74C
+D74DD74ED74FD752D753D755D75AD75BD75CD75DD75E00000000000000000000
+0000D75FD762D764D766D767D768D76AD76BD76DD76ED76FD771D772D773D775
+D776D777D778D779D77AD77BD77ED77FD780D782D783D784D785D786D787D78A
+D78BD044D045D047D049D050D054D058D060D06CD06DD070D074D07CD07DD081
+D0A4D0A5D0A8D0ACD0B4D0B5D0B7D0B9D0C0D0C1D0C4D0C8D0C9D0D0D0D1D0D3
+D0D4D0D5D0DCD0DDD0E0D0E4D0ECD0EDD0EFD0F0D0F1D0F8D10DD130D131D134
+D138D13AD140D141D143D144D145D14CD14DD150D154D15CD15DD15FD161D168
+D16CD17CD184D188D1A0D1A1D1A4D1A8D1B0D1B1D1B3D1B5D1BAD1BCD1C0D1D8
+D1F4D1F8D207D209D210D22CD22DD230D234D23CD23DD23FD241D248D25C0000
+C6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D78DD78ED78FD791D792D793D794D795D796D797D79AD79CD79ED79FD7A0
+D7A1D7A2D7A30000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D264D280D281D284D288D290D291D295D29CD2A0D2A4D2ACD2B1D2B8D2B9
+D2BCD2BFD2C0D2C2D2C8D2C9D2CBD2D4D2D8D2DCD2E4D2E5D2F0D2F1D2F4D2F8
+D300D301D303D305D30CD30DD30ED310D314D316D31CD31DD31FD320D321D325
+D328D329D32CD330D338D339D33BD33CD33DD344D345D37CD37DD380D384D38C
+D38DD38FD390D391D398D399D39CD3A0D3A8D3A9D3ABD3ADD3B4D3B8D3BCD3C4
+D3C5D3C8D3C9D3D0D3D8D3E1D3E3D3ECD3EDD3F0D3F4D3FCD3FDD3FFD4010000
+C7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D408D41DD440D444D45CD460D464D46DD46FD478D479D47CD47FD480D482
+D488D489D48BD48DD494D4A9D4CCD4D0D4D4D4DCD4DFD4E8D4ECD4F0D4F8D4FB
+D4FDD504D508D50CD514D515D517D53CD53DD540D544D54CD54DD54FD551D558
+D559D55CD560D565D568D569D56BD56DD574D575D578D57CD584D585D587D588
+D589D590D5A5D5C8D5C9D5CCD5D0D5D2D5D8D5D9D5DBD5DDD5E4D5E5D5E8D5EC
+D5F4D5F5D5F7D5F9D600D601D604D608D610D611D613D614D615D61CD6200000
+C8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D624D62DD638D639D63CD640D645D648D649D64BD64DD651D654D655D658
+D65CD667D669D670D671D674D683D685D68CD68DD690D694D69DD69FD6A1D6A8
+D6ACD6B0D6B9D6BBD6C4D6C5D6C8D6CCD6D1D6D4D6D7D6D9D6E0D6E4D6E8D6F0
+D6F5D6FCD6FDD700D704D711D718D719D71CD720D728D729D72BD72DD734D735
+D738D73CD744D747D749D750D751D754D756D757D758D759D760D761D763D765
+D769D76CD770D774D77CD77DD781D788D789D78CD790D798D799D79BD79D0000
+CA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F3D4F73504750F952A053EF547554E556095AC15BB6668767B667B767EF
+6B4C73C275C27A3C82DB8304885788888A368CC88DCF8EFB8FE699D5523B5374
+5404606A61646BBC73CF811A89BA89D295A34F83520A58BE597859E65E725E79
+61C763C0674667EC687F6F97764E770B78F57A087AFF7C21809D826E82718AEB
+95934E6B559D66F76E3478A37AED845B8910874E97A852D8574E582A5D4C611F
+61BE6221656267D16A446E1B751875B376E377B07D3A90AF945194529F950000
+CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000053235CAC753280DB92409598525B580859DC5CA15D175EB75F3A5F4A6177
+6C5F757A75867CE07D737DB17F8C81548221859189418B1B92FC964D9C474ECB
+4EF7500B51F1584F6137613E6168653969EA6F1175A5768676D67B8782A584CB
+F90093A7958B55805BA25751F9017CB37FB991B5502853BB5C455DE862D2636E
+64DA64E76E2070AC795B8DDD8E1EF902907D924592F84E7E4EF650655DFE5EFA
+61066957817186548E4793759A2B4E5E5091677068405109528D52926AA20000
+CC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077BC92109ED452AB602F8FF2504861A963ED64CA683C6A846FC0818889A1
+96945805727D72AC75047D797E6D80A9898B8B7490639D5162896C7A6F547D50
+7F3A8A23517C614A7B9D8B199257938C4EAC4FD3501E50BE510652C152CD537F
+577058835E9A5F91617661AC64CE656C666F66BB66F468976D87708570F1749F
+74A574CA75D9786C78EC7ADF7AF67D457D938015803F811B83968B668F159015
+93E1980398389A5A9BE84FC25553583A59515B635C4660B86212684268B00000
+CD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068E86EAA754C767878CE7A3D7CFB7E6B7E7C8A088AA18C3F968E9DC453E4
+53E9544A547156FA59D15B645C3B5EAB62F765376545657266A067AF69C16CBD
+75FC7690777E7A3F7F94800380A1818F82E682FD83F085C1883188B48AA5F903
+8F9C932E96C798679AD89F1354ED659B66F2688F7A408C379D6056F057645D11
+660668B168CD6EFE7428889E9BE46C68F9049AA84F9B516C5171529F5B545DE5
+6050606D62F163A7653B73D97A7A86A38CA2978F4E325BE16208679C74DC0000
+CE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000079D183D38A878AB28DE8904E934B98465ED369E885FF90EDF90551A05B98
+5BEC616368FA6B3E704C742F74D87BA17F5083C589C08CAB95DC9928522E605D
+62EC90024F8A5149532158D95EE366E06D38709A72C273D67B5080F1945B5366
+639B7F6B4E565080584A58DE602A612762D069D09B415B8F7D1880B18F5F4EA4
+50D154AC55AC5B0C5DA05DE7652A654E68216A4B72E1768E77EF7D5E7FF981A0
+854E86DF8F038F4E90CA99039A559BAB4E184E454E5D4EC74FF1517752FE0000
+CF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000534053E353E5548E5614577557A25BC75D875ED061FC62D8655167B867E9
+69CB6B506BC66BEC6C426E9D707872D77396740377BF77E97A767D7F800981FC
+8205820A82DF88628B338CFC8EC0901190B1926492B699D29A459CE99DD79F9C
+570B5C4083CA97A097AB9EB4541B7A987FA488D98ECD90E158005C4863987A9F
+5BAE5F137A797AAE828E8EAC5026523852F85377570862F363726B0A6DC37737
+53A5735785688E7695D5673A6AC36F708A6D8ECC994BF90666776B788CB40000
+D0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009B3CF90753EB572D594E63C669FB73EA78457ABA7AC57CFE8475898F8D73
+903595A852FB574775477B6083CC921EF9086A58514B524B5287621F68D86975
+969950C552A452E461C365A4683969FF747E7B4B82B983EB89B28B398FD19949
+F9094ECA599764D266116A8E7434798179BD82A9887E887F895FF90A93264F0B
+53CA602562716C727D1A7D664E98516277DC80AF4F014F0E5176518055DC5668
+573B57FA57FC5914594759935BC45C905D0E5DF15E7E5FCC628065D765E30000
+D1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000671E671F675E68CB68C46A5F6B3A6C236C7D6C826DC773987426742A7482
+74A37578757F788178EF794179477948797A7B957D007DBA7F888006802D808C
+8A188B4F8C488D779321932498E299519A0E9A0F9A659E927DCA4F76540962EE
+685491D155AB513AF90BF90C5A1C61E6F90D62CF62FFF90EF90FF910F911F912
+F91390A3F914F915F916F917F9188AFEF919F91AF91BF91C6696F91D7156F91E
+F91F96E3F920634F637A5357F921678F69606E73F9227537F923F924F9250000
+D2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007D0DF926F927887256CA5A18F928F929F92AF92BF92C4E43F92D51675948
+67F08010F92E59735E74649A79CA5FF5606C62C8637B5BE75BD752AAF92F5974
+5F296012F930F931F9327459F933F934F935F936F937F93899D1F939F93AF93B
+F93CF93DF93EF93FF940F941F942F9436FC3F944F94581BF8FB260F1F946F947
+8166F948F9495C3FF94AF94BF94CF94DF94EF94FF950F9515AE98A25677B7D10
+F952F953F954F955F956F95780FDF958F9595C3C6CE5533F6EBA591A83360000
+D3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E394EB64F4655AE571858C75F5665B765E66A806BB56E4D77ED7AEF7C1E
+7DDE86CB88929132935B64BB6FBE737A75B890545556574D61BA64D466C76DE1
+6E5B6F6D6FB975F0804381BD854189838AC78B5A931F6C9375537B548E0F905D
+5510580258585E626207649E68E075767CD687B39EE84EE35788576E59275C0D
+5CB15E365F85623464E173B381FA888B8CB8968A9EDB5B855FB760B350125200
+52305716583558575C0E5C605CF65D8B5EA65F9260BC63116389641768430000
+D4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068F96AC26DD86E216ED46FE471FE76DC777979B17A3B840489A98CED8DF3
+8E4890039014905390FD934D967697DC6BD27006725872A27368776379BF7BE4
+7E9B8B8058A960C7656665FD66BE6C8C711E71C98C5A98134E6D7A814EDD51AC
+51CD52D5540C61A76771685068DF6D1E6F7C75BC77B37AE580F484639285515C
+6597675C679375D87AC78373F95A8C469017982D5C6F81C0829A9041906F920D
+5F975D9D6A5971C8767B7B4985E48B0491279A30558761F6F95B76697F850000
+D5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000863F87BA88F8908FF95C6D1B70D973DE7D61843DF95D916A99F1F95E4E82
+53756B046B12703E721B862D9E1E524C8FA35D5064E5652C6B166FEB7C437E9C
+85CD896489BD62C981D8881F5ECA67176D6A72FC7405746F878290DE4F865D0D
+5FA0840A51B763A075654EAE5006516951C968816A117CAE7CB17CE7826F8AD2
+8F1B91CF4FB6513752F554425EEC616E623E65C56ADA6FFE792A85DC882395AD
+9A629A6A9E979ECE529B66C66B77701D792B8F6297426190620065236F230000
+D6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000714974897DF4806F84EE8F269023934A51BD521752A36D0C70C888C25EC9
+65826BAE6FC27C3E73754EE44F3656F9F95F5CBA5DBA601C73B27B2D7F9A7FCE
+8046901E923496F6974898189F614F8B6FA779AE91B496B752DEF960648864C4
+6AD36F5E7018721076E780018606865C8DEF8F0597329B6F9DFA9E75788C797F
+7DA083C993049E7F9E938AD658DF5F046727702774CF7C60807E512170287262
+78CA8CC28CDA8CF496F74E8650DA5BEE5ED6659971CE764277AD804A84FC0000
+D7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000907C9B279F8D58D85A415C626A136DDA6F0F763B7D2F7E37851E893893E4
+964B528965D267F369B46D416E9C700F7409746075597624786B8B2C985E516D
+622E96784F96502B5D196DEA7DB88F2A5F8B61446817F961968652D2808B51DC
+51CC695E7A1C7DBE83F196754FDA52295398540F550E5C6560A7674E68A86D6C
+728172F874067483F96275E27C6C7F797FB8838988CF88E191CC91D096E29BC9
+541D6F7E71D0749885FA8EAA96A39C579E9F67976DCB743381E89716782C0000
+D8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007ACB7B207C926469746A75F278BC78E899AC9B549EBB5BDE5E556F20819C
+83AB90884E07534D5A295DD25F4E6162633D666966FC6EFF6F2B7063779E842C
+8513883B8F1399459C3B551C62B9672B6CAB8309896A977A4EA159845FD85FD9
+671B7DB27F548292832B83BD8F1E909957CB59B95A925BD06627679A68856BCF
+71647F758CB78CE390819B4581088C8A964C9A409EA55B5F6C13731B76F276DF
+840C51AA8993514D519552C968C96C94770477207DBF7DEC97629EB56EC50000
+D9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000851151A5540D547D660E669D69276E9F76BF7791831784C2879F91699298
+9CF488824FAE519252DF59C65E3D61556478647966AE67D06A216BCD6BDB725F
+72617441773877DB801782BC83058B008B288C8C67286C90726776EE77667A46
+9DA96B7F6C92592267268499536F589359995EDF63CF663467736E3A732B7AD7
+82D7932852D95DEB61AE61CB620A62C764AB65E069596B666BCB712173F7755D
+7E46821E8302856A8AA38CBF97279D6158A89ED85011520E543B554F65870000
+DA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006C767D0A7D0B805E868A958096EF52FF6C95726954735A9A5C3E5D4B5F4C
+5FAE672A68B669636E3C6E4477097C737F8E85878B0E8FF797619EF45CB760B6
+610D61AB654F65FB65FC6C116CEF739F73C97DE195945BC6871C8B10525D535A
+62CD640F64B267346A386CCA73C0749E7B947C957E1B818A823685848FEB96F9
+99C14F34534A53CD53DB62CC642C6500659169C36CEE6F5873ED7554762276E4
+76FC78D078FB792C7D46822C87E08FD4981298EF52C362D464A56E246F510000
+DB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000767C8DCB91B192629AEE9B435023508D574A59A85C285E475F77623F653E
+65B965C16609678B699C6EC278C57D2180AA8180822B82B384A1868C8A2A8B17
+90A696329F90500D4FF3F96357F95F9862DC6392676F6E43711976C380CC80DA
+88F488F589198CE08F29914D966A4F2F4F705E1B67CF6822767D767E9B445E61
+6A0A716971D4756AF9647E41854385E998DC4F107B4F7F7095A551E15E0668B5
+6C3E6C4E6CDB72AF7BC483036CD5743A50FB528858C164D86A9774A776560000
+DC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000078A7861795E29739F965535E5F018B8A8FA88FAF908A522577A59C499F08
+4E19500251755C5B5E77661E663A67C468C570B3750175C579C97ADD8F279920
+9A084FDD582158315BF6666E6B656D116E7A6F7D73E4752B83E988DC89138B5C
+8F144F0F50D55310535C5B935FA9670D798F8179832F8514890789868F398F3B
+99A59C12672C4E764FF859495C015CEF5CF0636768D270FD71A2742B7E2B84EC
+8702902292D29CF34E0D4ED84FEF50855256526F5426549057E0592B5A660000
+DD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005B5A5B755BCC5E9CF9666276657765A76D6E6EA572367B267C3F7F368150
+8151819A8240829983A98A038CA08CE68CFB8D748DBA90E891DC961C964499D9
+9CE7531752065429567458B35954596E5FFF61A4626E66106C7E711A76C67C89
+7CDE7D1B82AC8CC196F0F9674F5B5F175F7F62C25D29670B68DA787C7E439D6C
+4E1550995315532A535159835A625E8760B2618A624962796590678769A76BD4
+6BD66BD76BD86CB8F968743575FA7812789179D579D87C837DCB7FE180A50000
+DE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000813E81C283F2871A88E88AB98B6C8CBB9119975E98DB9F3B56AC5B2A5F6C
+658C6AB36BAF6D5C6FF17015725D73AD8CA78CD3983B61916C3780589A014E4D
+4E8B4E9B4ED54F3A4F3C4F7F4FDF50FF53F253F8550655E356DB58EB59625A11
+5BEB5BFA5C045DF35E2B5F99601D6368659C65AF67F667FB68AD6B7B6C996CD7
+6E23700973457802793E7940796079C17BE97D177D728086820D838E84D186C7
+88DF8A508A5E8B1D8CDC8D668FAD90AA98FC99DF9E9D524AF9696714F96A0000
+DF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005098522A5C7165636C5573CA7523759D7B97849C917897304E7764926BBA
+715E85A94E09F96B674968EE6E17829F8518886B63F76F81921298AF4E0A50B7
+50CF511F554655AA56175B405C195CE05E385E8A5EA05EC260F368516A616E58
+723D724072C076F879657BB17FD488F389F48A738C618CDE971C585E74BD8CFD
+55C7F96C7A617D2282727272751F7525F96D7B19588558FB5DBC5E8F5EB65F90
+60556292637F654D669166D966F8681668F27280745E7B6E7D6E7DD67F720000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000080E5821285AF897F8A93901D92E49ECD9F205915596D5E2D60DC66146673
+67906C506DC56F5F77F378A984C691CB932B4ED950CA514855845B0B5BA36247
+657E65CB6E32717D74017444748774BF766C79AA7DDA7E557FA8817A81B38239
+861A87EC8A758DE3907892919425994D9BAE53685C5169546CC46D296E2B820C
+859B893B8A2D8AAA96EA9F67526166B96BB27E9687FE8D0D9583965D651D6D89
+71EEF96E57CE59D35BAC602760FA6210661F665F732973F976DB77017B6C0000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008056807281658AA091924E1652E26B726D177A057B397D30F96F8CB053EC
+562F58515BB55C0F5C115DE2624063836414662D68B36CBC6D886EAF701F70A4
+71D27526758F758E76197B117BE07C2B7D207D39852C856D86078A34900D9061
+90B592B797F69A374FD75C6C675F6D917C9F7E8C8B168D16901F5B6B5DFD640D
+84C0905C98E173875B8B609A677E6DDE8A1F8AA69001980C5237F9707051788E
+9396887091D74FEE53D755FD56DA578258FD5AC25B885CAB5CC05E2561010000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000620D624B6388641C653665786A396B8A6C346D196F3171E772E973787407
+74B27626776179C07A577AEA7CB97D8F7DAC7E617F9E81298331849084DA85EA
+88968AB08B908F3890429083916C929692B9968B96A796A896D6970098089996
+9AD39B1A53D4587E59195B705BBF6DD16F5A719F742174B9808583FD5DE15F87
+5FAA604265EC6812696F6A536B896D356DF373E376FE77AC7B4D7D148123821C
+834084F485638A628AC49187931E980699B4620C88538FF092655D075D270000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005D69745F819D87686FD562FE7FD2893689724E1E4E5850E752DD5347627F
+66077E698805965E4F8D5319563659CB5AA45C385C4E5C4D5E025F11604365BD
+662F664267BE67F4731C77E2793A7FC5849484CD89968A668A698AE18C558C7A
+57F45BD45F0F606F62ED690D6B966E5C71847BD287558B588EFE98DF98FE4F38
+4F814FE1547B5A205BB8613C65B0666871FC7533795E7D33814E81E3839885AA
+85CE87038A0A8EAB8F9BF9718FC559315BA45BE660895BE95C0B5FC36C810000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9726DF1700B751A82AF8AF64EC05341F97396D96C0F4E9E4FC45152555E
+5A255CE86211725982BD83AA86FE88598A1D963F96C599139D099D5D580A5CB3
+5DBD5E4460E1611563E16A026E2591029354984E9C109F775B895CB86309664F
+6848773C96C1978D98549B9F65A18B018ECB95BC55355CA95DD65EB56697764C
+83F495C758D362BC72CE9D284EF0592E600F663B6B8379E79D26539354C057C3
+5D16611B66D66DAF788D827E969897445384627C63966DB27E0A814B984D0000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006AFB7F4C9DAF9E1A4E5F503B51B6591C60F963F66930723A8036F97491CE
+5F31F975F9767D0482E5846F84BB85E58E8DF9774F6FF978F97958E45B436059
+63DA6518656D6698F97A694A6A236D0B7001716C75D2760D79B37A70F97B7F8A
+F97C8944F97D8B9391C0967DF97E990A57045FA165BC6F01760079A68A9E99AD
+9B5A9F6C510461B662916A8D81C6504358305F6671098A008AFA5B7C86164FFA
+513C56B4594463A96DF95DAA696D51864E884F59F97FF980F9815982F9820000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9836B5F6C5DF98474B57916F9858207824583398F3F8F5DF9869918F987
+F988F9894EA6F98A57DF5F796613F98BF98C75AB7E798B6FF98D90069A5B56A5
+582759F85A1F5BB4F98E5EF6F98FF9906350633BF991693D6C876CBF6D8E6D93
+6DF56F14F99270DF71367159F99371C371D5F994784F786FF9957B757DE3F996
+7E2FF997884D8EDFF998F999F99A925BF99B9CF6F99CF99DF99E60856D85F99F
+71B1F9A0F9A195B153ADF9A2F9A3F9A467D3F9A5708E71307430827682D20000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9A695BB9AE59E7D66C4F9A771C18449F9A8F9A9584BF9AAF9AB5DB85F71
+F9AC6620668E697969AE6C386CF36E366F416FDA701B702F715071DF7370F9AD
+745BF9AE74D476C87A4E7E93F9AFF9B082F18A608FCEF9B19348F9B29719F9B3
+F9B44E42502AF9B5520853E166F36C6D6FCA730A777F7A6282AE85DD8602F9B6
+88D48A638B7D8C6BF9B792B3F9B8971398104E944F0D4FC950B25348543E5433
+55DA586258BA59675A1B5BE4609FF9B961CA655665FF666468A76C5A6FB30000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000070CF71AC73527B7D87088AA49C329F075C4B6C8373447389923A6EAB7465
+761F7A697E15860A514058C564C174EE751576707FC1909596CD99546E2674E6
+7AA97AAA81E586D987788A1B5A495B8C5B9B68A169006D6373A97413742C7897
+7DE97FEB81188155839E8C4C962E981166F05F8065FA67896C6A738B502D5A03
+6B6A77EE59165D6C5DCD7325754FF9BAF9BB50E551F9582F592D599659DA5BE5
+F9BCF9BD5DA262D76416649364FEF9BE66DCF9BF6A48F9C071FF7464F9C10000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A887AAF7E477E5E80008170F9C287EF89818B209059F9C390809952617E
+6B326D747E1F89258FB14FD150AD519752C757C758895BB95EB8614269956D8C
+6E676EB6719474627528752C8073833884C98E0A939493DEF9C44E8E4F515076
+512A53C853CB53F35B875BD35C24611A618265F4725B7397744076C279507991
+79B97D067FBD828B85D5865E8FC2904790F591EA968596E896E952D65F6765ED
+6631682F715C7A3690C1980A4E91F9C56A526B9E6F907189801882B885530000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000904B969596F297FB851A9B314E90718A96C45143539F54E15713571257A3
+5A9B5AC45BC36028613F63F46C856D396E726E907230733F745782D188818F45
+9060F9C6966298589D1B67088D8A925E4F4D504950DE5371570D59D45A015C09
+617066906E2D7232744B7DEF80C3840E8466853F875F885B89188B02905597CB
+9B4F4E734F915112516AF9C7552F55A95B7A5BA55E7C5E7D5EBE60A060DF6108
+610963C465386709F9C867D467DAF9C9696169626CB96D27F9CA6E38F9CB0000
+EB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006FE173367337F9CC745C7531F9CD7652F9CEF9CF7DAD81FE843888D58A98
+8ADB8AED8E308E42904A903E907A914991C9936EF9D0F9D15809F9D26BD38089
+80B2F9D3F9D45141596B5C39F9D5F9D66F6473A780E48D07F9D79217958FF9D8
+F9D9F9DAF9DB807F620E701C7D68878DF9DC57A0606961476BB78ABE928096B1
+4E59541F6DEB852D967097F398EE63D66CE3909151DD61C981BA9DF94F9D501A
+51005B9C610F61FF64EC69056BC5759177E37FA98264858F87FB88638ABC0000
+EC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008B7091AB4E8C4EE54F0AF9DDF9DE593759E8F9DF5DF25F1B5F5B6021F9E0
+F9E1F9E2F9E3723E73E5F9E4757075CDF9E579FBF9E6800C8033808482E18351
+F9E7F9E88CBD8CB39087F9E9F9EA98F4990CF9EBF9EC703776CA7FCA7FCC7FFC
+8B1A4EBA4EC152035370F9ED54BD56E059FB5BC55F155FCD6E6EF9EEF9EF7D6A
+8335F9F086938A8DF9F1976D9777F9F2F9F34E004F5A4F7E58F965E56EA29038
+93B099B94EFB58EC598A59D96041F9F4F9F57A14F9F6834F8CC3516553440000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9F7F9F8F9F94ECD52695B5582BF4ED4523A54A859C959FF5B505B575B5C
+606361486ECB7099716E738674F775B578C17D2B800581EA8328851785C98AEE
+8CC796CC4F5C52FA56BC65AB6628707C70B872357DBD828D914C96C09D725B71
+68E76B986F7A76DE5C9166AB6F5B7BB47C2A883696DC4E084ED75320583458BB
+58EF596C5C075E335E845F35638C66B267566A1F6AA36B0C6F3F7246F9FA7350
+748B7AE07CA7817881DF81E7838A846C8523859485CF88DD8D1391AC95770000
+EE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000969C518D54C957285BB0624D6750683D68936E3D6ED3707D7E2188C18CA1
+8F099F4B9F4E722D7B8F8ACD931A4F474F4E5132548059D05E9562B56775696E
+6A176CAE6E1A72D9732A75BD7BB87D3582E783F9845785F78A5B8CAF8E879019
+90B896CE9F5F52E3540A5AE15BC2645865756EF472C4F9FB76847A4D7B1B7C4D
+7E3E7FDF837B8B2B8CCA8D648DE18E5F8FEA8FF9906993D14F434F7A50B35168
+5178524D526A5861587C59605C085C555EDB609B623068136BBF6C086FB10000
+EF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000714E742075307538755176727B4C7B8B7BAD7BC67E8F8A6E8F3E8F49923F
+92939322942B96FB985A986B991E5207622A62986D5976647ACA7BC07D765360
+5CBE5E976F3870B97C9897119B8E9EDE63A5647A87764E014E954EAD505C5075
+544859C35B9A5E405EAD5EF75F8160C5633A653F657465CC6676667867FE6968
+6A896B636C406DC06DE86E1F6E5E701E70A1738E73FD753A775B7887798E7A0B
+7A7D7CBE7D8E82478A028AEA8C9E912D914A91D8926692CC9320970697560000
+F0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000975C98029F0E52365291557C58245E1D5F1F608C63D068AF6FDF796D7B2C
+81CD85BA88FD8AF88E44918D9664969B973D984C9F4A4FCE514651CB52A95632
+5F145F6B63AA64CD65E9664166FA66F9671D689D68D769FD6F156F6E716771E5
+722A74AA773A7956795A79DF7A207A957C977CDF7D447E70808785FB86A48A54
+8ABF8D998E819020906D91E3963B96D59CE565CF7C078DB393C35B585C0A5352
+62D9731D50275B975F9E60B0616B68D56DD9742E7A2E7D427D9C7E31816B0000
+F1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008E2A8E35937E94184F5057505DE65EA7632B7F6A4E3B4F4F4F8F505A59DD
+80C4546A546855FE594F5B995DDE5EDA665D673167F1682A6CE86D326E4A6F8D
+70B773E075877C4C7D027D2C7DA2821F86DB8A3B8A858D708E8A8F339031914E
+9152944499D07AF97CA54FCA510151C657C85BEF5CFB66596A3D6D5A6E966FEC
+710C756F7AE388229021907596CB99FF83014E2D4EF2884691CD537D6ADB696B
+6C41847A589E618E66FE62EF70DD751175C77E5284B88B498D084E4B53EA0000
+F2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054AB573057405FD763016307646F652F65E8667A679D67B36B626C606C9A
+6F2C77E57825794979577D1980A2810281F3829D82B787188A8CF9FC8D048DBE
+907276F47A197A377E548077550755D45875632F64226649664B686D699B6B84
+6D256EB173CD746874A1755B75B976E1771E778B79E67E097E1D81FB852F8897
+8A3A8CD18EEB8FB0903293AD9663967397074F8453F159EA5AC95E19684E74C6
+75BE79E97A9281A386ED8CEA8DCC8FED659F6715F9FD57F76F577DDD8F2F0000
+F3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000093F696C65FB561F26F844E144F98501F53C955DF5D6F5DEE6B216B6478CB
+7B9AF9FE8E498ECA906E6349643E77407A84932F947F9F6A64B06FAF71E674A8
+74DA7AC47C127E827CB27E988B9A8D0A947D9910994C52395BDF64E6672D7D2E
+50ED53C358796158615961FA65AC7AD98B928B9650095021527555315A3C5EE0
+5F706134655E660C663666A269CD6EC46F32731676217A938139825983D684BC
+50B557F05BC05BE85F6963A178267DB583DC852191C791F5518A67F57B560000
+F4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008CAC51C459BB60BD8655501CF9FF52545C3A617D621A62D364F265A56ECC
+7620810A8E60965F96BB4EDF5343559859295DDD64C56CC96DFA73947A7F821B
+85A68CE48E10907791E795E1962197C651F854F255865FB964A46F887DB48F1F
+8F4D943550C95C166CBE6DFB751B77BB7C3D7C648A798AC2581E59BE5E166377
+7252758A776B8ADC8CBC8F125EF366746DF8807D83C18ACB97519BD6FA005243
+66FF6D956EEF7DE08AE6902E905E9AD4521D527F54E86194628462DB68A20000
+F5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006912695A6A3570927126785D7901790E79D27A0D8096827882D583498549
+8C828D859162918B91AE4FC356D171ED77D7870089F85BF85FD6675190A853E2
+585A5BF560A4618164607E3D80708525928364AE50AC5D146700589C62BD63A8
+690E69786A1E6E6B76BA79CB82BB84298ACF8DA88FFD9112914B919C93109318
+939A96DB9A369C0D4E11755C795D7AFA7B517BC97E2E84C48E598E748EF89010
+6625693F744351FA672E9EDC51455FE06C9687F2885D887760B481B584030000
+F6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008D0553D6543956345A365C31708A7FE0805A810681ED8DA391899A5F9DF2
+50744EC453A060FB6E2C5C644F88502455E45CD95E5F606568946CBB6DC471BE
+75D475F476617A1A7A497DC77DFB7F6E81F486A98F1C96C999B39F52524752C5
+98ED89AA4E0367D26F064FB55BE267956C886D78741B782791DD937C87C479E4
+7A315FEB4ED654A4553E58AE59A560F0625362D6673669558235964099B199DD
+502C53535544577CFA016258FA0264E2666B67DD6FC16FEF742274388A170000
+F7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000094385451560657665F48619A6B4E705870AD7DBB8A95596A812B63A27708
+803D8CAA5854642D69BB5B955E116E6FFA038569514C53F0592A6020614B6B86
+6C706CF07B1E80CE82D48DC690B098B1FA0464C76FA464916504514E5410571F
+8A0E615F6876FA0575DB7B527D71901A580669CC817F892A9000983950785957
+59AC6295900F9B2A615D727995D657615A465DF4628A64AD64FA67776CE26D3E
+722C743678347F7782AD8DDB981752245742677F724874E38CA98FA692110000
+F8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000962A516B53ED634C4F695504609665576C9B6D7F724C72FD7A1789878C9D
+5F6D6F8E70F981A8610E4FBF504F624172477BC77DE87FE9904D97AD9A198CB6
+576A5E7367B0840D8A5554205B165E635EE25F0A658380BA853D9589965B4F48
+5305530D530F548654FA57035E036016629B62B16355FA066CE16D6675B17832
+80DE812F82DE846184B2888D8912900B92EA98FD9B915E4566B466DD70117206
+FA074FF5527D5F6A615367536A196F0274E2796888688C7998C798C49A430000
+F9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054C17A1F69538AF78C4A98A899AE5F7C62AB75B276AE88AB907F96425339
+5F3C5FC56CCC73CC7562758B7B4682FE999D4E4F903C4E0B4F5553A6590F5EC8
+66306CB37455837787668CC09050971E9C1558D15B7886508B149DB45BD26068
+608D65F16C576F226FA3701A7F557FF095919592965097D352728F4451FD542B
+54B85563558A6ABB6DB57DD88266929C96779E79540854C876D286E495A495D4
+965C4EA24F0959EE5AE65DF760526297676D68416C866E2F7F38809B822A0000
+FA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FA08FA0998054EA5505554B35793595A5B695BB361C869776D77702387F9
+89E38A728AE7908299ED9AB852BE683850165E78674F8347884C4EAB541156AE
+73E6911597FF9909995799995653589F865B8A3161B26AF6737B8ED26B4796AA
+9A57595572008D6B97694FD45CF45F2661F8665B6CEB70AB738473B973FE7729
+774D7D437D627E2382378852FA0A8CE29249986F5B517A74884098015ACC4FE0
+5354593E5CFD633E6D7972F98105810783A292CF98304EA851445211578B0000
+FB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F626CC26ECE7005705070AF719273E97469834A87A28861900890A293A3
+99A8516E5F5760E0616766B385598E4A91AF978B4E4E4E92547C58D558FA597D
+5CB55F2762366248660A66676BEB6D696DCF6E566EF86F946FE06FE9705D72D0
+7425745A74E07693795C7CCA7E1E80E182A6846B84BF864E865F87748B778C6A
+93AC9800986560D1621691775A5A660F6DF76E3E743F9B425FFD60DA7B0F54C4
+5F186C5E6CD36D2A70D87D0586798A0C9D3B5316548C5B056A3A706B75750000
+FC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000798D79BE82B183EF8A718B418CA89774FA0B64F4652B78BA78BB7A6B4E38
+559A59505BA65E7B60A363DB6B61666568536E19716574B07D0890849A699C25
+6D3B6ED1733E8C4195CA51F05E4C5FA8604D60F66130614C6643664469A56CC1
+6E5F6EC96F62714C749C76877BC17C27835287579051968D9EC3532F56DE5EFB
+5F8A6062609461F7666667036A9C6DEE6FAE7070736A7E6A81BE833486D48AA8
+8CC4528373725B966A6B940454EE56865B5D6548658566C9689F6D8D6DC60000
+FD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000723B80B491759A4D4FAF5019539A540E543C558955C55E3F5F8C673D7166
+73DD900552DB52F3586458CE7104718F71FB85B08A13668885A855A76684714A
+8431534955996BC15F595FBD63EE668971478AF18F1D9EBE4F11643A70CB7566
+866760648B4E9DF8514751F653086D3680F89ED166156B23709875D554035C79
+7D078A166B206B3D6B46543860706D3D7FD5820850D651DE559C566B56CD59EC
+5B095E0C619961986231665E66E6719971B971BA72A779A77A007FB28A700000
diff --git a/tcl/library/encoding/cp950.enc b/tcl/library/encoding/cp950.enc
new file mode 100644
index 00000000000..881628443c8
--- /dev/null
+++ b/tcl/library/encoding/cp950.enc
@@ -0,0 +1,1499 @@
+# Encoding file: cp950, multi-byte
+M
+003F 0 88
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3000FF0C30013002FF0E2027FF1BFF1AFF1FFF01FE3020262025FE50FE51FE52
+00B7FE54FE55FE56FE57FF5C2013FE312014FE332574FE34FE4FFF08FF09FE35
+FE36FF5BFF5DFE37FE3830143015FE39FE3A30103011FE3BFE3C300A300BFE3D
+FE3E30083009FE3FFE40300C300DFE41FE42300E300FFE43FE44FE59FE5A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FE5BFE5CFE5DFE5E20182019201C201D301D301E20352032FF03FF06FF0A
+203B00A7300325CB25CF25B325B225CE2606260525C725C625A125A025BD25BC
+32A3210500AFFFE3FF3F02CDFE49FE4AFE4DFE4EFE4BFE4CFE5FFE60FE61FF0B
+FF0D00D700F700B1221AFF1CFF1EFF1D226622672260221E22522261FE62FE63
+FE64FE65FE66FF5E2229222A22A52220221F22BF33D233D1222B222E22352234
+26402642229522992191219321902192219621972199219822252223FF0F0000
+A2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FF3C2215FE68FF04FFE53012FFE0FFE1FF05FF2021032109FE69FE6AFE6B33D5
+339C339D339E33CE33A1338E338F33C400B05159515B515E515D5161516355E7
+74E97CCE25812582258325842585258625872588258F258E258D258C258B258A
+2589253C2534252C2524251C2594250025022595250C251025142518256D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000256E2570256F2550255E256A256125E225E325E525E4257125722573FF10
+FF11FF12FF13FF14FF15FF16FF17FF18FF192160216121622163216421652166
+216721682169302130223023302430253026302730283029534153445345FF21
+FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2FFF30FF31
+FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF41FF42FF43FF44FF45FF46FF47
+FF48FF49FF4AFF4BFF4CFF4DFF4EFF4FFF50FF51FF52FF53FF54FF55FF560000
+A3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FF57FF58FF59FF5A039103920393039403950396039703980399039A039B039C
+039D039E039F03A003A103A303A403A503A603A703A803A903B103B203B303B4
+03B503B603B703B803B903BA03BB03BC03BD03BE03BF03C003C103C303C403C5
+03C603C703C803C931053106310731083109310A310B310C310D310E310F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00003110311131123113311431153116311731183119311A311B311C311D311E
+311F312031213122312331243125312631273128312902D902C902CA02C702CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E004E594E014E034E434E5D4E864E8C4EBA513F5165516B51E052005201529B
+53155341535C53C84E094E0B4E084E0A4E2B4E3851E14E454E484E5F4E5E4E8E
+4EA15140520352FA534353C953E3571F58EB5915592759735B505B515B535BF8
+5C0F5C225C385C715DDD5DE55DF15DF25DF35DFE5E725EFE5F0B5F13624D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E114E104E0D4E2D4E304E394E4B5C394E884E914E954E924E944EA24EC1
+4EC04EC34EC64EC74ECD4ECA4ECB4EC4514351415167516D516E516C519751F6
+52065207520852FB52FE52FF53165339534853475345535E538453CB53CA53CD
+58EC5929592B592A592D5B545C115C245C3A5C6F5DF45E7B5EFF5F145F155FC3
+62086236624B624E652F6587659765A465B965E566F0670867286B206B626B79
+6BCB6BD46BDB6C0F6C34706B722A7236723B72477259725B72AC738B4E190000
+A5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E164E154E144E184E3B4E4D4E4F4E4E4EE54ED84ED44ED54ED64ED74EE34EE4
+4ED94EDE514551445189518A51AC51F951FA51F8520A52A0529F530553065317
+531D4EDF534A534953615360536F536E53BB53EF53E453F353EC53EE53E953E8
+53FC53F853F553EB53E653EA53F253F153F053E553ED53FB56DB56DA59160000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000592E5931597459765B555B835C3C5DE85DE75DE65E025E035E735E7C5F01
+5F185F175FC5620A625362546252625165A565E6672E672C672A672B672D6B63
+6BCD6C116C106C386C416C406C3E72AF7384738974DC74E67518751F75287529
+7530753175327533758B767D76AE76BF76EE77DB77E277F3793A79BE7A747ACB
+4E1E4E1F4E524E534E694E994EA44EA64EA54EFF4F094F194F0A4F154F0D4F10
+4F114F0F4EF24EF64EFB4EF04EF34EFD4F014F0B514951475146514851680000
+A6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5171518D51B0521752115212520E521652A3530853215320537053715409540F
+540C540A54105401540B54045411540D54085403540E5406541256E056DE56DD
+573357305728572D572C572F57295919591A59375938598459785983597D5979
+598259815B575B585B875B885B855B895BFA5C165C795DDE5E065E765E740000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F0F5F1B5FD95FD6620E620C620D62106263625B6258653665E965E865EC
+65ED66F266F36709673D6734673167356B216B646B7B6C166C5D6C576C596C5F
+6C606C506C556C616C5B6C4D6C4E7070725F725D767E7AF97C737CF87F367F8A
+7FBD80018003800C80128033807F8089808B808C81E381EA81F381FC820C821B
+821F826E8272827E866B8840884C8863897F96214E324EA84F4D4F4F4F474F57
+4F5E4F344F5B4F554F304F504F514F3D4F3A4F384F434F544F3C4F464F630000
+A7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4F5C4F604F2F4F4E4F364F594F5D4F484F5A514C514B514D517551B651B75225
+52245229522A522852AB52A952AA52AC532353735375541D542D541E543E5426
+544E542754465443543354485442541B5429544A5439543B5438542E54355436
+5420543C54405431542B541F542C56EA56F056E456EB574A57515740574D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005747574E573E5750574F573B58EF593E599D599259A8599E59A359995996
+598D59A45993598A59A55B5D5B5C5B5A5B5B5B8C5B8B5B8F5C2C5C405C415C3F
+5C3E5C905C915C945C8C5DEB5E0C5E8F5E875E8A5EF75F045F1F5F645F625F77
+5F795FD85FCC5FD75FCD5FF15FEB5FF85FEA6212621162846297629662806276
+6289626D628A627C627E627962736292626F6298626E62956293629162866539
+653B653865F166F4675F674E674F67506751675C6756675E6749674667600000
+A8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+675367576B656BCF6C426C5E6C996C816C886C896C856C9B6C6A6C7A6C906C70
+6C8C6C686C966C926C7D6C836C726C7E6C746C866C766C8D6C946C986C827076
+707C707D707872627261726072C472C27396752C752B75377538768276EF77E3
+79C179C079BF7A767CFB7F5580968093809D8098809B809A80B2826F82920000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000828B828D898B89D28A008C378C468C558C9D8D648D708DB38EAB8ECA8F9B
+8FB08FC28FC68FC58FC45DE1909190A290AA90A690A3914991C691CC9632962E
+9631962A962C4E264E564E734E8B4E9B4E9E4EAB4EAC4F6F4F9D4F8D4F734F7F
+4F6C4F9B4F8B4F864F834F704F754F884F694F7B4F964F7E4F8F4F914F7A5154
+51525155516951775176517851BD51FD523B52385237523A5230522E52365241
+52BE52BB5352535453535351536653775378537953D653D453D7547354750000
+A9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5496547854955480547B5477548454925486547C549054715476548C549A5462
+5468548B547D548E56FA57835777576A5769576157665764577C591C59495947
+59485944595459BE59BB59D459B959AE59D159C659D059CD59CB59D359CA59AF
+59B359D259C55B5F5B645B635B975B9A5B985B9C5B995B9B5C1A5C485C450000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C465CB75CA15CB85CA95CAB5CB15CB35E185E1A5E165E155E1B5E115E78
+5E9A5E975E9C5E955E965EF65F265F275F295F805F815F7F5F7C5FDD5FE05FFD
+5FF55FFF600F6014602F60356016602A6015602160276029602B601B62166215
+623F623E6240627F62C962CC62C462BF62C262B962D262DB62AB62D362D462CB
+62C862A862BD62BC62D062D962C762CD62B562DA62B162D862D662D762C662AC
+62CE653E65A765BC65FA66146613660C66066602660E6600660F6615660A0000
+AA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6607670D670B676D678B67956771679C677367776787679D6797676F6770677F
+6789677E67906775679A6793677C676A67726B236B666B676B7F6C136C1B6CE3
+6CE86CF36CB16CCC6CE56CB36CBD6CBE6CBC6CE26CAB6CD56CD36CB86CC46CB9
+6CC16CAE6CD76CC56CF16CBF6CBB6CE16CDB6CCA6CAC6CEF6CDC6CD66CE00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007095708E7092708A7099722C722D723872487267726972C072CE72D972D7
+72D073A973A8739F73AB73A5753D759D7599759A768476C276F276F477E577FD
+793E7940794179C979C87A7A7A797AFA7CFE7F547F8C7F8B800580BA80A580A2
+80B180A180AB80A980B480AA80AF81E581FE820D82B3829D829982AD82BD829F
+82B982B182AC82A582AF82B882A382B082BE82B7864E8671521D88688ECB8FCE
+8FD48FD190B590B890B190B691C791D195779580961C9640963F963B96440000
+AB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+964296B996E89752975E4E9F4EAD4EAE4FE14FB54FAF4FBF4FE04FD14FCF4FDD
+4FC34FB64FD84FDF4FCA4FD74FAE4FD04FC44FC24FDA4FCE4FDE4FB751575192
+519151A0524E5243524A524D524C524B524752C752C952C352C1530D5357537B
+539A53DB54AC54C054A854CE54C954B854A654B354C754C254BD54AA54C10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054C454C854AF54AB54B154BB54A954A754BF56FF5782578B57A057A357A2
+57CE57AE579359555951594F594E595059DC59D859FF59E359E85A0359E559EA
+59DA59E65A0159FB5B695BA35BA65BA45BA25BA55C015C4E5C4F5C4D5C4B5CD9
+5CD25DF75E1D5E255E1F5E7D5EA05EA65EFA5F085F2D5F655F885F855F8A5F8B
+5F875F8C5F896012601D60206025600E6028604D60706068606260466043606C
+606B606A6064624162DC6316630962FC62ED630162EE62FD630762F162F70000
+AC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62EF62EC62FE62F463116302653F654565AB65BD65E26625662D66206627662F
+661F66286631662466F767FF67D367F167D467D067EC67B667AF67F567E967EF
+67C467D167B467DA67E567B867CF67DE67F367B067D967E267DD67D26B6A6B83
+6B866BB56BD26BD76C1F6CC96D0B6D326D2A6D416D256D0C6D316D1E6D170000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D3B6D3D6D3E6D366D1B6CF56D396D276D386D296D2E6D356D0E6D2B70AB
+70BA70B370AC70AF70AD70B870AE70A472307272726F727472E972E072E173B7
+73CA73BB73B273CD73C073B3751A752D754F754C754E754B75AB75A475A575A2
+75A3767876867687768876C876C676C376C5770176F976F87709770B76FE76FC
+770777DC78027814780C780D794679497948794779B979BA79D179D279CB7A7F
+7A817AFF7AFD7C7D7D027D057D007D097D077D047D067F387F8E7FBF80040000
+AD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8010800D8011803680D680E580DA80C380C480CC80E180DB80CE80DE80E480DD
+81F4822282E78303830582E382DB82E6830482E58302830982D282D782F18301
+82DC82D482D182DE82D382DF82EF830686508679867B867A884D886B898189D4
+8A088A028A038C9E8CA08D748D738DB48ECD8ECC8FF08FE68FE28FEA8FE50000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008FED8FEB8FE48FE890CA90CE90C190C3914B914A91CD95829650964B964C
+964D9762976997CB97ED97F3980198A898DB98DF999699994E584EB3500C500D
+50234FEF502650254FF8502950165006503C501F501A501250114FFA50005014
+50284FF15021500B501950184FF34FEE502D502A4FFE502B5009517C51A451A5
+51A251CD51CC51C651CB5256525C5254525B525D532A537F539F539D53DF54E8
+55105501553754FC54E554F2550654FA551454E954ED54E1550954EE54EA0000
+AE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54E65527550754FD550F5703570457C257D457CB57C35809590F59575958595A
+5A115A185A1C5A1F5A1B5A1359EC5A205A235A295A255A0C5A095B6B5C585BB0
+5BB35BB65BB45BAE5BB55BB95BB85C045C515C555C505CED5CFD5CFB5CEA5CE8
+5CF05CF65D015CF45DEE5E2D5E2B5EAB5EAD5EA75F315F925F915F9060590000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006063606560506055606D6069606F6084609F609A608D6094608C60856096
+624762F3630862FF634E633E632F635563426346634F6349633A6350633D632A
+632B6328634D634C65486549659965C165C566426649664F66436652664C6645
+664166F867146715671768216838684868466853683968426854682968B36817
+684C6851683D67F468506840683C6843682A68456813681868416B8A6B896BB7
+6C236C276C286C266C246CF06D6A6D956D886D876D666D786D776D596D930000
+AF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6D6C6D896D6E6D5A6D746D696D8C6D8A6D796D856D656D9470CA70D870E470D9
+70C870CF7239727972FC72F972FD72F872F7738673ED740973EE73E073EA73DE
+7554755D755C755A755975BE75C575C775B275B375BD75BC75B975C275B8768B
+76B076CA76CD76CE7729771F7720772877E9783078277838781D783478370000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007825782D7820781F7832795579507960795F7956795E795D7957795A79E4
+79E379E779DF79E679E979D87A847A887AD97B067B117C897D217D177D0B7D0A
+7D207D227D147D107D157D1A7D1C7D0D7D197D1B7F3A7F5F7F947FC57FC18006
+8018801580198017803D803F80F1810280F0810580ED80F4810680F880F38108
+80FD810A80FC80EF81ED81EC82008210822A822B8228822C82BB832B83528354
+834A83388350834983358334834F833283398336831783408331832883430000
+B0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8654868A86AA869386A486A9868C86A3869C8870887788818882887D88798A18
+8A108A0E8A0C8A158A0A8A178A138A168A0F8A118C488C7A8C798CA18CA28D77
+8EAC8ED28ED48ECF8FB1900190068FF790008FFA8FF490038FFD90058FF89095
+90E190DD90E29152914D914C91D891DD91D791DC91D995839662966396610000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000965B965D96649658965E96BB98E299AC9AA89AD89B259B329B3C4E7E507A
+507D505C50475043504C505A504950655076504E5055507550745077504F500F
+506F506D515C519551F0526A526F52D252D952D852D55310530F5319533F5340
+533E53C366FC5546556A55665544555E55615543554A55315556554F5555552F
+55645538552E555C552C55635533554155575708570B570957DF5805580A5806
+57E057E457FA5802583557F757F9592059625A365A415A495A665A6A5A400000
+B1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A3C5A625A5A5A465A4A5B705BC75BC55BC45BC25BBF5BC65C095C085C075C60
+5C5C5C5D5D075D065D0E5D1B5D165D225D115D295D145D195D245D275D175DE2
+5E385E365E335E375EB75EB85EB65EB55EBE5F355F375F575F6C5F695F6B5F97
+5F995F9E5F985FA15FA05F9C607F60A3608960A060A860CB60B460E660BD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060C560BB60B560DC60BC60D860D560C660DF60B860DA60C7621A621B6248
+63A063A76372639663A263A563776367639863AA637163A963896383639B636B
+63A863846388639963A163AC6392638F6380637B63696368637A655D65566551
+65596557555F654F655865556554659C659B65AC65CF65CB65CC65CE665D665A
+666466686666665E66F952D7671B688168AF68A2689368B5687F687668B168A7
+689768B0688368C468AD688668856894689D68A8689F68A168826B326BBA0000
+B2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6BEB6BEC6C2B6D8E6DBC6DF36DD96DB26DE16DCC6DE46DFB6DFA6E056DC76DCB
+6DAF6DD16DAE6DDE6DF96DB86DF76DF56DC56DD26E1A6DB56DDA6DEB6DD86DEA
+6DF16DEE6DE86DC66DC46DAA6DEC6DBF6DE670F97109710A70FD70EF723D727D
+7281731C731B73167313731973877405740A7403740673FE740D74E074F60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000074F7751C75227565756675627570758F75D475D575B575CA75CD768E76D4
+76D276DB7737773E773C77367738773A786B7843784E79657968796D79FB7A92
+7A957B207B287B1B7B2C7B267B197B1E7B2E7C927C977C957D467D437D717D2E
+7D397D3C7D407D307D337D447D2F7D427D327D317F3D7F9E7F9A7FCC7FCE7FD2
+801C804A8046812F81168123812B81298130812482028235823782368239838E
+839E8398837883A2839683BD83AB8392838A8393838983A08377837B837C0000
+B3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+838683A786555F6A86C786C086B686C486B586C686CB86B186AF86C98853889E
+888888AB88928896888D888B8993898F8A2A8A1D8A238A258A318A2D8A1F8A1B
+8A228C498C5A8CA98CAC8CAB8CA88CAA8CA78D678D668DBE8DBA8EDB8EDF9019
+900D901A90179023901F901D90109015901E9020900F90229016901B90140000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090E890ED90FD915791CE91F591E691E391E791ED91E99589966A96759673
+96789670967496769677966C96C096EA96E97AE07ADF980298039B5A9CE59E75
+9E7F9EA59EBB50A2508D508550995091508050965098509A670051F152725274
+5275526952DE52DD52DB535A53A5557B558055A7557C558A559D55985582559C
+55AA55945587558B558355B355AE559F553E55B2559A55BB55AC55B1557E5589
+55AB5599570D582F582A58345824583058315821581D582058F958FA59600000
+B4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A775A9A5A7F5A925A9B5AA75B735B715BD25BCC5BD35BD05C0A5C0B5C315D4C
+5D505D345D475DFD5E455E3D5E405E435E7E5ECA5EC15EC25EC45F3C5F6D5FA9
+5FAA5FA860D160E160B260B660E0611C612360FA611560F060FB60F4616860F1
+610E60F6610961006112621F624963A3638C63CF63C063E963C963C663CD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000063D263E363D063E163D663ED63EE637663F463EA63DB645263DA63F9655E
+6566656265636591659065AF666E667066746676666F6691667A667E667766FE
+66FF671F671D68FA68D568E068D868D7690568DF68F568EE68E768F968D268F2
+68E368CB68CD690D6912690E68C968DA696E68FB6B3E6B3A6B3D6B986B966BBC
+6BEF6C2E6C2F6C2C6E2F6E386E546E216E326E676E4A6E206E256E236E1B6E5B
+6E586E246E566E6E6E2D6E266E6F6E346E4D6E3A6E2C6E436E1D6E3E6ECB0000
+B5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6E896E196E4E6E636E446E726E696E5F7119711A7126713071217136716E711C
+724C728472807336732573347329743A742A743374227425743574367434742F
+741B7426742875257526756B756A75E275DB75E375D975D875DE75E0767B767C
+7696769376B476DC774F77ED785D786C786F7A0D7A087A0B7A057A007A980000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A977A967AE57AE37B497B567B467B507B527B547B4D7B4B7B4F7B517C9F
+7CA57D5E7D507D687D557D2B7D6E7D727D617D667D627D707D7355847FD47FD5
+800B8052808581558154814B8151814E81398146813E814C815381748212821C
+83E9840383F8840D83E083C5840B83C183EF83F183F48457840A83F0840C83CC
+83FD83F283CA8438840E840483DC840783D483DF865B86DF86D986ED86D486DB
+86E486D086DE885788C188C288B1898389968A3B8A608A558A5E8A3C8A410000
+B6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8A548A5B8A508A468A348A3A8A368A568C618C828CAF8CBC8CB38CBD8CC18CBB
+8CC08CB48CB78CB68CBF8CB88D8A8D858D818DCE8DDD8DCB8DDA8DD18DCC8DDB
+8DC68EFB8EF88EFC8F9C902E90359031903890329036910290F5910990FE9163
+916591CF9214921592239209921E920D9210920792119594958F958B95910000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000095939592958E968A968E968B967D96859686968D9672968496C196C596C4
+96C696C796EF96F297CC98059806980898E798EA98EF98E998F298ED99AE99AD
+9EC39ECD9ED14E8250AD50B550B250B350C550BE50AC50B750BB50AF50C7527F
+5277527D52DF52E652E452E252E3532F55DF55E855D355E655CE55DC55C755D1
+55E355E455EF55DA55E155C555C655E555C957125713585E585158585857585A
+5854586B584C586D584A58625852584B59675AC15AC95ACC5ABE5ABD5ABC0000
+B7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5AB35AC25AB25D695D6F5E4C5E795EC95EC85F125F595FAC5FAE611A610F6148
+611F60F3611B60F961016108614E614C6144614D613E61346127610D61066137
+622162226413643E641E642A642D643D642C640F641C6414640D643664166417
+6406656C659F65B06697668966876688669666846698668D67036994696D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000695A697769606954697569306982694A6968696B695E695369796986695D
+6963695B6B476B726BC06BBF6BD36BFD6EA26EAF6ED36EB66EC26E906E9D6EC7
+6EC56EA56E986EBC6EBA6EAB6ED16E966E9C6EC46ED46EAA6EA76EB4714E7159
+7169716471497167715C716C7166714C7165715E714671687156723A72527337
+7345733F733E746F745A7455745F745E7441743F7459745B745C757675787600
+75F0760175F275F175FA75FF75F475F376DE76DF775B776B7766775E77630000
+B8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7779776A776C775C77657768776277EE788E78B078977898788C7889787C7891
+7893787F797A797F7981842C79BD7A1C7A1A7A207A147A1F7A1E7A9F7AA07B77
+7BC07B607B6E7B677CB17CB37CB57D937D797D917D817D8F7D5B7F6E7F697F6A
+7F727FA97FA87FA480568058808680848171817081788165816E8173816B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008179817A81668205824784828477843D843184758466846B8449846C845B
+843C8435846184638469846D8446865E865C865F86F9871387088707870086FE
+86FB870287038706870A885988DF88D488D988DC88D888DD88E188CA88D588D2
+899C89E38A6B8A728A738A668A698A708A878A7C8A638AA08A718A858A6D8A62
+8A6E8A6C8A798A7B8A3E8A688C628C8A8C898CCA8CC78CC88CC48CB28CC38CC2
+8CC58DE18DDF8DE88DEF8DF38DFA8DEA8DE48DE68EB28F038F098EFE8F0A0000
+B9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8F9F8FB2904B904A905390429054903C905590509047904F904E904D9051903E
+904191129117916C916A916991C9923792579238923D9240923E925B924B9264
+925192349249924D92459239923F925A959896989694969596CD96CB96C996CA
+96F796FB96F996F6975697749776981098119813980A9812980C98FC98F40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000098FD98FE99B399B199B49AE19CE99E829F0E9F139F2050E750EE50E550D6
+50ED50DA50D550CF50D150F150CE50E9516251F352835282533153AD55FE5600
+561B561755FD561456065609560D560E55F75616561F5608561055F657185716
+5875587E58835893588A58795885587D58FD592559225924596A59695AE15AE6
+5AE95AD75AD65AD85AE35B755BDE5BE75BE15BE55BE65BE85BE25BE45BDF5C0D
+5C625D845D875E5B5E635E555E575E545ED35ED65F0A5F465F705FB961470000
+BA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+613F614B617761626163615F615A61586175622A64876458645464A46478645F
+647A645164676434646D647B657265A165D765D666A266A8669D699C69A86995
+69C169AE69D369CB699B69B769BB69AB69B469D069CD69AD69CC69A669C369A3
+6B496B4C6C336F336F146EFE6F136EF46F296F3E6F206F2C6F0F6F026F220000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006EFF6EEF6F066F316F386F326F236F156F2B6F2F6F886F2A6EEC6F016EF2
+6ECC6EF771947199717D718A71847192723E729272967344735074647463746A
+7470746D750475917627760D760B7609761376E176E37784777D777F776178C1
+789F78A778B378A978A3798E798F798D7A2E7A317AAA7AA97AED7AEF7BA17B95
+7B8B7B757B977B9D7B947B8F7BB87B877B847CB97CBD7CBE7DBB7DB07D9C7DBD
+7DBE7DA07DCA7DB47DB27DB17DBA7DA27DBF7DB57DB87DAD7DD27DC77DAC0000
+BB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7F707FE07FE17FDF805E805A808781508180818F8188818A817F818281E781FA
+82078214821E824B84C984BF84C684C48499849E84B2849C84CB84B884C084D3
+849084BC84D184CA873F871C873B872287258734871887558737872988F38902
+88F488F988F888FD88E8891A88EF8AA68A8C8A9E8AA38A8D8AA18A938AA40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008AAA8AA58AA88A988A918A9A8AA78C6A8C8D8C8C8CD38CD18CD28D6B8D99
+8D958DFC8F148F128F158F138FA390609058905C90639059905E9062905D905B
+91199118911E917591789177917492789280928592989296927B9293929C92A8
+927C929195A195A895A995A395A595A49699969C969B96CC96D29700977C9785
+97F69817981898AF98B199039905990C990999C19AAF9AB09AE69B419B429CF4
+9CF69CF39EBC9F3B9F4A5104510050FB50F550F9510251085109510551DC0000
+BC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+528752885289528D528A52F053B2562E563B56395632563F563456295653564E
+565756745636562F56305880589F589E58B3589C58AE58A958A6596D5B095AFB
+5B0B5AF55B0C5B085BEE5BEC5BE95BEB5C645C655D9D5D945E625E5F5E615EE2
+5EDA5EDF5EDD5EE35EE05F485F715FB75FB561766167616E615D615561820000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000617C6170616B617E61A7619061AB618E61AC619A61A4619461AE622E6469
+646F6479649E64B26488649064B064A56493649564A9649264AE64AD64AB649A
+64AC649964A264B365756577657866AE66AB66B466B16A236A1F69E86A016A1E
+6A1969FD6A216A136A0A69F36A026A0569ED6A116B506B4E6BA46BC56BC66F3F
+6F7C6F846F516F666F546F866F6D6F5B6F786F6E6F8E6F7A6F706F646F976F58
+6ED56F6F6F606F5F719F71AC71B171A87256729B734E73577469748B74830000
+BD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+747E7480757F76207629761F7624762676217622769A76BA76E4778E7787778C
+7791778B78CB78C578BA78CA78BE78D578BC78D07A3F7A3C7A407A3D7A377A3B
+7AAF7AAE7BAD7BB17BC47BB47BC67BC77BC17BA07BCC7CCA7DE07DF47DEF7DFB
+7DD87DEC7DDD7DE87DE37DDA7DDE7DE97D9E7DD97DF27DF97F757F777FAF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007FE98026819B819C819D81A0819A81988517853D851A84EE852C852D8513
+851185238521851484EC852584FF850687828774877687608766877887688759
+8757874C8753885B885D89108907891289138915890A8ABC8AD28AC78AC48A95
+8ACB8AF88AB28AC98AC28ABF8AB08AD68ACD8AB68AB98ADB8C4C8C4E8C6C8CE0
+8CDE8CE68CE48CEC8CED8CE28CE38CDC8CEA8CE18D6D8D9F8DA38E2B8E108E1D
+8E228E0F8E298E1F8E218E1E8EBA8F1D8F1B8F1F8F298F268F2A8F1C8F1E0000
+BE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8F259069906E9068906D90779130912D9127913191879189918B918392C592BB
+92B792EA92AC92E492C192B392BC92D292C792F092B295AD95B1970497069707
+97099760978D978B978F9821982B981C98B3990A99139912991899DD99D099DF
+99DB99D199D599D299D99AB79AEE9AEF9B279B459B449B779B6F9D069D090000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009D039EA99EBE9ECE58A89F5251125118511451105115518051AA51DD5291
+529352F35659566B5679566956645678566A566856655671566F566C56625676
+58C158BE58C758C5596E5B1D5B345B785BF05C0E5F4A61B2619161A9618A61CD
+61B661BE61CA61C8623064C564C164CB64BB64BC64DA64C464C764C264CD64BF
+64D264D464BE657466C666C966B966C466C766B86A3D6A386A3A6A596A6B6A58
+6A396A446A626A616A4B6A476A356A5F6A486B596B776C056FC26FB16FA10000
+BF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6FC36FA46FC16FA76FB36FC06FB96FB66FA66FA06FB471BE71C971D071D271C8
+71D571B971CE71D971DC71C371C47368749C74A37498749F749E74E2750C750D
+76347638763A76E776E577A0779E779F77A578E878DA78EC78E779A67A4D7A4E
+7A467A4C7A4B7ABA7BD97C117BC97BE47BDB7BE17BE97BE67CD57CD67E0A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007E117E087E1B7E237E1E7E1D7E097E107F797FB27FF07FF17FEE802881B3
+81A981A881FB820882588259854A855985488568856985438549856D856A855E
+8783879F879E87A2878D8861892A89328925892B892189AA89A68AE68AFA8AEB
+8AF18B008ADC8AE78AEE8AFE8B018B028AF78AED8AF38AF68AFC8C6B8C6D8C93
+8CF48E448E318E348E428E398E358F3B8F2F8F388F338FA88FA6907590749078
+9072907C907A913491929320933692F89333932F932292FC932B9304931A0000
+C0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9310932693219315932E931995BB96A796A896AA96D5970E97119716970D9713
+970F975B975C9766979898309838983B9837982D9839982499109928991E991B
+9921991A99ED99E299F19AB89ABC9AFB9AED9B289B919D159D239D269D289D12
+9D1B9ED89ED49F8D9F9C512A511F5121513252F5568E56805690568556870000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000568F58D558D358D158CE5B305B2A5B245B7A5C375C685DBC5DBA5DBD5DB8
+5E6B5F4C5FBD61C961C261C761E661CB6232623464CE64CA64D864E064F064E6
+64EC64F164E264ED6582658366D966D66A806A946A846AA26A9C6ADB6AA36A7E
+6A976A906AA06B5C6BAE6BDA6C086FD86FF16FDF6FE06FDB6FE46FEB6FEF6F80
+6FEC6FE16FE96FD56FEE6FF071E771DF71EE71E671E571ED71EC71F471E07235
+72467370737274A974B074A674A876467642764C76EA77B377AA77B077AC0000
+C1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+77A777AD77EF78F778FA78F478EF790179A779AA7A577ABF7C077C0D7BFE7BF7
+7C0C7BE07CE07CDC7CDE7CE27CDF7CD97CDD7E2E7E3E7E467E377E327E437E2B
+7E3D7E317E457E417E347E397E487E357E3F7E2F7F447FF37FFC807180728070
+806F807381C681C381BA81C281C081BF81BD81C981BE81E88209827185AA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008584857E859C8591859485AF859B858785A8858A866787C087D187B387D2
+87C687AB87BB87BA87C887CB893B893689448938893D89AC8B0E8B178B198B1B
+8B0A8B208B1D8B048B108C418C3F8C738CFA8CFD8CFC8CF88CFB8DA88E498E4B
+8E488E4A8F448F3E8F428F458F3F907F907D9084908190829080913991A3919E
+919C934D938293289375934A9365934B9318937E936C935B9370935A935495CA
+95CB95CC95C895C696B196B896D6971C971E97A097D3984698B699359A010000
+C2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+99FF9BAE9BAB9BAA9BAD9D3B9D3F9E8B9ECF9EDE9EDC9EDD9EDB9F3E9F4B53E2
+569556AE58D958D85B385F5D61E3623364F464F264FE650664FA64FB64F765B7
+66DC67266AB36AAC6AC36ABB6AB86AC26AAE6AAF6B5F6B786BAF7009700B6FFE
+70066FFA7011700F71FB71FC71FE71F87377737574A774BF7515765676580000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000765277BD77BF77BB77BC790E79AE7A617A627A607AC47AC57C2B7C277C2A
+7C1E7C237C217CE77E547E557E5E7E5A7E617E527E597F487FF97FFB80778076
+81CD81CF820A85CF85A985CD85D085C985B085BA85B985A687EF87EC87F287E0
+898689B289F48B288B398B2C8B2B8C508D058E598E638E668E648E5F8E558EC0
+8F498F4D90879083908891AB91AC91D09394938A939693A293B393AE93AC93B0
+9398939A939795D495D695D095D596E296DC96D996DB96DE972497A397A60000
+C3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+97AD97F9984D984F984C984E985398BA993E993F993D992E99A59A0E9AC19B03
+9B069B4F9B4E9B4D9BCA9BC99BFD9BC89BC09D519D5D9D609EE09F159F2C5133
+56A558DE58DF58E25BF59F905EEC61F261F761F661F56500650F66E066DD6AE5
+6ADD6ADA6AD3701B701F7028701A701D701570187206720D725872A273780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000737A74BD74CA74E375877586765F766177C7791979B17A6B7A697C3E7C3F
+7C387C3D7C377C407E6B7E6D7E797E697E6A7F857E737FB67FB97FB881D885E9
+85DD85EA85D585E485E585F787FB8805880D87F987FE8960895F8956895E8B41
+8B5C8B588B498B5A8B4E8B4F8B468B598D088D0A8E7C8E728E878E768E6C8E7A
+8E748F548F4E8FAD908A908B91B191AE93E193D193DF93C393C893DC93DD93D6
+93E293CD93D893E493D793E895DC96B496E3972A9727976197DC97FB985E0000
+C4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9858985B98BC994599499A169A199B0D9BE89BE79BD69BDB9D899D619D729D6A
+9D6C9E929E979E939EB452F856A856B756B656B456BC58E45B405B435B7D5BF6
+5DC961F861FA65186514651966E667276AEC703E703070327210737B74CF7662
+76657926792A792C792B7AC77AF67C4C7C437C4D7CEF7CF08FAE7E7D7E7C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007E827F4C800081DA826685FB85F9861185FA8606860B8607860A88148815
+896489BA89F88B708B6C8B668B6F8B5F8B6B8D0F8D0D8E898E818E858E8291B4
+91CB9418940393FD95E1973098C49952995199A89A2B9A309A379A359C139C0D
+9E799EB59EE89F2F9F5F9F639F615137513856C156C056C259145C6C5DCD61FC
+61FE651D651C659566E96AFB6B046AFA6BB2704C721B72A774D674D4766977D3
+7C507E8F7E8C7FBC8617862D861A882388228821881F896A896C89BD8B740000
+C5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B778B7D8D138E8A8E8D8E8B8F5F8FAF91BA942E94339435943A94389432942B
+95E297389739973297FF9867986599579A459A439A409A3E9ACF9B549B519C2D
+9C259DAF9DB49DC29DB89E9D9EEF9F199F5C9F669F67513C513B56C856CA56C9
+5B7F5DD45DD25F4E61FF65246B0A6B6170517058738074E4758A766E766C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000079B37C607C5F807E807D81DF8972896F89FC8B808D168D178E918E938F61
+9148944494519452973D973E97C397C1986B99559A559A4D9AD29B1A9C499C31
+9C3E9C3B9DD39DD79F349F6C9F6A9F9456CC5DD662006523652B652A66EC6B10
+74DA7ACA7C647C637C657E937E967E9481E28638863F88318B8A9090908F9463
+946094649768986F995C9A5A9A5B9A579AD39AD49AD19C549C579C569DE59E9F
+9EF456D158E9652C705E7671767277D77F507F888836883988628B938B920000
+C6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B9682778D1B91C0946A97429748974497C698709A5F9B229B589C5F9DF99DFA
+9E7C9E7D9F079F779F725EF36B1670637C6C7C6E883B89C08EA191C194729470
+9871995E9AD69B239ECC706477DA8B9A947797C99A629A657E9C8B9C8EAA91C5
+947D947E947C9C779C789EF78C54947F9E1A72289A6A9B319E1B9E1E7C720000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+C9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E424E5C51F5531A53824E074E0C4E474E8D56D7FA0C5C6E5F734E0F51874E0E
+4E2E4E934EC24EC94EC8519852FC536C53B957205903592C5C105DFF65E16BB3
+6BCC6C14723F4E314E3C4EE84EDC4EE94EE14EDD4EDA520C531C534C57225723
+5917592F5B815B845C125C3B5C745C735E045E805E825FC9620962506C150000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006C366C436C3F6C3B72AE72B0738A79B8808A961E4F0E4F184F2C4EF54F14
+4EF14F004EF74F084F1D4F024F054F224F134F044EF44F1251B1521352095210
+52A65322531F534D538A540756E156DF572E572A5734593C5980597C5985597B
+597E5977597F5B565C155C255C7C5C7A5C7B5C7E5DDF5E755E845F025F1A5F74
+5FD55FD45FCF625C625E626462616266626262596260625A626565EF65EE673E
+67396738673B673A673F673C67336C186C466C526C5C6C4F6C4A6C546C4B0000
+CA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6C4C7071725E72B472B5738E752A767F7A757F518278827C8280827D827F864D
+897E909990979098909B909496229624962096234F564F3B4F624F494F534F64
+4F3E4F674F524F5F4F414F584F2D4F334F3F4F61518F51B9521C521E522152AD
+52AE530953635372538E538F54305437542A545454455419541C542554180000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000543D544F544154285424544756EE56E756E557415745574C5749574B5752
+5906594059A6599859A05997598E59A25990598F59A759A15B8E5B925C285C2A
+5C8D5C8F5C885C8B5C895C925C8A5C865C935C955DE05E0A5E0E5E8B5E895E8C
+5E885E8D5F055F1D5F785F765FD25FD15FD05FED5FE85FEE5FF35FE15FE45FE3
+5FFA5FEF5FF75FFB60005FF4623A6283628C628E628F629462876271627B627A
+6270628162886277627D62726274653765F065F465F365F265F5674567470000
+CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67596755674C6748675D674D675A674B6BD06C196C1A6C786C676C6B6C846C8B
+6C8F6C716C6F6C696C9A6C6D6C876C956C9C6C666C736C656C7B6C8E7074707A
+726372BF72BD72C372C672C172BA72C573957397739373947392753A75397594
+75957681793D80348095809980908092809C8290828F8285828E829182930000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000828A828382848C788FC98FBF909F90A190A5909E90A790A096309628962F
+962D4E334F984F7C4F854F7D4F804F874F764F744F894F844F774F4C4F974F6A
+4F9A4F794F814F784F904F9C4F944F9E4F924F824F954F6B4F6E519E51BC51BE
+5235523252335246523152BC530A530B533C539253945487547F548154915482
+5488546B547A547E5465546C54745466548D546F546154605498546354675464
+56F756F9576F5772576D576B57715770577657805775577B5773577457620000
+CC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5768577D590C594559B559BA59CF59CE59B259CC59C159B659BC59C359D659B1
+59BD59C059C859B459C75B625B655B935B955C445C475CAE5CA45CA05CB55CAF
+5CA85CAC5C9F5CA35CAD5CA25CAA5CA75C9D5CA55CB65CB05CA65E175E145E19
+5F285F225F235F245F545F825F7E5F7D5FDE5FE5602D602660196032600B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006034600A60176033601A601E602C6022600D6010602E60136011600C6009
+601C6214623D62AD62B462D162BE62AA62B662CA62AE62B362AF62BB62A962B0
+62B8653D65A865BB660965FC66046612660865FB6603660B660D660565FD6611
+661066F6670A6785676C678E67926776677B6798678667846774678D678C677A
+679F679167996783677D67816778677967946B256B806B7E6BDE6C1D6C936CEC
+6CEB6CEE6CD96CB66CD46CAD6CE76CB76CD06CC26CBA6CC36CC66CED6CF20000
+CD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6CD26CDD6CB46C8A6C9D6C806CDE6CC06D306CCD6CC76CB06CF96CCF6CE96CD1
+709470987085709370867084709170967082709A7083726A72D672CB72D872C9
+72DC72D272D472DA72CC72D173A473A173AD73A673A273A073AC739D74DD74E8
+753F7540753E758C759876AF76F376F176F076F577F877FC77F977FB77FA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077F77942793F79C57A787A7B7AFB7C757CFD8035808F80AE80A380B880B5
+80AD822082A082C082AB829A8298829B82B582A782AE82BC829E82BA82B482A8
+82A182A982C282A482C382B682A28670866F866D866E8C568FD28FCB8FD38FCD
+8FD68FD58FD790B290B490AF90B390B09639963D963C963A96434FCD4FC54FD3
+4FB24FC94FCB4FC14FD44FDC4FD94FBB4FB34FDB4FC74FD64FBA4FC04FB94FEC
+5244524952C052C2533D537C539753965399539854BA54A154AD54A554CF0000
+CE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54C3830D54B754AE54D654B654C554C654A0547054BC54A254BE547254DE54B0
+57B5579E579F57A4578C5797579D579B57945798578F579957A5579A579558F4
+590D595359E159DE59EE5A0059F159DD59FA59FD59FC59F659E459F259F759DB
+59E959F359F559E059FE59F459ED5BA85C4C5CD05CD85CCC5CD75CCB5CDB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005CDE5CDA5CC95CC75CCA5CD65CD35CD45CCF5CC85CC65CCE5CDF5CF85DF9
+5E215E225E235E205E245EB05EA45EA25E9B5EA35EA55F075F2E5F565F866037
+603960546072605E6045605360476049605B604C60406042605F602460446058
+6066606E6242624362CF630D630B62F5630E630362EB62F9630F630C62F862F6
+63006313631462FA631562FB62F06541654365AA65BF6636662166326635661C
+662666226633662B663A661D66346639662E670F671067C167F267C867BA0000
+CF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67DC67BB67F867D867C067B767C567EB67E467DF67B567CD67B367F767F667EE
+67E367C267B967CE67E767F067B267FC67C667ED67CC67AE67E667DB67FA67C9
+67CA67C367EA67CB6B286B826B846BB66BD66BD86BE06C206C216D286D346D2D
+6D1F6D3C6D3F6D126D0A6CDA6D336D046D196D3A6D1A6D116D006D1D6D420000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D016D186D376D036D0F6D406D076D206D2C6D086D226D096D1070B7709F
+70BE70B170B070A170B470B570A972417249724A726C72707273726E72CA72E4
+72E872EB72DF72EA72E672E3738573CC73C273C873C573B973B673B573B473EB
+73BF73C773BE73C373C673B873CB74EC74EE752E7547754875A775AA767976C4
+7708770377047705770A76F776FB76FA77E777E878067811781278057810780F
+780E780978037813794A794C794B7945794479D579CD79CF79D679CE7A800000
+D0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7A7E7AD17B007B017C7A7C787C797C7F7C807C817D037D087D017F587F917F8D
+7FBE8007800E800F8014803780D880C780E080D180C880C280D080C580E380D9
+80DC80CA80D580C980CF80D780E680CD81FF8221829482D982FE82F9830782E8
+830082D5833A82EB82D682F482EC82E182F282F5830C82FB82F682F082EA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000082E482E082FA82F382ED86778674867C86738841884E8867886A886989D3
+8A048A078D728FE38FE18FEE8FE090F190BD90BF90D590C590BE90C790CB90C8
+91D491D39654964F96519653964A964E501E50055007501350225030501B4FF5
+4FF450335037502C4FF64FF75017501C502050275035502F5031500E515A5194
+519351CA51C451C551C851CE5261525A5252525E525F5255526252CD530E539E
+552654E25517551254E754F354E4551A54FF5504550854EB5511550554F10000
+D1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+550A54FB54F754F854E0550E5503550B5701570257CC583257D557D257BA57C6
+57BD57BC57B857B657BF57C757D057B957C1590E594A5A195A165A2D5A2E5A15
+5A0F5A175A0A5A1E5A335B6C5BA75BAD5BAC5C035C565C545CEC5CFF5CEE5CF1
+5CF75D005CF95E295E285EA85EAE5EAA5EAC5F335F305F67605D605A60670000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000604160A26088608060926081609D60836095609B60976087609C608E6219
+624662F263106356632C634463456336634363E46339634B634A633C63296341
+6334635863546359632D63476333635A63516338635763406348654A654665C6
+65C365C465C2664A665F6647665167126713681F681A684968326833683B684B
+684F68166831681C6835682B682D682F684E68446834681D6812681468266828
+682E684D683A682568206B2C6B2F6B2D6B316B346B6D80826B886BE66BE40000
+D2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6BE86BE36BE26BE76C256D7A6D636D646D766D0D6D616D926D586D626D6D6D6F
+6D916D8D6DEF6D7F6D866D5E6D676D606D976D706D7C6D5F6D826D986D2F6D68
+6D8B6D7E6D806D846D166D836D7B6D7D6D756D9070DC70D370D170DD70CB7F39
+70E270D770D270DE70E070D470CD70C570C670C770DA70CE70E1724272780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000072777276730072FA72F472FE72F672F372FB730173D373D973E573D673BC
+73E773E373E973DC73D273DB73D473DD73DA73D773D873E874DE74DF74F474F5
+7521755B755F75B075C175BB75C475C075BF75B675BA768A76C9771D771B7710
+771377127723771177157719771A772277277823782C78227835782F7828782E
+782B782178297833782A78317954795B794F795C79537952795179EB79EC79E0
+79EE79ED79EA79DC79DE79DD7A867A897A857A8B7A8C7A8A7A877AD87B100000
+D3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7B047B137B057B0F7B087B0A7B0E7B097B127C847C917C8A7C8C7C887C8D7C85
+7D1E7D1D7D117D0E7D187D167D137D1F7D127D0F7D0C7F5C7F617F5E7F607F5D
+7F5B7F967F927FC37FC27FC08016803E803980FA80F280F980F5810180FB8100
+8201822F82258333832D83448319835183258356833F83418326831C83220000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008342834E831B832A8308833C834D8316832483208337832F832983478345
+834C8353831E832C834B832783488653865286A286A88696868D8691869E8687
+86978686868B869A868586A5869986A186A786958698868E869D869086948843
+8844886D88758876887288808871887F886F8883887E8874887C8A128C478C57
+8C7B8CA48CA38D768D788DB58DB78DB68ED18ED38FFE8FF590028FFF8FFB9004
+8FFC8FF690D690E090D990DA90E390DF90E590D890DB90D790DC90E491500000
+D4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+914E914F91D591E291DA965C965F96BC98E39ADF9B2F4E7F5070506A5061505E
+50605053504B505D50725048504D5041505B504A506250155045505F5069506B
+5063506450465040506E50735057505151D0526B526D526C526E52D652D3532D
+539C55755576553C554D55505534552A55515562553655355530555255450000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000550C55325565554E55395548552D553B5540554B570A570757FB581457E2
+57F657DC57F4580057ED57FD580857F8580B57F357CF580757EE57E357F257E5
+57EC57E1580E57FC581057E75801580C57F157E957F0580D5804595C5A605A58
+5A555A675A5E5A385A355A6D5A505A5F5A655A6C5A535A645A575A435A5D5A52
+5A445A5B5A485A8E5A3E5A4D5A395A4C5A705A695A475A515A565A425A5C5B72
+5B6E5BC15BC05C595D1E5D0B5D1D5D1A5D205D0C5D285D0D5D265D255D0F0000
+D5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5D305D125D235D1F5D2E5E3E5E345EB15EB45EB95EB25EB35F365F385F9B5F96
+5F9F608A6090608660BE60B060BA60D360D460CF60E460D960DD60C860B160DB
+60B760CA60BF60C360CD60C063326365638A6382637D63BD639E63AD639D6397
+63AB638E636F63876390636E63AF6375639C636D63AE637C63A4633B639F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006378638563816391638D6370655365CD66656661665B6659665C66626718
+687968876890689C686D686E68AE68AB6956686F68A368AC68A96875687468B2
+688F68776892687C686B687268AA68806871687E689B6896688B68A0688968A4
+6878687B6891688C688A687D6B366B336B376B386B916B8F6B8D6B8E6B8C6C2A
+6DC06DAB6DB46DB36E746DAC6DE96DE26DB76DF66DD46E006DC86DE06DDF6DD6
+6DBE6DE56DDC6DDD6DDB6DF46DCA6DBD6DED6DF06DBA6DD56DC26DCF6DC90000
+D6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6DD06DF26DD36DFD6DD76DCD6DE36DBB70FA710D70F7711770F4710C70F07104
+70F3711070FC70FF71067113710070F870F6710B7102710E727E727B727C727F
+731D7317730773117318730A730872FF730F731E738873F673F873F574047401
+73FD7407740073FA73FC73FF740C740B73F474087564756375CE75D275CF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075CB75CC75D175D0768F768976D37739772F772D7731773277347733773D
+7725773B7735784878527849784D784A784C782678457850796479677969796A
+7963796B796179BB79FA79F879F679F77A8F7A947A907B357B477B347B257B30
+7B227B247B337B187B2A7B1D7B317B2B7B2D7B2F7B327B387B1A7B237C947C98
+7C967CA37D357D3D7D387D367D3A7D457D2C7D297D417D477D3E7D3F7D4A7D3B
+7D287F637F957F9C7F9D7F9B7FCA7FCB7FCD7FD07FD17FC77FCF7FC9801F0000
+D7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+801E801B804780438048811881258119811B812D811F812C811E812181158127
+811D8122821182388233823A823482328274839083A383A8838D837A837383A4
+8374838F8381839583998375839483A9837D8383838C839D839B83AA838B837E
+83A583AF8388839783B0837F83A6838783AE8376839A8659865686BF86B70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000086C286C186C586BA86B086C886B986B386B886CC86B486BB86BC86C386BD
+86BE88528889889588A888A288AA889A889188A1889F889888A78899889B8897
+88A488AC888C8893888E898289D689D989D58A308A278A2C8A1E8C398C3B8C5C
+8C5D8C7D8CA58D7D8D7B8D798DBC8DC28DB98DBF8DC18ED88EDE8EDD8EDC8ED7
+8EE08EE19024900B9011901C900C902190EF90EA90F090F490F290F390D490EB
+90EC90E991569158915A9153915591EC91F491F191F391F891E491F991EA0000
+D8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+91EB91F791E891EE957A95869588967C966D966B9671966F96BF976A980498E5
+9997509B50955094509E508B50A35083508C508E509D5068509C509250825087
+515F51D45312531153A453A7559155A855A555AD5577564555A255935588558F
+55B5558155A3559255A4557D558C55A6557F559555A1558E570C582958370000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005819581E58275823582857F558485825581C581B5833583F5836582E5839
+5838582D582C583B59615AAF5A945A9F5A7A5AA25A9E5A785AA65A7C5AA55AAC
+5A955AAE5A375A845A8A5A975A835A8B5AA95A7B5A7D5A8C5A9C5A8F5A935A9D
+5BEA5BCD5BCB5BD45BD15BCA5BCE5C0C5C305D375D435D6B5D415D4B5D3F5D35
+5D515D4E5D555D335D3A5D525D3D5D315D595D425D395D495D385D3C5D325D36
+5D405D455E445E415F585FA65FA55FAB60C960B960CC60E260CE60C461140000
+D9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+60F2610A6116610560F5611360F860FC60FE60C161036118611D611060FF6104
+610B624A639463B163B063CE63E563E863EF63C3649D63F363CA63E063F663D5
+63F263F5646163DF63BE63DD63DC63C463D863D363C263C763CC63CB63C863F0
+63D763D965326567656A6564655C65686565658C659D659E65AE65D065D20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000667C666C667B668066716679666A66726701690C68D3690468DC692A68EC
+68EA68F1690F68D668F768EB68E468F66913691068F368E1690768CC69086970
+68B4691168EF68C6691468F868D068FD68FC68E8690B690A691768CE68C868DD
+68DE68E668F468D1690668D468E96915692568C76B396B3B6B3F6B3C6B946B97
+6B996B956BBD6BF06BF26BF36C306DFC6E466E476E1F6E496E886E3C6E3D6E45
+6E626E2B6E3F6E416E5D6E736E1C6E336E4B6E406E516E3B6E036E2E6E5E0000
+DA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6E686E5C6E616E316E286E606E716E6B6E396E226E306E536E656E276E786E64
+6E776E556E796E526E666E356E366E5A7120711E712F70FB712E713171237125
+71227132711F7128713A711B724B725A7288728972867285728B7312730B7330
+73227331733373277332732D732673237335730C742E742C7430742B74160000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000741A7421742D743174247423741D74297420743274FB752F756F756C75E7
+75DA75E175E675DD75DF75E475D77695769276DA774677477744774D7745774A
+774E774B774C77DE77EC786078647865785C786D7871786A786E787078697868
+785E786279747973797279707A027A0A7A037A0C7A047A997AE67AE47B4A7B3B
+7B447B487B4C7B4E7B407B587B457CA27C9E7CA87CA17D587D6F7D637D537D56
+7D677D6A7D4F7D6D7D5C7D6B7D527D547D697D517D5F7D4E7F3E7F3F7F650000
+DB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7F667FA27FA07FA17FD78051804F805080FE80D48143814A8152814F8147813D
+814D813A81E681EE81F781F881F98204823C823D823F8275833B83CF83F98423
+83C083E8841283E783E483FC83F6841083C683C883EB83E383BF840183DD83E5
+83D883FF83E183CB83CE83D683F583C98409840F83DE8411840683C283F30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000083D583FA83C783D183EA841383C383EC83EE83C483FB83D783E2841B83DB
+83FE86D886E286E686D386E386DA86EA86DD86EB86DC86EC86E986D786E886D1
+88488856885588BA88D788B988B888C088BE88B688BC88B788BD88B2890188C9
+89958998899789DD89DA89DB8A4E8A4D8A398A598A408A578A588A448A458A52
+8A488A518A4A8A4C8A4F8C5F8C818C808CBA8CBE8CB08CB98CB58D848D808D89
+8DD88DD38DCD8DC78DD68DDC8DCF8DD58DD98DC88DD78DC58EEF8EF78EFA0000
+DC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8EF98EE68EEE8EE58EF58EE78EE88EF68EEB8EF18EEC8EF48EE9902D9034902F
+9106912C910490FF90FC910890F990FB9101910091079105910391619164915F
+916291609201920A92259203921A9226920F920C9200921291FF91FD92069204
+92279202921C92249219921792059216957B958D958C95909687967E96880000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000096899683968096C296C896C396F196F0976C9770976E980798A998EB9CE6
+9EF94E834E844EB650BD50BF50C650AE50C450CA50B450C850C250B050C150BA
+50B150CB50C950B650B851D7527A5278527B527C55C355DB55CC55D055CB55CA
+55DD55C055D455C455E955BF55D2558D55CF55D555E255D655C855F255CD55D9
+55C25714585358685864584F584D5849586F5855584E585D58595865585B583D
+5863587158FC5AC75AC45ACB5ABA5AB85AB15AB55AB05ABF5AC85ABB5AC60000
+DD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5AB75AC05ACA5AB45AB65ACD5AB95A905BD65BD85BD95C1F5C335D715D635D4A
+5D655D725D6C5D5E5D685D675D625DF05E4F5E4E5E4A5E4D5E4B5EC55ECC5EC6
+5ECB5EC75F405FAF5FAD60F76149614A612B614561366132612E6146612F614F
+612961406220916862236225622463C563F163EB641064126409642064240000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000064336443641F641564186439643764226423640C64266430642864416435
+642F640A641A644064256427640B63E7641B642E6421640E656F659265D36686
+668C66956690668B668A66996694667867206966695F6938694E69626971693F
+6945696A6939694269576959697A694869496935696C6933693D696568F06978
+693469696940696F69446976695869416974694C693B694B6937695C694F6951
+69326952692F697B693C6B466B456B436B426B486B416B9BFA0D6BFB6BFC0000
+DE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6BF96BF76BF86E9B6ED66EC86E8F6EC06E9F6E936E946EA06EB16EB96EC66ED2
+6EBD6EC16E9E6EC96EB76EB06ECD6EA66ECF6EB26EBE6EC36EDC6ED86E996E92
+6E8E6E8D6EA46EA16EBF6EB36ED06ECA6E976EAE6EA371477154715271637160
+7141715D716271727178716A7161714271587143714B7170715F715071530000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007144714D715A724F728D728C72917290728E733C7342733B733A7340734A
+73497444744A744B7452745174577440744F7450744E74427446744D745474E1
+74FF74FE74FD751D75797577698375EF760F760375F775FE75FC75F975F87610
+75FB75F675ED75F575FD769976B576DD7755775F776077527756775A77697767
+77547759776D77E07887789A7894788F788478957885788678A1788378797899
+78807896787B797C7982797D79797A117A187A197A127A177A157A227A130000
+DF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7A1B7A107AA37AA27A9E7AEB7B667B647B6D7B747B697B727B657B737B717B70
+7B617B787B767B637CB27CB47CAF7D887D867D807D8D7D7F7D857D7A7D8E7D7B
+7D837D7C7D8C7D947D847D7D7D927F6D7F6B7F677F687F6C7FA67FA57FA77FDB
+7FDC8021816481608177815C8169815B816281726721815E81768167816F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081448161821D8249824482408242824584F1843F845684768479848F848D
+846584518440848684678430844D847D845A845984748473845D8507845E8437
+843A8434847A8443847884328445842983D9844B842F8442842D845F84708439
+844E844C8452846F84C5848E843B8447843684338468847E8444842B84608454
+846E8450870B870486F7870C86FA86D686F5874D86F8870E8709870186F6870D
+870588D688CB88CD88CE88DE88DB88DA88CC88D08985899B89DF89E589E40000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+89E189E089E289DC89E68A768A868A7F8A618A3F8A778A828A848A758A838A81
+8A748A7A8C3C8C4B8C4A8C658C648C668C868C848C858CCC8D688D698D918D8C
+8D8E8D8F8D8D8D938D948D908D928DF08DE08DEC8DF18DEE8DD08DE98DE38DE2
+8DE78DF28DEB8DF48F068EFF8F018F008F058F078F088F028F0B9052903F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090449049903D9110910D910F911191169114910B910E916E916F92489252
+9230923A926692339265925E9283922E924A9246926D926C924F92609267926F
+92369261927092319254926392509272924E9253924C92569232959F959C959E
+959B969296939691969796CE96FA96FD96F896F59773977797789772980F980D
+980E98AC98F698F999AF99B299B099B59AAD9AAB9B5B9CEA9CED9CE79E809EFD
+50E650D450D750E850F350DB50EA50DD50E450D350EC50F050EF50E350E00000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+51D85280528152E952EB533053AC56275615560C561255FC560F561C56015613
+560255FA561D560455FF55F95889587C5890589858865881587F5874588B587A
+58875891588E587658825888587B5894588F58FE596B5ADC5AEE5AE55AD55AEA
+5ADA5AED5AEB5AF35AE25AE05ADB5AEC5ADE5ADD5AD95AE85ADF5B775BE00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005BE35C635D825D805D7D5D865D7A5D815D775D8A5D895D885D7E5D7C5D8D
+5D795D7F5E585E595E535ED85ED15ED75ECE5EDC5ED55ED95ED25ED45F445F43
+5F6F5FB6612C61286141615E61716173615261536172616C618061746154617A
+615B6165613B616A6161615662296227622B642B644D645B645D647464766472
+6473647D6475646664A6644E6482645E645C644B645364606450647F643F646C
+646B645964656477657365A066A166A0669F67056704672269B169B669C90000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+69A069CE699669B069AC69BC69916999698E69A7698D69A969BE69AF69BF69C4
+69BD69A469D469B969CA699A69CF69B3699369AA69A1699E69D96997699069C2
+69B569A569C66B4A6B4D6B4B6B9E6B9F6BA06BC36BC46BFE6ECE6EF56EF16F03
+6F256EF86F376EFB6F2E6F096F4E6F196F1A6F276F186F3B6F126EED6F0A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006F366F736EF96EEE6F2D6F406F306F3C6F356EEB6F076F0E6F436F056EFD
+6EF66F396F1C6EFC6F3A6F1F6F0D6F1E6F086F21718771907189718071857182
+718F717B718671817197724472537297729572937343734D7351734C74627473
+7471747574727467746E750075027503757D759076167608760C76157611760A
+761476B87781777C77857782776E7780776F777E778378B278AA78B478AD78A8
+787E78AB789E78A578A078AC78A278A47998798A798B79967995799479930000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+79977988799279907A2B7A4A7A307A2F7A287A267AA87AAB7AAC7AEE7B887B9C
+7B8A7B917B907B967B8D7B8C7B9B7B8E7B857B9852847B997BA47B827CBB7CBF
+7CBC7CBA7DA77DB77DC27DA37DAA7DC17DC07DC57D9D7DCE7DC47DC67DCB7DCC
+7DAF7DB97D967DBC7D9F7DA67DAE7DA97DA17DC97F737FE27FE37FE57FDE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008024805D805C8189818681838187818D818C818B8215849784A484A1849F
+84BA84CE84C284AC84AE84AB84B984B484C184CD84AA849A84B184D0849D84A7
+84BB84A2849484C784CC849B84A984AF84A884D6849884B684CF84A084D784D4
+84D284DB84B084918661873387238728876B8740872E871E87218719871B8743
+872C8741873E874687208732872A872D873C8712873A87318735874287268727
+87388724871A8730871188F788E788F188F288FA88FE88EE88FC88F688FB0000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+88F088EC88EB899D89A1899F899E89E989EB89E88AAB8A998A8B8A928A8F8A96
+8C3D8C688C698CD58CCF8CD78D968E098E028DFF8E0D8DFD8E0A8E038E078E06
+8E058DFE8E008E048F108F118F0E8F0D9123911C91209122911F911D911A9124
+9121911B917A91729179917392A592A49276929B927A92A0929492AA928D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000092A6929A92AB92799297927F92A392EE928E9282929592A2927D928892A1
+928A9286928C929992A7927E928792A9929D928B922D969E96A196FF9758977D
+977A977E978397809782977B97849781977F97CE97CD981698AD98AE99029900
+9907999D999C99C399B999BB99BA99C299BD99C79AB19AE39AE79B3E9B3F9B60
+9B619B5F9CF19CF29CF59EA750FF5103513050F85106510750F650FE510B510C
+50FD510A528B528C52F152EF56485642564C56355641564A5649564656580000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+565A56405633563D562C563E5638562A563A571A58AB589D58B158A058A358AF
+58AC58A558A158FF5AFF5AF45AFD5AF75AF65B035AF85B025AF95B015B075B05
+5B0F5C675D995D975D9F5D925DA25D935D955DA05D9C5DA15D9A5D9E5E695E5D
+5E605E5C7DF35EDB5EDE5EE15F495FB2618B6183617961B161B061A261890000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000619B619361AF61AD619F619261AA61A1618D616661B3622D646E64706496
+64A064856497649C648F648B648A648C64A3649F646864B164986576657A6579
+657B65B265B366B566B066A966B266B766AA66AF6A006A066A1769E569F86A15
+69F169E46A2069FF69EC69E26A1B6A1D69FE6A2769F269EE6A1469F769E76A40
+6A0869E669FB6A0D69FC69EB6A096A046A186A256A0F69F66A266A0769F46A16
+6B516BA56BA36BA26BA66C016C006BFF6C026F416F266F7E6F876FC66F920000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F8D6F896F8C6F626F4F6F856F5A6F966F766F6C6F826F556F726F526F506F57
+6F946F936F5D6F006F616F6B6F7D6F676F906F536F8B6F696F7F6F956F636F77
+6F6A6F7B71B271AF719B71B071A0719A71A971B5719D71A5719E71A471A171AA
+719C71A771B37298729A73587352735E735F7360735D735B7361735A73590000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000736274877489748A74867481747D74857488747C747975087507757E7625
+761E7619761D761C7623761A7628761B769C769D769E769B778D778F77897788
+78CD78BB78CF78CC78D178CE78D478C878C378C478C9799A79A179A0799C79A2
+799B6B767A397AB27AB47AB37BB77BCB7BBE7BAC7BCE7BAF7BB97BCA7BB57CC5
+7CC87CCC7CCB7DF77DDB7DEA7DE77DD77DE17E037DFA7DE67DF67DF17DF07DEE
+7DDF7F767FAC7FB07FAD7FED7FEB7FEA7FEC7FE67FE88064806781A3819F0000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+819E819581A2819981978216824F825382528250824E82518524853B850F8500
+8529850E8509850D851F850A8527851C84FB852B84FA8508850C84F4852A84F2
+851584F784EB84F384FC851284EA84E9851684FE8528851D852E850284FD851E
+84F68531852684E784E884F084EF84F9851885208530850B8519852F86620000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000875687638764877787E1877387588754875B87528761875A8751875E876D
+876A8750874E875F875D876F876C877A876E875C8765874F877B877587628767
+8769885A8905890C8914890B891789188919890689168911890E890989A289A4
+89A389ED89F089EC8ACF8AC68AB88AD38AD18AD48AD58ABB8AD78ABE8AC08AC5
+8AD88AC38ABA8ABD8AD98C3E8C4D8C8F8CE58CDF8CD98CE88CDA8CDD8CE78DA0
+8D9C8DA18D9B8E208E238E258E248E2E8E158E1B8E168E118E198E268E270000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E148E128E188E138E1C8E178E1A8F2C8F248F188F1A8F208F238F168F179073
+9070906F9067906B912F912B9129912A91329126912E91859186918A91819182
+9184918092D092C392C492C092D992B692CF92F192DF92D892E992D792DD92CC
+92EF92C292E892CA92C892CE92E692CD92D592C992E092DE92E792D192D30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000092B592E192C692B4957C95AC95AB95AE95B096A496A296D3970597089702
+975A978A978E978897D097CF981E981D9826982998289820981B982798B29908
+98FA9911991499169917991599DC99CD99CF99D399D499CE99C999D699D899CB
+99D799CC9AB39AEC9AEB9AF39AF29AF19B469B439B679B749B719B669B769B75
+9B709B689B649B6C9CFC9CFA9CFD9CFF9CF79D079D009CF99CFB9D089D059D04
+9E839ED39F0F9F10511C51135117511A511151DE533453E156705660566E0000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+567356665663566D5672565E5677571C571B58C858BD58C958BF58BA58C258BC
+58C65B175B195B1B5B215B145B135B105B165B285B1A5B205B1E5BEF5DAC5DB1
+5DA95DA75DB55DB05DAE5DAA5DA85DB25DAD5DAF5DB45E675E685E665E6F5EE9
+5EE75EE65EE85EE55F4B5FBC619D61A8619661C561B461C661C161CC61BA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000061BF61B8618C64D764D664D064CF64C964BD648964C364DB64F364D96533
+657F657C65A266C866BE66C066CA66CB66CF66BD66BB66BA66CC67236A346A66
+6A496A676A326A686A3E6A5D6A6D6A766A5B6A516A286A5A6A3B6A3F6A416A6A
+6A646A506A4F6A546A6F6A696A606A3C6A5E6A566A556A4D6A4E6A466B556B54
+6B566BA76BAA6BAB6BC86BC76C046C036C066FAD6FCB6FA36FC76FBC6FCE6FC8
+6F5E6FC46FBD6F9E6FCA6FA870046FA56FAE6FBA6FAC6FAA6FCF6FBF6FB80000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6FA26FC96FAB6FCD6FAF6FB26FB071C571C271BF71B871D671C071C171CB71D4
+71CA71C771CF71BD71D871BC71C671DA71DB729D729E736973667367736C7365
+736B736A747F749A74A074947492749574A1750B7580762F762D7631763D7633
+763C76357632763076BB76E6779A779D77A1779C779B77A277A3779577990000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000779778DD78E978E578EA78DE78E378DB78E178E278ED78DF78E079A47A44
+7A487A477AB67AB87AB57AB17AB77BDE7BE37BE77BDD7BD57BE57BDA7BE87BF9
+7BD47BEA7BE27BDC7BEB7BD87BDF7CD27CD47CD77CD07CD17E127E217E177E0C
+7E1F7E207E137E0E7E1C7E157E1A7E227E0B7E0F7E167E0D7E147E257E247F43
+7F7B7F7C7F7A7FB17FEF802A8029806C81B181A681AE81B981B581AB81B081AC
+81B481B281B781A781F282558256825785568545856B854D8553856185580000
+EB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+854085468564854185628544855185478563853E855B8571854E856E85758555
+85678560858C8566855D85548565856C866386658664879B878F879787938792
+87888781879687988779878787A3878587908791879D87848794879C879A8789
+891E89268930892D892E89278931892289298923892F892C891F89F18AE00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008AE28AF28AF48AF58ADD8B148AE48ADF8AF08AC88ADE8AE18AE88AFF8AEF
+8AFB8C918C928C908CF58CEE8CF18CF08CF38D6C8D6E8DA58DA78E338E3E8E38
+8E408E458E368E3C8E3D8E418E308E3F8EBD8F368F2E8F358F328F398F378F34
+90769079907B908690FA913391359136919391909191918D918F9327931E9308
+931F9306930F937A9338933C931B9323931293019346932D930E930D92CB931D
+92FA9325931392F992F793349302932492FF932993399335932A9314930C0000
+EC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+930B92FE9309930092FB931695BC95CD95BE95B995BA95B695BF95B595BD96A9
+96D4970B9712971097999797979497F097F89835982F98329924991F99279929
+999E99EE99EC99E599E499F099E399EA99E999E79AB99ABF9AB49ABB9AF69AFA
+9AF99AF79B339B809B859B879B7C9B7E9B7B9B829B939B929B909B7A9B950000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009B7D9B889D259D179D209D1E9D149D299D1D9D189D229D109D199D1F9E88
+9E869E879EAE9EAD9ED59ED69EFA9F129F3D51265125512251245120512952F4
+5693568C568D568656845683567E5682567F568158D658D458CF58D25B2D5B25
+5B325B235B2C5B275B265B2F5B2E5B7B5BF15BF25DB75E6C5E6A5FBE5FBB61C3
+61B561BC61E761E061E561E461E861DE64EF64E964E364EB64E464E865816580
+65B665DA66D26A8D6A966A816AA56A896A9F6A9B6AA16A9E6A876A936A8E0000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A956A836AA86AA46A916A7F6AA66A9A6A856A8C6A926B5B6BAD6C096FCC6FA9
+6FF46FD46FE36FDC6FED6FE76FE66FDE6FF26FDD6FE26FE871E171F171E871F2
+71E471F071E27373736E736F749774B274AB749074AA74AD74B174A574AF7510
+75117512750F7584764376487649764776A476E977B577AB77B277B777B60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077B477B177A877F078F378FD790278FB78FC78F2790578F978FE790479AB
+79A87A5C7A5B7A567A587A547A5A7ABE7AC07AC17C057C0F7BF27C007BFF7BFB
+7C0E7BF47C0B7BF37C027C097C037C017BF87BFD7C067BF07BF17C107C0A7CE8
+7E2D7E3C7E427E3398487E387E2A7E497E407E477E297E4C7E307E3B7E367E44
+7E3A7F457F7F7F7E7F7D7FF47FF2802C81BB81C481CC81CA81C581C781BC81E9
+825B825A825C85838580858F85A7859585A0858B85A3857B85A4859A859E0000
+EE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8577857C858985A1857A85788557858E85968586858D8599859D858185A28582
+858885858579857685988590859F866887BE87AA87AD87C587B087AC87B987B5
+87BC87AE87C987C387C287CC87B787AF87C487CA87B487B687BF87B887BD87DE
+87B289358933893C893E894189528937894289AD89AF89AE89F289F38B1E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008B188B168B118B058B0B8B228B0F8B128B158B078B0D8B088B068B1C8B13
+8B1A8C4F8C708C728C718C6F8C958C948CF98D6F8E4E8E4D8E538E508E4C8E47
+8F438F409085907E9138919A91A2919B9199919F91A1919D91A093A1938393AF
+936493569347937C9358935C93769349935093519360936D938F934C936A9379
+935793559352934F93719377937B9361935E936393679380934E935995C795C0
+95C995C395C595B796AE96B096AC9720971F9718971D9719979A97A1979C0000
+EF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+979E979D97D597D497F198419844984A9849984598439925992B992C992A9933
+9932992F992D99319930999899A399A19A0299FA99F499F799F999F899F699FB
+99FD99FE99FC9A039ABE9AFE9AFD9B019AFC9B489B9A9BA89B9E9B9B9BA69BA1
+9BA59BA49B869BA29BA09BAF9D339D419D679D369D2E9D2F9D319D389D300000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009D459D429D439D3E9D379D409D3D7FF59D2D9E8A9E899E8D9EB09EC89EDA
+9EFB9EFF9F249F239F229F549FA05131512D512E5698569C5697569A569D5699
+59705B3C5C695C6A5DC05E6D5E6E61D861DF61ED61EE61F161EA61F061EB61D6
+61E964FF650464FD64F86501650364FC659465DB66DA66DB66D86AC56AB96ABD
+6AE16AC66ABA6AB66AB76AC76AB46AAD6B5E6BC96C0B7007700C700D70017005
+7014700E6FFF70006FFB70266FFC6FF7700A720171FF71F9720371FD73760000
+F0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74B874C074B574C174BE74B674BB74C275147513765C76647659765076537657
+765A76A676BD76EC77C277BA78FF790C79137914790979107912791179AD79AC
+7A5F7C1C7C297C197C207C1F7C2D7C1D7C267C287C227C257C307E5C7E507E56
+7E637E587E627E5F7E517E607E577E537FB57FB37FF77FF8807581D181D20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081D0825F825E85B485C685C085C385C285B385B585BD85C785C485BF85CB
+85CE85C885C585B185B685D2862485B885B785BE866987E787E687E287DB87EB
+87EA87E587DF87F387E487D487DC87D387ED87D887E387A487D787D9880187F4
+87E887DD8953894B894F894C89468950895189498B2A8B278B238B338B308B35
+8B478B2F8B3C8B3E8B318B258B378B268B368B2E8B248B3B8B3D8B3A8C428C75
+8C998C988C978CFE8D048D028D008E5C8E628E608E578E568E5E8E658E670000
+F1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E5B8E5A8E618E5D8E698E548F468F478F488F4B9128913A913B913E91A891A5
+91A791AF91AA93B5938C939293B7939B939D938993A7938E93AA939E93A69395
+93889399939F938D93B1939193B293A493A893B493A393A595D295D395D196B3
+96D796DA5DC296DF96D896DD97239722972597AC97AE97A897AB97A497AA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000097A297A597D797D997D697D897FA98509851985298B89941993C993A9A0F
+9A0B9A099A0D9A049A119A0A9A059A079A069AC09ADC9B089B049B059B299B35
+9B4A9B4C9B4B9BC79BC69BC39BBF9BC19BB59BB89BD39BB69BC49BB99BBD9D5C
+9D539D4F9D4A9D5B9D4B9D599D569D4C9D579D529D549D5F9D589D5A9E8E9E8C
+9EDF9F019F009F169F259F2B9F2A9F299F289F4C9F5551345135529652F753B4
+56AB56AD56A656A756AA56AC58DA58DD58DB59125B3D5B3E5B3F5DC35E700000
+F2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5FBF61FB65076510650D6509650C650E658465DE65DD66DE6AE76AE06ACC6AD1
+6AD96ACB6ADF6ADC6AD06AEB6ACF6ACD6ADE6B606BB06C0C7019702770207016
+702B702170227023702970177024701C702A720C720A72077202720572A572A6
+72A472A372A174CB74C574B774C37516766077C977CA77C477F1791D791B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007921791C7917791E79B07A677A687C337C3C7C397C2C7C3B7CEC7CEA7E76
+7E757E787E707E777E6F7E7A7E727E747E687F4B7F4A7F837F867FB77FFD7FFE
+807881D781D582648261826385EB85F185ED85D985E185E885DA85D785EC85F2
+85F885D885DF85E385DC85D185F085E685EF85DE85E2880087FA880387F687F7
+8809880C880B880687FC880887FF880A88028962895A895B89578961895C8958
+895D8959898889B789B689F68B508B488B4A8B408B538B568B548B4B8B550000
+F3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B518B428B528B578C438C778C768C9A8D068D078D098DAC8DAA8DAD8DAB8E6D
+8E788E738E6A8E6F8E7B8EC28F528F518F4F8F508F538FB49140913F91B091AD
+93DE93C793CF93C293DA93D093F993EC93CC93D993A993E693CA93D493EE93E3
+93D593C493CE93C093D293E7957D95DA95DB96E19729972B972C972897260000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000097B397B797B697DD97DE97DF985C9859985D985798BF98BD98BB98BE9948
+9947994399A699A79A1A9A159A259A1D9A249A1B9A229A209A279A239A1E9A1C
+9A149AC29B0B9B0A9B0E9B0C9B379BEA9BEB9BE09BDE9BE49BE69BE29BF09BD4
+9BD79BEC9BDC9BD99BE59BD59BE19BDA9D779D819D8A9D849D889D719D809D78
+9D869D8B9D8C9D7D9D6B9D749D759D709D699D859D739D7B9D829D6F9D799D7F
+9D879D689E949E919EC09EFC9F2D9F409F419F4D9F569F579F58533756B20000
+F4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+56B556B358E35B455DC65DC75EEE5EEF5FC05FC161F9651765166515651365DF
+66E866E366E46AF36AF06AEA6AE86AF96AF16AEE6AEF703C7035702F70377034
+703170427038703F703A70397040703B703370417213721472A8737D737C74BA
+76AB76AA76BE76ED77CC77CE77CF77CD77F27925792379277928792479290000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000079B27A6E7A6C7A6D7AF77C497C487C4A7C477C457CEE7E7B7E7E7E817E80
+7FBA7FFF807981DB81D9820B82688269862285FF860185FE861B860085F68604
+86098605860C85FD8819881088118817881388168963896689B989F78B608B6A
+8B5D8B688B638B658B678B6D8DAE8E868E888E848F598F568F578F558F588F5A
+908D9143914191B791B591B291B3940B941393FB9420940F941493FE94159410
+94289419940D93F5940093F79407940E9416941293FA940993F8940A93FF0000
+F5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+93FC940C93F69411940695DE95E095DF972E972F97B997BB97FD97FE98609862
+9863985F98C198C29950994E9959994C994B99539A329A349A319A2C9A2A9A36
+9A299A2E9A389A2D9AC79ACA9AC69B109B129B119C0B9C089BF79C059C129BF8
+9C409C079C0E9C069C179C149C099D9F9D999DA49D9D9D929D989D909D9B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009DA09D949D9C9DAA9D979DA19D9A9DA29DA89D9E9DA39DBF9DA99D969DA6
+9DA79E999E9B9E9A9EE59EE49EE79EE69F309F2E9F5B9F609F5E9F5D9F599F91
+513A51395298529756C356BD56BE5B485B475DCB5DCF5EF161FD651B6B026AFC
+6B036AF86B0070437044704A7048704970457046721D721A7219737E7517766A
+77D0792D7931792F7C547C537CF27E8A7E877E887E8B7E867E8D7F4D7FBB8030
+81DD8618862A8626861F8623861C86198627862E862186208629861E86250000
+F6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8829881D881B88208824881C882B884A896D8969896E896B89FA8B798B788B45
+8B7A8B7B8D108D148DAF8E8E8E8C8F5E8F5B8F5D91469144914591B9943F943B
+94369429943D943C94309439942A9437942C9440943195E595E495E39735973A
+97BF97E1986498C998C698C0995899569A399A3D9A469A449A429A419A3A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009A3F9ACD9B159B179B189B169B3A9B529C2B9C1D9C1C9C2C9C239C289C29
+9C249C219DB79DB69DBC9DC19DC79DCA9DCF9DBE9DC59DC39DBB9DB59DCE9DB9
+9DBA9DAC9DC89DB19DAD9DCC9DB39DCD9DB29E7A9E9C9EEB9EEE9EED9F1B9F18
+9F1A9F319F4E9F659F649F924EB956C656C556CB59715B4B5B4C5DD55DD15EF2
+65216520652665226B0B6B086B096C0D7055705670577052721E721F72A9737F
+74D874D574D974D7766D76AD793579B47A707A717C577C5C7C597C5B7C5A0000
+F7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7CF47CF17E917F4F7F8781DE826B863486358633862C86328636882C88288826
+882A8825897189BF89BE89FB8B7E8B848B828B868B858B7F8D158E958E948E9A
+8E928E908E968E978F608F629147944C9450944A944B944F9447944594489449
+9446973F97E3986A986998CB9954995B9A4E9A539A549A4C9A4F9A489A4A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009A499A529A509AD09B199B2B9B3B9B569B559C469C489C3F9C449C399C33
+9C419C3C9C379C349C329C3D9C369DDB9DD29DDE9DDA9DCB9DD09DDC9DD19DDF
+9DE99DD99DD89DD69DF59DD59DDD9EB69EF09F359F339F329F429F6B9F959FA2
+513D529958E858E759725B4D5DD8882F5F4F62016203620465296525659666EB
+6B116B126B0F6BCA705B705A7222738273817383767077D47C677C667E95826C
+863A86408639863C8631863B863E88308832882E883389768974897389FE0000
+F8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8B8C8B8E8B8B8B888C458D198E988F648F6391BC94629455945D9457945E97C4
+97C598009A569A599B1E9B1F9B209C529C589C509C4A9C4D9C4B9C559C599C4C
+9C4E9DFB9DF79DEF9DE39DEB9DF89DE49DF69DE19DEE9DE69DF29DF09DE29DEC
+9DF49DF39DE89DED9EC29ED09EF29EF39F069F1C9F389F379F369F439F4F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009F719F709F6E9F6F56D356CD5B4E5C6D652D66ED66EE6B13705F7061705D
+7060722374DB74E577D5793879B779B67C6A7E977F89826D8643883888378835
+884B8B948B958E9E8E9F8EA08E9D91BE91BD91C2946B9468946996E597469743
+974797C797E59A5E9AD59B599C639C679C669C629C5E9C609E029DFE9E079E03
+9E069E059E009E019E099DFF9DFD9E049EA09F1E9F469F749F759F7656D4652E
+65B86B186B196B176B1A7062722672AA77D877D979397C697C6B7CF67E9A0000
+F9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7E987E9B7E9981E081E18646864786488979897A897C897B89FF8B988B998EA5
+8EA48EA3946E946D946F9471947397499872995F9C689C6E9C6D9E0B9E0D9E10
+9E0F9E129E119EA19EF59F099F479F789F7B9F7A9F79571E70667C6F883C8DB2
+8EA691C394749478947694759A609C749C739C719C759E149E139EF69F0A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009FA4706870657CF7866A883E883D883F8B9E8C9C8EA98EC9974B98739874
+98CC996199AB9A649A669A679B249E159E179F4862076B1E7227864C8EA89482
+948094819A699A689B2E9E197229864B8B9F94839C799EB776759A6B9C7A9E1D
+7069706A9EA49F7E9F499F98788192B988CF58BB60527CA75AFA255425662557
+2560256C2563255A2569255D255225642555255E256A256125582567255B2553
+25652556255F256B256225592568255C25512550256D256E2570256F25930000
diff --git a/tcl/library/encoding/dingbats.enc b/tcl/library/encoding/dingbats.enc
new file mode 100644
index 00000000000..972948767d0
--- /dev/null
+++ b/tcl/library/encoding/dingbats.enc
@@ -0,0 +1,20 @@
+# Encoding file: dingbats, single-byte
+S
+003F 1 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+00202701270227032704260E2706270727082709261B261E270C270D270E270F
+2710271127122713271427152716271727182719271A271B271C271D271E271F
+2720272127222723272427252726272726052729272A272B272C272D272E272F
+2730273127322733273427352736273727382739273A273B273C273D273E273F
+2740274127422743274427452746274727482749274A274B25CF274D25A0274F
+27502751275225B225BC25C6275625D727582759275A275B275C275D275E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000276127622763276427652766276726632666266526602460246124622463
+2464246524662467246824692776277727782779277A277B277C277D277E277F
+2780278127822783278427852786278727882789278A278B278C278D278E278F
+2790279127922793279421922194219527982799279A279B279C279D279E279F
+27A027A127A227A327A427A527A627A727A827A927AA27AB27AC27AD27AE27AF
+000027B127B227B327B427B527B627B727B827B927BA27BB27BC27BD27BE0000
diff --git a/tcl/library/encoding/euc-cn.enc b/tcl/library/encoding/euc-cn.enc
new file mode 100644
index 00000000000..4b2f8c73ad7
--- /dev/null
+++ b/tcl/library/encoding/euc-cn.enc
@@ -0,0 +1,1397 @@
+# Encoding file: euc-cn, multi-byte
+M
+003F 0 82
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030003001300230FB02C902C700A8300330052015FF5E2225202620182019
+201C201D3014301530083009300A300B300C300D300E300F3016301730103011
+00B100D700F72236222722282211220F222A222922082237221A22A522252220
+23122299222B222E2261224C2248223D221D2260226E226F22642265221E2235
+22342642264000B0203220332103FF0400A4FFE0FFE1203000A7211626062605
+25CB25CF25CE25C725C625A125A025B325B2203B219221902191219330130000
+A2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000024882489248A248B248C248D248E248F2490249124922493249424952496
+249724982499249A249B247424752476247724782479247A247B247C247D247E
+247F248024812482248324842485248624872460246124622463246424652466
+2467246824690000000032203221322232233224322532263227322832290000
+00002160216121622163216421652166216721682169216A216B000000000000
+A3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF01FF02FF03FFE5FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F
+FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFF3CFF3DFF3EFF3F
+FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000
+A4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+A5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+A6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000004100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+A8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000010100E101CE00E0011300E9011B00E8012B00ED01D000EC014D00F301D2
+00F2016B00FA01D400F901D601D801DA01DC00FC00EA00000000000000000000
+0000000000000000000031053106310731083109310A310B310C310D310E310F
+3110311131123113311431153116311731183119311A311B311C311D311E311F
+3120312131223123312431253126312731283129000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000002500250125022503250425052506250725082509250A250B
+250C250D250E250F2510251125122513251425152516251725182519251A251B
+251C251D251E251F2520252125222523252425252526252725282529252A252B
+252C252D252E252F2530253125322533253425352536253725382539253A253B
+253C253D253E253F2540254125422543254425452546254725482549254A254B
+0000000000000000000000000000000000000000000000000000000000000000
+B0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000554A963F57C3632854CE550954C07691764C853C77EE827E788D72319698
+978D6C285B894FFA630966975CB880FA684880AE660276CE51F9655671AC7FF1
+888450B2596561CA6FB382AD634C625253ED54277B06516B75A45DF462D48DCB
+9776628A8019575D97387F627238767D67CF767E64464F708D2562DC7A176591
+73ED642C6273822C9881677F7248626E62CC4F3474E3534A529E7ECA90A65E2E
+6886699C81807ED168D278C5868C9551508D8C2482DE80DE5305891252650000
+B1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000858496F94FDD582199715B9D62B162A566B48C799C8D7206676F789160B2
+535153178F8880CC8D1D94A1500D72C8590760EB711988AB595482EF672C7B28
+5D297EF7752D6CF58E668FF8903C9F3B6BD491197B145F7C78A784D6853D6BD5
+6BD96BD65E015E8775F995ED655D5F0A5FC58F9F58C181C2907F965B97AD8FB9
+7F168D2C62414FBF53D8535E8FA88FA98FAB904D68075F6A819888689CD6618B
+522B762A5F6C658C6FD26EE85BBE6448517551B067C44E1979C9997C70B30000
+B2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075C55E7673BB83E064AD62E894B56CE2535A52C3640F94C27B944F2F5E1B
+82368116818A6E246CCA9A736355535C54FA886557E04E0D5E036B657C3F90E8
+601664E6731C88C16750624D8D22776C8E2991C75F6983DC8521991053C28695
+6B8B60ED60E8707F82CD82314ED36CA785CF64CD7CD969FD66F9834953957B56
+4FA7518C6D4B5C428E6D63D253C9832C833667E578B4643D5BDF5C945DEE8BE7
+62C667F48C7A640063BA8749998B8C177F2094F24EA7961098A4660C73160000
+B3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000573A5C1D5E38957F507F80A05382655E7545553150218D856284949E671D
+56326F6E5DE2543570928F66626F64A463A35F7B6F8890F481E38FB05C186668
+5FF16C8996488D81886C649179F057CE6A59621054484E587A0B60E96F848BDA
+627F901E9A8B79E4540375F4630153196C608FDF5F1B9A70803B9F7F4F885C3A
+8D647FC565A570BD514551B2866B5D075BA062BD916C75748E0C7A2061017B79
+4EC77EF877854E1181ED521D51FA6A7153A88E87950496CF6EC19664695A0000
+B4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000784050A877D7641089E6590463E35DDD7A7F693D4F20823955984E3275AE
+7A975E625E8A95EF521B5439708A6376952457826625693F918755076DF37EAF
+882262337EF075B5832878C196CC8F9E614874F78BCD6B64523A8D506B21806A
+847156F153064ECE4E1B51D17C97918B7C074FC38E7F7BE17A9C64675D1450AC
+810676017CB96DEC7FE067515B585BF878CB64AE641363AA632B9519642D8FBE
+7B5476296253592754466B7950A362345E266B864EE38D37888B5F85902E0000
+B5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006020803D62C54E39535590F863B880C665E66C2E4F4660EE6DE18BDE5F39
+86CB5F536321515A83616863520063638E4850125C9B79775BFC52307A3B60BC
+905376D75FB75F9776848E6C706F767B7B4977AA51F3909358244F4E6EF48FEA
+654C7B1B72C46DA47FDF5AE162B55E95573084827B2C5E1D5F1F90127F1498A0
+63826EC7789870B95178975B57AB75354F4375385E9760E659606DC06BBF7889
+53FC96D551CB52016389540A94938C038DCC7239789F87768FED8C0D53E00000
+B6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E0176EF53EE948998769F0E952D5B9A8BA24E224E1C51AC846361C252A8
+680B4F97606B51BB6D1E515C6296659796618C46901775D890FD77636BD2728A
+72EC8BFB583577798D4C675C9540809A5EA66E2159927AEF77ED953B6BB565AD
+7F0E58065151961F5BF958A954288E726566987F56E4949D76FE9041638754C6
+591A593A579B8EB267358DFA8235524160F0581586FE5CE89E454FC4989D8BB9
+5A2560765384627C904F9102997F6069800C513F80335C1499756D314E8C0000
+B7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008D3053D17F5A7B4F4F104E4F96006CD573D085E95E06756A7FFB6A0A77FE
+94927E4151E170E653CD8FD483038D2972AF996D6CDB574A82B365B980AA623F
+963259A84EFF8BBF7EBA653E83F2975E556198DE80A5532A8BFD542080BA5E9F
+6CB88D3982AC915A54296C1B52067EB7575F711A6C7E7C89594B4EFD5FFF6124
+7CAA4E305C0167AB87025CF0950B98CE75AF70FD902251AF7F1D8BBD594951E4
+4F5B5426592B657780A45B75627662C28F905E456C1F7B264F0F4FD8670D0000
+B8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D6E6DAA798F88B15F17752B629A8F854FEF91DC65A7812F81515E9C8150
+8D74526F89868D4B590D50854ED8961C723681798D1F5BCC8BA3964459877F1A
+54905676560E8BE565396982949976D66E895E727518674667D17AFF809D8D76
+611F79C665628D635188521A94A27F38809B7EB25C976E2F67607BD9768B9AD8
+818F7F947CD5641E95507A3F544A54E56B4C640162089E3D80F3759952729769
+845B683C86E49601969494EC4E2A54047ED968398DDF801566F45E9A7FB90000
+B9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000057C2803F68975DE5653B529F606D9F9A4F9B8EAC516C5BAB5F135DE96C5E
+62F18D21517194A952FE6C9F82DF72D757A267848D2D591F8F9C83C754957B8D
+4F306CBD5B6459D19F1353E486CA9AA88C3780A16545987E56FA96C7522E74DC
+52505BE1630289024E5662D0602A68FA51735B9851A089C27BA199867F5060EF
+704C8D2F51495E7F901B747089C4572D78455F529F9F95FA8F689B3C8BE17678
+684267DC8DEA8D35523D8F8A6EDA68CD950590ED56FD679C88F98FC754C80000
+BA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009AB85B696D776C264EA55BB39A87916361A890AF97E9542B6DB55BD251FD
+558A7F557FF064BC634D65F161BE608D710A6C576C49592F676D822A58D5568E
+8C6A6BEB90DD597D801753F76D695475559D837783CF683879BE548C4F555408
+76D28C8996026CB36DB88D6B89109E648D3A563F9ED175D55F8872E0606854FC
+4EA86A2A886160528F7054C470D886799E3F6D2A5B8F5F187EA255894FAF7334
+543C539A5019540E547C4E4E5FFD745A58F6846B80E1877472D07CCA6E560000
+BB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F27864E552C62A44E926CAA623782B154D7534E733E6ED1753B52125316
+8BDD69D05F8A60006DEE574F6B2273AF68538FD87F13636260A3552475EA8C62
+71156DA35BA65E7B8352614C9EC478FA87577C27768751F060F6714C66435E4C
+604D8C0E707063258F895FBD606286D456DE6BC160946167534960E066668D3F
+79FD4F1A70E96C478BB38BF27ED88364660F5A5A9B426D516DF78C416D3B4F19
+706B83B7621660D1970D8D27797851FB573E57FA673A75787A3D79EF7B950000
+BC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000808C99658FF96FC08BA59E2159EC7EE97F095409678168D88F917C4D96C6
+53CA602575BE6C7253735AC97EA7632451E0810A5DF184DF628051805B634F0E
+796D524260B86D4E5BC45BC28BA18BB065E25FCC964559937EE77EAA560967B7
+59394F735BB652A0835A988A8D3E753294BE50477A3C4EF767B69A7E5AC16B7C
+76D1575A5C167B3A95F4714E517C80A9827059787F04832768C067EC78B17877
+62E363617B804FED526A51CF835069DB92748DF58D3189C1952E7BAD4EF60000
+BD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000506582305251996F6E106E856DA75EFA50F559DC5C066D466C5F7586848B
+686859568BB253209171964D854969127901712680F64EA490CA6D479A845A07
+56BC640594F077EB4FA5811A72E189D2997A7F347EDE527F655991758F7F8F83
+53EB7A9663ED63A5768679F888579636622A52AB8282685467706377776B7AED
+6D017ED389E359D0621285C982A5754C501F4ECB75A58BEB5C4A5DFE7B4B65A4
+91D14ECA6D25895F7D2795264EC58C288FDB9773664B79818FD170EC6D780000
+BE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C3D52B283465162830E775B66769CB84EAC60CA7CBE7CB37ECF4E958B66
+666F988897595883656C955C5F8475C997567ADF7ADE51C070AF7A9863EA7A76
+7EA0739697ED4E4570784E5D915253A9655165E781FC8205548E5C31759A97A0
+62D872D975BD5C459A7983CA5C40548077E94E3E6CAE805A62D2636E5DE85177
+8DDD8E1E952F4FF153E560E770AC526763509E435A1F5026773753777EE26485
+652B628963985014723589C951B38BC07EDD574783CC94A7519B541B5CFB0000
+BF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004FCA7AE36D5A90E19A8F55805496536154AF5F0063E9697751EF6168520A
+582A52D8574E780D770B5EB761777CE0625B62974EA27095800362F770E49760
+577782DB67EF68F578D5989779D158F354B353EF6E34514B523B5BA28BFE80AF
+554357A660735751542D7A7A60505B5463A762A053E362635BC767AF54ED7A9F
+82E691775E9388E4593857AE630E8DE880EF57577B774FA95FEB5BBD6B3E5321
+7B5072C2684677FF773665F751B54E8F76D45CBF7AA58475594E9B4150800000
+C0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000998861276E8357646606634656F062EC62695ED39614578362C955878721
+814A8FA3556683B167658D5684DD5A6A680F62E67BEE961151706F9C8C3063FD
+89C861D27F0670C26EE57405699472FC5ECA90CE67176D6A635E52B372628001
+4F6C59E5916A70D96D9D52D24E5096F7956D857E78CA7D2F5121579264C2808B
+7C7B6CEA68F1695E51B7539868A872819ECE7BF172F879BB6F137406674E91CC
+9CA4793C83898354540F68174E3D538952B1783E5386522950884F8B4FD00000
+C1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075E27ACB7C926CA596B6529B748354E94FE9805483B28FDE95705EC9601C
+6D9F5E18655B813894FE604B70BC7EC37CAE51C968817CB1826F4E248F8691CF
+667E4EAE8C0564A9804A50DA759771CE5BE58FBD6F664E86648295635ED66599
+521788C270C852A3730E7433679778F797164E3490BB9CDE6DCB51DB8D41541D
+62CE73B283F196F69F8494C34F367F9A51CC707596755CAD988653E64EE46E9C
+740969B4786B998F7559521876246D4167F3516D9F99804B54997B3C7ABF0000
+C2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009686578462E29647697C5A0464027BD36F0F964B82A6536298855E907089
+63B35364864F9C819E93788C97328DEF8D429E7F6F5E79845F559646622E9A74
+541594DD4FA365C55C655C617F1586516C2F5F8B73876EE47EFF5CE6631B5B6A
+6EE653754E7163A0756562A18F6E4F264ED16CA67EB68BBA841D87BA7F57903B
+95237BA99AA188F8843D6D1B9A867EDC59889EBB739B780186829A6C9A82561B
+541757CB4E709EA653568FC881097792999286EE6EE1851366FC61626F2B0000
+C3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008C298292832B76F26C135FD983BD732B8305951A6BDB77DB94C6536F8302
+51925E3D8C8C8D384E4873AB679A68859176970971646CA177095A9295416BCF
+7F8E66275BD059B95A9A95E895F74EEC840C84996AAC76DF9530731B68A65B5F
+772F919A97617CDC8FF78C1C5F257C7379D889C56CCC871C5BC65E4268C97720
+7EF55195514D52C95A297F05976282D763CF778485D079D26E3A5E9959998511
+706D6C1162BF76BF654F60AF95FD660E879F9E2394ED540D547D8C2C64780000
+C4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000647986116A21819C78E864699B5462B9672B83AB58A89ED86CAB6F205BDE
+964C8C0B725F67D062C772614EA959C66BCD589366AE5E5552DF6155672876EE
+776672677A4662FF54EA545094A090A35A1C7EB36C164E435976801059485357
+753796BE56CA63208111607C95F96DD65462998151855AE980FD59AE9713502A
+6CE55C3C62DF4F60533F817B90066EBA852B62C85E7478BE64B5637B5FF55A18
+917F9E1F5C3F634F80425B7D556E954A954D6D8560A867E072DE51DD5B810000
+C5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000062E76CDE725B626D94AE7EBD81136D53519C5F04597452AA601259736696
+8650759F632A61E67CEF8BFA54E66B279E256BB485D5545550766CA4556A8DB4
+722C5E156015743662CD6392724C5F986E436D3E65006F5876D878D076FC7554
+522453DB4E535E9E65C1802A80D6629B5486522870AE888D8DD16CE1547880DA
+57F988F48D54966A914D4F696C9B55B776C6783062A870F96F8E5F6D84EC68DA
+787C7BF781A8670B9E4F636778B0576F78129739627962AB528874356BD70000
+C6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005564813E75B276AE533975DE50FB5C418B6C7BC7504F72479A9798D86F02
+74E27968648777A562FC98918D2B54C180584E52576A82F9840D5E7351ED74F6
+8BC45C4F57616CFC98875A4678349B448FEB7C955256625194FA4EC683868461
+83E984B257D467345703666E6D668C3166DD7011671F6B3A6816621A59BB4E03
+51C46F0667D26C8F517668CB59476B6775665D0E81109F5065D7794879419A91
+8D775C824E5E4F01542F5951780C56686C148FC45F036C7D6CE38BAB63900000
+C7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060706D3D72756266948E94C553438FC17B7E4EDF8C264E7E9ED494B194B3
+524D6F5C90636D458C3458115D4C6B206B4967AA545B81547F8C589985375F3A
+62A26A47953965726084686577A74E544FA85DE7979864AC7FD85CED4FCF7A8D
+520783044E14602F7A8394A64FB54EB279E6743452E482B964D279BD5BDD6C81
+97528F7B6C22503E537F6E0564CE66746C3060C598778BF75E86743C7A7779CB
+4E1890B174036C4256DA914B6CC58D8B533A86C666F28EAF5C489A716E200000
+C8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000053D65A369F8B8DA353BB570898A76743919B6CC9516875CA62F372AC5238
+529D7F3A7094763853749E4A69B7786E96C088D97FA4713671C3518967D374E4
+58E4651856B78BA9997662707ED560F970ED58EC4EC14EBA5FCD97E74EFB8BA4
+5203598A7EAB62544ECD65E5620E833884C98363878D71946EB65BB97ED25197
+63C967D480898339881551125B7A59828FB14E736C5D516589258F6F962E854A
+745E951095F06DA682E55F3164926D128428816E9CC3585E8D5B4E0953C10000
+C9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F1E6563685155D34E2764149A9A626B5AC2745F82726DA968EE50E7838E
+7802674052396C997EB150BB5565715E7B5B665273CA82EB67495C715220717D
+886B95EA965564C58D6181B355846C5562477F2E58924F2455468D4F664C4E0A
+5C1A88F368A2634E7A0D70E7828D52FA97F65C1154E890B57ECD59628D4A86C7
+820C820D8D6664445C0461516D89793E8BBE78377533547B4F388EAB6DF15A20
+7EC5795E6C885BA15A76751A80BE614E6E1758F0751F7525727253477EF30000
+CA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000770176DB526980DC57235E08593172EE65BD6E7F8BD75C388671534177F3
+62FE65F64EC098DF86805B9E8BC653F277E24F7F5C4E9A7659CB5F0F793A58EB
+4E1667FF4E8B62ED8A93901D52BF662F55DC566C90024ED54F8D91CA99706C0F
+5E0260435BA489C68BD56536624B99965B885BFF6388552E53D77626517D852C
+67A268B36B8A62928F9353D482126DD1758F4E668D4E5B70719F85AF669166D9
+7F7287009ECD9F205C5E672F8FF06811675F620D7AD658855EB665706F310000
+CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060555237800D6454887075295E05681362F4971C53CC723D8C016C347761
+7A0E542E77AC987A821C8BF47855671470C165AF64955636601D79C153F84E1D
+6B7B80865BFA55E356DB4F3A4F3C99725DF3677E80386002988290015B8B8BBC
+8BF5641C825864DE55FD82CF91654FD77D20901F7C9F50F358516EAF5BBF8BC9
+80839178849C7B97867D968B968F7EE59AD3788E5C817A57904296A7795F5B59
+635F7B0B84D168AD55067F2974107D2295016240584C4ED65B83597958540000
+CC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000736D631E8E4B8E0F80CE82D462AC53F06CF0915E592A60016C70574D644A
+8D2A762B6EE9575B6A8075F06F6D8C2D8C0857666BEF889278B363A253F970AD
+6C645858642A580268E0819B55107CD650188EBA6DCC8D9F70EB638F6D9B6ED4
+7EE68404684390036DD896768BA85957727985E4817E75BC8A8A68AF52548E22
+951163D098988E44557C4F5366FF568F60D56D9552435C4959296DFB586B7530
+751C606C82148146631167618FE2773A8DF38D3494C15E165385542C70C30000
+CD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006C405EF7505C4EAD5EAD633A8247901A6850916E77B3540C94DC5F647AE5
+687663457B527EDF75DB507762955934900F51F879C37A8156FE5F9290146D82
+5C60571F541051546E4D56E263A89893817F8715892A9000541E5C6F81C062D6
+625881319E3596409A6E9A7C692D59A562D3553E631654C786D96D3C5A0374E6
+889C6B6A59168C4C5F2F6E7E73A9987D4E3870F75B8C7897633D665A769660CB
+5B9B5A494E0781556C6A738B4EA167897F515F8065FA671B5FD859845A010000
+CE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005DCD5FAE537197E68FDD684556F4552F60DF4E3A6F4D7EF482C7840E59D4
+4F1F4F2A5C3E7EAC672A851A5473754F80C355829B4F4F4D6E2D8C135C096170
+536B761F6E29868A658795FB7EB9543B7A337D0A95EE55E17FC174EE631D8717
+6DA17A9D621165A1536763E16C835DEB545C94A84E4C6C618BEC5C4B65E0829C
+68A7543E54346BCB6B664E9463425348821E4F0D4FAE575E620A96FE66647269
+52FF52A1609F8BEF661471996790897F785277FD6670563B54389521727A0000
+CF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A00606F5E0C6089819D591560DC718470EF6EAA6C5072806A8488AD5E2D
+4E605AB3559C94E36D177CFB9699620F7EC6778E867E5323971E8F9666875CE1
+4FA072ED4E0B53A6590F54136380952851484ED99C9C7EA454B88D2488548237
+95F26D8E5F265ACC663E966973B0732E53BF817A99857FA15BAA967796507EBF
+76F853A2957699997BB189446E584E617FD479658BE660F354CD4EAB98795DF7
+6A6150CF54118C618427785D9704524A54EE56A395006D885BB56DC666530000
+D0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C0F5B5D6821809655787B11654869544E9B6B47874E978B534F631F643A
+90AA659C80C18C10519968B0537887F961C86CC46CFB8C225C5185AA82AF950C
+6B238F9B65B05FFB5FC34FE18845661F8165732960FA51745211578B5F6290A2
+884C91925E78674F602759D3514451F680F853086C7996C4718A4F114FEE7F9E
+673D55C5950879C088967EE3589F620C9700865A5618987B5F908BB884C49157
+53D965ED5E8F755C60647D6E5A7F7EEA7EED8F6955A75BA360AC65CB73840000
+D1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009009766377297EDA9774859B5B667A7496EA884052CB718F5FAA65EC8BE2
+5BFB9A6F5DE16B896C5B8BAD8BAF900A8FC5538B62BC9E269E2D54404E2B82BD
+7259869C5D1688596DAF96C554D14E9A8BB6710954BD960970DF6DF976D04E25
+781487125CA95EF68A00989C960E708E6CBF594463A9773C884D6F1482735830
+71D5538C781A96C155015F6671305BB48C1A9A8C6B83592E9E2F79E76768626C
+4F6F75A17F8A6D0B96336C274EF075D2517B68376F3E90808170599674760000
+D2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000064475C2790657A918C2359DA54AC8200836F898180006930564E80367237
+91CE51B64E5F987563964E1A53F666F3814B591C6DB24E0058F9533B63D694F1
+4F9D4F0A886398905937905779FB4EEA80F075916C825B9C59E85F5D69058681
+501A5DF24E5977E34EE5827A6291661390915C794EBF5F7981C69038808475AB
+4EA688D4610F6BC55FC64E4976CA6EA28BE38BAE8C0A8BD15F027FFC7FCC7ECE
+8335836B56E06BB797F3963459FB541F94F66DEB5BC5996E5C395F1596900000
+D3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000537082F16A315A749E705E947F2883B984248425836787478FCE8D6276C8
+5F719896786C662054DF62E54F6381C375C85EB896CD8E0A86F9548F6CF36D8C
+6C38607F52C775285E7D4F1860A05FE75C24753190AE94C072B96CB96E389149
+670953CB53F34F5191C98BF153C85E7C8FC26DE44E8E76C26986865E611A8206
+4F594FDE903E9C7C61096E1D6E1496854E885A3196E84E0E5C7F79B95B878BED
+7FBD738957DF828B90C15401904755BB5CEA5FA161086B3272F180B28A890000
+D4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D745BD388D598848C6B9A6D9E336E0A51A4514357A38881539F63F48F95
+56ED54585706733F6E907F188FDC82D1613F6028966266F07EA68D8A8DC394A5
+5CB37CA4670860A6960580184E9190E75300966851418FD08574915D665597F5
+5B55531D78386742683D54C9707E5BB08F7D518D572854B1651266828D5E8D43
+810F846C906D7CDF51FF85FB67A365E96FA186A48E81566A90207682707671E5
+8D2362E952196CFD8D3C600E589E618E66FE8D60624E55B36E23672D8F670000
+D5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000094E195F87728680569A8548B4E4D70B88BC86458658B5B857A84503A5BE8
+77BB6BE18A797C986CBE76CF65A98F975D2D5C5586386808536062187AD96E5B
+7EFD6A1F7AE05F706F335F20638C6DA867564E085E108D264ED780C07634969C
+62DB662D627E6CBC8D7571677F695146808753EC906E629854F286F08F998005
+951785178FD96D5973CD659F771F7504782781FB8D1E94884FA6679575B98BCA
+9707632F9547963584B8632377415F8172F04E896014657462EF6B63653F0000
+D6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005E2775C790D18BC1829D679D652F5431871877E580A281026C414E4B7EC7
+804C76F4690D6B966267503C4F84574063076B628DBE53EA65E87EB85FD7631A
+63B781F381F47F6E5E1C5CD95236667A79E97A1A8D28709975D46EDE6CBB7A92
+4E2D76C55FE0949F88777EC879CD80BF91CD4EF24F17821F54685DDE6D328BCC
+7CA58F7480985E1A549276B15B99663C9AA473E0682A86DB6731732A8BF88BDB
+90107AF970DB716E62C477A956314E3B845767F152A986C08D2E94F87B510000
+D7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F4F6CE8795D9A7B6293722A62FD4E1378168F6C64B08D5A7BC668695E84
+88C55986649E58EE72B6690E95258FFD8D5857607F008C0651C6634962D95353
+684C74228301914C55447740707C6D4A517954A88D4459FF6ECB6DC45B5C7D2B
+4ED47C7D6ED35B5081EA6E0D5B579B0368D58E2A5B977EFC603B7EB590B98D70
+594F63CD79DF8DB3535265CF79568BC5963B7EC494BB7E825634918967007F6A
+5C0A907566285DE64F5067DE505A4F5C57505EA7000000000000000000000000
+D8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E8D4E0C51404E105EFF53454E154E984E1E9B325B6C56694E2879BA4E3F
+53154E47592D723B536E6C1056DF80E499976BD3777E9F174E364E9F9F104E5C
+4E694E9382885B5B556C560F4EC4538D539D53A353A553AE97658D5D531A53F5
+5326532E533E8D5C5366536352025208520E522D5233523F5240524C525E5261
+525C84AF527D528252815290529351827F544EBB4EC34EC94EC24EE84EE14EEB
+4EDE4F1B4EF34F224F644EF54F254F274F094F2B4F5E4F6765384F5A4F5D0000
+D9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F5F4F574F324F3D4F764F744F914F894F834F8F4F7E4F7B4FAA4F7C4FAC
+4F944FE64FE84FEA4FC54FDA4FE34FDC4FD14FDF4FF85029504C4FF3502C500F
+502E502D4FFE501C500C50255028507E504350555048504E506C507B50A550A7
+50A950BA50D6510650ED50EC50E650EE5107510B4EDD6C3D4F584F654FCE9FA0
+6C467C74516E5DFD9EC999985181591452F9530D8A07531051EB591951554EA0
+51564EB3886E88A44EB5811488D279805B3488037FB851AB51B151BD51BC0000
+DA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000051C7519651A251A58BA08BA68BA78BAA8BB48BB58BB78BC28BC38BCB8BCF
+8BCE8BD28BD38BD48BD68BD88BD98BDC8BDF8BE08BE48BE88BE98BEE8BF08BF3
+8BF68BF98BFC8BFF8C008C028C048C078C0C8C0F8C118C128C148C158C168C19
+8C1B8C188C1D8C1F8C208C218C258C278C2A8C2B8C2E8C2F8C328C338C358C36
+5369537A961D962296219631962A963D963C964296499654965F9667966C9672
+96749688968D969796B09097909B909D909990AC90A190B490B390B690BA0000
+DB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090B890B090CF90C590BE90D090C490C790D390E690E290DC90D790DB90EB
+90EF90FE91049122911E91239131912F913991439146520D594252A252AC52AD
+52BE54FF52D052D652F053DF71EE77CD5EF451F551FC9B2F53B65F01755A5DEF
+574C57A957A1587E58BC58C558D15729572C572A57335739572E572F575C573B
+574257695785576B5786577C577B5768576D5776577357AD57A4578C57B257CF
+57A757B4579357A057D557D857DA57D957D257B857F457EF57F857E457DD0000
+DC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000580B580D57FD57ED5800581E5819584458205865586C58815889589A5880
+99A89F1961FF8279827D827F828F828A82A88284828E82918297829982AB82B8
+82BE82B082C882CA82E3829882B782AE82CB82CC82C182A982B482A182AA829F
+82C482CE82A482E1830982F782E4830F830782DC82F482D282D8830C82FB82D3
+8311831A83068314831582E082D5831C8351835B835C83088392833C83348331
+839B835E832F834F83478343835F834083178360832D833A8333836683650000
+DD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008368831B8369836C836A836D836E83B0837883B383B483A083AA8393839C
+8385837C83B683A9837D83B8837B8398839E83A883BA83BC83C1840183E583D8
+58078418840B83DD83FD83D6841C84388411840683D483DF840F840383F883F9
+83EA83C583C0842683F083E1845C8451845A8459847384878488847A84898478
+843C844684698476848C848E8431846D84C184CD84D084E684BD84D384CA84BF
+84BA84E084A184B984B4849784E584E3850C750D853884F08539851F853A0000
+DE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008556853B84FF84FC8559854885688564855E857A77A285438572857B85A4
+85A88587858F857985AE859C858585B985B785B085D385C185DC85FF86278605
+86298616863C5EFE5F08593C594180375955595A5958530F5C225C255C2C5C34
+624C626A629F62BB62CA62DA62D762EE632262F66339634B634363AD63F66371
+637A638E63B4636D63AC638A636963AE63BC63F263F863E063FF63C463DE63CE
+645263C663BE64456441640B641B6420640C64266421645E6484646D64960000
+DF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000647A64B764B8649964BA64C064D064D764E464E265096525652E5F0B5FD2
+75195F11535F53F153FD53E953E853FB541254165406544B5452545354545456
+54435421545754595423543254825494547754715464549A549B548454765466
+549D54D054AD54C254B454D254A754A654D354D4547254A354D554BB54BF54CC
+54D954DA54DC54A954AA54A454DD54CF54DE551B54E7552054FD551454F35522
+5523550F55115527552A5567558F55B55549556D55415555553F5550553C0000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005537555655755576557755335530555C558B55D2558355B155B955885581
+559F557E55D65591557B55DF55BD55BE5594559955EA55F755C9561F55D155EB
+55EC55D455E655DD55C455EF55E555F255F355CC55CD55E855F555E48F94561E
+5608560C56015624562355FE56005627562D565856395657562C564D56625659
+565C564C5654568656645671566B567B567C5685569356AF56D456D756DD56E1
+56F556EB56F956FF5704570A5709571C5E0F5E195E145E115E315E3B5E3C0000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005E375E445E545E5B5E5E5E615C8C5C7A5C8D5C905C965C885C985C995C91
+5C9A5C9C5CB55CA25CBD5CAC5CAB5CB15CA35CC15CB75CC45CD25CE45CCB5CE5
+5D025D035D275D265D2E5D245D1E5D065D1B5D585D3E5D345D3D5D6C5D5B5D6F
+5D5D5D6B5D4B5D4A5D695D745D825D995D9D8C735DB75DC55F735F775F825F87
+5F895F8C5F955F995F9C5FA85FAD5FB55FBC88625F6172AD72B072B472B772B8
+72C372C172CE72CD72D272E872EF72E972F272F472F7730172F3730372FA0000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000072FB731773137321730A731E731D7315732273397325732C733873317350
+734D73577360736C736F737E821B592598E7592459029963996799689969996A
+996B996C99749977997D998099849987998A998D999099919993999499955E80
+5E915E8B5E965EA55EA05EB95EB55EBE5EB38D535ED25ED15EDB5EE85EEA81BA
+5FC45FC95FD65FCF60035FEE60045FE15FE45FFE600560065FEA5FED5FF86019
+60356026601B600F600D6029602B600A603F602160786079607B607A60420000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000606A607D6096609A60AD609D60836092608C609B60EC60BB60B160DD60D8
+60C660DA60B4612061266115612360F46100610E612B614A617561AC619461A7
+61B761D461F55FDD96B395E995EB95F195F395F595F695FC95FE960396049606
+9608960A960B960C960D960F96129615961696179619961A4E2C723F62156C35
+6C546C5C6C4A6CA36C856C906C946C8C6C686C696C746C766C866CA96CD06CD4
+6CAD6CF76CF86CF16CD76CB26CE06CD66CFA6CEB6CEE6CB16CD36CEF6CFE0000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D396D276D0C6D436D486D076D046D196D0E6D2B6D4D6D2E6D356D1A6D4F
+6D526D546D336D916D6F6D9E6DA06D5E6D936D946D5C6D606D7C6D636E1A6DC7
+6DC56DDE6E0E6DBF6DE06E116DE66DDD6DD96E166DAB6E0C6DAE6E2B6E6E6E4E
+6E6B6EB26E5F6E866E536E546E326E256E446EDF6EB16E986EE06F2D6EE26EA5
+6EA76EBD6EBB6EB76ED76EB46ECF6E8F6EC26E9F6F626F466F476F246F156EF9
+6F2F6F366F4B6F746F2A6F096F296F896F8D6F8C6F786F726F7C6F7A6FD10000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006FC96FA76FB96FB66FC26FE16FEE6FDE6FE06FEF701A7023701B70397035
+704F705E5B805B845B955B935BA55BB8752F9A9E64345BE45BEE89305BF08E47
+8B078FB68FD38FD58FE58FEE8FE48FE98FE68FF38FE890059004900B90269011
+900D9016902190359036902D902F9044905190529050906890589062905B66B9
+9074907D908290889083908B5F505F575F565F585C3B54AB5C505C595B715C63
+5C667FBC5F2A5F295F2D82745F3C9B3B5C6E59815983598D59A959AA59A30000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000599759CA59AB599E59A459D259B259AF59D759BE5A055A0659DD5A0859E3
+59D859F95A0C5A095A325A345A115A235A135A405A675A4A5A555A3C5A625A75
+80EC5AAA5A9B5A775A7A5ABE5AEB5AB25AD25AD45AB85AE05AE35AF15AD65AE6
+5AD85ADC5B095B175B165B325B375B405C155C1C5B5A5B655B735B515B535B62
+9A759A779A789A7A9A7F9A7D9A809A819A859A889A8A9A909A929A939A969A98
+9A9B9A9C9A9D9A9F9AA09AA29AA39AA59AA77E9F7EA17EA37EA57EA87EA90000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007EAD7EB07EBE7EC07EC17EC27EC97ECB7ECC7ED07ED47ED77EDB7EE07EE1
+7EE87EEB7EEE7EEF7EF17EF27F0D7EF67EFA7EFB7EFE7F017F027F037F077F08
+7F0B7F0C7F0F7F117F127F177F197F1C7F1B7F1F7F217F227F237F247F257F26
+7F277F2A7F2B7F2C7F2D7F2F7F307F317F327F337F355E7A757F5DDB753E9095
+738E739173AE73A2739F73CF73C273D173B773B373C073C973C873E573D9987C
+740A73E973E773DE73BA73F2740F742A745B7426742574287430742E742C0000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000741B741A7441745C7457745574597477746D747E749C748E748074817487
+748B749E74A874A9749074A774D274BA97EA97EB97EC674C6753675E67486769
+67A56787676A6773679867A7677567A8679E67AD678B6777677C67F0680967D8
+680A67E967B0680C67D967B567DA67B367DD680067C367B867E2680E67C167FD
+6832683368606861684E6862684468646883681D68556866684168676840683E
+684A6849682968B5688F687468776893686B68C2696E68FC691F692068F90000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000692468F0690B6901695768E369106971693969606942695D6984696B6980
+69986978693469CC6987698869CE6989696669636979699B69A769BB69AB69AD
+69D469B169C169CA69DF699569E0698D69FF6A2F69ED6A176A186A6569F26A44
+6A3E6AA06A506A5B6A356A8E6A796A3D6A286A586A7C6A916A906AA96A976AAB
+733773526B816B826B876B846B926B936B8D6B9A6B9B6BA16BAA8F6B8F6D8F71
+8F728F738F758F768F788F778F798F7A8F7C8F7E8F818F828F848F878F8B0000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008F8D8F8E8F8F8F988F9A8ECE620B6217621B621F6222622162256224622C
+81E774EF74F474FF750F75117513653465EE65EF65F0660A6619677266036615
+6600708566F7661D66346631663666358006665F66546641664F665666616657
+66776684668C66A7669D66BE66DB66DC66E666E98D328D338D368D3B8D3D8D40
+8D458D468D488D498D478D4D8D558D5989C789CA89CB89CC89CE89CF89D089D1
+726E729F725D7266726F727E727F7284728B728D728F72926308633263B00000
+EB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000643F64D880046BEA6BF36BFD6BF56BF96C056C076C066C0D6C156C186C19
+6C1A6C216C296C246C2A6C3265356555656B724D72527256723086625216809F
+809C809380BC670A80BD80B180AB80AD80B480B780E780E880E980EA80DB80C2
+80C480D980CD80D7671080DD80EB80F180F480ED810D810E80F280FC67158112
+8C5A8136811E812C811881328148814C815381748159815A817181608169817C
+817D816D8167584D5AB58188818281916ED581A381AA81CC672681CA81BB0000
+EC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081C181A66B246B376B396B436B466B5998D198D298D398D598D998DA6BB3
+5F406BC289F365909F51659365BC65C665C465C365CC65CE65D265D67080709C
+7096709D70BB70C070B770AB70B170E870CA711071137116712F71317173715C
+716871457172714A7178717A719871B371B571A871A071E071D471E771F9721D
+7228706C7118716671B9623E623D624362486249793B794079467949795B795C
+7953795A796279577960796F7967797A7985798A799A79A779B35FD15FD00000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000603C605D605A606760416059606360AB6106610D615D61A9619D61CB61D1
+62068080807F6C936CF66DFC77F677F87800780978177818781165AB782D781C
+781D7839783A783B781F783C7825782C78237829784E786D7856785778267850
+7847784C786A789B7893789A7887789C78A178A378B278B978A578D478D978C9
+78EC78F2790578F479137924791E79349F9B9EF99EFB9EFC76F17704770D76F9
+77077708771A77227719772D7726773577387750775177477743775A77680000
+EE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077627765777F778D777D7780778C7791779F77A077B077B577BD753A7540
+754E754B7548755B7572757975837F587F617F5F8A487F687F747F717F797F81
+7F7E76CD76E58832948594869487948B948A948C948D948F9490949494979495
+949A949B949C94A394A494AB94AA94AD94AC94AF94B094B294B494B694B794B8
+94B994BA94BC94BD94BF94C494C894C994CA94CB94CC94CD94CE94D094D194D2
+94D594D694D794D994D894DB94DE94DF94E094E294E494E594E794E894EA0000
+EF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000094E994EB94EE94EF94F394F494F594F794F994FC94FD94FF950395029506
+95079509950A950D950E950F951295139514951595169518951B951D951E951F
+9522952A952B9529952C953195329534953695379538953C953E953F95429535
+9544954595469549954C954E954F9552955395549556955795589559955B955E
+955F955D95619562956495659566956795689569956A956B956C956F95719572
+9573953A77E777EC96C979D579ED79E379EB7A065D477A037A027A1E7A140000
+F0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A397A377A519ECF99A57A707688768E7693769976A474DE74E0752C9E20
+9E229E289E299E2A9E2B9E2C9E329E319E369E389E379E399E3A9E3E9E419E42
+9E449E469E479E489E499E4B9E4C9E4E9E519E559E579E5A9E5B9E5C9E5E9E63
+9E669E679E689E699E6A9E6B9E6C9E719E6D9E7375927594759675A0759D75AC
+75A375B375B475B875C475B175B075C375C275D675CD75E375E875E675E475EB
+75E7760375F175FC75FF761076007605760C7617760A76257618761576190000
+F1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000761B763C762276207640762D7630763F76357643763E7633764D765E7654
+765C7656766B766F7FCA7AE67A787A797A807A867A887A957AA67AA07AAC7AA8
+7AAD7AB3886488698872887D887F888288A288C688B788BC88C988E288CE88E3
+88E588F1891A88FC88E888FE88F0892189198913891B890A8934892B89368941
+8966897B758B80E576B276B477DC801280148016801C80208022802580268027
+802980288031800B803580438046804D80528069807189839878988098830000
+F2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009889988C988D988F9894989A989B989E989F98A198A298A598A6864D8654
+866C866E867F867A867C867B86A8868D868B86AC869D86A786A386AA869386A9
+86B686C486B586CE86B086BA86B186AF86C986CF86B486E986F186F286ED86F3
+86D0871386DE86F486DF86D886D18703870786F88708870A870D87098723873B
+871E8725872E871A873E87488734873187298737873F87828722877D877E877B
+87608770874C876E878B87538763877C876487598765879387AF87A887D20000
+F3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000087C68788878587AD8797878387AB87E587AC87B587B387CB87D387BD87D1
+87C087CA87DB87EA87E087EE8816881387FE880A881B88218839883C7F367F42
+7F447F4582107AFA7AFD7B087B037B047B157B0A7B2B7B0F7B477B387B2A7B19
+7B2E7B317B207B257B247B337B3E7B1E7B587B5A7B457B757B4C7B5D7B607B6E
+7B7B7B627B727B717B907BA67BA77BB87BAC7B9D7BA87B857BAA7B9C7BA27BAB
+7BB47BD17BC17BCC7BDD7BDA7BE57BE67BEA7C0C7BFE7BFC7C0F7C167C0B0000
+F4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007C1F7C2A7C267C387C417C4081FE82018202820481EC8844822182228223
+822D822F8228822B8238823B82338234823E82448249824B824F825A825F8268
+887E8885888888D888DF895E7F9D7F9F7FA77FAF7FB07FB27C7C65497C917C9D
+7C9C7C9E7CA27CB27CBC7CBD7CC17CC77CCC7CCD7CC87CC57CD77CE8826E66A8
+7FBF7FCE7FD57FE57FE17FE67FE97FEE7FF37CF87D777DA67DAE7E477E9B9EB8
+9EB48D738D848D948D918DB18D678D6D8C478C49914A9150914E914F91640000
+F5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009162916191709169916F917D917E917291749179918C91859190918D9191
+91A291A391AA91AD91AE91AF91B591B491BA8C559E7E8DB88DEB8E058E598E69
+8DB58DBF8DBC8DBA8DC48DD68DD78DDA8DDE8DCE8DCF8DDB8DC68DEC8DF78DF8
+8DE38DF98DFB8DE48E098DFD8E148E1D8E1F8E2C8E2E8E238E2F8E3A8E408E39
+8E358E3D8E318E498E418E428E518E528E4A8E708E768E7C8E6F8E748E858E8F
+8E948E908E9C8E9E8C788C828C8A8C858C988C94659B89D689DE89DA89DC0000
+F6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000089E589EB89EF8A3E8B26975396E996F396EF970697019708970F970E972A
+972D9730973E9F809F839F859F869F879F889F899F8A9F8C9EFE9F0B9F0D96B9
+96BC96BD96CE96D277BF96E0928E92AE92C8933E936A93CA938F943E946B9C7F
+9C829C859C869C879C887A239C8B9C8E9C909C919C929C949C959C9A9C9B9C9E
+9C9F9CA09CA19CA29CA39CA59CA69CA79CA89CA99CAB9CAD9CAE9CB09CB19CB2
+9CB39CB49CB59CB69CB79CBA9CBB9CBC9CBD9CC49CC59CC69CC79CCA9CCB0000
+F7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009CCC9CCD9CCE9CCF9CD09CD39CD49CD59CD79CD89CD99CDC9CDD9CDF9CE2
+977C978597919792979497AF97AB97A397B297B49AB19AB09AB79E589AB69ABA
+9ABC9AC19AC09AC59AC29ACB9ACC9AD19B459B439B479B499B489B4D9B5198E8
+990D992E995599549ADF9AE19AE69AEF9AEB9AFB9AED9AF99B089B0F9B139B1F
+9B239EBD9EBE7E3B9E829E879E889E8B9E9293D69E9D9E9F9EDB9EDC9EDD9EE0
+9EDF9EE29EE99EE79EE59EEA9EEF9F229F2C9F2F9F399F379F3D9F3E9F440000
diff --git a/tcl/library/encoding/euc-jp.enc b/tcl/library/encoding/euc-jp.enc
new file mode 100644
index 00000000000..9b7abb140a2
--- /dev/null
+++ b/tcl/library/encoding/euc-jp.enc
@@ -0,0 +1,1346 @@
+# Encoding file: euc-jp, multi-byte
+M
+003F 0 79
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D0000008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000300030013002FF0CFF0E30FBFF1AFF1BFF1FFF01309B309C00B4FF4000A8
+FF3EFFE3FF3F30FD30FE309D309E30034EDD30053006300730FC20152010FF0F
+FF3C301C2016FF5C2026202520182019201C201DFF08FF0930143015FF3BFF3D
+FF5BFF5D30083009300A300B300C300D300E300F30103011FF0B221200B100D7
+00F7FF1D2260FF1CFF1E22662267221E22342642264000B0203220332103FFE5
+FF0400A200A3FF05FF03FF06FF0AFF2000A72606260525CB25CF25CE25C70000
+A2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000025C625A125A025B325B225BD25BC203B3012219221902191219330130000
+00000000000000000000000000000000000000002208220B2286228722822283
+222A2229000000000000000000000000000000002227222800AC21D221D42200
+220300000000000000000000000000000000000000000000222022A523122202
+220722612252226A226B221A223D221D2235222B222C00000000000000000000
+00000000212B2030266F266D266A2020202100B6000000000000000025EF0000
+A3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19000000000000000000000000
+0000FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3A00000000000000000000
+0000FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5A00000000000000000000
+A4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+A5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+A6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000004100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+A8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000025002502250C251025182514251C252C25242534253C25012503250F2513
+251B251725232533252B253B254B2520252F25282537253F251D253025252538
+2542000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+B0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E9C55165A03963F54C0611B632859F690228475831C7A5060AA63E16E25
+65ED846682A69BF56893572765A162715B9B59D0867B98F47D627DBE9B8E6216
+7C9F88B75B895EB563096697684895C7978D674F4EE54F0A4F4D4F9D504956F2
+593759D45A015C0960DF610F61706613690570BA754F757079FB7DAD7DEF80C3
+840E88638B029055907A533B4E954EA557DF80B290C178EF4E0058F16EA29038
+7A328328828B9C2F5141537054BD54E156E059FB5F1598F26DEB80E4852D0000
+B1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009662967096A097FB540B53F35B8770CF7FBD8FC296E8536F9D5C7ABA4E11
+789381FC6E26561855046B1D851A9C3B59E553A96D6674DC958F56424E91904B
+96F2834F990C53E155B65B305F71662066F368046C386CF36D29745B76C87A4E
+983482F1885B8A6092ED6DB275AB76CA99C560A68B018D8A95B2698E53AD5186
+5712583059445BB45EF6602863A963F46CBF6F14708E7114715971D5733F7E01
+827682D185979060925B9D1B586965BC6C5A752551F9592E59655F805FDC0000
+B2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000062BC65FA6A2A6B276BB4738B7FC189569D2C9D0E9EC45CA16C96837B5104
+5C4B61B681C6687672614E594FFA537860696E297A4F97F34E0B53164EEE4F55
+4F3D4FA14F7352A053EF5609590F5AC15BB65BE179D16687679C67B66B4C6CB3
+706B73C2798D79BE7A3C7B8782B182DB8304837783EF83D387668AB256298CA8
+8FE6904E971E868A4FC45CE862117259753B81E582BD86FE8CC096C5991399D5
+4ECB4F1A89E356DE584A58CA5EFB5FEB602A6094606261D0621262D065390000
+B3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009B41666668B06D777070754C76867D7582A587F9958B968E8C9D51F152BE
+591654B35BB35D16616869826DAF788D84CB88578A7293A79AB86D6C99A886D9
+57A367FF86CE920E5283568754045ED362E164B9683C68386BBB737278BA7A6B
+899A89D28D6B8F0390ED95A3969497695B665CB3697D984D984E639B7B206A2B
+6A7F68B69C0D6F5F5272559D607062EC6D3B6E076ED1845B89108F444E149C39
+53F6691B6A3A9784682A515C7AC384B291DC938C565B9D286822830584310000
+B4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007CA5520882C574E64E7E4F8351A05BD2520A52D852E75DFB559A582A59E6
+5B8C5B985BDB5E725E7960A3611F616361BE63DB656267D1685368FA6B3E6B53
+6C576F226F976F4574B0751876E3770B7AFF7BA17C217DE97F367FF0809D8266
+839E89B38ACC8CAB908494519593959195A2966597D3992882184E38542B5CB8
+5DCC73A9764C773C5CA97FEB8D0B96C19811985498584F014F0E5371559C5668
+57FA59475B095BC45C905E0C5E7E5FCC63EE673A65D765E2671F68CB68C40000
+B5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006A5F5E306BC56C176C7D757F79485B637A007D005FBD898F8A188CB48D77
+8ECC8F1D98E29A0E9B3C4E80507D510059935B9C622F628064EC6B3A72A07591
+79477FA987FB8ABC8B7063AC83CA97A05409540355AB68546A588A7078276775
+9ECD53745BA2811A865090064E184E454EC74F1153CA54385BAE5F1360256551
+673D6C426C726CE3707874037A767AAE7B087D1A7CFE7D6665E7725B53BB5C45
+5DE862D262E063196E20865A8A318DDD92F86F0179A69B5A4EA84EAB4EAC0000
+B6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F9B4FA050D151477AF6517151F653545321537F53EB55AC58835CE15F37
+5F4A602F6050606D631F65596A4B6CC172C272ED77EF80F881058208854E90F7
+93E197FF99579A5A4EF051DD5C2D6681696D5C4066F26975738968507C8150C5
+52E457475DFE932665A46B236B3D7434798179BD7B4B7DCA82B983CC887F895F
+8B398FD191D1541F92804E5D503653E5533A72D7739677E982E68EAF99C699C8
+99D25177611A865E55B07A7A50765BD3904796854E326ADB91E75C515C480000
+B7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000063987A9F6C9397748F617AAA718A96887C8268177E706851936C52F2541B
+85AB8A137FA48ECD90E15366888879414FC250BE521151445553572D73EA578B
+59515F625F8460756176616761A963B2643A656C666F68426E1375667A3D7CFB
+7D4C7D997E4B7F6B830E834A86CD8A088A638B668EFD981A9D8F82B88FCE9BE8
+5287621F64836FC09699684150916B206C7A6F547A747D5088408A2367084EF6
+503950265065517C5238526355A7570F58055ACC5EFA61B261F862F363720000
+B8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000691C6A29727D72AC732E7814786F7D79770C80A9898B8B198CE28ED29063
+9375967A98559A139E785143539F53B35E7B5F266E1B6E90738473FE7D438237
+8A008AFA96504E4E500B53E4547C56FA59D15B645DF15EAB5F276238654567AF
+6E5672D07CCA88B480A180E183F0864E8A878DE8923796C798679F134E944E92
+4F0D53485449543E5A2F5F8C5FA1609F68A76A8E745A78818A9E8AA48B779190
+4E5E9BC94EA44F7C4FAF501950165149516C529F52B952FE539A53E354110000
+B9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000540E5589575157A2597D5B545B5D5B8F5DE55DE75DF75E785E835E9A5EB7
+5F186052614C629762D863A7653B6602664366F4676D6821689769CB6C5F6D2A
+6D696E2F6E9D75327687786C7A3F7CE07D057D187D5E7DB18015800380AF80B1
+8154818F822A8352884C88618B1B8CA28CFC90CA91759271783F92FC95A4964D
+980599999AD89D3B525B52AB53F7540858D562F76FE08C6A8F5F9EB9514B523B
+544A56FD7A4091779D609ED273446F09817075115FFD60DA9AA872DB8FBC0000
+BA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006B6498034ECA56F0576458BE5A5A606861C7660F6606683968B16DF775D5
+7D3A826E9B424E9B4F5053C955065D6F5DE65DEE67FB6C99747378028A509396
+88DF57505EA7632B50B550AC518D670054C9585E59BB5BB05F69624D63A1683D
+6B736E08707D91C7728078157826796D658E7D3083DC88C18F09969B52645728
+67507F6A8CA151B45742962A583A698A80B454B25D0E57FC78959DFA4F5C524A
+548B643E6628671467F57A847B567D22932F685C9BAD7B395319518A52370000
+BB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005BDF62F664AE64E6672D6BBA85A996D176909BD6634C93069BAB76BF6652
+4E09509853C25C7160E864926563685F71E673CA75237B977E8286958B838CDB
+9178991065AC66AB6B8B4ED54ED44F3A4F7F523A53F853F255E356DB58EB59CB
+59C959FF5B505C4D5E025E2B5FD7601D6307652F5B5C65AF65BD65E8679D6B62
+6B7B6C0F7345794979C17CF87D197D2B80A2810281F389968A5E8A698A668A8C
+8AEE8CC78CDC96CC98FC6B6F4E8B4F3C4F8D51505B575BFA6148630166420000
+BC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006B216ECB6CBB723E74BD75D478C1793A800C803381EA84948F9E6C509E7F
+5F0F8B589D2B7AFA8EF85B8D96EB4E0353F157F759315AC95BA460896E7F6F06
+75BE8CEA5B9F85007BE0507267F4829D5C61854A7E1E820E51995C0463688D66
+659C716E793E7D1780058B1D8ECA906E86C790AA501F52FA5C3A6753707C7235
+914C91C8932B82E55BC25F3160F94E3B53D65B88624B67316B8A72E973E07A2E
+816B8DA391529996511253D7546A5BFF63886A397DAC970056DA53CE54680000
+BD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005B975C315DDE4FEE610162FE6D3279C079CB7D427E4D7FD281ED821F8490
+884689728B908E748F2F9031914B916C96C6919C4EC04F4F514553415F93620E
+67D46C416E0B73637E2691CD928353D459195BBF6DD1795D7E2E7C9B587E719F
+51FA88538FF04FCA5CFB662577AC7AE3821C99FF51C65FAA65EC696F6B896DF3
+6E966F6476FE7D145DE190759187980651E6521D6240669166D96E1A5EB67DD2
+7F7266F885AF85F78AF852A953D959735E8F5F90605592E4966450B7511F0000
+BE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000052DD5320534753EC54E8554655315617596859BE5A3C5BB55C065C0F5C11
+5C1A5E845E8A5EE05F70627F628462DB638C63776607660C662D6676677E68A2
+6A1F6A356CBC6D886E096E58713C7126716775C77701785D7901796579F07AE0
+7B117CA77D39809683D6848B8549885D88F38A1F8A3C8A548A738C618CDE91A4
+9266937E9418969C97984E0A4E084E1E4E575197527057CE583458CC5B225E38
+60C564FE676167566D4472B675737A6384B88B7291B89320563157F498FE0000
+BF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000062ED690D6B9671ED7E548077827289E698DF87558FB15C3B4F384FE14FB5
+55075A205BDD5BE95FC3614E632F65B0664B68EE699B6D786DF1753375B9771F
+795E79E67D3381E382AF85AA89AA8A3A8EAB8F9B903291DD97074EBA4EC15203
+587558EC5C0B751A5C3D814E8A0A8FC59663976D7B258ACF9808916256F353A8
+9017543957825E2563A86C34708A77617C8B7FE088709042915493109318968F
+745E9AC45D075D69657067A28DA896DB636E6749691983C5981796C088FE0000
+C0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006F84647A5BF84E16702C755D662F51C4523652E259D35F8160276210653F
+6574661F667468F268166B636E057272751F76DB7CBE805658F088FD897F8AA0
+8A938ACB901D91929752975965897A0E810696BB5E2D60DC621A65A566146790
+77F37A4D7C4D7E3E810A8CAC8D648DE18E5F78A9520762D963A5644262988A2D
+7A837BC08AAC96EA7D76820C87494ED95148534353605BA35C025C165DDD6226
+624764B0681368346CC96D456D1767D36F5C714E717D65CB7A7F7BAD7DDA0000
+C1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007E4A7FA8817A821B823985A68A6E8CCE8DF59078907792AD929195839BAE
+524D55846F387136516879857E5581B37CCE564C58515CA863AA66FE66FD695A
+72D9758F758E790E795679DF7C977D207D4486078A34963B90619F2050E75275
+53CC53E2500955AA58EE594F723D5B8B5C64531D60E360F3635C6383633F63BB
+64CD65E966F95DE369CD69FD6F1571E54E8975E976F87A937CDF7DCF7D9C8061
+83498358846C84BC85FB88C58D709001906D9397971C9A1250CF5897618E0000
+C2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081D385358D0890204FC3507452475373606F6349675F6E2C8DB3901F4FD7
+5C5E8CCA65CF7D9A53528896517663C35B585B6B5C0A640D6751905C4ED6591A
+592A6C708A51553E581559A560F0625367C182356955964099C49A284F535806
+5BFE80105CB15E2F5F856020614B623466FF6CF06EDE80CE817F82D4888B8CB8
+9000902E968A9EDB9BDB4EE353F059277B2C918D984C9DF96EDD702753535544
+5B856258629E62D36CA26FEF74228A1794386FC18AFE833851E786F853EA0000
+C3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000053E94F4690548FB0596A81315DFD7AEA8FBF68DA8C3772F89C486A3D8AB0
+4E3953585606576662C563A265E66B4E6DE16E5B70AD77ED7AEF7BAA7DBB803D
+80C686CB8A95935B56E358C75F3E65AD66966A806BB575378AC7502477E55730
+5F1B6065667A6C6075F47A1A7F6E81F48718904599B37BC9755C7AF97B5184C4
+901079E97A9283365AE177404E2D4EF25B995FE062BD663C67F16CE8866B8877
+8A3B914E92F399D06A177026732A82E784578CAF4E01514651CB558B5BF50000
+C4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005E165E335E815F145F355F6B5FB461F2631166A2671D6F6E7252753A773A
+80748139817887768ABF8ADC8D858DF3929A957798029CE552C5635776F46715
+6C8873CD8CC393AE96736D25589C690E69CC8FFD939A75DB901A585A680263B4
+69FB4F436F2C67D88FBB85267DB49354693F6F70576A58F75B2C7D2C722A540A
+91E39DB44EAD4F4E505C507552438C9E544858245B9A5E1D5E955EAD5EF75F1F
+608C62B5633A63D068AF6C407887798E7A0B7DE082478A028AE68E4490130000
+C5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090B8912D91D89F0E6CE5645864E265756EF476847B1B906993D16EBA54F2
+5FB964A48F4D8FED92445178586B59295C555E976DFB7E8F751C8CBC8EE2985B
+70B94F1D6BBF6FB1753096FB514E54105835585759AC5C605F926597675C6E21
+767B83DF8CED901490FD934D7825783A52AA5EA6571F597460125012515A51AC
+51CD520055105854585859575B955CF65D8B60BC6295642D6771684368BC68DF
+76D76DD86E6F6D9B706F71C85F5375D879777B497B547B527CD67D7152300000
+C6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008463856985E48A0E8B048C468E0F9003900F94199676982D9A3095D850CD
+52D5540C58025C0E61A7649E6D1E77B37AE580F48404905392855CE09D07533F
+5F975FB36D9C7279776379BF7BE46BD272EC8AAD68036A6151F87A8169345C4A
+9CF682EB5BC59149701E56785C6F60C765666C8C8C5A90419813545166C7920D
+594890A351854E4D51EA85998B0E7058637A934B696299B47E04757753576960
+8EDF96E36C5D4E8C5C3C5F108FE953028CD1808986795EFF65E54E7351650000
+C7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000059825C3F97EE4EFB598A5FCD8A8D6FE179B079625BE78471732B71B15E74
+5FF5637B649A71C37C984E435EFC4E4B57DC56A260A96FC37D0D80FD813381BF
+8FB2899786A45DF4628A64AD898767776CE26D3E743678345A467F7582AD99AC
+4FF35EC362DD63926557676F76C3724C80CC80BA8F29914D500D57F95A926885
+6973716472FD8CB758F28CE0966A9019877F79E477E784294F2F5265535A62CD
+67CF6CCA767D7B947C95823685848FEB66DD6F2072067E1B83AB99C19EA60000
+C8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000051FD7BB178727BB880877B486AE85E61808C75517560516B92626E8C767A
+91979AEA4F107F70629C7B4F95A59CE9567A585986E496BC4F345224534A53CD
+53DB5E06642C6591677F6C3E6C4E724872AF73ED75547E41822C85E98CA97BC4
+91C67169981298EF633D6669756A76E478D0854386EE532A5351542659835E87
+5F7C60B26249627962AB65906BD46CCC75B276AE789179D87DCB7F7780A588AB
+8AB98CBB907F975E98DB6A0B7C3850995C3E5FAE67876BD8743577097F8E0000
+C9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009F3B67CA7A175339758B9AED5F66819D83F180985F3C5FC575627B46903C
+686759EB5A9B7D10767E8B2C4FF55F6A6A196C376F0274E2796888688A558C79
+5EDF63CF75C579D282D7932892F2849C86ED9C2D54C15F6C658C6D5C70158CA7
+8CD3983B654F74F64E0D4ED857E0592B5A665BCC51A85E035E9C601662766577
+65A7666E6D6E72367B268150819A82998B5C8CA08CE68D74961C96444FAE64AB
+6B66821E8461856A90E85C01695398A8847A85574F0F526F5FA95E45670D0000
+CA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000798F8179890789866DF55F1762556CB84ECF72699B925206543B567458B3
+61A4626E711A596E7C897CDE7D1B96F06587805E4E194F75517558405E635E73
+5F0A67C44E26853D9589965B7C73980150FB58C1765678A7522577A585117B86
+504F590972477BC77DE88FBA8FD4904D4FBF52C95A295F0197AD4FDD821792EA
+570363556B69752B88DC8F147A4252DF58936155620A66AE6BCD7C3F83E95023
+4FF853055446583159495B9D5CF05CEF5D295E9662B16367653E65B9670B0000
+CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006CD56CE170F978327E2B80DE82B3840C84EC870289128A2A8C4A90A692D2
+98FD9CF39D6C4E4F4EA1508D5256574A59A85E3D5FD85FD9623F66B4671B67D0
+68D251927D2180AA81A88B008C8C8CBF927E96325420982C531750D5535C58A8
+64B26734726777667A4691E652C36CA16B8658005E4C5954672C7FFB51E176C6
+646978E89B549EBB57CB59B96627679A6BCE54E969D95E55819C67959BAA67FE
+9C52685D4EA64FE353C862B9672B6CAB8FC44FAD7E6D9EBF4E0761626E800000
+CC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006F2B85135473672A9B455DF37B955CAC5BC6871C6E4A84D17A1481085999
+7C8D6C11772052D959227121725F77DB97279D61690B5A7F5A1851A5540D547D
+660E76DF8FF792989CF459EA725D6EC5514D68C97DBF7DEC97629EBA64786A21
+830259845B5F6BDB731B76F27DB280178499513267289ED976EE676252FF9905
+5C24623B7C7E8CB0554F60B67D0B958053014E5F51B6591C723A803691CE5F25
+77E253845F797D0485AC8A338E8D975667F385AE9453610961086CB976520000
+CD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008AED8F38552F4F51512A52C753CB5BA55E7D60A0618263D6670967DA6E67
+6D8C733673377531795088D58A98904A909190F596C4878D59154E884F594E0E
+8A898F3F981050AD5E7C59965BB95EB863DA63FA64C166DC694A69D86D0B6EB6
+719475287AAF7F8A8000844984C989818B218E0A9065967D990A617E62916B32
+6C836D747FCC7FFC6DC07F8587BA88F8676583B1983C96F76D1B7D61843D916A
+4E7153755D506B046FEB85CD862D89A75229540F5C65674E68A8740674830000
+CE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075E288CF88E191CC96E296785F8B73877ACB844E63A0756552896D416E9C
+74097559786B7C9296867ADC9F8D4FB6616E65C5865C4E864EAE50DA4E2151CC
+5BEE659968816DBC731F764277AD7A1C7CE7826F8AD2907C91CF96759818529B
+7DD1502B539867976DCB71D0743381E88F2A96A39C579E9F746058416D997D2F
+985E4EE44F364F8B51B752B15DBA601C73B2793C82D3923496B796F6970A9E97
+9F6266A66B74521752A370C888C25EC9604B61906F2371497C3E7DF4806F0000
+CF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000084EE9023932C54429B6F6AD370898CC28DEF973252B45A415ECA5F046717
+697C69946D6A6F0F726272FC7BED8001807E874B90CE516D9E937984808B9332
+8AD6502D548C8A716B6A8CC4810760D167A09DF24E994E989C108A6B85C18568
+69006E7E78978155000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+D0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F0C4E104E154E2A4E314E364E3C4E3F4E424E564E584E824E858C6B4E8A
+82125F0D4E8E4E9E4E9F4EA04EA24EB04EB34EB64ECE4ECD4EC44EC64EC24ED7
+4EDE4EED4EDF4EF74F094F5A4F304F5B4F5D4F574F474F764F884F8F4F984F7B
+4F694F704F914F6F4F864F9651184FD44FDF4FCE4FD84FDB4FD14FDA4FD04FE4
+4FE5501A50285014502A502550054F1C4FF650215029502C4FFE4FEF50115006
+504350476703505550505048505A5056506C50785080509A508550B450B20000
+D1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000050C950CA50B350C250D650DE50E550ED50E350EE50F950F5510951015102
+511651155114511A5121513A5137513C513B513F51405152514C515451627AF8
+5169516A516E5180518256D8518C5189518F519151935195519651A451A651A2
+51A951AA51AB51B351B151B251B051B551BD51C551C951DB51E0865551E951ED
+51F051F551FE5204520B5214520E5227522A522E52335239524F5244524B524C
+525E5254526A527452695273527F527D528D529452925271528852918FA80000
+D2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008FA752AC52AD52BC52B552C152CD52D752DE52E352E698ED52E052F352F5
+52F852F9530653087538530D5310530F5315531A5323532F5331533353385340
+534653454E175349534D51D6535E5369536E5918537B53775382539653A053A6
+53A553AE53B053B653C37C1296D953DF66FC71EE53EE53E853ED53FA5401543D
+5440542C542D543C542E54365429541D544E548F5475548E545F547154775470
+5492547B5480547654845490548654C754A254B854A554AC54C454C854A80000
+D3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054AB54C254A454BE54BC54D854E554E6550F551454FD54EE54ED54FA54E2
+553955405563554C552E555C55455556555755385533555D5599558054AF558A
+559F557B557E5598559E55AE557C558355A9558755A855DA55C555DF55C455DC
+55E455D4561455F7561655FE55FD561B55F9564E565071DF5634563656325638
+566B5664562F566C566A56865680568A56A05694568F56A556AE56B656B456C2
+56BC56C156C356C056C856CE56D156D356D756EE56F9570056FF570457090000
+D4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005708570B570D57135718571655C7571C572657375738574E573B5740574F
+576957C057885761577F5789579357A057B357A457AA57B057C357C657D457D2
+57D3580A57D657E3580B5819581D587258215862584B58706BC05852583D5879
+588558B9589F58AB58BA58DE58BB58B858AE58C558D358D158D758D958D858E5
+58DC58E458DF58EF58FA58F958FB58FC58FD5902590A5910591B68A65925592C
+592D59325938593E7AD259555950594E595A5958596259605967596C59690000
+D5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000059785981599D4F5E4FAB59A359B259C659E859DC598D59D959DA5A255A1F
+5A115A1C5A095A1A5A405A6C5A495A355A365A625A6A5A9A5ABC5ABE5ACB5AC2
+5ABD5AE35AD75AE65AE95AD65AFA5AFB5B0C5B0B5B165B325AD05B2A5B365B3E
+5B435B455B405B515B555B5A5B5B5B655B695B705B735B755B7865885B7A5B80
+5B835BA65BB85BC35BC75BC95BD45BD05BE45BE65BE25BDE5BE55BEB5BF05BF6
+5BF35C055C075C085C0D5C135C205C225C285C385C395C415C465C4E5C530000
+D6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C505C4F5B715C6C5C6E4E625C765C795C8C5C915C94599B5CAB5CBB5CB6
+5CBC5CB75CC55CBE5CC75CD95CE95CFD5CFA5CED5D8C5CEA5D0B5D155D175D5C
+5D1F5D1B5D115D145D225D1A5D195D185D4C5D525D4E5D4B5D6C5D735D765D87
+5D845D825DA25D9D5DAC5DAE5DBD5D905DB75DBC5DC95DCD5DD35DD25DD65DDB
+5DEB5DF25DF55E0B5E1A5E195E115E1B5E365E375E445E435E405E4E5E575E54
+5E5F5E625E645E475E755E765E7A9EBC5E7F5EA05EC15EC25EC85ED05ECF0000
+D7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005ED65EE35EDD5EDA5EDB5EE25EE15EE85EE95EEC5EF15EF35EF05EF45EF8
+5EFE5F035F095F5D5F5C5F0B5F115F165F295F2D5F385F415F485F4C5F4E5F2F
+5F515F565F575F595F615F6D5F735F775F835F825F7F5F8A5F885F915F875F9E
+5F995F985FA05FA85FAD5FBC5FD65FFB5FE45FF85FF15FDD60B35FFF60216060
+601960106029600E6031601B6015602B6026600F603A605A6041606A6077605F
+604A6046604D6063604360646042606C606B60596081608D60E76083609A0000
+D8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006084609B60966097609260A7608B60E160B860E060D360B45FF060BD60C6
+60B560D8614D6115610660F660F7610060F460FA6103612160FB60F1610D610E
+6147613E61286127614A613F613C612C6134613D614261446173617761586159
+615A616B6174616F61656171615F615D6153617561996196618761AC6194619A
+618A619161AB61AE61CC61CA61C961F761C861C361C661BA61CB7F7961CD61E6
+61E361F661FA61F461FF61FD61FC61FE620062086209620D620C6214621B0000
+D9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000621E6221622A622E6230623262336241624E625E6263625B62606268627C
+62826289627E62926293629662D46283629462D762D162BB62CF62FF62C664D4
+62C862DC62CC62CA62C262C7629B62C9630C62EE62F163276302630862EF62F5
+6350633E634D641C634F6396638E638063AB637663A3638F6389639F63B5636B
+636963BE63E963C063C663E363C963D263F663C4641664346406641364266436
+651D64176428640F6467646F6476644E652A6495649364A564A9648864BC0000
+DA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000064DA64D264C564C764BB64D864C264F164E7820964E064E162AC64E364EF
+652C64F664F464F264FA650064FD6518651C650565246523652B653465356537
+65366538754B654865566555654D6558655E655D65726578658265838B8A659B
+659F65AB65B765C365C665C165C465CC65D265DB65D965E065E165F16772660A
+660365FB6773663566366634661C664F664466496641665E665D666466676668
+665F6662667066836688668E668966846698669D66C166B966C966BE66BC0000
+DB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000066C466B866D666DA66E0663F66E666E966F066F566F7670F6716671E6726
+67279738672E673F67366741673867376746675E676067596763676467896770
+67A9677C676A678C678B67A667A1678567B767EF67B467EC67B367E967B867E4
+67DE67DD67E267EE67B967CE67C667E76A9C681E684668296840684D6832684E
+68B3682B685968636877687F689F688F68AD6894689D689B68836AAE68B96874
+68B568A068BA690F688D687E690168CA690868D86922692668E1690C68CD0000
+DC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068D468E768D569366912690468D768E3692568F968E068EF6928692A691A
+6923692168C669796977695C6978696B6954697E696E69396974693D69596930
+6961695E695D6981696A69B269AE69D069BF69C169D369BE69CE5BE869CA69DD
+69BB69C369A76A2E699169A0699C699569B469DE69E86A026A1B69FF6B0A69F9
+69F269E76A0569B16A1E69ED6A1469EB6A0A6A126AC16A236A136A446A0C6A72
+6A366A786A476A626A596A666A486A386A226A906A8D6AA06A846AA26AA30000
+DD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006A9786176ABB6AC36AC26AB86AB36AAC6ADE6AD16ADF6AAA6ADA6AEA6AFB
+6B0586166AFA6B126B169B316B1F6B386B3776DC6B3998EE6B476B436B496B50
+6B596B546B5B6B5F6B616B786B796B7F6B806B846B836B8D6B986B956B9E6BA4
+6BAA6BAB6BAF6BB26BB16BB36BB76BBC6BC66BCB6BD36BDF6BEC6BEB6BF36BEF
+9EBE6C086C136C146C1B6C246C236C5E6C556C626C6A6C826C8D6C9A6C816C9B
+6C7E6C686C736C926C906CC46CF16CD36CBD6CD76CC56CDD6CAE6CB16CBE0000
+DE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006CBA6CDB6CEF6CD96CEA6D1F884D6D366D2B6D3D6D386D196D356D336D12
+6D0C6D636D936D646D5A6D796D596D8E6D956FE46D856DF96E156E0A6DB56DC7
+6DE66DB86DC66DEC6DDE6DCC6DE86DD26DC56DFA6DD96DE46DD56DEA6DEE6E2D
+6E6E6E2E6E196E726E5F6E3E6E236E6B6E2B6E766E4D6E1F6E436E3A6E4E6E24
+6EFF6E1D6E386E826EAA6E986EC96EB76ED36EBD6EAF6EC46EB26ED46ED56E8F
+6EA56EC26E9F6F416F11704C6EEC6EF86EFE6F3F6EF26F316EEF6F326ECC0000
+DF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006F3E6F136EF76F866F7A6F786F816F806F6F6F5B6FF36F6D6F826F7C6F58
+6F8E6F916FC26F666FB36FA36FA16FA46FB96FC66FAA6FDF6FD56FEC6FD46FD8
+6FF16FEE6FDB7009700B6FFA70117001700F6FFE701B701A6F74701D7018701F
+7030703E7032705170637099709270AF70F170AC70B870B370AE70DF70CB70DD
+70D9710970FD711C711971657155718871667162714C7156716C718F71FB7184
+719571A871AC71D771B971BE71D271C971D471CE71E071EC71E771F571FC0000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000071F971FF720D7210721B7228722D722C72307232723B723C723F72407246
+724B72587274727E7282728172877292729672A272A772B972B272C372C672C4
+72CE72D272E272E072E172F972F7500F7317730A731C7316731D7334732F7329
+7325733E734E734F9ED87357736A7368737073787375737B737A73C873B373CE
+73BB73C073E573EE73DE74A27405746F742573F87432743A7455743F745F7459
+7441745C746974707463746A7476747E748B749E74A774CA74CF74D473F10000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000074E074E374E774E974EE74F274F074F174F874F7750475037505750C750E
+750D75157513751E7526752C753C7544754D754A7549755B7546755A75697564
+7567756B756D75787576758675877574758A758975827594759A759D75A575A3
+75C275B375C375B575BD75B875BC75B175CD75CA75D275D975E375DE75FE75FF
+75FC760175F075FA75F275F3760B760D7609761F762776207621762276247634
+7630763B764776487646765C76587661766276687669766A7667766C76700000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000767276767678767C768076837688768B768E769676937699769A76B076B4
+76B876B976BA76C276CD76D676D276DE76E176E576E776EA862F76FB77087707
+770477297724771E77257726771B773777387747775A7768776B775B7765777F
+777E7779778E778B779177A0779E77B077B677B977BF77BC77BD77BB77C777CD
+77D777DA77DC77E377EE77FC780C781279267820792A7845788E78747886787C
+789A788C78A378B578AA78AF78D178C678CB78D478BE78BC78C578CA78EC0000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000078E778DA78FD78F47907791279117919792C792B794079607957795F795A
+79557953797A797F798A799D79A79F4B79AA79AE79B379B979BA79C979D579E7
+79EC79E179E37A087A0D7A187A197A207A1F79807A317A3B7A3E7A377A437A57
+7A497A617A627A699F9D7A707A797A7D7A887A977A957A987A967AA97AC87AB0
+7AB67AC57AC47ABF90837AC77ACA7ACD7ACF7AD57AD37AD97ADA7ADD7AE17AE2
+7AE67AED7AF07B027B0F7B0A7B067B337B187B197B1E7B357B287B367B500000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007B7A7B047B4D7B0B7B4C7B457B757B657B747B677B707B717B6C7B6E7B9D
+7B987B9F7B8D7B9C7B9A7B8B7B927B8F7B5D7B997BCB7BC17BCC7BCF7BB47BC6
+7BDD7BE97C117C147BE67BE57C607C007C077C137BF37BF77C177C0D7BF67C23
+7C277C2A7C1F7C377C2B7C3D7C4C7C437C547C4F7C407C507C587C5F7C647C56
+7C657C6C7C757C837C907CA47CAD7CA27CAB7CA17CA87CB37CB27CB17CAE7CB9
+7CBD7CC07CC57CC27CD87CD27CDC7CE29B3B7CEF7CF27CF47CF67CFA7D060000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007D027D1C7D157D0A7D457D4B7D2E7D327D3F7D357D467D737D567D4E7D72
+7D687D6E7D4F7D637D937D897D5B7D8F7D7D7D9B7DBA7DAE7DA37DB57DC77DBD
+7DAB7E3D7DA27DAF7DDC7DB87D9F7DB07DD87DDD7DE47DDE7DFB7DF27DE17E05
+7E0A7E237E217E127E317E1F7E097E0B7E227E467E667E3B7E357E397E437E37
+7E327E3A7E677E5D7E567E5E7E597E5A7E797E6A7E697E7C7E7B7E837DD57E7D
+8FAE7E7F7E887E897E8C7E927E907E937E947E967E8E7E9B7E9C7F387F3A0000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007F457F4C7F4D7F4E7F507F517F557F547F587F5F7F607F687F697F677F78
+7F827F867F837F887F877F8C7F947F9E7F9D7F9A7FA37FAF7FB27FB97FAE7FB6
+7FB88B717FC57FC67FCA7FD57FD47FE17FE67FE97FF37FF998DC80068004800B
+801280188019801C80218028803F803B804A804680528058805A805F80628068
+80738072807080768079807D807F808480868085809B8093809A80AD519080AC
+80DB80E580D980DD80C480DA80D6810980EF80F1811B81298123812F814B0000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000968B8146813E8153815180FC8171816E81658166817481838188818A8180
+818281A0819581A481A3815F819381A981B081B581BE81B881BD81C081C281BA
+81C981CD81D181D981D881C881DA81DF81E081E781FA81FB81FE820182028205
+8207820A820D821082168229822B82388233824082598258825D825A825F8264
+82628268826A826B822E827182778278827E828D829282AB829F82BB82AC82E1
+82E382DF82D282F482F382FA8393830382FB82F982DE830682DC830982D90000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000833583348316833283318340833983508345832F832B831783188385839A
+83AA839F83A283968323838E8387838A837C83B58373837583A0838983A883F4
+841383EB83CE83FD840383D8840B83C183F7840783E083F2840D8422842083BD
+8438850683FB846D842A843C855A84848477846B84AD846E848284698446842C
+846F8479843584CA846284B984BF849F84D984CD84BB84DA84D084C184C684D6
+84A1852184FF84F485178518852C851F8515851484FC85408563855885480000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000085418602854B8555858085A485888591858A85A8856D8594859B85EA8587
+859C8577857E859085C985BA85CF85B985D085D585DD85E585DC85F9860A8613
+860B85FE85FA86068622861A8630863F864D4E558654865F86678671869386A3
+86A986AA868B868C86B686AF86C486C686B086C9882386AB86D486DE86E986EC
+86DF86DB86EF8712870687088700870386FB87118709870D86F9870A8734873F
+8737873B87258729871A8760875F8778874C874E877487578768876E87590000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000087538763876A880587A2879F878287AF87CB87BD87C087D096D687AB87C4
+87B387C787C687BB87EF87F287E0880F880D87FE87F687F7880E87D288118816
+8815882288218831883688398827883B8844884288528859885E8862886B8881
+887E889E8875887D88B5887288828897889288AE889988A2888D88A488B088BF
+88B188C388C488D488D888D988DD88F9890288FC88F488E888F28904890C890A
+89138943891E8925892A892B89418944893B89368938894C891D8960895E0000
+EB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000089668964896D896A896F89748977897E89838988898A8993899889A189A9
+89A689AC89AF89B289BA89BD89BF89C089DA89DC89DD89E789F489F88A038A16
+8A108A0C8A1B8A1D8A258A368A418A5B8A528A468A488A7C8A6D8A6C8A628A85
+8A828A848AA88AA18A918AA58AA68A9A8AA38AC48ACD8AC28ADA8AEB8AF38AE7
+8AE48AF18B148AE08AE28AF78ADE8ADB8B0C8B078B1A8AE18B168B108B178B20
+8B3397AB8B268B2B8B3E8B288B418B4C8B4F8B4E8B498B568B5B8B5A8B6B0000
+EC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008B5F8B6C8B6F8B748B7D8B808B8C8B8E8B928B938B968B998B9A8C3A8C41
+8C3F8C488C4C8C4E8C508C558C628C6C8C788C7A8C828C898C858C8A8C8D8C8E
+8C948C7C8C98621D8CAD8CAA8CBD8CB28CB38CAE8CB68CC88CC18CE48CE38CDA
+8CFD8CFA8CFB8D048D058D0A8D078D0F8D0D8D109F4E8D138CCD8D148D168D67
+8D6D8D718D738D818D998DC28DBE8DBA8DCF8DDA8DD68DCC8DDB8DCB8DEA8DEB
+8DDF8DE38DFC8E088E098DFF8E1D8E1E8E108E1F8E428E358E308E348E4A0000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008E478E498E4C8E508E488E598E648E608E2A8E638E558E768E728E7C8E81
+8E878E858E848E8B8E8A8E938E918E948E998EAA8EA18EAC8EB08EC68EB18EBE
+8EC58EC88ECB8EDB8EE38EFC8EFB8EEB8EFE8F0A8F058F158F128F198F138F1C
+8F1F8F1B8F0C8F268F338F3B8F398F458F428F3E8F4C8F498F468F4E8F578F5C
+8F628F638F648F9C8F9F8FA38FAD8FAF8FB78FDA8FE58FE28FEA8FEF90878FF4
+90058FF98FFA901190159021900D901E9016900B90279036903590398FF80000
+EE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000904F905090519052900E9049903E90569058905E9068906F907696A89072
+9082907D90819080908A9089908F90A890AF90B190B590E290E4624890DB9102
+9112911991329130914A9156915891639165916991739172918B9189918291A2
+91AB91AF91AA91B591B491BA91C091C191C991CB91D091D691DF91E191DB91FC
+91F591F6921E91FF9214922C92159211925E925792459249926492489295923F
+924B9250929C92969293929B925A92CF92B992B792E9930F92FA9344932E0000
+EF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000093199322931A9323933A9335933B935C9360937C936E935693B093AC93AD
+939493B993D693D793E893E593D893C393DD93D093C893E4941A941494139403
+940794109436942B94359421943A944194529444945B94609462945E946A9229
+947094759477947D945A947C947E9481947F95829587958A9594959695989599
+95A095A895A795AD95BC95BB95B995BE95CA6FF695C395CD95CC95D595D495D6
+95DC95E195E595E296219628962E962F9642964C964F964B9677965C965E0000
+F0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000965D965F96669672966C968D96989695969796AA96A796B196B296B096B4
+96B696B896B996CE96CB96C996CD894D96DC970D96D596F99704970697089713
+970E9711970F971697199724972A97309739973D973E97449746974897429749
+975C976097649766976852D2976B977197799785977C9781977A9786978B978F
+9790979C97A897A697A397B397B497C397C697C897CB97DC97ED9F4F97F27ADF
+97F697F5980F980C9838982498219837983D9846984F984B986B986F98700000
+F1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000098719874987398AA98AF98B198B698C498C398C698E998EB990399099912
+991499189921991D991E99249920992C992E993D993E9942994999459950994B
+99519952994C99559997999899A599AD99AE99BC99DF99DB99DD99D899D199ED
+99EE99F199F299FB99F89A019A0F9A0599E29A199A2B9A379A459A429A409A43
+9A3E9A559A4D9A5B9A579A5F9A629A659A649A699A6B9A6A9AAD9AB09ABC9AC0
+9ACF9AD19AD39AD49ADE9ADF9AE29AE39AE69AEF9AEB9AEE9AF49AF19AF70000
+F2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009AFB9B069B189B1A9B1F9B229B239B259B279B289B299B2A9B2E9B2F9B32
+9B449B439B4F9B4D9B4E9B519B589B749B939B839B919B969B979B9F9BA09BA8
+9BB49BC09BCA9BB99BC69BCF9BD19BD29BE39BE29BE49BD49BE19C3A9BF29BF1
+9BF09C159C149C099C139C0C9C069C089C129C0A9C049C2E9C1B9C259C249C21
+9C309C479C329C469C3E9C5A9C609C679C769C789CE79CEC9CF09D099D089CEB
+9D039D069D2A9D269DAF9D239D1F9D449D159D129D419D3F9D3E9D469D480000
+F3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009D5D9D5E9D649D519D509D599D729D899D879DAB9D6F9D7A9D9A9DA49DA9
+9DB29DC49DC19DBB9DB89DBA9DC69DCF9DC29DD99DD39DF89DE69DED9DEF9DFD
+9E1A9E1B9E1E9E759E799E7D9E819E889E8B9E8C9E929E959E919E9D9EA59EA9
+9EB89EAA9EAD97619ECC9ECE9ECF9ED09ED49EDC9EDE9EDD9EE09EE59EE89EEF
+9EF49EF69EF79EF99EFB9EFC9EFD9F079F0876B79F159F219F2C9F3E9F4A9F52
+9F549F639F5F9F609F619F669F679F6C9F6A9F779F729F769F959F9C9FA00000
+F4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000582F69C79059746451DC7199000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/euc-kr.enc b/tcl/library/encoding/euc-kr.enc
new file mode 100644
index 00000000000..5e9bb93bbb0
--- /dev/null
+++ b/tcl/library/encoding/euc-kr.enc
@@ -0,0 +1,1533 @@
+# Encoding file: euc-kr, multi-byte
+M
+003F 0 90
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030003001300200B72025202600A8300300AD20152225FF3C223C20182019
+201C201D3014301530083009300A300B300C300D300E300F3010301100B100D7
+00F7226022642265221E223400B0203220332103212BFFE0FFE1FFE526422640
+222022A52312220222072261225200A7203B2606260525CB25CF25CE25C725C6
+25A125A025B325B225BD25BC219221902191219321943013226A226B221A223D
+221D2235222B222C2208220B2286228722822283222A222922272228FFE20000
+A2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000021D221D42200220300B4FF5E02C702D802DD02DA02D900B802DB00A100BF
+02D0222E2211220F00A42109203025C125C025B725B626642660266126652667
+2663229925C825A325D025D1259225A425A525A825A725A625A92668260F260E
+261C261E00B62020202121952197219921962198266D2669266A266C327F321C
+211633C7212233C233D821210000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF01FF02FF03FF04FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F
+FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFFE6FF3DFF3EFF3F
+FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000
+A4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000313131323133313431353136313731383139313A313B313C313D313E313F
+3140314131423143314431453146314731483149314A314B314C314D314E314F
+3150315131523153315431553156315731583159315A315B315C315D315E315F
+3160316131623163316431653166316731683169316A316B316C316D316E316F
+3170317131723173317431753176317731783179317A317B317C317D317E317F
+3180318131823183318431853186318731883189318A318B318C318D318E0000
+A5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000217021712172217321742175217621772178217900000000000000000000
+2160216121622163216421652166216721682169000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+A6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000025002502250C251025182514251C252C25242534253C25012503250F2513
+251B251725232533252B253B254B2520252F25282537253F251D253025252538
+254225122511251A251925162515250E250D251E251F25212522252625272529
+252A252D252E25312532253525362539253A253D253E25402541254325442545
+2546254725482549254A00000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+A7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00003395339633972113339833C433A333A433A533A63399339A339B339C339D
+339E339F33A033A133A233CA338D338E338F33CF3388338933C833A733A833B0
+33B133B233B333B433B533B633B733B833B93380338133823383338433BA33BB
+33BC33BD33BE33BF33903391339233933394212633C033C1338A338B338C33D6
+33C533AD33AE33AF33DB33A933AA33AB33AC33DD33D033D333C333C933DC33C6
+0000000000000000000000000000000000000000000000000000000000000000
+A8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000C600D000AA0126000001320000013F014100D8015200BA00DE0166014A
+00003260326132623263326432653266326732683269326A326B326C326D326E
+326F3270327132723273327432753276327732783279327A327B24D024D124D2
+24D324D424D524D624D724D824D924DA24DB24DC24DD24DE24DF24E024E124E2
+24E324E424E524E624E724E824E9246024612462246324642465246624672468
+2469246A246B246C246D246E00BD2153215400BC00BE215B215C215D215E0000
+A9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000E6011100F001270131013301380140014200F8015300DF00FE0167014B
+01493200320132023203320432053206320732083209320A320B320C320D320E
+320F3210321132123213321432153216321732183219321A321B249C249D249E
+249F24A024A124A224A324A424A524A624A724A824A924AA24AB24AC24AD24AE
+24AF24B024B124B224B324B424B5247424752476247724782479247A247B247C
+247D247E247F24802481248200B900B200B32074207F20812082208320840000
+AA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+AB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+AC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000004100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+B0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AC00AC01AC04AC07AC08AC09AC0AAC10AC11AC12AC13AC14AC15AC16AC17
+AC19AC1AAC1BAC1CAC1DAC20AC24AC2CAC2DAC2FAC30AC31AC38AC39AC3CAC40
+AC4BAC4DAC54AC58AC5CAC70AC71AC74AC77AC78AC7AAC80AC81AC83AC84AC85
+AC86AC89AC8AAC8BAC8CAC90AC94AC9CAC9DAC9FACA0ACA1ACA8ACA9ACAAACAC
+ACAFACB0ACB8ACB9ACBBACBCACBDACC1ACC4ACC8ACCCACD5ACD7ACE0ACE1ACE4
+ACE7ACE8ACEAACECACEFACF0ACF1ACF3ACF5ACF6ACFCACFDAD00AD04AD060000
+B1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AD0CAD0DAD0FAD11AD18AD1CAD20AD29AD2CAD2DAD34AD35AD38AD3CAD44
+AD45AD47AD49AD50AD54AD58AD61AD63AD6CAD6DAD70AD73AD74AD75AD76AD7B
+AD7CAD7DAD7FAD81AD82AD88AD89AD8CAD90AD9CAD9DADA4ADB7ADC0ADC1ADC4
+ADC8ADD0ADD1ADD3ADDCADE0ADE4ADF8ADF9ADFCADFFAE00AE01AE08AE09AE0B
+AE0DAE14AE30AE31AE34AE37AE38AE3AAE40AE41AE43AE45AE46AE4AAE4CAE4D
+AE4EAE50AE54AE56AE5CAE5DAE5FAE60AE61AE65AE68AE69AE6CAE70AE780000
+B2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AE79AE7BAE7CAE7DAE84AE85AE8CAEBCAEBDAEBEAEC0AEC4AECCAECDAECF
+AED0AED1AED8AED9AEDCAEE8AEEBAEEDAEF4AEF8AEFCAF07AF08AF0DAF10AF2C
+AF2DAF30AF32AF34AF3CAF3DAF3FAF41AF42AF43AF48AF49AF50AF5CAF5DAF64
+AF65AF79AF80AF84AF88AF90AF91AF95AF9CAFB8AFB9AFBCAFC0AFC7AFC8AFC9
+AFCBAFCDAFCEAFD4AFDCAFE8AFE9AFF0AFF1AFF4AFF8B000B001B004B00CB010
+B014B01CB01DB028B044B045B048B04AB04CB04EB053B054B055B057B0590000
+B3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B05DB07CB07DB080B084B08CB08DB08FB091B098B099B09AB09CB09FB0A0
+B0A1B0A2B0A8B0A9B0ABB0ACB0ADB0AEB0AFB0B1B0B3B0B4B0B5B0B8B0BCB0C4
+B0C5B0C7B0C8B0C9B0D0B0D1B0D4B0D8B0E0B0E5B108B109B10BB10CB110B112
+B113B118B119B11BB11CB11DB123B124B125B128B12CB134B135B137B138B139
+B140B141B144B148B150B151B154B155B158B15CB160B178B179B17CB180B182
+B188B189B18BB18DB192B193B194B198B19CB1A8B1CCB1D0B1D4B1DCB1DD0000
+B4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B1DFB1E8B1E9B1ECB1F0B1F9B1FBB1FDB204B205B208B20BB20CB214B215
+B217B219B220B234B23CB258B25CB260B268B269B274B275B27CB284B285B289
+B290B291B294B298B299B29AB2A0B2A1B2A3B2A5B2A6B2AAB2ACB2B0B2B4B2C8
+B2C9B2CCB2D0B2D2B2D8B2D9B2DBB2DDB2E2B2E4B2E5B2E6B2E8B2EBB2ECB2ED
+B2EEB2EFB2F3B2F4B2F5B2F7B2F8B2F9B2FAB2FBB2FFB300B301B304B308B310
+B311B313B314B315B31CB354B355B356B358B35BB35CB35EB35FB364B3650000
+B5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B367B369B36BB36EB370B371B374B378B380B381B383B384B385B38CB390
+B394B3A0B3A1B3A8B3ACB3C4B3C5B3C8B3CBB3CCB3CEB3D0B3D4B3D5B3D7B3D9
+B3DBB3DDB3E0B3E4B3E8B3FCB410B418B41CB420B428B429B42BB434B450B451
+B454B458B460B461B463B465B46CB480B488B49DB4A4B4A8B4ACB4B5B4B7B4B9
+B4C0B4C4B4C8B4D0B4D5B4DCB4DDB4E0B4E3B4E4B4E6B4ECB4EDB4EFB4F1B4F8
+B514B515B518B51BB51CB524B525B527B528B529B52AB530B531B534B5380000
+B6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B540B541B543B544B545B54BB54CB54DB550B554B55CB55DB55FB560B561
+B5A0B5A1B5A4B5A8B5AAB5ABB5B0B5B1B5B3B5B4B5B5B5BBB5BCB5BDB5C0B5C4
+B5CCB5CDB5CFB5D0B5D1B5D8B5ECB610B611B614B618B625B62CB634B648B664
+B668B69CB69DB6A0B6A4B6ABB6ACB6B1B6D4B6F0B6F4B6F8B700B701B705B728
+B729B72CB72FB730B738B739B73BB744B748B74CB754B755B760B764B768B770
+B771B773B775B77CB77DB780B784B78CB78DB78FB790B791B792B796B7970000
+B7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B798B799B79CB7A0B7A8B7A9B7ABB7ACB7ADB7B4B7B5B7B8B7C7B7C9B7EC
+B7EDB7F0B7F4B7FCB7FDB7FFB800B801B807B808B809B80CB810B818B819B81B
+B81DB824B825B828B82CB834B835B837B838B839B840B844B851B853B85CB85D
+B860B864B86CB86DB86FB871B878B87CB88DB8A8B8B0B8B4B8B8B8C0B8C1B8C3
+B8C5B8CCB8D0B8D4B8DDB8DFB8E1B8E8B8E9B8ECB8F0B8F8B8F9B8FBB8FDB904
+B918B920B93CB93DB940B944B94CB94FB951B958B959B95CB960B968B9690000
+B8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B96BB96DB974B975B978B97CB984B985B987B989B98AB98DB98EB9ACB9AD
+B9B0B9B4B9BCB9BDB9BFB9C1B9C8B9C9B9CCB9CEB9CFB9D0B9D1B9D2B9D8B9D9
+B9DBB9DDB9DEB9E1B9E3B9E4B9E5B9E8B9ECB9F4B9F5B9F7B9F8B9F9B9FABA00
+BA01BA08BA15BA38BA39BA3CBA40BA42BA48BA49BA4BBA4DBA4EBA53BA54BA55
+BA58BA5CBA64BA65BA67BA68BA69BA70BA71BA74BA78BA83BA84BA85BA87BA8C
+BAA8BAA9BAABBAACBAB0BAB2BAB8BAB9BABBBABDBAC4BAC8BAD8BAD9BAFC0000
+B9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BB00BB04BB0DBB0FBB11BB18BB1CBB20BB29BB2BBB34BB35BB36BB38BB3B
+BB3CBB3DBB3EBB44BB45BB47BB49BB4DBB4FBB50BB54BB58BB61BB63BB6CBB88
+BB8CBB90BBA4BBA8BBACBBB4BBB7BBC0BBC4BBC8BBD0BBD3BBF8BBF9BBFCBBFF
+BC00BC02BC08BC09BC0BBC0CBC0DBC0FBC11BC14BC15BC16BC17BC18BC1BBC1C
+BC1DBC1EBC1FBC24BC25BC27BC29BC2DBC30BC31BC34BC38BC40BC41BC43BC44
+BC45BC49BC4CBC4DBC50BC5DBC84BC85BC88BC8BBC8CBC8EBC94BC95BC970000
+BA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BC99BC9ABCA0BCA1BCA4BCA7BCA8BCB0BCB1BCB3BCB4BCB5BCBCBCBDBCC0
+BCC4BCCDBCCFBCD0BCD1BCD5BCD8BCDCBCF4BCF5BCF6BCF8BCFCBD04BD05BD07
+BD09BD10BD14BD24BD2CBD40BD48BD49BD4CBD50BD58BD59BD64BD68BD80BD81
+BD84BD87BD88BD89BD8ABD90BD91BD93BD95BD99BD9ABD9CBDA4BDB0BDB8BDD4
+BDD5BDD8BDDCBDE9BDF0BDF4BDF8BE00BE03BE05BE0CBE0DBE10BE14BE1CBE1D
+BE1FBE44BE45BE48BE4CBE4EBE54BE55BE57BE59BE5ABE5BBE60BE61BE640000
+BB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BE68BE6ABE70BE71BE73BE74BE75BE7BBE7CBE7DBE80BE84BE8CBE8DBE8F
+BE90BE91BE98BE99BEA8BED0BED1BED4BED7BED8BEE0BEE3BEE4BEE5BEECBF01
+BF08BF09BF18BF19BF1BBF1CBF1DBF40BF41BF44BF48BF50BF51BF55BF94BFB0
+BFC5BFCCBFCDBFD0BFD4BFDCBFDFBFE1C03CC051C058C05CC060C068C069C090
+C091C094C098C0A0C0A1C0A3C0A5C0ACC0ADC0AFC0B0C0B3C0B4C0B5C0B6C0BC
+C0BDC0BFC0C0C0C1C0C5C0C8C0C9C0CCC0D0C0D8C0D9C0DBC0DCC0DDC0E40000
+BC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C0E5C0E8C0ECC0F4C0F5C0F7C0F9C100C104C108C110C115C11CC11DC11E
+C11FC120C123C124C126C127C12CC12DC12FC130C131C136C138C139C13CC140
+C148C149C14BC14CC14DC154C155C158C15CC164C165C167C168C169C170C174
+C178C185C18CC18DC18EC190C194C196C19CC19DC19FC1A1C1A5C1A8C1A9C1AC
+C1B0C1BDC1C4C1C8C1CCC1D4C1D7C1D8C1E0C1E4C1E8C1F0C1F1C1F3C1FCC1FD
+C200C204C20CC20DC20FC211C218C219C21CC21FC220C228C229C22BC22D0000
+BD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C22FC231C232C234C248C250C251C254C258C260C265C26CC26DC270C274
+C27CC27DC27FC281C288C289C290C298C29BC29DC2A4C2A5C2A8C2ACC2ADC2B4
+C2B5C2B7C2B9C2DCC2DDC2E0C2E3C2E4C2EBC2ECC2EDC2EFC2F1C2F6C2F8C2F9
+C2FBC2FCC300C308C309C30CC30DC313C314C315C318C31CC324C325C328C329
+C345C368C369C36CC370C372C378C379C37CC37DC384C388C38CC3C0C3D8C3D9
+C3DCC3DFC3E0C3E2C3E8C3E9C3EDC3F4C3F5C3F8C408C410C424C42CC4300000
+BE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C434C43CC43DC448C464C465C468C46CC474C475C479C480C494C49CC4B8
+C4BCC4E9C4F0C4F1C4F4C4F8C4FAC4FFC500C501C50CC510C514C51CC528C529
+C52CC530C538C539C53BC53DC544C545C548C549C54AC54CC54DC54EC553C554
+C555C557C558C559C55DC55EC560C561C564C568C570C571C573C574C575C57C
+C57DC580C584C587C58CC58DC58FC591C595C597C598C59CC5A0C5A9C5B4C5B5
+C5B8C5B9C5BBC5BCC5BDC5BEC5C4C5C5C5C6C5C7C5C8C5C9C5CAC5CCC5CE0000
+BF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C5D0C5D1C5D4C5D8C5E0C5E1C5E3C5E5C5ECC5EDC5EEC5F0C5F4C5F6C5F7
+C5FCC5FDC5FEC5FFC600C601C605C606C607C608C60CC610C618C619C61BC61C
+C624C625C628C62CC62DC62EC630C633C634C635C637C639C63BC640C641C644
+C648C650C651C653C654C655C65CC65DC660C66CC66FC671C678C679C67CC680
+C688C689C68BC68DC694C695C698C69CC6A4C6A5C6A7C6A9C6B0C6B1C6B4C6B8
+C6B9C6BAC6C0C6C1C6C3C6C5C6CCC6CDC6D0C6D4C6DCC6DDC6E0C6E1C6E80000
+C0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C6E9C6ECC6F0C6F8C6F9C6FDC704C705C708C70CC714C715C717C719C720
+C721C724C728C730C731C733C735C737C73CC73DC740C744C74AC74CC74DC74F
+C751C752C753C754C755C756C757C758C75CC760C768C76BC774C775C778C77C
+C77DC77EC783C784C785C787C788C789C78AC78EC790C791C794C796C797C798
+C79AC7A0C7A1C7A3C7A4C7A5C7A6C7ACC7ADC7B0C7B4C7BCC7BDC7BFC7C0C7C1
+C7C8C7C9C7CCC7CEC7D0C7D8C7DDC7E4C7E8C7ECC800C801C804C808C80A0000
+C1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C810C811C813C815C816C81CC81DC820C824C82CC82DC82FC831C838C83C
+C840C848C849C84CC84DC854C870C871C874C878C87AC880C881C883C885C886
+C887C88BC88CC88DC894C89DC89FC8A1C8A8C8BCC8BDC8C4C8C8C8CCC8D4C8D5
+C8D7C8D9C8E0C8E1C8E4C8F5C8FCC8FDC900C904C905C906C90CC90DC90FC911
+C918C92CC934C950C951C954C958C960C961C963C96CC970C974C97CC988C989
+C98CC990C998C999C99BC99DC9C0C9C1C9C4C9C7C9C8C9CAC9D0C9D1C9D30000
+C2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C9D5C9D6C9D9C9DAC9DCC9DDC9E0C9E2C9E4C9E7C9ECC9EDC9EFC9F0C9F1
+C9F8C9F9C9FCCA00CA08CA09CA0BCA0CCA0DCA14CA18CA29CA4CCA4DCA50CA54
+CA5CCA5DCA5FCA60CA61CA68CA7DCA84CA98CABCCABDCAC0CAC4CACCCACDCACF
+CAD1CAD3CAD8CAD9CAE0CAECCAF4CB08CB10CB14CB18CB20CB21CB41CB48CB49
+CB4CCB50CB58CB59CB5DCB64CB78CB79CB9CCBB8CBD4CBE4CBE7CBE9CC0CCC0D
+CC10CC14CC1CCC1DCC21CC22CC27CC28CC29CC2CCC2ECC30CC38CC39CC3B0000
+C3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CC3CCC3DCC3ECC44CC45CC48CC4CCC54CC55CC57CC58CC59CC60CC64CC66
+CC68CC70CC75CC98CC99CC9CCCA0CCA8CCA9CCABCCACCCADCCB4CCB5CCB8CCBC
+CCC4CCC5CCC7CCC9CCD0CCD4CCE4CCECCCF0CD01CD08CD09CD0CCD10CD18CD19
+CD1BCD1DCD24CD28CD2CCD39CD5CCD60CD64CD6CCD6DCD6FCD71CD78CD88CD94
+CD95CD98CD9CCDA4CDA5CDA7CDA9CDB0CDC4CDCCCDD0CDE8CDECCDF0CDF8CDF9
+CDFBCDFDCE04CE08CE0CCE14CE19CE20CE21CE24CE28CE30CE31CE33CE350000
+C4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CE58CE59CE5CCE5FCE60CE61CE68CE69CE6BCE6DCE74CE75CE78CE7CCE84
+CE85CE87CE89CE90CE91CE94CE98CEA0CEA1CEA3CEA4CEA5CEACCEADCEC1CEE4
+CEE5CEE8CEEBCEECCEF4CEF5CEF7CEF8CEF9CF00CF01CF04CF08CF10CF11CF13
+CF15CF1CCF20CF24CF2CCF2DCF2FCF30CF31CF38CF54CF55CF58CF5CCF64CF65
+CF67CF69CF70CF71CF74CF78CF80CF85CF8CCFA1CFA8CFB0CFC4CFE0CFE1CFE4
+CFE8CFF0CFF1CFF3CFF5CFFCD000D004D011D018D02DD034D035D038D03C0000
+C5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D044D045D047D049D050D054D058D060D06CD06DD070D074D07CD07DD081
+D0A4D0A5D0A8D0ACD0B4D0B5D0B7D0B9D0C0D0C1D0C4D0C8D0C9D0D0D0D1D0D3
+D0D4D0D5D0DCD0DDD0E0D0E4D0ECD0EDD0EFD0F0D0F1D0F8D10DD130D131D134
+D138D13AD140D141D143D144D145D14CD14DD150D154D15CD15DD15FD161D168
+D16CD17CD184D188D1A0D1A1D1A4D1A8D1B0D1B1D1B3D1B5D1BAD1BCD1C0D1D8
+D1F4D1F8D207D209D210D22CD22DD230D234D23CD23DD23FD241D248D25C0000
+C6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D264D280D281D284D288D290D291D295D29CD2A0D2A4D2ACD2B1D2B8D2B9
+D2BCD2BFD2C0D2C2D2C8D2C9D2CBD2D4D2D8D2DCD2E4D2E5D2F0D2F1D2F4D2F8
+D300D301D303D305D30CD30DD30ED310D314D316D31CD31DD31FD320D321D325
+D328D329D32CD330D338D339D33BD33CD33DD344D345D37CD37DD380D384D38C
+D38DD38FD390D391D398D399D39CD3A0D3A8D3A9D3ABD3ADD3B4D3B8D3BCD3C4
+D3C5D3C8D3C9D3D0D3D8D3E1D3E3D3ECD3EDD3F0D3F4D3FCD3FDD3FFD4010000
+C7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D408D41DD440D444D45CD460D464D46DD46FD478D479D47CD47FD480D482
+D488D489D48BD48DD494D4A9D4CCD4D0D4D4D4DCD4DFD4E8D4ECD4F0D4F8D4FB
+D4FDD504D508D50CD514D515D517D53CD53DD540D544D54CD54DD54FD551D558
+D559D55CD560D565D568D569D56BD56DD574D575D578D57CD584D585D587D588
+D589D590D5A5D5C8D5C9D5CCD5D0D5D2D5D8D5D9D5DBD5DDD5E4D5E5D5E8D5EC
+D5F4D5F5D5F7D5F9D600D601D604D608D610D611D613D614D615D61CD6200000
+C8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D624D62DD638D639D63CD640D645D648D649D64BD64DD651D654D655D658
+D65CD667D669D670D671D674D683D685D68CD68DD690D694D69DD69FD6A1D6A8
+D6ACD6B0D6B9D6BBD6C4D6C5D6C8D6CCD6D1D6D4D6D7D6D9D6E0D6E4D6E8D6F0
+D6F5D6FCD6FDD700D704D711D718D719D71CD720D728D729D72BD72DD734D735
+D738D73CD744D747D749D750D751D754D756D757D758D759D760D761D763D765
+D769D76CD770D774D77CD77DD781D788D789D78CD790D798D799D79BD79D0000
+CA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F3D4F73504750F952A053EF547554E556095AC15BB6668767B667B767EF
+6B4C73C275C27A3C82DB8304885788888A368CC88DCF8EFB8FE699D5523B5374
+5404606A61646BBC73CF811A89BA89D295A34F83520A58BE597859E65E725E79
+61C763C0674667EC687F6F97764E770B78F57A087AFF7C21809D826E82718AEB
+95934E6B559D66F76E3478A37AED845B8910874E97A852D8574E582A5D4C611F
+61BE6221656267D16A446E1B751875B376E377B07D3A90AF945194529F950000
+CB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000053235CAC753280DB92409598525B580859DC5CA15D175EB75F3A5F4A6177
+6C5F757A75867CE07D737DB17F8C81548221859189418B1B92FC964D9C474ECB
+4EF7500B51F1584F6137613E6168653969EA6F1175A5768676D67B8782A584CB
+F90093A7958B55805BA25751F9017CB37FB991B5502853BB5C455DE862D2636E
+64DA64E76E2070AC795B8DDD8E1EF902907D924592F84E7E4EF650655DFE5EFA
+61066957817186548E4793759A2B4E5E5091677068405109528D52926AA20000
+CC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077BC92109ED452AB602F8FF2504861A963ED64CA683C6A846FC0818889A1
+96945805727D72AC75047D797E6D80A9898B8B7490639D5162896C7A6F547D50
+7F3A8A23517C614A7B9D8B199257938C4EAC4FD3501E50BE510652C152CD537F
+577058835E9A5F91617661AC64CE656C666F66BB66F468976D87708570F1749F
+74A574CA75D9786C78EC7ADF7AF67D457D938015803F811B83968B668F159015
+93E1980398389A5A9BE84FC25553583A59515B635C4660B86212684268B00000
+CD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068E86EAA754C767878CE7A3D7CFB7E6B7E7C8A088AA18C3F968E9DC453E4
+53E9544A547156FA59D15B645C3B5EAB62F765376545657266A067AF69C16CBD
+75FC7690777E7A3F7F94800380A1818F82E682FD83F085C1883188B48AA5F903
+8F9C932E96C798679AD89F1354ED659B66F2688F7A408C379D6056F057645D11
+660668B168CD6EFE7428889E9BE46C68F9049AA84F9B516C5171529F5B545DE5
+6050606D62F163A7653B73D97A7A86A38CA2978F4E325BE16208679C74DC0000
+CE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000079D183D38A878AB28DE8904E934B98465ED369E885FF90EDF90551A05B98
+5BEC616368FA6B3E704C742F74D87BA17F5083C589C08CAB95DC9928522E605D
+62EC90024F8A5149532158D95EE366E06D38709A72C273D67B5080F1945B5366
+639B7F6B4E565080584A58DE602A612762D069D09B415B8F7D1880B18F5F4EA4
+50D154AC55AC5B0C5DA05DE7652A654E68216A4B72E1768E77EF7D5E7FF981A0
+854E86DF8F038F4E90CA99039A559BAB4E184E454E5D4EC74FF1517752FE0000
+CF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000534053E353E5548E5614577557A25BC75D875ED061FC62D8655167B867E9
+69CB6B506BC66BEC6C426E9D707872D77396740377BF77E97A767D7F800981FC
+8205820A82DF88628B338CFC8EC0901190B1926492B699D29A459CE99DD79F9C
+570B5C4083CA97A097AB9EB4541B7A987FA488D98ECD90E158005C4863987A9F
+5BAE5F137A797AAE828E8EAC5026523852F85377570862F363726B0A6DC37737
+53A5735785688E7695D5673A6AC36F708A6D8ECC994BF90666776B788CB40000
+D0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009B3CF90753EB572D594E63C669FB73EA78457ABA7AC57CFE8475898F8D73
+903595A852FB574775477B6083CC921EF9086A58514B524B5287621F68D86975
+969950C552A452E461C365A4683969FF747E7B4B82B983EB89B28B398FD19949
+F9094ECA599764D266116A8E7434798179BD82A9887E887F895FF90A93264F0B
+53CA602562716C727D1A7D664E98516277DC80AF4F014F0E5176518055DC5668
+573B57FA57FC5914594759935BC45C905D0E5DF15E7E5FCC628065D765E30000
+D1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000671E671F675E68CB68C46A5F6B3A6C236C7D6C826DC773987426742A7482
+74A37578757F788178EF794179477948797A7B957D007DBA7F888006802D808C
+8A188B4F8C488D779321932498E299519A0E9A0F9A659E927DCA4F76540962EE
+685491D155AB513AF90BF90C5A1C61E6F90D62CF62FFF90EF90FF910F911F912
+F91390A3F914F915F916F917F9188AFEF919F91AF91BF91C6696F91D7156F91E
+F91F96E3F920634F637A5357F921678F69606E73F9227537F923F924F9250000
+D2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007D0DF926F927887256CA5A18F928F929F92AF92BF92C4E43F92D51675948
+67F08010F92E59735E74649A79CA5FF5606C62C8637B5BE75BD752AAF92F5974
+5F296012F930F931F9327459F933F934F935F936F937F93899D1F939F93AF93B
+F93CF93DF93EF93FF940F941F942F9436FC3F944F94581BF8FB260F1F946F947
+8166F948F9495C3FF94AF94BF94CF94DF94EF94FF950F9515AE98A25677B7D10
+F952F953F954F955F956F95780FDF958F9595C3C6CE5533F6EBA591A83360000
+D3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E394EB64F4655AE571858C75F5665B765E66A806BB56E4D77ED7AEF7C1E
+7DDE86CB88929132935B64BB6FBE737A75B890545556574D61BA64D466C76DE1
+6E5B6F6D6FB975F0804381BD854189838AC78B5A931F6C9375537B548E0F905D
+5510580258585E626207649E68E075767CD687B39EE84EE35788576E59275C0D
+5CB15E365F85623464E173B381FA888B8CB8968A9EDB5B855FB760B350125200
+52305716583558575C0E5C605CF65D8B5EA65F9260BC63116389641768430000
+D4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068F96AC26DD86E216ED46FE471FE76DC777979B17A3B840489A98CED8DF3
+8E4890039014905390FD934D967697DC6BD27006725872A27368776379BF7BE4
+7E9B8B8058A960C7656665FD66BE6C8C711E71C98C5A98134E6D7A814EDD51AC
+51CD52D5540C61A76771685068DF6D1E6F7C75BC77B37AE580F484639285515C
+6597675C679375D87AC78373F95A8C469017982D5C6F81C0829A9041906F920D
+5F975D9D6A5971C8767B7B4985E48B0491279A30558761F6F95B76697F850000
+D5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000863F87BA88F8908FF95C6D1B70D973DE7D61843DF95D916A99F1F95E4E82
+53756B046B12703E721B862D9E1E524C8FA35D5064E5652C6B166FEB7C437E9C
+85CD896489BD62C981D8881F5ECA67176D6A72FC7405746F878290DE4F865D0D
+5FA0840A51B763A075654EAE5006516951C968816A117CAE7CB17CE7826F8AD2
+8F1B91CF4FB6513752F554425EEC616E623E65C56ADA6FFE792A85DC882395AD
+9A629A6A9E979ECE529B66C66B77701D792B8F6297426190620065236F230000
+D6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000714974897DF4806F84EE8F269023934A51BD521752A36D0C70C888C25EC9
+65826BAE6FC27C3E73754EE44F3656F9F95F5CBA5DBA601C73B27B2D7F9A7FCE
+8046901E923496F6974898189F614F8B6FA779AE91B496B752DEF960648864C4
+6AD36F5E7018721076E780018606865C8DEF8F0597329B6F9DFA9E75788C797F
+7DA083C993049E7F9E938AD658DF5F046727702774CF7C60807E512170287262
+78CA8CC28CDA8CF496F74E8650DA5BEE5ED6659971CE764277AD804A84FC0000
+D7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000907C9B279F8D58D85A415C626A136DDA6F0F763B7D2F7E37851E893893E4
+964B528965D267F369B46D416E9C700F7409746075597624786B8B2C985E516D
+622E96784F96502B5D196DEA7DB88F2A5F8B61446817F961968652D2808B51DC
+51CC695E7A1C7DBE83F196754FDA52295398540F550E5C6560A7674E68A86D6C
+728172F874067483F96275E27C6C7F797FB8838988CF88E191CC91D096E29BC9
+541D6F7E71D0749885FA8EAA96A39C579E9F67976DCB743381E89716782C0000
+D8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007ACB7B207C926469746A75F278BC78E899AC9B549EBB5BDE5E556F20819C
+83AB90884E07534D5A295DD25F4E6162633D666966FC6EFF6F2B7063779E842C
+8513883B8F1399459C3B551C62B9672B6CAB8309896A977A4EA159845FD85FD9
+671B7DB27F548292832B83BD8F1E909957CB59B95A925BD06627679A68856BCF
+71647F758CB78CE390819B4581088C8A964C9A409EA55B5F6C13731B76F276DF
+840C51AA8993514D519552C968C96C94770477207DBF7DEC97629EB56EC50000
+D9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000851151A5540D547D660E669D69276E9F76BF7791831784C2879F91699298
+9CF488824FAE519252DF59C65E3D61556478647966AE67D06A216BCD6BDB725F
+72617441773877DB801782BC83058B008B288C8C67286C90726776EE77667A46
+9DA96B7F6C92592267268499536F589359995EDF63CF663467736E3A732B7AD7
+82D7932852D95DEB61AE61CB620A62C764AB65E069596B666BCB712173F7755D
+7E46821E8302856A8AA38CBF97279D6158A89ED85011520E543B554F65870000
+DA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006C767D0A7D0B805E868A958096EF52FF6C95726954735A9A5C3E5D4B5F4C
+5FAE672A68B669636E3C6E4477097C737F8E85878B0E8FF797619EF45CB760B6
+610D61AB654F65FB65FC6C116CEF739F73C97DE195945BC6871C8B10525D535A
+62CD640F64B267346A386CCA73C0749E7B947C957E1B818A823685848FEB96F9
+99C14F34534A53CD53DB62CC642C6500659169C36CEE6F5873ED7554762276E4
+76FC78D078FB792C7D46822C87E08FD4981298EF52C362D464A56E246F510000
+DB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000767C8DCB91B192629AEE9B435023508D574A59A85C285E475F77623F653E
+65B965C16609678B699C6EC278C57D2180AA8180822B82B384A1868C8A2A8B17
+90A696329F90500D4FF3F96357F95F9862DC6392676F6E43711976C380CC80DA
+88F488F589198CE08F29914D966A4F2F4F705E1B67CF6822767D767E9B445E61
+6A0A716971D4756AF9647E41854385E998DC4F107B4F7F7095A551E15E0668B5
+6C3E6C4E6CDB72AF7BC483036CD5743A50FB528858C164D86A9774A776560000
+DC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000078A7861795E29739F965535E5F018B8A8FA88FAF908A522577A59C499F08
+4E19500251755C5B5E77661E663A67C468C570B3750175C579C97ADD8F279920
+9A084FDD582158315BF6666E6B656D116E7A6F7D73E4752B83E988DC89138B5C
+8F144F0F50D55310535C5B935FA9670D798F8179832F8514890789868F398F3B
+99A59C12672C4E764FF859495C015CEF5CF0636768D270FD71A2742B7E2B84EC
+8702902292D29CF34E0D4ED84FEF50855256526F5426549057E0592B5A660000
+DD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005B5A5B755BCC5E9CF9666276657765A76D6E6EA572367B267C3F7F368150
+8151819A8240829983A98A038CA08CE68CFB8D748DBA90E891DC961C964499D9
+9CE7531752065429567458B35954596E5FFF61A4626E66106C7E711A76C67C89
+7CDE7D1B82AC8CC196F0F9674F5B5F175F7F62C25D29670B68DA787C7E439D6C
+4E1550995315532A535159835A625E8760B2618A624962796590678769A76BD4
+6BD66BD76BD86CB8F968743575FA7812789179D579D87C837DCB7FE180A50000
+DE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000813E81C283F2871A88E88AB98B6C8CBB9119975E98DB9F3B56AC5B2A5F6C
+658C6AB36BAF6D5C6FF17015725D73AD8CA78CD3983B61916C3780589A014E4D
+4E8B4E9B4ED54F3A4F3C4F7F4FDF50FF53F253F8550655E356DB58EB59625A11
+5BEB5BFA5C045DF35E2B5F99601D6368659C65AF67F667FB68AD6B7B6C996CD7
+6E23700973457802793E7940796079C17BE97D177D728086820D838E84D186C7
+88DF8A508A5E8B1D8CDC8D668FAD90AA98FC99DF9E9D524AF9696714F96A0000
+DF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005098522A5C7165636C5573CA7523759D7B97849C917897304E7764926BBA
+715E85A94E09F96B674968EE6E17829F8518886B63F76F81921298AF4E0A50B7
+50CF511F554655AA56175B405C195CE05E385E8A5EA05EC260F368516A616E58
+723D724072C076F879657BB17FD488F389F48A738C618CDE971C585E74BD8CFD
+55C7F96C7A617D2282727272751F7525F96D7B19588558FB5DBC5E8F5EB65F90
+60556292637F654D669166D966F8681668F27280745E7B6E7D6E7DD67F720000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000080E5821285AF897F8A93901D92E49ECD9F205915596D5E2D60DC66146673
+67906C506DC56F5F77F378A984C691CB932B4ED950CA514855845B0B5BA36247
+657E65CB6E32717D74017444748774BF766C79AA7DDA7E557FA8817A81B38239
+861A87EC8A758DE3907892919425994D9BAE53685C5169546CC46D296E2B820C
+859B893B8A2D8AAA96EA9F67526166B96BB27E9687FE8D0D9583965D651D6D89
+71EEF96E57CE59D35BAC602760FA6210661F665F732973F976DB77017B6C0000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008056807281658AA091924E1652E26B726D177A057B397D30F96F8CB053EC
+562F58515BB55C0F5C115DE2624063836414662D68B36CBC6D886EAF701F70A4
+71D27526758F758E76197B117BE07C2B7D207D39852C856D86078A34900D9061
+90B592B797F69A374FD75C6C675F6D917C9F7E8C8B168D16901F5B6B5DFD640D
+84C0905C98E173875B8B609A677E6DDE8A1F8AA69001980C5237F9707051788E
+9396887091D74FEE53D755FD56DA578258FD5AC25B885CAB5CC05E2561010000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000620D624B6388641C653665786A396B8A6C346D196F3171E772E973787407
+74B27626776179C07A577AEA7CB97D8F7DAC7E617F9E81298331849084DA85EA
+88968AB08B908F3890429083916C929692B9968B96A796A896D6970098089996
+9AD39B1A53D4587E59195B705BBF6DD16F5A719F742174B9808583FD5DE15F87
+5FAA604265EC6812696F6A536B896D356DF373E376FE77AC7B4D7D148123821C
+834084F485638A628AC49187931E980699B4620C88538FF092655D075D270000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005D69745F819D87686FD562FE7FD2893689724E1E4E5850E752DD5347627F
+66077E698805965E4F8D5319563659CB5AA45C385C4E5C4D5E025F11604365BD
+662F664267BE67F4731C77E2793A7FC5849484CD89968A668A698AE18C558C7A
+57F45BD45F0F606F62ED690D6B966E5C71847BD287558B588EFE98DF98FE4F38
+4F814FE1547B5A205BB8613C65B0666871FC7533795E7D33814E81E3839885AA
+85CE87038A0A8EAB8F9BF9718FC559315BA45BE660895BE95C0B5FC36C810000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9726DF1700B751A82AF8AF64EC05341F97396D96C0F4E9E4FC45152555E
+5A255CE86211725982BD83AA86FE88598A1D963F96C599139D099D5D580A5CB3
+5DBD5E4460E1611563E16A026E2591029354984E9C109F775B895CB86309664F
+6848773C96C1978D98549B9F65A18B018ECB95BC55355CA95DD65EB56697764C
+83F495C758D362BC72CE9D284EF0592E600F663B6B8379E79D26539354C057C3
+5D16611B66D66DAF788D827E969897445384627C63966DB27E0A814B984D0000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006AFB7F4C9DAF9E1A4E5F503B51B6591C60F963F66930723A8036F97491CE
+5F31F975F9767D0482E5846F84BB85E58E8DF9774F6FF978F97958E45B436059
+63DA6518656D6698F97A694A6A236D0B7001716C75D2760D79B37A70F97B7F8A
+F97C8944F97D8B9391C0967DF97E990A57045FA165BC6F01760079A68A9E99AD
+9B5A9F6C510461B662916A8D81C6504358305F6671098A008AFA5B7C86164FFA
+513C56B4594463A96DF95DAA696D51864E884F59F97FF980F9815982F9820000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9836B5F6C5DF98474B57916F9858207824583398F3F8F5DF9869918F987
+F988F9894EA6F98A57DF5F796613F98BF98C75AB7E798B6FF98D90069A5B56A5
+582759F85A1F5BB4F98E5EF6F98FF9906350633BF991693D6C876CBF6D8E6D93
+6DF56F14F99270DF71367159F99371C371D5F994784F786FF9957B757DE3F996
+7E2FF997884D8EDFF998F999F99A925BF99B9CF6F99CF99DF99E60856D85F99F
+71B1F9A0F9A195B153ADF9A2F9A3F9A467D3F9A5708E71307430827682D20000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9A695BB9AE59E7D66C4F9A771C18449F9A8F9A9584BF9AAF9AB5DB85F71
+F9AC6620668E697969AE6C386CF36E366F416FDA701B702F715071DF7370F9AD
+745BF9AE74D476C87A4E7E93F9AFF9B082F18A608FCEF9B19348F9B29719F9B3
+F9B44E42502AF9B5520853E166F36C6D6FCA730A777F7A6282AE85DD8602F9B6
+88D48A638B7D8C6BF9B792B3F9B8971398104E944F0D4FC950B25348543E5433
+55DA586258BA59675A1B5BE4609FF9B961CA655665FF666468A76C5A6FB30000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000070CF71AC73527B7D87088AA49C329F075C4B6C8373447389923A6EAB7465
+761F7A697E15860A514058C564C174EE751576707FC1909596CD99546E2674E6
+7AA97AAA81E586D987788A1B5A495B8C5B9B68A169006D6373A97413742C7897
+7DE97FEB81188155839E8C4C962E981166F05F8065FA67896C6A738B502D5A03
+6B6A77EE59165D6C5DCD7325754FF9BAF9BB50E551F9582F592D599659DA5BE5
+F9BCF9BD5DA262D76416649364FEF9BE66DCF9BF6A48F9C071FF7464F9C10000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A887AAF7E477E5E80008170F9C287EF89818B209059F9C390809952617E
+6B326D747E1F89258FB14FD150AD519752C757C758895BB95EB8614269956D8C
+6E676EB6719474627528752C8073833884C98E0A939493DEF9C44E8E4F515076
+512A53C853CB53F35B875BD35C24611A618265F4725B7397744076C279507991
+79B97D067FBD828B85D5865E8FC2904790F591EA968596E896E952D65F6765ED
+6631682F715C7A3690C1980A4E91F9C56A526B9E6F907189801882B885530000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000904B969596F297FB851A9B314E90718A96C45143539F54E15713571257A3
+5A9B5AC45BC36028613F63F46C856D396E726E907230733F745782D188818F45
+9060F9C6966298589D1B67088D8A925E4F4D504950DE5371570D59D45A015C09
+617066906E2D7232744B7DEF80C3840E8466853F875F885B89188B02905597CB
+9B4F4E734F915112516AF9C7552F55A95B7A5BA55E7C5E7D5EBE60A060DF6108
+610963C465386709F9C867D467DAF9C9696169626CB96D27F9CA6E38F9CB0000
+EB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006FE173367337F9CC745C7531F9CD7652F9CEF9CF7DAD81FE843888D58A98
+8ADB8AED8E308E42904A903E907A914991C9936EF9D0F9D15809F9D26BD38089
+80B2F9D3F9D45141596B5C39F9D5F9D66F6473A780E48D07F9D79217958FF9D8
+F9D9F9DAF9DB807F620E701C7D68878DF9DC57A0606961476BB78ABE928096B1
+4E59541F6DEB852D967097F398EE63D66CE3909151DD61C981BA9DF94F9D501A
+51005B9C610F61FF64EC69056BC5759177E37FA98264858F87FB88638ABC0000
+EC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008B7091AB4E8C4EE54F0AF9DDF9DE593759E8F9DF5DF25F1B5F5B6021F9E0
+F9E1F9E2F9E3723E73E5F9E4757075CDF9E579FBF9E6800C8033808482E18351
+F9E7F9E88CBD8CB39087F9E9F9EA98F4990CF9EBF9EC703776CA7FCA7FCC7FFC
+8B1A4EBA4EC152035370F9ED54BD56E059FB5BC55F155FCD6E6EF9EEF9EF7D6A
+8335F9F086938A8DF9F1976D9777F9F2F9F34E004F5A4F7E58F965E56EA29038
+93B099B94EFB58EC598A59D96041F9F4F9F57A14F9F6834F8CC3516553440000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9F7F9F8F9F94ECD52695B5582BF4ED4523A54A859C959FF5B505B575B5C
+606361486ECB7099716E738674F775B578C17D2B800581EA8328851785C98AEE
+8CC796CC4F5C52FA56BC65AB6628707C70B872357DBD828D914C96C09D725B71
+68E76B986F7A76DE5C9166AB6F5B7BB47C2A883696DC4E084ED75320583458BB
+58EF596C5C075E335E845F35638C66B267566A1F6AA36B0C6F3F7246F9FA7350
+748B7AE07CA7817881DF81E7838A846C8523859485CF88DD8D1391AC95770000
+EE
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000969C518D54C957285BB0624D6750683D68936E3D6ED3707D7E2188C18CA1
+8F099F4B9F4E722D7B8F8ACD931A4F474F4E5132548059D05E9562B56775696E
+6A176CAE6E1A72D9732A75BD7BB87D3582E783F9845785F78A5B8CAF8E879019
+90B896CE9F5F52E3540A5AE15BC2645865756EF472C4F9FB76847A4D7B1B7C4D
+7E3E7FDF837B8B2B8CCA8D648DE18E5F8FEA8FF9906993D14F434F7A50B35168
+5178524D526A5861587C59605C085C555EDB609B623068136BBF6C086FB10000
+EF
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000714E742075307538755176727B4C7B8B7BAD7BC67E8F8A6E8F3E8F49923F
+92939322942B96FB985A986B991E5207622A62986D5976647ACA7BC07D765360
+5CBE5E976F3870B97C9897119B8E9EDE63A5647A87764E014E954EAD505C5075
+544859C35B9A5E405EAD5EF75F8160C5633A653F657465CC6676667867FE6968
+6A896B636C406DC06DE86E1F6E5E701E70A1738E73FD753A775B7887798E7A0B
+7A7D7CBE7D8E82478A028AEA8C9E912D914A91D8926692CC9320970697560000
+F0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000975C98029F0E52365291557C58245E1D5F1F608C63D068AF6FDF796D7B2C
+81CD85BA88FD8AF88E44918D9664969B973D984C9F4A4FCE514651CB52A95632
+5F145F6B63AA64CD65E9664166FA66F9671D689D68D769FD6F156F6E716771E5
+722A74AA773A7956795A79DF7A207A957C977CDF7D447E70808785FB86A48A54
+8ABF8D998E819020906D91E3963B96D59CE565CF7C078DB393C35B585C0A5352
+62D9731D50275B975F9E60B0616B68D56DD9742E7A2E7D427D9C7E31816B0000
+F1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008E2A8E35937E94184F5057505DE65EA7632B7F6A4E3B4F4F4F8F505A59DD
+80C4546A546855FE594F5B995DDE5EDA665D673167F1682A6CE86D326E4A6F8D
+70B773E075877C4C7D027D2C7DA2821F86DB8A3B8A858D708E8A8F339031914E
+9152944499D07AF97CA54FCA510151C657C85BEF5CFB66596A3D6D5A6E966FEC
+710C756F7AE388229021907596CB99FF83014E2D4EF2884691CD537D6ADB696B
+6C41847A589E618E66FE62EF70DD751175C77E5284B88B498D084E4B53EA0000
+F2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054AB573057405FD763016307646F652F65E8667A679D67B36B626C606C9A
+6F2C77E57825794979577D1980A2810281F3829D82B787188A8CF9FC8D048DBE
+907276F47A197A377E548077550755D45875632F64226649664B686D699B6B84
+6D256EB173CD746874A1755B75B976E1771E778B79E67E097E1D81FB852F8897
+8A3A8CD18EEB8FB0903293AD9663967397074F8453F159EA5AC95E19684E74C6
+75BE79E97A9281A386ED8CEA8DCC8FED659F6715F9FD57F76F577DDD8F2F0000
+F3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000093F696C65FB561F26F844E144F98501F53C955DF5D6F5DEE6B216B6478CB
+7B9AF9FE8E498ECA906E6349643E77407A84932F947F9F6A64B06FAF71E674A8
+74DA7AC47C127E827CB27E988B9A8D0A947D9910994C52395BDF64E6672D7D2E
+50ED53C358796158615961FA65AC7AD98B928B9650095021527555315A3C5EE0
+5F706134655E660C663666A269CD6EC46F32731676217A938139825983D684BC
+50B557F05BC05BE85F6963A178267DB583DC852191C791F5518A67F57B560000
+F4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008CAC51C459BB60BD8655501CF9FF52545C3A617D621A62D364F265A56ECC
+7620810A8E60965F96BB4EDF5343559859295DDD64C56CC96DFA73947A7F821B
+85A68CE48E10907791E795E1962197C651F854F255865FB964A46F887DB48F1F
+8F4D943550C95C166CBE6DFB751B77BB7C3D7C648A798AC2581E59BE5E166377
+7252758A776B8ADC8CBC8F125EF366746DF8807D83C18ACB97519BD6FA005243
+66FF6D956EEF7DE08AE6902E905E9AD4521D527F54E86194628462DB68A20000
+F5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006912695A6A3570927126785D7901790E79D27A0D8096827882D583498549
+8C828D859162918B91AE4FC356D171ED77D7870089F85BF85FD6675190A853E2
+585A5BF560A4618164607E3D80708525928364AE50AC5D146700589C62BD63A8
+690E69786A1E6E6B76BA79CB82BB84298ACF8DA88FFD9112914B919C93109318
+939A96DB9A369C0D4E11755C795D7AFA7B517BC97E2E84C48E598E748EF89010
+6625693F744351FA672E9EDC51455FE06C9687F2885D887760B481B584030000
+F6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008D0553D6543956345A365C31708A7FE0805A810681ED8DA391899A5F9DF2
+50744EC453A060FB6E2C5C644F88502455E45CD95E5F606568946CBB6DC471BE
+75D475F476617A1A7A497DC77DFB7F6E81F486A98F1C96C999B39F52524752C5
+98ED89AA4E0367D26F064FB55BE267956C886D78741B782791DD937C87C479E4
+7A315FEB4ED654A4553E58AE59A560F0625362D6673669558235964099B199DD
+502C53535544577CFA016258FA0264E2666B67DD6FC16FEF742274388A170000
+F7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000094385451560657665F48619A6B4E705870AD7DBB8A95596A812B63A27708
+803D8CAA5854642D69BB5B955E116E6FFA038569514C53F0592A6020614B6B86
+6C706CF07B1E80CE82D48DC690B098B1FA0464C76FA464916504514E5410571F
+8A0E615F6876FA0575DB7B527D71901A580669CC817F892A9000983950785957
+59AC6295900F9B2A615D727995D657615A465DF4628A64AD64FA67776CE26D3E
+722C743678347F7782AD8DDB981752245742677F724874E38CA98FA692110000
+F8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000962A516B53ED634C4F695504609665576C9B6D7F724C72FD7A1789878C9D
+5F6D6F8E70F981A8610E4FBF504F624172477BC77DE87FE9904D97AD9A198CB6
+576A5E7367B0840D8A5554205B165E635EE25F0A658380BA853D9589965B4F48
+5305530D530F548654FA57035E036016629B62B16355FA066CE16D6675B17832
+80DE812F82DE846184B2888D8912900B92EA98FD9B915E4566B466DD70117206
+FA074FF5527D5F6A615367536A196F0274E2796888688C7998C798C49A430000
+F9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054C17A1F69538AF78C4A98A899AE5F7C62AB75B276AE88AB907F96425339
+5F3C5FC56CCC73CC7562758B7B4682FE999D4E4F903C4E0B4F5553A6590F5EC8
+66306CB37455837787668CC09050971E9C1558D15B7886508B149DB45BD26068
+608D65F16C576F226FA3701A7F557FF095919592965097D352728F4451FD542B
+54B85563558A6ABB6DB57DD88266929C96779E79540854C876D286E495A495D4
+965C4EA24F0959EE5AE65DF760526297676D68416C866E2F7F38809B822A0000
+FA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FA08FA0998054EA5505554B35793595A5B695BB361C869776D77702387F9
+89E38A728AE7908299ED9AB852BE683850165E78674F8347884C4EAB541156AE
+73E6911597FF9909995799995653589F865B8A3161B26AF6737B8ED26B4796AA
+9A57595572008D6B97694FD45CF45F2661F8665B6CEB70AB738473B973FE7729
+774D7D437D627E2382378852FA0A8CE29249986F5B517A74884098015ACC4FE0
+5354593E5CFD633E6D7972F98105810783A292CF98304EA851445211578B0000
+FB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F626CC26ECE7005705070AF719273E97469834A87A28861900890A293A3
+99A8516E5F5760E0616766B385598E4A91AF978B4E4E4E92547C58D558FA597D
+5CB55F2762366248660A66676BEB6D696DCF6E566EF86F946FE06FE9705D72D0
+7425745A74E07693795C7CCA7E1E80E182A6846B84BF864E865F87748B778C6A
+93AC9800986560D1621691775A5A660F6DF76E3E743F9B425FFD60DA7B0F54C4
+5F186C5E6CD36D2A70D87D0586798A0C9D3B5316548C5B056A3A706B75750000
+FC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000798D79BE82B183EF8A718B418CA89774FA0B64F4652B78BA78BB7A6B4E38
+559A59505BA65E7B60A363DB6B61666568536E19716574B07D0890849A699C25
+6D3B6ED1733E8C4195CA51F05E4C5FA8604D60F66130614C6643664469A56CC1
+6E5F6EC96F62714C749C76877BC17C27835287579051968D9EC3532F56DE5EFB
+5F8A6062609461F7666667036A9C6DEE6FAE7070736A7E6A81BE833486D48AA8
+8CC4528373725B966A6B940454EE56865B5D6548658566C9689F6D8D6DC60000
+FD
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000723B80B491759A4D4FAF5019539A540E543C558955C55E3F5F8C673D7166
+73DD900552DB52F3586458CE7104718F71FB85B08A13668885A855A76684714A
+8431534955996BC15F595FBD63EE668971478AF18F1D9EBE4F11643A70CB7566
+866760648B4E9DF8514751F653086D3680F89ED166156B23709875D554035C79
+7D078A166B206B3D6B46543860706D3D7FD5820850D651DE559C566B56CD59EC
+5B095E0C619961986231665E66E6719971B971BA72A779A77A007FB28A700000
diff --git a/tcl/library/encoding/gb12345.enc b/tcl/library/encoding/gb12345.enc
new file mode 100644
index 00000000000..3f3f4d25458
--- /dev/null
+++ b/tcl/library/encoding/gb12345.enc
@@ -0,0 +1,1414 @@
+# Encoding file: gb12345, double-byte
+D
+233F 0 83
+21
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030003001300230FB02C902C700A8300330052015FF5E2225202620182019
+201C201D3014301530083009300A300B300C300D300E300F3016301730103011
+00B100D700F72236222722282211220F222A222922082237221A22A522252220
+23122299222B222E2261224C2248223D221D2260226E226F22642265221E2235
+22342642264000B0203220332103FF0400A4FFE0FFE1203000A7211626062605
+25CB25CF25CE25C725C625A125A025B325B2203B219221902191219330130000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+22
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000024882489248A248B248C248D248E248F2490249124922493249424952496
+249724982499249A249B247424752476247724782479247A247B247C247D247E
+247F248024812482248324842485248624872460246124622463246424652466
+2467246824690000000032203221322232233224322532263227322832290000
+00002160216121622163216421652166216721682169216A216B000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+23
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF01FF02FF03FFE5FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F
+FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFF3CFF3DFF3EFF3F
+FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+24
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+25
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+26
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+27
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000004100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+28
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000010100E101CE00E0011300E9011B00E8012B00ED01D000EC014D00F301D2
+00F2016B00FA01D400F901D601D801DA01DC00FC00EA00000000000000000000
+0000000000000000000031053106310731083109310A310B310C310D310E310F
+3110311131123113311431153116311731183119311A311B311C311D311E311F
+3120312131223123312431253126312731283129000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+29
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000002500250125022503250425052506250725082509250A250B
+250C250D250E250F2510251125122513251425152516251725182519251A251B
+251C251D251E251F2520252125222523252425252526252725282529252A252B
+252C252D252E252F2530253125322533253425352536253725382539253A253B
+253C253D253E253F2540254125422543254425452546254725482549254A254B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000554A963F57C3632854CE550954C0769A764C85F977EE827E7919611B9698
+978D6C285B894FFA630966975CB880FA68489AAF660276CE51F9655671AC7FF1
+895650B2596561CA6FB382AD634C625253ED54277B06516B75A45DF462D48DCB
+9776628A801958E997387F777238767D67CF767E64FA4F70655762DC7A176591
+73ED642C6273822C9812677F7248626E62CC4F3474E3534A8FA67D4690A65E6B
+6886699C81807D8168D278C5868C938A508D8B1782DE80DE5305891252650000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+31
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000858496F94FDD582198FD5BF662B1583166B48C799B917206676F789160B2
+535153178F2980CC8C9D92C7500D72FD5099618A711988AB595482EF672C7B28
+5D297DB3752D6CF58E668FF8903C9F3B6BD491197B465F7C78A784D6853D7562
+65836BD65E635E8775F99589655D5F0A5FC58F9F58C181C2907F965B97AD908A
+7DE88CB662414FBF8B8A535E8FA88FAF8FAE904D6A195F6A819888689C49618B
+522B765F5F6C658C70156FF18CD364EF517551B067C44E1979C9990570B30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+32
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075C55E7673BB83E064AD64A592626CE2535A52C3640F92517B944F2F5E1B
+82368116818A6E246CCA99C16355535C54FA88DC57E04E0D5E036B657C3F90E8
+601664E6731C88C16750624D8CA1776C8E2991C75F6983DC8521991053C38836
+6B98615A615871E684BC825950096EC485CF64CD7CD969FD66F9834953A07B56
+5074518C6E2C5C648E6D63D253C9832C833667E578B4643D5BDF5C945DEE8A6B
+62C667F48C7A6519647B87EC995E8B927E8F93DF752395E1986B660C73160000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+33
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000583456175E389577511F81785EE0655E66A2553150218D8562849214671D
+56326F6E5DE2543570928ECA626F64A463A35FB96F8890F481E38FB058756668
+5FF16C8996738D81896F64917A3157CE6A59621054484E587A0B61F26F848AA0
+627F901E9A0179E4540375F4630153196C6090725F1B99B3803B9F524F885C3A
+8D647FC565A571BE5145885D87F25D075BF562BD916C75878E8A7A2061017C4C
+4EC77DA27785919C81ED521D51FA6A7153A88E8792E496DB6EC19664695A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+34
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000790E513277D7641089F8865563E35DDD7A7F693D50B3823955984E327621
+7A975E625E8A95D652755439708A6376931857826625693F918755076DF37D14
+882262337DBD75B5832878C196CC8FAD614874F78A5E6B64523A8CDC6B218070
+847156F153065F9E53E251D17C97918B7C074FC38EA57BE17AC464675D1450AC
+810676017CB96DEC7FE067515B585BF878CB64AE641363AA632B932F642D9054
+7B5476296253592754466B7950A362345E366B864EE38CB8888B5F85902E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+35
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006020803D64D44E3955AE913264A381BD65E66C2E4F46619A6DE18A955F48
+86CB757664CB9EE885696A94520064178E4850125CF679B15C0E52307A3B60BC
+905376D75FB75F9776848E6C71C8767B7B4977AA51F3912758244F4E6EF48FEA
+65757B1B72C46ECC7FDF5AE162B55E95573084827B2C5E1D5F1F905E7DE0985B
+63826EC778989EDE5178975B588A96FB4F4375385E9760E659606FB16BBF7889
+53FC96D551CB52016389540A91E38ABF8DCC7239789F87768FED8ADC758A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+36
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E0176EF53EE91D898029F0E93205B9A8A024E22677151AC846361C252D5
+68DF4F97606B51CD6D1E515C62969B2596618C46901775D890FD77636BD272A2
+73688B80583577798CED675C934D809A5EA66E2159927AEF77ED935B6BB565B7
+7DDE58065151968A5C0D58A956788E726566981356E4920D76FE9041638754C6
+591A596A579B8EB267358DFA8235524160F058AE86FE5CE89D5D4FC4984D8A1B
+5A2560E15384627C904F910299136069800C51528033723E990C6D314E8C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+37
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008CB3767C7F707B4F4F104E4F95A56CD573D085E95E06756A7FFB6A0A792C
+91E97E4151E1716953CD8FD47BC48CA972AF98EF6CDB574A82B365B980AA623F
+963259A84EFF8A2A7D21653E83F2975E556198DB80A5532A8AB9542080BA5EE2
+6CB88CBB82AC915A54296C1B52067D1B58B3711A6C7E7C89596E4EFD5FFF61A4
+7CDE8C505C01695387025CF092D298A8760B70FD902299AE7E2B8AF759499CF3
+4F5B5426592B6577819A5B75627662C28F3B5E456C1F7B264F0F4FD8670D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+38
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D6E6DAA798F88B15F17752B64AB8F144FEF91DC65A7812F81515E9C8150
+8D74526F89868CE65FA950854ED8961C723681798CA05BCC8A0396445A667E1B
+54905676560E8A7265396982922384CB6E895E797518674667D17AFF809D8D95
+611F79C665628D1B5CA1525B92FC7F38809B7DB15D176E2F67607BD9768B9AD8
+818F7F947CD5641E93AC7A3F544A54E56B4C64F162089D3F80F3759952729769
+845B683C86E495A39694927B500B54047D6668398DDF801566F45E9A7FB90000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+39
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000057C2803F68975DE5653B529F606D9F944F9B8EAC516C5BAB5F13978F6C5E
+62F18CA25171920E52FE6E9D82DF72D757A269CB8CFC591F8F9C83C754957B8D
+4F306CBD5B6459D19F1353E488319AA88C3780A16545986756FA96C7522E74DC
+526E5BE1630289024E5662D0602A68FA95DC5B9851A089C07BA199287F506163
+704C8CAB51495EE3901B7470898F572D78456B789F9C95A88ECC9B3C8A6D7678
+68426AC38DEA8CB4528A8F256EDA68CD934B90ED570B679C88F9904E54C80000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009AB85B696D776C264EA55BB399ED916361A890AF97D3542B6DB55BD251FD
+558A7F557FF064BC634D65F161BE608D710A6C576F22592F676D822A58D5568E
+8C6A6BEB90DD597D8017865F6D695475559D837783CF683879BE548C4F555408
+76D28C8995A16CB36DB88D6B89109DB48CC0563F9ED175D55F8872E0606854FC
+4EA86A2A886160528F5F54C470D886799D3B6D2A5B8F5F187D0555894FAF7334
+543C539A50195F8C547C4E4E5FFD745A58FA846B80E1877472D07CCA6E560000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F27864E552C8B774E926EEC623782B1562983EF733E6ED1756B52835316
+8A7169D05F8A61F76DEE58DE6B6174B0685390847DE963DB60A3559A76138C62
+71656E195BA65E7B8352614C9EC478FA87577C27768751F060F6714C66435E4C
+604D8B0A707063EE8F1D5FBD606286D456DE6BC160946167534960E066668CC4
+7A62670371F4532F8AF18AA87E6A8477660F5A5A9B426E3E6DF78C416D3B4F19
+706B7372621660D1970D8CA8798D64CA573E57FA6A5F75787A3D7A4D7B950000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000808C99518FF96FC08B4F9DC459EC7E3E7DDD5409697568D88F2F7C4D96C6
+53CA602575BE6C7253735AC97D1A64E05E7E810A5DF1858A628051805B634F0E
+796D529160B86FDF5BC45BC28A088A1865E25FCC969B59937E7C7D00560967B7
+593E4F735BB652A083A298308CC87532924050477A3C50F967B699D55AC16BB2
+76E358055C167B8B9593714E517C80A9827159787DD87E6D6AA267EC78B19E7C
+63C064BF7C215109526A51CF85A66ABB94528E108CE4898B93757BAD4EF60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000050658266528D991E6F386FFA6F975EFA50F559DC5C076F3F6C5F75868523
+69F3596C8B1B532091AC964D854969127901712681A04EA490CA6F869A555B0C
+56BC652A927877EF50E5811A72E189D299037E737D5E527F655991758F4E8F03
+53EB7A9663ED63A5768679F88857968E622A52AB7BC0685467706377776B7AED
+6F547D5089E359D0621285C982A5754C501F4ECB75A58AA15C4A5DFE7B4B65A4
+91D14ECA6D25895F7DCA932650C58B3990329773664979818FD171FC6D780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000076E152C1834651628396775B66769BE84EAC9A5A7CBE7CB37D934E958B66
+666F9838975C5883656C93E15F9175D997567ADF7AF651C870AF7A9863EA7A76
+7CFE739697ED4E4570784E5D915253A96551820A81FC8205548E5C31759A97A0
+62D872D975BD5C4599D283CA5C40548077E982096CAE805A62D264DA5DE85177
+8DDD8E1E92F84FF153E561FC70AC528763509D515A1F5026773753777D796485
+652B628963985014723589BA51B38A237D76574783CC921E8ECD541B5CFB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004FCA7AE36D5A90E199FF55805496536154AF958B63E9697751F16168520A
+582A52D8574E780D770B5EB761777CE0625B62974EA27095800362F770E49760
+577782DB67EF68F578D5984679D16BBB54B353EF6E34514B523B5BA28AB280AF
+554358BE61C75751542D7A7A60505B5463A7647353E362635BC767AF54ED7A9F
+82E691775EAB89328A8757AE630E8DE880EF584A7B7751085FEB5BEC6B3E5321
+7B5072C268467926773666E051B5866776D45DCB7ABA8475594E9B4150800000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+40
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000994B61276F7057646606634656F062EC64F45ED395CA578362C95587881F
+81D88FA35566840A4F868CF485CD5A6A6B0465147C4395CC862D703E8B95652C
+89BD61F67E9C721B6FEB7405699472FC5ECA90CE67176D6A648852DE72628001
+4F6C59E5916A70D96F8752D26A0296F79433857E78CA7D2F512158D864C2808B
+985E6CEA68F1695E51B7539868A872819ECE7C6C72F896E270557406674E88CF
+9BC979AE83898354540F68179E9753B252F5792B6B77522950884F8B4FD00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+41
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075E27ACB7C92701D96B8529B748354E95006806F84EE9023942E5EC96190
+6F237C3E658281C993C8620071497DF47CE751C968817CB1826F51698F1B91CF
+667E4EAE8AD264A9804A50DA764271CE5BE5907C6F664E86648294105ED66599
+521788C270C852A373757433679778F7971681E891309C576DCB51DB8CC3541D
+62CE73B283F196F69F6192344F367F9A51CC974896755DBA981853E64EE46E9C
+740969B4786B993E7559528976246D4167F3516D9F8D807E56A87C607ABF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+42
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000968658DF650F96B46A135A41645F7C0D6F0F964B860676E798715EEC7210
+64C46EF7865C9B6F9E93788C97328DEF8CC29E7F6F5E798493329678622E9A62
+541592C14FA365C55C655C627E37616E6C2F5F8B73876FFE7DD15DD265235B7F
+706453754E8263A0756563848F2A502B4F966DEA7DB88AD6863F87BA7F85908F
+947C7C6E9A3E88F8843D6D1B99F17D615ABD9EBB746A78BC879E99AC99E1561B
+55CE57CB8CB79EA58CE390818109779E9945883B6EFF851366FC61626F2B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+43
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008B3E8292832B76F26C135FD983BD732B830593286BDB77DB925A536F8302
+51925E3D8C8C8CBF9EBD73AB679A68859176970971646CA177095A9293826BCF
+7F8E66275BD059B95A9A958060B65011840C84996AAC76DF9333731B59225B5F
+772F919A97617CDC8FF78B0E5F4C7C7379D889936CCC871C5BC65E4268C97720
+7DBF5195514D52C95A297DEC976282D763CF778485D079D26E3A5EDF59998511
+6EC56C1162BF76BF654F61AB95A9660E879F9CF49298540D547D8B2C64780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+44
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000647986116A21819C78E864699B5462B9672B83AB58A89ED86CAB6F205BDE
+964C8B00725F67D062C77261755D59C66BCD589366AE5E5552DF6155672876EE
+776672677A4662FF54EA5450920990A35A1C7D0D6C164E435976801059485357
+753796E356CA6493816660F19B276DD65462991251855AE980FD59AE9713502A
+6CE55C3C64EC4F60533F81A990066EBA852B62C85E7478BE6506637B5FF55A18
+91C09CE55C3F634F80765B7D5699947793B36D8560A86AB8737051DD5BE70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+45
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000064F06FD8725B626D92157D1081BF6FC38FB25F04597452AA601259736696
+86507627632A61E67CEF8AFE54E66B509DD76BC685D5561450766F1A556A8DB4
+722C5E156015743662CD6392724C5F986E436D3E65006F5876E478D076FC7554
+522453DB4E539F9065C1802A80D6629B5486522870AE888D8DD16CE1547880DA
+57F988F48CE0966A914D4F696C9B567476C6783062A870F96F8E5F6D84EC68DA
+787C7BF781A8670B9D6C636778B0576F78129739627962AB528874356BD70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+46
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005564813E75B276AE533975DE50FB5C418B6C7BC7504F72479A1998C46F02
+74E27968648777A562FC983B8CA754C180584E52576A860B840D5E73619174F6
+8A555C4F57616F5198175A4678349B448FEB7C95525664B292EA50D583868461
+83E984B257D46A385703666E6D668B5C66DD7011671F6B3A68F2621A59BB4E03
+51C46F0667D26C8F517668CB59476B6775665D0E81CD9F4A65D7794879419A0E
+8D778C484E5E4F0155535951780C56686C238FC468C46C7D6CE38A1663900000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+47
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060706D3D727D626691FA925B534390777C3D4EDF8B194E7E9ED493229257
+524D6F5B90636DFA8B7458795D4C6B206B4969CD55C681547F8C58BB85945F3A
+64366A47936C657260846A4B77A755AC50D15DE7979864AC7FF95CED4FCF7AC5
+520783044E14602F7ACA6B3D4FB589AA79E6743452E482B964D279BD5BE26C81
+97528F156C2B50BE537F6E0564CE66746C3060C598038ACB617674CA7AAE79CB
+4E1890B174036C4256DA914B6CC58DA8534086C666F28EC05C489A456E200000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+48
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000053D65A369F728DA353BB570898746B0A919B6CC9516875CA62F372AC5238
+52F87F3A7094763853749D7269B778BA96C088D97FA4713671C3518967D374E4
+58E4651856B78B93995264FE7E5E60F971B158EC4EC14EBA5FCD97CC4EFB8A8D
+5203598A7D0962544ECD65E5620E833884C969AE878D71946EB65BB97D685197
+63C967D480898339881551125B7A59828FB14E736C5D516589258EDF962E854A
+745E92ED958F6F6482E55F316492705185A9816E9C13585E8CFD4E0953C10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+49
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000050986563685155D355AA64149A3763835AC2745F82726F8068EE50E7838E
+78026BBA52396C997D1750BB5565715E7BE966EC73CA82EB67495C715220717D
+886B9583965D64C58D0D81B355846C5562477E55589250B755468CDE664C4E0A
+5C1A88F368A2634E7A0D71D2828D52FA97F65C1154E890B57D3959628CD286C7
+820C63688D66651D5C0461FE6D89793E8A2D78377533547B4F388EAB6DF15A20
+7D33795E6C885BE95B38751A814E614E6EF28072751F7525727253477E690000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000770176DB526952DD80565E2B5931734565BD6FD58A695C388671534177F3
+62FE66424EC098DF87555BE68B5853F277E24F7F5C4E99DB59CB5F0F793A58EB
+4E1667FF4E8B62ED8A93901D52E2662F55DC566C90694ED54F8D91CB98FE6C0F
+5E0260435BA489968A666536624B99965B8858FD6388552E53D776267378852C
+6A1E68B36B8A62928F3853D482126DD1758F66F88D165B70719F85AF669166D9
+7F7287009ECD9F205C6C88538FF06A39675F620D7AEA58855EB665786F310000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060555237800D6454887075295E25681362F4971C96D9723D8AB06C347761
+7A0E542E77AC9806821C8AAC78A96714720D65AF64955636601D79C153F87D72
+6B7B80865BFA55E356DB4F3A4F3C98FC5DF39B068073616B980C90015B8B8A1F
+8AA6641C825864FB55FD860791654FD77D20901F7C9F50F358516EAF5BBF8A34
+80859178849C7B9796D6968B96A87D8F9AD3788E6B727A57904296A7795F5B6B
+640D7B0B84D168AD55067E2E74637D2293966240584C4ED65B83597958540000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000737A64BB8E4B8E0F80CE82D462AC81FA6CF0915E592A614B6C70574D6524
+8CAA7671705858C76A8075F06F6D8B5A8AC757666BEF889278B363A2560670AD
+6E6F5858642A580268E0819B55107CD650188EBA6DCC8D9F71D9638F6FE46ED4
+7E278404684390036DD896768A0E5957727985E49A3075BC8B0468AF52548E22
+92BB63D0984C8E44557C9AD466FF568F60D56D9552435C4959296DFB586B7530
+751C606C821481466311689D8FE2773A8DF38CBC94355E165EF3807D70F40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006C405EF7505C4EAD5EAD633A8247901A6850916E77B3540C92855F647AE5
+687663457B527D7175DB50776295982D900F51F879C37A8157165F9290145857
+5C60571F541051546E4D571863A8983D817F8715892A9000541E5C6F81C062D6
+625881319D15964099B199DD6A6259A562D3553E631654C786D97AAA5A0374E6
+896A6B6A59168C4C5F4E706373A998114E3870F75B8C7897633D665A769660CB
+5B9B5A49842C81556C6A738B4EA167897DB25F8065FA671B5FD859845A010000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005DCD5FAE537197CB90556845570D552F60DF72326FF07DAD8466840E59D4
+504950DE5C3E7DEF672A851A5473754F80C355829B4F4F4D6E2D8B025C096170
+885B761F6E29868A6587805E7D0B543B7A697D0A554F55E17FC174EE64BE8778
+6E267AA9621165A1536763E16C835DEB55DA93A270CF6C618AA35C4B7121856A
+68A7543E54346BCB6B664E9463425348821E4F0D4FAE5862620A972766647269
+52FF52D9609F8AA4661471996790897F785277FD6670563B5438932B72A70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A00606F5E0C6089819D591560DC718470EF6EAA6C5072806A8489725E2D
+7FD25AB3559C92916D177CFB969962327D30778E87665323971E8F4466875CFD
+4FE072F94E0B53A6590F56876380934151484ED99BAE7E9654B88CE2929C8237
+95916D8E5F265ACC986F96AA73FE737B7E23817A99217FA161B2967796507DAB
+76F853A2947299997BB189446E5891097FD479658A7360F397FF4EAB98055DF7
+6A6150CF54118C61856D785D9704524A54EE56C292B76D885BB56DC666C90000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C0F5B5D68218096562F7B11654869544E9B6B47874E978B5354633E643A
+90AA659C81058AE75BEB68B0537887F961C86CC470098B1D5C5185AA82AF92C5
+6B238F9B65B05FFB5FC34FE191C1661F8165732960FA82085211578B5F6290A2
+884C91925E78674F602759D3514451F680F853086C7996C4718A4F114FEE7F9E
+673D55C592B979C088967D89589F620C9700865A561898085F908A3184C49157
+53D965ED5E8F755C60647D6E5A7F7DD27E8C8ED255A75BA361F865CB73840000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+51
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009078766C77297D629774859B5B787A7496EA884052DB718F5FAA65EC8A62
+5C0B99B45DE16B896C5B8A138A0A905C8FC558D362BC9D099D2854404E2B82BD
+7259869C5D1688596DAF96C5555E4E9E8A1D710954BD95B970DF6DF99E7D56B4
+781487125CA95EF68A00985495BB708E6CBF594463A9773C884D6F1482775830
+71D553AD786F96C155015F6671305BB48AFA9A576B83592E9D2679E7694A63DA
+4F6F760D7F8A6D0B967D6C274EF07662990A6A236F3E90808170599674760000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+52
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006447582F90657A918B2159DA54AC820085E5898180006930564E8036723A
+91CE51B64E5F98016396696D844966F3814B591C6DB24E0058F991AB63D692A5
+4F9D4F0A886398245937907A79FB510080F075916C825B9C59E85F5D690587FB
+501A5DF24E5977E34EE585DD6291661390915C7951045F7981C69038808475AB
+4EA688D4610F6BC561B67FA976CA6EA28A638B708ABC8B6F5F027FFC7FCC7E79
+8335852D56E06BB797F3967059FB541F92806DEB5BC598F25C395F1596B10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000537082F16AFB5B309DF961C97E93746987A271DF719288058FCE8D0F76C8
+5F717A4E786C662055B264C150AD81C376705EB896CD8E3486F9548F6CF36D8C
+6C38607F52C775285E7D512A60A061825C24753190F5923E73366CB96E389149
+670953CB53F34F5191C98A9853C85E7C8FC26DE44E8E76C26986865E611A8F3F
+99184FDE903E9B5A61096E1D6F0196854E885A3196E882075DBC79B95B878A9E
+7FBD738957DF828B9B315401904755BB5CEA5FA161086B32734480B28B7D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D745BD388D598108C6B99AD9D1B6DF551A4514357A38881539F63F48F45
+571254E15713733F6E907DE3906082D198586028966266F07D048D8A8E8D9470
+5CB37CA4670860A695B2801896F29116530096955141904B85F49196668897F5
+5B55531D783896DC683D54C9707E5BB08F09518D572854B1652266AB8D0A8D1C
+81DF846C906D7CDF947F85FB68D765E96FA186A48E81566A902076827AC871E5
+8CAC64C752476FA48CCA600E589E618E66FE8D08624E55B36E23672D8ECB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+55
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000935895987728680569A8548B4E4D70B88A5064589F4B5B857A8450B55BE8
+77BB6C088A797C986CBE76DE65AC8F3E5D845C55863868E7536062307AD96E5B
+7DBB6A1F7AE05F706F335F35638C6F3267564E085E338CEC4ED781397634969C
+62DB662D627E6CBC8D9971677F695146808753EC906E629854F287C48F4D8005
+937A851790196D5973CD659F771F7504782781FB8C9E91DD5075679575B98A3A
+9707632F93AE966384B86399775C5F817319722D6014657462EF6B63653F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+56
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005E407665912D8B49829D679D652F5431871877E580A281026C414E4B7E54
+807776F4690D6B9657F7503C4F84574063076B628DBE887965E87D195FD7646F
+64F281F381F47F6E5E5F5CD95236667A79E97A1A8CEA709975D46EEF6CBB7A92
+4E2D76C55FE0941888777D427A2E816B91CD4EF28846821F54685DDE6D328B05
+7CA58EF880985E1A549276BA5B99665D9A5F73E0682A86DB6731732A8AF88A85
+90107AF971ED716E62C477DA56D14E3B845767F152A986C08CAF94447BC90000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+57
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F4F6CE8795D99D06293722A62FD5C0878DA8F4964B08CFA7BC66A01838A
+88DD599D649E58EF72C0690E93108FFD8D05589C7DB48AC46E96634962D95353
+684C74228301914C55447740707C6FC1517954A88CC759FF6ECB6DC45B5C7D2B
+4ED47C7D6ED35B5081EA6F2C5B579B0368D58E2A5B977D9C7E3D7E3191128D70
+594F63CD79DF8DB3535265CF79568A5B963B7D44947D7E825634918967007F6A
+5C0A907566285DE64F5067DE505A4F5C57505EA7000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+58
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E8D4E0C51404E105EFF53454E154E984E1E9B325B6C56694E2879BA4E3F
+53154E47592D723B536E6C1056DF80E499976BD3777E9F174E364E9F9F104E5C
+4E694E9382885B5B55C7560F4EC45399539D53B453A553AE97688D0B531A53F5
+532D5331533E8CFE5366536352025208520E52445233528C5274524C525E5261
+525C84AF527D528252815290529351827F544EBB4EC34EC94EC24EE84EE14EEB
+4EDE50B44EF34F224F644EF5500050964F094F474F5E4F6765384F5A4F5D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F5F4F574F324F3D4F764F744F914F894F834F8F4F7E4F7B51154F7C5102
+4F945114513C51374FC54FDA4FE34FDC4FD14FDF4FF85029504C4FF3502C500F
+502E502D4FFE501C500C5025502850E8504350555048504E506C50C2513B5110
+513A50BA50D6510650ED50EC50E650EE5107510B4EDD6C3D4F5850C94FCE9FA0
+6C467CF4516E5DFD9ECC999856C5591452F9530D8A0753109CEC591951554EA0
+51564EB3886E88A4893B81E088D279805B3488037FB851AB51B151BD51BC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000051C7519651A251A58A018A108A0C8A158B338A4E8A258A418A368A468A54
+8A588A528A868A848A7F8A708A7C8A758A6C8A6E8ACD8AE28A618A9A8AA58A91
+8A928ACF8AD18AC98ADB8AD78AC28AB68AF68AEB8B148B018AE48AED8AFC8AF3
+8AE68AEE8ADE8B288B9C8B168B1A8B108B2B8B2D8B568B598B4E8B9E8B6B8B96
+5369537A961D962296219631962A963D963C964296589654965F9689966C9672
+96749688968D969796B09097909B913A9099911490A190B490B390B691340000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090B890B090DF90C590BE913690C490C79106914890E290DC90D790DB90EB
+90EF90FE91049122911E91239131912F91399143914682BB595052F152AC52AD
+52BE54FF52D052D652F053DF71EE77CD5EF451F551FC9B2F53B65F01755A5DF0
+574C580A57A1587E58BC58C558D15729572C572A573358D9572E572F58E2573B
+5742576958E0576B58DA577C577B5768576D5776577357E157A4578C584F57CF
+57A75816579357A057D55852581D586457D257B857F457EF57F857E457DD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000580B580D57FD57ED5800581E5819584458205865586C58815889589A5880
+99A89F1961FF8279827D827F828F828A82A88284828E8291858C829982AB8553
+82BE82B085F682CA82E3829882B782AE83A7840784EF82A982B482A182AA829F
+82C482E782A482E1830982F782E48622830782DC82F482D282D8830C82FB82D3
+8526831A8306584B716282E082D5831C8351855884FD83088392833C83348331
+839B854E832F834F8347834385888340831785BA832D833A833372966ECE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008541831B85CE855284C08452846483B083788494843583A083AA8393839C
+8385837C859F83A9837D8555837B8398839E83A89DAF849383C1840183E583D8
+58078418840B83DD83FD83D6841C84388411840683D483DF840F840383F883F9
+83EA83C583C07E0883F083E1845C8451845A8459847385468488847A85628478
+843C844684698476851E848E8431846D84C184CD84D09A4084BD84D384CA84BF
+84BA863A84A184B984B4849793A38577850C750D853884F0861E851F85FA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008556853B84FF84FC8559854885688564855E857A77A285438604857B85A4
+85A88587858F857985EA859C858585B985B785B0861A85C185DC85FF86278605
+86298616863C5EFE5F08593C596980375955595A5958530F5C225C255C2C5C37
+624C636B647662BB62CA62DA62D762EE649F62F66339634B634363AD63F66371
+637A638E6451636D63AC638A636963AE645C63F263F863E064B363C463DE63CE
+645263C663BE65046441640B641B6420640C64266421645E6516646D64960000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000647A64F764FC6499651B64C064D064D764E464E265096525652E5F0B5FD2
+75195F11535F53F1563053E953E853FB541254165406544B563856C8545456A6
+54435421550454BC5423543254825494547754715464549A5680548454765466
+565D54D054AD54C254B4566054A754A6563555F6547254A3566654BB54BF54CC
+567254DA568C54A954AA54A4566554CF54DE561C54E7562E54FD551454F355E9
+5523550F55115527552A5616558F55B5554956C055415555553F5550553C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+60
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005537555655755576557755335530555C558B55D2558355B155B955885581
+559F557E55D65591557B55DF560D56B35594559955EA55F755C9561F55D156C1
+55EC55D455E655DD55C455EF55E555F2566F55CC55CD55E855F555E48F61561E
+5608560C560156B6562355FE56005627562D565856395657562C564D56625659
+5695564C5654568656645671566B567B567C5685569356AF56D456D756DD56E1
+570756EB56F956FF5704570A5709571C5E435E195E145E115E6C5E585E570000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+61
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005E375E445E545E5B5E5E5E615C8C5C7A5C8D5C905D875C885CF45C995C91
+5D505C9C5CB55CA25D2C5CAC5CAB5CB15CA35CC15CB75DA75CD25DA05CCB5D22
+5D975D0D5D275D265D2E5D245D1E5D065D1B5DB85D3E5D345D3D5D6C5D5B5D6F
+5D815D6B5D4B5D4A5D695D745D825D995D9D8C735DB75DD45F735F775F825F87
+5F89540E5FA05F995F9C5FA85FAD5FB55FBC88625F6172AD72B072B473777341
+72C372C172CE72CD72D272E8736A72E9733B72F472F7730172F3736B72FA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000072FB731773137380730A731E731D737C732273397325732C733873317350
+734D73577360736C736F737E821B592598E75924590298E0993398E9993C98EA
+98EB98ED98F4990999114F59991B9937993F994399489949994A994C99625E80
+5EE15E8B5E965EA55EA05EB95EB55EBE5EB38CE15ED25ED15EDB5EE85EEA81BA
+5FC45FC95FD661FA61AE5FEE616A5FE15FE4613E60B561345FEA5FED5FF86019
+60356026601B600F600D6029602B600A61CC6021615F61E860FB613760420000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000606A60F26096609A6173609D60836092608C609B611C60BB60B160DD60D8
+60C660DA60B4612061926115612360F46100610E612B614A617561AC619461A7
+61B761D461F55FDD96B39582958695C8958E9594958C95E595AD95AB9B2E95AC
+95BE95B69B2995BF95BD95BC95C395CB95D495D095D595DE4E2C723F62156C35
+6C546C5C6C4A70436C856C906C946C8C6C686C696C746C766C866F596CD06CD4
+6CAD702770186CF16CD76CB26CE06CD66FFC6CEB6CEE6CB16CD36CEF6D870000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+64
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D396D276D0C6D796E5E6D076D046D196D0E6D2B6FAE6D2E6D356D1A700F
+6EF86F6F6D336D916D6F6DF66F7F6D5E6D936D946D5C6D606D7C6D636E1A6DC7
+6DC56DDE70066DBF6DE06FA06DE66DDD6DD9700B6DAB6E0C6DAE6E2B6E6E6E4E
+6E6B6EB26E5F6E866E536E546E326E256E4470676EB16E9870446F2D70056EA5
+6EA76EBD6EBB6EB76F776EB46ECF6E8F6EC26E9F6F627020701F6F246F156EF9
+6F2F6F3670326F746F2A6F096F296F896F8D6F8C6F786F726F7C6F7A70280000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+65
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006FC96FA76FB96FB66FC26FE16FEE6FDE6FE06FEF701A7023701B70397035
+705D705E5B805B845B955B935BA55BB8752F9A2B64345BE45BEE89305BF08E47
+8B078FB68FD38FD58FE58FEE8FE490878FE690158FE890059004900B90909011
+900D9016902190359036902D902F9044905190529050906890589062905B66B9
+9074907D908290889083908B5F505F575F565F585C3B54AB5C505C595B715C63
+5C687FBC5F335F295F2D82745F3C9B3B5C6E59815983598D5AF55AD759A30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+66
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000599759CA5B00599E59A459D259B259AF59D759BE5A6D5B0859DD5B4C59E3
+59D859F95A0C5A095AA75AFB5A115A235A135A405A675A4A5A555A3C5A625B0B
+80EC5AAA5A9B5A775A7A5ABE5AEB5AB25B215B2A5AB85AE05AE35B195AD65AE6
+5AD85ADC5B095B175B165B325B375B405C155C1C5B5A5B655B735B515B535B62
+99D499DF99D99A369A5B99D199D89A4D9A4A99E29A6A9A0F9A0D9A059A429A2D
+9A169A419A2E9A389A439A449A4F9A659A647CF97D067D027D077D087E8A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007D1C7D157D137D3A7D327D317E107D3C7D407D3F7D5D7D4E7D737D867D83
+7D887DBE7DBA7DCB7DD47DC47D9E7DAC7DB97DA37DB07DC77DD97DD77DF97DF2
+7E627DE67DF67DF17E0B7DE17E097E1D7E1F7E1E7E2D7E0A7E117E7D7E397E35
+7E327E467E457E887E5A7E527E6E7E7E7E707E6F7E985E7A757F5DDB753E9095
+738E74A3744B73A2739F73CF73C274CF73B773B373C073C973C873E573D9980A
+740A73E973E773DE74BD743F7489742A745B7426742574287430742E742C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+68
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000741B741A7441745C74577455745974A6746D747E749C74D4748074817487
+748B749E74A874A9749074A774DA74BA97D997DE97DC674C6753675E674869AA
+6AEA6787676A677367986898677568D66A05689F678B6777677C67F06ADB67D8
+6AF367E967B06AE867D967B567DA67B367DD680067C367B867E26ADF67C16A89
+68326833690F6A48684E6968684469BF6883681D68556A3A68416A9C68406B12
+684A6849682968B5688F687468776893686B6B1E696E68FC6ADD69E768F90000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+69
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006B0F68F0690B6901695768E369106971693969606942695D6B16696B6980
+69986978693469CC6AEC6ADA69CE6AF8696669636979699B69A769BB69AB69AD
+69D469B169C169CA6AB369956AE7698D69FF6AA369ED6A176A186A6569F26A44
+6A3E6AA06A506A5B6A356A8E6AD36A3D6A286A586ADE6A916A906AA96A976AAB
+733773526B816B826BA46B846B9E6BAE6B8D6BAB6B9B6BAF6BAA8ED48EDB8EF2
+8EFB8F648EF98EFC8EEB8EE48F628EFA8EFE8F0A8F078F058F128F268F1E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008F1F8F1C8F338F468F548ECE62146227621B621F62226221622562246229
+81E7750C74F474FF750F75117513653465EE65EF65F0660A66C7677266036615
+6600708566F7661D66346631663666358006665F66C46641664F668966616657
+66776684668C66D6669D66BE66DB66DC66E666E98CC18CB08CBA8CBD8D048CB2
+8CC58D108CD18CDA8CD58CEB8CE78CFB899889AC89A189BF89A689AF89B289B7
+726E729F725D7266726F727E727F7284728B728D728F72926308633263B00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000643F64D880046BEA6BF36BFD6BFF6BF96C056C0C6C066C0D6C156C186C19
+6C1A6C216C2C6C246C2A6C3265356555656B725872527256723086625216809F
+809C809380BC670A80BD80B180AB80AD80B480B76727815680E981DA80DB80C2
+80C480D980CD80D7671080DD811B80F180F480ED81BE810E80F280FC67158112
+8C5A8161811E812C811881328148814C815381748159815A817181608169817C
+817D816D8167584D5AB58188818281CF6ED581A381AA81CC672681CA81BB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081C181A66B5F6B376B396B436B466B5998AE98AF98B698BC98C698C86BB3
+5F408F4289F365909F4F659565BC65C665C465C365CC65CE65D265D6716C7152
+7096719770BB70C070B770AB70B171C170CA7110711371DC712F71317173715C
+716871457172714A7178717A719871B371B571A871A071E071D471E771F9721D
+7228706C71FE716671B9623E623D624362486249793B794079467949795B795C
+7953795A79B079577960798E7967797A79AA798A799A79A779B35FD15FD00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000061DF605D605A606760416059606361646106610D615D61A9619D61CB61E3
+62078080807F6C936FA96DFC78EF77F878AD780978687818781165AB782D78B8
+781D7839792A7931781F783C7825782C78237829784E786D786478FD78267850
+7847784C786A78E77893789A788778E378A178A378B278B978A578D478D978C9
+78EC78F2790578F479137924791E79349F959EF99EFB9EFC76F17704779876F9
+77077708771A77227719772D772677357738775E77BC77477743775A77680000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077627765777F778D777D7780778C7791779F77A077B077B577BD753A7540
+754E754B7548755B7572757975837F587F617F5F8A487F687F867F717F797F88
+7F7E76CD76E5883291D291D391D491D991D791D591F791E791E4934691F591F9
+9208922692459211921092019227920492259200923A9266923792339255923D
+9238925E926C926D923F9460923092499248924D922E9239943892AC92A0927A
+92AA92EE92CF940392E3943A92B192A693A7929692CC92A993F59293927F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000093A9929A931A92AB9283940B92A892A39412933892F193D792E592F092EF
+92E892BC92DD92F69426942792C392DF92E6931293069369931B934093019315
+932E934393079308931F93199365934793769354936493AA9370938493E493D8
+9428938793CC939893B893BF93A693B093B5944C93E293DC93DD93CD93DE93C3
+93C793D19414941D93F794659413946D9420947993F99419944A9432943F9454
+9463937E77E777EC96C979D579ED79E379EB7A065D477A037A027A1E7A140000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+70
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A397A377A619ECF99A57A707688768E7693769976A474DE74E0752C9CE9
+9CF69D079D069D239D879E159D1D9D1F9DE59D2F9DD99D309D429E1E9D539E1D
+9D609D529DF39D5C9D619D939D6A9D6F9D899D989D9A9DC09DA59DA99DC29DBC
+9E1A9DD39DDA9DEF9DE69DF29DF89E0C9DFA9E1B7592759476647658759D7667
+75A375B375B475B875C475B175B075C375C2760275CD75E3764675E675E47647
+75E7760375F175FC75FF761076007649760C761E760A7625763B761576190000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+71
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000761B763C762276207640762D7630766D76357643766E7633764D76697654
+765C76567672766F7FCA7AE67A787A797A807A867A887A957AC77AA07AAC7AA8
+7AB67AB3886488698872887D887F888288A2896088B788BC88C9893388CE895D
+894788F1891A88FC88E888FE88F08921891989138938890A8964892B89368941
+8966897B758B80E576B876B477DC801280148016801C8020802E80258026802C
+802980288031800B803580438046807980528075807189839807980E980F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+72
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009821981C6F4198269837984E98539873986298599865986C9870864D8654
+866C87E38806867A867C867B86A8868D868B8706869D86A786A386AA869386A9
+86B686C486B5882386B086BA86B186AF86C987F686B486E986FA87EF86ED8784
+86D0871386DE881086DF86D886D18703870786F88708870A870D87098723873B
+871E8725872E871A873E87C88734873187298737873F87828722877D8811877B
+87608770874C876E878B8753876387BB876487598765879387AF87CE87D20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+73
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000087C68788878587AD8797878387AB87E587AC87B587B387CB87D387BD87D1
+87C087CA87DB87EA87E087EE8816881387FE880A881B88218839883C7F367F4C
+7F447F4582107AFA7AFD7B087BE47B047B677B0A7B2B7B0F7B477B387B2A7B19
+7B2E7B317B207B257B247B337C697B1E7B587BF37B457B757B4C7B8F7B607B6E
+7B7B7B627B727B717B907C007BCB7BB87BAC7B9D7C5C7B857C1E7B9C7BA27C2B
+7BB47C237BC17BCC7BDD7BDA7BE57BE67BEA7C0C7BFE7BFC7C0F7C6A7C0B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007C1F7C2A7C267C387C5F7C4081FE82018202820481EC8844822182228264
+822D822F8228822B8238826B82338234823E82448249824B824F825A825F8268
+887E88CA888888D888DF895E7F9D7FA57FA77FAF7FB07FB27C7C65497C917CF2
+7CF67C9E7CA27CB27CBC7CBD7CDD7CC77CCC7CCD7CC87CC57CD77CE8826E66A8
+7FBF7FCE7FD57FE57FE17FE67FE97FEE7FF37CF87E367DA67DAE7E477E9B9EA9
+9EB48D738D848D948D918DB28D678D6D8C478C49914A9150914E914F91640000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+75
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009162916191709169916F91C591C3917291749179918C91859190918D9191
+91A291A391AA91AD91AE91AF91B591B491BA8C559E7A8E898DEB8E058E598E69
+8DB58DBF8DBC8DBA8E4C8DD68DD78DDA8E928DCE8DCF8DDB8DC68DEC8E7A8E55
+8DE38E9A8E8B8DE48E098DFD8E148E1D8E1F8E938E2E8E238E918E3A8E408E39
+8E358E3D8E318E498E418E428EA18E638E4A8E708E768E7C8E6F8E748E858EAA
+8E948E908EA68E9E8C788C828C8A8C858C988C94659B89D689F489DA89DC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+76
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000089E589EB89F68A3E8B26975A96E9974296EF9706973D9708970F970E972A
+97449730973E9F549F5F9F599F609F5C9F669F6C9F6A9F779EFD9EFF9F0996B9
+96BC96BD96CE96D277BF8B8E928E947E92C893E8936A93CA938F943E946B9B77
+9B749B819B839B8E9C787A4C9B929C5F9B909BAD9B9A9BAA9B9E9C6D9BAB9B9D
+9C589BC19C7A9C319C399C239C379BC09BCA9BC79BFD9BD69BEA9BEB9BE19BE4
+9BE79BDD9BE29BF09BDB9BF49BD49C5D9C089C109C0D9C129C099BFF9C200000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+77
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009C329C2D9C289C259C299C339C3E9C489C3B9C359C459C569C549C529C67
+977C978597C397BD979497C997AB97A397B297B49AB19AB09AB79DBB9AB69ABA
+9ABC9AC19AC09ACF9AC29AD69AD59AD19B459B439B589B4E9B489B4D9B519957
+995C992E995599549ADF9AE19AE69AEF9AEB9AFB9AED9AF99B089B0F9B229B1F
+9B234E489EBE7E3B9E829E879E889E8B9E9293D69E9D9E9F9EDB9EDC9EDD9EE0
+9EDF9EE29EF79EE79EE59EF29EEF9F229F2C9F2F9F399F379F3D9F3E9F440000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+78
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000896C95C693365F4685147E94538251B24E119F635679515A6DC09F156597
+56419AEE83034E3089075E727A4098B35E7F95A49B0D52128FF45F597A6B98E2
+51E050A24EF7835085915118636E6372524B5938774F8721814A7E8D91CC66C6
+5E1877AD9E7556C99EF46FDB61DE77C770309EB5884A95E282F951ED62514EC6
+673497C67C647E3497A69EAF786E820D672F677E56CC53F098B16AAF7F4E6D82
+7CF04E074FC27E6B9E7956AE9B1A846F53F690C179A67C72613F4E919AD20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+79
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075C796BB53EA7DFB88FD79CD78437B5151C6000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/gb1988.enc b/tcl/library/encoding/gb1988.enc
new file mode 100644
index 00000000000..298732ccc23
--- /dev/null
+++ b/tcl/library/encoding/gb1988.enc
@@ -0,0 +1,20 @@
+# Encoding file: gb1988, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+002000210022002300A500250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D203E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/gb2312.enc b/tcl/library/encoding/gb2312.enc
new file mode 100644
index 00000000000..813d7a6f370
--- /dev/null
+++ b/tcl/library/encoding/gb2312.enc
@@ -0,0 +1,1380 @@
+# Encoding file: gb2312, double-byte
+D
+233F 0 81
+21
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030003001300230FB02C902C700A8300330052015FF5E2225202620182019
+201C201D3014301530083009300A300B300C300D300E300F3016301730103011
+00B100D700F72236222722282211220F222A222922082237221A22A522252220
+23122299222B222E2261224C2248223D221D2260226E226F22642265221E2235
+22342642264000B0203220332103FF0400A4FFE0FFE1203000A7211626062605
+25CB25CF25CE25C725C625A125A025B325B2203B219221902191219330130000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+22
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000024882489248A248B248C248D248E248F2490249124922493249424952496
+249724982499249A249B247424752476247724782479247A247B247C247D247E
+247F248024812482248324842485248624872460246124622463246424652466
+2467246824690000000032203221322232233224322532263227322832290000
+00002160216121622163216421652166216721682169216A216B000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+23
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF01FF02FF03FFE5FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F
+FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFF3CFF3DFF3EFF3F
+FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+24
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+25
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+26
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+27
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000004100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+28
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000010100E101CE00E0011300E9011B00E8012B00ED01D000EC014D00F301D2
+00F2016B00FA01D400F901D601D801DA01DC00FC00EA00000000000000000000
+0000000000000000000031053106310731083109310A310B310C310D310E310F
+3110311131123113311431153116311731183119311A311B311C311D311E311F
+3120312131223123312431253126312731283129000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+29
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000002500250125022503250425052506250725082509250A250B
+250C250D250E250F2510251125122513251425152516251725182519251A251B
+251C251D251E251F2520252125222523252425252526252725282529252A252B
+252C252D252E252F2530253125322533253425352536253725382539253A253B
+253C253D253E253F2540254125422543254425452546254725482549254A254B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000554A963F57C3632854CE550954C07691764C853C77EE827E788D72319698
+978D6C285B894FFA630966975CB880FA684880AE660276CE51F9655671AC7FF1
+888450B2596561CA6FB382AD634C625253ED54277B06516B75A45DF462D48DCB
+9776628A8019575D97387F627238767D67CF767E64464F708D2562DC7A176591
+73ED642C6273822C9881677F7248626E62CC4F3474E3534A529E7ECA90A65E2E
+6886699C81807ED168D278C5868C9551508D8C2482DE80DE5305891252650000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+31
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000858496F94FDD582199715B9D62B162A566B48C799C8D7206676F789160B2
+535153178F8880CC8D1D94A1500D72C8590760EB711988AB595482EF672C7B28
+5D297EF7752D6CF58E668FF8903C9F3B6BD491197B145F7C78A784D6853D6BD5
+6BD96BD65E015E8775F995ED655D5F0A5FC58F9F58C181C2907F965B97AD8FB9
+7F168D2C62414FBF53D8535E8FA88FA98FAB904D68075F6A819888689CD6618B
+522B762A5F6C658C6FD26EE85BBE6448517551B067C44E1979C9997C70B30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+32
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075C55E7673BB83E064AD62E894B56CE2535A52C3640F94C27B944F2F5E1B
+82368116818A6E246CCA9A736355535C54FA886557E04E0D5E036B657C3F90E8
+601664E6731C88C16750624D8D22776C8E2991C75F6983DC8521991053C28695
+6B8B60ED60E8707F82CD82314ED36CA785CF64CD7CD969FD66F9834953957B56
+4FA7518C6D4B5C428E6D63D253C9832C833667E578B4643D5BDF5C945DEE8BE7
+62C667F48C7A640063BA8749998B8C177F2094F24EA7961098A4660C73160000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+33
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000573A5C1D5E38957F507F80A05382655E7545553150218D856284949E671D
+56326F6E5DE2543570928F66626F64A463A35F7B6F8890F481E38FB05C186668
+5FF16C8996488D81886C649179F057CE6A59621054484E587A0B60E96F848BDA
+627F901E9A8B79E4540375F4630153196C608FDF5F1B9A70803B9F7F4F885C3A
+8D647FC565A570BD514551B2866B5D075BA062BD916C75748E0C7A2061017B79
+4EC77EF877854E1181ED521D51FA6A7153A88E87950496CF6EC19664695A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+34
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000784050A877D7641089E6590463E35DDD7A7F693D4F20823955984E3275AE
+7A975E625E8A95EF521B5439708A6376952457826625693F918755076DF37EAF
+882262337EF075B5832878C196CC8F9E614874F78BCD6B64523A8D506B21806A
+847156F153064ECE4E1B51D17C97918B7C074FC38E7F7BE17A9C64675D1450AC
+810676017CB96DEC7FE067515B585BF878CB64AE641363AA632B9519642D8FBE
+7B5476296253592754466B7950A362345E266B864EE38D37888B5F85902E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+35
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006020803D62C54E39535590F863B880C665E66C2E4F4660EE6DE18BDE5F39
+86CB5F536321515A83616863520063638E4850125C9B79775BFC52307A3B60BC
+905376D75FB75F9776848E6C706F767B7B4977AA51F3909358244F4E6EF48FEA
+654C7B1B72C46DA47FDF5AE162B55E95573084827B2C5E1D5F1F90127F1498A0
+63826EC7789870B95178975B57AB75354F4375385E9760E659606DC06BBF7889
+53FC96D551CB52016389540A94938C038DCC7239789F87768FED8C0D53E00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+36
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E0176EF53EE948998769F0E952D5B9A8BA24E224E1C51AC846361C252A8
+680B4F97606B51BB6D1E515C6296659796618C46901775D890FD77636BD2728A
+72EC8BFB583577798D4C675C9540809A5EA66E2159927AEF77ED953B6BB565AD
+7F0E58065151961F5BF958A954288E726566987F56E4949D76FE9041638754C6
+591A593A579B8EB267358DFA8235524160F0581586FE5CE89E454FC4989D8BB9
+5A2560765384627C904F9102997F6069800C513F80335C1499756D314E8C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+37
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008D3053D17F5A7B4F4F104E4F96006CD573D085E95E06756A7FFB6A0A77FE
+94927E4151E170E653CD8FD483038D2972AF996D6CDB574A82B365B980AA623F
+963259A84EFF8BBF7EBA653E83F2975E556198DE80A5532A8BFD542080BA5E9F
+6CB88D3982AC915A54296C1B52067EB7575F711A6C7E7C89594B4EFD5FFF6124
+7CAA4E305C0167AB87025CF0950B98CE75AF70FD902251AF7F1D8BBD594951E4
+4F5B5426592B657780A45B75627662C28F905E456C1F7B264F0F4FD8670D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+38
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D6E6DAA798F88B15F17752B629A8F854FEF91DC65A7812F81515E9C8150
+8D74526F89868D4B590D50854ED8961C723681798D1F5BCC8BA3964459877F1A
+54905676560E8BE565396982949976D66E895E727518674667D17AFF809D8D76
+611F79C665628D635188521A94A27F38809B7EB25C976E2F67607BD9768B9AD8
+818F7F947CD5641E95507A3F544A54E56B4C640162089E3D80F3759952729769
+845B683C86E49601969494EC4E2A54047ED968398DDF801566F45E9A7FB90000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+39
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000057C2803F68975DE5653B529F606D9F9A4F9B8EAC516C5BAB5F135DE96C5E
+62F18D21517194A952FE6C9F82DF72D757A267848D2D591F8F9C83C754957B8D
+4F306CBD5B6459D19F1353E486CA9AA88C3780A16545987E56FA96C7522E74DC
+52505BE1630289024E5662D0602A68FA51735B9851A089C27BA199867F5060EF
+704C8D2F51495E7F901B747089C4572D78455F529F9F95FA8F689B3C8BE17678
+684267DC8DEA8D35523D8F8A6EDA68CD950590ED56FD679C88F98FC754C80000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009AB85B696D776C264EA55BB39A87916361A890AF97E9542B6DB55BD251FD
+558A7F557FF064BC634D65F161BE608D710A6C576C49592F676D822A58D5568E
+8C6A6BEB90DD597D801753F76D695475559D837783CF683879BE548C4F555408
+76D28C8996026CB36DB88D6B89109E648D3A563F9ED175D55F8872E0606854FC
+4EA86A2A886160528F7054C470D886799E3F6D2A5B8F5F187EA255894FAF7334
+543C539A5019540E547C4E4E5FFD745A58F6846B80E1877472D07CCA6E560000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F27864E552C62A44E926CAA623782B154D7534E733E6ED1753B52125316
+8BDD69D05F8A60006DEE574F6B2273AF68538FD87F13636260A3552475EA8C62
+71156DA35BA65E7B8352614C9EC478FA87577C27768751F060F6714C66435E4C
+604D8C0E707063258F895FBD606286D456DE6BC160946167534960E066668D3F
+79FD4F1A70E96C478BB38BF27ED88364660F5A5A9B426D516DF78C416D3B4F19
+706B83B7621660D1970D8D27797851FB573E57FA673A75787A3D79EF7B950000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000808C99658FF96FC08BA59E2159EC7EE97F095409678168D88F917C4D96C6
+53CA602575BE6C7253735AC97EA7632451E0810A5DF184DF628051805B634F0E
+796D524260B86D4E5BC45BC28BA18BB065E25FCC964559937EE77EAA560967B7
+59394F735BB652A0835A988A8D3E753294BE50477A3C4EF767B69A7E5AC16B7C
+76D1575A5C167B3A95F4714E517C80A9827059787F04832768C067EC78B17877
+62E363617B804FED526A51CF835069DB92748DF58D3189C1952E7BAD4EF60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000506582305251996F6E106E856DA75EFA50F559DC5C066D466C5F7586848B
+686859568BB253209171964D854969127901712680F64EA490CA6D479A845A07
+56BC640594F077EB4FA5811A72E189D2997A7F347EDE527F655991758F7F8F83
+53EB7A9663ED63A5768679F888579636622A52AB8282685467706377776B7AED
+6D017ED389E359D0621285C982A5754C501F4ECB75A58BEB5C4A5DFE7B4B65A4
+91D14ECA6D25895F7D2795264EC58C288FDB9773664B79818FD170EC6D780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C3D52B283465162830E775B66769CB84EAC60CA7CBE7CB37ECF4E958B66
+666F988897595883656C955C5F8475C997567ADF7ADE51C070AF7A9863EA7A76
+7EA0739697ED4E4570784E5D915253A9655165E781FC8205548E5C31759A97A0
+62D872D975BD5C459A7983CA5C40548077E94E3E6CAE805A62D2636E5DE85177
+8DDD8E1E952F4FF153E560E770AC526763509E435A1F5026773753777EE26485
+652B628963985014723589C951B38BC07EDD574783CC94A7519B541B5CFB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004FCA7AE36D5A90E19A8F55805496536154AF5F0063E9697751EF6168520A
+582A52D8574E780D770B5EB761777CE0625B62974EA27095800362F770E49760
+577782DB67EF68F578D5989779D158F354B353EF6E34514B523B5BA28BFE80AF
+554357A660735751542D7A7A60505B5463A762A053E362635BC767AF54ED7A9F
+82E691775E9388E4593857AE630E8DE880EF57577B774FA95FEB5BBD6B3E5321
+7B5072C2684677FF773665F751B54E8F76D45CBF7AA58475594E9B4150800000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+40
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000998861276E8357646606634656F062EC62695ED39614578362C955878721
+814A8FA3556683B167658D5684DD5A6A680F62E67BEE961151706F9C8C3063FD
+89C861D27F0670C26EE57405699472FC5ECA90CE67176D6A635E52B372628001
+4F6C59E5916A70D96D9D52D24E5096F7956D857E78CA7D2F5121579264C2808B
+7C7B6CEA68F1695E51B7539868A872819ECE7BF172F879BB6F137406674E91CC
+9CA4793C83898354540F68174E3D538952B1783E5386522950884F8B4FD00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+41
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075E27ACB7C926CA596B6529B748354E94FE9805483B28FDE95705EC9601C
+6D9F5E18655B813894FE604B70BC7EC37CAE51C968817CB1826F4E248F8691CF
+667E4EAE8C0564A9804A50DA759771CE5BE58FBD6F664E86648295635ED66599
+521788C270C852A3730E7433679778F797164E3490BB9CDE6DCB51DB8D41541D
+62CE73B283F196F69F8494C34F367F9A51CC707596755CAD988653E64EE46E9C
+740969B4786B998F7559521876246D4167F3516D9F99804B54997B3C7ABF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+42
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009686578462E29647697C5A0464027BD36F0F964B82A6536298855E907089
+63B35364864F9C819E93788C97328DEF8D429E7F6F5E79845F559646622E9A74
+541594DD4FA365C55C655C617F1586516C2F5F8B73876EE47EFF5CE6631B5B6A
+6EE653754E7163A0756562A18F6E4F264ED16CA67EB68BBA841D87BA7F57903B
+95237BA99AA188F8843D6D1B9A867EDC59889EBB739B780186829A6C9A82561B
+541757CB4E709EA653568FC881097792999286EE6EE1851366FC61626F2B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+43
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008C298292832B76F26C135FD983BD732B8305951A6BDB77DB94C6536F8302
+51925E3D8C8C8D384E4873AB679A68859176970971646CA177095A9295416BCF
+7F8E66275BD059B95A9A95E895F74EEC840C84996AAC76DF9530731B68A65B5F
+772F919A97617CDC8FF78C1C5F257C7379D889C56CCC871C5BC65E4268C97720
+7EF55195514D52C95A297F05976282D763CF778485D079D26E3A5E9959998511
+706D6C1162BF76BF654F60AF95FD660E879F9E2394ED540D547D8C2C64780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+44
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000647986116A21819C78E864699B5462B9672B83AB58A89ED86CAB6F205BDE
+964C8C0B725F67D062C772614EA959C66BCD589366AE5E5552DF6155672876EE
+776672677A4662FF54EA545094A090A35A1C7EB36C164E435976801059485357
+753796BE56CA63208111607C95F96DD65462998151855AE980FD59AE9713502A
+6CE55C3C62DF4F60533F817B90066EBA852B62C85E7478BE64B5637B5FF55A18
+917F9E1F5C3F634F80425B7D556E954A954D6D8560A867E072DE51DD5B810000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+45
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000062E76CDE725B626D94AE7EBD81136D53519C5F04597452AA601259736696
+8650759F632A61E67CEF8BFA54E66B279E256BB485D5545550766CA4556A8DB4
+722C5E156015743662CD6392724C5F986E436D3E65006F5876D878D076FC7554
+522453DB4E535E9E65C1802A80D6629B5486522870AE888D8DD16CE1547880DA
+57F988F48D54966A914D4F696C9B55B776C6783062A870F96F8E5F6D84EC68DA
+787C7BF781A8670B9E4F636778B0576F78129739627962AB528874356BD70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+46
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005564813E75B276AE533975DE50FB5C418B6C7BC7504F72479A9798D86F02
+74E27968648777A562FC98918D2B54C180584E52576A82F9840D5E7351ED74F6
+8BC45C4F57616CFC98875A4678349B448FEB7C955256625194FA4EC683868461
+83E984B257D467345703666E6D668C3166DD7011671F6B3A6816621A59BB4E03
+51C46F0667D26C8F517668CB59476B6775665D0E81109F5065D7794879419A91
+8D775C824E5E4F01542F5951780C56686C148FC45F036C7D6CE38BAB63900000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+47
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060706D3D72756266948E94C553438FC17B7E4EDF8C264E7E9ED494B194B3
+524D6F5C90636D458C3458115D4C6B206B4967AA545B81547F8C589985375F3A
+62A26A47953965726084686577A74E544FA85DE7979864AC7FD85CED4FCF7A8D
+520783044E14602F7A8394A64FB54EB279E6743452E482B964D279BD5BDD6C81
+97528F7B6C22503E537F6E0564CE66746C3060C598778BF75E86743C7A7779CB
+4E1890B174036C4256DA914B6CC58D8B533A86C666F28EAF5C489A716E200000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+48
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000053D65A369F8B8DA353BB570898A76743919B6CC9516875CA62F372AC5238
+529D7F3A7094763853749E4A69B7786E96C088D97FA4713671C3518967D374E4
+58E4651856B78BA9997662707ED560F970ED58EC4EC14EBA5FCD97E74EFB8BA4
+5203598A7EAB62544ECD65E5620E833884C98363878D71946EB65BB97ED25197
+63C967D480898339881551125B7A59828FB14E736C5D516589258F6F962E854A
+745E951095F06DA682E55F3164926D128428816E9CC3585E8D5B4E0953C10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+49
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F1E6563685155D34E2764149A9A626B5AC2745F82726DA968EE50E7838E
+7802674052396C997EB150BB5565715E7B5B665273CA82EB67495C715220717D
+886B95EA965564C58D6181B355846C5562477F2E58924F2455468D4F664C4E0A
+5C1A88F368A2634E7A0D70E7828D52FA97F65C1154E890B57ECD59628D4A86C7
+820C820D8D6664445C0461516D89793E8BBE78377533547B4F388EAB6DF15A20
+7EC5795E6C885BA15A76751A80BE614E6E1758F0751F7525727253477EF30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000770176DB526980DC57235E08593172EE65BD6E7F8BD75C388671534177F3
+62FE65F64EC098DF86805B9E8BC653F277E24F7F5C4E9A7659CB5F0F793A58EB
+4E1667FF4E8B62ED8A93901D52BF662F55DC566C90024ED54F8D91CA99706C0F
+5E0260435BA489C68BD56536624B99965B885BFF6388552E53D77626517D852C
+67A268B36B8A62928F9353D482126DD1758F4E668D4E5B70719F85AF669166D9
+7F7287009ECD9F205C5E672F8FF06811675F620D7AD658855EB665706F310000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060555237800D6454887075295E05681362F4971C53CC723D8C016C347761
+7A0E542E77AC987A821C8BF47855671470C165AF64955636601D79C153F84E1D
+6B7B80865BFA55E356DB4F3A4F3C99725DF3677E80386002988290015B8B8BBC
+8BF5641C825864DE55FD82CF91654FD77D20901F7C9F50F358516EAF5BBF8BC9
+80839178849C7B97867D968B968F7EE59AD3788E5C817A57904296A7795F5B59
+635F7B0B84D168AD55067F2974107D2295016240584C4ED65B83597958540000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000736D631E8E4B8E0F80CE82D462AC53F06CF0915E592A60016C70574D644A
+8D2A762B6EE9575B6A8075F06F6D8C2D8C0857666BEF889278B363A253F970AD
+6C645858642A580268E0819B55107CD650188EBA6DCC8D9F70EB638F6D9B6ED4
+7EE68404684390036DD896768BA85957727985E4817E75BC8A8A68AF52548E22
+951163D098988E44557C4F5366FF568F60D56D9552435C4959296DFB586B7530
+751C606C82148146631167618FE2773A8DF38D3494C15E165385542C70C30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006C405EF7505C4EAD5EAD633A8247901A6850916E77B3540C94DC5F647AE5
+687663457B527EDF75DB507762955934900F51F879C37A8156FE5F9290146D82
+5C60571F541051546E4D56E263A89893817F8715892A9000541E5C6F81C062D6
+625881319E3596409A6E9A7C692D59A562D3553E631654C786D96D3C5A0374E6
+889C6B6A59168C4C5F2F6E7E73A9987D4E3870F75B8C7897633D665A769660CB
+5B9B5A494E0781556C6A738B4EA167897F515F8065FA671B5FD859845A010000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005DCD5FAE537197E68FDD684556F4552F60DF4E3A6F4D7EF482C7840E59D4
+4F1F4F2A5C3E7EAC672A851A5473754F80C355829B4F4F4D6E2D8C135C096170
+536B761F6E29868A658795FB7EB9543B7A337D0A95EE55E17FC174EE631D8717
+6DA17A9D621165A1536763E16C835DEB545C94A84E4C6C618BEC5C4B65E0829C
+68A7543E54346BCB6B664E9463425348821E4F0D4FAE575E620A96FE66647269
+52FF52A1609F8BEF661471996790897F785277FD6670563B54389521727A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A00606F5E0C6089819D591560DC718470EF6EAA6C5072806A8488AD5E2D
+4E605AB3559C94E36D177CFB9699620F7EC6778E867E5323971E8F9666875CE1
+4FA072ED4E0B53A6590F54136380952851484ED99C9C7EA454B88D2488548237
+95F26D8E5F265ACC663E966973B0732E53BF817A99857FA15BAA967796507EBF
+76F853A2957699997BB189446E584E617FD479658BE660F354CD4EAB98795DF7
+6A6150CF54118C618427785D9704524A54EE56A395006D885BB56DC666530000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C0F5B5D6821809655787B11654869544E9B6B47874E978B534F631F643A
+90AA659C80C18C10519968B0537887F961C86CC46CFB8C225C5185AA82AF950C
+6B238F9B65B05FFB5FC34FE18845661F8165732960FA51745211578B5F6290A2
+884C91925E78674F602759D3514451F680F853086C7996C4718A4F114FEE7F9E
+673D55C5950879C088967EE3589F620C9700865A5618987B5F908BB884C49157
+53D965ED5E8F755C60647D6E5A7F7EEA7EED8F6955A75BA360AC65CB73840000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+51
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009009766377297EDA9774859B5B667A7496EA884052CB718F5FAA65EC8BE2
+5BFB9A6F5DE16B896C5B8BAD8BAF900A8FC5538B62BC9E269E2D54404E2B82BD
+7259869C5D1688596DAF96C554D14E9A8BB6710954BD960970DF6DF976D04E25
+781487125CA95EF68A00989C960E708E6CBF594463A9773C884D6F1482735830
+71D5538C781A96C155015F6671305BB48C1A9A8C6B83592E9E2F79E76768626C
+4F6F75A17F8A6D0B96336C274EF075D2517B68376F3E90808170599674760000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+52
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000064475C2790657A918C2359DA54AC8200836F898180006930564E80367237
+91CE51B64E5F987563964E1A53F666F3814B591C6DB24E0058F9533B63D694F1
+4F9D4F0A886398905937905779FB4EEA80F075916C825B9C59E85F5D69058681
+501A5DF24E5977E34EE5827A6291661390915C794EBF5F7981C69038808475AB
+4EA688D4610F6BC55FC64E4976CA6EA28BE38BAE8C0A8BD15F027FFC7FCC7ECE
+8335836B56E06BB797F3963459FB541F94F66DEB5BC5996E5C395F1596900000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000537082F16A315A749E705E947F2883B984248425836787478FCE8D6276C8
+5F719896786C662054DF62E54F6381C375C85EB896CD8E0A86F9548F6CF36D8C
+6C38607F52C775285E7D4F1860A05FE75C24753190AE94C072B96CB96E389149
+670953CB53F34F5191C98BF153C85E7C8FC26DE44E8E76C26986865E611A8206
+4F594FDE903E9C7C61096E1D6E1496854E885A3196E84E0E5C7F79B95B878BED
+7FBD738957DF828B90C15401904755BB5CEA5FA161086B3272F180B28A890000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D745BD388D598848C6B9A6D9E336E0A51A4514357A38881539F63F48F95
+56ED54585706733F6E907F188FDC82D1613F6028966266F07EA68D8A8DC394A5
+5CB37CA4670860A6960580184E9190E75300966851418FD08574915D665597F5
+5B55531D78386742683D54C9707E5BB08F7D518D572854B1651266828D5E8D43
+810F846C906D7CDF51FF85FB67A365E96FA186A48E81566A90207682707671E5
+8D2362E952196CFD8D3C600E589E618E66FE8D60624E55B36E23672D8F670000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+55
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000094E195F87728680569A8548B4E4D70B88BC86458658B5B857A84503A5BE8
+77BB6BE18A797C986CBE76CF65A98F975D2D5C5586386808536062187AD96E5B
+7EFD6A1F7AE05F706F335F20638C6DA867564E085E108D264ED780C07634969C
+62DB662D627E6CBC8D7571677F695146808753EC906E629854F286F08F998005
+951785178FD96D5973CD659F771F7504782781FB8D1E94884FA6679575B98BCA
+9707632F9547963584B8632377415F8172F04E896014657462EF6B63653F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+56
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005E2775C790D18BC1829D679D652F5431871877E580A281026C414E4B7EC7
+804C76F4690D6B966267503C4F84574063076B628DBE53EA65E87EB85FD7631A
+63B781F381F47F6E5E1C5CD95236667A79E97A1A8D28709975D46EDE6CBB7A92
+4E2D76C55FE0949F88777EC879CD80BF91CD4EF24F17821F54685DDE6D328BCC
+7CA58F7480985E1A549276B15B99663C9AA473E0682A86DB6731732A8BF88BDB
+90107AF970DB716E62C477A956314E3B845767F152A986C08D2E94F87B510000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+57
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F4F6CE8795D9A7B6293722A62FD4E1378168F6C64B08D5A7BC668695E84
+88C55986649E58EE72B6690E95258FFD8D5857607F008C0651C6634962D95353
+684C74228301914C55447740707C6D4A517954A88D4459FF6ECB6DC45B5C7D2B
+4ED47C7D6ED35B5081EA6E0D5B579B0368D58E2A5B977EFC603B7EB590B98D70
+594F63CD79DF8DB3535265CF79568BC5963B7EC494BB7E825634918967007F6A
+5C0A907566285DE64F5067DE505A4F5C57505EA7000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+58
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E8D4E0C51404E105EFF53454E154E984E1E9B325B6C56694E2879BA4E3F
+53154E47592D723B536E6C1056DF80E499976BD3777E9F174E364E9F9F104E5C
+4E694E9382885B5B556C560F4EC4538D539D53A353A553AE97658D5D531A53F5
+5326532E533E8D5C5366536352025208520E522D5233523F5240524C525E5261
+525C84AF527D528252815290529351827F544EBB4EC34EC94EC24EE84EE14EEB
+4EDE4F1B4EF34F224F644EF54F254F274F094F2B4F5E4F6765384F5A4F5D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F5F4F574F324F3D4F764F744F914F894F834F8F4F7E4F7B4FAA4F7C4FAC
+4F944FE64FE84FEA4FC54FDA4FE34FDC4FD14FDF4FF85029504C4FF3502C500F
+502E502D4FFE501C500C50255028507E504350555048504E506C507B50A550A7
+50A950BA50D6510650ED50EC50E650EE5107510B4EDD6C3D4F584F654FCE9FA0
+6C467C74516E5DFD9EC999985181591452F9530D8A07531051EB591951554EA0
+51564EB3886E88A44EB5811488D279805B3488037FB851AB51B151BD51BC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000051C7519651A251A58BA08BA68BA78BAA8BB48BB58BB78BC28BC38BCB8BCF
+8BCE8BD28BD38BD48BD68BD88BD98BDC8BDF8BE08BE48BE88BE98BEE8BF08BF3
+8BF68BF98BFC8BFF8C008C028C048C078C0C8C0F8C118C128C148C158C168C19
+8C1B8C188C1D8C1F8C208C218C258C278C2A8C2B8C2E8C2F8C328C338C358C36
+5369537A961D962296219631962A963D963C964296499654965F9667966C9672
+96749688968D969796B09097909B909D909990AC90A190B490B390B690BA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090B890B090CF90C590BE90D090C490C790D390E690E290DC90D790DB90EB
+90EF90FE91049122911E91239131912F913991439146520D594252A252AC52AD
+52BE54FF52D052D652F053DF71EE77CD5EF451F551FC9B2F53B65F01755A5DEF
+574C57A957A1587E58BC58C558D15729572C572A57335739572E572F575C573B
+574257695785576B5786577C577B5768576D5776577357AD57A4578C57B257CF
+57A757B4579357A057D557D857DA57D957D257B857F457EF57F857E457DD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000580B580D57FD57ED5800581E5819584458205865586C58815889589A5880
+99A89F1961FF8279827D827F828F828A82A88284828E82918297829982AB82B8
+82BE82B082C882CA82E3829882B782AE82CB82CC82C182A982B482A182AA829F
+82C482CE82A482E1830982F782E4830F830782DC82F482D282D8830C82FB82D3
+8311831A83068314831582E082D5831C8351835B835C83088392833C83348331
+839B835E832F834F83478343835F834083178360832D833A8333836683650000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008368831B8369836C836A836D836E83B0837883B383B483A083AA8393839C
+8385837C83B683A9837D83B8837B8398839E83A883BA83BC83C1840183E583D8
+58078418840B83DD83FD83D6841C84388411840683D483DF840F840383F883F9
+83EA83C583C0842683F083E1845C8451845A8459847384878488847A84898478
+843C844684698476848C848E8431846D84C184CD84D084E684BD84D384CA84BF
+84BA84E084A184B984B4849784E584E3850C750D853884F08539851F853A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008556853B84FF84FC8559854885688564855E857A77A285438572857B85A4
+85A88587858F857985AE859C858585B985B785B085D385C185DC85FF86278605
+86298616863C5EFE5F08593C594180375955595A5958530F5C225C255C2C5C34
+624C626A629F62BB62CA62DA62D762EE632262F66339634B634363AD63F66371
+637A638E63B4636D63AC638A636963AE63BC63F263F863E063FF63C463DE63CE
+645263C663BE64456441640B641B6420640C64266421645E6484646D64960000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000647A64B764B8649964BA64C064D064D764E464E265096525652E5F0B5FD2
+75195F11535F53F153FD53E953E853FB541254165406544B5452545354545456
+54435421545754595423543254825494547754715464549A549B548454765466
+549D54D054AD54C254B454D254A754A654D354D4547254A354D554BB54BF54CC
+54D954DA54DC54A954AA54A454DD54CF54DE551B54E7552054FD551454F35522
+5523550F55115527552A5567558F55B55549556D55415555553F5550553C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+60
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005537555655755576557755335530555C558B55D2558355B155B955885581
+559F557E55D65591557B55DF55BD55BE5594559955EA55F755C9561F55D155EB
+55EC55D455E655DD55C455EF55E555F255F355CC55CD55E855F555E48F94561E
+5608560C56015624562355FE56005627562D565856395657562C564D56625659
+565C564C5654568656645671566B567B567C5685569356AF56D456D756DD56E1
+56F556EB56F956FF5704570A5709571C5E0F5E195E145E115E315E3B5E3C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+61
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005E375E445E545E5B5E5E5E615C8C5C7A5C8D5C905C965C885C985C995C91
+5C9A5C9C5CB55CA25CBD5CAC5CAB5CB15CA35CC15CB75CC45CD25CE45CCB5CE5
+5D025D035D275D265D2E5D245D1E5D065D1B5D585D3E5D345D3D5D6C5D5B5D6F
+5D5D5D6B5D4B5D4A5D695D745D825D995D9D8C735DB75DC55F735F775F825F87
+5F895F8C5F955F995F9C5FA85FAD5FB55FBC88625F6172AD72B072B472B772B8
+72C372C172CE72CD72D272E872EF72E972F272F472F7730172F3730372FA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000072FB731773137321730A731E731D7315732273397325732C733873317350
+734D73577360736C736F737E821B592598E7592459029963996799689969996A
+996B996C99749977997D998099849987998A998D999099919993999499955E80
+5E915E8B5E965EA55EA05EB95EB55EBE5EB38D535ED25ED15EDB5EE85EEA81BA
+5FC45FC95FD65FCF60035FEE60045FE15FE45FFE600560065FEA5FED5FF86019
+60356026601B600F600D6029602B600A603F602160786079607B607A60420000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000606A607D6096609A60AD609D60836092608C609B60EC60BB60B160DD60D8
+60C660DA60B4612061266115612360F46100610E612B614A617561AC619461A7
+61B761D461F55FDD96B395E995EB95F195F395F595F695FC95FE960396049606
+9608960A960B960C960D960F96129615961696179619961A4E2C723F62156C35
+6C546C5C6C4A6CA36C856C906C946C8C6C686C696C746C766C866CA96CD06CD4
+6CAD6CF76CF86CF16CD76CB26CE06CD66CFA6CEB6CEE6CB16CD36CEF6CFE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+64
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006D396D276D0C6D436D486D076D046D196D0E6D2B6D4D6D2E6D356D1A6D4F
+6D526D546D336D916D6F6D9E6DA06D5E6D936D946D5C6D606D7C6D636E1A6DC7
+6DC56DDE6E0E6DBF6DE06E116DE66DDD6DD96E166DAB6E0C6DAE6E2B6E6E6E4E
+6E6B6EB26E5F6E866E536E546E326E256E446EDF6EB16E986EE06F2D6EE26EA5
+6EA76EBD6EBB6EB76ED76EB46ECF6E8F6EC26E9F6F626F466F476F246F156EF9
+6F2F6F366F4B6F746F2A6F096F296F896F8D6F8C6F786F726F7C6F7A6FD10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+65
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006FC96FA76FB96FB66FC26FE16FEE6FDE6FE06FEF701A7023701B70397035
+704F705E5B805B845B955B935BA55BB8752F9A9E64345BE45BEE89305BF08E47
+8B078FB68FD38FD58FE58FEE8FE48FE98FE68FF38FE890059004900B90269011
+900D9016902190359036902D902F9044905190529050906890589062905B66B9
+9074907D908290889083908B5F505F575F565F585C3B54AB5C505C595B715C63
+5C667FBC5F2A5F295F2D82745F3C9B3B5C6E59815983598D59A959AA59A30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+66
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000599759CA59AB599E59A459D259B259AF59D759BE5A055A0659DD5A0859E3
+59D859F95A0C5A095A325A345A115A235A135A405A675A4A5A555A3C5A625A75
+80EC5AAA5A9B5A775A7A5ABE5AEB5AB25AD25AD45AB85AE05AE35AF15AD65AE6
+5AD85ADC5B095B175B165B325B375B405C155C1C5B5A5B655B735B515B535B62
+9A759A779A789A7A9A7F9A7D9A809A819A859A889A8A9A909A929A939A969A98
+9A9B9A9C9A9D9A9F9AA09AA29AA39AA59AA77E9F7EA17EA37EA57EA87EA90000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007EAD7EB07EBE7EC07EC17EC27EC97ECB7ECC7ED07ED47ED77EDB7EE07EE1
+7EE87EEB7EEE7EEF7EF17EF27F0D7EF67EFA7EFB7EFE7F017F027F037F077F08
+7F0B7F0C7F0F7F117F127F177F197F1C7F1B7F1F7F217F227F237F247F257F26
+7F277F2A7F2B7F2C7F2D7F2F7F307F317F327F337F355E7A757F5DDB753E9095
+738E739173AE73A2739F73CF73C273D173B773B373C073C973C873E573D9987C
+740A73E973E773DE73BA73F2740F742A745B7426742574287430742E742C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+68
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000741B741A7441745C7457745574597477746D747E749C748E748074817487
+748B749E74A874A9749074A774D274BA97EA97EB97EC674C6753675E67486769
+67A56787676A6773679867A7677567A8679E67AD678B6777677C67F0680967D8
+680A67E967B0680C67D967B567DA67B367DD680067C367B867E2680E67C167FD
+6832683368606861684E6862684468646883681D68556866684168676840683E
+684A6849682968B5688F687468776893686B68C2696E68FC691F692068F90000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+69
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000692468F0690B6901695768E369106971693969606942695D6984696B6980
+69986978693469CC6987698869CE6989696669636979699B69A769BB69AB69AD
+69D469B169C169CA69DF699569E0698D69FF6A2F69ED6A176A186A6569F26A44
+6A3E6AA06A506A5B6A356A8E6A796A3D6A286A586A7C6A916A906AA96A976AAB
+733773526B816B826B876B846B926B936B8D6B9A6B9B6BA16BAA8F6B8F6D8F71
+8F728F738F758F768F788F778F798F7A8F7C8F7E8F818F828F848F878F8B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008F8D8F8E8F8F8F988F9A8ECE620B6217621B621F6222622162256224622C
+81E774EF74F474FF750F75117513653465EE65EF65F0660A6619677266036615
+6600708566F7661D66346631663666358006665F66546641664F665666616657
+66776684668C66A7669D66BE66DB66DC66E666E98D328D338D368D3B8D3D8D40
+8D458D468D488D498D478D4D8D558D5989C789CA89CB89CC89CE89CF89D089D1
+726E729F725D7266726F727E727F7284728B728D728F72926308633263B00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000643F64D880046BEA6BF36BFD6BF56BF96C056C076C066C0D6C156C186C19
+6C1A6C216C296C246C2A6C3265356555656B724D72527256723086625216809F
+809C809380BC670A80BD80B180AB80AD80B480B780E780E880E980EA80DB80C2
+80C480D980CD80D7671080DD80EB80F180F480ED810D810E80F280FC67158112
+8C5A8136811E812C811881328148814C815381748159815A817181608169817C
+817D816D8167584D5AB58188818281916ED581A381AA81CC672681CA81BB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081C181A66B246B376B396B436B466B5998D198D298D398D598D998DA6BB3
+5F406BC289F365909F51659365BC65C665C465C365CC65CE65D265D67080709C
+7096709D70BB70C070B770AB70B170E870CA711071137116712F71317173715C
+716871457172714A7178717A719871B371B571A871A071E071D471E771F9721D
+7228706C7118716671B9623E623D624362486249793B794079467949795B795C
+7953795A796279577960796F7967797A7985798A799A79A779B35FD15FD00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000603C605D605A606760416059606360AB6106610D615D61A9619D61CB61D1
+62068080807F6C936CF66DFC77F677F87800780978177818781165AB782D781C
+781D7839783A783B781F783C7825782C78237829784E786D7856785778267850
+7847784C786A789B7893789A7887789C78A178A378B278B978A578D478D978C9
+78EC78F2790578F479137924791E79349F9B9EF99EFB9EFC76F17704770D76F9
+77077708771A77227719772D7726773577387750775177477743775A77680000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077627765777F778D777D7780778C7791779F77A077B077B577BD753A7540
+754E754B7548755B7572757975837F587F617F5F8A487F687F747F717F797F81
+7F7E76CD76E58832948594869487948B948A948C948D948F9490949494979495
+949A949B949C94A394A494AB94AA94AD94AC94AF94B094B294B494B694B794B8
+94B994BA94BC94BD94BF94C494C894C994CA94CB94CC94CD94CE94D094D194D2
+94D594D694D794D994D894DB94DE94DF94E094E294E494E594E794E894EA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000094E994EB94EE94EF94F394F494F594F794F994FC94FD94FF950395029506
+95079509950A950D950E950F951295139514951595169518951B951D951E951F
+9522952A952B9529952C953195329534953695379538953C953E953F95429535
+9544954595469549954C954E954F9552955395549556955795589559955B955E
+955F955D95619562956495659566956795689569956A956B956C956F95719572
+9573953A77E777EC96C979D579ED79E379EB7A065D477A037A027A1E7A140000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+70
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A397A377A519ECF99A57A707688768E7693769976A474DE74E0752C9E20
+9E229E289E299E2A9E2B9E2C9E329E319E369E389E379E399E3A9E3E9E419E42
+9E449E469E479E489E499E4B9E4C9E4E9E519E559E579E5A9E5B9E5C9E5E9E63
+9E669E679E689E699E6A9E6B9E6C9E719E6D9E7375927594759675A0759D75AC
+75A375B375B475B875C475B175B075C375C275D675CD75E375E875E675E475EB
+75E7760375F175FC75FF761076007605760C7617760A76257618761576190000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+71
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000761B763C762276207640762D7630763F76357643763E7633764D765E7654
+765C7656766B766F7FCA7AE67A787A797A807A867A887A957AA67AA07AAC7AA8
+7AAD7AB3886488698872887D887F888288A288C688B788BC88C988E288CE88E3
+88E588F1891A88FC88E888FE88F0892189198913891B890A8934892B89368941
+8966897B758B80E576B276B477DC801280148016801C80208022802580268027
+802980288031800B803580438046804D80528069807189839878988098830000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+72
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009889988C988D988F9894989A989B989E989F98A198A298A598A6864D8654
+866C866E867F867A867C867B86A8868D868B86AC869D86A786A386AA869386A9
+86B686C486B586CE86B086BA86B186AF86C986CF86B486E986F186F286ED86F3
+86D0871386DE86F486DF86D886D18703870786F88708870A870D87098723873B
+871E8725872E871A873E87488734873187298737873F87828722877D877E877B
+87608770874C876E878B87538763877C876487598765879387AF87A887D20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+73
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000087C68788878587AD8797878387AB87E587AC87B587B387CB87D387BD87D1
+87C087CA87DB87EA87E087EE8816881387FE880A881B88218839883C7F367F42
+7F447F4582107AFA7AFD7B087B037B047B157B0A7B2B7B0F7B477B387B2A7B19
+7B2E7B317B207B257B247B337B3E7B1E7B587B5A7B457B757B4C7B5D7B607B6E
+7B7B7B627B727B717B907BA67BA77BB87BAC7B9D7BA87B857BAA7B9C7BA27BAB
+7BB47BD17BC17BCC7BDD7BDA7BE57BE67BEA7C0C7BFE7BFC7C0F7C167C0B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007C1F7C2A7C267C387C417C4081FE82018202820481EC8844822182228223
+822D822F8228822B8238823B82338234823E82448249824B824F825A825F8268
+887E8885888888D888DF895E7F9D7F9F7FA77FAF7FB07FB27C7C65497C917C9D
+7C9C7C9E7CA27CB27CBC7CBD7CC17CC77CCC7CCD7CC87CC57CD77CE8826E66A8
+7FBF7FCE7FD57FE57FE17FE67FE97FEE7FF37CF87D777DA67DAE7E477E9B9EB8
+9EB48D738D848D948D918DB18D678D6D8C478C49914A9150914E914F91640000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+75
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009162916191709169916F917D917E917291749179918C91859190918D9191
+91A291A391AA91AD91AE91AF91B591B491BA8C559E7E8DB88DEB8E058E598E69
+8DB58DBF8DBC8DBA8DC48DD68DD78DDA8DDE8DCE8DCF8DDB8DC68DEC8DF78DF8
+8DE38DF98DFB8DE48E098DFD8E148E1D8E1F8E2C8E2E8E238E2F8E3A8E408E39
+8E358E3D8E318E498E418E428E518E528E4A8E708E768E7C8E6F8E748E858E8F
+8E948E908E9C8E9E8C788C828C8A8C858C988C94659B89D689DE89DA89DC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+76
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000089E589EB89EF8A3E8B26975396E996F396EF970697019708970F970E972A
+972D9730973E9F809F839F859F869F879F889F899F8A9F8C9EFE9F0B9F0D96B9
+96BC96BD96CE96D277BF96E0928E92AE92C8933E936A93CA938F943E946B9C7F
+9C829C859C869C879C887A239C8B9C8E9C909C919C929C949C959C9A9C9B9C9E
+9C9F9CA09CA19CA29CA39CA59CA69CA79CA89CA99CAB9CAD9CAE9CB09CB19CB2
+9CB39CB49CB59CB69CB79CBA9CBB9CBC9CBD9CC49CC59CC69CC79CCA9CCB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+77
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009CCC9CCD9CCE9CCF9CD09CD39CD49CD59CD79CD89CD99CDC9CDD9CDF9CE2
+977C978597919792979497AF97AB97A397B297B49AB19AB09AB79E589AB69ABA
+9ABC9AC19AC09AC59AC29ACB9ACC9AD19B459B439B479B499B489B4D9B5198E8
+990D992E995599549ADF9AE19AE69AEF9AEB9AFB9AED9AF99B089B0F9B139B1F
+9B239EBD9EBE7E3B9E829E879E889E8B9E9293D69E9D9E9F9EDB9EDC9EDD9EE0
+9EDF9EE29EE99EE79EE59EEA9EEF9F229F2C9F2F9F399F379F3D9F3E9F440000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/iso2022-jp.enc b/tcl/library/encoding/iso2022-jp.enc
new file mode 100644
index 00000000000..a4e455f3ba9
--- /dev/null
+++ b/tcl/library/encoding/iso2022-jp.enc
@@ -0,0 +1,12 @@
+# Encoding file: iso2022-jp, escape-driven
+E
+name iso2022-jp
+init {}
+final {}
+iso8859-1 \x1b(B
+jis0201 \x1b(J
+jis0208 \x1b$@
+jis0208 \x1b$B
+jis0212 \x1b$(D
+gb2312 \x1b$A
+ksc5601 \x1b$(C
diff --git a/tcl/library/encoding/iso2022-kr.enc b/tcl/library/encoding/iso2022-kr.enc
new file mode 100644
index 00000000000..d20ce2bc126
--- /dev/null
+++ b/tcl/library/encoding/iso2022-kr.enc
@@ -0,0 +1,7 @@
+# Encoding file: iso2022-kr, escape-driven
+E
+name iso2022-kr
+init \x1b$)C
+final {}
+iso8859-1 \x0f
+ksc5601 \x0e
diff --git a/tcl/library/encoding/iso2022.enc b/tcl/library/encoding/iso2022.enc
new file mode 100644
index 00000000000..ae7cde15fee
--- /dev/null
+++ b/tcl/library/encoding/iso2022.enc
@@ -0,0 +1,16 @@
+# Encoding file: iso2022, escape-driven
+E
+name iso2022
+init {}
+final {}
+iso8859-1 \x1b(B
+jis0201 \x1b(J
+gb1988 \x1b(T
+jis0208 \x1b$@
+jis0208 \x1b$B
+jis0212 \x1b$(D
+gb2312 \x1b$A
+ksc5601 \x1b$(C
+jis0208 \x1b&@\x1b$B
+
+
diff --git a/tcl/library/encoding/iso8859-1.enc b/tcl/library/encoding/iso8859-1.enc
new file mode 100644
index 00000000000..045d8fa28b4
--- /dev/null
+++ b/tcl/library/encoding/iso8859-1.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-1, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
+00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
+00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
+00D000D100D200D300D400D500D600D700D800D900DA00DB00DC00DD00DE00DF
+00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
+00F000F100F200F300F400F500F600F700F800F900FA00FB00FC00FD00FE00FF
diff --git a/tcl/library/encoding/iso8859-2.enc b/tcl/library/encoding/iso8859-2.enc
new file mode 100644
index 00000000000..16faab66ed7
--- /dev/null
+++ b/tcl/library/encoding/iso8859-2.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-2, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A0010402D8014100A4013D015A00A700A80160015E0164017900AD017D017B
+00B0010502DB014200B4013E015B02C700B80161015F0165017A02DD017E017C
+015400C100C2010200C40139010600C7010C00C9011800CB011A00CD00CE010E
+01100143014700D300D4015000D600D70158016E00DA017000DC00DD016200DF
+015500E100E2010300E4013A010700E7010D00E9011900EB011B00ED00EE010F
+01110144014800F300F4015100F600F70159016F00FA017100FC00FD016302D9
diff --git a/tcl/library/encoding/iso8859-3.enc b/tcl/library/encoding/iso8859-3.enc
new file mode 100644
index 00000000000..c914bce7af3
--- /dev/null
+++ b/tcl/library/encoding/iso8859-3.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-3, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A0012602D800A300A40000012400A700A80130015E011E013400AD0000017B
+00B0012700B200B300B400B5012500B700B80131015F011F013500BD0000017C
+00C000C100C2000000C4010A010800C700C800C900CA00CB00CC00CD00CE00CF
+000000D100D200D300D4012000D600D7011C00D900DA00DB00DC016C015C00DF
+00E000E100E2000000E4010B010900E700E800E900EA00EB00EC00ED00EE00EF
+000000F100F200F300F4012100F600F7011D00F900FA00FB00FC016D015D02D9
diff --git a/tcl/library/encoding/iso8859-4.enc b/tcl/library/encoding/iso8859-4.enc
new file mode 100644
index 00000000000..ef5c5a99825
--- /dev/null
+++ b/tcl/library/encoding/iso8859-4.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-4, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A001040138015600A40128013B00A700A8016001120122016600AD017D00AF
+00B0010502DB015700B40129013C02C700B80161011301230167014A017E014B
+010000C100C200C300C400C500C6012E010C00C9011800CB011600CD00CE012A
+01100145014C013600D400D500D600D700D8017200DA00DB00DC0168016A00DF
+010100E100E200E300E400E500E6012F010D00E9011900EB011700ED00EE012B
+01110146014D013700F400F500F600F700F8017300FA00FB00FC0169016B02D9
diff --git a/tcl/library/encoding/iso8859-5.enc b/tcl/library/encoding/iso8859-5.enc
new file mode 100644
index 00000000000..bf4ee82b662
--- /dev/null
+++ b/tcl/library/encoding/iso8859-5.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-5, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A0040104020403040404050406040704080409040A040B040C00AD040E040F
+0410041104120413041404150416041704180419041A041B041C041D041E041F
+0420042104220423042404250426042704280429042A042B042C042D042E042F
+0430043104320433043404350436043704380439043A043B043C043D043E043F
+0440044104420443044404450446044704480449044A044B044C044D044E044F
+2116045104520453045404550456045704580459045A045B045C00A7045E045F
diff --git a/tcl/library/encoding/iso8859-6.enc b/tcl/library/encoding/iso8859-6.enc
new file mode 100644
index 00000000000..6510af74070
--- /dev/null
+++ b/tcl/library/encoding/iso8859-6.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-6, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0660066106620663066406650666066706680669003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A000000000000000A40000000000000000000000000000060C00AD00000000
+00000000000000000000000000000000000000000000061B000000000000061F
+0000062106220623062406250626062706280629062A062B062C062D062E062F
+0630063106320633063406350636063706380639063A00000000000000000000
+0640064106420643064406450646064706480649064A064B064C064D064E064F
+0650065106520000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/iso8859-7.enc b/tcl/library/encoding/iso8859-7.enc
new file mode 100644
index 00000000000..2cb69a25c99
--- /dev/null
+++ b/tcl/library/encoding/iso8859-7.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-7, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A002BD02BC00A30000000000A600A700A800A9000000AB00AC00AD00002015
+00B000B100B200B303840385038600B703880389038A00BB038C00BD038E038F
+0390039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A1000003A303A403A503A603A703A803A903AA03AB03AC03AD03AE03AF
+03B003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C203C303C403C503C603C703C803C903CA03CB03CC03CD03CE0000
diff --git a/tcl/library/encoding/iso8859-8.enc b/tcl/library/encoding/iso8859-8.enc
new file mode 100644
index 00000000000..6b424d57d9f
--- /dev/null
+++ b/tcl/library/encoding/iso8859-8.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-8, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A0000000A200A300A400A500A600A700A800A900D700AB00AC00AD00AE203E
+00B000B100B200B300B400B500B600B700B800B900F700BB00BC00BD00BE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000002017
+05D005D105D205D305D405D505D605D705D805D905DA05DB05DC05DD05DE05DF
+05E005E105E205E305E405E505E605E705E805E905EA00000000000000000000
diff --git a/tcl/library/encoding/iso8859-9.enc b/tcl/library/encoding/iso8859-9.enc
new file mode 100644
index 00000000000..6eed3f1a871
--- /dev/null
+++ b/tcl/library/encoding/iso8859-9.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-9, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
+00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
+00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
+011E00D100D200D300D400D500D600D700D800D900DA00DB00DC0130015E00DF
+00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
+011F00F100F200F300F400F500F600F700F800F900FA00FB00FC0131015F00FF
diff --git a/tcl/library/encoding/jis0201.enc b/tcl/library/encoding/jis0201.enc
new file mode 100644
index 00000000000..64f423f1620
--- /dev/null
+++ b/tcl/library/encoding/jis0201.enc
@@ -0,0 +1,20 @@
+# Encoding file: jis0201, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D203E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/jis0208.enc b/tcl/library/encoding/jis0208.enc
new file mode 100644
index 00000000000..7102e8855fd
--- /dev/null
+++ b/tcl/library/encoding/jis0208.enc
@@ -0,0 +1,1312 @@
+# Encoding file: jis0208, double-byte
+D
+2129 0 77
+21
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000300030013002FF0CFF0E30FBFF1AFF1BFF1FFF01309B309C00B4FF4000A8
+FF3EFFE3FF3F30FD30FE309D309E30034EDD30053006300730FC20152010FF0F
+FF3C301C2016FF5C2026202520182019201C201DFF08FF0930143015FF3BFF3D
+FF5BFF5D30083009300A300B300C300D300E300F30103011FF0B221200B100D7
+00F7FF1D2260FF1CFF1E22662267221E22342642264000B0203220332103FFE5
+FF0400A200A3FF05FF03FF06FF0AFF2000A72606260525CB25CF25CE25C70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+22
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000025C625A125A025B325B225BD25BC203B3012219221902191219330130000
+00000000000000000000000000000000000000002208220B2286228722822283
+222A2229000000000000000000000000000000002227222800AC21D221D42200
+220300000000000000000000000000000000000000000000222022A523122202
+220722612252226A226B221A223D221D2235222B222C00000000000000000000
+00000000212B2030266F266D266A2020202100B6000000000000000025EF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+23
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19000000000000000000000000
+0000FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3A00000000000000000000
+0000FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5A00000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+24
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+25
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+26
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+27
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000004100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+28
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000025002502250C251025182514251C252C25242534253C25012503250F2513
+251B251725232533252B253B254B2520252F25282537253F251D253025252538
+2542000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E9C55165A03963F54C0611B632859F690228475831C7A5060AA63E16E25
+65ED846682A69BF56893572765A162715B9B59D0867B98F47D627DBE9B8E6216
+7C9F88B75B895EB563096697684895C7978D674F4EE54F0A4F4D4F9D504956F2
+593759D45A015C0960DF610F61706613690570BA754F757079FB7DAD7DEF80C3
+840E88638B029055907A533B4E954EA557DF80B290C178EF4E0058F16EA29038
+7A328328828B9C2F5141537054BD54E156E059FB5F1598F26DEB80E4852D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+31
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009662967096A097FB540B53F35B8770CF7FBD8FC296E8536F9D5C7ABA4E11
+789381FC6E26561855046B1D851A9C3B59E553A96D6674DC958F56424E91904B
+96F2834F990C53E155B65B305F71662066F368046C386CF36D29745B76C87A4E
+983482F1885B8A6092ED6DB275AB76CA99C560A68B018D8A95B2698E53AD5186
+5712583059445BB45EF6602863A963F46CBF6F14708E7114715971D5733F7E01
+827682D185979060925B9D1B586965BC6C5A752551F9592E59655F805FDC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+32
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000062BC65FA6A2A6B276BB4738B7FC189569D2C9D0E9EC45CA16C96837B5104
+5C4B61B681C6687672614E594FFA537860696E297A4F97F34E0B53164EEE4F55
+4F3D4FA14F7352A053EF5609590F5AC15BB65BE179D16687679C67B66B4C6CB3
+706B73C2798D79BE7A3C7B8782B182DB8304837783EF83D387668AB256298CA8
+8FE6904E971E868A4FC45CE862117259753B81E582BD86FE8CC096C5991399D5
+4ECB4F1A89E356DE584A58CA5EFB5FEB602A6094606261D0621262D065390000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+33
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009B41666668B06D777070754C76867D7582A587F9958B968E8C9D51F152BE
+591654B35BB35D16616869826DAF788D84CB88578A7293A79AB86D6C99A886D9
+57A367FF86CE920E5283568754045ED362E164B9683C68386BBB737278BA7A6B
+899A89D28D6B8F0390ED95A3969497695B665CB3697D984D984E639B7B206A2B
+6A7F68B69C0D6F5F5272559D607062EC6D3B6E076ED1845B89108F444E149C39
+53F6691B6A3A9784682A515C7AC384B291DC938C565B9D286822830584310000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+34
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007CA5520882C574E64E7E4F8351A05BD2520A52D852E75DFB559A582A59E6
+5B8C5B985BDB5E725E7960A3611F616361BE63DB656267D1685368FA6B3E6B53
+6C576F226F976F4574B0751876E3770B7AFF7BA17C217DE97F367FF0809D8266
+839E89B38ACC8CAB908494519593959195A2966597D3992882184E38542B5CB8
+5DCC73A9764C773C5CA97FEB8D0B96C19811985498584F014F0E5371559C5668
+57FA59475B095BC45C905E0C5E7E5FCC63EE673A65D765E2671F68CB68C40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+35
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006A5F5E306BC56C176C7D757F79485B637A007D005FBD898F8A188CB48D77
+8ECC8F1D98E29A0E9B3C4E80507D510059935B9C622F628064EC6B3A72A07591
+79477FA987FB8ABC8B7063AC83CA97A05409540355AB68546A588A7078276775
+9ECD53745BA2811A865090064E184E454EC74F1153CA54385BAE5F1360256551
+673D6C426C726CE3707874037A767AAE7B087D1A7CFE7D6665E7725B53BB5C45
+5DE862D262E063196E20865A8A318DDD92F86F0179A69B5A4EA84EAB4EAC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+36
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F9B4FA050D151477AF6517151F653545321537F53EB55AC58835CE15F37
+5F4A602F6050606D631F65596A4B6CC172C272ED77EF80F881058208854E90F7
+93E197FF99579A5A4EF051DD5C2D6681696D5C4066F26975738968507C8150C5
+52E457475DFE932665A46B236B3D7434798179BD7B4B7DCA82B983CC887F895F
+8B398FD191D1541F92804E5D503653E5533A72D7739677E982E68EAF99C699C8
+99D25177611A865E55B07A7A50765BD3904796854E326ADB91E75C515C480000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+37
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000063987A9F6C9397748F617AAA718A96887C8268177E706851936C52F2541B
+85AB8A137FA48ECD90E15366888879414FC250BE521151445553572D73EA578B
+59515F625F8460756176616761A963B2643A656C666F68426E1375667A3D7CFB
+7D4C7D997E4B7F6B830E834A86CD8A088A638B668EFD981A9D8F82B88FCE9BE8
+5287621F64836FC09699684150916B206C7A6F547A747D5088408A2367084EF6
+503950265065517C5238526355A7570F58055ACC5EFA61B261F862F363720000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+38
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000691C6A29727D72AC732E7814786F7D79770C80A9898B8B198CE28ED29063
+9375967A98559A139E785143539F53B35E7B5F266E1B6E90738473FE7D438237
+8A008AFA96504E4E500B53E4547C56FA59D15B645DF15EAB5F276238654567AF
+6E5672D07CCA88B480A180E183F0864E8A878DE8923796C798679F134E944E92
+4F0D53485449543E5A2F5F8C5FA1609F68A76A8E745A78818A9E8AA48B779190
+4E5E9BC94EA44F7C4FAF501950165149516C529F52B952FE539A53E354110000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+39
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000540E5589575157A2597D5B545B5D5B8F5DE55DE75DF75E785E835E9A5EB7
+5F186052614C629762D863A7653B6602664366F4676D6821689769CB6C5F6D2A
+6D696E2F6E9D75327687786C7A3F7CE07D057D187D5E7DB18015800380AF80B1
+8154818F822A8352884C88618B1B8CA28CFC90CA91759271783F92FC95A4964D
+980599999AD89D3B525B52AB53F7540858D562F76FE08C6A8F5F9EB9514B523B
+544A56FD7A4091779D609ED273446F09817075115FFD60DA9AA872DB8FBC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006B6498034ECA56F0576458BE5A5A606861C7660F6606683968B16DF775D5
+7D3A826E9B424E9B4F5053C955065D6F5DE65DEE67FB6C99747378028A509396
+88DF57505EA7632B50B550AC518D670054C9585E59BB5BB05F69624D63A1683D
+6B736E08707D91C7728078157826796D658E7D3083DC88C18F09969B52645728
+67507F6A8CA151B45742962A583A698A80B454B25D0E57FC78959DFA4F5C524A
+548B643E6628671467F57A847B567D22932F685C9BAD7B395319518A52370000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005BDF62F664AE64E6672D6BBA85A996D176909BD6634C93069BAB76BF6652
+4E09509853C25C7160E864926563685F71E673CA75237B977E8286958B838CDB
+9178991065AC66AB6B8B4ED54ED44F3A4F7F523A53F853F255E356DB58EB59CB
+59C959FF5B505C4D5E025E2B5FD7601D6307652F5B5C65AF65BD65E8679D6B62
+6B7B6C0F7345794979C17CF87D197D2B80A2810281F389968A5E8A698A668A8C
+8AEE8CC78CDC96CC98FC6B6F4E8B4F3C4F8D51505B575BFA6148630166420000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006B216ECB6CBB723E74BD75D478C1793A800C803381EA84948F9E6C509E7F
+5F0F8B589D2B7AFA8EF85B8D96EB4E0353F157F759315AC95BA460896E7F6F06
+75BE8CEA5B9F85007BE0507267F4829D5C61854A7E1E820E51995C0463688D66
+659C716E793E7D1780058B1D8ECA906E86C790AA501F52FA5C3A6753707C7235
+914C91C8932B82E55BC25F3160F94E3B53D65B88624B67316B8A72E973E07A2E
+816B8DA391529996511253D7546A5BFF63886A397DAC970056DA53CE54680000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005B975C315DDE4FEE610162FE6D3279C079CB7D427E4D7FD281ED821F8490
+884689728B908E748F2F9031914B916C96C6919C4EC04F4F514553415F93620E
+67D46C416E0B73637E2691CD928353D459195BBF6DD1795D7E2E7C9B587E719F
+51FA88538FF04FCA5CFB662577AC7AE3821C99FF51C65FAA65EC696F6B896DF3
+6E966F6476FE7D145DE190759187980651E6521D6240669166D96E1A5EB67DD2
+7F7266F885AF85F78AF852A953D959735E8F5F90605592E4966450B7511F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000052DD5320534753EC54E8554655315617596859BE5A3C5BB55C065C0F5C11
+5C1A5E845E8A5EE05F70627F628462DB638C63776607660C662D6676677E68A2
+6A1F6A356CBC6D886E096E58713C7126716775C77701785D7901796579F07AE0
+7B117CA77D39809683D6848B8549885D88F38A1F8A3C8A548A738C618CDE91A4
+9266937E9418969C97984E0A4E084E1E4E575197527057CE583458CC5B225E38
+60C564FE676167566D4472B675737A6384B88B7291B89320563157F498FE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000062ED690D6B9671ED7E548077827289E698DF87558FB15C3B4F384FE14FB5
+55075A205BDD5BE95FC3614E632F65B0664B68EE699B6D786DF1753375B9771F
+795E79E67D3381E382AF85AA89AA8A3A8EAB8F9B903291DD97074EBA4EC15203
+587558EC5C0B751A5C3D814E8A0A8FC59663976D7B258ACF9808916256F353A8
+9017543957825E2563A86C34708A77617C8B7FE088709042915493109318968F
+745E9AC45D075D69657067A28DA896DB636E6749691983C5981796C088FE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+40
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006F84647A5BF84E16702C755D662F51C4523652E259D35F8160276210653F
+6574661F667468F268166B636E057272751F76DB7CBE805658F088FD897F8AA0
+8A938ACB901D91929752975965897A0E810696BB5E2D60DC621A65A566146790
+77F37A4D7C4D7E3E810A8CAC8D648DE18E5F78A9520762D963A5644262988A2D
+7A837BC08AAC96EA7D76820C87494ED95148534353605BA35C025C165DDD6226
+624764B0681368346CC96D456D1767D36F5C714E717D65CB7A7F7BAD7DDA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+41
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007E4A7FA8817A821B823985A68A6E8CCE8DF59078907792AD929195839BAE
+524D55846F387136516879857E5581B37CCE564C58515CA863AA66FE66FD695A
+72D9758F758E790E795679DF7C977D207D4486078A34963B90619F2050E75275
+53CC53E2500955AA58EE594F723D5B8B5C64531D60E360F3635C6383633F63BB
+64CD65E966F95DE369CD69FD6F1571E54E8975E976F87A937CDF7DCF7D9C8061
+83498358846C84BC85FB88C58D709001906D9397971C9A1250CF5897618E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+42
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000081D385358D0890204FC3507452475373606F6349675F6E2C8DB3901F4FD7
+5C5E8CCA65CF7D9A53528896517663C35B585B6B5C0A640D6751905C4ED6591A
+592A6C708A51553E581559A560F0625367C182356955964099C49A284F535806
+5BFE80105CB15E2F5F856020614B623466FF6CF06EDE80CE817F82D4888B8CB8
+9000902E968A9EDB9BDB4EE353F059277B2C918D984C9DF96EDD702753535544
+5B856258629E62D36CA26FEF74228A1794386FC18AFE833851E786F853EA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+43
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000053E94F4690548FB0596A81315DFD7AEA8FBF68DA8C3772F89C486A3D8AB0
+4E3953585606576662C563A265E66B4E6DE16E5B70AD77ED7AEF7BAA7DBB803D
+80C686CB8A95935B56E358C75F3E65AD66966A806BB575378AC7502477E55730
+5F1B6065667A6C6075F47A1A7F6E81F48718904599B37BC9755C7AF97B5184C4
+901079E97A9283365AE177404E2D4EF25B995FE062BD663C67F16CE8866B8877
+8A3B914E92F399D06A177026732A82E784578CAF4E01514651CB558B5BF50000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+44
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005E165E335E815F145F355F6B5FB461F2631166A2671D6F6E7252753A773A
+80748139817887768ABF8ADC8D858DF3929A957798029CE552C5635776F46715
+6C8873CD8CC393AE96736D25589C690E69CC8FFD939A75DB901A585A680263B4
+69FB4F436F2C67D88FBB85267DB49354693F6F70576A58F75B2C7D2C722A540A
+91E39DB44EAD4F4E505C507552438C9E544858245B9A5E1D5E955EAD5EF75F1F
+608C62B5633A63D068AF6C407887798E7A0B7DE082478A028AE68E4490130000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+45
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090B8912D91D89F0E6CE5645864E265756EF476847B1B906993D16EBA54F2
+5FB964A48F4D8FED92445178586B59295C555E976DFB7E8F751C8CBC8EE2985B
+70B94F1D6BBF6FB1753096FB514E54105835585759AC5C605F926597675C6E21
+767B83DF8CED901490FD934D7825783A52AA5EA6571F597460125012515A51AC
+51CD520055105854585859575B955CF65D8B60BC6295642D6771684368BC68DF
+76D76DD86E6F6D9B706F71C85F5375D879777B497B547B527CD67D7152300000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+46
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008463856985E48A0E8B048C468E0F9003900F94199676982D9A3095D850CD
+52D5540C58025C0E61A7649E6D1E77B37AE580F48404905392855CE09D07533F
+5F975FB36D9C7279776379BF7BE46BD272EC8AAD68036A6151F87A8169345C4A
+9CF682EB5BC59149701E56785C6F60C765666C8C8C5A90419813545166C7920D
+594890A351854E4D51EA85998B0E7058637A934B696299B47E04757753576960
+8EDF96E36C5D4E8C5C3C5F108FE953028CD1808986795EFF65E54E7351650000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+47
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000059825C3F97EE4EFB598A5FCD8A8D6FE179B079625BE78471732B71B15E74
+5FF5637B649A71C37C984E435EFC4E4B57DC56A260A96FC37D0D80FD813381BF
+8FB2899786A45DF4628A64AD898767776CE26D3E743678345A467F7582AD99AC
+4FF35EC362DD63926557676F76C3724C80CC80BA8F29914D500D57F95A926885
+6973716472FD8CB758F28CE0966A9019877F79E477E784294F2F5265535A62CD
+67CF6CCA767D7B947C95823685848FEB66DD6F2072067E1B83AB99C19EA60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+48
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000051FD7BB178727BB880877B486AE85E61808C75517560516B92626E8C767A
+91979AEA4F107F70629C7B4F95A59CE9567A585986E496BC4F345224534A53CD
+53DB5E06642C6591677F6C3E6C4E724872AF73ED75547E41822C85E98CA97BC4
+91C67169981298EF633D6669756A76E478D0854386EE532A5351542659835E87
+5F7C60B26249627962AB65906BD46CCC75B276AE789179D87DCB7F7780A588AB
+8AB98CBB907F975E98DB6A0B7C3850995C3E5FAE67876BD8743577097F8E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+49
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009F3B67CA7A175339758B9AED5F66819D83F180985F3C5FC575627B46903C
+686759EB5A9B7D10767E8B2C4FF55F6A6A196C376F0274E2796888688A558C79
+5EDF63CF75C579D282D7932892F2849C86ED9C2D54C15F6C658C6D5C70158CA7
+8CD3983B654F74F64E0D4ED857E0592B5A665BCC51A85E035E9C601662766577
+65A7666E6D6E72367B268150819A82998B5C8CA08CE68D74961C96444FAE64AB
+6B66821E8461856A90E85C01695398A8847A85574F0F526F5FA95E45670D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000798F8179890789866DF55F1762556CB84ECF72699B925206543B567458B3
+61A4626E711A596E7C897CDE7D1B96F06587805E4E194F75517558405E635E73
+5F0A67C44E26853D9589965B7C73980150FB58C1765678A7522577A585117B86
+504F590972477BC77DE88FBA8FD4904D4FBF52C95A295F0197AD4FDD821792EA
+570363556B69752B88DC8F147A4252DF58936155620A66AE6BCD7C3F83E95023
+4FF853055446583159495B9D5CF05CEF5D295E9662B16367653E65B9670B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006CD56CE170F978327E2B80DE82B3840C84EC870289128A2A8C4A90A692D2
+98FD9CF39D6C4E4F4EA1508D5256574A59A85E3D5FD85FD9623F66B4671B67D0
+68D251927D2180AA81A88B008C8C8CBF927E96325420982C531750D5535C58A8
+64B26734726777667A4691E652C36CA16B8658005E4C5954672C7FFB51E176C6
+646978E89B549EBB57CB59B96627679A6BCE54E969D95E55819C67959BAA67FE
+9C52685D4EA64FE353C862B9672B6CAB8FC44FAD7E6D9EBF4E0761626E800000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006F2B85135473672A9B455DF37B955CAC5BC6871C6E4A84D17A1481085999
+7C8D6C11772052D959227121725F77DB97279D61690B5A7F5A1851A5540D547D
+660E76DF8FF792989CF459EA725D6EC5514D68C97DBF7DEC97629EBA64786A21
+830259845B5F6BDB731B76F27DB280178499513267289ED976EE676252FF9905
+5C24623B7C7E8CB0554F60B67D0B958053014E5F51B6591C723A803691CE5F25
+77E253845F797D0485AC8A338E8D975667F385AE9453610961086CB976520000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008AED8F38552F4F51512A52C753CB5BA55E7D60A0618263D6670967DA6E67
+6D8C733673377531795088D58A98904A909190F596C4878D59154E884F594E0E
+8A898F3F981050AD5E7C59965BB95EB863DA63FA64C166DC694A69D86D0B6EB6
+719475287AAF7F8A8000844984C989818B218E0A9065967D990A617E62916B32
+6C836D747FCC7FFC6DC07F8587BA88F8676583B1983C96F76D1B7D61843D916A
+4E7153755D506B046FEB85CD862D89A75229540F5C65674E68A8740674830000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075E288CF88E191CC96E296785F8B73877ACB844E63A0756552896D416E9C
+74097559786B7C9296867ADC9F8D4FB6616E65C5865C4E864EAE50DA4E2151CC
+5BEE659968816DBC731F764277AD7A1C7CE7826F8AD2907C91CF96759818529B
+7DD1502B539867976DCB71D0743381E88F2A96A39C579E9F746058416D997D2F
+985E4EE44F364F8B51B752B15DBA601C73B2793C82D3923496B796F6970A9E97
+9F6266A66B74521752A370C888C25EC9604B61906F2371497C3E7DF4806F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000084EE9023932C54429B6F6AD370898CC28DEF973252B45A415ECA5F046717
+697C69946D6A6F0F726272FC7BED8001807E874B90CE516D9E937984808B9332
+8AD6502D548C8A716B6A8CC4810760D167A09DF24E994E989C108A6B85C18568
+69006E7E78978155000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F0C4E104E154E2A4E314E364E3C4E3F4E424E564E584E824E858C6B4E8A
+82125F0D4E8E4E9E4E9F4EA04EA24EB04EB34EB64ECE4ECD4EC44EC64EC24ED7
+4EDE4EED4EDF4EF74F094F5A4F304F5B4F5D4F574F474F764F884F8F4F984F7B
+4F694F704F914F6F4F864F9651184FD44FDF4FCE4FD84FDB4FD14FDA4FD04FE4
+4FE5501A50285014502A502550054F1C4FF650215029502C4FFE4FEF50115006
+504350476703505550505048505A5056506C50785080509A508550B450B20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+51
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000050C950CA50B350C250D650DE50E550ED50E350EE50F950F5510951015102
+511651155114511A5121513A5137513C513B513F51405152514C515451627AF8
+5169516A516E5180518256D8518C5189518F519151935195519651A451A651A2
+51A951AA51AB51B351B151B251B051B551BD51C551C951DB51E0865551E951ED
+51F051F551FE5204520B5214520E5227522A522E52335239524F5244524B524C
+525E5254526A527452695273527F527D528D529452925271528852918FA80000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+52
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008FA752AC52AD52BC52B552C152CD52D752DE52E352E698ED52E052F352F5
+52F852F9530653087538530D5310530F5315531A5323532F5331533353385340
+534653454E175349534D51D6535E5369536E5918537B53775382539653A053A6
+53A553AE53B053B653C37C1296D953DF66FC71EE53EE53E853ED53FA5401543D
+5440542C542D543C542E54365429541D544E548F5475548E545F547154775470
+5492547B5480547654845490548654C754A254B854A554AC54C454C854A80000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054AB54C254A454BE54BC54D854E554E6550F551454FD54EE54ED54FA54E2
+553955405563554C552E555C55455556555755385533555D5599558054AF558A
+559F557B557E5598559E55AE557C558355A9558755A855DA55C555DF55C455DC
+55E455D4561455F7561655FE55FD561B55F9564E565071DF5634563656325638
+566B5664562F566C566A56865680568A56A05694568F56A556AE56B656B456C2
+56BC56C156C356C056C856CE56D156D356D756EE56F9570056FF570457090000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005708570B570D57135718571655C7571C572657375738574E573B5740574F
+576957C057885761577F5789579357A057B357A457AA57B057C357C657D457D2
+57D3580A57D657E3580B5819581D587258215862584B58706BC05852583D5879
+588558B9589F58AB58BA58DE58BB58B858AE58C558D358D158D758D958D858E5
+58DC58E458DF58EF58FA58F958FB58FC58FD5902590A5910591B68A65925592C
+592D59325938593E7AD259555950594E595A5958596259605967596C59690000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+55
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000059785981599D4F5E4FAB59A359B259C659E859DC598D59D959DA5A255A1F
+5A115A1C5A095A1A5A405A6C5A495A355A365A625A6A5A9A5ABC5ABE5ACB5AC2
+5ABD5AE35AD75AE65AE95AD65AFA5AFB5B0C5B0B5B165B325AD05B2A5B365B3E
+5B435B455B405B515B555B5A5B5B5B655B695B705B735B755B7865885B7A5B80
+5B835BA65BB85BC35BC75BC95BD45BD05BE45BE65BE25BDE5BE55BEB5BF05BF6
+5BF35C055C075C085C0D5C135C205C225C285C385C395C415C465C4E5C530000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+56
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C505C4F5B715C6C5C6E4E625C765C795C8C5C915C94599B5CAB5CBB5CB6
+5CBC5CB75CC55CBE5CC75CD95CE95CFD5CFA5CED5D8C5CEA5D0B5D155D175D5C
+5D1F5D1B5D115D145D225D1A5D195D185D4C5D525D4E5D4B5D6C5D735D765D87
+5D845D825DA25D9D5DAC5DAE5DBD5D905DB75DBC5DC95DCD5DD35DD25DD65DDB
+5DEB5DF25DF55E0B5E1A5E195E115E1B5E365E375E445E435E405E4E5E575E54
+5E5F5E625E645E475E755E765E7A9EBC5E7F5EA05EC15EC25EC85ED05ECF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+57
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005ED65EE35EDD5EDA5EDB5EE25EE15EE85EE95EEC5EF15EF35EF05EF45EF8
+5EFE5F035F095F5D5F5C5F0B5F115F165F295F2D5F385F415F485F4C5F4E5F2F
+5F515F565F575F595F615F6D5F735F775F835F825F7F5F8A5F885F915F875F9E
+5F995F985FA05FA85FAD5FBC5FD65FFB5FE45FF85FF15FDD60B35FFF60216060
+601960106029600E6031601B6015602B6026600F603A605A6041606A6077605F
+604A6046604D6063604360646042606C606B60596081608D60E76083609A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+58
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006084609B60966097609260A7608B60E160B860E060D360B45FF060BD60C6
+60B560D8614D6115610660F660F7610060F460FA6103612160FB60F1610D610E
+6147613E61286127614A613F613C612C6134613D614261446173617761586159
+615A616B6174616F61656171615F615D6153617561996196618761AC6194619A
+618A619161AB61AE61CC61CA61C961F761C861C361C661BA61CB7F7961CD61E6
+61E361F661FA61F461FF61FD61FC61FE620062086209620D620C6214621B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000621E6221622A622E6230623262336241624E625E6263625B62606268627C
+62826289627E62926293629662D46283629462D762D162BB62CF62FF62C664D4
+62C862DC62CC62CA62C262C7629B62C9630C62EE62F163276302630862EF62F5
+6350633E634D641C634F6396638E638063AB637663A3638F6389639F63B5636B
+636963BE63E963C063C663E363C963D263F663C4641664346406641364266436
+651D64176428640F6467646F6476644E652A6495649364A564A9648864BC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000064DA64D264C564C764BB64D864C264F164E7820964E064E162AC64E364EF
+652C64F664F464F264FA650064FD6518651C650565246523652B653465356537
+65366538754B654865566555654D6558655E655D65726578658265838B8A659B
+659F65AB65B765C365C665C165C465CC65D265DB65D965E065E165F16772660A
+660365FB6773663566366634661C664F664466496641665E665D666466676668
+665F6662667066836688668E668966846698669D66C166B966C966BE66BC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000066C466B866D666DA66E0663F66E666E966F066F566F7670F6716671E6726
+67279738672E673F67366741673867376746675E676067596763676467896770
+67A9677C676A678C678B67A667A1678567B767EF67B467EC67B367E967B867E4
+67DE67DD67E267EE67B967CE67C667E76A9C681E684668296840684D6832684E
+68B3682B685968636877687F689F688F68AD6894689D689B68836AAE68B96874
+68B568A068BA690F688D687E690168CA690868D86922692668E1690C68CD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068D468E768D569366912690468D768E3692568F968E068EF6928692A691A
+6923692168C669796977695C6978696B6954697E696E69396974693D69596930
+6961695E695D6981696A69B269AE69D069BF69C169D369BE69CE5BE869CA69DD
+69BB69C369A76A2E699169A0699C699569B469DE69E86A026A1B69FF6B0A69F9
+69F269E76A0569B16A1E69ED6A1469EB6A0A6A126AC16A236A136A446A0C6A72
+6A366A786A476A626A596A666A486A386A226A906A8D6AA06A846AA26AA30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006A9786176ABB6AC36AC26AB86AB36AAC6ADE6AD16ADF6AAA6ADA6AEA6AFB
+6B0586166AFA6B126B169B316B1F6B386B3776DC6B3998EE6B476B436B496B50
+6B596B546B5B6B5F6B616B786B796B7F6B806B846B836B8D6B986B956B9E6BA4
+6BAA6BAB6BAF6BB26BB16BB36BB76BBC6BC66BCB6BD36BDF6BEC6BEB6BF36BEF
+9EBE6C086C136C146C1B6C246C236C5E6C556C626C6A6C826C8D6C9A6C816C9B
+6C7E6C686C736C926C906CC46CF16CD36CBD6CD76CC56CDD6CAE6CB16CBE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006CBA6CDB6CEF6CD96CEA6D1F884D6D366D2B6D3D6D386D196D356D336D12
+6D0C6D636D936D646D5A6D796D596D8E6D956FE46D856DF96E156E0A6DB56DC7
+6DE66DB86DC66DEC6DDE6DCC6DE86DD26DC56DFA6DD96DE46DD56DEA6DEE6E2D
+6E6E6E2E6E196E726E5F6E3E6E236E6B6E2B6E766E4D6E1F6E436E3A6E4E6E24
+6EFF6E1D6E386E826EAA6E986EC96EB76ED36EBD6EAF6EC46EB26ED46ED56E8F
+6EA56EC26E9F6F416F11704C6EEC6EF86EFE6F3F6EF26F316EEF6F326ECC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006F3E6F136EF76F866F7A6F786F816F806F6F6F5B6FF36F6D6F826F7C6F58
+6F8E6F916FC26F666FB36FA36FA16FA46FB96FC66FAA6FDF6FD56FEC6FD46FD8
+6FF16FEE6FDB7009700B6FFA70117001700F6FFE701B701A6F74701D7018701F
+7030703E7032705170637099709270AF70F170AC70B870B370AE70DF70CB70DD
+70D9710970FD711C711971657155718871667162714C7156716C718F71FB7184
+719571A871AC71D771B971BE71D271C971D471CE71E071EC71E771F571FC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+60
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000071F971FF720D7210721B7228722D722C72307232723B723C723F72407246
+724B72587274727E7282728172877292729672A272A772B972B272C372C672C4
+72CE72D272E272E072E172F972F7500F7317730A731C7316731D7334732F7329
+7325733E734E734F9ED87357736A7368737073787375737B737A73C873B373CE
+73BB73C073E573EE73DE74A27405746F742573F87432743A7455743F745F7459
+7441745C746974707463746A7476747E748B749E74A774CA74CF74D473F10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+61
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000074E074E374E774E974EE74F274F074F174F874F7750475037505750C750E
+750D75157513751E7526752C753C7544754D754A7549755B7546755A75697564
+7567756B756D75787576758675877574758A758975827594759A759D75A575A3
+75C275B375C375B575BD75B875BC75B175CD75CA75D275D975E375DE75FE75FF
+75FC760175F075FA75F275F3760B760D7609761F762776207621762276247634
+7630763B764776487646765C76587661766276687669766A7667766C76700000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000767276767678767C768076837688768B768E769676937699769A76B076B4
+76B876B976BA76C276CD76D676D276DE76E176E576E776EA862F76FB77087707
+770477297724771E77257726771B773777387747775A7768776B775B7765777F
+777E7779778E778B779177A0779E77B077B677B977BF77BC77BD77BB77C777CD
+77D777DA77DC77E377EE77FC780C781279267820792A7845788E78747886787C
+789A788C78A378B578AA78AF78D178C678CB78D478BE78BC78C578CA78EC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000078E778DA78FD78F47907791279117919792C792B794079607957795F795A
+79557953797A797F798A799D79A79F4B79AA79AE79B379B979BA79C979D579E7
+79EC79E179E37A087A0D7A187A197A207A1F79807A317A3B7A3E7A377A437A57
+7A497A617A627A699F9D7A707A797A7D7A887A977A957A987A967AA97AC87AB0
+7AB67AC57AC47ABF90837AC77ACA7ACD7ACF7AD57AD37AD97ADA7ADD7AE17AE2
+7AE67AED7AF07B027B0F7B0A7B067B337B187B197B1E7B357B287B367B500000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+64
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007B7A7B047B4D7B0B7B4C7B457B757B657B747B677B707B717B6C7B6E7B9D
+7B987B9F7B8D7B9C7B9A7B8B7B927B8F7B5D7B997BCB7BC17BCC7BCF7BB47BC6
+7BDD7BE97C117C147BE67BE57C607C007C077C137BF37BF77C177C0D7BF67C23
+7C277C2A7C1F7C377C2B7C3D7C4C7C437C547C4F7C407C507C587C5F7C647C56
+7C657C6C7C757C837C907CA47CAD7CA27CAB7CA17CA87CB37CB27CB17CAE7CB9
+7CBD7CC07CC57CC27CD87CD27CDC7CE29B3B7CEF7CF27CF47CF67CFA7D060000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+65
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007D027D1C7D157D0A7D457D4B7D2E7D327D3F7D357D467D737D567D4E7D72
+7D687D6E7D4F7D637D937D897D5B7D8F7D7D7D9B7DBA7DAE7DA37DB57DC77DBD
+7DAB7E3D7DA27DAF7DDC7DB87D9F7DB07DD87DDD7DE47DDE7DFB7DF27DE17E05
+7E0A7E237E217E127E317E1F7E097E0B7E227E467E667E3B7E357E397E437E37
+7E327E3A7E677E5D7E567E5E7E597E5A7E797E6A7E697E7C7E7B7E837DD57E7D
+8FAE7E7F7E887E897E8C7E927E907E937E947E967E8E7E9B7E9C7F387F3A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+66
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007F457F4C7F4D7F4E7F507F517F557F547F587F5F7F607F687F697F677F78
+7F827F867F837F887F877F8C7F947F9E7F9D7F9A7FA37FAF7FB27FB97FAE7FB6
+7FB88B717FC57FC67FCA7FD57FD47FE17FE67FE97FF37FF998DC80068004800B
+801280188019801C80218028803F803B804A804680528058805A805F80628068
+80738072807080768079807D807F808480868085809B8093809A80AD519080AC
+80DB80E580D980DD80C480DA80D6810980EF80F1811B81298123812F814B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000968B8146813E8153815180FC8171816E81658166817481838188818A8180
+818281A0819581A481A3815F819381A981B081B581BE81B881BD81C081C281BA
+81C981CD81D181D981D881C881DA81DF81E081E781FA81FB81FE820182028205
+8207820A820D821082168229822B82388233824082598258825D825A825F8264
+82628268826A826B822E827182778278827E828D829282AB829F82BB82AC82E1
+82E382DF82D282F482F382FA8393830382FB82F982DE830682DC830982D90000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+68
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000833583348316833283318340833983508345832F832B831783188385839A
+83AA839F83A283968323838E8387838A837C83B58373837583A0838983A883F4
+841383EB83CE83FD840383D8840B83C183F7840783E083F2840D8422842083BD
+8438850683FB846D842A843C855A84848477846B84AD846E848284698446842C
+846F8479843584CA846284B984BF849F84D984CD84BB84DA84D084C184C684D6
+84A1852184FF84F485178518852C851F8515851484FC85408563855885480000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+69
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000085418602854B8555858085A485888591858A85A8856D8594859B85EA8587
+859C8577857E859085C985BA85CF85B985D085D585DD85E585DC85F9860A8613
+860B85FE85FA86068622861A8630863F864D4E558654865F86678671869386A3
+86A986AA868B868C86B686AF86C486C686B086C9882386AB86D486DE86E986EC
+86DF86DB86EF8712870687088700870386FB87118709870D86F9870A8734873F
+8737873B87258729871A8760875F8778874C874E877487578768876E87590000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000087538763876A880587A2879F878287AF87CB87BD87C087D096D687AB87C4
+87B387C787C687BB87EF87F287E0880F880D87FE87F687F7880E87D288118816
+8815882288218831883688398827883B8844884288528859885E8862886B8881
+887E889E8875887D88B5887288828897889288AE889988A2888D88A488B088BF
+88B188C388C488D488D888D988DD88F9890288FC88F488E888F28904890C890A
+89138943891E8925892A892B89418944893B89368938894C891D8960895E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000089668964896D896A896F89748977897E89838988898A8993899889A189A9
+89A689AC89AF89B289BA89BD89BF89C089DA89DC89DD89E789F489F88A038A16
+8A108A0C8A1B8A1D8A258A368A418A5B8A528A468A488A7C8A6D8A6C8A628A85
+8A828A848AA88AA18A918AA58AA68A9A8AA38AC48ACD8AC28ADA8AEB8AF38AE7
+8AE48AF18B148AE08AE28AF78ADE8ADB8B0C8B078B1A8AE18B168B108B178B20
+8B3397AB8B268B2B8B3E8B288B418B4C8B4F8B4E8B498B568B5B8B5A8B6B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008B5F8B6C8B6F8B748B7D8B808B8C8B8E8B928B938B968B998B9A8C3A8C41
+8C3F8C488C4C8C4E8C508C558C628C6C8C788C7A8C828C898C858C8A8C8D8C8E
+8C948C7C8C98621D8CAD8CAA8CBD8CB28CB38CAE8CB68CC88CC18CE48CE38CDA
+8CFD8CFA8CFB8D048D058D0A8D078D0F8D0D8D109F4E8D138CCD8D148D168D67
+8D6D8D718D738D818D998DC28DBE8DBA8DCF8DDA8DD68DCC8DDB8DCB8DEA8DEB
+8DDF8DE38DFC8E088E098DFF8E1D8E1E8E108E1F8E428E358E308E348E4A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008E478E498E4C8E508E488E598E648E608E2A8E638E558E768E728E7C8E81
+8E878E858E848E8B8E8A8E938E918E948E998EAA8EA18EAC8EB08EC68EB18EBE
+8EC58EC88ECB8EDB8EE38EFC8EFB8EEB8EFE8F0A8F058F158F128F198F138F1C
+8F1F8F1B8F0C8F268F338F3B8F398F458F428F3E8F4C8F498F468F4E8F578F5C
+8F628F638F648F9C8F9F8FA38FAD8FAF8FB78FDA8FE58FE28FEA8FEF90878FF4
+90058FF98FFA901190159021900D901E9016900B90279036903590398FF80000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000904F905090519052900E9049903E90569058905E9068906F907696A89072
+9082907D90819080908A9089908F90A890AF90B190B590E290E4624890DB9102
+9112911991329130914A9156915891639165916991739172918B9189918291A2
+91AB91AF91AA91B591B491BA91C091C191C991CB91D091D691DF91E191DB91FC
+91F591F6921E91FF9214922C92159211925E925792459249926492489295923F
+924B9250929C92969293929B925A92CF92B992B792E9930F92FA9344932E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000093199322931A9323933A9335933B935C9360937C936E935693B093AC93AD
+939493B993D693D793E893E593D893C393DD93D093C893E4941A941494139403
+940794109436942B94359421943A944194529444945B94609462945E946A9229
+947094759477947D945A947C947E9481947F95829587958A9594959695989599
+95A095A895A795AD95BC95BB95B995BE95CA6FF695C395CD95CC95D595D495D6
+95DC95E195E595E296219628962E962F9642964C964F964B9677965C965E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+70
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000965D965F96669672966C968D96989695969796AA96A796B196B296B096B4
+96B696B896B996CE96CB96C996CD894D96DC970D96D596F99704970697089713
+970E9711970F971697199724972A97309739973D973E97449746974897429749
+975C976097649766976852D2976B977197799785977C9781977A9786978B978F
+9790979C97A897A697A397B397B497C397C697C897CB97DC97ED9F4F97F27ADF
+97F697F5980F980C9838982498219837983D9846984F984B986B986F98700000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+71
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000098719874987398AA98AF98B198B698C498C398C698E998EB990399099912
+991499189921991D991E99249920992C992E993D993E9942994999459950994B
+99519952994C99559997999899A599AD99AE99BC99DF99DB99DD99D899D199ED
+99EE99F199F299FB99F89A019A0F9A0599E29A199A2B9A379A459A429A409A43
+9A3E9A559A4D9A5B9A579A5F9A629A659A649A699A6B9A6A9AAD9AB09ABC9AC0
+9ACF9AD19AD39AD49ADE9ADF9AE29AE39AE69AEF9AEB9AEE9AF49AF19AF70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+72
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009AFB9B069B189B1A9B1F9B229B239B259B279B289B299B2A9B2E9B2F9B32
+9B449B439B4F9B4D9B4E9B519B589B749B939B839B919B969B979B9F9BA09BA8
+9BB49BC09BCA9BB99BC69BCF9BD19BD29BE39BE29BE49BD49BE19C3A9BF29BF1
+9BF09C159C149C099C139C0C9C069C089C129C0A9C049C2E9C1B9C259C249C21
+9C309C479C329C469C3E9C5A9C609C679C769C789CE79CEC9CF09D099D089CEB
+9D039D069D2A9D269DAF9D239D1F9D449D159D129D419D3F9D3E9D469D480000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+73
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009D5D9D5E9D649D519D509D599D729D899D879DAB9D6F9D7A9D9A9DA49DA9
+9DB29DC49DC19DBB9DB89DBA9DC69DCF9DC29DD99DD39DF89DE69DED9DEF9DFD
+9E1A9E1B9E1E9E759E799E7D9E819E889E8B9E8C9E929E959E919E9D9EA59EA9
+9EB89EAA9EAD97619ECC9ECE9ECF9ED09ED49EDC9EDE9EDD9EE09EE59EE89EEF
+9EF49EF69EF79EF99EFB9EFC9EFD9F079F0876B79F159F219F2C9F3E9F4A9F52
+9F549F639F5F9F609F619F669F679F6C9F6A9F779F729F769F959F9C9FA00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000582F69C79059746451DC7199000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/jis0212.enc b/tcl/library/encoding/jis0212.enc
new file mode 100644
index 00000000000..cddbbba9d20
--- /dev/null
+++ b/tcl/library/encoding/jis0212.enc
@@ -0,0 +1,1159 @@
+# Encoding file: jis0212, double-byte
+D
+2244 0 68
+22
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000000000000000000000002D8
+02C700B802D902DD00AF02DB02DA007E03840385000000000000000000000000
+0000000000A100A600BF00000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000BA00AA00A900AE2122
+00A4211600000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+26
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000038603880389038A03AA0000038C0000038E03AB0000038F000000000000
+000003AC03AD03AE03AF03CA039003CC03C203CD03CB03B003CE000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+27
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000004020403040404050406040704080409040A040B040C040E040F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000004520453045404550456045704580459045A045B045C045E045F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+29
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000C60110000001260000013200000141013F0000014A00D8015200000166
+00DE000000000000000000000000000000000000000000000000000000000000
+000000E6011100F00127013101330138014201400149014B00F8015300DF0167
+00FE000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+2A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000C100C000C400C2010201CD0100010400C500C301060108010C00C7010A
+010E00C900C800CB00CA011A0116011201180000011C011E01220120012400CD
+00CC00CF00CE01CF0130012A012E0128013401360139013D013B014301470145
+00D100D300D200D600D401D10150014C00D5015401580156015A015C0160015E
+0164016200DA00D900DC00DB016C01D30170016A0172016E016801D701DB01D9
+01D5017400DD017801760179017D017B00000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+2B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000E100E000E400E2010301CE0101010500E500E301070109010D00E7010B
+010F00E900E800EB00EA011B01170113011901F5011D011F00000121012500ED
+00EC00EF00EE01D00000012B012F012901350137013A013E013C014401480146
+00F100F300F200F600F401D20151014D00F5015501590157015B015D0161015F
+0165016300FA00F900FC00FB016D01D40171016B0173016F016901D801DC01DA
+01D6017500FD00FF0177017A017E017C00000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E024E044E054E0C4E124E1F4E234E244E284E2B4E2E4E2F4E304E354E40
+4E414E444E474E514E5A4E5C4E634E684E694E744E754E794E7F4E8D4E964E97
+4E9D4EAF4EB94EC34ED04EDA4EDB4EE04EE14EE24EE84EEF4EF14EF34EF54EFD
+4EFE4EFF4F004F024F034F084F0B4F0C4F124F154F164F174F194F2E4F314F60
+4F334F354F374F394F3B4F3E4F404F424F484F494F4B4F4C4F524F544F564F58
+4F5F4F634F6A4F6C4F6E4F714F774F784F794F7A4F7D4F7E4F814F824F840000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+31
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F854F894F8A4F8C4F8E4F904F924F934F944F974F994F9A4F9E4F9F4FB2
+4FB74FB94FBB4FBC4FBD4FBE4FC04FC14FC54FC64FC84FC94FCB4FCC4FCD4FCF
+4FD24FDC4FE04FE24FF04FF24FFC4FFD4FFF5000500150045007500A500C500E
+5010501350175018501B501C501D501E50225027502E50305032503350355040
+5041504250455046504A504C504E50515052505350575059505F506050625063
+50665067506A506D50705071503B5081508350845086508A508E508F50900000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+32
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005092509350945096509B509C509E509F50A050A150A250AA50AF50B050B9
+50BA50BD50C050C350C450C750CC50CE50D050D350D450D850DC50DD50DF50E2
+50E450E650E850E950EF50F150F650FA50FE5103510651075108510B510C510D
+510E50F2511051175119511B511C511D511E512351275128512C512D512F5131
+513351345135513851395142514A514F5153515551575158515F51645166517E
+51835184518B518E5198519D51A151A351AD51B851BA51BC51BE51BF51C20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+33
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000051C851CF51D151D251D351D551D851DE51E251E551EE51F251F351F451F7
+5201520252055212521352155216521852225228523152325235523C52455249
+525552575258525A525C525F526052615266526E527752785279528052825285
+528A528C52935295529652975298529A529C52A452A552A652A752AF52B052B6
+52B752B852BA52BB52BD52C052C452C652C852CC52CF52D152D452D652DB52DC
+52E152E552E852E952EA52EC52F052F152F452F652F753005303530A530B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+34
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000530C531153135318531B531C531E531F5325532753285329532B532C532D
+533053325335533C533D533E5342534C534B5359535B536153635365536C536D
+53725379537E538353875388538E539353945399539D53A153A453AA53AB53AF
+53B253B453B553B753B853BA53BD53C053C553CF53D253D353D553DA53DD53DE
+53E053E653E753F554025413541A542154275428542A542F5431543454355443
+54445447544D544F545E54625464546654675469546B546D546E5474547F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+35
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054815483548554885489548D549154955496549C549F54A154A654A754A9
+54AA54AD54AE54B154B754B954BA54BB54BF54C654CA54CD54CE54E054EA54EC
+54EF54F654FC54FE54FF55005501550555085509550C550D550E5515552A552B
+553255355536553B553C553D554155475549554A554D555055515558555A555B
+555E5560556155645566557F5581558255865588558E558F5591559255935594
+559755A355A455AD55B255BF55C155C355C655C955CB55CC55CE55D155D20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+36
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000055D355D755D855DB55DE55E255E955F655FF56055608560A560D560E560F
+5610561156125619562C56305633563556375639563B563C563D563F56405641
+5643564456465649564B564D564F5654565E566056615662566356665669566D
+566F567156725675568456855688568B568C56955699569A569D569E569F56A6
+56A756A856A956AB56AC56AD56B156B356B756BE56C556C956CA56CB56CF56D0
+56CC56CD56D956DC56DD56DF56E156E456E556E656E756E856F156EB56ED0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+37
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000056F656F7570157025707570A570C57115715571A571B571D572057225723
+572457255729572A572C572E572F57335734573D573E573F57455746574C574D
+57525762576557675768576B576D576E576F5770577157735774577557775779
+577A577B577C577E57815783578C579457975799579A579C579D579E579F57A1
+579557A757A857A957AC57B857BD57C757C857CC57CF57D557DD57DE57E457E6
+57E757E957ED57F057F557F657F857FD57FE57FF580358045808580957E10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+38
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000580C580D581B581E581F582058265827582D58325839583F5849584C584D
+584F58505855585F58615864586758685878587C587F58805881588758885889
+588A588C588D588F589058945896589D58A058A158A258A658A958B158B258C4
+58BC58C258C858CD58CE58D058D258D458D658DA58DD58E158E258E958F35905
+5906590B590C5912591359148641591D5921592359245928592F593059335935
+5936593F59435946595259535959595B595D595E595F59615963596B596D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+39
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000596F5972597559765979597B597C598B598C598E599259955997599F59A4
+59A759AD59AE59AF59B059B359B759BA59BC59C159C359C459C859CA59CD59D2
+59DD59DE59DF59E359E459E759EE59EF59F159F259F459F75A005A045A0C5A0D
+5A0E5A125A135A1E5A235A245A275A285A2A5A2D5A305A445A455A475A485A4C
+5A505A555A5E5A635A655A675A6D5A775A7A5A7B5A7E5A8B5A905A935A965A99
+5A9C5A9E5A9F5AA05AA25AA75AAC5AB15AB25AB35AB55AB85ABA5ABB5ABF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005AC45AC65AC85ACF5ADA5ADC5AE05AE55AEA5AEE5AF55AF65AFD5B005B01
+5B085B175B345B195B1B5B1D5B215B255B2D5B385B415B4B5B4C5B525B565B5E
+5B685B6E5B6F5B7C5B7D5B7E5B7F5B815B845B865B8A5B8E5B905B915B935B94
+5B965BA85BA95BAC5BAD5BAF5BB15BB25BB75BBA5BBC5BC05BC15BCD5BCF5BD6
+5BD75BD85BD95BDA5BE05BEF5BF15BF45BFD5C0C5C175C1E5C1F5C235C265C29
+5C2B5C2C5C2E5C305C325C355C365C595C5A5C5C5C625C635C675C685C690000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005C6D5C705C745C755C7A5C7B5C7C5C7D5C875C885C8A5C8F5C925C9D5C9F
+5CA05CA25CA35CA65CAA5CB25CB45CB55CBA5CC95CCB5CD25CDD5CD75CEE5CF1
+5CF25CF45D015D065D0D5D125D2B5D235D245D265D275D315D345D395D3D5D3F
+5D425D435D465D485D555D515D595D4A5D5F5D605D615D625D645D6A5D6D5D70
+5D795D7A5D7E5D7F5D815D835D885D8A5D925D935D945D955D995D9B5D9F5DA0
+5DA75DAB5DB05DB45DB85DB95DC35DC75DCB5DD05DCE5DD85DD95DE05DE40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005DE95DF85DF95E005E075E0D5E125E145E155E185E1F5E205E2E5E285E32
+5E355E3E5E4B5E505E495E515E565E585E5B5E5C5E5E5E685E6A5E6B5E6C5E6D
+5E6E5E705E805E8B5E8E5EA25EA45EA55EA85EAA5EAC5EB15EB35EBD5EBE5EBF
+5EC65ECC5ECB5ECE5ED15ED25ED45ED55EDC5EDE5EE55EEB5F025F065F075F08
+5F0E5F195F1C5F1D5F215F225F235F245F285F2B5F2C5F2E5F305F345F365F3B
+5F3D5F3F5F405F445F455F475F4D5F505F545F585F5B5F605F635F645F670000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F6F5F725F745F755F785F7A5F7D5F7E5F895F8D5F8F5F965F9C5F9D5FA2
+5FA75FAB5FA45FAC5FAF5FB05FB15FB85FC45FC75FC85FC95FCB5FD05FD15FD2
+5FD35FD45FDE5FE15FE25FE85FE95FEA5FEC5FED5FEE5FEF5FF25FF35FF65FFA
+5FFC6007600A600D6013601460176018601A601F6024602D6033603560406047
+60486049604C6051605460566057605D606160676071607E607F608260866088
+608A608E6091609360956098609D609E60A260A460A560A860B060B160B70000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000060BB60BE60C260C460C860C960CA60CB60CE60CF60D460D560D960DB60DD
+60DE60E260E560F260F560F860FC60FD61026107610A610C6110611161126113
+6114611661176119611C611E6122612A612B6130613161356136613761396141
+614561466149615E6160616C61726178617B617C617F6180618161836184618B
+618D6192619361976198619C619D619F61A061A561A861AA61AD61B861B961BC
+61C061C161C261CE61CF61D561DC61DD61DE61DF61E161E261E761E961E50000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000061EC61ED61EF620162036204620762136215621C62206222622362276229
+622B6239623D6242624362446246624C62506251625262546256625A625C6264
+626D626F6273627A627D628D628E628F629062A662A862B362B662B762BA62BE
+62BF62C462CE62D562D662DA62EA62F262F462FC62FD63036304630A630B630D
+63106313631663186329632A632D633563366339633C63416342634363446346
+634A634B634E6352635363546358635B63656366636C636D6371637463750000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+40
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006378637C637D637F638263846387638A6390639463956399639A639E63A4
+63A663AD63AE63AF63BD63C163C563C863CE63D163D363D463D563DC63E063E5
+63EA63EC63F263F363F563F863F96409640A6410641264146418641E64206422
+642464256429642A642F64306435643D643F644B644F6451645264536454645A
+645B645C645D645F646064616463646D64736474647B647D64856487648F6490
+649164986499649B649D649F64A164A364A664A864AC64B364BD64BE64BF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+41
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000064C464C964CA64CB64CC64CE64D064D164D564D764E464E564E964EA64ED
+64F064F564F764FB64FF6501650465086509650A650F6513651465166519651B
+651E651F652265266529652E6531653A653C653D654365476549655065526554
+655F65606567656B657A657D65816585658A659265956598659D65A065A365A6
+65AE65B265B365B465BF65C265C865C965CE65D065D465D665D865DF65F065F2
+65F465F565F965FE65FF6600660466086609660D6611661266156616661D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+42
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000661E662166226623662466266629662A662B662C662E6630663166336639
+6637664066456646664A664C6651664E665766586659665B665C6660666166FB
+666A666B666C667E66736675667F667766786679667B6680667C668B668C668D
+669066926699669A669B669C669F66A066A466AD66B166B266B566BB66BF66C0
+66C266C366C866CC66CE66CF66D466DB66DF66E866EB66EC66EE66FA67056707
+670E67136719671C672067226733673E674567476748674C67546755675D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+43
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006766676C676E67746776677B67816784678E678F67916793679667986799
+679B67B067B167B267B567BB67BC67BD67F967C067C267C367C567C867C967D2
+67D767D967DC67E167E667F067F267F667F7685268146819681D681F68286827
+682C682D682F683068316833683B683F68446845684A684C685568576858685B
+686B686E686F68706871687268756879687A687B687C68826884688668886896
+6898689A689C68A168A368A568A968AA68AE68B268BB68C568C868CC68CF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+44
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068D068D168D368D668D968DC68DD68E568E868EA68EB68EC68ED68F068F1
+68F568F668FB68FC68FD69066909690A69106911691369166917693169336935
+6938693B694269456949694E6957695B696369646965696669686969696C6970
+69716972697A697B697F6980698D69926996699869A169A569A669A869AB69AD
+69AF69B769B869BA69BC69C569C869D169D669D769E269E569EE69EF69F169F3
+69F569FE6A006A016A036A0F6A116A156A1A6A1D6A206A246A286A306A320000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+45
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006A346A376A3B6A3E6A3F6A456A466A496A4A6A4E6A506A516A526A556A56
+6A5B6A646A676A6A6A716A736A7E6A816A836A866A876A896A8B6A916A9B6A9D
+6A9E6A9F6AA56AAB6AAF6AB06AB16AB46ABD6ABE6ABF6AC66AC96AC86ACC6AD0
+6AD46AD56AD66ADC6ADD6AE46AE76AEC6AF06AF16AF26AFC6AFD6B026B036B06
+6B076B096B0F6B106B116B176B1B6B1E6B246B286B2B6B2C6B2F6B356B366B3B
+6B3F6B466B4A6B4D6B526B566B586B5D6B606B676B6B6B6E6B706B756B7D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+46
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006B7E6B826B856B976B9B6B9F6BA06BA26BA36BA86BA96BAC6BAD6BAE6BB0
+6BB86BB96BBD6BBE6BC36BC46BC96BCC6BD66BDA6BE16BE36BE66BE76BEE6BF1
+6BF76BF96BFF6C026C046C056C096C0D6C0E6C106C126C196C1F6C266C276C28
+6C2C6C2E6C336C356C366C3A6C3B6C3F6C4A6C4B6C4D6C4F6C526C546C596C5B
+6C5C6C6B6C6D6C6F6C746C766C786C796C7B6C856C866C876C896C946C956C97
+6C986C9C6C9F6CB06CB26CB46CC26CC66CCD6CCF6CD06CD16CD26CD46CD60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+47
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006CDA6CDC6CE06CE76CE96CEB6CEC6CEE6CF26CF46D046D076D0A6D0E6D0F
+6D116D136D1A6D266D276D286C676D2E6D2F6D316D396D3C6D3F6D576D5E6D5F
+6D616D656D676D6F6D706D7C6D826D876D916D926D946D966D976D986DAA6DAC
+6DB46DB76DB96DBD6DBF6DC46DC86DCA6DCE6DCF6DD66DDB6DDD6DDF6DE06DE2
+6DE56DE96DEF6DF06DF46DF66DFC6E006E046E1E6E226E276E326E366E396E3B
+6E3C6E446E456E486E496E4B6E4F6E516E526E536E546E576E5C6E5D6E5E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+48
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006E626E636E686E736E7B6E7D6E8D6E936E996EA06EA76EAD6EAE6EB16EB3
+6EBB6EBF6EC06EC16EC36EC76EC86ECA6ECD6ECE6ECF6EEB6EED6EEE6EF96EFB
+6EFD6F046F086F0A6F0C6F0D6F166F186F1A6F1B6F266F296F2A6F2F6F306F33
+6F366F3B6F3C6F2D6F4F6F516F526F536F576F596F5A6F5D6F5E6F616F626F68
+6F6C6F7D6F7E6F836F876F886F8B6F8C6F8D6F906F926F936F946F966F9A6F9F
+6FA06FA56FA66FA76FA86FAE6FAF6FB06FB56FB66FBC6FC56FC76FC86FCA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+49
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006FDA6FDE6FE86FE96FF06FF56FF96FFC6FFD7000700570067007700D7017
+70207023702F703470377039703C7043704470487049704A704B70547055705D
+705E704E70647065706C706E70757076707E7081708570867094709570967097
+7098709B70A470AB70B070B170B470B770CA70D170D370D470D570D670D870DC
+70E470FA71037104710571067107710B710C710F711E7120712B712D712F7130
+713171387141714571467147714A714B715071527157715A715C715E71600000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000071687179718071857187718C7192719A719B71A071A271AF71B071B271B3
+71BA71BF71C071C171C471CB71CC71D371D671D971DA71DC71F871FE72007207
+7208720972137217721A721D721F7224722B722F723472387239724172427243
+7245724E724F7250725372557256725A725C725E726072637268726B726E726F
+727172777278727B727C727F72847289728D728E7293729B72A872AD72AE72B1
+72B472BE72C172C772C972CC72D572D672D872DF72E572F372F472FA72FB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000072FE7302730473057307730B730D7312731373187319731E732273247327
+7328732C733173327335733A733B733D7343734D7350735273567358735D735E
+735F7360736673677369736B736C736E736F737173777379737C738073817383
+73857386738E73907393739573977398739C739E739F73A073A273A573A673AA
+73AB73AD73B573B773B973BC73BD73BF73C573C673C973CB73CC73CF73D273D3
+73D673D973DD73E173E373E673E773E973F473F573F773F973FA73FB73FD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000073FF7400740174047407740A7411741A741B7424742674287429742A742B
+742C742D742E742F74307431743974407443744474467447744B744D74517452
+7457745D7462746674677468746B746D746E7471747274807481748574867487
+7489748F74907491749274987499749A749C749F74A074A174A374A674A874A9
+74AA74AB74AE74AF74B174B274B574B974BB74BF74C874C974CC74D074D374D8
+74DA74DB74DE74DF74E474E874EA74EB74EF74F474FA74FB74FC74FF75060000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000075127516751775207521752475277529752A752F75367539753D753E753F
+7540754375477548754E755075527557755E755F7561756F75717579757A757B
+757C757D757E7581758575907592759375957599759C75A275A475B475BA75BF
+75C075C175C475C675CC75CE75CF75D775DC75DF75E075E175E475E775EC75EE
+75EF75F175F9760076027603760476077608760A760C760F7612761376157616
+7619761B761C761D761E7623762576267629762D763276337635763876390000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000763A763C764A764076417643764476457649764B76557659765F76647665
+766D766E766F7671767476817685768C768D7695769B769C769D769F76A076A2
+76A376A476A576A676A776A876AA76AD76BD76C176C576C976CB76CC76CE76D4
+76D976E076E676E876EC76F076F176F676F976FC77007706770A770E77127714
+771577177719771A771C77227728772D772E772F7734773577367739773D773E
+774277457746774A774D774E774F775277567757775C775E775F776077620000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077647767776A776C7770777277737774777A777D77807784778C778D7794
+77957796779A779F77A277A777AA77AE77AF77B177B577BE77C377C977D177D2
+77D577D977DE77DF77E077E477E677EA77EC77F077F177F477F877FB78057806
+7809780D780E7811781D782178227823782D782E783078357837784378447847
+7848784C784E7852785C785E78607861786378647868786A786E787A787E788A
+788F7894789878A1789D789E789F78A478A878AC78AD78B078B178B278B30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000078BB78BD78BF78C778C878C978CC78CE78D278D378D578D678E478DB78DF
+78E078E178E678EA78F278F3790078F678F778FA78FB78FF7906790C7910791A
+791C791E791F7920792579277929792D793179347935793B793D793F79447945
+7946794A794B794F795179547958795B795C79677969796B79727979797B797C
+797E798B798C799179937994799579967998799B799C79A179A879A979AB79AF
+79B179B479B879BB79C279C479C779C879CA79CF79D479D679DA79DD79DE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+51
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000079E079E279E579EA79EB79ED79F179F879FC7A027A037A077A097A0A7A0C
+7A117A157A1B7A1E7A217A277A2B7A2D7A2F7A307A347A357A387A397A3A7A44
+7A457A477A487A4C7A557A567A597A5C7A5D7A5F7A607A657A677A6A7A6D7A75
+7A787A7E7A807A827A857A867A8A7A8B7A907A917A947A9E7AA07AA37AAC7AB3
+7AB57AB97ABB7ABC7AC67AC97ACC7ACE7AD17ADB7AE87AE97AEB7AEC7AF17AF4
+7AFB7AFD7AFE7B077B147B1F7B237B277B297B2A7B2B7B2D7B2E7B2F7B300000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+52
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007B317B347B3D7B3F7B407B417B477B4E7B557B607B647B667B697B6A7B6D
+7B6F7B727B737B777B847B897B8E7B907B917B967B9B7B9E7BA07BA57BAC7BAF
+7BB07BB27BB57BB67BBA7BBB7BBC7BBD7BC27BC57BC87BCA7BD47BD67BD77BD9
+7BDA7BDB7BE87BEA7BF27BF47BF57BF87BF97BFA7BFC7BFE7C017C027C037C04
+7C067C097C0B7C0C7C0E7C0F7C197C1B7C207C257C267C287C2C7C317C337C34
+7C367C397C3A7C467C4A7C557C517C527C537C597C5A7C5B7C5C7C5D7C5E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007C617C637C677C697C6D7C6E7C707C727C797C7C7C7D7C867C877C8F7C94
+7C9E7CA07CA67CB07CB67CB77CBA7CBB7CBC7CBF7CC47CC77CC87CC97CCD7CCF
+7CD37CD47CD57CD77CD97CDA7CDD7CE67CE97CEB7CF57D037D077D087D097D0F
+7D117D127D137D167D1D7D1E7D237D267D2A7D2D7D317D3C7D3D7D3E7D407D41
+7D477D487D4D7D517D537D577D597D5A7D5C7D5D7D657D677D6A7D707D787D7A
+7D7B7D7F7D817D827D837D857D867D887D8B7D8C7D8D7D917D967D977D9D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007D9E7DA67DA77DAA7DB37DB67DB77DB97DC27DC37DC47DC57DC67DCC7DCD
+7DCE7DD77DD97E007DE27DE57DE67DEA7DEB7DED7DF17DF57DF67DF97DFA7E08
+7E107E117E157E177E1C7E1D7E207E277E287E2C7E2D7E2F7E337E367E3F7E44
+7E457E477E4E7E507E527E587E5F7E617E627E657E6B7E6E7E6F7E737E787E7E
+7E817E867E877E8A7E8D7E917E957E987E9A7E9D7E9E7F3C7F3B7F3D7F3E7F3F
+7F437F447F477F4F7F527F537F5B7F5C7F5D7F617F637F647F657F667F6D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+55
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007F717F7D7F7E7F7F7F807F8B7F8D7F8F7F907F917F967F977F9C7FA17FA2
+7FA67FAA7FAD7FB47FBC7FBF7FC07FC37FC87FCE7FCF7FDB7FDF7FE37FE57FE8
+7FEC7FEE7FEF7FF27FFA7FFD7FFE7FFF80078008800A800D800E800F80118013
+80148016801D801E801F802080248026802C802E80308034803580378039803A
+803C803E80408044806080648066806D8071807580818088808E809C809E80A6
+80A780AB80B880B980C880CD80CF80D280D480D580D780D880E080ED80EE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+56
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000080F080F280F380F680F980FA80FE8103810B811681178118811C811E8120
+81248127812C81308135813A813C81458147814A814C81528157816081618167
+81688169816D816F817781818190818481858186818B818E81968198819B819E
+81A281AE81B281B481BB81CB81C381C581CA81CE81CF81D581D781DB81DD81DE
+81E181E481EB81EC81F081F181F281F581F681F881F981FD81FF82008203820F
+821382148219821A821D82218222822882328234823A82438244824582460000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+57
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000824B824E824F82518256825C826082638267826D8274827B827D827F8280
+82818283828482878289828A828E8291829482968298829A829B82A082A182A3
+82A482A782A882A982AA82AE82B082B282B482B782BA82BC82BE82BF82C682D0
+82D582DA82E082E282E482E882EA82ED82EF82F682F782FD82FE830083018307
+8308830A830B8354831B831D831E831F83218322832C832D832E833083338337
+833A833C833D8342834383448347834D834E8351835583568357837083780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+58
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000837D837F8380838283848386838D83928394839583988399839B839C839D
+83A683A783A983AC83BE83BF83C083C783C983CF83D083D183D483DD835383E8
+83EA83F683F883F983FC84018406840A840F84118415841983AD842F84398445
+84478448844A844D844F84518452845684588459845A845C8460846484658467
+846A84708473847484768478847C847D84818485849284938495849E84A684A8
+84A984AA84AF84B184B484BA84BD84BE84C084C284C784C884CC84CF84D30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000084DC84E784EA84EF84F084F184F284F7853284FA84FB84FD850285038507
+850C850E8510851C851E85228523852485258527852A852B852F853385348536
+853F8546854F855085518552855385568559855C855D855E855F856085618562
+8564856B856F8579857A857B857D857F8581858585868589858B858C858F8593
+8598859D859F85A085A285A585A785B485B685B785B885BC85BD85BE85BF85C2
+85C785CA85CB85CE85AD85D885DA85DF85E085E685E885ED85F385F685FC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000085FF860086048605860D860E86108611861286188619861B861E86218627
+862986368638863A863C863D864086428646865286538656865786588659865D
+866086618662866386648669866C866F867586768677867A868D869186968698
+869A869C86A186A686A786A886AD86B186B386B486B586B786B886B986BF86C0
+86C186C386C586D186D286D586D786DA86DC86E086E386E586E7868886FA86FC
+86FD870487058707870B870E870F8710871387148719871E871F872187230000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008728872E872F873187328739873A873C873D873E874087438745874D8758
+875D876187648765876F87718772877B8783878487858786878787888789878B
+878C879087938795879787988799879E87A087A387A787AC87AD87AE87B187B5
+87BE87BF87C187C887C987CA87CE87D587D687D987DA87DC87DF87E287E387E4
+87EA87EB87ED87F187F387F887FA87FF8801880388068809880A880B88108819
+8812881388148818881A881B881C881E881F8828882D882E8830883288350000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000883A883C88418843884588488849884A884B884E8851885588568858885A
+885C885F88608864886988718879887B88808898889A889B889C889F88A088A8
+88AA88BA88BD88BE88C088CA88CB88CC88CD88CE88D188D288D388DB88DE88E7
+88EF88F088F188F588F789018906890D890E890F8915891689188919891A891C
+892089268927892889308931893289358939893A893E89408942894589468949
+894F89528957895A895B895C896189628963896B896E897089738975897A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000897B897C897D8989898D899089948995899B899C899F89A089A589B089B4
+89B589B689B789BC89D489D589D689D789D889E589E989EB89ED89F189F389F6
+89F989FD89FF8A048A058A078A0F8A118A128A148A158A1E8A208A228A248A26
+8A2B8A2C8A2F8A358A378A3D8A3E8A408A438A458A478A498A4D8A4E8A538A56
+8A578A588A5C8A5D8A618A658A678A758A768A778A798A7A8A7B8A7E8A7F8A80
+8A838A868A8B8A8F8A908A928A968A978A998A9F8AA78AA98AAE8AAF8AB30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008AB68AB78ABB8ABE8AC38AC68AC88AC98ACA8AD18AD38AD48AD58AD78ADD
+8ADF8AEC8AF08AF48AF58AF68AFC8AFF8B058B068B0B8B118B1C8B1E8B1F8B0A
+8B2D8B308B378B3C8B428B438B448B458B468B488B528B538B548B598B4D8B5E
+8B638B6D8B768B788B798B7C8B7E8B818B848B858B8B8B8D8B8F8B948B958B9C
+8B9E8B9F8C388C398C3D8C3E8C458C478C498C4B8C4F8C518C538C548C578C58
+8C5B8C5D8C598C638C648C668C688C698C6D8C738C758C768C7B8C7E8C860000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008C878C8B8C908C928C938C998C9B8C9C8CA48CB98CBA8CC58CC68CC98CCB
+8CCF8CD68CD58CD98CDD8CE18CE88CEC8CEF8CF08CF28CF58CF78CF88CFE8CFF
+8D018D038D098D128D178D1B8D658D698D6C8D6E8D7F8D828D848D888D8D8D90
+8D918D958D9E8D9F8DA08DA68DAB8DAC8DAF8DB28DB58DB78DB98DBB8DC08DC5
+8DC68DC78DC88DCA8DCE8DD18DD48DD58DD78DD98DE48DE58DE78DEC8DF08DBC
+8DF18DF28DF48DFD8E018E048E058E068E0B8E118E148E168E208E218E220000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+60
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008E238E268E278E318E338E368E378E388E398E3D8E408E418E4B8E4D8E4E
+8E4F8E548E5B8E5C8E5D8E5E8E618E628E698E6C8E6D8E6F8E708E718E798E7A
+8E7B8E828E838E898E908E928E958E9A8E9B8E9D8E9E8EA28EA78EA98EAD8EAE
+8EB38EB58EBA8EBB8EC08EC18EC38EC48EC78ECF8ED18ED48EDC8EE88EEE8EF0
+8EF18EF78EF98EFA8EED8F008F028F078F088F0F8F108F168F178F188F1E8F20
+8F218F238F258F278F288F2C8F2D8F2E8F348F358F368F378F3A8F408F410000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+61
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008F438F478F4F8F518F528F538F548F558F588F5D8F5E8F658F9D8FA08FA1
+8FA48FA58FA68FB58FB68FB88FBE8FC08FC18FC68FCA8FCB8FCD8FD08FD28FD3
+8FD58FE08FE38FE48FE88FEE8FF18FF58FF68FFB8FFE900290049008900C9018
+901B90289029902F902A902C902D903390349037903F90439044904C905B905D
+906290669067906C90709074907990859088908B908C908E9090909590979098
+9099909B90A090A190A290A590B090B290B390B490B690BD90CC90BE90C30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000090C490C590C790C890D590D790D890D990DC90DD90DF90E590D290F690EB
+90EF90F090F490FE90FF91009104910591069108910D91109114911691179118
+911A911C911E912091259122912391279129912E912F91319134913691379139
+913A913C913D914391479148914F915391579159915A915B916191649167916D
+91749179917A917B9181918391859186918A918E91919193919491959198919E
+91A191A691A891AC91AD91AE91B091B191B291B391B691BB91BC91BD91BF0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000091C291C391C591D391D491D791D991DA91DE91E491E591E991EA91EC91ED
+91EE91EF91F091F191F791F991FB91FD9200920192049205920692079209920A
+920C92109212921392169218921C921D92239224922592269228922E922F9230
+92339235923692389239923A923C923E92409242924392469247924A924D924E
+924F925192589259925C925D926092619265926792689269926E926F92709275
+9276927792789279927B927C927D927F92889289928A928D928E929292970000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+64
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009299929F92A092A492A592A792A892AB92AF92B292B692B892BA92BB92BC
+92BD92BF92C092C192C292C392C592C692C792C892CB92CC92CD92CE92D092D3
+92D592D792D892D992DC92DD92DF92E092E192E392E592E792E892EC92EE92F0
+92F992FB92FF930093029308930D931193149315931C931D931E931F93219324
+932593279329932A933393349336933793479348934993509351935293559357
+9358935A935E9364936593679369936A936D936F937093719373937493760000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+65
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000937A937D937F9380938193829388938A938B938D938F939293959398939B
+939E93A193A393A493A693A893AB93B493B593B693BA93A993C193C493C593C6
+93C793C993CA93CB93CC93CD93D393D993DC93DE93DF93E293E693E793F993F7
+93F893FA93FB93FD94019402940494089409940D940E940F941594169417941F
+942E942F9431943294339434943B943F943D944394459448944A944C94559459
+945C945F946194639468946B946D946E946F9471947294849483957895790000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+66
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000957E95849588958C958D958E959D959E959F95A195A695A995AB95AC95B4
+95B695BA95BD95BF95C695C895C995CB95D095D195D295D395D995DA95DD95DE
+95DF95E095E495E6961D961E9622962496259626962C96319633963796389639
+963A963C963D9641965296549656965796589661966E9674967B967C967E967F
+9681968296839684968996919696969A969D969F96A496A596A696A996AE96AF
+96B396BA96CA96D25DB296D896DA96DD96DE96DF96E996EF96F196FA97020000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000970397059709971A971B971D97219722972397289731973397419743974A
+974E974F975597579758975A975B97639767976A976E9773977697779778977B
+977D977F978097899795979697979799979A979E979F97A297AC97AE97B197B2
+97B597B697B897B997BA97BC97BE97BF97C197C497C597C797C997CA97CC97CD
+97CE97D097D197D497D797D897D997DD97DE97E097DB97E197E497EF97F197F4
+97F797F897FA9807980A9819980D980E98149816981C981E9820982398260000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+68
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000982B982E982F98309832983398359825983E98449847984A985198529853
+985698579859985A9862986398659866986A986C98AB98AD98AE98B098B498B7
+98B898BA98BB98BF98C298C598C898CC98E198E398E598E698E798EA98F398F6
+9902990799089911991599169917991A991B991C991F992299269927992B9931
+99329933993499359939993A993B993C99409941994699479948994D994E9954
+99589959995B995C995E995F9960999B999D999F99A699B099B199B299B50000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+69
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000099B999BA99BD99BF99C399C999D399D499D999DA99DC99DE99E799EA99EB
+99EC99F099F499F599F999FD99FE9A029A039A049A0B9A0C9A109A119A169A1E
+9A209A229A239A249A279A2D9A2E9A339A359A369A389A479A419A449A4A9A4B
+9A4C9A4E9A519A549A569A5D9AAA9AAC9AAE9AAF9AB29AB49AB59AB69AB99ABB
+9ABE9ABF9AC19AC39AC69AC89ACE9AD09AD29AD59AD69AD79ADB9ADC9AE09AE4
+9AE59AE79AE99AEC9AF29AF39AF59AF99AFA9AFD9AFF9B009B019B029B030000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009B049B059B089B099B0B9B0C9B0D9B0E9B109B129B169B199B1B9B1C9B20
+9B269B2B9B2D9B339B349B359B379B399B3A9B3D9B489B4B9B4C9B559B569B57
+9B5B9B5E9B619B639B659B669B689B6A9B6B9B6C9B6D9B6E9B739B759B779B78
+9B799B7F9B809B849B859B869B879B899B8A9B8B9B8D9B8F9B909B949B9A9B9D
+9B9E9BA69BA79BA99BAC9BB09BB19BB29BB79BB89BBB9BBC9BBE9BBF9BC19BC7
+9BC89BCE9BD09BD79BD89BDD9BDF9BE59BE79BEA9BEB9BEF9BF39BF79BF80000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009BF99BFA9BFD9BFF9C009C029C0B9C0F9C119C169C189C199C1A9C1C9C1E
+9C229C239C269C279C289C299C2A9C319C359C369C379C3D9C419C439C449C45
+9C499C4A9C4E9C4F9C509C539C549C569C589C5B9C5D9C5E9C5F9C639C699C6A
+9C5C9C6B9C689C6E9C709C729C759C779C7B9CE69CF29CF79CF99D0B9D029D11
+9D179D189D1C9D1D9D1E9D2F9D309D329D339D349D3A9D3C9D459D3D9D429D43
+9D479D4A9D539D549D5F9D639D629D659D699D6A9D6B9D709D769D779D7B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009D7C9D7E9D839D849D869D8A9D8D9D8E9D929D939D959D969D979D989DA1
+9DAA9DAC9DAE9DB19DB59DB99DBC9DBF9DC39DC79DC99DCA9DD49DD59DD69DD7
+9DDA9DDE9DDF9DE09DE59DE79DE99DEB9DEE9DF09DF39DF49DFE9E0A9E029E07
+9E0E9E109E119E129E159E169E199E1C9E1D9E7A9E7B9E7C9E809E829E839E84
+9E859E879E8E9E8F9E969E989E9B9E9E9EA49EA89EAC9EAE9EAF9EB09EB39EB4
+9EB59EC69EC89ECB9ED59EDF9EE49EE79EEC9EED9EEE9EF09EF19EF29EF50000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009EF89EFF9F029F039F099F0F9F109F119F129F149F169F179F199F1A9F1B
+9F1F9F229F269F2A9F2B9F2F9F319F329F349F379F399F3A9F3C9F3D9F3F9F41
+9F439F449F459F469F479F539F559F569F579F589F5A9F5D9F5E9F689F699F6D
+9F6E9F6F9F709F719F739F759F7A9F7D9F8F9F909F919F929F949F969F979F9E
+9FA19FA29FA39FA5000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/koi8-r.enc b/tcl/library/encoding/koi8-r.enc
new file mode 100644
index 00000000000..49bf2ea65cf
--- /dev/null
+++ b/tcl/library/encoding/koi8-r.enc
@@ -0,0 +1,20 @@
+# Encoding file: koi8-r, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+25002502250C251025142518251C2524252C2534253C258025842588258C2590
+259125922593232025A02219221A22482264226500A0232100B000B200B700F7
+25502551255204512553255425552556255725582559255A255B255C255D255E
+255F25602561040125622563256425652566256725682569256A256B256C00A9
+044E0430043104460434043504440433044504380439043A043B043C043D043E
+043F044F044004410442044304360432044C044B04370448044D04490447044A
+042E0410041104260414041504240413042504180419041A041B041C041D041E
+041F042F042004210422042304160412042C042B04170428042D04290427042A
diff --git a/tcl/library/encoding/ksc5601.enc b/tcl/library/encoding/ksc5601.enc
new file mode 100644
index 00000000000..bec61d0ff84
--- /dev/null
+++ b/tcl/library/encoding/ksc5601.enc
@@ -0,0 +1,1516 @@
+# Encoding file: ksc5601, double-byte
+D
+233F 0 89
+21
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030003001300200B72025202600A8300300AD20152225FF3C223C20182019
+201C201D3014301530083009300A300B300C300D300E300F3010301100B100D7
+00F7226022642265221E223400B0203220332103212BFFE0FFE1FFE526422640
+222022A52312220222072261225200A7203B2606260525CB25CF25CE25C725C6
+25A125A025B325B225BD25BC219221902191219321943013226A226B221A223D
+221D2235222B222C2208220B2286228722822283222A222922272228FFE20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+22
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000021D221D42200220300B4FF5E02C702D802DD02DA02D900B802DB00A100BF
+02D0222E2211220F00A42109203025C125C025B725B626642660266126652667
+2663229925C825A325D025D1259225A425A525A825A725A625A92668260F260E
+261C261E00B62020202121952197219921962198266D2669266A266C327F321C
+211633C7212233C233D821210000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+23
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF01FF02FF03FF04FF05FF06FF07FF08FF09FF0AFF0BFF0CFF0DFF0EFF0F
+FF10FF11FF12FF13FF14FF15FF16FF17FF18FF19FF1AFF1BFF1CFF1DFF1EFF1F
+FF20FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2F
+FF30FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3AFF3BFFE6FF3DFF3EFF3F
+FF40FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5AFF5BFF5CFF5DFFE30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+24
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000313131323133313431353136313731383139313A313B313C313D313E313F
+3140314131423143314431453146314731483149314A314B314C314D314E314F
+3150315131523153315431553156315731583159315A315B315C315D315E315F
+3160316131623163316431653166316731683169316A316B316C316D316E316F
+3170317131723173317431753176317731783179317A317B317C317D317E317F
+3180318131823183318431853186318731883189318A318B318C318D318E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+25
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000217021712172217321742175217621772178217900000000000000000000
+2160216121622163216421652166216721682169000000000000000000000000
+0000039103920393039403950396039703980399039A039B039C039D039E039F
+03A003A103A303A403A503A603A703A803A90000000000000000000000000000
+000003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
+03C003C103C303C403C503C603C703C803C90000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+26
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000025002502250C251025182514251C252C25242534253C25012503250F2513
+251B251725232533252B253B254B2520252F25282537253F251D253025252538
+254225122511251A251925162515250E250D251E251F25212522252625272529
+252A252D252E25312532253525362539253A253D253E25402541254325442545
+2546254725482549254A00000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+27
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00003395339633972113339833C433A333A433A533A63399339A339B339C339D
+339E339F33A033A133A233CA338D338E338F33CF3388338933C833A733A833B0
+33B133B233B333B433B533B633B733B833B93380338133823383338433BA33BB
+33BC33BD33BE33BF33903391339233933394212633C033C1338A338B338C33D6
+33C533AD33AE33AF33DB33A933AA33AB33AC33DD33D033D333C333C933DC33C6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+28
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000C600D000AA0126000001320000013F014100D8015200BA00DE0166014A
+00003260326132623263326432653266326732683269326A326B326C326D326E
+326F3270327132723273327432753276327732783279327A327B24D024D124D2
+24D324D424D524D624D724D824D924DA24DB24DC24DD24DE24DF24E024E124E2
+24E324E424E524E624E724E824E9246024612462246324642465246624672468
+2469246A246B246C246D246E00BD2153215400BC00BE215B215C215D215E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+29
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000E6011100F001270131013301380140014200F8015300DF00FE0167014B
+01493200320132023203320432053206320732083209320A320B320C320D320E
+320F3210321132123213321432153216321732183219321A321B249C249D249E
+249F24A024A124A224A324A424A524A624A724A824A924AA24AB24AC24AD24AE
+24AF24B024B124B224B324B424B5247424752476247724782479247A247B247C
+247D247E247F24802481248200B900B200B32074207F20812082208320840000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+2A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000304130423043304430453046304730483049304A304B304C304D304E304F
+3050305130523053305430553056305730583059305A305B305C305D305E305F
+3060306130623063306430653066306730683069306A306B306C306D306E306F
+3070307130723073307430753076307730783079307A307B307C307D307E307F
+3080308130823083308430853086308730883089308A308B308C308D308E308F
+3090309130923093000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+2B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000030A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF
+30B030B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF
+30C030C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF
+30D030D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+2C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000004100411041204130414041504010416041704180419041A041B041C041D
+041E041F0420042104220423042404250426042704280429042A042B042C042D
+042E042F00000000000000000000000000000000000000000000000000000000
+000004300431043204330434043504510436043704380439043A043B043C043D
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AC00AC01AC04AC07AC08AC09AC0AAC10AC11AC12AC13AC14AC15AC16AC17
+AC19AC1AAC1BAC1CAC1DAC20AC24AC2CAC2DAC2FAC30AC31AC38AC39AC3CAC40
+AC4BAC4DAC54AC58AC5CAC70AC71AC74AC77AC78AC7AAC80AC81AC83AC84AC85
+AC86AC89AC8AAC8BAC8CAC90AC94AC9CAC9DAC9FACA0ACA1ACA8ACA9ACAAACAC
+ACAFACB0ACB8ACB9ACBBACBCACBDACC1ACC4ACC8ACCCACD5ACD7ACE0ACE1ACE4
+ACE7ACE8ACEAACECACEFACF0ACF1ACF3ACF5ACF6ACFCACFDAD00AD04AD060000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+31
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AD0CAD0DAD0FAD11AD18AD1CAD20AD29AD2CAD2DAD34AD35AD38AD3CAD44
+AD45AD47AD49AD50AD54AD58AD61AD63AD6CAD6DAD70AD73AD74AD75AD76AD7B
+AD7CAD7DAD7FAD81AD82AD88AD89AD8CAD90AD9CAD9DADA4ADB7ADC0ADC1ADC4
+ADC8ADD0ADD1ADD3ADDCADE0ADE4ADF8ADF9ADFCADFFAE00AE01AE08AE09AE0B
+AE0DAE14AE30AE31AE34AE37AE38AE3AAE40AE41AE43AE45AE46AE4AAE4CAE4D
+AE4EAE50AE54AE56AE5CAE5DAE5FAE60AE61AE65AE68AE69AE6CAE70AE780000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+32
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000AE79AE7BAE7CAE7DAE84AE85AE8CAEBCAEBDAEBEAEC0AEC4AECCAECDAECF
+AED0AED1AED8AED9AEDCAEE8AEEBAEEDAEF4AEF8AEFCAF07AF08AF0DAF10AF2C
+AF2DAF30AF32AF34AF3CAF3DAF3FAF41AF42AF43AF48AF49AF50AF5CAF5DAF64
+AF65AF79AF80AF84AF88AF90AF91AF95AF9CAFB8AFB9AFBCAFC0AFC7AFC8AFC9
+AFCBAFCDAFCEAFD4AFDCAFE8AFE9AFF0AFF1AFF4AFF8B000B001B004B00CB010
+B014B01CB01DB028B044B045B048B04AB04CB04EB053B054B055B057B0590000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+33
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B05DB07CB07DB080B084B08CB08DB08FB091B098B099B09AB09CB09FB0A0
+B0A1B0A2B0A8B0A9B0ABB0ACB0ADB0AEB0AFB0B1B0B3B0B4B0B5B0B8B0BCB0C4
+B0C5B0C7B0C8B0C9B0D0B0D1B0D4B0D8B0E0B0E5B108B109B10BB10CB110B112
+B113B118B119B11BB11CB11DB123B124B125B128B12CB134B135B137B138B139
+B140B141B144B148B150B151B154B155B158B15CB160B178B179B17CB180B182
+B188B189B18BB18DB192B193B194B198B19CB1A8B1CCB1D0B1D4B1DCB1DD0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+34
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B1DFB1E8B1E9B1ECB1F0B1F9B1FBB1FDB204B205B208B20BB20CB214B215
+B217B219B220B234B23CB258B25CB260B268B269B274B275B27CB284B285B289
+B290B291B294B298B299B29AB2A0B2A1B2A3B2A5B2A6B2AAB2ACB2B0B2B4B2C8
+B2C9B2CCB2D0B2D2B2D8B2D9B2DBB2DDB2E2B2E4B2E5B2E6B2E8B2EBB2ECB2ED
+B2EEB2EFB2F3B2F4B2F5B2F7B2F8B2F9B2FAB2FBB2FFB300B301B304B308B310
+B311B313B314B315B31CB354B355B356B358B35BB35CB35EB35FB364B3650000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+35
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B367B369B36BB36EB370B371B374B378B380B381B383B384B385B38CB390
+B394B3A0B3A1B3A8B3ACB3C4B3C5B3C8B3CBB3CCB3CEB3D0B3D4B3D5B3D7B3D9
+B3DBB3DDB3E0B3E4B3E8B3FCB410B418B41CB420B428B429B42BB434B450B451
+B454B458B460B461B463B465B46CB480B488B49DB4A4B4A8B4ACB4B5B4B7B4B9
+B4C0B4C4B4C8B4D0B4D5B4DCB4DDB4E0B4E3B4E4B4E6B4ECB4EDB4EFB4F1B4F8
+B514B515B518B51BB51CB524B525B527B528B529B52AB530B531B534B5380000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+36
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B540B541B543B544B545B54BB54CB54DB550B554B55CB55DB55FB560B561
+B5A0B5A1B5A4B5A8B5AAB5ABB5B0B5B1B5B3B5B4B5B5B5BBB5BCB5BDB5C0B5C4
+B5CCB5CDB5CFB5D0B5D1B5D8B5ECB610B611B614B618B625B62CB634B648B664
+B668B69CB69DB6A0B6A4B6ABB6ACB6B1B6D4B6F0B6F4B6F8B700B701B705B728
+B729B72CB72FB730B738B739B73BB744B748B74CB754B755B760B764B768B770
+B771B773B775B77CB77DB780B784B78CB78DB78FB790B791B792B796B7970000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+37
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B798B799B79CB7A0B7A8B7A9B7ABB7ACB7ADB7B4B7B5B7B8B7C7B7C9B7EC
+B7EDB7F0B7F4B7FCB7FDB7FFB800B801B807B808B809B80CB810B818B819B81B
+B81DB824B825B828B82CB834B835B837B838B839B840B844B851B853B85CB85D
+B860B864B86CB86DB86FB871B878B87CB88DB8A8B8B0B8B4B8B8B8C0B8C1B8C3
+B8C5B8CCB8D0B8D4B8DDB8DFB8E1B8E8B8E9B8ECB8F0B8F8B8F9B8FBB8FDB904
+B918B920B93CB93DB940B944B94CB94FB951B958B959B95CB960B968B9690000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+38
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000B96BB96DB974B975B978B97CB984B985B987B989B98AB98DB98EB9ACB9AD
+B9B0B9B4B9BCB9BDB9BFB9C1B9C8B9C9B9CCB9CEB9CFB9D0B9D1B9D2B9D8B9D9
+B9DBB9DDB9DEB9E1B9E3B9E4B9E5B9E8B9ECB9F4B9F5B9F7B9F8B9F9B9FABA00
+BA01BA08BA15BA38BA39BA3CBA40BA42BA48BA49BA4BBA4DBA4EBA53BA54BA55
+BA58BA5CBA64BA65BA67BA68BA69BA70BA71BA74BA78BA83BA84BA85BA87BA8C
+BAA8BAA9BAABBAACBAB0BAB2BAB8BAB9BABBBABDBAC4BAC8BAD8BAD9BAFC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+39
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BB00BB04BB0DBB0FBB11BB18BB1CBB20BB29BB2BBB34BB35BB36BB38BB3B
+BB3CBB3DBB3EBB44BB45BB47BB49BB4DBB4FBB50BB54BB58BB61BB63BB6CBB88
+BB8CBB90BBA4BBA8BBACBBB4BBB7BBC0BBC4BBC8BBD0BBD3BBF8BBF9BBFCBBFF
+BC00BC02BC08BC09BC0BBC0CBC0DBC0FBC11BC14BC15BC16BC17BC18BC1BBC1C
+BC1DBC1EBC1FBC24BC25BC27BC29BC2DBC30BC31BC34BC38BC40BC41BC43BC44
+BC45BC49BC4CBC4DBC50BC5DBC84BC85BC88BC8BBC8CBC8EBC94BC95BC970000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BC99BC9ABCA0BCA1BCA4BCA7BCA8BCB0BCB1BCB3BCB4BCB5BCBCBCBDBCC0
+BCC4BCCDBCCFBCD0BCD1BCD5BCD8BCDCBCF4BCF5BCF6BCF8BCFCBD04BD05BD07
+BD09BD10BD14BD24BD2CBD40BD48BD49BD4CBD50BD58BD59BD64BD68BD80BD81
+BD84BD87BD88BD89BD8ABD90BD91BD93BD95BD99BD9ABD9CBDA4BDB0BDB8BDD4
+BDD5BDD8BDDCBDE9BDF0BDF4BDF8BE00BE03BE05BE0CBE0DBE10BE14BE1CBE1D
+BE1FBE44BE45BE48BE4CBE4EBE54BE55BE57BE59BE5ABE5BBE60BE61BE640000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000BE68BE6ABE70BE71BE73BE74BE75BE7BBE7CBE7DBE80BE84BE8CBE8DBE8F
+BE90BE91BE98BE99BEA8BED0BED1BED4BED7BED8BEE0BEE3BEE4BEE5BEECBF01
+BF08BF09BF18BF19BF1BBF1CBF1DBF40BF41BF44BF48BF50BF51BF55BF94BFB0
+BFC5BFCCBFCDBFD0BFD4BFDCBFDFBFE1C03CC051C058C05CC060C068C069C090
+C091C094C098C0A0C0A1C0A3C0A5C0ACC0ADC0AFC0B0C0B3C0B4C0B5C0B6C0BC
+C0BDC0BFC0C0C0C1C0C5C0C8C0C9C0CCC0D0C0D8C0D9C0DBC0DCC0DDC0E40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C0E5C0E8C0ECC0F4C0F5C0F7C0F9C100C104C108C110C115C11CC11DC11E
+C11FC120C123C124C126C127C12CC12DC12FC130C131C136C138C139C13CC140
+C148C149C14BC14CC14DC154C155C158C15CC164C165C167C168C169C170C174
+C178C185C18CC18DC18EC190C194C196C19CC19DC19FC1A1C1A5C1A8C1A9C1AC
+C1B0C1BDC1C4C1C8C1CCC1D4C1D7C1D8C1E0C1E4C1E8C1F0C1F1C1F3C1FCC1FD
+C200C204C20CC20DC20FC211C218C219C21CC21FC220C228C229C22BC22D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C22FC231C232C234C248C250C251C254C258C260C265C26CC26DC270C274
+C27CC27DC27FC281C288C289C290C298C29BC29DC2A4C2A5C2A8C2ACC2ADC2B4
+C2B5C2B7C2B9C2DCC2DDC2E0C2E3C2E4C2EBC2ECC2EDC2EFC2F1C2F6C2F8C2F9
+C2FBC2FCC300C308C309C30CC30DC313C314C315C318C31CC324C325C328C329
+C345C368C369C36CC370C372C378C379C37CC37DC384C388C38CC3C0C3D8C3D9
+C3DCC3DFC3E0C3E2C3E8C3E9C3EDC3F4C3F5C3F8C408C410C424C42CC4300000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C434C43CC43DC448C464C465C468C46CC474C475C479C480C494C49CC4B8
+C4BCC4E9C4F0C4F1C4F4C4F8C4FAC4FFC500C501C50CC510C514C51CC528C529
+C52CC530C538C539C53BC53DC544C545C548C549C54AC54CC54DC54EC553C554
+C555C557C558C559C55DC55EC560C561C564C568C570C571C573C574C575C57C
+C57DC580C584C587C58CC58DC58FC591C595C597C598C59CC5A0C5A9C5B4C5B5
+C5B8C5B9C5BBC5BCC5BDC5BEC5C4C5C5C5C6C5C7C5C8C5C9C5CAC5CCC5CE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C5D0C5D1C5D4C5D8C5E0C5E1C5E3C5E5C5ECC5EDC5EEC5F0C5F4C5F6C5F7
+C5FCC5FDC5FEC5FFC600C601C605C606C607C608C60CC610C618C619C61BC61C
+C624C625C628C62CC62DC62EC630C633C634C635C637C639C63BC640C641C644
+C648C650C651C653C654C655C65CC65DC660C66CC66FC671C678C679C67CC680
+C688C689C68BC68DC694C695C698C69CC6A4C6A5C6A7C6A9C6B0C6B1C6B4C6B8
+C6B9C6BAC6C0C6C1C6C3C6C5C6CCC6CDC6D0C6D4C6DCC6DDC6E0C6E1C6E80000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+40
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C6E9C6ECC6F0C6F8C6F9C6FDC704C705C708C70CC714C715C717C719C720
+C721C724C728C730C731C733C735C737C73CC73DC740C744C74AC74CC74DC74F
+C751C752C753C754C755C756C757C758C75CC760C768C76BC774C775C778C77C
+C77DC77EC783C784C785C787C788C789C78AC78EC790C791C794C796C797C798
+C79AC7A0C7A1C7A3C7A4C7A5C7A6C7ACC7ADC7B0C7B4C7BCC7BDC7BFC7C0C7C1
+C7C8C7C9C7CCC7CEC7D0C7D8C7DDC7E4C7E8C7ECC800C801C804C808C80A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+41
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C810C811C813C815C816C81CC81DC820C824C82CC82DC82FC831C838C83C
+C840C848C849C84CC84DC854C870C871C874C878C87AC880C881C883C885C886
+C887C88BC88CC88DC894C89DC89FC8A1C8A8C8BCC8BDC8C4C8C8C8CCC8D4C8D5
+C8D7C8D9C8E0C8E1C8E4C8F5C8FCC8FDC900C904C905C906C90CC90DC90FC911
+C918C92CC934C950C951C954C958C960C961C963C96CC970C974C97CC988C989
+C98CC990C998C999C99BC99DC9C0C9C1C9C4C9C7C9C8C9CAC9D0C9D1C9D30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+42
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000C9D5C9D6C9D9C9DAC9DCC9DDC9E0C9E2C9E4C9E7C9ECC9EDC9EFC9F0C9F1
+C9F8C9F9C9FCCA00CA08CA09CA0BCA0CCA0DCA14CA18CA29CA4CCA4DCA50CA54
+CA5CCA5DCA5FCA60CA61CA68CA7DCA84CA98CABCCABDCAC0CAC4CACCCACDCACF
+CAD1CAD3CAD8CAD9CAE0CAECCAF4CB08CB10CB14CB18CB20CB21CB41CB48CB49
+CB4CCB50CB58CB59CB5DCB64CB78CB79CB9CCBB8CBD4CBE4CBE7CBE9CC0CCC0D
+CC10CC14CC1CCC1DCC21CC22CC27CC28CC29CC2CCC2ECC30CC38CC39CC3B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+43
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CC3CCC3DCC3ECC44CC45CC48CC4CCC54CC55CC57CC58CC59CC60CC64CC66
+CC68CC70CC75CC98CC99CC9CCCA0CCA8CCA9CCABCCACCCADCCB4CCB5CCB8CCBC
+CCC4CCC5CCC7CCC9CCD0CCD4CCE4CCECCCF0CD01CD08CD09CD0CCD10CD18CD19
+CD1BCD1DCD24CD28CD2CCD39CD5CCD60CD64CD6CCD6DCD6FCD71CD78CD88CD94
+CD95CD98CD9CCDA4CDA5CDA7CDA9CDB0CDC4CDCCCDD0CDE8CDECCDF0CDF8CDF9
+CDFBCDFDCE04CE08CE0CCE14CE19CE20CE21CE24CE28CE30CE31CE33CE350000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+44
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000CE58CE59CE5CCE5FCE60CE61CE68CE69CE6BCE6DCE74CE75CE78CE7CCE84
+CE85CE87CE89CE90CE91CE94CE98CEA0CEA1CEA3CEA4CEA5CEACCEADCEC1CEE4
+CEE5CEE8CEEBCEECCEF4CEF5CEF7CEF8CEF9CF00CF01CF04CF08CF10CF11CF13
+CF15CF1CCF20CF24CF2CCF2DCF2FCF30CF31CF38CF54CF55CF58CF5CCF64CF65
+CF67CF69CF70CF71CF74CF78CF80CF85CF8CCFA1CFA8CFB0CFC4CFE0CFE1CFE4
+CFE8CFF0CFF1CFF3CFF5CFFCD000D004D011D018D02DD034D035D038D03C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+45
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D044D045D047D049D050D054D058D060D06CD06DD070D074D07CD07DD081
+D0A4D0A5D0A8D0ACD0B4D0B5D0B7D0B9D0C0D0C1D0C4D0C8D0C9D0D0D0D1D0D3
+D0D4D0D5D0DCD0DDD0E0D0E4D0ECD0EDD0EFD0F0D0F1D0F8D10DD130D131D134
+D138D13AD140D141D143D144D145D14CD14DD150D154D15CD15DD15FD161D168
+D16CD17CD184D188D1A0D1A1D1A4D1A8D1B0D1B1D1B3D1B5D1BAD1BCD1C0D1D8
+D1F4D1F8D207D209D210D22CD22DD230D234D23CD23DD23FD241D248D25C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+46
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D264D280D281D284D288D290D291D295D29CD2A0D2A4D2ACD2B1D2B8D2B9
+D2BCD2BFD2C0D2C2D2C8D2C9D2CBD2D4D2D8D2DCD2E4D2E5D2F0D2F1D2F4D2F8
+D300D301D303D305D30CD30DD30ED310D314D316D31CD31DD31FD320D321D325
+D328D329D32CD330D338D339D33BD33CD33DD344D345D37CD37DD380D384D38C
+D38DD38FD390D391D398D399D39CD3A0D3A8D3A9D3ABD3ADD3B4D3B8D3BCD3C4
+D3C5D3C8D3C9D3D0D3D8D3E1D3E3D3ECD3EDD3F0D3F4D3FCD3FDD3FFD4010000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+47
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D408D41DD440D444D45CD460D464D46DD46FD478D479D47CD47FD480D482
+D488D489D48BD48DD494D4A9D4CCD4D0D4D4D4DCD4DFD4E8D4ECD4F0D4F8D4FB
+D4FDD504D508D50CD514D515D517D53CD53DD540D544D54CD54DD54FD551D558
+D559D55CD560D565D568D569D56BD56DD574D575D578D57CD584D585D587D588
+D589D590D5A5D5C8D5C9D5CCD5D0D5D2D5D8D5D9D5DBD5DDD5E4D5E5D5E8D5EC
+D5F4D5F5D5F7D5F9D600D601D604D608D610D611D613D614D615D61CD6200000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+48
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000D624D62DD638D639D63CD640D645D648D649D64BD64DD651D654D655D658
+D65CD667D669D670D671D674D683D685D68CD68DD690D694D69DD69FD6A1D6A8
+D6ACD6B0D6B9D6BBD6C4D6C5D6C8D6CCD6D1D6D4D6D7D6D9D6E0D6E4D6E8D6F0
+D6F5D6FCD6FDD700D704D711D718D719D71CD720D728D729D72BD72DD734D735
+D738D73CD744D747D749D750D751D754D756D757D758D759D760D761D763D765
+D769D76CD770D774D77CD77DD781D788D789D78CD790D798D799D79BD79D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004F3D4F73504750F952A053EF547554E556095AC15BB6668767B667B767EF
+6B4C73C275C27A3C82DB8304885788888A368CC88DCF8EFB8FE699D5523B5374
+5404606A61646BBC73CF811A89BA89D295A34F83520A58BE597859E65E725E79
+61C763C0674667EC687F6F97764E770B78F57A087AFF7C21809D826E82718AEB
+95934E6B559D66F76E3478A37AED845B8910874E97A852D8574E582A5D4C611F
+61BE6221656267D16A446E1B751875B376E377B07D3A90AF945194529F950000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000053235CAC753280DB92409598525B580859DC5CA15D175EB75F3A5F4A6177
+6C5F757A75867CE07D737DB17F8C81548221859189418B1B92FC964D9C474ECB
+4EF7500B51F1584F6137613E6168653969EA6F1175A5768676D67B8782A584CB
+F90093A7958B55805BA25751F9017CB37FB991B5502853BB5C455DE862D2636E
+64DA64E76E2070AC795B8DDD8E1EF902907D924592F84E7E4EF650655DFE5EFA
+61066957817186548E4793759A2B4E5E5091677068405109528D52926AA20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000077BC92109ED452AB602F8FF2504861A963ED64CA683C6A846FC0818889A1
+96945805727D72AC75047D797E6D80A9898B8B7490639D5162896C7A6F547D50
+7F3A8A23517C614A7B9D8B199257938C4EAC4FD3501E50BE510652C152CD537F
+577058835E9A5F91617661AC64CE656C666F66BB66F468976D87708570F1749F
+74A574CA75D9786C78EC7ADF7AF67D457D938015803F811B83968B668F159015
+93E1980398389A5A9BE84FC25553583A59515B635C4660B86212684268B00000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068E86EAA754C767878CE7A3D7CFB7E6B7E7C8A088AA18C3F968E9DC453E4
+53E9544A547156FA59D15B645C3B5EAB62F765376545657266A067AF69C16CBD
+75FC7690777E7A3F7F94800380A1818F82E682FD83F085C1883188B48AA5F903
+8F9C932E96C798679AD89F1354ED659B66F2688F7A408C379D6056F057645D11
+660668B168CD6EFE7428889E9BE46C68F9049AA84F9B516C5171529F5B545DE5
+6050606D62F163A7653B73D97A7A86A38CA2978F4E325BE16208679C74DC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000079D183D38A878AB28DE8904E934B98465ED369E885FF90EDF90551A05B98
+5BEC616368FA6B3E704C742F74D87BA17F5083C589C08CAB95DC9928522E605D
+62EC90024F8A5149532158D95EE366E06D38709A72C273D67B5080F1945B5366
+639B7F6B4E565080584A58DE602A612762D069D09B415B8F7D1880B18F5F4EA4
+50D154AC55AC5B0C5DA05DE7652A654E68216A4B72E1768E77EF7D5E7FF981A0
+854E86DF8F038F4E90CA99039A559BAB4E184E454E5D4EC74FF1517752FE0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+4F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000534053E353E5548E5614577557A25BC75D875ED061FC62D8655167B867E9
+69CB6B506BC66BEC6C426E9D707872D77396740377BF77E97A767D7F800981FC
+8205820A82DF88628B338CFC8EC0901190B1926492B699D29A459CE99DD79F9C
+570B5C4083CA97A097AB9EB4541B7A987FA488D98ECD90E158005C4863987A9F
+5BAE5F137A797AAE828E8EAC5026523852F85377570862F363726B0A6DC37737
+53A5735785688E7695D5673A6AC36F708A6D8ECC994BF90666776B788CB40000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00009B3CF90753EB572D594E63C669FB73EA78457ABA7AC57CFE8475898F8D73
+903595A852FB574775477B6083CC921EF9086A58514B524B5287621F68D86975
+969950C552A452E461C365A4683969FF747E7B4B82B983EB89B28B398FD19949
+F9094ECA599764D266116A8E7434798179BD82A9887E887F895FF90A93264F0B
+53CA602562716C727D1A7D664E98516277DC80AF4F014F0E5176518055DC5668
+573B57FA57FC5914594759935BC45C905D0E5DF15E7E5FCC628065D765E30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+51
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000671E671F675E68CB68C46A5F6B3A6C236C7D6C826DC773987426742A7482
+74A37578757F788178EF794179477948797A7B957D007DBA7F888006802D808C
+8A188B4F8C488D779321932498E299519A0E9A0F9A659E927DCA4F76540962EE
+685491D155AB513AF90BF90C5A1C61E6F90D62CF62FFF90EF90FF910F911F912
+F91390A3F914F915F916F917F9188AFEF919F91AF91BF91C6696F91D7156F91E
+F91F96E3F920634F637A5357F921678F69606E73F9227537F923F924F9250000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+52
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007D0DF926F927887256CA5A18F928F929F92AF92BF92C4E43F92D51675948
+67F08010F92E59735E74649A79CA5FF5606C62C8637B5BE75BD752AAF92F5974
+5F296012F930F931F9327459F933F934F935F936F937F93899D1F939F93AF93B
+F93CF93DF93EF93FF940F941F942F9436FC3F944F94581BF8FB260F1F946F947
+8166F948F9495C3FF94AF94BF94CF94DF94EF94FF950F9515AE98A25677B7D10
+F952F953F954F955F956F95780FDF958F9595C3C6CE5533F6EBA591A83360000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00004E394EB64F4655AE571858C75F5665B765E66A806BB56E4D77ED7AEF7C1E
+7DDE86CB88929132935B64BB6FBE737A75B890545556574D61BA64D466C76DE1
+6E5B6F6D6FB975F0804381BD854189838AC78B5A931F6C9375537B548E0F905D
+5510580258585E626207649E68E075767CD687B39EE84EE35788576E59275C0D
+5CB15E365F85623464E173B381FA888B8CB8968A9EDB5B855FB760B350125200
+52305716583558575C0E5C605CF65D8B5EA65F9260BC63116389641768430000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000068F96AC26DD86E216ED46FE471FE76DC777979B17A3B840489A98CED8DF3
+8E4890039014905390FD934D967697DC6BD27006725872A27368776379BF7BE4
+7E9B8B8058A960C7656665FD66BE6C8C711E71C98C5A98134E6D7A814EDD51AC
+51CD52D5540C61A76771685068DF6D1E6F7C75BC77B37AE580F484639285515C
+6597675C679375D87AC78373F95A8C469017982D5C6F81C0829A9041906F920D
+5F975D9D6A5971C8767B7B4985E48B0491279A30558761F6F95B76697F850000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+55
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000863F87BA88F8908FF95C6D1B70D973DE7D61843DF95D916A99F1F95E4E82
+53756B046B12703E721B862D9E1E524C8FA35D5064E5652C6B166FEB7C437E9C
+85CD896489BD62C981D8881F5ECA67176D6A72FC7405746F878290DE4F865D0D
+5FA0840A51B763A075654EAE5006516951C968816A117CAE7CB17CE7826F8AD2
+8F1B91CF4FB6513752F554425EEC616E623E65C56ADA6FFE792A85DC882395AD
+9A629A6A9E979ECE529B66C66B77701D792B8F6297426190620065236F230000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+56
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000714974897DF4806F84EE8F269023934A51BD521752A36D0C70C888C25EC9
+65826BAE6FC27C3E73754EE44F3656F9F95F5CBA5DBA601C73B27B2D7F9A7FCE
+8046901E923496F6974898189F614F8B6FA779AE91B496B752DEF960648864C4
+6AD36F5E7018721076E780018606865C8DEF8F0597329B6F9DFA9E75788C797F
+7DA083C993049E7F9E938AD658DF5F046727702774CF7C60807E512170287262
+78CA8CC28CDA8CF496F74E8650DA5BEE5ED6659971CE764277AD804A84FC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+57
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000907C9B279F8D58D85A415C626A136DDA6F0F763B7D2F7E37851E893893E4
+964B528965D267F369B46D416E9C700F7409746075597624786B8B2C985E516D
+622E96784F96502B5D196DEA7DB88F2A5F8B61446817F961968652D2808B51DC
+51CC695E7A1C7DBE83F196754FDA52295398540F550E5C6560A7674E68A86D6C
+728172F874067483F96275E27C6C7F797FB8838988CF88E191CC91D096E29BC9
+541D6F7E71D0749885FA8EAA96A39C579E9F67976DCB743381E89716782C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+58
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007ACB7B207C926469746A75F278BC78E899AC9B549EBB5BDE5E556F20819C
+83AB90884E07534D5A295DD25F4E6162633D666966FC6EFF6F2B7063779E842C
+8513883B8F1399459C3B551C62B9672B6CAB8309896A977A4EA159845FD85FD9
+671B7DB27F548292832B83BD8F1E909957CB59B95A925BD06627679A68856BCF
+71647F758CB78CE390819B4581088C8A964C9A409EA55B5F6C13731B76F276DF
+840C51AA8993514D519552C968C96C94770477207DBF7DEC97629EB56EC50000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000851151A5540D547D660E669D69276E9F76BF7791831784C2879F91699298
+9CF488824FAE519252DF59C65E3D61556478647966AE67D06A216BCD6BDB725F
+72617441773877DB801782BC83058B008B288C8C67286C90726776EE77667A46
+9DA96B7F6C92592267268499536F589359995EDF63CF663467736E3A732B7AD7
+82D7932852D95DEB61AE61CB620A62C764AB65E069596B666BCB712173F7755D
+7E46821E8302856A8AA38CBF97279D6158A89ED85011520E543B554F65870000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006C767D0A7D0B805E868A958096EF52FF6C95726954735A9A5C3E5D4B5F4C
+5FAE672A68B669636E3C6E4477097C737F8E85878B0E8FF797619EF45CB760B6
+610D61AB654F65FB65FC6C116CEF739F73C97DE195945BC6871C8B10525D535A
+62CD640F64B267346A386CCA73C0749E7B947C957E1B818A823685848FEB96F9
+99C14F34534A53CD53DB62CC642C6500659169C36CEE6F5873ED7554762276E4
+76FC78D078FB792C7D46822C87E08FD4981298EF52C362D464A56E246F510000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000767C8DCB91B192629AEE9B435023508D574A59A85C285E475F77623F653E
+65B965C16609678B699C6EC278C57D2180AA8180822B82B384A1868C8A2A8B17
+90A696329F90500D4FF3F96357F95F9862DC6392676F6E43711976C380CC80DA
+88F488F589198CE08F29914D966A4F2F4F705E1B67CF6822767D767E9B445E61
+6A0A716971D4756AF9647E41854385E998DC4F107B4F7F7095A551E15E0668B5
+6C3E6C4E6CDB72AF7BC483036CD5743A50FB528858C164D86A9774A776560000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000078A7861795E29739F965535E5F018B8A8FA88FAF908A522577A59C499F08
+4E19500251755C5B5E77661E663A67C468C570B3750175C579C97ADD8F279920
+9A084FDD582158315BF6666E6B656D116E7A6F7D73E4752B83E988DC89138B5C
+8F144F0F50D55310535C5B935FA9670D798F8179832F8514890789868F398F3B
+99A59C12672C4E764FF859495C015CEF5CF0636768D270FD71A2742B7E2B84EC
+8702902292D29CF34E0D4ED84FEF50855256526F5426549057E0592B5A660000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005B5A5B755BCC5E9CF9666276657765A76D6E6EA572367B267C3F7F368150
+8151819A8240829983A98A038CA08CE68CFB8D748DBA90E891DC961C964499D9
+9CE7531752065429567458B35954596E5FFF61A4626E66106C7E711A76C67C89
+7CDE7D1B82AC8CC196F0F9674F5B5F175F7F62C25D29670B68DA787C7E439D6C
+4E1550995315532A535159835A625E8760B2618A624962796590678769A76BD4
+6BD66BD76BD86CB8F968743575FA7812789179D579D87C837DCB7FE180A50000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000813E81C283F2871A88E88AB98B6C8CBB9119975E98DB9F3B56AC5B2A5F6C
+658C6AB36BAF6D5C6FF17015725D73AD8CA78CD3983B61916C3780589A014E4D
+4E8B4E9B4ED54F3A4F3C4F7F4FDF50FF53F253F8550655E356DB58EB59625A11
+5BEB5BFA5C045DF35E2B5F99601D6368659C65AF67F667FB68AD6B7B6C996CD7
+6E23700973457802793E7940796079C17BE97D177D728086820D838E84D186C7
+88DF8A508A5E8B1D8CDC8D668FAD90AA98FC99DF9E9D524AF9696714F96A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005098522A5C7165636C5573CA7523759D7B97849C917897304E7764926BBA
+715E85A94E09F96B674968EE6E17829F8518886B63F76F81921298AF4E0A50B7
+50CF511F554655AA56175B405C195CE05E385E8A5EA05EC260F368516A616E58
+723D724072C076F879657BB17FD488F389F48A738C618CDE971C585E74BD8CFD
+55C7F96C7A617D2282727272751F7525F96D7B19588558FB5DBC5E8F5EB65F90
+60556292637F654D669166D966F8681668F27280745E7B6E7D6E7DD67F720000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+60
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000080E5821285AF897F8A93901D92E49ECD9F205915596D5E2D60DC66146673
+67906C506DC56F5F77F378A984C691CB932B4ED950CA514855845B0B5BA36247
+657E65CB6E32717D74017444748774BF766C79AA7DDA7E557FA8817A81B38239
+861A87EC8A758DE3907892919425994D9BAE53685C5169546CC46D296E2B820C
+859B893B8A2D8AAA96EA9F67526166B96BB27E9687FE8D0D9583965D651D6D89
+71EEF96E57CE59D35BAC602760FA6210661F665F732973F976DB77017B6C0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+61
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008056807281658AA091924E1652E26B726D177A057B397D30F96F8CB053EC
+562F58515BB55C0F5C115DE2624063836414662D68B36CBC6D886EAF701F70A4
+71D27526758F758E76197B117BE07C2B7D207D39852C856D86078A34900D9061
+90B592B797F69A374FD75C6C675F6D917C9F7E8C8B168D16901F5B6B5DFD640D
+84C0905C98E173875B8B609A677E6DDE8A1F8AA69001980C5237F9707051788E
+9396887091D74FEE53D755FD56DA578258FD5AC25B885CAB5CC05E2561010000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000620D624B6388641C653665786A396B8A6C346D196F3171E772E973787407
+74B27626776179C07A577AEA7CB97D8F7DAC7E617F9E81298331849084DA85EA
+88968AB08B908F3890429083916C929692B9968B96A796A896D6970098089996
+9AD39B1A53D4587E59195B705BBF6DD16F5A719F742174B9808583FD5DE15F87
+5FAA604265EC6812696F6A536B896D356DF373E376FE77AC7B4D7D148123821C
+834084F485638A628AC49187931E980699B4620C88538FF092655D075D270000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005D69745F819D87686FD562FE7FD2893689724E1E4E5850E752DD5347627F
+66077E698805965E4F8D5319563659CB5AA45C385C4E5C4D5E025F11604365BD
+662F664267BE67F4731C77E2793A7FC5849484CD89968A668A698AE18C558C7A
+57F45BD45F0F606F62ED690D6B966E5C71847BD287558B588EFE98DF98FE4F38
+4F814FE1547B5A205BB8613C65B0666871FC7533795E7D33814E81E3839885AA
+85CE87038A0A8EAB8F9BF9718FC559315BA45BE660895BE95C0B5FC36C810000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+64
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9726DF1700B751A82AF8AF64EC05341F97396D96C0F4E9E4FC45152555E
+5A255CE86211725982BD83AA86FE88598A1D963F96C599139D099D5D580A5CB3
+5DBD5E4460E1611563E16A026E2591029354984E9C109F775B895CB86309664F
+6848773C96C1978D98549B9F65A18B018ECB95BC55355CA95DD65EB56697764C
+83F495C758D362BC72CE9D284EF0592E600F663B6B8379E79D26539354C057C3
+5D16611B66D66DAF788D827E969897445384627C63966DB27E0A814B984D0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+65
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006AFB7F4C9DAF9E1A4E5F503B51B6591C60F963F66930723A8036F97491CE
+5F31F975F9767D0482E5846F84BB85E58E8DF9774F6FF978F97958E45B436059
+63DA6518656D6698F97A694A6A236D0B7001716C75D2760D79B37A70F97B7F8A
+F97C8944F97D8B9391C0967DF97E990A57045FA165BC6F01760079A68A9E99AD
+9B5A9F6C510461B662916A8D81C6504358305F6671098A008AFA5B7C86164FFA
+513C56B4594463A96DF95DAA696D51864E884F59F97FF980F9815982F9820000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+66
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9836B5F6C5DF98474B57916F9858207824583398F3F8F5DF9869918F987
+F988F9894EA6F98A57DF5F796613F98BF98C75AB7E798B6FF98D90069A5B56A5
+582759F85A1F5BB4F98E5EF6F98FF9906350633BF991693D6C876CBF6D8E6D93
+6DF56F14F99270DF71367159F99371C371D5F994784F786FF9957B757DE3F996
+7E2FF997884D8EDFF998F999F99A925BF99B9CF6F99CF99DF99E60856D85F99F
+71B1F9A0F9A195B153ADF9A2F9A3F9A467D3F9A5708E71307430827682D20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+67
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9A695BB9AE59E7D66C4F9A771C18449F9A8F9A9584BF9AAF9AB5DB85F71
+F9AC6620668E697969AE6C386CF36E366F416FDA701B702F715071DF7370F9AD
+745BF9AE74D476C87A4E7E93F9AFF9B082F18A608FCEF9B19348F9B29719F9B3
+F9B44E42502AF9B5520853E166F36C6D6FCA730A777F7A6282AE85DD8602F9B6
+88D48A638B7D8C6BF9B792B3F9B8971398104E944F0D4FC950B25348543E5433
+55DA586258BA59675A1B5BE4609FF9B961CA655665FF666468A76C5A6FB30000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+68
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000070CF71AC73527B7D87088AA49C329F075C4B6C8373447389923A6EAB7465
+761F7A697E15860A514058C564C174EE751576707FC1909596CD99546E2674E6
+7AA97AAA81E586D987788A1B5A495B8C5B9B68A169006D6373A97413742C7897
+7DE97FEB81188155839E8C4C962E981166F05F8065FA67896C6A738B502D5A03
+6B6A77EE59165D6C5DCD7325754FF9BAF9BB50E551F9582F592D599659DA5BE5
+F9BCF9BD5DA262D76416649364FEF9BE66DCF9BF6A48F9C071FF7464F9C10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+69
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00007A887AAF7E477E5E80008170F9C287EF89818B209059F9C390809952617E
+6B326D747E1F89258FB14FD150AD519752C757C758895BB95EB8614269956D8C
+6E676EB6719474627528752C8073833884C98E0A939493DEF9C44E8E4F515076
+512A53C853CB53F35B875BD35C24611A618265F4725B7397744076C279507991
+79B97D067FBD828B85D5865E8FC2904790F591EA968596E896E952D65F6765ED
+6631682F715C7A3690C1980A4E91F9C56A526B9E6F907189801882B885530000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000904B969596F297FB851A9B314E90718A96C45143539F54E15713571257A3
+5A9B5AC45BC36028613F63F46C856D396E726E907230733F745782D188818F45
+9060F9C6966298589D1B67088D8A925E4F4D504950DE5371570D59D45A015C09
+617066906E2D7232744B7DEF80C3840E8466853F875F885B89188B02905597CB
+9B4F4E734F915112516AF9C7552F55A95B7A5BA55E7C5E7D5EBE60A060DF6108
+610963C465386709F9C867D467DAF9C9696169626CB96D27F9CA6E38F9CB0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006FE173367337F9CC745C7531F9CD7652F9CEF9CF7DAD81FE843888D58A98
+8ADB8AED8E308E42904A903E907A914991C9936EF9D0F9D15809F9D26BD38089
+80B2F9D3F9D45141596B5C39F9D5F9D66F6473A780E48D07F9D79217958FF9D8
+F9D9F9DAF9DB807F620E701C7D68878DF9DC57A0606961476BB78ABE928096B1
+4E59541F6DEB852D967097F398EE63D66CE3909151DD61C981BA9DF94F9D501A
+51005B9C610F61FF64EC69056BC5759177E37FA98264858F87FB88638ABC0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008B7091AB4E8C4EE54F0AF9DDF9DE593759E8F9DF5DF25F1B5F5B6021F9E0
+F9E1F9E2F9E3723E73E5F9E4757075CDF9E579FBF9E6800C8033808482E18351
+F9E7F9E88CBD8CB39087F9E9F9EA98F4990CF9EBF9EC703776CA7FCA7FCC7FFC
+8B1A4EBA4EC152035370F9ED54BD56E059FB5BC55F155FCD6E6EF9EEF9EF7D6A
+8335F9F086938A8DF9F1976D9777F9F2F9F34E004F5A4F7E58F965E56EA29038
+93B099B94EFB58EC598A59D96041F9F4F9F57A14F9F6834F8CC3516553440000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F9F7F9F8F9F94ECD52695B5582BF4ED4523A54A859C959FF5B505B575B5C
+606361486ECB7099716E738674F775B578C17D2B800581EA8328851785C98AEE
+8CC796CC4F5C52FA56BC65AB6628707C70B872357DBD828D914C96C09D725B71
+68E76B986F7A76DE5C9166AB6F5B7BB47C2A883696DC4E084ED75320583458BB
+58EF596C5C075E335E845F35638C66B267566A1F6AA36B0C6F3F7246F9FA7350
+748B7AE07CA7817881DF81E7838A846C8523859485CF88DD8D1391AC95770000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000969C518D54C957285BB0624D6750683D68936E3D6ED3707D7E2188C18CA1
+8F099F4B9F4E722D7B8F8ACD931A4F474F4E5132548059D05E9562B56775696E
+6A176CAE6E1A72D9732A75BD7BB87D3582E783F9845785F78A5B8CAF8E879019
+90B896CE9F5F52E3540A5AE15BC2645865756EF472C4F9FB76847A4D7B1B7C4D
+7E3E7FDF837B8B2B8CCA8D648DE18E5F8FEA8FF9906993D14F434F7A50B35168
+5178524D526A5861587C59605C085C555EDB609B623068136BBF6C086FB10000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000714E742075307538755176727B4C7B8B7BAD7BC67E8F8A6E8F3E8F49923F
+92939322942B96FB985A986B991E5207622A62986D5976647ACA7BC07D765360
+5CBE5E976F3870B97C9897119B8E9EDE63A5647A87764E014E954EAD505C5075
+544859C35B9A5E405EAD5EF75F8160C5633A653F657465CC6676667867FE6968
+6A896B636C406DC06DE86E1F6E5E701E70A1738E73FD753A775B7887798E7A0B
+7A7D7CBE7D8E82478A028AEA8C9E912D914A91D8926692CC9320970697560000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+70
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000975C98029F0E52365291557C58245E1D5F1F608C63D068AF6FDF796D7B2C
+81CD85BA88FD8AF88E44918D9664969B973D984C9F4A4FCE514651CB52A95632
+5F145F6B63AA64CD65E9664166FA66F9671D689D68D769FD6F156F6E716771E5
+722A74AA773A7956795A79DF7A207A957C977CDF7D447E70808785FB86A48A54
+8ABF8D998E819020906D91E3963B96D59CE565CF7C078DB393C35B585C0A5352
+62D9731D50275B975F9E60B0616B68D56DD9742E7A2E7D427D9C7E31816B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+71
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008E2A8E35937E94184F5057505DE65EA7632B7F6A4E3B4F4F4F8F505A59DD
+80C4546A546855FE594F5B995DDE5EDA665D673167F1682A6CE86D326E4A6F8D
+70B773E075877C4C7D027D2C7DA2821F86DB8A3B8A858D708E8A8F339031914E
+9152944499D07AF97CA54FCA510151C657C85BEF5CFB66596A3D6D5A6E966FEC
+710C756F7AE388229021907596CB99FF83014E2D4EF2884691CD537D6ADB696B
+6C41847A589E618E66FE62EF70DD751175C77E5284B88B498D084E4B53EA0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+72
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054AB573057405FD763016307646F652F65E8667A679D67B36B626C606C9A
+6F2C77E57825794979577D1980A2810281F3829D82B787188A8CF9FC8D048DBE
+907276F47A197A377E548077550755D45875632F64226649664B686D699B6B84
+6D256EB173CD746874A1755B75B976E1771E778B79E67E097E1D81FB852F8897
+8A3A8CD18EEB8FB0903293AD9663967397074F8453F159EA5AC95E19684E74C6
+75BE79E97A9281A386ED8CEA8DCC8FED659F6715F9FD57F76F577DDD8F2F0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+73
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000093F696C65FB561F26F844E144F98501F53C955DF5D6F5DEE6B216B6478CB
+7B9AF9FE8E498ECA906E6349643E77407A84932F947F9F6A64B06FAF71E674A8
+74DA7AC47C127E827CB27E988B9A8D0A947D9910994C52395BDF64E6672D7D2E
+50ED53C358796158615961FA65AC7AD98B928B9650095021527555315A3C5EE0
+5F706134655E660C663666A269CD6EC46F32731676217A938139825983D684BC
+50B557F05BC05BE85F6963A178267DB583DC852191C791F5518A67F57B560000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008CAC51C459BB60BD8655501CF9FF52545C3A617D621A62D364F265A56ECC
+7620810A8E60965F96BB4EDF5343559859295DDD64C56CC96DFA73947A7F821B
+85A68CE48E10907791E795E1962197C651F854F255865FB964A46F887DB48F1F
+8F4D943550C95C166CBE6DFB751B77BB7C3D7C648A798AC2581E59BE5E166377
+7252758A776B8ADC8CBC8F125EF366746DF8807D83C18ACB97519BD6FA005243
+66FF6D956EEF7DE08AE6902E905E9AD4521D527F54E86194628462DB68A20000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+75
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00006912695A6A3570927126785D7901790E79D27A0D8096827882D583498549
+8C828D859162918B91AE4FC356D171ED77D7870089F85BF85FD6675190A853E2
+585A5BF560A4618164607E3D80708525928364AE50AC5D146700589C62BD63A8
+690E69786A1E6E6B76BA79CB82BB84298ACF8DA88FFD9112914B919C93109318
+939A96DB9A369C0D4E11755C795D7AFA7B517BC97E2E84C48E598E748EF89010
+6625693F744351FA672E9EDC51455FE06C9687F2885D887760B481B584030000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+76
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00008D0553D6543956345A365C31708A7FE0805A810681ED8DA391899A5F9DF2
+50744EC453A060FB6E2C5C644F88502455E45CD95E5F606568946CBB6DC471BE
+75D475F476617A1A7A497DC77DFB7F6E81F486A98F1C96C999B39F52524752C5
+98ED89AA4E0367D26F064FB55BE267956C886D78741B782791DD937C87C479E4
+7A315FEB4ED654A4553E58AE59A560F0625362D6673669558235964099B199DD
+502C53535544577CFA016258FA0264E2666B67DD6FC16FEF742274388A170000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+77
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000094385451560657665F48619A6B4E705870AD7DBB8A95596A812B63A27708
+803D8CAA5854642D69BB5B955E116E6FFA038569514C53F0592A6020614B6B86
+6C706CF07B1E80CE82D48DC690B098B1FA0464C76FA464916504514E5410571F
+8A0E615F6876FA0575DB7B527D71901A580669CC817F892A9000983950785957
+59AC6295900F9B2A615D727995D657615A465DF4628A64AD64FA67776CE26D3E
+722C743678347F7782AD8DDB981752245742677F724874E38CA98FA692110000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+78
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000962A516B53ED634C4F695504609665576C9B6D7F724C72FD7A1789878C9D
+5F6D6F8E70F981A8610E4FBF504F624172477BC77DE87FE9904D97AD9A198CB6
+576A5E7367B0840D8A5554205B165E635EE25F0A658380BA853D9589965B4F48
+5305530D530F548654FA57035E036016629B62B16355FA066CE16D6675B17832
+80DE812F82DE846184B2888D8912900B92EA98FD9B915E4566B466DD70117206
+FA074FF5527D5F6A615367536A196F0274E2796888688C7998C798C49A430000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+79
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000054C17A1F69538AF78C4A98A899AE5F7C62AB75B276AE88AB907F96425339
+5F3C5FC56CCC73CC7562758B7B4682FE999D4E4F903C4E0B4F5553A6590F5EC8
+66306CB37455837787668CC09050971E9C1558D15B7886508B149DB45BD26068
+608D65F16C576F226FA3701A7F557FF095919592965097D352728F4451FD542B
+54B85563558A6ABB6DB57DD88266929C96779E79540854C876D286E495A495D4
+965C4EA24F0959EE5AE65DF760526297676D68416C866E2F7F38809B822A0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FA08FA0998054EA5505554B35793595A5B695BB361C869776D77702387F9
+89E38A728AE7908299ED9AB852BE683850165E78674F8347884C4EAB541156AE
+73E6911597FF9909995799995653589F865B8A3161B26AF6737B8ED26B4796AA
+9A57595572008D6B97694FD45CF45F2661F8665B6CEB70AB738473B973FE7729
+774D7D437D627E2382378852FA0A8CE29249986F5B517A74884098015ACC4FE0
+5354593E5CFD633E6D7972F98105810783A292CF98304EA851445211578B0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00005F626CC26ECE7005705070AF719273E97469834A87A28861900890A293A3
+99A8516E5F5760E0616766B385598E4A91AF978B4E4E4E92547C58D558FA597D
+5CB55F2762366248660A66676BEB6D696DCF6E566EF86F946FE06FE9705D72D0
+7425745A74E07693795C7CCA7E1E80E182A6846B84BF864E865F87748B778C6A
+93AC9800986560D1621691775A5A660F6DF76E3E743F9B425FFD60DA7B0F54C4
+5F186C5E6CD36D2A70D87D0586798A0C9D3B5316548C5B056A3A706B75750000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000798D79BE82B183EF8A718B418CA89774FA0B64F4652B78BA78BB7A6B4E38
+559A59505BA65E7B60A363DB6B61666568536E19716574B07D0890849A699C25
+6D3B6ED1733E8C4195CA51F05E4C5FA8604D60F66130614C6643664469A56CC1
+6E5F6EC96F62714C749C76877BC17C27835287579051968D9EC3532F56DE5EFB
+5F8A6062609461F7666667036A9C6DEE6FAE7070736A7E6A81BE833486D48AA8
+8CC4528373725B966A6B940454EE56865B5D6548658566C9689F6D8D6DC60000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000723B80B491759A4D4FAF5019539A540E543C558955C55E3F5F8C673D7166
+73DD900552DB52F3586458CE7104718F71FB85B08A13668885A855A76684714A
+8431534955996BC15F595FBD63EE668971478AF18F1D9EBE4F11643A70CB7566
+866760648B4E9DF8514751F653086D3680F89ED166156B23709875D554035C79
+7D078A166B206B3D6B46543860706D3D7FD5820850D651DE559C566B56CD59EC
+5B095E0C619961986231665E66E6719971B971BA72A779A77A007FB28A700000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/macCentEuro.enc b/tcl/library/encoding/macCentEuro.enc
new file mode 100644
index 00000000000..dde616a4cb7
--- /dev/null
+++ b/tcl/library/encoding/macCentEuro.enc
@@ -0,0 +1,20 @@
+# Encoding file: macCentEuro, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C40100010100C9010400D600DC00E10105010C00E4010D0106010700E90179
+017A010E00ED010F01120113011600F3011700F400F600F500FA011A011B00FC
+202000B0011800A300A7202200B600DF00AE00A92122011900A822600123012E
+012F012A22642265012B0136220222110142013B013C013D013E0139013A0145
+0146014300AC221A01440147220600AB00BB202600A00148015000D50151014C
+20132014201C201D2018201900F725CA014D0154015501582039203A01590156
+01570160201A201E0161015A015B00C10164016500CD017D017E016A00D300D4
+016B016E00DA016F017001710172017300DD00FD0137017B0141017C012202C7
diff --git a/tcl/library/encoding/macCroatian.enc b/tcl/library/encoding/macCroatian.enc
new file mode 100644
index 00000000000..132a74c789c
--- /dev/null
+++ b/tcl/library/encoding/macCroatian.enc
@@ -0,0 +1,20 @@
+# Encoding file: macCroatian, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
+00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
+202000B000A200A300A7202200B600DF00AE0160212200B400A82260017D00D8
+221E00B122642265220600B522022211220F0161222B00AA00BA2126017E00F8
+00BF00A100AC221A01922248010600AB010C202600A000C000C300D501520153
+01102014201C201D2018201900F725CAF8FF00A9204400A42039203A00C600BB
+201300B7201A201E203000C2010700C1010D00C800CD00CE00CF00CC00D300D4
+011100D200DA00DB00D9013102C602DC00AF03C000CB02DA00B800CA00E602C7
diff --git a/tcl/library/encoding/macCyrillic.enc b/tcl/library/encoding/macCyrillic.enc
new file mode 100644
index 00000000000..559083373cb
--- /dev/null
+++ b/tcl/library/encoding/macCyrillic.enc
@@ -0,0 +1,20 @@
+# Encoding file: macCyrillic, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0410041104120413041404150416041704180419041A041B041C041D041E041F
+0420042104220423042404250426042704280429042A042B042C042D042E042F
+202000B000A200A300A7202200B6040600AE00A9212204020452226004030453
+221E00B122642265045600B522020408040404540407045704090459040A045A
+0458040500AC221A01922248220600AB00BB202600A0040B045B040C045C0455
+20132014201C201D2018201900F7201E040E045E040F045F211604010451044F
+0430043104320433043404350436043704380439043A043B043C043D043E043F
+0440044104420443044404450446044704480449044A044B044C044D044E00A4
diff --git a/tcl/library/encoding/macDingbats.enc b/tcl/library/encoding/macDingbats.enc
new file mode 100644
index 00000000000..28449cdd651
--- /dev/null
+++ b/tcl/library/encoding/macDingbats.enc
@@ -0,0 +1,20 @@
+# Encoding file: macDingbats, single-byte
+S
+003F 1 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+00202701270227032704260E2706270727082709261B261E270C270D270E270F
+2710271127122713271427152716271727182719271A271B271C271D271E271F
+2720272127222723272427252726272726052729272A272B272C272D272E272F
+2730273127322733273427352736273727382739273A273B273C273D273E273F
+2740274127422743274427452746274727482749274A274B25CF274D25A0274F
+27502751275225B225BC25C6275625D727582759275A275B275C275D275E007F
+F8D7F8D8F8D9F8DAF8DBF8DCF8DDF8DEF8DFF8E0F8E1F8E2F8E3F8E4008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+0000276127622763276427652766276726632666266526602460246124622463
+2464246524662467246824692776277727782779277A277B277C277D277E277F
+2780278127822783278427852786278727882789278A278B278C278D278E278F
+2790279127922793279421922194219527982799279A279B279C279D279E279F
+27A027A127A227A327A427A527A627A727A827A927AA27AB27AC27AD27AE27AF
+000027B127B227B327B427B527B627B727B827B927BA27BB27BC27BD27BE0000
diff --git a/tcl/library/encoding/macGreek.enc b/tcl/library/encoding/macGreek.enc
new file mode 100644
index 00000000000..fbfa51fe8f0
--- /dev/null
+++ b/tcl/library/encoding/macGreek.enc
@@ -0,0 +1,20 @@
+# Encoding file: macGreek, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C400B900B200C900B300D600DC038500E000E200E4038400A800E700E900E8
+00EA00EB00A3212200EE00EF202200BD203000F400F600A600AD00F900FB00FC
+2020039303940398039B039E03A000DF00AE00A903A303AA00A7226000B00387
+039100B12264226500A503920395039603970399039A039C03A603AB03A803A9
+03AC039D00AC039F03A1224803A400AB00BB202600A003A503A7038603880153
+20132015201C201D2018201900F70389038A038C038E03AD03AE03AF03CC038F
+03CD03B103B203C803B403B503C603B303B703B903BE03BA03BB03BC03BD03BF
+03C003CE03C103C303C403B803C903C203C703C503B603CA03CB039003B0F8A0
diff --git a/tcl/library/encoding/macIceland.enc b/tcl/library/encoding/macIceland.enc
new file mode 100644
index 00000000000..e3fe9a959ac
--- /dev/null
+++ b/tcl/library/encoding/macIceland.enc
@@ -0,0 +1,20 @@
+# Encoding file: macIceland, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
+00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
+00DD00B000A200A300A7202200B600DF00AE00A9212200B400A8226000C600D8
+221E00B12264226500A500B522022211220F03C0222B00AA00BA212600E600F8
+00BF00A100AC221A01922248220600AB00BB202600A000C000C300D501520153
+20132014201C201D2018201900F725CA00FF0178204400A400D000F000DE00FE
+00FD00B7201A201E203000C200CA00C100CB00C800CD00CE00CF00CC00D300D4
+F8FF00D200DA00DB00D9013102C602DC00AF02D802D902DA00B802DD02DB02C7
diff --git a/tcl/library/encoding/macJapan.enc b/tcl/library/encoding/macJapan.enc
new file mode 100644
index 00000000000..dba24bd8e3f
--- /dev/null
+++ b/tcl/library/encoding/macJapan.enc
@@ -0,0 +1,785 @@
+# Encoding file: macJapan, multi-byte
+M
+003F 0 46
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00A0FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000A921222026
+81
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+300030013002FF0CFF0E30FBFF1AFF1BFF1FFF01309B309C00B4FF4000A8FF3E
+203EFF3F30FD30FE309D309E30034EDD30053006300730FC20142010FF0FFF3C
+301C2016FF5C22EF202520182019201C201DFF08FF0930143015FF3BFF3DFF5B
+FF5D30083009300A300B300C300D300E300F30103011FF0B221200B100D70000
+00F7FF1D2260FF1CFF1E22662267221E22342642264000B0203220332103FFE5
+FF0400A200A3FF05FF03FF06FF0AFF2000A72606260525CB25CF25CE25C725C6
+25A125A025B325B225BD25BC203B301221922190219121933013000000000000
+000000000000000000000000000000002208220B2286228722822283222A2229
+000000000000000000000000000000002227222800AC21D221D4220022030000
+0000000000000000000000000000000000000000222022A52312220222072261
+2252226A226B221A223D221D2235222B222C0000000000000000000000000000
+212B2030266F266D266A2020202100B6000000000000000025EF000000000000
+82
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000FF10
+FF11FF12FF13FF14FF15FF16FF17FF18FF190000000000000000000000000000
+FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2FFF30
+FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3A000000000000000000000000
+0000FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5A00000000000000003041
+30423043304430453046304730483049304A304B304C304D304E304F30503051
+30523053305430553056305730583059305A305B305C305D305E305F30603061
+30623063306430653066306730683069306A306B306C306D306E306F30703071
+30723073307430753076307730783079307A307B307C307D307E307F30803081
+30823083308430853086308730883089308A308B308C308D308E308F30903091
+3092309300000000000000000000000000000000000000000000000000000000
+83
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF30B0
+30B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF30C0
+30C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF30D0
+30D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF0000
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000391
+03920393039403950396039703980399039A039B039C039D039E039F03A003A1
+03A303A403A503A603A703A803A90000000000000000000000000000000003B1
+03B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF03C003C1
+03C303C403C503C603C703C803C9000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+84
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+04100411041204130414041504010416041704180419041A041B041C041D041E
+041F0420042104220423042404250426042704280429042A042B042C042D042E
+042F000000000000000000000000000000000000000000000000000000000000
+04300431043204330434043504510436043704380439043A043B043C043D0000
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000002500
+2502250C251025182514251C252C25242534253C25012503250F2513251B2517
+25232533252B253B254B2520252F25282537253F251D25302525253825420000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+85
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+2460246124622463246424652466246724682469246A246B246C246D246E246F
+2470247124722473000000000000000000000000000000000000000024742475
+2476247724782479247A247B247C247D247E247F248024812482248324842485
+2486248700000000000000000000000000000000000000002776277727780000
+2779277A277B277C277D277E0000000000000000000000000000000000000000
+0000F8A124882489248A248B248C248D248E248F249000000000000000002160
+216121622163216421652166216721682169216A216BF8A2F8A3F8A400000000
+0000000000002170217121722173217421752176217721782179217A217BF8A5
+F8A6F8A700000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000000249C249D249E249F24A0
+24A124A224A324A424A524A624A724A824A924AA24AB24AC24AD24AE24AF24B0
+24B124B224B324B424B500000000000000000000000000000000000000000000
+86
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+339C339F339D33A033A4F8A833A133A5339E33A2338EF8A9338F33C433963397
+F8AA339833B333B233B133B0210933D433CB3390338533863387F8AB00000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000000211633CD2121F8AC2664
+2667266126622660266326652666000000000000000000000000000000000000
+0000000000003020260E30040000000000000000000000000000000000000000
+0000000000000000000000000000261E261C261D261F21C621C421C5F8AD21E8
+21E621E721E9F8AEF8AFF8B0F8B1000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+87
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+3230322A322B322C322D322E322F32403237324232433239323A3231323E3234
+3232323B323632333235323C323D323F32380000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000059275C0F32A432A532A632A732A832A93296329D3298329E63A732993349
+3322334D3314331633053333334E330333363318331533273351334A33393357
+330D334233233326333B332B00000000000000000000000000003300331E332A
+3331334700000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000337E337D337C337B0000000000000000000000000000
+0000000000000000000000000000000000000000337FF8B2F8B3000000000000
+88
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+222E221F22BF0000000000000000000000000000000000000000000000000000
+0000000000000000301DF8B40000000000000000000000000000000000000000
+000000000000000000000000000000003094000030F730F830F930FA00000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000004E9C
+55165A03963F54C0611B632859F690228475831C7A5060AA63E16E2565ED8466
+82A69BF56893572765A162715B9B59D0867B98F47D627DBE9B8E62167C9F88B7
+5B895EB563096697684895C7978D674F4EE54F0A4F4D4F9D504956F2593759D4
+5A015C0960DF610F61706613690570BA754F757079FB7DAD7DEF80C3840E8863
+8B029055907A533B4E954EA557DF80B290C178EF4E0058F16EA290387A328328
+828B9C2F5141537054BD54E156E059FB5F1598F26DEB80E4852D000000000000
+89
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9662967096A097FB540B53F35B8770CF7FBD8FC296E8536F9D5C7ABA4E117893
+81FC6E26561855046B1D851A9C3B59E553A96D6674DC958F56424E91904B96F2
+834F990C53E155B65B305F71662066F368046C386CF36D29745B76C87A4E9834
+82F1885B8A6092ED6DB275AB76CA99C560A68B018D8A95B2698E53AD51860000
+5712583059445BB45EF6602863A963F46CBF6F14708E7114715971D5733F7E01
+827682D185979060925B9D1B586965BC6C5A752551F9592E59655F805FDC62BC
+65FA6A2A6B276BB4738B7FC189569D2C9D0E9EC45CA16C96837B51045C4B61B6
+81C6687672614E594FFA537860696E297A4F97F34E0B53164EEE4F554F3D4FA1
+4F7352A053EF5609590F5AC15BB65BE179D16687679C67B66B4C6CB3706B73C2
+798D79BE7A3C7B8782B182DB8304837783EF83D387668AB256298CA88FE6904E
+971E868A4FC45CE862117259753B81E582BD86FE8CC096C5991399D54ECB4F1A
+89E356DE584A58CA5EFB5FEB602A6094606261D0621262D06539000000000000
+8A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9B41666668B06D777070754C76867D7582A587F9958B968E8C9D51F152BE5916
+54B35BB35D16616869826DAF788D84CB88578A7293A79AB86D6C99A886D957A3
+67FF86CE920E5283568754045ED362E164B9683C68386BBB737278BA7A6B899A
+89D28D6B8F0390ED95A3969497695B665CB3697D984D984E639B7B206A2B0000
+6A7F68B69C0D6F5F5272559D607062EC6D3B6E076ED1845B89108F444E149C39
+53F6691B6A3A9784682A515C7AC384B291DC938C565B9D286822830584317CA5
+520882C574E64E7E4F8351A05BD2520A52D852E75DFB559A582A59E65B8C5B98
+5BDB5E725E7960A3611F616361BE63DB656267D1685368FA6B3E6B536C576F22
+6F976F4574B0751876E3770B7AFF7BA17C217DE97F367FF0809D8266839E89B3
+8ACC8CAB908494519593959195A2966597D3992882184E38542B5CB85DCC73A9
+764C773C5CA97FEB8D0B96C19811985498584F014F0E5371559C566857FA5947
+5B095BC45C905E0C5E7E5FCC63EE673A65D765E2671F68CB68C4000000000000
+8B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A5F5E306BC56C176C7D757F79485B637A007D005FBD898F8A188CB48D778ECC
+8F1D98E29A0E9B3C4E80507D510059935B9C622F628064EC6B3A72A075917947
+7FA987FB8ABC8B7063AC83CA97A05409540355AB68546A588A70782767759ECD
+53745BA2811A865090064E184E454EC74F1153CA54385BAE5F13602565510000
+673D6C426C726CE3707874037A767AAE7B087D1A7CFE7D6665E7725B53BB5C45
+5DE862D262E063196E20865A8A318DDD92F86F0179A69B5A4EA84EAB4EAC4F9B
+4FA050D151477AF6517151F653545321537F53EB55AC58835CE15F375F4A602F
+6050606D631F65596A4B6CC172C272ED77EF80F881058208854E90F793E197FF
+99579A5A4EF051DD5C2D6681696D5C4066F26975738968507C8150C552E45747
+5DFE932665A46B236B3D7434798179BD7B4B7DCA82B983CC887F895F8B398FD1
+91D1541F92804E5D503653E5533A72D7739677E982E68EAF99C699C899D25177
+611A865E55B07A7A50765BD3904796854E326ADB91E75C515C48000000000000
+8C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63987A9F6C9397748F617AAA718A96887C8268177E706851936C52F2541B85AB
+8A137FA48ECD90E15366888879414FC250BE521151445553572D73EA578B5951
+5F625F8460756176616761A963B2643A656C666F68426E1375667A3D7CFB7D4C
+7D997E4B7F6B830E834A86CD8A088A638B668EFD981A9D8F82B88FCE9BE80000
+5287621F64836FC09699684150916B206C7A6F547A747D5088408A2367084EF6
+503950265065517C5238526355A7570F58055ACC5EFA61B261F862F36372691C
+6A29727D72AC732E7814786F7D79770C80A9898B8B198CE28ED290639375967A
+98559A139E785143539F53B35E7B5F266E1B6E90738473FE7D4382378A008AFA
+96504E4E500B53E4547C56FA59D15B645DF15EAB5F276238654567AF6E5672D0
+7CCA88B480A180E183F0864E8A878DE8923796C798679F134E944E924F0D5348
+5449543E5A2F5F8C5FA1609F68A76A8E745A78818A9E8AA48B7791904E5E9BC9
+4EA44F7C4FAF501950165149516C529F52B952FE539A53E35411000000000000
+8D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+540E5589575157A2597D5B545B5D5B8F5DE55DE75DF75E785E835E9A5EB75F18
+6052614C629762D863A7653B6602664366F4676D6821689769CB6C5F6D2A6D69
+6E2F6E9D75327687786C7A3F7CE07D057D187D5E7DB18015800380AF80B18154
+818F822A8352884C88618B1B8CA28CFC90CA91759271783F92FC95A4964D0000
+980599999AD89D3B525B52AB53F7540858D562F76FE08C6A8F5F9EB9514B523B
+544A56FD7A4091779D609ED273446F09817075115FFD60DA9AA872DB8FBC6B64
+98034ECA56F0576458BE5A5A606861C7660F6606683968B16DF775D57D3A826E
+9B424E9B4F5053C955065D6F5DE65DEE67FB6C99747378028A50939688DF5750
+5EA7632B50B550AC518D670054C9585E59BB5BB05F69624D63A1683D6B736E08
+707D91C7728078157826796D658E7D3083DC88C18F09969B5264572867507F6A
+8CA151B45742962A583A698A80B454B25D0E57FC78959DFA4F5C524A548B643E
+6628671467F57A847B567D22932F685C9BAD7B395319518A5237000000000000
+8E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5BDF62F664AE64E6672D6BBA85A996D176909BD6634C93069BAB76BF66524E09
+509853C25C7160E864926563685F71E673CA75237B977E8286958B838CDB9178
+991065AC66AB6B8B4ED54ED44F3A4F7F523A53F853F255E356DB58EB59CB59C9
+59FF5B505C4D5E025E2B5FD7601D6307652F5B5C65AF65BD65E8679D6B620000
+6B7B6C0F7345794979C17CF87D197D2B80A2810281F389968A5E8A698A668A8C
+8AEE8CC78CDC96CC98FC6B6F4E8B4F3C4F8D51505B575BFA6148630166426B21
+6ECB6CBB723E74BD75D478C1793A800C803381EA84948F9E6C509E7F5F0F8B58
+9D2B7AFA8EF85B8D96EB4E0353F157F759315AC95BA460896E7F6F0675BE8CEA
+5B9F85007BE0507267F4829D5C61854A7E1E820E51995C0463688D66659C716E
+793E7D1780058B1D8ECA906E86C790AA501F52FA5C3A6753707C7235914C91C8
+932B82E55BC25F3160F94E3B53D65B88624B67316B8A72E973E07A2E816B8DA3
+91529996511253D7546A5BFF63886A397DAC970056DA53CE5468000000000000
+8F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B975C315DDE4FEE610162FE6D3279C079CB7D427E4D7FD281ED821F84908846
+89728B908E748F2F9031914B916C96C6919C4EC04F4F514553415F93620E67D4
+6C416E0B73637E2691CD928353D459195BBF6DD1795D7E2E7C9B587E719F51FA
+88538FF04FCA5CFB662577AC7AE3821C99FF51C65FAA65EC696F6B896DF30000
+6E966F6476FE7D145DE190759187980651E6521D6240669166D96E1A5EB67DD2
+7F7266F885AF85F78AF852A953D959735E8F5F90605592E4966450B7511F52DD
+5320534753EC54E8554655315617596859BE5A3C5BB55C065C0F5C115C1A5E84
+5E8A5EE05F70627F628462DB638C63776607660C662D6676677E68A26A1F6A35
+6CBC6D886E096E58713C7126716775C77701785D7901796579F07AE07B117CA7
+7D39809683D6848B8549885D88F38A1F8A3C8A548A738C618CDE91A49266937E
+9418969C97984E0A4E084E1E4E575197527057CE583458CC5B225E3860C564FE
+676167566D4472B675737A6384B88B7291B89320563157F498FE000000000000
+90
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62ED690D6B9671ED7E548077827289E698DF87558FB15C3B4F384FE14FB55507
+5A205BDD5BE95FC3614E632F65B0664B68EE699B6D786DF1753375B9771F795E
+79E67D3381E382AF85AA89AA8A3A8EAB8F9B903291DD97074EBA4EC152035875
+58EC5C0B751A5C3D814E8A0A8FC59663976D7B258ACF9808916256F353A80000
+9017543957825E2563A86C34708A77617C8B7FE088709042915493109318968F
+745E9AC45D075D69657067A28DA896DB636E6749691983C5981796C088FE6F84
+647A5BF84E16702C755D662F51C4523652E259D35F8160276210653F6574661F
+667468F268166B636E057272751F76DB7CBE805658F088FD897F8AA08A938ACB
+901D91929752975965897A0E810696BB5E2D60DC621A65A56614679077F37A4D
+7C4D7E3E810A8CAC8D648DE18E5F78A9520762D963A5644262988A2D7A837BC0
+8AAC96EA7D76820C87494ED95148534353605BA35C025C165DDD6226624764B0
+681368346CC96D456D1767D36F5C714E717D65CB7A7F7BAD7DDA000000000000
+91
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7E4A7FA8817A821B823985A68A6E8CCE8DF59078907792AD929195839BAE524D
+55846F387136516879857E5581B37CCE564C58515CA863AA66FE66FD695A72D9
+758F758E790E795679DF7C977D207D4486078A34963B90619F2050E7527553CC
+53E2500955AA58EE594F723D5B8B5C64531D60E360F3635C6383633F63BB0000
+64CD65E966F95DE369CD69FD6F1571E54E8975E976F87A937CDF7DCF7D9C8061
+83498358846C84BC85FB88C58D709001906D9397971C9A1250CF5897618E81D3
+85358D0890204FC3507452475373606F6349675F6E2C8DB3901F4FD75C5E8CCA
+65CF7D9A53528896517663C35B585B6B5C0A640D6751905C4ED6591A592A6C70
+8A51553E581559A560F0625367C182356955964099C49A284F5358065BFE8010
+5CB15E2F5F856020614B623466FF6CF06EDE80CE817F82D4888B8CB89000902E
+968A9EDB9BDB4EE353F059277B2C918D984C9DF96EDD7027535355445B856258
+629E62D36CA26FEF74228A1794386FC18AFE833851E786F853EA000000000000
+92
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53E94F4690548FB0596A81315DFD7AEA8FBF68DA8C3772F89C486A3D8AB04E39
+53585606576662C563A265E66B4E6DE16E5B70AD77ED7AEF7BAA7DBB803D80C6
+86CB8A95935B56E358C75F3E65AD66966A806BB575378AC7502477E557305F1B
+6065667A6C6075F47A1A7F6E81F48718904599B37BC9755C7AF97B5184C40000
+901079E97A9283365AE177404E2D4EF25B995FE062BD663C67F16CE8866B8877
+8A3B914E92F399D06A177026732A82E784578CAF4E01514651CB558B5BF55E16
+5E335E815F145F355F6B5FB461F2631166A2671D6F6E7252753A773A80748139
+817887768ABF8ADC8D858DF3929A957798029CE552C5635776F467156C8873CD
+8CC393AE96736D25589C690E69CC8FFD939A75DB901A585A680263B469FB4F43
+6F2C67D88FBB85267DB49354693F6F70576A58F75B2C7D2C722A540A91E39DB4
+4EAD4F4E505C507552438C9E544858245B9A5E1D5E955EAD5EF75F1F608C62B5
+633A63D068AF6C407887798E7A0B7DE082478A028AE68E449013000000000000
+93
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+90B8912D91D89F0E6CE5645864E265756EF476847B1B906993D16EBA54F25FB9
+64A48F4D8FED92445178586B59295C555E976DFB7E8F751C8CBC8EE2985B70B9
+4F1D6BBF6FB1753096FB514E54105835585759AC5C605F926597675C6E21767B
+83DF8CED901490FD934D7825783A52AA5EA6571F597460125012515A51AC0000
+51CD520055105854585859575B955CF65D8B60BC6295642D6771684368BC68DF
+76D76DD86E6F6D9B706F71C85F5375D879777B497B547B527CD67D7152308463
+856985E48A0E8B048C468E0F9003900F94199676982D9A3095D850CD52D5540C
+58025C0E61A7649E6D1E77B37AE580F48404905392855CE09D07533F5F975FB3
+6D9C7279776379BF7BE46BD272EC8AAD68036A6151F87A8169345C4A9CF682EB
+5BC59149701E56785C6F60C765666C8C8C5A90419813545166C7920D594890A3
+51854E4D51EA85998B0E7058637A934B696299B47E047577535769608EDF96E3
+6C5D4E8C5C3C5F108FE953028CD1808986795EFF65E54E735165000000000000
+94
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59825C3F97EE4EFB598A5FCD8A8D6FE179B079625BE78471732B71B15E745FF5
+637B649A71C37C984E435EFC4E4B57DC56A260A96FC37D0D80FD813381BF8FB2
+899786A45DF4628A64AD898767776CE26D3E743678345A467F7582AD99AC4FF3
+5EC362DD63926557676F76C3724C80CC80BA8F29914D500D57F95A9268850000
+6973716472FD8CB758F28CE0966A9019877F79E477E784294F2F5265535A62CD
+67CF6CCA767D7B947C95823685848FEB66DD6F2072067E1B83AB99C19EA651FD
+7BB178727BB880877B486AE85E61808C75517560516B92626E8C767A91979AEA
+4F107F70629C7B4F95A59CE9567A585986E496BC4F345224534A53CD53DB5E06
+642C6591677F6C3E6C4E724872AF73ED75547E41822C85E98CA97BC491C67169
+981298EF633D6669756A76E478D0854386EE532A5351542659835E875F7C60B2
+6249627962AB65906BD46CCC75B276AE789179D87DCB7F7780A588AB8AB98CBB
+907F975E98DB6A0B7C3850995C3E5FAE67876BD8743577097F8E000000000000
+95
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9F3B67CA7A175339758B9AED5F66819D83F180985F3C5FC575627B46903C6867
+59EB5A9B7D10767E8B2C4FF55F6A6A196C376F0274E2796888688A558C795EDF
+63CF75C579D282D7932892F2849C86ED9C2D54C15F6C658C6D5C70158CA78CD3
+983B654F74F64E0D4ED857E0592B5A665BCC51A85E035E9C6016627665770000
+65A7666E6D6E72367B268150819A82998B5C8CA08CE68D74961C96444FAE64AB
+6B66821E8461856A90E85C01695398A8847A85574F0F526F5FA95E45670D798F
+8179890789866DF55F1762556CB84ECF72699B925206543B567458B361A4626E
+711A596E7C897CDE7D1B96F06587805E4E194F75517558405E635E735F0A67C4
+4E26853D9589965B7C73980150FB58C1765678A7522577A585117B86504F5909
+72477BC77DE88FBA8FD4904D4FBF52C95A295F0197AD4FDD821792EA57036355
+6B69752B88DC8F147A4252DF58936155620A66AE6BCD7C3F83E950234FF85305
+5446583159495B9D5CF05CEF5D295E9662B16367653E65B9670B000000000000
+96
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6CD56CE170F978327E2B80DE82B3840C84EC870289128A2A8C4A90A692D298FD
+9CF39D6C4E4F4EA1508D5256574A59A85E3D5FD85FD9623F66B4671B67D068D2
+51927D2180AA81A88B008C8C8CBF927E96325420982C531750D5535C58A864B2
+6734726777667A4691E652C36CA16B8658005E4C5954672C7FFB51E176C60000
+646978E89B549EBB57CB59B96627679A6BCE54E969D95E55819C67959BAA67FE
+9C52685D4EA64FE353C862B9672B6CAB8FC44FAD7E6D9EBF4E0761626E806F2B
+85135473672A9B455DF37B955CAC5BC6871C6E4A84D17A14810859997C8D6C11
+772052D959227121725F77DB97279D61690B5A7F5A1851A5540D547D660E76DF
+8FF792989CF459EA725D6EC5514D68C97DBF7DEC97629EBA64786A2183025984
+5B5F6BDB731B76F27DB280178499513267289ED976EE676252FF99055C24623B
+7C7E8CB0554F60B67D0B958053014E5F51B6591C723A803691CE5F2577E25384
+5F797D0485AC8A338E8D975667F385AE9453610961086CB97652000000000000
+97
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8AED8F38552F4F51512A52C753CB5BA55E7D60A0618263D6670967DA6E676D8C
+733673377531795088D58A98904A909190F596C4878D59154E884F594E0E8A89
+8F3F981050AD5E7C59965BB95EB863DA63FA64C166DC694A69D86D0B6EB67194
+75287AAF7F8A8000844984C989818B218E0A9065967D990A617E62916B320000
+6C836D747FCC7FFC6DC07F8587BA88F8676583B1983C96F76D1B7D61843D916A
+4E7153755D506B046FEB85CD862D89A75229540F5C65674E68A87406748375E2
+88CF88E191CC96E296785F8B73877ACB844E63A0756552896D416E9C74097559
+786B7C9296867ADC9F8D4FB6616E65C5865C4E864EAE50DA4E2151CC5BEE6599
+68816DBC731F764277AD7A1C7CE7826F8AD2907C91CF96759818529B7DD1502B
+539867976DCB71D0743381E88F2A96A39C579E9F746058416D997D2F985E4EE4
+4F364F8B51B752B15DBA601C73B2793C82D3923496B796F6970A9E979F6266A6
+6B74521752A370C888C25EC9604B61906F2371497C3E7DF4806F000000000000
+98
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+84EE9023932C54429B6F6AD370898CC28DEF973252B45A415ECA5F046717697C
+69946D6A6F0F726272FC7BED8001807E874B90CE516D9E937984808B93328AD6
+502D548C8A716B6A8CC4810760D167A09DF24E994E989C108A6B85C185686900
+6E7E789781550000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000005F0C
+4E104E154E2A4E314E364E3C4E3F4E424E564E584E824E858C6B4E8A82125F0D
+4E8E4E9E4E9F4EA04EA24EB04EB34EB64ECE4ECD4EC44EC64EC24ED74EDE4EED
+4EDF4EF74F094F5A4F304F5B4F5D4F574F474F764F884F8F4F984F7B4F694F70
+4F914F6F4F864F9651184FD44FDF4FCE4FD84FDB4FD14FDA4FD04FE44FE5501A
+50285014502A502550054F1C4FF650215029502C4FFE4FEF5011500650435047
+6703505550505048505A5056506C50785080509A508550B450B2000000000000
+99
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50C950CA50B350C250D650DE50E550ED50E350EE50F950F55109510151025116
+51155114511A5121513A5137513C513B513F51405152514C515451627AF85169
+516A516E5180518256D8518C5189518F519151935195519651A451A651A251A9
+51AA51AB51B351B151B251B051B551BD51C551C951DB51E0865551E951ED0000
+51F051F551FE5204520B5214520E5227522A522E52335239524F5244524B524C
+525E5254526A527452695273527F527D528D529452925271528852918FA88FA7
+52AC52AD52BC52B552C152CD52D752DE52E352E698ED52E052F352F552F852F9
+530653087538530D5310530F5315531A5323532F533153335338534053465345
+4E175349534D51D6535E5369536E5918537B53775382539653A053A653A553AE
+53B053B653C37C1296D953DF66FC71EE53EE53E853ED53FA5401543D5440542C
+542D543C542E54365429541D544E548F5475548E545F5471547754705492547B
+5480547654845490548654C754A254B854A554AC54C454C854A8000000000000
+9A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54AB54C254A454BE54BC54D854E554E6550F551454FD54EE54ED54FA54E25539
+55405563554C552E555C55455556555755385533555D5599558054AF558A559F
+557B557E5598559E55AE557C558355A9558755A855DA55C555DF55C455DC55E4
+55D4561455F7561655FE55FD561B55F9564E565071DF56345636563256380000
+566B5664562F566C566A56865680568A56A05694568F56A556AE56B656B456C2
+56BC56C156C356C056C856CE56D156D356D756EE56F9570056FF570457095708
+570B570D57135718571655C7571C572657375738574E573B5740574F576957C0
+57885761577F5789579357A057B357A457AA57B057C357C657D457D257D3580A
+57D657E3580B5819581D587258215862584B58706BC05852583D5879588558B9
+589F58AB58BA58DE58BB58B858AE58C558D358D158D758D958D858E558DC58E4
+58DF58EF58FA58F958FB58FC58FD5902590A5910591B68A65925592C592D5932
+5938593E7AD259555950594E595A5958596259605967596C5969000000000000
+9B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59785981599D4F5E4FAB59A359B259C659E859DC598D59D959DA5A255A1F5A11
+5A1C5A095A1A5A405A6C5A495A355A365A625A6A5A9A5ABC5ABE5ACB5AC25ABD
+5AE35AD75AE65AE95AD65AFA5AFB5B0C5B0B5B165B325AD05B2A5B365B3E5B43
+5B455B405B515B555B5A5B5B5B655B695B705B735B755B7865885B7A5B800000
+5B835BA65BB85BC35BC75BC95BD45BD05BE45BE65BE25BDE5BE55BEB5BF05BF6
+5BF35C055C075C085C0D5C135C205C225C285C385C395C415C465C4E5C535C50
+5C4F5B715C6C5C6E4E625C765C795C8C5C915C94599B5CAB5CBB5CB65CBC5CB7
+5CC55CBE5CC75CD95CE95CFD5CFA5CED5D8C5CEA5D0B5D155D175D5C5D1F5D1B
+5D115D145D225D1A5D195D185D4C5D525D4E5D4B5D6C5D735D765D875D845D82
+5DA25D9D5DAC5DAE5DBD5D905DB75DBC5DC95DCD5DD35DD25DD65DDB5DEB5DF2
+5DF55E0B5E1A5E195E115E1B5E365E375E445E435E405E4E5E575E545E5F5E62
+5E645E475E755E765E7A9EBC5E7F5EA05EC15EC25EC85ED05ECF000000000000
+9C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5ED65EE35EDD5EDA5EDB5EE25EE15EE85EE95EEC5EF15EF35EF05EF45EF85EFE
+5F035F095F5D5F5C5F0B5F115F165F295F2D5F385F415F485F4C5F4E5F2F5F51
+5F565F575F595F615F6D5F735F775F835F825F7F5F8A5F885F915F875F9E5F99
+5F985FA05FA85FAD5FBC5FD65FFB5FE45FF85FF15FDD60B35FFF602160600000
+601960106029600E6031601B6015602B6026600F603A605A6041606A6077605F
+604A6046604D6063604360646042606C606B60596081608D60E76083609A6084
+609B60966097609260A7608B60E160B860E060D360B45FF060BD60C660B560D8
+614D6115610660F660F7610060F460FA6103612160FB60F1610D610E6147613E
+61286127614A613F613C612C6134613D614261446173617761586159615A616B
+6174616F61656171615F615D6153617561996196618761AC6194619A618A6191
+61AB61AE61CC61CA61C961F761C861C361C661BA61CB7F7961CD61E661E361F6
+61FA61F461FF61FD61FC61FE620062086209620D620C6214621B000000000000
+9D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+621E6221622A622E6230623262336241624E625E6263625B62606268627C6282
+6289627E62926293629662D46283629462D762D162BB62CF62FF62C664D462C8
+62DC62CC62CA62C262C7629B62C9630C62EE62F163276302630862EF62F56350
+633E634D641C634F6396638E638063AB637663A3638F6389639F63B5636B0000
+636963BE63E963C063C663E363C963D263F663C4641664346406641364266436
+651D64176428640F6467646F6476644E652A6495649364A564A9648864BC64DA
+64D264C564C764BB64D864C264F164E7820964E064E162AC64E364EF652C64F6
+64F464F264FA650064FD6518651C650565246523652B65346535653765366538
+754B654865566555654D6558655E655D65726578658265838B8A659B659F65AB
+65B765C365C665C165C465CC65D265DB65D965E065E165F16772660A660365FB
+6773663566366634661C664F664466496641665E665D666466676668665F6662
+667066836688668E668966846698669D66C166B966C966BE66BC000000000000
+9E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+66C466B866D666DA66E0663F66E666E966F066F566F7670F6716671E67266727
+9738672E673F67366741673867376746675E67606759676367646789677067A9
+677C676A678C678B67A667A1678567B767EF67B467EC67B367E967B867E467DE
+67DD67E267EE67B967CE67C667E76A9C681E684668296840684D6832684E0000
+68B3682B685968636877687F689F688F68AD6894689D689B68836AAE68B96874
+68B568A068BA690F688D687E690168CA690868D86922692668E1690C68CD68D4
+68E768D569366912690468D768E3692568F968E068EF6928692A691A69236921
+68C669796977695C6978696B6954697E696E69396974693D695969306961695E
+695D6981696A69B269AE69D069BF69C169D369BE69CE5BE869CA69DD69BB69C3
+69A76A2E699169A0699C699569B469DE69E86A026A1B69FF6B0A69F969F269E7
+6A0569B16A1E69ED6A1469EB6A0A6A126AC16A236A136A446A0C6A726A366A78
+6A476A626A596A666A486A386A226A906A8D6AA06A846AA26AA3000000000000
+9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A9786176ABB6AC36AC26AB86AB36AAC6ADE6AD16ADF6AAA6ADA6AEA6AFB6B05
+86166AFA6B126B169B316B1F6B386B3776DC6B3998EE6B476B436B496B506B59
+6B546B5B6B5F6B616B786B796B7F6B806B846B836B8D6B986B956B9E6BA46BAA
+6BAB6BAF6BB26BB16BB36BB76BBC6BC66BCB6BD36BDF6BEC6BEB6BF36BEF0000
+9EBE6C086C136C146C1B6C246C236C5E6C556C626C6A6C826C8D6C9A6C816C9B
+6C7E6C686C736C926C906CC46CF16CD36CBD6CD76CC56CDD6CAE6CB16CBE6CBA
+6CDB6CEF6CD96CEA6D1F884D6D366D2B6D3D6D386D196D356D336D126D0C6D63
+6D936D646D5A6D796D596D8E6D956FE46D856DF96E156E0A6DB56DC76DE66DB8
+6DC66DEC6DDE6DCC6DE86DD26DC56DFA6DD96DE46DD56DEA6DEE6E2D6E6E6E2E
+6E196E726E5F6E3E6E236E6B6E2B6E766E4D6E1F6E436E3A6E4E6E246EFF6E1D
+6E386E826EAA6E986EC96EB76ED36EBD6EAF6EC46EB26ED46ED56E8F6EA56EC2
+6E9F6F416F11704C6EEC6EF86EFE6F3F6EF26F316EEF6F326ECC000000000000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F3E6F136EF76F866F7A6F786F816F806F6F6F5B6FF36F6D6F826F7C6F586F8E
+6F916FC26F666FB36FA36FA16FA46FB96FC66FAA6FDF6FD56FEC6FD46FD86FF1
+6FEE6FDB7009700B6FFA70117001700F6FFE701B701A6F74701D7018701F7030
+703E7032705170637099709270AF70F170AC70B870B370AE70DF70CB70DD0000
+70D9710970FD711C711971657155718871667162714C7156716C718F71FB7184
+719571A871AC71D771B971BE71D271C971D471CE71E071EC71E771F571FC71F9
+71FF720D7210721B7228722D722C72307232723B723C723F72407246724B7258
+7274727E7282728172877292729672A272A772B972B272C372C672C472CE72D2
+72E272E072E172F972F7500F7317730A731C7316731D7334732F73297325733E
+734E734F9ED87357736A7368737073787375737B737A73C873B373CE73BB73C0
+73E573EE73DE74A27405746F742573F87432743A7455743F745F74597441745C
+746974707463746A7476747E748B749E74A774CA74CF74D473F1000000000000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74E074E374E774E974EE74F274F074F174F874F7750475037505750C750E750D
+75157513751E7526752C753C7544754D754A7549755B7546755A756975647567
+756B756D75787576758675877574758A758975827594759A759D75A575A375C2
+75B375C375B575BD75B875BC75B175CD75CA75D275D975E375DE75FE75FF0000
+75FC760175F075FA75F275F3760B760D7609761F762776207621762276247634
+7630763B764776487646765C76587661766276687669766A7667766C76707672
+76767678767C768076837688768B768E769676937699769A76B076B476B876B9
+76BA76C276CD76D676D276DE76E176E576E776EA862F76FB7708770777047729
+7724771E77257726771B773777387747775A7768776B775B7765777F777E7779
+778E778B779177A0779E77B077B677B977BF77BC77BD77BB77C777CD77D777DA
+77DC77E377EE77FC780C781279267820792A7845788E78747886787C789A788C
+78A378B578AA78AF78D178C678CB78D478BE78BC78C578CA78EC000000000000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+78E778DA78FD78F47907791279117919792C792B794079607957795F795A7955
+7953797A797F798A799D79A79F4B79AA79AE79B379B979BA79C979D579E779EC
+79E179E37A087A0D7A187A197A207A1F79807A317A3B7A3E7A377A437A577A49
+7A617A627A699F9D7A707A797A7D7A887A977A957A987A967AA97AC87AB00000
+7AB67AC57AC47ABF90837AC77ACA7ACD7ACF7AD57AD37AD97ADA7ADD7AE17AE2
+7AE67AED7AF07B027B0F7B0A7B067B337B187B197B1E7B357B287B367B507B7A
+7B047B4D7B0B7B4C7B457B757B657B747B677B707B717B6C7B6E7B9D7B987B9F
+7B8D7B9C7B9A7B8B7B927B8F7B5D7B997BCB7BC17BCC7BCF7BB47BC67BDD7BE9
+7C117C147BE67BE57C607C007C077C137BF37BF77C177C0D7BF67C237C277C2A
+7C1F7C377C2B7C3D7C4C7C437C547C4F7C407C507C587C5F7C647C567C657C6C
+7C757C837C907CA47CAD7CA27CAB7CA17CA87CB37CB27CB17CAE7CB97CBD7CC0
+7CC57CC27CD87CD27CDC7CE29B3B7CEF7CF27CF47CF67CFA7D06000000000000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7D027D1C7D157D0A7D457D4B7D2E7D327D3F7D357D467D737D567D4E7D727D68
+7D6E7D4F7D637D937D897D5B7D8F7D7D7D9B7DBA7DAE7DA37DB57DC77DBD7DAB
+7E3D7DA27DAF7DDC7DB87D9F7DB07DD87DDD7DE47DDE7DFB7DF27DE17E057E0A
+7E237E217E127E317E1F7E097E0B7E227E467E667E3B7E357E397E437E370000
+7E327E3A7E677E5D7E567E5E7E597E5A7E797E6A7E697E7C7E7B7E837DD57E7D
+8FAE7E7F7E887E897E8C7E927E907E937E947E967E8E7E9B7E9C7F387F3A7F45
+7F4C7F4D7F4E7F507F517F557F547F587F5F7F607F687F697F677F787F827F86
+7F837F887F877F8C7F947F9E7F9D7F9A7FA37FAF7FB27FB97FAE7FB67FB88B71
+7FC57FC67FCA7FD57FD47FE17FE67FE97FF37FF998DC80068004800B80128018
+8019801C80218028803F803B804A804680528058805A805F8062806880738072
+807080768079807D807F808480868085809B8093809A80AD519080AC80DB80E5
+80D980DD80C480DA80D6810980EF80F1811B81298123812F814B000000000000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+968B8146813E8153815180FC8171816E81658166817481838188818A81808182
+81A0819581A481A3815F819381A981B081B581BE81B881BD81C081C281BA81C9
+81CD81D181D981D881C881DA81DF81E081E781FA81FB81FE8201820282058207
+820A820D821082168229822B82388233824082598258825D825A825F82640000
+82628268826A826B822E827182778278827E828D829282AB829F82BB82AC82E1
+82E382DF82D282F482F382FA8393830382FB82F982DE830682DC830982D98335
+83348316833283318340833983508345832F832B831783188385839A83AA839F
+83A283968323838E8387838A837C83B58373837583A0838983A883F4841383EB
+83CE83FD840383D8840B83C183F7840783E083F2840D8422842083BD84388506
+83FB846D842A843C855A84848477846B84AD846E848284698446842C846F8479
+843584CA846284B984BF849F84D984CD84BB84DA84D084C184C684D684A18521
+84FF84F485178518852C851F8515851484FC8540856385588548000000000000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+85418602854B8555858085A485888591858A85A8856D8594859B85EA8587859C
+8577857E859085C985BA85CF85B985D085D585DD85E585DC85F9860A8613860B
+85FE85FA86068622861A8630863F864D4E558654865F86678671869386A386A9
+86AA868B868C86B686AF86C486C686B086C9882386AB86D486DE86E986EC0000
+86DF86DB86EF8712870687088700870386FB87118709870D86F9870A8734873F
+8737873B87258729871A8760875F8778874C874E877487578768876E87598753
+8763876A880587A2879F878287AF87CB87BD87C087D096D687AB87C487B387C7
+87C687BB87EF87F287E0880F880D87FE87F687F7880E87D28811881688158822
+88218831883688398827883B8844884288528859885E8862886B8881887E889E
+8875887D88B5887288828897889288AE889988A2888D88A488B088BF88B188C3
+88C488D488D888D988DD88F9890288FC88F488E888F28904890C890A89138943
+891E8925892A892B89418944893B89368938894C891D8960895E000000000000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+89668964896D896A896F89748977897E89838988898A8993899889A189A989A6
+89AC89AF89B289BA89BD89BF89C089DA89DC89DD89E789F489F88A038A168A10
+8A0C8A1B8A1D8A258A368A418A5B8A528A468A488A7C8A6D8A6C8A628A858A82
+8A848AA88AA18A918AA58AA68A9A8AA38AC48ACD8AC28ADA8AEB8AF38AE70000
+8AE48AF18B148AE08AE28AF78ADE8ADB8B0C8B078B1A8AE18B168B108B178B20
+8B3397AB8B268B2B8B3E8B288B418B4C8B4F8B4E8B498B568B5B8B5A8B6B8B5F
+8B6C8B6F8B748B7D8B808B8C8B8E8B928B938B968B998B9A8C3A8C418C3F8C48
+8C4C8C4E8C508C558C628C6C8C788C7A8C828C898C858C8A8C8D8C8E8C948C7C
+8C98621D8CAD8CAA8CBD8CB28CB38CAE8CB68CC88CC18CE48CE38CDA8CFD8CFA
+8CFB8D048D058D0A8D078D0F8D0D8D109F4E8D138CCD8D148D168D678D6D8D71
+8D738D818D998DC28DBE8DBA8DCF8DDA8DD68DCC8DDB8DCB8DEA8DEB8DDF8DE3
+8DFC8E088E098DFF8E1D8E1E8E108E1F8E428E358E308E348E4A000000000000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E478E498E4C8E508E488E598E648E608E2A8E638E558E768E728E7C8E818E87
+8E858E848E8B8E8A8E938E918E948E998EAA8EA18EAC8EB08EC68EB18EBE8EC5
+8EC88ECB8EDB8EE38EFC8EFB8EEB8EFE8F0A8F058F158F128F198F138F1C8F1F
+8F1B8F0C8F268F338F3B8F398F458F428F3E8F4C8F498F468F4E8F578F5C0000
+8F628F638F648F9C8F9F8FA38FAD8FAF8FB78FDA8FE58FE28FEA8FEF90878FF4
+90058FF98FFA901190159021900D901E9016900B90279036903590398FF8904F
+905090519052900E9049903E90569058905E9068906F907696A890729082907D
+90819080908A9089908F90A890AF90B190B590E290E4624890DB910291129119
+91329130914A9156915891639165916991739172918B9189918291A291AB91AF
+91AA91B591B491BA91C091C191C991CB91D091D691DF91E191DB91FC91F591F6
+921E91FF9214922C92159211925E925792459249926492489295923F924B9250
+929C92969293929B925A92CF92B992B792E9930F92FA9344932E000000000000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+93199322931A9323933A9335933B935C9360937C936E935693B093AC93AD9394
+93B993D693D793E893E593D893C393DD93D093C893E4941A9414941394039407
+94109436942B94359421943A944194529444945B94609462945E946A92299470
+94759477947D945A947C947E9481947F95829587958A95949596959895990000
+95A095A895A795AD95BC95BB95B995BE95CA6FF695C395CD95CC95D595D495D6
+95DC95E195E595E296219628962E962F9642964C964F964B9677965C965E965D
+965F96669672966C968D96989695969796AA96A796B196B296B096B496B696B8
+96B996CE96CB96C996CD894D96DC970D96D596F99704970697089713970E9711
+970F971697199724972A97309739973D973E97449746974897429749975C9760
+97649766976852D2976B977197799785977C9781977A9786978B978F9790979C
+97A897A697A397B397B497C397C697C897CB97DC97ED9F4F97F27ADF97F697F5
+980F980C9838982498219837983D9846984F984B986B986F9870000000000000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+98719874987398AA98AF98B198B698C498C398C698E998EB9903990999129914
+99189921991D991E99249920992C992E993D993E9942994999459950994B9951
+9952994C99559997999899A599AD99AE99BC99DF99DB99DD99D899D199ED99EE
+99F199F299FB99F89A019A0F9A0599E29A199A2B9A379A459A429A409A430000
+9A3E9A559A4D9A5B9A579A5F9A629A659A649A699A6B9A6A9AAD9AB09ABC9AC0
+9ACF9AD19AD39AD49ADE9ADF9AE29AE39AE69AEF9AEB9AEE9AF49AF19AF79AFB
+9B069B189B1A9B1F9B229B239B259B279B289B299B2A9B2E9B2F9B329B449B43
+9B4F9B4D9B4E9B519B589B749B939B839B919B969B979B9F9BA09BA89BB49BC0
+9BCA9BB99BC69BCF9BD19BD29BE39BE29BE49BD49BE19C3A9BF29BF19BF09C15
+9C149C099C139C0C9C069C089C129C0A9C049C2E9C1B9C259C249C219C309C47
+9C329C469C3E9C5A9C609C679C769C789CE79CEC9CF09D099D089CEB9D039D06
+9D2A9D269DAF9D239D1F9D449D159D129D419D3F9D3E9D469D48000000000000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9D5D9D5E9D649D519D509D599D729D899D879DAB9D6F9D7A9D9A9DA49DA99DB2
+9DC49DC19DBB9DB89DBA9DC69DCF9DC29DD99DD39DF89DE69DED9DEF9DFD9E1A
+9E1B9E1E9E759E799E7D9E819E889E8B9E8C9E929E959E919E9D9EA59EA99EB8
+9EAA9EAD97619ECC9ECE9ECF9ED09ED49EDC9EDE9EDD9EE09EE59EE89EEF0000
+9EF49EF69EF79EF99EFB9EFC9EFD9F079F0876B79F159F219F2C9F3E9F4A9F52
+9F549F639F5F9F609F619F669F679F6C9F6A9F779F729F769F959F9C9FA0582F
+69C79059746451DC719900000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+EB
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F8B5F8B60000000000000000000000000000000000000000000000000000
+F8B7FE33000000000000000000000000000000000000F8B8FE31F8B900000000
+F8BAF8BBF8BCF8BDFE300000000000000000FE35FE36FE39FE3AF8BEF8BFFE37
+FE38FE3FFE40FE3DFE3EFE41FE42FE43FE44FE3BFE3C00000000000000000000
+0000F8C000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+EC
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000F8C1
+0000F8C20000F8C30000F8C40000F8C500000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F8C600000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000F8C70000F8C80000F8C9000000000000000000000000F8CA000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+ED
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+F8CB0000F8CC0000F8CD0000F8CE0000F8CF0000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000F8D00000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000F8D10000F8D20000F8D3000000000000000000000000F8D40000
+00000000000000000000F8D5F8D6000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/macRoman.enc b/tcl/library/encoding/macRoman.enc
new file mode 100644
index 00000000000..6cfd7494884
--- /dev/null
+++ b/tcl/library/encoding/macRoman.enc
@@ -0,0 +1,20 @@
+# Encoding file: macRoman, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
+00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
+202000B000A200A300A7202200B600DF00AE00A9212200B400A8226000C600D8
+221E00B12264226500A500B522022211220F03C0222B00AA00BA212600E600F8
+00BF00A100AC221A01922248220600AB00BB202600A000C000C300D501520153
+20132014201C201D2018201900F725CA00FF0178204400A42039203AFB01FB02
+202100B7201A201E203000C200CA00C100CB00C800CD00CE00CF00CC00D300D4
+F8FF00D200DA00DB00D9013102C602DC00AF02D802D902DA00B802DD02DB02C7
diff --git a/tcl/library/encoding/macRomania.enc b/tcl/library/encoding/macRomania.enc
new file mode 100644
index 00000000000..ce41cf427f2
--- /dev/null
+++ b/tcl/library/encoding/macRomania.enc
@@ -0,0 +1,20 @@
+# Encoding file: macRomania, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
+00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
+202000B000A200A300A7202200B600DF00AE00A9212200B400A822600102015E
+221E00B12264226500A500B522022211220F03C0222B00AA00BA21260103015F
+00BF00A100AC221A01922248220600AB00BB202600A000C000C300D501520153
+20132014201C201D2018201900F725CA00FF0178204400A42039203A01620163
+202100B7201A201E203000C200CA00C100CB00C800CD00CE00CF00CC00D300D4
+F8FF00D200DA00DB00D9013102C602DC00AF02D802D902DA00B802DD02DB02C7
diff --git a/tcl/library/encoding/macThai.enc b/tcl/library/encoding/macThai.enc
new file mode 100644
index 00000000000..7d9c8ad4a2b
--- /dev/null
+++ b/tcl/library/encoding/macThai.enc
@@ -0,0 +1,20 @@
+# Encoding file: macThai, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00AB00BB2026F88CF88FF892F895F898F88BF88EF891F894F897201C201DF899
+FFFD2022F884F889F885F886F887F888F88AF88DF890F893F89620182019FFFD
+00A00E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
+0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
+0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F
+0E300E310E320E330E340E350E360E370E380E390E3AFEFF200B201320140E3F
+0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D21220E4F
+0E500E510E520E530E540E550E560E570E580E5900AE00A9FFFDFFFDFFFDFFFD
diff --git a/tcl/library/encoding/macTurkish.enc b/tcl/library/encoding/macTurkish.enc
new file mode 100644
index 00000000000..73e86876bfb
--- /dev/null
+++ b/tcl/library/encoding/macTurkish.enc
@@ -0,0 +1,20 @@
+# Encoding file: macTurkish, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
+00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
+202000B000A200A300A7202200B600DF00AE00A9212200B400A8226000C600D8
+221E00B12264226500A500B522022211220F03C0222B00AA00BA212600E600F8
+00BF00A100AC221A01922248220600AB00BB202600A000C000C300D501520153
+20132014201C201D2018201900F725CA00FF0178011E011F01300131015E015F
+202100B7201A201E203000C200CA00C100CB00C800CD00CE00CF00CC00D300D4
+F8FF00D200DA00DB00D9F8A002C602DC00AF02D802D902DA00B802DD02DB02C7
diff --git a/tcl/library/encoding/macUkraine.enc b/tcl/library/encoding/macUkraine.enc
new file mode 100644
index 00000000000..643cc45e9ef
--- /dev/null
+++ b/tcl/library/encoding/macUkraine.enc
@@ -0,0 +1,20 @@
+# Encoding file: macUkraine, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0410041104120413041404150416041704180419041A041B041C041D041E041F
+0420042104220423042404250426042704280429042A042B042C042D042E042F
+202000B0049000A300A7202200B6040600AE00A9212204020452226004030453
+221E00B122642265045600B504910408040404540407045704090459040A045A
+0458040500AC221A01922248220600AB00BB202600A0040B045B040C045C0455
+20132014201C201D2018201900F7201E040E045E040F045F211604010451044F
+0430043104320433043404350436043704380439043A043B043C043D043E043F
+0440044104420443044404450446044704480449044A044B044C044D044E00A4
diff --git a/tcl/library/encoding/shiftjis.enc b/tcl/library/encoding/shiftjis.enc
new file mode 100644
index 00000000000..c8d25044b05
--- /dev/null
+++ b/tcl/library/encoding/shiftjis.enc
@@ -0,0 +1,683 @@
+# Encoding file: shiftjis, multi-byte
+M
+003F 0 40
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080000000000000000000850086008700000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+81
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+300030013002FF0CFF0E30FBFF1AFF1BFF1FFF01309B309C00B4FF4000A8FF3E
+FFE3FF3F30FD30FE309D309E30034EDD30053006300730FC20152010FF0FFF3C
+301C2016FF5C2026202520182019201C201DFF08FF0930143015FF3BFF3DFF5B
+FF5D30083009300A300B300C300D300E300F30103011FF0B221200B100D70000
+00F7FF1D2260FF1CFF1E22662267221E22342642264000B0203220332103FFE5
+FF0400A200A3FF05FF03FF06FF0AFF2000A72606260525CB25CF25CE25C725C6
+25A125A025B325B225BD25BC203B301221922190219121933013000000000000
+000000000000000000000000000000002208220B2286228722822283222A2229
+000000000000000000000000000000002227222800AC21D221D4220022030000
+0000000000000000000000000000000000000000222022A52312220222072261
+2252226A226B221A223D221D2235222B222C0000000000000000000000000000
+212B2030266F266D266A2020202100B6000000000000000025EF000000000000
+82
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000000000000000000000FF10
+FF11FF12FF13FF14FF15FF16FF17FF18FF190000000000000000000000000000
+FF21FF22FF23FF24FF25FF26FF27FF28FF29FF2AFF2BFF2CFF2DFF2EFF2FFF30
+FF31FF32FF33FF34FF35FF36FF37FF38FF39FF3A000000000000000000000000
+0000FF41FF42FF43FF44FF45FF46FF47FF48FF49FF4AFF4BFF4CFF4DFF4EFF4F
+FF50FF51FF52FF53FF54FF55FF56FF57FF58FF59FF5A00000000000000003041
+30423043304430453046304730483049304A304B304C304D304E304F30503051
+30523053305430553056305730583059305A305B305C305D305E305F30603061
+30623063306430653066306730683069306A306B306C306D306E306F30703071
+30723073307430753076307730783079307A307B307C307D307E307F30803081
+30823083308430853086308730883089308A308B308C308D308E308F30903091
+3092309300000000000000000000000000000000000000000000000000000000
+83
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+30A130A230A330A430A530A630A730A830A930AA30AB30AC30AD30AE30AF30B0
+30B130B230B330B430B530B630B730B830B930BA30BB30BC30BD30BE30BF30C0
+30C130C230C330C430C530C630C730C830C930CA30CB30CC30CD30CE30CF30D0
+30D130D230D330D430D530D630D730D830D930DA30DB30DC30DD30DE30DF0000
+30E030E130E230E330E430E530E630E730E830E930EA30EB30EC30ED30EE30EF
+30F030F130F230F330F430F530F6000000000000000000000000000000000391
+03920393039403950396039703980399039A039B039C039D039E039F03A003A1
+03A303A403A503A603A703A803A90000000000000000000000000000000003B1
+03B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF03C003C1
+03C303C403C503C603C703C803C9000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+84
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+04100411041204130414041504010416041704180419041A041B041C041D041E
+041F0420042104220423042404250426042704280429042A042B042C042D042E
+042F000000000000000000000000000000000000000000000000000000000000
+04300431043204330434043504510436043704380439043A043B043C043D0000
+043E043F0440044104420443044404450446044704480449044A044B044C044D
+044E044F00000000000000000000000000000000000000000000000000002500
+2502250C251025182514251C252C25242534253C25012503250F2513251B2517
+25232533252B253B254B2520252F25282537253F251D25302525253825420000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+88
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000004E9C
+55165A03963F54C0611B632859F690228475831C7A5060AA63E16E2565ED8466
+82A69BF56893572765A162715B9B59D0867B98F47D627DBE9B8E62167C9F88B7
+5B895EB563096697684895C7978D674F4EE54F0A4F4D4F9D504956F2593759D4
+5A015C0960DF610F61706613690570BA754F757079FB7DAD7DEF80C3840E8863
+8B029055907A533B4E954EA557DF80B290C178EF4E0058F16EA290387A328328
+828B9C2F5141537054BD54E156E059FB5F1598F26DEB80E4852D000000000000
+89
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9662967096A097FB540B53F35B8770CF7FBD8FC296E8536F9D5C7ABA4E117893
+81FC6E26561855046B1D851A9C3B59E553A96D6674DC958F56424E91904B96F2
+834F990C53E155B65B305F71662066F368046C386CF36D29745B76C87A4E9834
+82F1885B8A6092ED6DB275AB76CA99C560A68B018D8A95B2698E53AD51860000
+5712583059445BB45EF6602863A963F46CBF6F14708E7114715971D5733F7E01
+827682D185979060925B9D1B586965BC6C5A752551F9592E59655F805FDC62BC
+65FA6A2A6B276BB4738B7FC189569D2C9D0E9EC45CA16C96837B51045C4B61B6
+81C6687672614E594FFA537860696E297A4F97F34E0B53164EEE4F554F3D4FA1
+4F7352A053EF5609590F5AC15BB65BE179D16687679C67B66B4C6CB3706B73C2
+798D79BE7A3C7B8782B182DB8304837783EF83D387668AB256298CA88FE6904E
+971E868A4FC45CE862117259753B81E582BD86FE8CC096C5991399D54ECB4F1A
+89E356DE584A58CA5EFB5FEB602A6094606261D0621262D06539000000000000
+8A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9B41666668B06D777070754C76867D7582A587F9958B968E8C9D51F152BE5916
+54B35BB35D16616869826DAF788D84CB88578A7293A79AB86D6C99A886D957A3
+67FF86CE920E5283568754045ED362E164B9683C68386BBB737278BA7A6B899A
+89D28D6B8F0390ED95A3969497695B665CB3697D984D984E639B7B206A2B0000
+6A7F68B69C0D6F5F5272559D607062EC6D3B6E076ED1845B89108F444E149C39
+53F6691B6A3A9784682A515C7AC384B291DC938C565B9D286822830584317CA5
+520882C574E64E7E4F8351A05BD2520A52D852E75DFB559A582A59E65B8C5B98
+5BDB5E725E7960A3611F616361BE63DB656267D1685368FA6B3E6B536C576F22
+6F976F4574B0751876E3770B7AFF7BA17C217DE97F367FF0809D8266839E89B3
+8ACC8CAB908494519593959195A2966597D3992882184E38542B5CB85DCC73A9
+764C773C5CA97FEB8D0B96C19811985498584F014F0E5371559C566857FA5947
+5B095BC45C905E0C5E7E5FCC63EE673A65D765E2671F68CB68C4000000000000
+8B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A5F5E306BC56C176C7D757F79485B637A007D005FBD898F8A188CB48D778ECC
+8F1D98E29A0E9B3C4E80507D510059935B9C622F628064EC6B3A72A075917947
+7FA987FB8ABC8B7063AC83CA97A05409540355AB68546A588A70782767759ECD
+53745BA2811A865090064E184E454EC74F1153CA54385BAE5F13602565510000
+673D6C426C726CE3707874037A767AAE7B087D1A7CFE7D6665E7725B53BB5C45
+5DE862D262E063196E20865A8A318DDD92F86F0179A69B5A4EA84EAB4EAC4F9B
+4FA050D151477AF6517151F653545321537F53EB55AC58835CE15F375F4A602F
+6050606D631F65596A4B6CC172C272ED77EF80F881058208854E90F793E197FF
+99579A5A4EF051DD5C2D6681696D5C4066F26975738968507C8150C552E45747
+5DFE932665A46B236B3D7434798179BD7B4B7DCA82B983CC887F895F8B398FD1
+91D1541F92804E5D503653E5533A72D7739677E982E68EAF99C699C899D25177
+611A865E55B07A7A50765BD3904796854E326ADB91E75C515C48000000000000
+8C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+63987A9F6C9397748F617AAA718A96887C8268177E706851936C52F2541B85AB
+8A137FA48ECD90E15366888879414FC250BE521151445553572D73EA578B5951
+5F625F8460756176616761A963B2643A656C666F68426E1375667A3D7CFB7D4C
+7D997E4B7F6B830E834A86CD8A088A638B668EFD981A9D8F82B88FCE9BE80000
+5287621F64836FC09699684150916B206C7A6F547A747D5088408A2367084EF6
+503950265065517C5238526355A7570F58055ACC5EFA61B261F862F36372691C
+6A29727D72AC732E7814786F7D79770C80A9898B8B198CE28ED290639375967A
+98559A139E785143539F53B35E7B5F266E1B6E90738473FE7D4382378A008AFA
+96504E4E500B53E4547C56FA59D15B645DF15EAB5F276238654567AF6E5672D0
+7CCA88B480A180E183F0864E8A878DE8923796C798679F134E944E924F0D5348
+5449543E5A2F5F8C5FA1609F68A76A8E745A78818A9E8AA48B7791904E5E9BC9
+4EA44F7C4FAF501950165149516C529F52B952FE539A53E35411000000000000
+8D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+540E5589575157A2597D5B545B5D5B8F5DE55DE75DF75E785E835E9A5EB75F18
+6052614C629762D863A7653B6602664366F4676D6821689769CB6C5F6D2A6D69
+6E2F6E9D75327687786C7A3F7CE07D057D187D5E7DB18015800380AF80B18154
+818F822A8352884C88618B1B8CA28CFC90CA91759271783F92FC95A4964D0000
+980599999AD89D3B525B52AB53F7540858D562F76FE08C6A8F5F9EB9514B523B
+544A56FD7A4091779D609ED273446F09817075115FFD60DA9AA872DB8FBC6B64
+98034ECA56F0576458BE5A5A606861C7660F6606683968B16DF775D57D3A826E
+9B424E9B4F5053C955065D6F5DE65DEE67FB6C99747378028A50939688DF5750
+5EA7632B50B550AC518D670054C9585E59BB5BB05F69624D63A1683D6B736E08
+707D91C7728078157826796D658E7D3083DC88C18F09969B5264572867507F6A
+8CA151B45742962A583A698A80B454B25D0E57FC78959DFA4F5C524A548B643E
+6628671467F57A847B567D22932F685C9BAD7B395319518A5237000000000000
+8E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5BDF62F664AE64E6672D6BBA85A996D176909BD6634C93069BAB76BF66524E09
+509853C25C7160E864926563685F71E673CA75237B977E8286958B838CDB9178
+991065AC66AB6B8B4ED54ED44F3A4F7F523A53F853F255E356DB58EB59CB59C9
+59FF5B505C4D5E025E2B5FD7601D6307652F5B5C65AF65BD65E8679D6B620000
+6B7B6C0F7345794979C17CF87D197D2B80A2810281F389968A5E8A698A668A8C
+8AEE8CC78CDC96CC98FC6B6F4E8B4F3C4F8D51505B575BFA6148630166426B21
+6ECB6CBB723E74BD75D478C1793A800C803381EA84948F9E6C509E7F5F0F8B58
+9D2B7AFA8EF85B8D96EB4E0353F157F759315AC95BA460896E7F6F0675BE8CEA
+5B9F85007BE0507267F4829D5C61854A7E1E820E51995C0463688D66659C716E
+793E7D1780058B1D8ECA906E86C790AA501F52FA5C3A6753707C7235914C91C8
+932B82E55BC25F3160F94E3B53D65B88624B67316B8A72E973E07A2E816B8DA3
+91529996511253D7546A5BFF63886A397DAC970056DA53CE5468000000000000
+8F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5B975C315DDE4FEE610162FE6D3279C079CB7D427E4D7FD281ED821F84908846
+89728B908E748F2F9031914B916C96C6919C4EC04F4F514553415F93620E67D4
+6C416E0B73637E2691CD928353D459195BBF6DD1795D7E2E7C9B587E719F51FA
+88538FF04FCA5CFB662577AC7AE3821C99FF51C65FAA65EC696F6B896DF30000
+6E966F6476FE7D145DE190759187980651E6521D6240669166D96E1A5EB67DD2
+7F7266F885AF85F78AF852A953D959735E8F5F90605592E4966450B7511F52DD
+5320534753EC54E8554655315617596859BE5A3C5BB55C065C0F5C115C1A5E84
+5E8A5EE05F70627F628462DB638C63776607660C662D6676677E68A26A1F6A35
+6CBC6D886E096E58713C7126716775C77701785D7901796579F07AE07B117CA7
+7D39809683D6848B8549885D88F38A1F8A3C8A548A738C618CDE91A49266937E
+9418969C97984E0A4E084E1E4E575197527057CE583458CC5B225E3860C564FE
+676167566D4472B675737A6384B88B7291B89320563157F498FE000000000000
+90
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+62ED690D6B9671ED7E548077827289E698DF87558FB15C3B4F384FE14FB55507
+5A205BDD5BE95FC3614E632F65B0664B68EE699B6D786DF1753375B9771F795E
+79E67D3381E382AF85AA89AA8A3A8EAB8F9B903291DD97074EBA4EC152035875
+58EC5C0B751A5C3D814E8A0A8FC59663976D7B258ACF9808916256F353A80000
+9017543957825E2563A86C34708A77617C8B7FE088709042915493109318968F
+745E9AC45D075D69657067A28DA896DB636E6749691983C5981796C088FE6F84
+647A5BF84E16702C755D662F51C4523652E259D35F8160276210653F6574661F
+667468F268166B636E057272751F76DB7CBE805658F088FD897F8AA08A938ACB
+901D91929752975965897A0E810696BB5E2D60DC621A65A56614679077F37A4D
+7C4D7E3E810A8CAC8D648DE18E5F78A9520762D963A5644262988A2D7A837BC0
+8AAC96EA7D76820C87494ED95148534353605BA35C025C165DDD6226624764B0
+681368346CC96D456D1767D36F5C714E717D65CB7A7F7BAD7DDA000000000000
+91
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7E4A7FA8817A821B823985A68A6E8CCE8DF59078907792AD929195839BAE524D
+55846F387136516879857E5581B37CCE564C58515CA863AA66FE66FD695A72D9
+758F758E790E795679DF7C977D207D4486078A34963B90619F2050E7527553CC
+53E2500955AA58EE594F723D5B8B5C64531D60E360F3635C6383633F63BB0000
+64CD65E966F95DE369CD69FD6F1571E54E8975E976F87A937CDF7DCF7D9C8061
+83498358846C84BC85FB88C58D709001906D9397971C9A1250CF5897618E81D3
+85358D0890204FC3507452475373606F6349675F6E2C8DB3901F4FD75C5E8CCA
+65CF7D9A53528896517663C35B585B6B5C0A640D6751905C4ED6591A592A6C70
+8A51553E581559A560F0625367C182356955964099C49A284F5358065BFE8010
+5CB15E2F5F856020614B623466FF6CF06EDE80CE817F82D4888B8CB89000902E
+968A9EDB9BDB4EE353F059277B2C918D984C9DF96EDD7027535355445B856258
+629E62D36CA26FEF74228A1794386FC18AFE833851E786F853EA000000000000
+92
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+53E94F4690548FB0596A81315DFD7AEA8FBF68DA8C3772F89C486A3D8AB04E39
+53585606576662C563A265E66B4E6DE16E5B70AD77ED7AEF7BAA7DBB803D80C6
+86CB8A95935B56E358C75F3E65AD66966A806BB575378AC7502477E557305F1B
+6065667A6C6075F47A1A7F6E81F48718904599B37BC9755C7AF97B5184C40000
+901079E97A9283365AE177404E2D4EF25B995FE062BD663C67F16CE8866B8877
+8A3B914E92F399D06A177026732A82E784578CAF4E01514651CB558B5BF55E16
+5E335E815F145F355F6B5FB461F2631166A2671D6F6E7252753A773A80748139
+817887768ABF8ADC8D858DF3929A957798029CE552C5635776F467156C8873CD
+8CC393AE96736D25589C690E69CC8FFD939A75DB901A585A680263B469FB4F43
+6F2C67D88FBB85267DB49354693F6F70576A58F75B2C7D2C722A540A91E39DB4
+4EAD4F4E505C507552438C9E544858245B9A5E1D5E955EAD5EF75F1F608C62B5
+633A63D068AF6C407887798E7A0B7DE082478A028AE68E449013000000000000
+93
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+90B8912D91D89F0E6CE5645864E265756EF476847B1B906993D16EBA54F25FB9
+64A48F4D8FED92445178586B59295C555E976DFB7E8F751C8CBC8EE2985B70B9
+4F1D6BBF6FB1753096FB514E54105835585759AC5C605F926597675C6E21767B
+83DF8CED901490FD934D7825783A52AA5EA6571F597460125012515A51AC0000
+51CD520055105854585859575B955CF65D8B60BC6295642D6771684368BC68DF
+76D76DD86E6F6D9B706F71C85F5375D879777B497B547B527CD67D7152308463
+856985E48A0E8B048C468E0F9003900F94199676982D9A3095D850CD52D5540C
+58025C0E61A7649E6D1E77B37AE580F48404905392855CE09D07533F5F975FB3
+6D9C7279776379BF7BE46BD272EC8AAD68036A6151F87A8169345C4A9CF682EB
+5BC59149701E56785C6F60C765666C8C8C5A90419813545166C7920D594890A3
+51854E4D51EA85998B0E7058637A934B696299B47E047577535769608EDF96E3
+6C5D4E8C5C3C5F108FE953028CD1808986795EFF65E54E735165000000000000
+94
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59825C3F97EE4EFB598A5FCD8A8D6FE179B079625BE78471732B71B15E745FF5
+637B649A71C37C984E435EFC4E4B57DC56A260A96FC37D0D80FD813381BF8FB2
+899786A45DF4628A64AD898767776CE26D3E743678345A467F7582AD99AC4FF3
+5EC362DD63926557676F76C3724C80CC80BA8F29914D500D57F95A9268850000
+6973716472FD8CB758F28CE0966A9019877F79E477E784294F2F5265535A62CD
+67CF6CCA767D7B947C95823685848FEB66DD6F2072067E1B83AB99C19EA651FD
+7BB178727BB880877B486AE85E61808C75517560516B92626E8C767A91979AEA
+4F107F70629C7B4F95A59CE9567A585986E496BC4F345224534A53CD53DB5E06
+642C6591677F6C3E6C4E724872AF73ED75547E41822C85E98CA97BC491C67169
+981298EF633D6669756A76E478D0854386EE532A5351542659835E875F7C60B2
+6249627962AB65906BD46CCC75B276AE789179D87DCB7F7780A588AB8AB98CBB
+907F975E98DB6A0B7C3850995C3E5FAE67876BD8743577097F8E000000000000
+95
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9F3B67CA7A175339758B9AED5F66819D83F180985F3C5FC575627B46903C6867
+59EB5A9B7D10767E8B2C4FF55F6A6A196C376F0274E2796888688A558C795EDF
+63CF75C579D282D7932892F2849C86ED9C2D54C15F6C658C6D5C70158CA78CD3
+983B654F74F64E0D4ED857E0592B5A665BCC51A85E035E9C6016627665770000
+65A7666E6D6E72367B268150819A82998B5C8CA08CE68D74961C96444FAE64AB
+6B66821E8461856A90E85C01695398A8847A85574F0F526F5FA95E45670D798F
+8179890789866DF55F1762556CB84ECF72699B925206543B567458B361A4626E
+711A596E7C897CDE7D1B96F06587805E4E194F75517558405E635E735F0A67C4
+4E26853D9589965B7C73980150FB58C1765678A7522577A585117B86504F5909
+72477BC77DE88FBA8FD4904D4FBF52C95A295F0197AD4FDD821792EA57036355
+6B69752B88DC8F147A4252DF58936155620A66AE6BCD7C3F83E950234FF85305
+5446583159495B9D5CF05CEF5D295E9662B16367653E65B9670B000000000000
+96
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6CD56CE170F978327E2B80DE82B3840C84EC870289128A2A8C4A90A692D298FD
+9CF39D6C4E4F4EA1508D5256574A59A85E3D5FD85FD9623F66B4671B67D068D2
+51927D2180AA81A88B008C8C8CBF927E96325420982C531750D5535C58A864B2
+6734726777667A4691E652C36CA16B8658005E4C5954672C7FFB51E176C60000
+646978E89B549EBB57CB59B96627679A6BCE54E969D95E55819C67959BAA67FE
+9C52685D4EA64FE353C862B9672B6CAB8FC44FAD7E6D9EBF4E0761626E806F2B
+85135473672A9B455DF37B955CAC5BC6871C6E4A84D17A14810859997C8D6C11
+772052D959227121725F77DB97279D61690B5A7F5A1851A5540D547D660E76DF
+8FF792989CF459EA725D6EC5514D68C97DBF7DEC97629EBA64786A2183025984
+5B5F6BDB731B76F27DB280178499513267289ED976EE676252FF99055C24623B
+7C7E8CB0554F60B67D0B958053014E5F51B6591C723A803691CE5F2577E25384
+5F797D0485AC8A338E8D975667F385AE9453610961086CB9765200000000FF5E
+97
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8AED8F38552F4F51512A52C753CB5BA55E7D60A0618263D6670967DA6E676D8C
+733673377531795088D58A98904A909190F596C4878D59154E884F594E0E8A89
+8F3F981050AD5E7C59965BB95EB863DA63FA64C166DC694A69D86D0B6EB67194
+75287AAF7F8A8000844984C989818B218E0A9065967D990A617E62916B320000
+6C836D747FCC7FFC6DC07F8587BA88F8676583B1983C96F76D1B7D61843D916A
+4E7153755D506B046FEB85CD862D89A75229540F5C65674E68A87406748375E2
+88CF88E191CC96E296785F8B73877ACB844E63A0756552896D416E9C74097559
+786B7C9296867ADC9F8D4FB6616E65C5865C4E864EAE50DA4E2151CC5BEE6599
+68816DBC731F764277AD7A1C7CE7826F8AD2907C91CF96759818529B7DD1502B
+539867976DCB71D0743381E88F2A96A39C579E9F746058416D997D2F985E4EE4
+4F364F8B51B752B15DBA601C73B2793C82D3923496B796F6970A9E979F6266A6
+6B74521752A370C888C25EC9604B61906F2371497C3E7DF4806F000000000000
+98
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+84EE9023932C54429B6F6AD370898CC28DEF973252B45A415ECA5F046717697C
+69946D6A6F0F726272FC7BED8001807E874B90CE516D9E937984808B93328AD6
+502D548C8A716B6A8CC4810760D167A09DF24E994E989C108A6B85C185686900
+6E7E789781550000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000005F0C
+4E104E154E2A4E314E364E3C4E3F4E424E564E584E824E858C6B4E8A82125F0D
+4E8E4E9E4E9F4EA04EA24EB04EB34EB64ECE4ECD4EC44EC64EC24ED74EDE4EED
+4EDF4EF74F094F5A4F304F5B4F5D4F574F474F764F884F8F4F984F7B4F694F70
+4F914F6F4F864F9651184FD44FDF4FCE4FD84FDB4FD14FDA4FD04FE44FE5501A
+50285014502A502550054F1C4FF650215029502C4FFE4FEF5011500650435047
+6703505550505048505A5056506C50785080509A508550B450B2000000000000
+99
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+50C950CA50B350C250D650DE50E550ED50E350EE50F950F55109510151025116
+51155114511A5121513A5137513C513B513F51405152514C515451627AF85169
+516A516E5180518256D8518C5189518F519151935195519651A451A651A251A9
+51AA51AB51B351B151B251B051B551BD51C551C951DB51E0865551E951ED0000
+51F051F551FE5204520B5214520E5227522A522E52335239524F5244524B524C
+525E5254526A527452695273527F527D528D529452925271528852918FA88FA7
+52AC52AD52BC52B552C152CD52D752DE52E352E698ED52E052F352F552F852F9
+530653087538530D5310530F5315531A5323532F533153335338534053465345
+4E175349534D51D6535E5369536E5918537B53775382539653A053A653A553AE
+53B053B653C37C1296D953DF66FC71EE53EE53E853ED53FA5401543D5440542C
+542D543C542E54365429541D544E548F5475548E545F5471547754705492547B
+5480547654845490548654C754A254B854A554AC54C454C854A8000000000000
+9A
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+54AB54C254A454BE54BC54D854E554E6550F551454FD54EE54ED54FA54E25539
+55405563554C552E555C55455556555755385533555D5599558054AF558A559F
+557B557E5598559E55AE557C558355A9558755A855DA55C555DF55C455DC55E4
+55D4561455F7561655FE55FD561B55F9564E565071DF56345636563256380000
+566B5664562F566C566A56865680568A56A05694568F56A556AE56B656B456C2
+56BC56C156C356C056C856CE56D156D356D756EE56F9570056FF570457095708
+570B570D57135718571655C7571C572657375738574E573B5740574F576957C0
+57885761577F5789579357A057B357A457AA57B057C357C657D457D257D3580A
+57D657E3580B5819581D587258215862584B58706BC05852583D5879588558B9
+589F58AB58BA58DE58BB58B858AE58C558D358D158D758D958D858E558DC58E4
+58DF58EF58FA58F958FB58FC58FD5902590A5910591B68A65925592C592D5932
+5938593E7AD259555950594E595A5958596259605967596C5969000000000000
+9B
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+59785981599D4F5E4FAB59A359B259C659E859DC598D59D959DA5A255A1F5A11
+5A1C5A095A1A5A405A6C5A495A355A365A625A6A5A9A5ABC5ABE5ACB5AC25ABD
+5AE35AD75AE65AE95AD65AFA5AFB5B0C5B0B5B165B325AD05B2A5B365B3E5B43
+5B455B405B515B555B5A5B5B5B655B695B705B735B755B7865885B7A5B800000
+5B835BA65BB85BC35BC75BC95BD45BD05BE45BE65BE25BDE5BE55BEB5BF05BF6
+5BF35C055C075C085C0D5C135C205C225C285C385C395C415C465C4E5C535C50
+5C4F5B715C6C5C6E4E625C765C795C8C5C915C94599B5CAB5CBB5CB65CBC5CB7
+5CC55CBE5CC75CD95CE95CFD5CFA5CED5D8C5CEA5D0B5D155D175D5C5D1F5D1B
+5D115D145D225D1A5D195D185D4C5D525D4E5D4B5D6C5D735D765D875D845D82
+5DA25D9D5DAC5DAE5DBD5D905DB75DBC5DC95DCD5DD35DD25DD65DDB5DEB5DF2
+5DF55E0B5E1A5E195E115E1B5E365E375E445E435E405E4E5E575E545E5F5E62
+5E645E475E755E765E7A9EBC5E7F5EA05EC15EC25EC85ED05ECF000000000000
+9C
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+5ED65EE35EDD5EDA5EDB5EE25EE15EE85EE95EEC5EF15EF35EF05EF45EF85EFE
+5F035F095F5D5F5C5F0B5F115F165F295F2D5F385F415F485F4C5F4E5F2F5F51
+5F565F575F595F615F6D5F735F775F835F825F7F5F8A5F885F915F875F9E5F99
+5F985FA05FA85FAD5FBC5FD65FFB5FE45FF85FF15FDD60B35FFF602160600000
+601960106029600E6031601B6015602B6026600F603A605A6041606A6077605F
+604A6046604D6063604360646042606C606B60596081608D60E76083609A6084
+609B60966097609260A7608B60E160B860E060D360B45FF060BD60C660B560D8
+614D6115610660F660F7610060F460FA6103612160FB60F1610D610E6147613E
+61286127614A613F613C612C6134613D614261446173617761586159615A616B
+6174616F61656171615F615D6153617561996196618761AC6194619A618A6191
+61AB61AE61CC61CA61C961F761C861C361C661BA61CB7F7961CD61E661E361F6
+61FA61F461FF61FD61FC61FE620062086209620D620C6214621B000000000000
+9D
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+621E6221622A622E6230623262336241624E625E6263625B62606268627C6282
+6289627E62926293629662D46283629462D762D162BB62CF62FF62C664D462C8
+62DC62CC62CA62C262C7629B62C9630C62EE62F163276302630862EF62F56350
+633E634D641C634F6396638E638063AB637663A3638F6389639F63B5636B0000
+636963BE63E963C063C663E363C963D263F663C4641664346406641364266436
+651D64176428640F6467646F6476644E652A6495649364A564A9648864BC64DA
+64D264C564C764BB64D864C264F164E7820964E064E162AC64E364EF652C64F6
+64F464F264FA650064FD6518651C650565246523652B65346535653765366538
+754B654865566555654D6558655E655D65726578658265838B8A659B659F65AB
+65B765C365C665C165C465CC65D265DB65D965E065E165F16772660A660365FB
+6773663566366634661C664F664466496641665E665D666466676668665F6662
+667066836688668E668966846698669D66C166B966C966BE66BC000000000000
+9E
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+66C466B866D666DA66E0663F66E666E966F066F566F7670F6716671E67266727
+9738672E673F67366741673867376746675E67606759676367646789677067A9
+677C676A678C678B67A667A1678567B767EF67B467EC67B367E967B867E467DE
+67DD67E267EE67B967CE67C667E76A9C681E684668296840684D6832684E0000
+68B3682B685968636877687F689F688F68AD6894689D689B68836AAE68B96874
+68B568A068BA690F688D687E690168CA690868D86922692668E1690C68CD68D4
+68E768D569366912690468D768E3692568F968E068EF6928692A691A69236921
+68C669796977695C6978696B6954697E696E69396974693D695969306961695E
+695D6981696A69B269AE69D069BF69C169D369BE69CE5BE869CA69DD69BB69C3
+69A76A2E699169A0699C699569B469DE69E86A026A1B69FF6B0A69F969F269E7
+6A0569B16A1E69ED6A1469EB6A0A6A126AC16A236A136A446A0C6A726A366A78
+6A476A626A596A666A486A386A226A906A8D6AA06A846AA26AA3000000000000
+9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6A9786176ABB6AC36AC26AB86AB36AAC6ADE6AD16ADF6AAA6ADA6AEA6AFB6B05
+86166AFA6B126B169B316B1F6B386B3776DC6B3998EE6B476B436B496B506B59
+6B546B5B6B5F6B616B786B796B7F6B806B846B836B8D6B986B956B9E6BA46BAA
+6BAB6BAF6BB26BB16BB36BB76BBC6BC66BCB6BD36BDF6BEC6BEB6BF36BEF0000
+9EBE6C086C136C146C1B6C246C236C5E6C556C626C6A6C826C8D6C9A6C816C9B
+6C7E6C686C736C926C906CC46CF16CD36CBD6CD76CC56CDD6CAE6CB16CBE6CBA
+6CDB6CEF6CD96CEA6D1F884D6D366D2B6D3D6D386D196D356D336D126D0C6D63
+6D936D646D5A6D796D596D8E6D956FE46D856DF96E156E0A6DB56DC76DE66DB8
+6DC66DEC6DDE6DCC6DE86DD26DC56DFA6DD96DE46DD56DEA6DEE6E2D6E6E6E2E
+6E196E726E5F6E3E6E236E6B6E2B6E766E4D6E1F6E436E3A6E4E6E246EFF6E1D
+6E386E826EAA6E986EC96EB76ED36EBD6EAF6EC46EB26ED46ED56E8F6EA56EC2
+6E9F6F416F11704C6EEC6EF86EFE6F3F6EF26F316EEF6F326ECC000000000000
+E0
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+6F3E6F136EF76F866F7A6F786F816F806F6F6F5B6FF36F6D6F826F7C6F586F8E
+6F916FC26F666FB36FA36FA16FA46FB96FC66FAA6FDF6FD56FEC6FD46FD86FF1
+6FEE6FDB7009700B6FFA70117001700F6FFE701B701A6F74701D7018701F7030
+703E7032705170637099709270AF70F170AC70B870B370AE70DF70CB70DD0000
+70D9710970FD711C711971657155718871667162714C7156716C718F71FB7184
+719571A871AC71D771B971BE71D271C971D471CE71E071EC71E771F571FC71F9
+71FF720D7210721B7228722D722C72307232723B723C723F72407246724B7258
+7274727E7282728172877292729672A272A772B972B272C372C672C472CE72D2
+72E272E072E172F972F7500F7317730A731C7316731D7334732F73297325733E
+734E734F9ED87357736A7368737073787375737B737A73C873B373CE73BB73C0
+73E573EE73DE74A27405746F742573F87432743A7455743F745F74597441745C
+746974707463746A7476747E748B749E74A774CA74CF74D473F1000000000000
+E1
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+74E074E374E774E974EE74F274F074F174F874F7750475037505750C750E750D
+75157513751E7526752C753C7544754D754A7549755B7546755A756975647567
+756B756D75787576758675877574758A758975827594759A759D75A575A375C2
+75B375C375B575BD75B875BC75B175CD75CA75D275D975E375DE75FE75FF0000
+75FC760175F075FA75F275F3760B760D7609761F762776207621762276247634
+7630763B764776487646765C76587661766276687669766A7667766C76707672
+76767678767C768076837688768B768E769676937699769A76B076B476B876B9
+76BA76C276CD76D676D276DE76E176E576E776EA862F76FB7708770777047729
+7724771E77257726771B773777387747775A7768776B775B7765777F777E7779
+778E778B779177A0779E77B077B677B977BF77BC77BD77BB77C777CD77D777DA
+77DC77E377EE77FC780C781279267820792A7845788E78747886787C789A788C
+78A378B578AA78AF78D178C678CB78D478BE78BC78C578CA78EC000000000000
+E2
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+78E778DA78FD78F47907791279117919792C792B794079607957795F795A7955
+7953797A797F798A799D79A79F4B79AA79AE79B379B979BA79C979D579E779EC
+79E179E37A087A0D7A187A197A207A1F79807A317A3B7A3E7A377A437A577A49
+7A617A627A699F9D7A707A797A7D7A887A977A957A987A967AA97AC87AB00000
+7AB67AC57AC47ABF90837AC77ACA7ACD7ACF7AD57AD37AD97ADA7ADD7AE17AE2
+7AE67AED7AF07B027B0F7B0A7B067B337B187B197B1E7B357B287B367B507B7A
+7B047B4D7B0B7B4C7B457B757B657B747B677B707B717B6C7B6E7B9D7B987B9F
+7B8D7B9C7B9A7B8B7B927B8F7B5D7B997BCB7BC17BCC7BCF7BB47BC67BDD7BE9
+7C117C147BE67BE57C607C007C077C137BF37BF77C177C0D7BF67C237C277C2A
+7C1F7C377C2B7C3D7C4C7C437C547C4F7C407C507C587C5F7C647C567C657C6C
+7C757C837C907CA47CAD7CA27CAB7CA17CA87CB37CB27CB17CAE7CB97CBD7CC0
+7CC57CC27CD87CD27CDC7CE29B3B7CEF7CF27CF47CF67CFA7D06000000000000
+E3
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+7D027D1C7D157D0A7D457D4B7D2E7D327D3F7D357D467D737D567D4E7D727D68
+7D6E7D4F7D637D937D897D5B7D8F7D7D7D9B7DBA7DAE7DA37DB57DC77DBD7DAB
+7E3D7DA27DAF7DDC7DB87D9F7DB07DD87DDD7DE47DDE7DFB7DF27DE17E057E0A
+7E237E217E127E317E1F7E097E0B7E227E467E667E3B7E357E397E437E370000
+7E327E3A7E677E5D7E567E5E7E597E5A7E797E6A7E697E7C7E7B7E837DD57E7D
+8FAE7E7F7E887E897E8C7E927E907E937E947E967E8E7E9B7E9C7F387F3A7F45
+7F4C7F4D7F4E7F507F517F557F547F587F5F7F607F687F697F677F787F827F86
+7F837F887F877F8C7F947F9E7F9D7F9A7FA37FAF7FB27FB97FAE7FB67FB88B71
+7FC57FC67FCA7FD57FD47FE17FE67FE97FF37FF998DC80068004800B80128018
+8019801C80218028803F803B804A804680528058805A805F8062806880738072
+807080768079807D807F808480868085809B8093809A80AD519080AC80DB80E5
+80D980DD80C480DA80D6810980EF80F1811B81298123812F814B000000000000
+E4
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+968B8146813E8153815180FC8171816E81658166817481838188818A81808182
+81A0819581A481A3815F819381A981B081B581BE81B881BD81C081C281BA81C9
+81CD81D181D981D881C881DA81DF81E081E781FA81FB81FE8201820282058207
+820A820D821082168229822B82388233824082598258825D825A825F82640000
+82628268826A826B822E827182778278827E828D829282AB829F82BB82AC82E1
+82E382DF82D282F482F382FA8393830382FB82F982DE830682DC830982D98335
+83348316833283318340833983508345832F832B831783188385839A83AA839F
+83A283968323838E8387838A837C83B58373837583A0838983A883F4841383EB
+83CE83FD840383D8840B83C183F7840783E083F2840D8422842083BD84388506
+83FB846D842A843C855A84848477846B84AD846E848284698446842C846F8479
+843584CA846284B984BF849F84D984CD84BB84DA84D084C184C684D684A18521
+84FF84F485178518852C851F8515851484FC8540856385588548000000000000
+E5
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+85418602854B8555858085A485888591858A85A8856D8594859B85EA8587859C
+8577857E859085C985BA85CF85B985D085D585DD85E585DC85F9860A8613860B
+85FE85FA86068622861A8630863F864D4E558654865F86678671869386A386A9
+86AA868B868C86B686AF86C486C686B086C9882386AB86D486DE86E986EC0000
+86DF86DB86EF8712870687088700870386FB87118709870D86F9870A8734873F
+8737873B87258729871A8760875F8778874C874E877487578768876E87598753
+8763876A880587A2879F878287AF87CB87BD87C087D096D687AB87C487B387C7
+87C687BB87EF87F287E0880F880D87FE87F687F7880E87D28811881688158822
+88218831883688398827883B8844884288528859885E8862886B8881887E889E
+8875887D88B5887288828897889288AE889988A2888D88A488B088BF88B188C3
+88C488D488D888D988DD88F9890288FC88F488E888F28904890C890A89138943
+891E8925892A892B89418944893B89368938894C891D8960895E000000000000
+E6
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+89668964896D896A896F89748977897E89838988898A8993899889A189A989A6
+89AC89AF89B289BA89BD89BF89C089DA89DC89DD89E789F489F88A038A168A10
+8A0C8A1B8A1D8A258A368A418A5B8A528A468A488A7C8A6D8A6C8A628A858A82
+8A848AA88AA18A918AA58AA68A9A8AA38AC48ACD8AC28ADA8AEB8AF38AE70000
+8AE48AF18B148AE08AE28AF78ADE8ADB8B0C8B078B1A8AE18B168B108B178B20
+8B3397AB8B268B2B8B3E8B288B418B4C8B4F8B4E8B498B568B5B8B5A8B6B8B5F
+8B6C8B6F8B748B7D8B808B8C8B8E8B928B938B968B998B9A8C3A8C418C3F8C48
+8C4C8C4E8C508C558C628C6C8C788C7A8C828C898C858C8A8C8D8C8E8C948C7C
+8C98621D8CAD8CAA8CBD8CB28CB38CAE8CB68CC88CC18CE48CE38CDA8CFD8CFA
+8CFB8D048D058D0A8D078D0F8D0D8D109F4E8D138CCD8D148D168D678D6D8D71
+8D738D818D998DC28DBE8DBA8DCF8DDA8DD68DCC8DDB8DCB8DEA8DEB8DDF8DE3
+8DFC8E088E098DFF8E1D8E1E8E108E1F8E428E358E308E348E4A000000000000
+E7
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+8E478E498E4C8E508E488E598E648E608E2A8E638E558E768E728E7C8E818E87
+8E858E848E8B8E8A8E938E918E948E998EAA8EA18EAC8EB08EC68EB18EBE8EC5
+8EC88ECB8EDB8EE38EFC8EFB8EEB8EFE8F0A8F058F158F128F198F138F1C8F1F
+8F1B8F0C8F268F338F3B8F398F458F428F3E8F4C8F498F468F4E8F578F5C0000
+8F628F638F648F9C8F9F8FA38FAD8FAF8FB78FDA8FE58FE28FEA8FEF90878FF4
+90058FF98FFA901190159021900D901E9016900B90279036903590398FF8904F
+905090519052900E9049903E90569058905E9068906F907696A890729082907D
+90819080908A9089908F90A890AF90B190B590E290E4624890DB910291129119
+91329130914A9156915891639165916991739172918B9189918291A291AB91AF
+91AA91B591B491BA91C091C191C991CB91D091D691DF91E191DB91FC91F591F6
+921E91FF9214922C92159211925E925792459249926492489295923F924B9250
+929C92969293929B925A92CF92B992B792E9930F92FA9344932E000000000000
+E8
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+93199322931A9323933A9335933B935C9360937C936E935693B093AC93AD9394
+93B993D693D793E893E593D893C393DD93D093C893E4941A9414941394039407
+94109436942B94359421943A944194529444945B94609462945E946A92299470
+94759477947D945A947C947E9481947F95829587958A95949596959895990000
+95A095A895A795AD95BC95BB95B995BE95CA6FF695C395CD95CC95D595D495D6
+95DC95E195E595E296219628962E962F9642964C964F964B9677965C965E965D
+965F96669672966C968D96989695969796AA96A796B196B296B096B496B696B8
+96B996CE96CB96C996CD894D96DC970D96D596F99704970697089713970E9711
+970F971697199724972A97309739973D973E97449746974897429749975C9760
+97649766976852D2976B977197799785977C9781977A9786978B978F9790979C
+97A897A697A397B397B497C397C697C897CB97DC97ED9F4F97F27ADF97F697F5
+980F980C9838982498219837983D9846984F984B986B986F9870000000000000
+E9
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+98719874987398AA98AF98B198B698C498C398C698E998EB9903990999129914
+99189921991D991E99249920992C992E993D993E9942994999459950994B9951
+9952994C99559997999899A599AD99AE99BC99DF99DB99DD99D899D199ED99EE
+99F199F299FB99F89A019A0F9A0599E29A199A2B9A379A459A429A409A430000
+9A3E9A559A4D9A5B9A579A5F9A629A659A649A699A6B9A6A9AAD9AB09ABC9AC0
+9ACF9AD19AD39AD49ADE9ADF9AE29AE39AE69AEF9AEB9AEE9AF49AF19AF79AFB
+9B069B189B1A9B1F9B229B239B259B279B289B299B2A9B2E9B2F9B329B449B43
+9B4F9B4D9B4E9B519B589B749B939B839B919B969B979B9F9BA09BA89BB49BC0
+9BCA9BB99BC69BCF9BD19BD29BE39BE29BE49BD49BE19C3A9BF29BF19BF09C15
+9C149C099C139C0C9C069C089C129C0A9C049C2E9C1B9C259C249C219C309C47
+9C329C469C3E9C5A9C609C679C769C789CE79CEC9CF09D099D089CEB9D039D06
+9D2A9D269DAF9D239D1F9D449D159D129D419D3F9D3E9D469D48000000000000
+EA
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+9D5D9D5E9D649D519D509D599D729D899D879DAB9D6F9D7A9D9A9DA49DA99DB2
+9DC49DC19DBB9DB89DBA9DC69DCF9DC29DD99DD39DF89DE69DED9DEF9DFD9E1A
+9E1B9E1E9E759E799E7D9E819E889E8B9E8C9E929E959E919E9D9EA59EA99EB8
+9EAA9EAD97619ECC9ECE9ECF9ED09ED49EDC9EDE9EDD9EE09EE59EE89EEF0000
+9EF49EF69EF79EF99EFB9EFC9EFD9F079F0876B79F159F219F2C9F3E9F4A9F52
+9F549F639F5F9F609F619F669F679F6C9F6A9F779F729F769F959F9C9FA0582F
+69C79059746451DC719900000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/symbol.enc b/tcl/library/encoding/symbol.enc
new file mode 100644
index 00000000000..ffda9e3ee60
--- /dev/null
+++ b/tcl/library/encoding/symbol.enc
@@ -0,0 +1,20 @@
+# Encoding file: symbol, single-byte
+S
+003F 1 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002122000023220300250026220D002800292217002B002C2212002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+22450391039203A70394039503A603930397039903D1039A039B039C039D039F
+03A0039803A103A303A403A503C203A9039E03A80396005B2234005D22A5005F
+F8E503B103B203C703B403B503C603B303B703B903D503BA03BB03BC03BD03BF
+03C003B803C103C303C403C503D603C903BE03C803B6007B007C007D223C007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+000003D2203222642044221E0192266326662665266021942190219121922193
+00B000B12033226500D7221D2202202200F72260226122482026F8E6F8E721B5
+21352111211C21182297229522052229222A2283228722842282228622082209
+2220220700AE00A92122220F221A22C500AC2227222821D421D021D121D221D3
+22C42329F8E8F8E9F8EA2211F8EBF8ECF8EDF8EEF8EFF8F0F8F1F8F2F8F3F8F4
+F8FF232A222B2320F8F52321F8F6F8F7F8F8F8F9F8FAF8FBF8FCF8FDF8FE0000
diff --git a/tcl/library/history.tcl b/tcl/library/history.tcl
index c200f0d6039..1b4849e569f 100644
--- a/tcl/library/history.tcl
+++ b/tcl/library/history.tcl
@@ -305,7 +305,8 @@ proc history {args} {
proc tcl::HistIndex {event} {
variable history
if {[catch {expr {~$event}}]} {
- for {set i $history(nextid)} {[info exists history($i)]} {incr i -1} {
+ for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
+ {incr i -1} {
if {[string match $event* $history($i)]} {
return $i;
}
@@ -367,3 +368,4 @@ proc history {args} {
set i [HistIndex $event]
set history($i) $cmd
}
+
diff --git a/tcl/library/http1.0/http.tcl b/tcl/library/http1.0/http.tcl
index f9991509cba..17d3b76652c 100644
--- a/tcl/library/http1.0/http.tcl
+++ b/tcl/library/http1.0/http.tcl
@@ -181,7 +181,7 @@ proc http_get { url args } {
puts $s "Content-Type: application/x-www-form-urlencoded"
puts $s ""
fconfigure $s -translation {auto binary}
- puts $s $state(-query)
+ puts -nonewline $s $state(-query)
} else {
puts $s ""
}
diff --git a/tcl/library/init.tcl b/tcl/library/init.tcl
index 9cb9a1a0cb6..8a1ff67467b 100644
--- a/tcl/library/init.tcl
+++ b/tcl/library/init.tcl
@@ -7,6 +7,7 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -15,7 +16,7 @@
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
-package require -exact Tcl 8.0
+package require -exact Tcl 8.3
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -29,9 +30,12 @@ package require -exact Tcl 8.0
# The parent directory of tcl_library. Adding the parent
# means that packages in peer directories will be found automatically.
#
+# Also add the directory where the executable is located, plus ../lib
+# relative to that path.
+#
# tcl_pkgPath, which is set by the platform-specific initialization routines
# On UNIX it is compiled in
-# On Windows it comes from the registry
+# On Windows, it is not used
# On Macintosh it is "Tool Command Language" in the Extensions folder
if {![info exists auto_path]} {
@@ -41,11 +45,18 @@ if {![info exists auto_path]} {
set auto_path ""
}
}
-foreach __dir [list [info library] [file dirname [info library]]] {
- if {[lsearch -exact $auto_path $__dir] < 0} {
- lappend auto_path $__dir
+if {[string compare [info library] {}]} {
+ foreach __dir [list [info library] [file dirname [info library]]] {
+ if {[lsearch -exact $auto_path $__dir] < 0} {
+ lappend auto_path $__dir
+ }
}
}
+set __dir [file join [file dirname [file dirname \
+ [info nameofexecutable]]] lib]
+if {[lsearch -exact $auto_path $__dir] < 0} {
+ lappend auto_path $__dir
+}
if {[info exist tcl_pkgPath]} {
foreach __dir $tcl_pkgPath {
if {[lsearch -exact $auto_path $__dir] < 0} {
@@ -53,11 +64,13 @@ if {[info exist tcl_pkgPath]} {
}
}
}
-unset __dir
-
-# Windows specific initialization to handle case isses with envars
+if {[info exists __dir]} {
+ unset __dir
+}
+
+# Windows specific end of initialization
-if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
+if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
namespace eval tcl {
proc envTraceProc {lo n1 n2 op} {
set x $::env($n2)
@@ -67,7 +80,7 @@ if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
}
foreach p [array names env] {
set u [string toupper $p]
- if {$u != $p} {
+ if {[string compare $u $p]} {
switch -- $u {
COMSPEC -
PATH {
@@ -87,7 +100,7 @@ if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
unset u
}
if {![info exists env(COMSPEC)]} {
- if {$tcl_platform(os) == {Windows NT}} {
+ if {[string equal $tcl_platform(os) "Windows NT"]} {
set env(COMSPEC) cmd.exe
} else {
set env(COMSPEC) command.com
@@ -101,7 +114,7 @@ package unknown tclPkgUnknown
# Conditionalize for presence of exec.
-if {[info commands exec] == ""} {
+if {[llength [info commands exec]] == 0} {
# Some machines, such as the Macintosh, do not have exec. Also, on all
# platforms, safe interpreters do not have exec.
@@ -114,7 +127,7 @@ set errorInfo ""
# Define a log command (which can be overwitten to log errors
# differently, specially when stderr is not available)
-if {[info commands tclLog] == ""} {
+if {[llength [info commands tclLog]] == 0} {
proc tclLog {string} {
catch {puts stderr $string}
}
@@ -178,8 +191,8 @@ proc unknown args {
set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
unset unknown_pending($name);
if {$ret != 0} {
- return -code $ret -errorcode $errorCode \
- "error while autoloading \"$name\": $msg"
+ append errorInfo "\n (autoloading \"$name\")"
+ return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg
}
if {![array size unknown_pending]} {
unset unknown_pending
@@ -204,15 +217,15 @@ proc unknown args {
}
}
- if {([info level] == 1) && ([info script] == "") \
+ if {([info level] == 1) && [string equal [info script] ""] \
&& [info exists tcl_interactive] && $tcl_interactive} {
if {![info exists auto_noexec]} {
set new [auto_execok $name]
- if {$new != ""} {
+ if {[string compare {} $new]} {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set redir ""
- if {[info commands console] == ""} {
+ if {[string equal [info commands console] ""]} {
set redir ">&@stdout <@stdin"
}
return [uplevel exec $redir $new [lrange $args 1 end]]
@@ -220,7 +233,7 @@ proc unknown args {
}
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
- if {$name == "!!"} {
+ if {[string equal $name "!!"]} {
set newcmd [history event]
} elseif {[regexp {^!(.+)$} $name dummy event]} {
set newcmd [history event $event]
@@ -235,7 +248,7 @@ proc unknown args {
}
set ret [catch {set cmds [info commands $name*]} msg]
- if {[string compare $name "::"] == 0} {
+ if {[string equal $name "::"]} {
set name ""
}
if {$ret != 0} {
@@ -245,8 +258,8 @@ proc unknown args {
if {[llength $cmds] == 1} {
return [uplevel [lreplace $args 0 0 $cmds]]
}
- if {[llength $cmds] != 0} {
- if {$name == ""} {
+ if {[llength $cmds]} {
+ if {[string equal $name ""]} {
return -code error "empty command name \"\""
} else {
return -code error \
@@ -292,11 +305,17 @@ proc auto_load {cmd {namespace {}}} {
if {![auto_load_index]} {
return 0
}
-
foreach name $nameList {
if {[info exists auto_index($name)]} {
uplevel #0 $auto_index($name)
- if {[info commands $name] != ""} {
+ # There's a couple of ways to look for a command of a given
+ # name. One is to use
+ # info commands $name
+ # Unfortunately, if the name has glob-magic chars in it like *
+ # or [], it may not match. For our purposes here, a better
+ # route is to use
+ # namespace which -command $name
+ if { ![string equal [namespace which -command $name] ""] } {
return 1
}
}
@@ -316,10 +335,9 @@ proc auto_load {cmd {namespace {}}} {
proc auto_load_index {} {
global auto_index auto_oldpath auto_path errorInfo errorCode
- if {[info exists auto_oldpath]} {
- if {$auto_oldpath == $auto_path} {
- return 0
- }
+ if {[info exists auto_oldpath] && \
+ [string equal $auto_oldpath $auto_path]} {
+ return 0
}
set auto_oldpath $auto_path
@@ -337,25 +355,24 @@ proc auto_load_index {} {
} else {
set error [catch {
set id [gets $f]
- if {$id == "# Tcl autoload index file, version 2.0"} {
+ if {[string equal $id \
+ "# Tcl autoload index file, version 2.0"]} {
eval [read $f]
- } elseif {$id == \
- "# Tcl autoload index file: each line identifies a Tcl"} {
+ } elseif {[string equal $id "# Tcl autoload index file: each line identifies a Tcl"]} {
while {[gets $f line] >= 0} {
- if {([string index $line 0] == "#")
+ if {[string equal [string index $line 0] "#"] \
|| ([llength $line] != 2)} {
continue
}
set name [lindex $line 0]
set auto_index($name) \
- "source [file join $dir [lindex $line 1]]"
+ "source [file join $dir [lindex $line 1]]"
}
} else {
- error \
- "[file join $dir tclIndex] isn't a proper Tcl index file"
+ error "[file join $dir tclIndex] isn't a proper Tcl index file"
}
} msg]
- if {$f != ""} {
+ if {[string compare $f ""]} {
close $f
}
if {$error} {
@@ -367,7 +384,8 @@ proc auto_load_index {} {
}
# auto_qualify --
-# compute a fully qualified names list for use in the auto_index array.
+#
+# Compute a fully qualified names list for use in the auto_index array.
# For historical reasons, commands in the global namespace do not have leading
# :: in the index key. The list has two elements when the command name is
# relative (no leading ::) and the namespace is not the global one. Otherwise
@@ -407,26 +425,25 @@ proc auto_qualify {cmd namespace} {
# (if the current namespace is not the global one)
if {$n == 0} {
- if {[string compare $namespace ::] == 0} {
+ if {[string equal $namespace ::]} {
# ( nocolons , :: ) -> nocolons
return [list $cmd]
} else {
# ( nocolons , ::sub ) -> ::sub::nocolons nocolons
return [list ${namespace}::$cmd $cmd]
}
+ } elseif {[string equal $namespace ::]} {
+ # ( foo::bar , :: ) -> ::foo::bar
+ return [list ::$cmd]
} else {
- if {[string compare $namespace ::] == 0} {
- # ( foo::bar , :: ) -> ::foo::bar
- return [list ::$cmd]
- } else {
- # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
- return [list ${namespace}::$cmd ::$cmd]
- }
+ # ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
+ return [list ${namespace}::$cmd ::$cmd]
}
}
# auto_import --
-# invoked during "namespace import" to make see if the imported commands
+#
+# Invoked during "namespace import" to make see if the imported commands
# reside in an autoloaded library. If so, the commands are loaded so
# that they will be available for the import links. If not, then this
# procedure does nothing.
@@ -438,6 +455,12 @@ proc auto_qualify {cmd namespace} {
proc auto_import {pattern} {
global auto_index
+ # If no namespace is specified, this will be an error case
+
+ if {![string match *::* $pattern]} {
+ return
+ }
+
set ns [uplevel namespace current]
set patternList [auto_qualify $pattern $ns]
@@ -445,15 +468,14 @@ proc auto_import {pattern} {
foreach pattern $patternList {
foreach name [array names auto_index] {
- if {[string match $pattern $name] && "" == [info commands $name]} {
+ if {[string match $pattern $name] && \
+ [string equal "" [info commands $name]]} {
uplevel #0 $auto_index($name)
}
}
}
}
-if {[string compare $tcl_platform(platform) windows] == 0} {
-
# auto_execok --
#
# Returns string that indicates name of program to execute if
@@ -465,6 +487,7 @@ if {[string compare $tcl_platform(platform) windows] == 0} {
# Arguments:
# name - Name of a command.
+if {[string equal windows $tcl_platform(platform)]} {
# Windows version.
#
# Note that info executable doesn't work under Windows, so we have to
@@ -480,8 +503,14 @@ proc auto_execok name {
}
set auto_execs($name) ""
- if {[lsearch -exact {cls copy date del erase dir echo mkdir md rename
- ren rmdir rd time type ver vol} $name] != -1} {
+ set shellBuiltins [list cls copy date del erase dir echo mkdir \
+ md rename ren rmdir rd time type ver vol]
+ if {[string equal $tcl_platform(os) "Windows NT"]} {
+ # NT includes the 'start' built-in
+ lappend shellBuiltins "start"
+ }
+
+ if {[lsearch -exact $shellBuiltins $name] != -1} {
return [set auto_execs($name) [list $env(COMSPEC) /c $name]]
}
@@ -500,26 +529,22 @@ proc auto_execok name {
set windir $env(WINDIR)
}
if {[info exists windir]} {
- if {$tcl_platform(os) == "Windows NT"} {
+ if {[string equal $tcl_platform(os) "Windows NT"]} {
append path "$windir/system32;"
}
append path "$windir/system;$windir;"
}
- if {[info exists env(PATH)]} {
- # CYGNUS LOCAL: in the Cygwin environment, we convert to a
- # Windows path first.
- if {[llength [info commands ide_cygwin_path]]} {
- append path [ide_cygwin_path posix_to_win32_path_list $env(PATH)]
- } else {
- append path $env(PATH)
+ foreach var {PATH Path path} {
+ if {[info exists env($var)]} {
+ append path ";$env($var)"
}
}
foreach dir [split $path {;}] {
- if {$dir == ""} {
- set dir .
- }
+ # Skip already checked directories
+ if {[info exists checked($dir)] || [string equal {} $dir]} { continue }
+ set checked($dir) {}
foreach ext {{} .com .exe .bat} {
set file [file join $dir ${name}${ext}]
if {[file exists $file] && ![file isdirectory $file]} {
@@ -531,17 +556,6 @@ proc auto_execok name {
}
} else {
-
-# auto_execok --
-#
-# Returns string that indicates name of program to execute if
-# name corresponds to an executable in the path. Builds an associative
-# array auto_execs that caches information about previous checks,
-# for speed.
-#
-# Arguments:
-# name - Name of a command.
-
# Unix version.
#
proc auto_execok name {
@@ -558,7 +572,7 @@ proc auto_execok name {
return $auto_execs($name)
}
foreach dir [split $env(PATH) :] {
- if {$dir == ""} {
+ if {[string equal $dir ""]} {
set dir .
}
set file [file join $dir $name]
@@ -571,967 +585,4 @@ proc auto_execok name {
}
}
-# auto_reset --
-# Destroy all cached information for auto-loading and auto-execution,
-# so that the information gets recomputed the next time it's needed.
-# Also delete any procedures that are listed in the auto-load index
-# except those defined in this file.
-#
-# Arguments:
-# None.
-
-proc auto_reset {} {
- global auto_execs auto_index auto_oldpath
- foreach p [info procs] {
- if {[info exists auto_index($p)] && ![string match auto_* $p]
- && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
- tcl_findLibrary pkg_compareExtension
- tclMacPkgSearch tclPkgUnknown} $p] < 0)} {
- rename $p {}
- }
- }
- catch {unset auto_execs}
- catch {unset auto_index}
- catch {unset auto_oldpath}
-}
-
-# tcl_findLibrary
-# This is a utility for extensions that searches for a library directory
-# using a canonical searching algorithm. A side effect is to source
-# the initialization script and set a global library variable.
-# Arguments:
-# basename Prefix of the directory name, (e.g., "tk")
-# version Version number of the package, (e.g., "8.0")
-# patch Patchlevel of the package, (e.g., "8.0.3")
-# initScript Initialization script to source (e.g., tk.tcl)
-# enVarName environment variable to honor (e.g., TK_LIBRARY)
-# varName Global variable to set when done (e.g., tk_library)
-# CYGNUS LOCAL: We have funny things like gdb having different library
-# names before & after install (and neither of them is gdb
-# or gdb$version...
-# srcLibName The name of the library directory in the build tree (assumed to be
-# under the basename directory.
-# instLibName The name of the installed library directory
-# pkgName The package name (for cases like Itcl where you have
-# several subpackages under one package...
-# debug_startup Run the startup proc through debugger_eval?
-
-proc tcl_findLibrary {basename version patch initScript
- enVarName varName {srcLibName {}} {instLibName {}}
- {pkgName {}} {debug_startup 0}} {
- upvar #0 $varName the_library
- global env errorInfo
-
- set dirs {}
- set errors {}
-
- # The C application may have hardwired a path, which we honor
-
- if {[info exist the_library]} {
- lappend dirs $the_library
- } else {
-
- # Do the canonical search
-
- # 1. From an environment variable, if it exists
-
- if {[info exists env($enVarName)]} {
- lappend dirs $env($enVarName)
- }
-
- # 2. Relative to the Tcl library
- # CYGNUS LOCAL: look in several places relative to the tcl library.
-
- if {$srcLibName == ""} {
- set srcLibName library
- }
- if {$instLibName == ""} {
- set instLibName $basename$version
- }
-
- set parentDir [file dirname [info library]]
- set grandParentDir [file dirname $parentDir]
- # These two are install locations without & with exec_prefix.
- lappend dirs [file join $parentDir $instLibName]
- lappend dirs [file join $grandParentDir $instLibName]
- # The rest are in the build tree:
- # this is for most things:
- lappend dirs [file join $grandParentDir $basename $srcLibName]
- # this is if we ever put version numbers on Tcl & Tk:
- lappend dirs [file join $grandParentDir $basename$version $srcLibName]
- # This handles itcl:
- if {$pkgName != ""} {
- lappend dirs [file join $grandParentDir $pkgName $basename $srcLibName]
- lappend dirs [file join $grandParentDir $pkgName $basename$version $srcLibName]
- }
-
- # 3. Various locations relative to the executable
- #CYGNUS LOCAL - I took all this out. For Cygnus, it seems more
- # reasonable to look relative to tcl_library. This might be anywhere
- # since the source & build trees are often widely separated,
- # but once you've found tcl_library, you've found the source tree,
- # and everything else is easy...
- }
-
- foreach i $dirs {
- set the_library $i
- set file [file join $i $initScript]
-
- # source everything when in a safe interpreter because
- # we have a source command, but no file exists command
-
- if {[interp issafe] || [file exists $file]} {
- if {$debug_startup} {
-
- if {![catch {uplevel \#0 debugger_eval [list [list source $file]]} msg]} {
- return
- } else {
- append errors "$file: $msg\n$errorInfo\n"
- }
- } else {
- if {![catch {uplevel \#0 [list source $file]} msg]} {
- return
- } else {
- append errors "$file: $msg\n$errorInfo\n"
- }
- }
- }
- }
- set msg "Can't find a usable $initScript in the following directories: \n"
- append msg " $dirs\n\n"
- append msg "$errors\n\n"
- append msg "This probably means that $basename wasn't installed properly.\n"
- error $msg
-}
-
-
-# OPTIONAL SUPPORT PROCEDURES
-# In Tcl 8.1 all the code below here has been moved to other files to
-# reduce the size of init.tcl
-
-# ----------------------------------------------------------------------
-# auto_mkindex
-# ----------------------------------------------------------------------
-# The following procedures are used to generate the tclIndex file
-# from Tcl source files. They use a special safe interpreter to
-# parse Tcl source files, writing out index entries as "proc"
-# commands are encountered. This implementation won't work in a
-# safe interpreter, since a safe interpreter can't create the
-# special parser and mess with its commands. If this is a safe
-# interpreter, we simply clip these procs out.
-
-if {! [interp issafe]} {
-
- # auto_mkindex --
- # Regenerate a tclIndex file from Tcl source files. Takes as argument
- # the name of the directory in which the tclIndex file is to be placed,
- # followed by any number of glob patterns to use in that directory to
- # locate all of the relevant files.
- #
- # Arguments:
- # dir - Name of the directory in which to create an index.
- # args - Any number of additional arguments giving the
- # names of files within dir. If no additional
- # are given auto_mkindex will look for *.tcl.
-
- proc auto_mkindex {dir args} {
- global errorCode errorInfo
-
- set oldDir [pwd]
- cd $dir
- set dir [pwd]
-
- append index "# Tcl autoload index file, version 2.0\n"
- append index "# This file is generated by the \"auto_mkindex\" command\n"
- append index "# and sourced to set up indexing information for one or\n"
- append index "# more commands. Typically each line is a command that\n"
- append index "# sets an element in the auto_index array, where the\n"
- append index "# element name is the name of a command and the value is\n"
- append index "# a script that loads the command.\n\n"
- if {$args == ""} {
- set args *.tcl
- }
- foreach file [eval glob $args] {
- auto_mkindex_parser::init
- if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
- append index $msg
- } else {
- set code $errorCode
- set info $errorInfo
- cd $oldDir
- error $msg $info $code
- }
- auto_mkindex_parser::cleanup
- }
-
- set fid [open "tclIndex" w]
- puts $fid $index nonewline
- close $fid
- cd $oldDir
- }
-
- # Original version of auto_mkindex that just searches the source
- # code for "proc" at the beginning of the line.
-
- proc auto_mkindex_old {dir args} {
- global errorCode errorInfo
- set oldDir [pwd]
- cd $dir
- set dir [pwd]
- append index "# Tcl autoload index file, version 2.0\n"
- append index "# This file is generated by the \"auto_mkindex\" command\n"
- append index "# and sourced to set up indexing information for one or\n"
- append index "# more commands. Typically each line is a command that\n"
- append index "# sets an element in the auto_index array, where the\n"
- append index "# element name is the name of a command and the value is\n"
- append index "# a script that loads the command.\n\n"
- if {$args == ""} {
- set args *.tcl
- }
- foreach file [eval glob $args] {
- set f ""
- set error [catch {
- set f [open $file]
- while {[gets $f line] >= 0} {
- if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
- set procName [lindex [auto_qualify $procName "::"] 0]
- append index "set [list auto_index($procName)]"
- append index " \[list source \[file join \$dir [list $file]\]\]\n"
- }
- }
- close $f
- } msg]
- if {$error} {
- set code $errorCode
- set info $errorInfo
- catch {close $f}
- cd $oldDir
- error $msg $info $code
- }
- }
- set f ""
- set error [catch {
- set f [open tclIndex w]
- puts $f $index nonewline
- close $f
- cd $oldDir
- } msg]
- if {$error} {
- set code $errorCode
- set info $errorInfo
- catch {close $f}
- cd $oldDir
- error $msg $info $code
- }
- }
-
- # Create a safe interpreter that can be used to parse Tcl source files
- # generate a tclIndex file for autoloading. This interp contains
- # commands for things that need index entries. Each time a command
- # is executed, it writes an entry out to the index file.
-
- namespace eval auto_mkindex_parser {
- variable parser "" ;# parser used to build index
- variable index "" ;# maintains index as it is built
- variable scriptFile "" ;# name of file being processed
- variable contextStack "" ;# stack of namespace scopes
- variable imports "" ;# keeps track of all imported cmds
- variable initCommands "" ;# list of commands that create aliases
- proc init {} {
- variable parser
- variable initCommands
- if {![interp issafe]} {
- set parser [interp create -safe]
- $parser hide info
- $parser hide rename
- $parser hide proc
- $parser hide namespace
- $parser hide eval
- $parser hide puts
- $parser invokehidden namespace delete ::
- $parser invokehidden proc unknown {args} {}
-
- #
- # We'll need access to the "namespace" command within the
- # interp. Put it back, but move it out of the way.
- #
- $parser expose namespace
- $parser invokehidden rename namespace _%@namespace
- $parser expose eval
- $parser invokehidden rename eval _%@eval
-
- # Install all the registered psuedo-command implementations
-
- foreach cmd $initCommands {
- eval $cmd
- }
- }
- }
- proc cleanup {} {
- variable parser
- interp delete $parser
- unset parser
- }
- }
-
- # auto_mkindex_parser::mkindex --
- # Used by the "auto_mkindex" command to create a "tclIndex" file for
- # the given Tcl source file. Executes the commands in the file, and
- # handles things like the "proc" command by adding an entry for the
- # index file. Returns a string that represents the index file.
- #
- # Arguments:
- # file - Name of Tcl source file to be indexed.
-
- proc auto_mkindex_parser::mkindex {file} {
- variable parser
- variable index
- variable scriptFile
- variable contextStack
- variable imports
-
- set scriptFile $file
-
- set fid [open $file]
- set contents [read $fid]
- close $fid
-
- # There is one problem with sourcing files into the safe
- # interpreter: references like "$x" will fail since code is not
- # really being executed and variables do not really exist.
- # Be careful to escape all naked "$" before evaluating.
-
- regsub -all {([^\$])\$([^\$])} $contents {\1\\$\2} contents
-
- set index ""
- set contextStack ""
- set imports ""
-
- $parser eval $contents
-
- foreach name $imports {
- catch {$parser eval [list _%@namespace forget $name]}
- }
- return $index
- }
-
- # auto_mkindex_parser::hook command
- # Registers a Tcl command to evaluate when initializing the
- # slave interpreter used by the mkindex parser.
- # The command is evaluated in the master interpreter, and can
- # use the variable auto_mkindex_parser::parser to get to the slave
-
- proc auto_mkindex_parser::hook {cmd} {
- variable initCommands
-
- lappend initCommands $cmd
- }
-
- # auto_mkindex_parser::slavehook command
- # Registers a Tcl command to evaluate when initializing the
- # slave interpreter used by the mkindex parser.
- # The command is evaluated in the slave interpreter.
-
- proc auto_mkindex_parser::slavehook {cmd} {
- variable initCommands
-
- lappend initCommands "\$parser eval [list $cmd]"
- }
-
- # auto_mkindex_parser::command --
- # Registers a new command with the "auto_mkindex_parser" interpreter
- # that parses Tcl files. These commands are fake versions of things
- # like the "proc" command. When you execute them, they simply write
- # out an entry to a "tclIndex" file for auto-loading.
- #
- # This procedure allows extensions to register their own commands
- # with the auto_mkindex facility. For example, a package like
- # [incr Tcl] might register a "class" command so that class definitions
- # could be added to a "tclIndex" file for auto-loading.
- #
- # Arguments:
- # name - Name of command recognized in Tcl files.
- # arglist - Argument list for command.
- # body - Implementation of command to handle indexing.
-
- proc auto_mkindex_parser::command {name arglist body} {
- hook [list auto_mkindex_parser::commandInit $name $arglist $body]
- }
-
- # auto_mkindex_parser::commandInit --
- # This does the actual work set up by auto_mkindex_parser::command
- # This is called when the interpreter used by the parser is created.
-
- proc auto_mkindex_parser::commandInit {name arglist body} {
- variable parser
-
- set ns [namespace qualifiers $name]
- set tail [namespace tail $name]
- if {$ns == ""} {
- set fakeName "[namespace current]::_%@fake_$tail"
- } else {
- set fakeName "_%@fake_$name"
- regsub -all {::} $fakeName "_" fakeName
- set fakeName "[namespace current]::$fakeName"
- }
- proc $fakeName $arglist $body
-
- #
- # YUK! Tcl won't let us alias fully qualified command names,
- # so we can't handle names like "::itcl::class". Instead,
- # we have to build procs with the fully qualified names, and
- # have the procs point to the aliases.
- #
- if {[regexp {::} $name]} {
- set exportCmd [list _%@namespace export [namespace tail $name]]
- $parser eval [list _%@namespace eval $ns $exportCmd]
- set alias [namespace tail $fakeName]
- $parser invokehidden proc $name {args} "_%@eval $alias \$args"
- $parser alias $alias $fakeName
- } else {
- $parser alias $name $fakeName
- }
- return
- }
-
- # auto_mkindex_parser::fullname --
- # Used by commands like "proc" within the auto_mkindex parser.
- # Returns the qualified namespace name for the "name" argument.
- # If the "name" does not start with "::", elements are added from
- # the current namespace stack to produce a qualified name. Then,
- # the name is examined to see whether or not it should really be
- # qualified. If the name has more than the leading "::", it is
- # returned as a fully qualified name. Otherwise, it is returned
- # as a simple name. That way, the Tcl autoloader will recognize
- # it properly.
- #
- # Arguments:
- # name - Name that is being added to index.
-
- proc auto_mkindex_parser::fullname {name} {
- variable contextStack
-
- if {![string match ::* $name]} {
- foreach ns $contextStack {
- set name "${ns}::$name"
- if {[string match ::* $name]} {
- break
- }
- }
- }
-
- if {[namespace qualifiers $name] == ""} {
- return [namespace tail $name]
- } elseif {![string match ::* $name]} {
- return "::$name"
- }
- return $name
- }
-
- # Register all of the procedures for the auto_mkindex parser that
- # will build the "tclIndex" file.
-
- # AUTO MKINDEX: proc name arglist body
- # Adds an entry to the auto index list for the given procedure name.
-
- auto_mkindex_parser::command proc {name args} {
- variable index
- variable scriptFile
- append index "set [list auto_index([fullname $name])]"
- append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
- }
-
- # AUTO MKINDEX: namespace eval name command ?arg arg...?
- # Adds the namespace name onto the context stack and evaluates the
- # associated body of commands.
- #
- # AUTO MKINDEX: namespace import ?-force? pattern ?pattern...?
- # Performs the "import" action in the parser interpreter. This is
- # important for any commands contained in a namespace that affect
- # the index. For example, a script may say "itcl::class ...",
- # or it may import "itcl::*" and then say "class ...". This
- # procedure does the import operation, but keeps track of imported
- # patterns so we can remove the imports later.
-
- auto_mkindex_parser::command namespace {op args} {
- switch -- $op {
- eval {
- variable parser
- variable contextStack
-
- set name [lindex $args 0]
- set args [lrange $args 1 end]
-
- set contextStack [linsert $contextStack 0 $name]
- if {[llength $args] == 1} {
- $parser eval [lindex $args 0]
- } else {
- eval $parser eval $args
- }
- set contextStack [lrange $contextStack 1 end]
- }
- import {
- variable parser
- variable imports
- foreach pattern $args {
- if {$pattern != "-force"} {
- lappend imports $pattern
- }
- }
- catch {$parser eval "_%@namespace import $args"}
- }
- }
- }
-
-# Close of the if ![interp issafe] block
-}
-
-# pkg_compareExtension --
-#
-# Used internally by pkg_mkIndex to compare the extension of a file to
-# a given extension. On Windows, it uses a case-insensitive comparison.
-#
-# Arguments:
-# fileName name of a file whose extension is compared
-# ext (optional) The extension to compare against; you must
-# provide the starting dot.
-# Defaults to [info sharedlibextension]
-#
-# Results:
-# Returns 1 if the extension matches, 0 otherwise
-
-proc pkg_compareExtension { fileName {ext {}} } {
- global tcl_platform
- if {[string length $ext] == 0} {
- set ext [info sharedlibextension]
- }
- if {[string compare $tcl_platform(platform) "windows"] == 0} {
- return [expr {[string compare \
- [string tolower [file extension $fileName]] \
- [string tolower $ext]] == 0}]
- } else {
- return [expr {[string compare [file extension $fileName] $ext] == 0}]
- }
-}
-
-# pkg_mkIndex --
-# This procedure creates a package index in a given directory. The
-# package index consists of a "pkgIndex.tcl" file whose contents are
-# a Tcl script that sets up package information with "package require"
-# commands. The commands describe all of the packages defined by the
-# files given as arguments.
-#
-# Arguments:
-# -direct (optional) If this flag is present, the generated
-# code in pkgMkIndex.tcl will cause the package to be
-# loaded when "package require" is executed, rather
-# than lazily when the first reference to an exported
-# procedure in the package is made.
-# -verbose (optional) Verbose output; the name of each file that
-# was successfully rocessed is printed out. Additionally,
-# if processing of a file failed a message is printed.
-# -load pat (optional) Preload any packages whose names match
-# the pattern. Used to handle DLLs that depend on
-# other packages during their Init procedure.
-# dir - Name of the directory in which to create the index.
-# args - Any number of additional arguments, each giving
-# a glob pattern that matches the names of one or
-# more shared libraries or Tcl script files in
-# dir.
-
-proc pkg_mkIndex {args} {
- global errorCode errorInfo
- set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"};
-
- set argCount [llength $args]
- if {$argCount < 1} {
- return -code error "wrong # args: should be\n$usage"
- }
-
- set more ""
- set direct 0
- set doVerbose 0
- set loadPat ""
- for {set idx 0} {$idx < $argCount} {incr idx} {
- set flag [lindex $args $idx]
- switch -glob -- $flag {
- -- {
- # done with the flags
- incr idx
- break
- }
- -verbose {
- set doVerbose 1
- }
- -direct {
- set direct 1
- append more " -direct"
- }
- -load {
- incr idx
- set loadPat [lindex $args $idx]
- append more " -load $loadPat"
- }
- -* {
- return -code error "unknown flag $flag: should be\n$usage"
- }
- default {
- # done with the flags
- break
- }
- }
- }
-
- set dir [lindex $args $idx]
- set patternList [lrange $args [expr {$idx + 1}] end]
- if {[llength $patternList] == 0} {
- set patternList [list "*.tcl" "*[info sharedlibextension]"]
- }
-
- append index "# Tcl package index file, version 1.1\n"
- append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
- append index "# and sourced either when an application starts up or\n"
- append index "# by a \"package unknown\" script. It invokes the\n"
- append index "# \"package ifneeded\" command to set up package-related\n"
- append index "# information so that packages will be loaded automatically\n"
- append index "# in response to \"package require\" commands. When this\n"
- append index "# script is sourced, the variable \$dir must contain the\n"
- append index "# full path name of this file's directory.\n"
- set oldDir [pwd]
- cd $dir
-
- if {[catch {eval glob $patternList} fileList]} {
- global errorCode errorInfo
- cd $oldDir
- return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
- }
- foreach file $fileList {
- # For each file, figure out what commands and packages it provides.
- # To do this, create a child interpreter, load the file into the
- # interpreter, and get a list of the new commands and packages
- # that are defined.
-
- if {[string compare $file "pkgIndex.tcl"] == 0} {
- continue
- }
-
- # Changed back to the original directory before initializing the
- # slave in case TCL_LIBRARY is a relative path (e.g. in the test
- # suite).
-
- cd $oldDir
- set c [interp create]
-
- # Load into the child any packages currently loaded in the parent
- # interpreter that match the -load pattern.
-
- foreach pkg [info loaded] {
- if {! [string match $loadPat [lindex $pkg 1]]} {
- continue
- }
- if {[lindex $pkg 1] == "Tk"} {
- $c eval {set argv {-geometry +0+0}}
- }
- if {[catch {
- load [lindex $pkg 0] [lindex $pkg 1] $c
- } err]} {
- if {$doVerbose} {
- tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
- }
- } else {
- if {$doVerbose} {
- tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
- }
- }
- }
- cd $dir
-
- $c eval {
- # Stub out the package command so packages can
- # require other packages.
-
- rename package __package_orig
- proc package {what args} {
- switch -- $what {
- require { return ; # ignore transitive requires }
- default { eval __package_orig {$what} $args }
- }
- }
- proc tclPkgUnknown args {}
- package unknown tclPkgUnknown
-
- # Stub out the unknown command so package can call
- # into each other during their initialilzation.
-
- proc unknown {args} {}
-
- # Stub out the auto_import mechanism
-
- proc auto_import {args} {}
-
- # reserve the ::tcl namespace for support procs
- # and temporary variables. This might make it awkward
- # to generate a pkgIndex.tcl file for the ::tcl namespace.
-
- namespace eval ::tcl {
- variable file ;# Current file being processed
- variable direct ;# -direct flag value
- variable x ;# Loop variable
- variable debug ;# For debugging
- variable type ;# "load" or "source", for -direct
- variable namespaces ;# Existing namespaces (e.g., ::tcl)
- variable packages ;# Existing packages (e.g., Tcl)
- variable origCmds ;# Existing commands
- variable newCmds ;# Newly created commands
- variable newPkgs {} ;# Newly created packages
- }
- }
-
- $c eval [list set ::tcl::file $file]
- $c eval [list set ::tcl::direct $direct]
- if {[catch {
- $c eval {
- set ::tcl::debug "loading or sourcing"
-
- # we need to track command defined by each package even in
- # the -direct case, because they are needed internally by
- # the "partial pkgIndex.tcl" step above.
-
- proc ::tcl::GetAllNamespaces {{root ::}} {
- set list $root
- foreach ns [namespace children $root] {
- eval lappend list [::tcl::GetAllNamespaces $ns]
- }
- return $list
- }
-
- # initialize the list of existing namespaces, packages, commands
- foreach ::tcl::x [::tcl::GetAllNamespaces] {
- set ::tcl::namespaces($::tcl::x) 1
- }
- foreach ::tcl::x [package names] {
- set ::tcl::packages($::tcl::x) 1
- }
- set ::tcl::origCmds [info commands]
-
- # Try to load the file if it has the shared library
- # extension, otherwise source it. It's important not to
- # try to load files that aren't shared libraries, because
- # on some systems (like SunOS) the loader will abort the
- # whole application when it gets an error.
-
- if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {
- # The "file join ." command below is necessary.
- # Without it, if the file name has no \'s and we're
- # on UNIX, the load command will invoke the
- # LD_LIBRARY_PATH search mechanism, which could cause
- # the wrong file to be used.
-
- set ::tcl::debug loading
- load [file join . $::tcl::file]
- set ::tcl::type load
- } else {
- set ::tcl::debug sourcing
- source $::tcl::file
- set ::tcl::type source
- }
-
- # See what new namespaces appeared, and import commands
- # from them. Only exported commands go into the index.
-
- foreach ::tcl::x [::tcl::GetAllNamespaces] {
- if {! [info exists ::tcl::namespaces($::tcl::x)]} {
- namespace import ${::tcl::x}::*
- }
- }
-
- # Figure out what commands appeared
-
- foreach ::tcl::x [info commands] {
- set ::tcl::newCmds($::tcl::x) 1
- }
- foreach ::tcl::x $::tcl::origCmds {
- catch {unset ::tcl::newCmds($::tcl::x)}
- }
- foreach ::tcl::x [array names ::tcl::newCmds] {
- # reverse engineer which namespace a command comes from
-
- set ::tcl::abs [namespace origin $::tcl::x]
-
- # special case so that global names have no leading
- # ::, this is required by the unknown command
-
- set ::tcl::abs [auto_qualify $::tcl::abs ::]
-
- if {[string compare $::tcl::x $::tcl::abs] != 0} {
- # Name changed during qualification
-
- set ::tcl::newCmds($::tcl::abs) 1
- unset ::tcl::newCmds($::tcl::x)
- }
- }
-
- # Look through the packages that appeared, and if there is
- # a version provided, then record it
-
- foreach ::tcl::x [package names] {
- if {([string compare [package provide $::tcl::x] ""] != 0) \
- && ![info exists ::tcl::packages($::tcl::x)]} {
- lappend ::tcl::newPkgs \
- [list $::tcl::x [package provide $::tcl::x]]
- }
- }
- }
- } msg] == 1} {
- set what [$c eval set ::tcl::debug]
- if {$doVerbose} {
- tclLog "warning: error while $what $file: $msg"
- }
- } else {
- set type [$c eval set ::tcl::type]
- set cmds [lsort [$c eval array names ::tcl::newCmds]]
- set pkgs [$c eval set ::tcl::newPkgs]
- if {[llength $pkgs] > 1} {
- tclLog "warning: \"$file\" provides more than one package ($pkgs)"
- }
- foreach pkg $pkgs {
- # cmds is empty/not used in the direct case
- lappend files($pkg) [list $file $type $cmds]
- }
-
- if {$doVerbose} {
- tclLog "processed $file"
- }
- }
- interp delete $c
- }
-
- foreach pkg [lsort [array names files]] {
- append index "\npackage ifneeded $pkg "
- if {$direct} {
- set cmdList {}
- foreach elem $files($pkg) {
- set file [lindex $elem 0]
- set type [lindex $elem 1]
- lappend cmdList "\[list $type \[file join \$dir\
- [list $file]\]\]"
- }
- append index [join $cmdList "\\n"]
- } else {
- append index "\[list tclPkgSetup \$dir [lrange $pkg 0 0]\
- [lrange $pkg 1 1] [list $files($pkg)]\]"
- }
- }
- set f [open pkgIndex.tcl w]
- puts $f $index
- close $f
- cd $oldDir
-}
-
-# tclPkgSetup --
-# This is a utility procedure use by pkgIndex.tcl files. It is invoked
-# as part of a "package ifneeded" script. It calls "package provide"
-# to indicate that a package is available, then sets entries in the
-# auto_index array so that the package's files will be auto-loaded when
-# the commands are used.
-#
-# Arguments:
-# dir - Directory containing all the files for this package.
-# pkg - Name of the package (no version number).
-# version - Version number for the package, such as 2.1.3.
-# files - List of files that constitute the package. Each
-# element is a sub-list with three elements. The first
-# is the name of a file relative to $dir, the second is
-# "load" or "source", indicating whether the file is a
-# loadable binary or a script to source, and the third
-# is a list of commands defined by this file.
-
-proc tclPkgSetup {dir pkg version files} {
- global auto_index
-
- package provide $pkg $version
- foreach fileInfo $files {
- set f [lindex $fileInfo 0]
- set type [lindex $fileInfo 1]
- foreach cmd [lindex $fileInfo 2] {
- if {$type == "load"} {
- set auto_index($cmd) [list load [file join $dir $f] $pkg]
- } else {
- set auto_index($cmd) [list source [file join $dir $f]]
- }
- }
- }
-}
-
-# tclMacPkgSearch --
-# The procedure is used on the Macintosh to search a given directory for files
-# with a TEXT resource named "pkgIndex". If it exists it is sourced in to the
-# interpreter to setup the package database.
-
-proc tclMacPkgSearch {dir} {
- foreach x [glob -nocomplain [file join $dir *.shlb]] {
- if {[file isfile $x]} {
- set res [resource open $x]
- foreach y [resource list TEXT $res] {
- if {$y == "pkgIndex"} {source -rsrc pkgIndex}
- }
- catch {resource close $res}
- }
- }
-}
-
-# tclPkgUnknown --
-# This procedure provides the default for the "package unknown" function.
-# It is invoked when a package that's needed can't be found. It scans
-# the auto_path directories and their immediate children looking for
-# pkgIndex.tcl files and sources any such files that are found to setup
-# the package database. (On the Macintosh we also search for pkgIndex
-# TEXT resources in all files.)
-#
-# Arguments:
-# name - Name of desired package. Not used.
-# version - Version of desired package. Not used.
-# exact - Either "-exact" or omitted. Not used.
-
-proc tclPkgUnknown {name version {exact {}}} {
- global auto_path tcl_platform env
-
- if {![info exists auto_path]} {
- return
- }
- for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
- # we can't use glob in safe interps, so enclose the following
- # in a catch statement
- catch {
- foreach file [glob -nocomplain [file join [lindex $auto_path $i] \
- * pkgIndex.tcl]] {
- set dir [file dirname $file]
- if {[catch {source $file} msg]} {
- tclLog "error reading package index file $file: $msg"
- }
- }
- }
- set dir [lindex $auto_path $i]
- set file [file join $dir pkgIndex.tcl]
- # safe interps usually don't have "file readable", nor stderr channel
- if {[interp issafe] || [file readable $file]} {
- if {[catch {source $file} msg] && ![interp issafe]} {
- tclLog "error reading package index file $file: $msg"
- }
- }
- # On the Macintosh we also look in the resource fork
- # of shared libraries
- # We can't use tclMacPkgSearch in safe interps because it uses glob
- if {(![interp issafe]) && ($tcl_platform(platform) == "macintosh")} {
- set dir [lindex $auto_path $i]
- tclMacPkgSearch $dir
- foreach x [glob -nocomplain [file join $dir *]] {
- if {[file isdirectory $x]} {
- set dir $x
- tclMacPkgSearch $dir
- }
- }
- }
- }
-}
diff --git a/tcl/library/ldAout.tcl b/tcl/library/ldAout.tcl
index d73e37b95ef..2b369558f4e 100644
--- a/tcl/library/ldAout.tcl
+++ b/tcl/library/ldAout.tcl
@@ -30,211 +30,204 @@
# F33615-94-C-4400.
proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
- global env
- global argv
-
- if {$cc==""} {
- set cc $env(CC)
- }
-
- # if only two parameters are supplied there is assumed that the
- # only shlib_suffix is missing. This parameter is anyway available
- # as "info sharedlibextension" too, so there is no need to transfer
- # 3 parameters to the function tclLdAout. For compatibility, this
- # function now accepts both 2 and 3 parameters.
-
- if {$shlib_suffix==""} {
- set shlib_cflags $env(SHLIB_CFLAGS)
- } else {
- if {$shlib_cflags=="none"} {
- set shlib_cflags $shlib_suffix
+ global env
+ global argv
+
+ if {[string equal $cc ""]} {
+ set cc $env(CC)
}
- }
- # seenDotO is nonzero if a .o or .a file has been seen
+ # if only two parameters are supplied there is assumed that the
+ # only shlib_suffix is missing. This parameter is anyway available
+ # as "info sharedlibextension" too, so there is no need to transfer
+ # 3 parameters to the function tclLdAout. For compatibility, this
+ # function now accepts both 2 and 3 parameters.
- set seenDotO 0
+ if {[string equal $shlib_suffix ""]} {
+ set shlib_cflags $env(SHLIB_CFLAGS)
+ } elseif {[string equal $shlib_cflags "none"]} {
+ set shlib_cflags $shlib_suffix
+ }
- # minusO is nonzero if the last command line argument was "-o".
+ # seenDotO is nonzero if a .o or .a file has been seen
+ set seenDotO 0
- set minusO 0
+ # minusO is nonzero if the last command line argument was "-o".
+ set minusO 0
- # head has command line arguments up to but not including the first
- # .o or .a file. tail has the rest of the arguments.
+ # head has command line arguments up to but not including the first
+ # .o or .a file. tail has the rest of the arguments.
+ set head {}
+ set tail {}
- set head {}
- set tail {}
+ # nmCommand is the "nm" command that lists global symbols from the
+ # object files.
+ set nmCommand {|nm -g}
- # nmCommand is the "nm" command that lists global symbols from the
- # object files.
+ # entryProtos is the table of _Init and _SafeInit prototypes found in the
+ # module.
+ set entryProtos {}
- set nmCommand {|nm -g}
+ # entryPoints is the table of _Init and _SafeInit entries found in the
+ # module.
+ set entryPoints {}
- # entryProtos is the table of _Init and _SafeInit prototypes found in the
- # module.
+ # libraries is the list of -L and -l flags to the linker.
+ set libraries {}
+ set libdirs {}
- set entryProtos {}
+ # Process command line arguments
+ foreach a $argv {
+ if {!$minusO && [regexp {\.[ao]$} $a]} {
+ set seenDotO 1
+ lappend nmCommand $a
+ }
+ if {$minusO} {
+ set outputFile $a
+ set minusO 0
+ } elseif {![string compare $a -o]} {
+ set minusO 1
+ }
+ if {[regexp {^-[lL]} $a]} {
+ lappend libraries $a
+ if {[regexp {^-L} $a]} {
+ lappend libdirs [string range $a 2 end]
+ }
+ } elseif {$seenDotO} {
+ lappend tail $a
+ } else {
+ lappend head $a
+ }
+ }
+ lappend libdirs /lib /usr/lib
+
+ # MIPS -- If there are corresponding G0 libraries, replace the
+ # ordinary ones with the G0 ones.
+
+ set libs {}
+ foreach lib $libraries {
+ if {[regexp {^-l} $lib]} {
+ set lname [string range $lib 2 end]
+ foreach dir $libdirs {
+ if {[file exists [file join $dir lib${lname}_G0.a]]} {
+ set lname ${lname}_G0
+ break
+ }
+ }
+ lappend libs -l$lname
+ } else {
+ lappend libs $lib
+ }
+ }
+ set libraries $libs
- # entryPoints is the table of _Init and _SafeInit entries found in the
- # module.
+ # Extract the module name from the "-o" option
- set entryPoints {}
+ if {![info exists outputFile]} {
+ error "-o option must be supplied to link a Tcl load module"
+ }
+ set m [file tail $outputFile]
+ if {[regexp {\.a$} $outputFile]} {
+ set shlib_suffix .a
+ } else {
+ set shlib_suffix ""
+ }
+ if {[regexp {\..*$} $outputFile match]} {
+ set l [expr {[string length $m] - [string length $match]}]
+ } else {
+ error "Output file does not appear to have a suffix"
+ }
+ set modName [string tolower $m 0 [expr {$l-1}]]
+ if {[regexp {^lib} $modName]} {
+ set modName [string range $modName 3 end]
+ }
+ if {[regexp {[0-9\.]*(_g0)?$} $modName match]} {
+ set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]
+ }
+ set modName [string totitle $modName]
+
+ # Catalog initialization entry points found in the module
+
+ set f [open $nmCommand r]
+ while {[gets $f l] >= 0} {
+ if {[regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {
+ if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
+ set s $symbol
+ }
+ append entryProtos {extern int } $symbol { (); } \n
+ append entryPoints { } \{ { "} $s {", } $symbol { } \} , \n
+ }
+ }
+ close $f
- # libraries is the list of -L and -l flags to the linker.
+ if {[string equal $entryPoints ""]} {
+ error "No entry point found in objects"
+ }
- set libraries {}
- set libdirs {}
+ # Compose a C function that resolves the initialization entry points and
+ # embeds the required libraries in the object code.
+
+ set C {#include <string.h>}
+ append C \n
+ append C {char TclLoadLibraries_} $modName { [] =} \n
+ append C { "@LIBS: } $libraries {";} \n
+ append C $entryProtos
+ append C {static struct } \{ \n
+ append C { char * name;} \n
+ append C { int (*value)();} \n
+ append C \} {dictionary [] = } \{ \n
+ append C $entryPoints
+ append C { 0, 0 } \n \} \; \n
+ append C {typedef struct Tcl_Interp Tcl_Interp;} \n
+ append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
+ append C {Tcl_PackageInitProc *} \n
+ append C TclLoadDictionary_ $modName { (symbol)} \n
+ append C { char * symbol;} \n
+ append C {
+ {
+ int i;
+ for (i = 0; dictionary [i] . name != 0; ++i) {
+ if (!strcmp (symbol, dictionary [i] . name)) {
+ return dictionary [i].value;
+ }
+ }
+ return 0;
+ }
+ }
+ append C \n
- # Process command line arguments
- foreach a $argv {
- if {!$minusO && [regexp {\.[ao]$} $a]} {
- set seenDotO 1
- lappend nmCommand $a
- }
- if {$minusO} {
- set outputFile $a
- set minusO 0
- } elseif {![string compare $a -o]} {
- set minusO 1
- }
- if {[regexp {^-[lL]} $a]} {
- lappend libraries $a
- if {[regexp {^-L} $a]} {
- lappend libdirs [string range $a 2 end]
- }
- } elseif {$seenDotO} {
- lappend tail $a
+ # Write the C module and compile it
+
+ set cFile tcl$modName.c
+ set f [open $cFile w]
+ puts -nonewline $f $C
+ close $f
+ set ccCommand "$cc -c $shlib_cflags $cFile"
+ puts stderr $ccCommand
+ eval exec $ccCommand
+
+ # Now compose and execute the ld command that packages the module
+
+ if {[string equal $shlib_suffix ".a"]} {
+ set ldCommand "ar cr $outputFile"
+ regsub { -o} $tail {} tail
} else {
- lappend head $a
- }
- }
- lappend libdirs /lib /usr/lib
-
- # MIPS -- If there are corresponding G0 libraries, replace the
- # ordinary ones with the G0 ones.
-
- set libs {}
- foreach lib $libraries {
- if {[regexp {^-l} $lib]} {
- set lname [string range $lib 2 end]
- foreach dir $libdirs {
- if {[file exists [file join $dir lib${lname}_G0.a]]} {
- set lname ${lname}_G0
- break
- }
- }
- lappend libs -l$lname
- } else {
- lappend libs $lib
- }
- }
- set libraries $libs
-
- # Extract the module name from the "-o" option
-
- if {![info exists outputFile]} {
- error "-o option must be supplied to link a Tcl load module"
- }
- set m [file tail $outputFile]
- if {[regexp {\.a$} $outputFile]} {
- set shlib_suffix .a
- } else {
- set shlib_suffix ""
- }
- if {[regexp {\..*$} $outputFile match]} {
- set l [expr {[string length $m] - [string length $match]}]
- } else {
- error "Output file does not appear to have a suffix"
- }
- set modName [string tolower [string range $m 0 [expr {$l-1}]]]
- if {[regexp {^lib} $modName]} {
- set modName [string range $modName 3 end]
- }
- if {[regexp {[0-9\.]*(_g0)?$} $modName match]} {
- set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]
- }
- set modName "[string toupper [string index $modName 0]][string range $modName 1 end]"
-
- # Catalog initialization entry points found in the module
-
- set f [open $nmCommand r]
- while {[gets $f l] >= 0} {
- if {[regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {
- if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
- set s $symbol
- }
- append entryProtos {extern int } $symbol { (); } \n
- append entryPoints { } \{ { "} $s {", } $symbol { } \} , \n
+ set ldCommand ld
+ foreach item $head {
+ lappend ldCommand $item
+ }
}
- }
- close $f
-
- if {$entryPoints==""} {
- error "No entry point found in objects"
- }
-
- # Compose a C function that resolves the initialization entry points and
- # embeds the required libraries in the object code.
-
- set C {#include <string.h>}
- append C \n
- append C {char TclLoadLibraries_} $modName { [] =} \n
- append C { "@LIBS: } $libraries {";} \n
- append C $entryProtos
- append C {static struct } \{ \n
- append C { char * name;} \n
- append C { int (*value)();} \n
- append C \} {dictionary [] = } \{ \n
- append C $entryPoints
- append C { 0, 0 } \n \} \; \n
- append C {typedef struct Tcl_Interp Tcl_Interp;} \n
- append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
- append C {Tcl_PackageInitProc *} \n
- append C TclLoadDictionary_ $modName { (symbol)} \n
- append C { char * symbol;} \n
- append C {{
- int i;
- for (i = 0; dictionary [i] . name != 0; ++i) {
- if (!strcmp (symbol, dictionary [i] . name)) {
- return dictionary [i].value;
- }
+ lappend ldCommand tcl$modName.o
+ foreach item $tail {
+ lappend ldCommand $item
}
- return 0;
-}} \n
-
- # Write the C module and compile it
-
- set cFile tcl$modName.c
- set f [open $cFile w]
- puts -nonewline $f $C
- close $f
- set ccCommand "$cc -c $shlib_cflags $cFile"
- puts stderr $ccCommand
- eval exec $ccCommand
-
- # Now compose and execute the ld command that packages the module
-
- if {$shlib_suffix == ".a"} {
- set ldCommand "ar cr $outputFile"
- regsub { -o} $tail {} tail
- } else {
- set ldCommand ld
- foreach item $head {
- lappend ldCommand $item
+ puts stderr $ldCommand
+ eval exec $ldCommand
+ if {[string equal $shlib_suffix ".a"]} {
+ exec ranlib $outputFile
}
- }
- lappend ldCommand tcl$modName.o
- foreach item $tail {
- lappend ldCommand $item
- }
- puts stderr $ldCommand
- eval exec $ldCommand
- if {$shlib_suffix == ".a"} {
- exec ranlib $outputFile
- }
-
- # Clean up working files
-
- exec /bin/rm $cFile [file rootname $cFile].o
+
+ # Clean up working files
+ exec /bin/rm $cFile [file rootname $cFile].o
}
diff --git a/tcl/library/msgcat1.0/msgcat.tcl b/tcl/library/msgcat1.0/msgcat.tcl
new file mode 100644
index 00000000000..2bd31ec7883
--- /dev/null
+++ b/tcl/library/msgcat1.0/msgcat.tcl
@@ -0,0 +1,202 @@
+# msgcat.tcl --
+#
+# This file defines various procedures which implement a
+# message catalog facility for Tcl programs. It should be
+# loaded with the command "package require msgcat".
+#
+# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998 by Mark Harrison.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+package provide msgcat 1.1
+
+namespace eval msgcat {
+ namespace export mc mcset mclocale mcpreferences mcunknown
+
+ # Records the current locale as passed to mclocale
+ variable locale ""
+
+ # Records the list of locales to search
+ variable loclist {}
+
+ # Records the mapping between source strings and translated strings. The
+ # array key is of the form "<locale>,<namespace>,<src>" and the value is
+ # the translated string.
+ array set msgs {}
+}
+
+# msgcat::mc --
+#
+# Find the translation for the given string based on the current
+# locale setting. Check the local namespace first, then look in each
+# parent namespace until the source is found. If additional args are
+# specified, use the format command to work them into the traslated
+# string.
+#
+# Arguments:
+# src The string to translate.
+# args Args to pass to the format command
+#
+# Results:
+# Returns the translatd string. Propagates errors thrown by the
+# format command.
+
+proc msgcat::mc {src args} {
+ # Check for the src in each namespace starting from the local and
+ # ending in the global.
+
+ set ns [uplevel {namespace current}]
+
+ while {$ns != ""} {
+ foreach loc $::msgcat::loclist {
+ if {[info exists ::msgcat::msgs($loc,$ns,$src)]} {
+ if {[llength $args] == 0} {
+ return $::msgcat::msgs($loc,$ns,$src)
+ } else {
+ return [eval \
+ [list format $::msgcat::msgs($loc,$ns,$src)] \
+ $args]
+ }
+ }
+ }
+ set ns [namespace parent $ns]
+ }
+ # we have not found the translation
+ return [uplevel 1 [list [namespace origin mcunknown] \
+ $::msgcat::locale $src] $args]
+}
+
+# msgcat::mclocale --
+#
+# Query or set the current locale.
+#
+# Arguments:
+# newLocale (Optional) The new locale string. Locale strings
+# should be composed of one or more sublocale parts
+# separated by underscores (e.g. en_US).
+#
+# Results:
+# Returns the current locale.
+
+proc msgcat::mclocale {args} {
+ set len [llength $args]
+
+ if {$len > 1} {
+ error {wrong # args: should be "mclocale ?newLocale?"}
+ }
+
+ set args [string tolower $args]
+ if {$len == 1} {
+ set ::msgcat::locale $args
+ set ::msgcat::loclist {}
+ set word ""
+ foreach part [split $args _] {
+ set word [string trimleft "${word}_${part}" _]
+ set ::msgcat::loclist [linsert $::msgcat::loclist 0 $word]
+ }
+ }
+ return $::msgcat::locale
+}
+
+# msgcat::mcpreferences --
+#
+# Fetch the list of locales used to look up strings, ordered from
+# most preferred to least preferred.
+#
+# Arguments:
+# None.
+#
+# Results:
+# Returns an ordered list of the locales preferred by the user.
+
+proc msgcat::mcpreferences {} {
+ return $::msgcat::loclist
+}
+
+# msgcat::mcload --
+#
+# Attempt to load message catalogs for each locale in the
+# preference list from the specified directory.
+#
+# Arguments:
+# langdir The directory to search.
+#
+# Results:
+# Returns the number of message catalogs that were loaded.
+
+proc msgcat::mcload {langdir} {
+ set x 0
+ foreach p [::msgcat::mcpreferences] {
+ set langfile [file join $langdir $p.msg]
+ if {[file exists $langfile]} {
+ incr x
+ uplevel [list source $langfile]
+ }
+ }
+ return $x
+}
+
+# msgcat::mcset --
+#
+# Set the translation for a given string in a specified locale.
+#
+# Arguments:
+# locale The locale to use.
+# src The source string.
+# dest (Optional) The translated string. If omitted,
+# the source string is used.
+#
+# Results:
+# Returns the new locale.
+
+proc msgcat::mcset {locale src {dest ""}} {
+ if {[string equal $dest ""]} {
+ set dest $src
+ }
+
+ set ns [uplevel {namespace current}]
+
+ set ::msgcat::msgs([string tolower $locale],$ns,$src) $dest
+ return $dest
+}
+
+# msgcat::mcunknown --
+#
+# This routine is called by msgcat::mc if a translation cannot
+# be found for a string. This routine is intended to be replaced
+# by an application specific routine for error reporting
+# purposes. The default behavior is to return the source string.
+# If additional args are specified, the format command will be used
+# to work them into the traslated string.
+#
+# Arguments:
+# locale The current locale.
+# src The string to be translated.
+# args Args to pass to the format command
+#
+# Results:
+# Returns the translated value.
+
+proc msgcat::mcunknown {locale src args} {
+ if {[llength $args]} {
+ return [eval [list format $src] $args]
+ } else {
+ return $src
+ }
+}
+
+# Initialize the default locale
+
+namespace eval msgcat {
+ # set default locale, try to get from environment
+ if {[info exists ::env(LANG)]} {
+ mclocale $::env(LANG)
+ } else {
+ mclocale "C"
+ }
+}
+
diff --git a/tcl/library/msgcat1.0/pkgIndex.tcl b/tcl/library/msgcat1.0/pkgIndex.tcl
new file mode 100644
index 00000000000..7bee508d939
--- /dev/null
+++ b/tcl/library/msgcat1.0/pkgIndex.tcl
@@ -0,0 +1 @@
+package ifneeded msgcat 1.1 [list source [file join $dir msgcat.tcl]]
diff --git a/tcl/library/opt0.4/optparse.tcl b/tcl/library/opt0.4/optparse.tcl
new file mode 100644
index 00000000000..96877dcce29
--- /dev/null
+++ b/tcl/library/opt0.4/optparse.tcl
@@ -0,0 +1,1090 @@
+# optparse.tcl --
+#
+# (private) Option parsing package
+# Primarily used internally by the safe:: code.
+#
+# WARNING: This code will go away in a future release
+# of Tcl. It is NOT supported and you should not rely
+# on it. If your code does rely on this package you
+# may directly incorporate this code into your application.
+#
+# RCS: @(#) $Id$
+
+package provide opt 0.4.1
+
+namespace eval ::tcl {
+
+ # Exported APIs
+ namespace export OptKeyRegister OptKeyDelete OptKeyError OptKeyParse \
+ OptProc OptProcArgGiven OptParse \
+ Lempty Lget \
+ Lassign Lvarpop Lvarpop1 Lvarset Lvarincr \
+ SetMax SetMin
+
+
+################# Example of use / 'user documentation' ###################
+
+ proc OptCreateTestProc {} {
+
+ # Defines ::tcl::OptParseTest as a test proc with parsed arguments
+ # (can't be defined before the code below is loaded (before "OptProc"))
+
+ # Every OptProc give usage information on "procname -help".
+ # Try "tcl::OptParseTest -help" and "tcl::OptParseTest -a" and
+ # then other arguments.
+ #
+ # example of 'valid' call:
+ # ::tcl::OptParseTest save -4 -pr 23 -libsok SybTcl\
+ # -nostatics false ch1
+ OptProc OptParseTest {
+ {subcommand -choice {save print} "sub command"}
+ {arg1 3 "some number"}
+ {-aflag}
+ {-intflag 7}
+ {-weirdflag "help string"}
+ {-noStatics "Not ok to load static packages"}
+ {-nestedloading1 true "OK to load into nested slaves"}
+ {-nestedloading2 -boolean true "OK to load into nested slaves"}
+ {-libsOK -choice {Tk SybTcl}
+ "List of packages that can be loaded"}
+ {-precision -int 12 "Number of digits of precision"}
+ {-intval 7 "An integer"}
+ {-scale -float 1.0 "Scale factor"}
+ {-zoom 1.0 "Zoom factor"}
+ {-arbitrary foobar "Arbitrary string"}
+ {-random -string 12 "Random string"}
+ {-listval -list {} "List value"}
+ {-blahflag -blah abc "Funny type"}
+ {arg2 -boolean "a boolean"}
+ {arg3 -choice "ch1 ch2"}
+ {?optarg? -list {} "optional argument"}
+ } {
+ foreach v [info locals] {
+ puts stderr [format "%14s : %s" $v [set $v]]
+ }
+ }
+ }
+
+################### No User serviceable part below ! ###############
+# You should really not look any further :
+# The following is private unexported undocumented unblessed... code
+# time to hit "q" ;-) !
+
+# Hmmm... ok, you really want to know ?
+
+# You've been warned... Here it is...
+
+ # Array storing the parsed descriptions
+ variable OptDesc;
+ array set OptDesc {};
+ # Next potentially free key id (numeric)
+ variable OptDescN 0;
+
+# Inside algorithm/mechanism description:
+# (not for the faint hearted ;-)
+#
+# The argument description is parsed into a "program tree"
+# It is called a "program" because it is the program used by
+# the state machine interpreter that use that program to
+# actually parse the arguments at run time.
+#
+# The general structure of a "program" is
+# notation (pseudo bnf like)
+# name :== definition defines "name" as being "definition"
+# { x y z } means list of x, y, and z
+# x* means x repeated 0 or more time
+# x+ means "x x*"
+# x? means optionally x
+# x | y means x or y
+# "cccc" means the literal string
+#
+# program :== { programCounter programStep* }
+#
+# programStep :== program | singleStep
+#
+# programCounter :== {"P" integer+ }
+#
+# singleStep :== { instruction parameters* }
+#
+# instruction :== single element list
+#
+# (the difference between singleStep and program is that \
+# llength [lindex $program 0] >= 2
+# while
+# llength [lindex $singleStep 0] == 1
+# )
+#
+# And for this application:
+#
+# singleStep :== { instruction varname {hasBeenSet currentValue} type
+# typeArgs help }
+# instruction :== "flags" | "value"
+# type :== knowType | anyword
+# knowType :== "string" | "int" | "boolean" | "boolflag" | "float"
+# | "choice"
+#
+# for type "choice" typeArgs is a list of possible choices, the first one
+# is the default value. for all other types the typeArgs is the default value
+#
+# a "boolflag" is the type for a flag whose presence or absence, without
+# additional arguments means respectively true or false (default flag type).
+#
+# programCounter is the index in the list of the currently processed
+# programStep (thus starting at 1 (0 is {"P" prgCounterValue}).
+# If it is a list it points toward each currently selected programStep.
+# (like for "flags", as they are optional, form a set and programStep).
+
+# Performance/Implementation issues
+# ---------------------------------
+# We use tcl lists instead of arrays because with tcl8.0
+# they should start to be much faster.
+# But this code use a lot of helper procs (like Lvarset)
+# which are quite slow and would be helpfully optimized
+# for instance by being written in C. Also our struture
+# is complex and there is maybe some places where the
+# string rep might be calculated at great exense. to be checked.
+
+#
+# Parse a given description and saves it here under the given key
+# generate a unused keyid if not given
+#
+proc ::tcl::OptKeyRegister {desc {key ""}} {
+ variable OptDesc;
+ variable OptDescN;
+ if {[string compare $key ""] == 0} {
+ # in case a key given to us as a parameter was a number
+ while {[info exists OptDesc($OptDescN)]} {incr OptDescN}
+ set key $OptDescN;
+ incr OptDescN;
+ }
+ # program counter
+ set program [list [list "P" 1]];
+
+ # are we processing flags (which makes a single program step)
+ set inflags 0;
+
+ set state {};
+
+ # flag used to detect that we just have a single (flags set) subprogram.
+ set empty 1;
+
+ foreach item $desc {
+ if {$state == "args"} {
+ # more items after 'args'...
+ return -code error "'args' special argument must be the last one";
+ }
+ set res [OptNormalizeOne $item];
+ set state [lindex $res 0];
+ if {$inflags} {
+ if {$state == "flags"} {
+ # add to 'subprogram'
+ lappend flagsprg $res;
+ } else {
+ # put in the flags
+ # structure for flag programs items is a list of
+ # {subprgcounter {prg flag 1} {prg flag 2} {...}}
+ lappend program $flagsprg;
+ # put the other regular stuff
+ lappend program $res;
+ set inflags 0;
+ set empty 0;
+ }
+ } else {
+ if {$state == "flags"} {
+ set inflags 1;
+ # sub program counter + first sub program
+ set flagsprg [list [list "P" 1] $res];
+ } else {
+ lappend program $res;
+ set empty 0;
+ }
+ }
+ }
+ if {$inflags} {
+ if {$empty} {
+ # We just have the subprogram, optimize and remove
+ # unneeded level:
+ set program $flagsprg;
+ } else {
+ lappend program $flagsprg;
+ }
+ }
+
+ set OptDesc($key) $program;
+
+ return $key;
+}
+
+#
+# Free the storage for that given key
+#
+proc ::tcl::OptKeyDelete {key} {
+ variable OptDesc;
+ unset OptDesc($key);
+}
+
+ # Get the parsed description stored under the given key.
+ proc OptKeyGetDesc {descKey} {
+ variable OptDesc;
+ if {![info exists OptDesc($descKey)]} {
+ return -code error "Unknown option description key \"$descKey\"";
+ }
+ set OptDesc($descKey);
+ }
+
+# Parse entry point for ppl who don't want to register with a key,
+# for instance because the description changes dynamically.
+# (otherwise one should really use OptKeyRegister once + OptKeyParse
+# as it is way faster or simply OptProc which does it all)
+# Assign a temporary key, call OptKeyParse and then free the storage
+proc ::tcl::OptParse {desc arglist} {
+ set tempkey [OptKeyRegister $desc];
+ set ret [catch {uplevel [list ::tcl::OptKeyParse $tempkey $arglist]} res];
+ OptKeyDelete $tempkey;
+ return -code $ret $res;
+}
+
+# Helper function, replacement for proc that both
+# register the description under a key which is the name of the proc
+# (and thus unique to that code)
+# and add a first line to the code to call the OptKeyParse proc
+# Stores the list of variables that have been actually given by the user
+# (the other will be sets to their default value)
+# into local variable named "Args".
+proc ::tcl::OptProc {name desc body} {
+ set namespace [uplevel namespace current];
+ if { ([string match "::*" $name])
+ || ([string compare $namespace "::"]==0)} {
+ # absolute name or global namespace, name is the key
+ set key $name;
+ } else {
+ # we are relative to some non top level namespace:
+ set key "${namespace}::${name}";
+ }
+ OptKeyRegister $desc $key;
+ uplevel [list proc $name args "set Args \[::tcl::OptKeyParse $key \$args\]\n$body"];
+ return $key;
+}
+# Check that a argument has been given
+# assumes that "OptProc" has been used as it will check in "Args" list
+proc ::tcl::OptProcArgGiven {argname} {
+ upvar Args alist;
+ expr {[lsearch $alist $argname] >=0}
+}
+
+ #######
+ # Programs/Descriptions manipulation
+
+ # Return the instruction word/list of a given step/(sub)program
+ proc OptInstr {lst} {
+ lindex $lst 0;
+ }
+ # Is a (sub) program or a plain instruction ?
+ proc OptIsPrg {lst} {
+ expr {[llength [OptInstr $lst]]>=2}
+ }
+ # Is this instruction a program counter or a real instr
+ proc OptIsCounter {item} {
+ expr {[lindex $item 0]=="P"}
+ }
+ # Current program counter (2nd word of first word)
+ proc OptGetPrgCounter {lst} {
+ Lget $lst {0 1}
+ }
+ # Current program counter (2nd word of first word)
+ proc OptSetPrgCounter {lstName newValue} {
+ upvar $lstName lst;
+ set lst [lreplace $lst 0 0 [concat "P" $newValue]];
+ }
+ # returns a list of currently selected items.
+ proc OptSelection {lst} {
+ set res {};
+ foreach idx [lrange [lindex $lst 0] 1 end] {
+ lappend res [Lget $lst $idx];
+ }
+ return $res;
+ }
+
+ # Advance to next description
+ proc OptNextDesc {descName} {
+ uplevel [list Lvarincr $descName {0 1}];
+ }
+
+ # Get the current description, eventually descend
+ proc OptCurDesc {descriptions} {
+ lindex $descriptions [OptGetPrgCounter $descriptions];
+ }
+ # get the current description, eventually descend
+ # through sub programs as needed.
+ proc OptCurDescFinal {descriptions} {
+ set item [OptCurDesc $descriptions];
+ # Descend untill we get the actual item and not a sub program
+ while {[OptIsPrg $item]} {
+ set item [OptCurDesc $item];
+ }
+ return $item;
+ }
+ # Current final instruction adress
+ proc OptCurAddr {descriptions {start {}}} {
+ set adress [OptGetPrgCounter $descriptions];
+ lappend start $adress;
+ set item [lindex $descriptions $adress];
+ if {[OptIsPrg $item]} {
+ return [OptCurAddr $item $start];
+ } else {
+ return $start;
+ }
+ }
+ # Set the value field of the current instruction
+ proc OptCurSetValue {descriptionsName value} {
+ upvar $descriptionsName descriptions
+ # get the current item full adress
+ set adress [OptCurAddr $descriptions];
+ # use the 3th field of the item (see OptValue / OptNewInst)
+ lappend adress 2
+ Lvarset descriptions $adress [list 1 $value];
+ # ^hasBeenSet flag
+ }
+
+ # empty state means done/paste the end of the program
+ proc OptState {item} {
+ lindex $item 0
+ }
+
+ # current state
+ proc OptCurState {descriptions} {
+ OptState [OptCurDesc $descriptions];
+ }
+
+ #######
+ # Arguments manipulation
+
+ # Returns the argument that has to be processed now
+ proc OptCurrentArg {lst} {
+ lindex $lst 0;
+ }
+ # Advance to next argument
+ proc OptNextArg {argsName} {
+ uplevel [list Lvarpop1 $argsName];
+ }
+ #######
+
+
+
+
+
+ # Loop over all descriptions, calling OptDoOne which will
+ # eventually eat all the arguments.
+ proc OptDoAll {descriptionsName argumentsName} {
+ upvar $descriptionsName descriptions
+ upvar $argumentsName arguments;
+# puts "entered DoAll";
+ # Nb: the places where "state" can be set are tricky to figure
+ # because DoOne sets the state to flagsValue and return -continue
+ # when needed...
+ set state [OptCurState $descriptions];
+ # We'll exit the loop in "OptDoOne" or when state is empty.
+ while 1 {
+ set curitem [OptCurDesc $descriptions];
+ # Do subprograms if needed, call ourselves on the sub branch
+ while {[OptIsPrg $curitem]} {
+ OptDoAll curitem arguments
+# puts "done DoAll sub";
+ # Insert back the results in current tree;
+ Lvarset1nc descriptions [OptGetPrgCounter $descriptions]\
+ $curitem;
+ OptNextDesc descriptions;
+ set curitem [OptCurDesc $descriptions];
+ set state [OptCurState $descriptions];
+ }
+# puts "state = \"$state\" - arguments=($arguments)";
+ if {[Lempty $state]} {
+ # Nothing left to do, we are done in this branch:
+ break;
+ }
+ # The following statement can make us terminate/continue
+ # as it use return -code {break, continue, return and error}
+ # codes
+ OptDoOne descriptions state arguments;
+ # If we are here, no special return code where issued,
+ # we'll step to next instruction :
+# puts "new state = \"$state\"";
+ OptNextDesc descriptions;
+ set state [OptCurState $descriptions];
+ }
+ }
+
+ # Process one step for the state machine,
+ # eventually consuming the current argument.
+ proc OptDoOne {descriptionsName stateName argumentsName} {
+ upvar $argumentsName arguments;
+ upvar $descriptionsName descriptions;
+ upvar $stateName state;
+
+ # the special state/instruction "args" eats all
+ # the remaining args (if any)
+ if {($state == "args")} {
+ if {![Lempty $arguments]} {
+ # If there is no additional arguments, leave the default value
+ # in.
+ OptCurSetValue descriptions $arguments;
+ set arguments {};
+ }
+# puts "breaking out ('args' state: consuming every reminding args)"
+ return -code break;
+ }
+
+ if {[Lempty $arguments]} {
+ if {$state == "flags"} {
+ # no argument and no flags : we're done
+# puts "returning to previous (sub)prg (no more args)";
+ return -code return;
+ } elseif {$state == "optValue"} {
+ set state next; # not used, for debug only
+ # go to next state
+ return ;
+ } else {
+ return -code error [OptMissingValue $descriptions];
+ }
+ } else {
+ set arg [OptCurrentArg $arguments];
+ }
+
+ switch $state {
+ flags {
+ # A non-dash argument terminates the options, as does --
+
+ # Still a flag ?
+ if {![OptIsFlag $arg]} {
+ # don't consume the argument, return to previous prg
+ return -code return;
+ }
+ # consume the flag
+ OptNextArg arguments;
+ if {[string compare "--" $arg] == 0} {
+ # return from 'flags' state
+ return -code return;
+ }
+
+ set hits [OptHits descriptions $arg];
+ if {$hits > 1} {
+ return -code error [OptAmbigous $descriptions $arg]
+ } elseif {$hits == 0} {
+ return -code error [OptFlagUsage $descriptions $arg]
+ }
+ set item [OptCurDesc $descriptions];
+ if {[OptNeedValue $item]} {
+ # we need a value, next state is
+ set state flagValue;
+ } else {
+ OptCurSetValue descriptions 1;
+ }
+ # continue
+ return -code continue;
+ }
+ flagValue -
+ value {
+ set item [OptCurDesc $descriptions];
+ # Test the values against their required type
+ if {[catch {OptCheckType $arg\
+ [OptType $item] [OptTypeArgs $item]} val]} {
+ return -code error [OptBadValue $item $arg $val]
+ }
+ # consume the value
+ OptNextArg arguments;
+ # set the value
+ OptCurSetValue descriptions $val;
+ # go to next state
+ if {$state == "flagValue"} {
+ set state flags
+ return -code continue;
+ } else {
+ set state next; # not used, for debug only
+ return ; # will go on next step
+ }
+ }
+ optValue {
+ set item [OptCurDesc $descriptions];
+ # Test the values against their required type
+ if {![catch {OptCheckType $arg\
+ [OptType $item] [OptTypeArgs $item]} val]} {
+ # right type, so :
+ # consume the value
+ OptNextArg arguments;
+ # set the value
+ OptCurSetValue descriptions $val;
+ }
+ # go to next state
+ set state next; # not used, for debug only
+ return ; # will go on next step
+ }
+ }
+ # If we reach this point: an unknown
+ # state as been entered !
+ return -code error "Bug! unknown state in DoOne \"$state\"\
+ (prg counter [OptGetPrgCounter $descriptions]:\
+ [OptCurDesc $descriptions])";
+ }
+
+# Parse the options given the key to previously registered description
+# and arguments list
+proc ::tcl::OptKeyParse {descKey arglist} {
+
+ set desc [OptKeyGetDesc $descKey];
+
+ # make sure -help always give usage
+ if {[string compare "-help" [string tolower $arglist]] == 0} {
+ return -code error [OptError "Usage information:" $desc 1];
+ }
+
+ OptDoAll desc arglist;
+
+ if {![Lempty $arglist]} {
+ return -code error [OptTooManyArgs $desc $arglist];
+ }
+
+ # Analyse the result
+ # Walk through the tree:
+ OptTreeVars $desc "#[expr {[info level]-1}]" ;
+}
+
+ # determine string length for nice tabulated output
+ proc OptTreeVars {desc level {vnamesLst {}}} {
+ foreach item $desc {
+ if {[OptIsCounter $item]} continue;
+ if {[OptIsPrg $item]} {
+ set vnamesLst [OptTreeVars $item $level $vnamesLst];
+ } else {
+ set vname [OptVarName $item];
+ upvar $level $vname var
+ if {[OptHasBeenSet $item]} {
+# puts "adding $vname"
+ # lets use the input name for the returned list
+ # it is more usefull, for instance you can check that
+ # no flags at all was given with expr
+ # {![string match "*-*" $Args]}
+ lappend vnamesLst [OptName $item];
+ set var [OptValue $item];
+ } else {
+ set var [OptDefaultValue $item];
+ }
+ }
+ }
+ return $vnamesLst
+ }
+
+
+# Check the type of a value
+# and emit an error if arg is not of the correct type
+# otherwise returns the canonical value of that arg (ie 0/1 for booleans)
+proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
+# puts "checking '$arg' against '$type' ($typeArgs)";
+
+ # only types "any", "choice", and numbers can have leading "-"
+
+ switch -exact -- $type {
+ int {
+ if {![regexp {^(-+)?[0-9]+$} $arg]} {
+ error "not an integer"
+ }
+ return $arg;
+ }
+ float {
+ return [expr {double($arg)}]
+ }
+ script -
+ list {
+ # if llength fail : malformed list
+ if {[llength $arg]==0} {
+ if {[OptIsFlag $arg]} {
+ error "no values with leading -"
+ }
+ }
+ return $arg;
+ }
+ boolean {
+ if {![regexp -nocase {^(true|false|0|1)$} $arg]} {
+ error "non canonic boolean"
+ }
+ # convert true/false because expr/if is broken with "!,...
+ if {$arg} {
+ return 1
+ } else {
+ return 0
+ }
+ }
+ choice {
+ if {[lsearch -exact $typeArgs $arg] < 0} {
+ error "invalid choice"
+ }
+ return $arg;
+ }
+ any {
+ return $arg;
+ }
+ string -
+ default {
+ if {[OptIsFlag $arg]} {
+ error "no values with leading -"
+ }
+ return $arg
+ }
+ }
+ return neverReached;
+}
+
+ # internal utilities
+
+ # returns the number of flags matching the given arg
+ # sets the (local) prg counter to the list of matches
+ proc OptHits {descName arg} {
+ upvar $descName desc;
+ set hits 0
+ set hitems {}
+ set i 1;
+
+ set larg [string tolower $arg];
+ set len [string length $larg];
+ set last [expr {$len-1}];
+
+ foreach item [lrange $desc 1 end] {
+ set flag [OptName $item]
+ # lets try to match case insensitively
+ # (string length ought to be cheap)
+ set lflag [string tolower $flag];
+ if {$len == [string length $lflag]} {
+ if {[string compare $larg $lflag]==0} {
+ # Exact match case
+ OptSetPrgCounter desc $i;
+ return 1;
+ }
+ } else {
+ if {[string compare $larg [string range $lflag 0 $last]]==0} {
+ lappend hitems $i;
+ incr hits;
+ }
+ }
+ incr i;
+ }
+ if {$hits} {
+ OptSetPrgCounter desc $hitems;
+ }
+ return $hits
+ }
+
+ # Extract fields from the list structure:
+
+ proc OptName {item} {
+ lindex $item 1;
+ }
+ #
+ proc OptHasBeenSet {item} {
+ Lget $item {2 0};
+ }
+ #
+ proc OptValue {item} {
+ Lget $item {2 1};
+ }
+
+ proc OptIsFlag {name} {
+ string match "-*" $name;
+ }
+ proc OptIsOpt {name} {
+ string match {\?*} $name;
+ }
+ proc OptVarName {item} {
+ set name [OptName $item];
+ if {[OptIsFlag $name]} {
+ return [string range $name 1 end];
+ } elseif {[OptIsOpt $name]} {
+ return [string trim $name "?"];
+ } else {
+ return $name;
+ }
+ }
+ proc OptType {item} {
+ lindex $item 3
+ }
+ proc OptTypeArgs {item} {
+ lindex $item 4
+ }
+ proc OptHelp {item} {
+ lindex $item 5
+ }
+ proc OptNeedValue {item} {
+ string compare [OptType $item] boolflag
+ }
+ proc OptDefaultValue {item} {
+ set val [OptTypeArgs $item]
+ switch -exact -- [OptType $item] {
+ choice {return [lindex $val 0]}
+ boolean -
+ boolflag {
+ # convert back false/true to 0/1 because expr !$bool
+ # is broken..
+ if {$val} {
+ return 1
+ } else {
+ return 0
+ }
+ }
+ }
+ return $val
+ }
+
+ # Description format error helper
+ proc OptOptUsage {item {what ""}} {
+ return -code error "invalid description format$what: $item\n\
+ should be a list of {varname|-flagname ?-type? ?defaultvalue?\
+ ?helpstring?}";
+ }
+
+
+ # Generate a canonical form single instruction
+ proc OptNewInst {state varname type typeArgs help} {
+ list $state $varname [list 0 {}] $type $typeArgs $help;
+ # ^ ^
+ # | |
+ # hasBeenSet=+ +=currentValue
+ }
+
+ # Translate one item to canonical form
+ proc OptNormalizeOne {item} {
+ set lg [Lassign $item varname arg1 arg2 arg3];
+# puts "called optnormalizeone '$item' v=($varname), lg=$lg";
+ set isflag [OptIsFlag $varname];
+ set isopt [OptIsOpt $varname];
+ if {$isflag} {
+ set state "flags";
+ } elseif {$isopt} {
+ set state "optValue";
+ } elseif {[string compare $varname "args"]} {
+ set state "value";
+ } else {
+ set state "args";
+ }
+
+ # apply 'smart' 'fuzzy' logic to try to make
+ # description writer's life easy, and our's difficult :
+ # let's guess the missing arguments :-)
+
+ switch $lg {
+ 1 {
+ if {$isflag} {
+ return [OptNewInst $state $varname boolflag false ""];
+ } else {
+ return [OptNewInst $state $varname any "" ""];
+ }
+ }
+ 2 {
+ # varname default
+ # varname help
+ set type [OptGuessType $arg1]
+ if {[string compare $type "string"] == 0} {
+ if {$isflag} {
+ set type boolflag
+ set def false
+ } else {
+ set type any
+ set def ""
+ }
+ set help $arg1
+ } else {
+ set help ""
+ set def $arg1
+ }
+ return [OptNewInst $state $varname $type $def $help];
+ }
+ 3 {
+ # varname type value
+ # varname value comment
+
+ if {[regexp {^-(.+)$} $arg1 x type]} {
+ # flags/optValue as they are optional, need a "value",
+ # on the contrary, for a variable (non optional),
+ # default value is pointless, 'cept for choices :
+ if {$isflag || $isopt || ($type == "choice")} {
+ return [OptNewInst $state $varname $type $arg2 ""];
+ } else {
+ return [OptNewInst $state $varname $type "" $arg2];
+ }
+ } else {
+ return [OptNewInst $state $varname\
+ [OptGuessType $arg1] $arg1 $arg2]
+ }
+ }
+ 4 {
+ if {[regexp {^-(.+)$} $arg1 x type]} {
+ return [OptNewInst $state $varname $type $arg2 $arg3];
+ } else {
+ return -code error [OptOptUsage $item];
+ }
+ }
+ default {
+ return -code error [OptOptUsage $item];
+ }
+ }
+ }
+
+ # Auto magic lasy type determination
+ proc OptGuessType {arg} {
+ if {[regexp -nocase {^(true|false)$} $arg]} {
+ return boolean
+ }
+ if {[regexp {^(-+)?[0-9]+$} $arg]} {
+ return int
+ }
+ if {![catch {expr {double($arg)}}]} {
+ return float
+ }
+ return string
+ }
+
+ # Error messages front ends
+
+ proc OptAmbigous {desc arg} {
+ OptError "ambigous option \"$arg\", choose from:" [OptSelection $desc]
+ }
+ proc OptFlagUsage {desc arg} {
+ OptError "bad flag \"$arg\", must be one of" $desc;
+ }
+ proc OptTooManyArgs {desc arguments} {
+ OptError "too many arguments (unexpected argument(s): $arguments),\
+ usage:"\
+ $desc 1
+ }
+ proc OptParamType {item} {
+ if {[OptIsFlag $item]} {
+ return "flag";
+ } else {
+ return "parameter";
+ }
+ }
+ proc OptBadValue {item arg {err {}}} {
+# puts "bad val err = \"$err\"";
+ OptError "bad value \"$arg\" for [OptParamType $item]"\
+ [list $item]
+ }
+ proc OptMissingValue {descriptions} {
+# set item [OptCurDescFinal $descriptions];
+ set item [OptCurDesc $descriptions];
+ OptError "no value given for [OptParamType $item] \"[OptName $item]\"\
+ (use -help for full usage) :"\
+ [list $item]
+ }
+
+proc ::tcl::OptKeyError {prefix descKey {header 0}} {
+ OptError $prefix [OptKeyGetDesc $descKey] $header;
+}
+
+ # determine string length for nice tabulated output
+ proc OptLengths {desc nlName tlName dlName} {
+ upvar $nlName nl;
+ upvar $tlName tl;
+ upvar $dlName dl;
+ foreach item $desc {
+ if {[OptIsCounter $item]} continue;
+ if {[OptIsPrg $item]} {
+ OptLengths $item nl tl dl
+ } else {
+ SetMax nl [string length [OptName $item]]
+ SetMax tl [string length [OptType $item]]
+ set dv [OptTypeArgs $item];
+ if {[OptState $item] != "header"} {
+ set dv "($dv)";
+ }
+ set l [string length $dv];
+ # limit the space allocated to potentially big "choices"
+ if {([OptType $item] != "choice") || ($l<=12)} {
+ SetMax dl $l
+ } else {
+ if {![info exists dl]} {
+ set dl 0
+ }
+ }
+ }
+ }
+ }
+ # output the tree
+ proc OptTree {desc nl tl dl} {
+ set res "";
+ foreach item $desc {
+ if {[OptIsCounter $item]} continue;
+ if {[OptIsPrg $item]} {
+ append res [OptTree $item $nl $tl $dl];
+ } else {
+ set dv [OptTypeArgs $item];
+ if {[OptState $item] != "header"} {
+ set dv "($dv)";
+ }
+ append res [format "\n %-*s %-*s %-*s %s" \
+ $nl [OptName $item] $tl [OptType $item] \
+ $dl $dv [OptHelp $item]]
+ }
+ }
+ return $res;
+ }
+
+# Give nice usage string
+proc ::tcl::OptError {prefix desc {header 0}} {
+ # determine length
+ if {$header} {
+ # add faked instruction
+ set h [list [OptNewInst header Var/FlagName Type Value Help]];
+ lappend h [OptNewInst header ------------ ---- ----- ----];
+ lappend h [OptNewInst header {( -help} "" "" {gives this help )}]
+ set desc [concat $h $desc]
+ }
+ OptLengths $desc nl tl dl
+ # actually output
+ return "$prefix[OptTree $desc $nl $tl $dl]"
+}
+
+
+################ General Utility functions #######################
+
+#
+# List utility functions
+# Naming convention:
+# "Lvarxxx" take the list VARiable name as argument
+# "Lxxxx" take the list value as argument
+# (which is not costly with Tcl8 objects system
+# as it's still a reference and not a copy of the values)
+#
+
+# Is that list empty ?
+proc ::tcl::Lempty {list} {
+ expr {[llength $list]==0}
+}
+
+# Gets the value of one leaf of a lists tree
+proc ::tcl::Lget {list indexLst} {
+ if {[llength $indexLst] <= 1} {
+ return [lindex $list $indexLst];
+ }
+ Lget [lindex $list [lindex $indexLst 0]] [lrange $indexLst 1 end];
+}
+# Sets the value of one leaf of a lists tree
+# (we use the version that does not create the elements because
+# it would be even slower... needs to be written in C !)
+# (nb: there is a non trivial recursive problem with indexes 0,
+# which appear because there is no difference between a list
+# of 1 element and 1 element alone : [list "a"] == "a" while
+# it should be {a} and [listp a] should be 0 while [listp {a b}] would be 1
+# and [listp "a b"] maybe 0. listp does not exist either...)
+proc ::tcl::Lvarset {listName indexLst newValue} {
+ upvar $listName list;
+ if {[llength $indexLst] <= 1} {
+ Lvarset1nc list $indexLst $newValue;
+ } else {
+ set idx [lindex $indexLst 0];
+ set targetList [lindex $list $idx];
+ # reduce refcount on targetList (not really usefull now,
+ # could be with optimizing compiler)
+# Lvarset1 list $idx {};
+ # recursively replace in targetList
+ Lvarset targetList [lrange $indexLst 1 end] $newValue;
+ # put updated sub list back in the tree
+ Lvarset1nc list $idx $targetList;
+ }
+}
+# Set one cell to a value, eventually create all the needed elements
+# (on level-1 of lists)
+variable emptyList {}
+proc ::tcl::Lvarset1 {listName index newValue} {
+ upvar $listName list;
+ if {$index < 0} {return -code error "invalid negative index"}
+ set lg [llength $list];
+ if {$index >= $lg} {
+ variable emptyList;
+ for {set i $lg} {$i<$index} {incr i} {
+ lappend list $emptyList;
+ }
+ lappend list $newValue;
+ } else {
+ set list [lreplace $list $index $index $newValue];
+ }
+}
+# same as Lvarset1 but no bound checking / creation
+proc ::tcl::Lvarset1nc {listName index newValue} {
+ upvar $listName list;
+ set list [lreplace $list $index $index $newValue];
+}
+# Increments the value of one leaf of a lists tree
+# (which must exists)
+proc ::tcl::Lvarincr {listName indexLst {howMuch 1}} {
+ upvar $listName list;
+ if {[llength $indexLst] <= 1} {
+ Lvarincr1 list $indexLst $howMuch;
+ } else {
+ set idx [lindex $indexLst 0];
+ set targetList [lindex $list $idx];
+ # reduce refcount on targetList
+ Lvarset1nc list $idx {};
+ # recursively replace in targetList
+ Lvarincr targetList [lrange $indexLst 1 end] $howMuch;
+ # put updated sub list back in the tree
+ Lvarset1nc list $idx $targetList;
+ }
+}
+# Increments the value of one cell of a list
+proc ::tcl::Lvarincr1 {listName index {howMuch 1}} {
+ upvar $listName list;
+ set newValue [expr {[lindex $list $index]+$howMuch}];
+ set list [lreplace $list $index $index $newValue];
+ return $newValue;
+}
+# Removes the first element of a list
+# and returns the new list value
+proc ::tcl::Lvarpop1 {listName} {
+ upvar $listName list;
+ set list [lrange $list 1 end];
+}
+# Same but returns the removed element
+# (Like the tclX version)
+proc ::tcl::Lvarpop {listName} {
+ upvar $listName list;
+ set el [lindex $list 0];
+ set list [lrange $list 1 end];
+ return $el;
+}
+# Assign list elements to variables and return the length of the list
+proc ::tcl::Lassign {list args} {
+ # faster than direct blown foreach (which does not byte compile)
+ set i 0;
+ set lg [llength $list];
+ foreach vname $args {
+ if {$i>=$lg} break
+ uplevel [list set $vname [lindex $list $i]];
+ incr i;
+ }
+ return $lg;
+}
+
+# Misc utilities
+
+# Set the varname to value if value is greater than varname's current value
+# or if varname is undefined
+proc ::tcl::SetMax {varname value} {
+ upvar 1 $varname var
+ if {![info exists var] || $value > $var} {
+ set var $value
+ }
+}
+
+# Set the varname to value if value is smaller than varname's current value
+# or if varname is undefined
+proc ::tcl::SetMin {varname value} {
+ upvar 1 $varname var
+ if {![info exists var] || $value < $var} {
+ set var $value
+ }
+}
+
+
+ # everything loaded fine, lets create the test proc:
+ # OptCreateTestProc
+ # Don't need the create temp proc anymore:
+ # rename OptCreateTestProc {}
+}
+
diff --git a/tcl/library/opt0.4/pkgIndex.tcl b/tcl/library/opt0.4/pkgIndex.tcl
new file mode 100644
index 00000000000..260e5729104
--- /dev/null
+++ b/tcl/library/opt0.4/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex -direct" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded opt 0.4.1 [list source [file join $dir optparse.tcl]]
diff --git a/tcl/library/package.tcl b/tcl/library/package.tcl
new file mode 100644
index 00000000000..ab6b790b861
--- /dev/null
+++ b/tcl/library/package.tcl
@@ -0,0 +1,632 @@
+# package.tcl --
+#
+# utility procs formerly in init.tcl which can be loaded on demand
+# for package management.
+#
+# RCS: @(#) $Id$
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1998 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# Create the package namespace
+namespace eval ::pkg {
+}
+
+# pkg_compareExtension --
+#
+# Used internally by pkg_mkIndex to compare the extension of a file to
+# a given extension. On Windows, it uses a case-insensitive comparison
+# because the file system can be file insensitive.
+#
+# Arguments:
+# fileName name of a file whose extension is compared
+# ext (optional) The extension to compare against; you must
+# provide the starting dot.
+# Defaults to [info sharedlibextension]
+#
+# Results:
+# Returns 1 if the extension matches, 0 otherwise
+
+proc pkg_compareExtension { fileName {ext {}} } {
+ global tcl_platform
+ if {[string length $ext] == 0} {
+ set ext [info sharedlibextension]
+ }
+ if {[string equal $tcl_platform(platform) "windows"]} {
+ return [string equal -nocase [file extension $fileName] $ext]
+ } else {
+ return [string equal [file extension $fileName] $ext]
+ }
+}
+
+# pkg_mkIndex --
+# This procedure creates a package index in a given directory. The
+# package index consists of a "pkgIndex.tcl" file whose contents are
+# a Tcl script that sets up package information with "package require"
+# commands. The commands describe all of the packages defined by the
+# files given as arguments.
+#
+# Arguments:
+# -direct (optional) If this flag is present, the generated
+# code in pkgMkIndex.tcl will cause the package to be
+# loaded when "package require" is executed, rather
+# than lazily when the first reference to an exported
+# procedure in the package is made.
+# -verbose (optional) Verbose output; the name of each file that
+# was successfully rocessed is printed out. Additionally,
+# if processing of a file failed a message is printed.
+# -load pat (optional) Preload any packages whose names match
+# the pattern. Used to handle DLLs that depend on
+# other packages during their Init procedure.
+# dir - Name of the directory in which to create the index.
+# args - Any number of additional arguments, each giving
+# a glob pattern that matches the names of one or
+# more shared libraries or Tcl script files in
+# dir.
+
+proc pkg_mkIndex {args} {
+ global errorCode errorInfo
+ set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"};
+
+ set argCount [llength $args]
+ if {$argCount < 1} {
+ return -code error "wrong # args: should be\n$usage"
+ }
+
+ set more ""
+ set direct 1
+ set doVerbose 0
+ set loadPat ""
+ for {set idx 0} {$idx < $argCount} {incr idx} {
+ set flag [lindex $args $idx]
+ switch -glob -- $flag {
+ -- {
+ # done with the flags
+ incr idx
+ break
+ }
+ -verbose {
+ set doVerbose 1
+ }
+ -lazy {
+ set direct 0
+ append more " -lazy"
+ }
+ -direct {
+ append more " -direct"
+ }
+ -load {
+ incr idx
+ set loadPat [lindex $args $idx]
+ append more " -load $loadPat"
+ }
+ -* {
+ return -code error "unknown flag $flag: should be\n$usage"
+ }
+ default {
+ # done with the flags
+ break
+ }
+ }
+ }
+
+ set dir [lindex $args $idx]
+ set patternList [lrange $args [expr {$idx + 1}] end]
+ if {[llength $patternList] == 0} {
+ set patternList [list "*.tcl" "*[info sharedlibextension]"]
+ }
+
+ set oldDir [pwd]
+ cd $dir
+
+ if {[catch {eval glob $patternList} fileList]} {
+ global errorCode errorInfo
+ cd $oldDir
+ return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
+ }
+ foreach file $fileList {
+ # For each file, figure out what commands and packages it provides.
+ # To do this, create a child interpreter, load the file into the
+ # interpreter, and get a list of the new commands and packages
+ # that are defined.
+
+ if {[string equal $file "pkgIndex.tcl"]} {
+ continue
+ }
+
+ # Changed back to the original directory before initializing the
+ # slave in case TCL_LIBRARY is a relative path (e.g. in the test
+ # suite).
+
+ cd $oldDir
+ set c [interp create]
+
+ # Load into the child any packages currently loaded in the parent
+ # interpreter that match the -load pattern.
+
+ foreach pkg [info loaded] {
+ if {! [string match $loadPat [lindex $pkg 1]]} {
+ continue
+ }
+ if {[catch {
+ load [lindex $pkg 0] [lindex $pkg 1] $c
+ } err]} {
+ if {$doVerbose} {
+ tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
+ }
+ } elseif {$doVerbose} {
+ tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
+ }
+ if {[string equal [lindex $pkg 1] "Tk"]} {
+ # Withdraw . if Tk was loaded, to avoid showing a window.
+ $c eval [list wm withdraw .]
+ }
+ }
+ cd $dir
+
+ $c eval {
+ # Stub out the package command so packages can
+ # require other packages.
+
+ rename package __package_orig
+ proc package {what args} {
+ switch -- $what {
+ require { return ; # ignore transitive requires }
+ default { eval __package_orig {$what} $args }
+ }
+ }
+ proc tclPkgUnknown args {}
+ package unknown tclPkgUnknown
+
+ # Stub out the unknown command so package can call
+ # into each other during their initialilzation.
+
+ proc unknown {args} {}
+
+ # Stub out the auto_import mechanism
+
+ proc auto_import {args} {}
+
+ # reserve the ::tcl namespace for support procs
+ # and temporary variables. This might make it awkward
+ # to generate a pkgIndex.tcl file for the ::tcl namespace.
+
+ namespace eval ::tcl {
+ variable file ;# Current file being processed
+ variable direct ;# -direct flag value
+ variable x ;# Loop variable
+ variable debug ;# For debugging
+ variable type ;# "load" or "source", for -direct
+ variable namespaces ;# Existing namespaces (e.g., ::tcl)
+ variable packages ;# Existing packages (e.g., Tcl)
+ variable origCmds ;# Existing commands
+ variable newCmds ;# Newly created commands
+ variable newPkgs {} ;# Newly created packages
+ }
+ }
+
+ $c eval [list set ::tcl::file $file]
+ $c eval [list set ::tcl::direct $direct]
+
+ # Download needed procedures into the slave because we've
+ # just deleted the unknown procedure. This doesn't handle
+ # procedures with default arguments.
+
+ foreach p {pkg_compareExtension} {
+ $c eval [list proc $p [info args $p] [info body $p]]
+ }
+
+ if {[catch {
+ $c eval {
+ set ::tcl::debug "loading or sourcing"
+
+ # we need to track command defined by each package even in
+ # the -direct case, because they are needed internally by
+ # the "partial pkgIndex.tcl" step above.
+
+ proc ::tcl::GetAllNamespaces {{root ::}} {
+ set list $root
+ foreach ns [namespace children $root] {
+ eval lappend list [::tcl::GetAllNamespaces $ns]
+ }
+ return $list
+ }
+
+ # init the list of existing namespaces, packages, commands
+
+ foreach ::tcl::x [::tcl::GetAllNamespaces] {
+ set ::tcl::namespaces($::tcl::x) 1
+ }
+ foreach ::tcl::x [package names] {
+ set ::tcl::packages($::tcl::x) 1
+ }
+ set ::tcl::origCmds [info commands]
+
+ # Try to load the file if it has the shared library
+ # extension, otherwise source it. It's important not to
+ # try to load files that aren't shared libraries, because
+ # on some systems (like SunOS) the loader will abort the
+ # whole application when it gets an error.
+
+ if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {
+ # The "file join ." command below is necessary.
+ # Without it, if the file name has no \'s and we're
+ # on UNIX, the load command will invoke the
+ # LD_LIBRARY_PATH search mechanism, which could cause
+ # the wrong file to be used.
+
+ set ::tcl::debug loading
+ load [file join . $::tcl::file]
+ set ::tcl::type load
+ } else {
+ set ::tcl::debug sourcing
+ source $::tcl::file
+ set ::tcl::type source
+ }
+
+ # As a performance optimization, if we are creating
+ # direct load packages, don't bother figuring out the
+ # set of commands created by the new packages. We
+ # only need that list for setting up the autoloading
+ # used in the non-direct case.
+ if { !$::tcl::direct } {
+ # See what new namespaces appeared, and import commands
+ # from them. Only exported commands go into the index.
+
+ foreach ::tcl::x [::tcl::GetAllNamespaces] {
+ if {! [info exists ::tcl::namespaces($::tcl::x)]} {
+ namespace import -force ${::tcl::x}::*
+ }
+
+ # Figure out what commands appeared
+
+ foreach ::tcl::x [info commands] {
+ set ::tcl::newCmds($::tcl::x) 1
+ }
+ foreach ::tcl::x $::tcl::origCmds {
+ catch {unset ::tcl::newCmds($::tcl::x)}
+ }
+ foreach ::tcl::x [array names ::tcl::newCmds] {
+ # determine which namespace a command comes from
+
+ set ::tcl::abs [namespace origin $::tcl::x]
+
+ # special case so that global names have no leading
+ # ::, this is required by the unknown command
+
+ set ::tcl::abs \
+ [lindex [auto_qualify $::tcl::abs ::] 0]
+
+ if {[string compare $::tcl::x $::tcl::abs]} {
+ # Name changed during qualification
+
+ set ::tcl::newCmds($::tcl::abs) 1
+ unset ::tcl::newCmds($::tcl::x)
+ }
+ }
+ }
+ }
+
+ # Look through the packages that appeared, and if there is
+ # a version provided, then record it
+
+ foreach ::tcl::x [package names] {
+ if {[string compare [package provide $::tcl::x] ""] \
+ && ![info exists ::tcl::packages($::tcl::x)]} {
+ lappend ::tcl::newPkgs \
+ [list $::tcl::x [package provide $::tcl::x]]
+ }
+ }
+ }
+ } msg] == 1} {
+ set what [$c eval set ::tcl::debug]
+ if {$doVerbose} {
+ tclLog "warning: error while $what $file: $msg"
+ }
+ } else {
+ set type [$c eval set ::tcl::type]
+ set cmds [lsort [$c eval array names ::tcl::newCmds]]
+ set pkgs [$c eval set ::tcl::newPkgs]
+ if {[llength $pkgs] > 1} {
+ tclLog "warning: \"$file\" provides more than one package ($pkgs)"
+ }
+ foreach pkg $pkgs {
+ # cmds is empty/not used in the direct case
+ lappend files($pkg) [list $file $type $cmds]
+ }
+
+ if {$doVerbose} {
+ tclLog "processed $file"
+ }
+ interp delete $c
+ }
+ }
+
+ append index "# Tcl package index file, version 1.1\n"
+ append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
+ append index "# and sourced either when an application starts up or\n"
+ append index "# by a \"package unknown\" script. It invokes the\n"
+ append index "# \"package ifneeded\" command to set up package-related\n"
+ append index "# information so that packages will be loaded automatically\n"
+ append index "# in response to \"package require\" commands. When this\n"
+ append index "# script is sourced, the variable \$dir must contain the\n"
+ append index "# full path name of this file's directory.\n"
+
+ foreach pkg [lsort [array names files]] {
+ set cmd {}
+ foreach {name version} $pkg {
+ break
+ }
+ lappend cmd ::pkg::create -name $name -version $version
+ foreach spec $files($pkg) {
+ foreach {file type procs} $spec {
+ if { $direct } {
+ set procs {}
+ }
+ lappend cmd "-$type" [list $file $procs]
+ }
+ }
+ append index "\n[eval $cmd]"
+ }
+
+ set f [open pkgIndex.tcl w]
+ puts $f $index
+ close $f
+ cd $oldDir
+}
+
+# tclPkgSetup --
+# This is a utility procedure use by pkgIndex.tcl files. It is invoked
+# as part of a "package ifneeded" script. It calls "package provide"
+# to indicate that a package is available, then sets entries in the
+# auto_index array so that the package's files will be auto-loaded when
+# the commands are used.
+#
+# Arguments:
+# dir - Directory containing all the files for this package.
+# pkg - Name of the package (no version number).
+# version - Version number for the package, such as 2.1.3.
+# files - List of files that constitute the package. Each
+# element is a sub-list with three elements. The first
+# is the name of a file relative to $dir, the second is
+# "load" or "source", indicating whether the file is a
+# loadable binary or a script to source, and the third
+# is a list of commands defined by this file.
+
+proc tclPkgSetup {dir pkg version files} {
+ global auto_index
+
+ package provide $pkg $version
+ foreach fileInfo $files {
+ set f [lindex $fileInfo 0]
+ set type [lindex $fileInfo 1]
+ foreach cmd [lindex $fileInfo 2] {
+ if {[string equal $type "load"]} {
+ set auto_index($cmd) [list load [file join $dir $f] $pkg]
+ } else {
+ set auto_index($cmd) [list source [file join $dir $f]]
+ }
+ }
+ }
+}
+
+# tclMacPkgSearch --
+# The procedure is used on the Macintosh to search a given directory for files
+# with a TEXT resource named "pkgIndex". If it exists it is sourced in to the
+# interpreter to setup the package database.
+
+proc tclMacPkgSearch {dir} {
+ foreach x [glob -nocomplain [file join $dir *.shlb]] {
+ if {[file isfile $x]} {
+ set res [resource open $x]
+ foreach y [resource list TEXT $res] {
+ if {[string equal $y "pkgIndex"]} {source -rsrc pkgIndex}
+ }
+ catch {resource close $res}
+ }
+ }
+}
+
+# tclPkgUnknown --
+# This procedure provides the default for the "package unknown" function.
+# It is invoked when a package that's needed can't be found. It scans
+# the auto_path directories and their immediate children looking for
+# pkgIndex.tcl files and sources any such files that are found to setup
+# the package database. (On the Macintosh we also search for pkgIndex
+# TEXT resources in all files.) As it searches, it will recognize changes
+# to the auto_path and scan any new directories.
+#
+# Arguments:
+# name - Name of desired package. Not used.
+# version - Version of desired package. Not used.
+# exact - Either "-exact" or omitted. Not used.
+
+proc tclPkgUnknown {name version {exact {}}} {
+ global auto_path tcl_platform env
+
+ if {![info exists auto_path]} {
+ return
+ }
+ # Cache the auto_path, because it may change while we run through
+ # the first set of pkgIndex.tcl files
+ set old_path [set use_path $auto_path]
+ while {[llength $use_path]} {
+ set dir [lindex $use_path end]
+ # we can't use glob in safe interps, so enclose the following
+ # in a catch statement, where we get the pkgIndex files out
+ # of the subdirectories
+ catch {
+ foreach file [glob -nocomplain [file join $dir * pkgIndex.tcl]] {
+ set dir [file dirname $file]
+ if {[file readable $file] && ![info exists procdDirs($dir)]} {
+ if {[catch {source $file} msg]} {
+ tclLog "error reading package index file $file: $msg"
+ } else {
+ set procdDirs($dir) 1
+ }
+ }
+ }
+ }
+ set dir [lindex $use_path end]
+ set file [file join $dir pkgIndex.tcl]
+ # safe interps usually don't have "file readable", nor stderr channel
+ if {([interp issafe] || [file readable $file]) && \
+ ![info exists procdDirs($dir)]} {
+ if {[catch {source $file} msg] && ![interp issafe]} {
+ tclLog "error reading package index file $file: $msg"
+ } else {
+ set procdDirs($dir) 1
+ }
+ }
+ # On the Macintosh we also look in the resource fork
+ # of shared libraries
+ # We can't use tclMacPkgSearch in safe interps because it uses glob
+ if {(![interp issafe]) && \
+ [string equal $tcl_platform(platform) "macintosh"]} {
+ set dir [lindex $use_path end]
+ if {![info exists procdDirs($dir)]} {
+ tclMacPkgSearch $dir
+ set procdDirs($dir) 1
+ }
+ foreach x [glob -nocomplain [file join $dir *]] {
+ if {[file isdirectory $x] && ![info exists procdDirs($x)]} {
+ set dir $x
+ tclMacPkgSearch $dir
+ set procdDirs($dir) 1
+ }
+ }
+ }
+ set use_path [lrange $use_path 0 end-1]
+ if {[string compare $old_path $auto_path]} {
+ foreach dir $auto_path {
+ lappend use_path $dir
+ }
+ set old_path $auto_path
+ }
+ }
+}
+
+# ::pkg::create --
+#
+# Given a package specification generate a "package ifneeded" statement
+# for the package, suitable for inclusion in a pkgIndex.tcl file.
+#
+# Arguments:
+# args arguments used by the create function:
+# -name packageName
+# -version packageVersion
+# -load {filename ?{procs}?}
+# ...
+# -source {filename ?{procs}?}
+# ...
+#
+# Any number of -load and -source parameters may be
+# specified, so long as there is at least one -load or
+# -source parameter. If the procs component of a
+# module specifier is left off, that module will be
+# set up for direct loading; otherwise, it will be
+# set up for lazy loading. If both -source and -load
+# are specified, the -load'ed files will be loaded
+# first, followed by the -source'd files.
+#
+# Results:
+# An appropriate "package ifneeded" statement for the package.
+
+proc ::pkg::create {args} {
+ append err(usage) "[lindex [info level 0] 0] "
+ append err(usage) "-name packageName -version packageVersion"
+ append err(usage) "?-load {filename ?{procs}?}? ... "
+ append err(usage) "?-source {filename ?{procs}?}? ..."
+
+ set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
+ set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
+ set err(unknownOpt) "unknown option \"%s\": should be \"$err(usage)\""
+ set err(noLoadOrSource) "at least one of -load and -source must be given"
+
+ # process arguments
+ set len [llength $args]
+ if { $len < 6 } {
+ error $err(wrongNumArgs)
+ }
+
+ # Initialize parameters
+ set opts(-name) {}
+ set opts(-version) {}
+ set opts(-source) {}
+ set opts(-load) {}
+
+ # process parameters
+ for {set i 0} {$i < $len} {incr i} {
+ set flag [lindex $args $i]
+ incr i
+ switch -glob -- $flag {
+ "-name" -
+ "-version" {
+ if { $i >= $len } {
+ error [format $err(valueMissing) $flag]
+ }
+ set opts($flag) [lindex $args $i]
+ }
+ "-source" -
+ "-load" {
+ if { $i >= $len } {
+ error [format $err(valueMissing) $flag]
+ }
+ lappend opts($flag) [lindex $args $i]
+ }
+ default {
+ error [format $err(unknownOpt) [lindex $args $i]]
+ }
+ }
+ }
+
+ # Validate the parameters
+ if { [llength $opts(-name)] == 0 } {
+ error [format $err(valueMissing) "-name"]
+ }
+ if { [llength $opts(-version)] == 0 } {
+ error [format $err(valueMissing) "-version"]
+ }
+
+ if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {
+ error $err(noLoadOrSource)
+ }
+
+ # OK, now everything is good. Generate the package ifneeded statment.
+ set cmdline "package ifneeded $opts(-name) $opts(-version) "
+
+ set cmdList {}
+ set lazyFileList {}
+
+ # Handle -load and -source specs
+ foreach key {load source} {
+ foreach filespec $opts(-$key) {
+ foreach {filename proclist} {{} {}} {
+ break
+ }
+ foreach {filename proclist} $filespec {
+ break
+ }
+
+ if { [llength $proclist] == 0 } {
+ set cmd "\[list $key \[file join \$dir [list $filename]\]\]"
+ lappend cmdList $cmd
+ } else {
+ lappend lazyFileList [list $filename $key $proclist]
+ }
+ }
+ }
+
+ if { [llength $lazyFileList] > 0 } {
+ lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\
+ $opts(-version) [list $lazyFileList]\]"
+ }
+ append cmdline [join $cmdList "\\n"]
+ return $cmdline
+}
+
+
diff --git a/tcl/library/reg1.0/pkgIndex.tcl b/tcl/library/reg1.0/pkgIndex.tcl
new file mode 100755
index 00000000000..d3e39ddff48
--- /dev/null
+++ b/tcl/library/reg1.0/pkgIndex.tcl
@@ -0,0 +1,7 @@
+if {[info exists tcl_platform(debug)]} {
+ package ifneeded registry 1.0 \
+ [list load [file join $dir tclreg83d.dll] registry]
+} else {
+ package ifneeded registry 1.0 \
+ [list load [file join $dir tclreg83.dll] registry]
+}
diff --git a/tcl/library/safe.tcl b/tcl/library/safe.tcl
index c16c49c5435..386ead114c3 100644
--- a/tcl/library/safe.tcl
+++ b/tcl/library/safe.tcl
@@ -22,15 +22,14 @@
#
# Needed utilities package
-package require opt 0.2;
+package require opt 0.4.1;
# Create the safe namespace
namespace eval ::safe {
# Exported API:
namespace export interpCreate interpInit interpConfigure interpDelete \
- interpAddToAccessPath interpFindInAccessPath \
- setLogCmd ;
+ interpAddToAccessPath interpFindInAccessPath setLogCmd
####
#
@@ -51,20 +50,20 @@ namespace eval ::safe {
# create case (slave is optional)
::tcl::OptKeyRegister {
{?slave? -name {} "name of the slave (optional)"}
- } ::safe::interpCreate ;
+ } ::safe::interpCreate
# adding the flags sub programs to the command program
# (relying on Opt's internal implementation details)
- lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp);
+ lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)
# init and configure (slave is needed)
::tcl::OptKeyRegister {
{slave -name {} "name of the slave"}
- } ::safe::interpIC;
+ } ::safe::interpIC
# adding the flags sub programs to the command program
# (relying on Opt's internal implementation details)
- lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp);
+ lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp)
# temp not needed anymore
- ::tcl::OptKeyDelete $temp;
+ ::tcl::OptKeyDelete $temp
# Helper function to resolve the dual way of specifying staticsok
@@ -77,10 +76,10 @@ namespace eval ::safe {
if {$flag && ($noStatics == $statics)
&& ([::tcl::OptProcArgGiven -statics])} {
return -code error\
- "conflicting values given for -statics and -noStatics";
+ "conflicting values given for -statics and -noStatics"
}
if {$flag} {
- return [expr {!$noStatics}];
+ return [expr {!$noStatics}]
} else {
return $statics
}
@@ -98,7 +97,7 @@ namespace eval ::safe {
if {$flag && ($nestedLoadOk != $nested)
&& ([::tcl::OptProcArgGiven -nested])} {
return -code error\
- "conflicting values given for -nested and -nestedLoadOk";
+ "conflicting values given for -nested and -nestedLoadOk"
}
if {$flag} {
# another difference with "InterpStatics"
@@ -119,14 +118,13 @@ namespace eval ::safe {
proc interpCreate {args} {
set Args [::tcl::OptKeyParse ::safe::interpCreate $args]
InterpCreate $slave $accessPath \
- [InterpStatics] [InterpNested] $deleteHook;
+ [InterpStatics] [InterpNested] $deleteHook
}
proc interpInit {args} {
set Args [::tcl::OptKeyParse ::safe::interpIC $args]
if {![::interp exists $slave]} {
- return -code error \
- "\"$slave\" is not an interpreter";
+ return -code error "\"$slave\" is not an interpreter"
}
InterpInit $slave $accessPath \
[InterpStatics] [InterpNested] $deleteHook;
@@ -135,7 +133,7 @@ namespace eval ::safe {
proc CheckInterp {slave} {
if {![IsInterp $slave]} {
return -code error \
- "\"$slave\" is not an interpreter managed by ::safe::" ;
+ "\"$slave\" is not an interpreter managed by ::safe::"
}
}
@@ -160,8 +158,8 @@ namespace eval ::safe {
# We still call OptKeyParse though we know that "slave"
# is our given argument because it also checks
# for the "-help" option.
- set Args [::tcl::OptKeyParse ::safe::interpIC $args];
- CheckInterp $slave;
+ set Args [::tcl::OptKeyParse ::safe::interpIC $args]
+ CheckInterp $slave
set res {}
lappend res [list -accessPath [Set [PathListName $slave]]]
lappend res [list -statics [Set [StaticsOkName $slave]]]
@@ -172,19 +170,19 @@ namespace eval ::safe {
2 {
# If we have exactly 2 arguments
# the semantic is a "configure get"
- ::tcl::Lassign $args slave arg;
+ ::tcl::Lassign $args slave arg
# get the flag sub program (we 'know' about Opt's internal
# representation of data)
set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]
- set hits [::tcl::OptHits desc $arg];
+ set hits [::tcl::OptHits desc $arg]
if {$hits > 1} {
return -code error [::tcl::OptAmbigous $desc $arg]
} elseif {$hits == 0} {
return -code error [::tcl::OptFlagUsage $desc $arg]
}
- CheckInterp $slave;
- set item [::tcl::OptCurDesc $desc];
- set name [::tcl::OptName $item];
+ CheckInterp $slave
+ set item [::tcl::OptCurDesc $desc]
+ set name [::tcl::OptName $item]
switch -exact -- $name {
-accessPath {
return [list -accessPath [Set [PathListName $slave]]]
@@ -206,23 +204,23 @@ namespace eval ::safe {
# unambigous -statics ?value? instead:
return -code error\
"ambigous query (get or set -noStatics ?)\
- use -statics instead";
+ use -statics instead"
}
-nestedLoadOk {
return -code error\
"ambigous query (get or set -nestedLoadOk ?)\
- use -nested instead";
+ use -nested instead"
}
default {
- return -code error "unknown flag $name (bug)";
+ return -code error "unknown flag $name (bug)"
}
}
}
default {
# Otherwise we want to parse the arguments like init and create
# did
- set Args [::tcl::OptKeyParse ::safe::interpIC $args];
- CheckInterp $slave;
+ set Args [::tcl::OptKeyParse ::safe::interpIC $args]
+ CheckInterp $slave
# Get the current (and not the default) values of
# whatever has not been given:
if {![::tcl::OptProcArgGiven -accessPath]} {
@@ -231,14 +229,14 @@ namespace eval ::safe {
} else {
set doreset 0
}
- if { (![::tcl::OptProcArgGiven -statics])
- && (![::tcl::OptProcArgGiven -noStatics]) } {
+ if {(![::tcl::OptProcArgGiven -statics]) \
+ && (![::tcl::OptProcArgGiven -noStatics]) } {
set statics [Set [StaticsOkName $slave]]
} else {
set statics [InterpStatics]
}
- if { ([::tcl::OptProcArgGiven -nested])
- || ([::tcl::OptProcArgGiven -nestedLoadOk]) } {
+ if {([::tcl::OptProcArgGiven -nested]) \
+ || ([::tcl::OptProcArgGiven -nestedLoadOk]) } {
set nested [InterpNested]
} else {
set nested [Set [NestedOkName $slave]]
@@ -247,14 +245,13 @@ namespace eval ::safe {
set deleteHook [Set [DeleteHookName $slave]]
}
# we can now reconfigure :
- InterpSetConfig $slave $accessPath \
- $statics $nested $deleteHook;
+ InterpSetConfig $slave $accessPath $statics $nested $deleteHook
# auto_reset the slave (to completly synch the new access_path)
if {$doreset} {
if {[catch {::interp eval $slave {auto_reset}} msg]} {
- Log $slave "auto_reset failed: $msg";
+ Log $slave "auto_reset failed: $msg"
} else {
- Log $slave "successful auto_reset" NOTICE;
+ Log $slave "successful auto_reset" NOTICE
}
}
}
@@ -298,15 +295,15 @@ namespace eval ::safe {
} {
# Create the slave.
if {[string compare "" $slave]} {
- ::interp create -safe $slave;
+ ::interp create -safe $slave
} else {
# empty argument: generate slave name
- set slave [::interp create -safe];
+ set slave [::interp create -safe]
}
- Log $slave "Created" NOTICE;
+ Log $slave "Created" NOTICE
# Initialize it. (returns slave name)
- InterpInit $slave $access_path $staticsok $nestedok $deletehook;
+ InterpInit $slave $access_path $staticsok $nestedok $deletehook
}
@@ -323,60 +320,60 @@ namespace eval ::safe {
nestedok deletehook} {
# determine and store the access path if empty
- if {[string match "" $access_path]} {
- set access_path [uplevel #0 set auto_path];
+ if {[string equal "" $access_path]} {
+ set access_path [uplevel #0 set auto_path]
# Make sure that tcl_library is in auto_path
# and at the first position (needed by setAccessPath)
- set where [lsearch -exact $access_path [info library]];
+ set where [lsearch -exact $access_path [info library]]
if {$where == -1} {
# not found, add it.
- set access_path [concat [list [info library]] $access_path];
+ set access_path [concat [list [info library]] $access_path]
Log $slave "tcl_library was not in auto_path,\
- added it to slave's access_path" NOTICE;
+ added it to slave's access_path" NOTICE
} elseif {$where != 0} {
# not first, move it first
set access_path [concat [list [info library]]\
- [lreplace $access_path $where $where]];
+ [lreplace $access_path $where $where]]
Log $slave "tcl_libray was not in first in auto_path,\
- moved it to front of slave's access_path" NOTICE;
+ moved it to front of slave's access_path" NOTICE
}
# Add 1st level sub dirs (will searched by auto loading from tcl
# code in the slave using glob and thus fail, so we add them
# here so by default it works the same).
- set access_path [AddSubDirs $access_path];
+ set access_path [AddSubDirs $access_path]
}
Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
- nestedok=$nestedok deletehook=($deletehook)" NOTICE;
+ nestedok=$nestedok deletehook=($deletehook)" NOTICE
# clear old autopath if it existed
- set nname [PathNumberName $slave];
+ set nname [PathNumberName $slave]
if {[Exists $nname]} {
- set n [Set $nname];
+ set n [Set $nname]
for {set i 0} {$i<$n} {incr i} {
- Unset [PathToken $i $slave];
+ Unset [PathToken $i $slave]
}
}
# build new one
set slave_auto_path {}
- set i 0;
+ set i 0
foreach dir $access_path {
- Set [PathToken $i $slave] $dir;
- lappend slave_auto_path "\$[PathToken $i]";
- incr i;
+ Set [PathToken $i $slave] $dir
+ lappend slave_auto_path "\$[PathToken $i]"
+ incr i
}
- Set $nname $i;
- Set [PathListName $slave] $access_path;
- Set [VirtualPathListName $slave] $slave_auto_path;
+ Set $nname $i
+ Set [PathListName $slave] $access_path
+ Set [VirtualPathListName $slave] $slave_auto_path
Set [StaticsOkName $slave] $staticsok
Set [NestedOkName $slave] $nestedok
Set [DeleteHookName $slave] $deletehook
- SyncAccessPath $slave;
+ SyncAccessPath $slave
}
#
@@ -385,12 +382,12 @@ namespace eval ::safe {
# Search for a real directory and returns its virtual Id
# (including the "$")
proc ::safe::interpFindInAccessPath {slave path} {
- set access_path [GetAccessPath $slave];
- set where [lsearch -exact $access_path $path];
+ set access_path [GetAccessPath $slave]
+ set where [lsearch -exact $access_path $path]
if {$where == -1} {
- return -code error "$path not found in access path $access_path";
+ return -code error "$path not found in access path $access_path"
}
- return "\$[PathToken $where]";
+ return "\$[PathToken $where]"
}
#
@@ -400,22 +397,22 @@ proc ::safe::interpFindInAccessPath {slave path} {
proc ::safe::interpAddToAccessPath {slave path} {
# first check if the directory is already in there
if {![catch {interpFindInAccessPath $slave $path} res]} {
- return $res;
+ return $res
}
# new one, add it:
- set nname [PathNumberName $slave];
- set n [Set $nname];
- Set [PathToken $n $slave] $path;
+ set nname [PathNumberName $slave]
+ set n [Set $nname]
+ Set [PathToken $n $slave] $path
- set token "\$[PathToken $n]";
+ set token "\$[PathToken $n]"
- Lappend [VirtualPathListName $slave] $token;
- Lappend [PathListName $slave] $path;
- Set $nname [expr {$n+1}];
+ Lappend [VirtualPathListName $slave] $token
+ Lappend [PathListName $slave] $path
+ Set $nname [expr {$n+1}]
- SyncAccessPath $slave;
+ SyncAccessPath $slave
- return $token;
+ return $token
}
# This procedure applies the initializations to an already existing
@@ -431,7 +428,7 @@ proc ::safe::interpAddToAccessPath {slave path} {
# Configure will generate an access_path when access_path is
# empty.
- InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook;
+ InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook
# These aliases let the slave load files to define new commands
@@ -440,6 +437,13 @@ proc ::safe::interpAddToAccessPath {slave path} {
::interp alias $slave source {} [namespace current]::AliasSource $slave
::interp alias $slave load {} [namespace current]::AliasLoad $slave
+ # This alias lets the slave use the encoding names, convertfrom,
+ # convertto, and system, but not "encoding system <name>" to set
+ # the system encoding.
+
+ ::interp alias $slave encoding {} [namespace current]::AliasEncoding \
+ $slave
+
# This alias lets the slave have access to a subset of the 'file'
# command functionality.
@@ -471,9 +475,8 @@ proc ::safe::interpAddToAccessPath {slave path} {
# model platform dependant and thus more error prone.
if {[catch {::interp eval $slave\
- {source [file join $tcl_library init.tcl]}}\
- msg]} {
- Log $slave "can't source init.tcl ($msg)";
+ {source [file join $tcl_library init.tcl]}} msg]} {
+ Log $slave "can't source init.tcl ($msg)"
error "can't source init.tcl into slave $slave ($msg)"
}
@@ -491,18 +494,18 @@ proc ::safe::interpAddToAccessPath {slave path} {
# check that we don't have it yet as a children
# of a previous dir
if {[lsearch -exact $res $dir]<0} {
- lappend res $dir;
+ lappend res $dir
}
foreach sub [glob -nocomplain -- [file join $dir *]] {
- if { ([file isdirectory $sub])
- && ([lsearch -exact $res $sub]<0) } {
+ if {([file isdirectory $sub]) \
+ && ([lsearch -exact $res $sub]<0) } {
# new sub dir, add it !
- lappend res $sub;
+ lappend res $sub
}
}
}
}
- return $res;
+ return $res
}
# This procedure deletes a safe slave managed by Safe Tcl and
@@ -510,20 +513,20 @@ proc ::safe::interpAddToAccessPath {slave path} {
proc ::safe::interpDelete {slave} {
- Log $slave "About to delete" NOTICE;
+ Log $slave "About to delete" NOTICE
# If the slave has a cleanup hook registered, call it.
# check the existance because we might be called to delete an interp
# which has not been registered with us at all
- set hookname [DeleteHookName $slave];
+ set hookname [DeleteHookName $slave]
if {[Exists $hookname]} {
- set hook [Set $hookname];
+ set hook [Set $hookname]
if {![::tcl::Lempty $hook]} {
# remove the hook now, otherwise if the hook
# calls us somehow, we'll loop
- Unset $hookname;
+ Unset $hookname
if {[catch {eval $hook [list $slave]} err]} {
- Log $slave "Delete hook error ($err)";
+ Log $slave "Delete hook error ($err)"
}
}
}
@@ -531,16 +534,16 @@ proc ::safe::interpDelete {slave} {
# Discard the global array of state associated with the slave, and
# delete the interpreter.
- set statename [InterpStateName $slave];
+ set statename [InterpStateName $slave]
if {[Exists $statename]} {
- Unset $statename;
+ Unset $statename
}
# if we have been called twice, the interp might have been deleted
# already
if {[::interp exists $slave]} {
- ::interp delete $slave;
- Log $slave "Deleted" NOTICE;
+ ::interp delete $slave
+ Log $slave "Deleted" NOTICE
}
return
@@ -549,12 +552,12 @@ proc ::safe::interpDelete {slave} {
# Set (or get) the loging mecanism
proc ::safe::setLogCmd {args} {
- variable Log;
+ variable Log
if {[llength $args] == 0} {
- return $Log;
+ return $Log
} else {
if {[llength $args] == 1} {
- set Log [lindex $args 0];
+ set Log [lindex $args 0]
} else {
set Log $args
}
@@ -572,12 +575,11 @@ proc ::safe::setLogCmd {args} {
# also sets tcl_library to the first token of the virtual path.
#
proc SyncAccessPath {slave} {
- set slave_auto_path [Set [VirtualPathListName $slave]];
- ::interp eval $slave [list set auto_path $slave_auto_path];
- Log $slave \
- "auto_path in $slave has been set to $slave_auto_path"\
- NOTICE;
- ::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]];
+ set slave_auto_path [Set [VirtualPathListName $slave]]
+ ::interp eval $slave [list set auto_path $slave_auto_path]
+ Log $slave "auto_path in $slave has been set to $slave_auto_path"\
+ NOTICE
+ ::interp eval $slave [list set tcl_library [lindex $slave_auto_path 0]]
}
# base name for storing all the slave states
@@ -587,13 +589,12 @@ proc ::safe::setLogCmd {args} {
# We add the S prefix to avoid that a slave interp called "Log"
# would smash our "Log" variable.
proc InterpStateName {slave} {
- return "S$slave";
+ return "S$slave"
}
# Check that the given slave is "one of us"
proc IsInterp {slave} {
- expr { ([Exists [InterpStateName $slave]])
- && ([::interp exists $slave])}
+ expr {[Exists [InterpStateName $slave]] && [::interp exists $slave]}
}
# returns the virtual token for directory number N
@@ -601,53 +602,53 @@ proc ::safe::setLogCmd {args} {
# it will return the corresponding master global variable name
proc PathToken {n {slave ""}} {
if {[string compare "" $slave]} {
- return "[InterpStateName $slave](access_path,$n)";
+ return "[InterpStateName $slave](access_path,$n)"
} else {
# We need to have a ":" in the token string so
# [file join] on the mac won't turn it into a relative
# path.
- return "p(:$n:)";
+ return "p(:$n:)"
}
}
# returns the variable name of the complete path list
proc PathListName {slave} {
- return "[InterpStateName $slave](access_path)";
+ return "[InterpStateName $slave](access_path)"
}
# returns the variable name of the complete path list
proc VirtualPathListName {slave} {
- return "[InterpStateName $slave](access_path_slave)";
+ return "[InterpStateName $slave](access_path_slave)"
}
# returns the variable name of the number of items
proc PathNumberName {slave} {
- return "[InterpStateName $slave](access_path,n)";
+ return "[InterpStateName $slave](access_path,n)"
}
# returns the staticsok flag var name
proc StaticsOkName {slave} {
- return "[InterpStateName $slave](staticsok)";
+ return "[InterpStateName $slave](staticsok)"
}
# returns the nestedok flag var name
proc NestedOkName {slave} {
- return "[InterpStateName $slave](nestedok)";
+ return "[InterpStateName $slave](nestedok)"
}
# Run some code at the namespace toplevel
proc Toplevel {args} {
- namespace eval [namespace current] $args;
+ namespace eval [namespace current] $args
}
# set/get values
proc Set {args} {
- eval Toplevel set $args;
+ eval Toplevel set $args
}
# lappend on toplevel vars
proc Lappend {args} {
- eval Toplevel lappend $args;
+ eval Toplevel lappend $args
}
# unset a var/token (currently just an global level eval)
proc Unset {args} {
- eval Toplevel unset $args;
+ eval Toplevel unset $args
}
# test existance
proc Exists {varname} {
- Toplevel info exists $varname;
+ Toplevel info exists $varname
}
# short cut for access path getting
proc GetAccessPath {slave} {
@@ -673,24 +674,24 @@ proc ::safe::setLogCmd {args} {
# somehow strip the namespaces 'functionality' out (the danger
# is that we would strip valid macintosh "../" queries... :
if {[regexp {(::)|(\.\.)} $path]} {
- error "invalid characters in path $path";
+ error "invalid characters in path $path"
}
- set n [expr {[Set [PathNumberName $slave]]-1}];
+ set n [expr {[Set [PathNumberName $slave]]-1}]
for {} {$n>=0} {incr n -1} {
# fill the token virtual names with their real value
- set [PathToken $n] [Set [PathToken $n $slave]];
+ set [PathToken $n] [Set [PathToken $n $slave]]
}
# replaces the token by their value
- subst -nobackslashes -nocommands $path;
+ subst -nobackslashes -nocommands $path
}
# Log eventually log an error
# to enable error logging, set Log to {puts stderr} for instance
proc Log {slave msg {type ERROR}} {
- variable Log;
+ variable Log
if {[info exists Log] && [llength $Log]} {
- eval $Log [list "$type for slave $slave : $msg"];
+ eval $Log [list "$type for slave $slave : $msg"]
}
}
@@ -701,29 +702,27 @@ proc ::safe::setLogCmd {args} {
# limit what can be sourced to .tcl
# and forbid files with more than 1 dot and
# longer than 14 chars
- set ftail [file tail $file];
+ set ftail [file tail $file]
if {[string length $ftail]>14} {
- error "$ftail: filename too long";
+ error "$ftail: filename too long"
}
if {[regexp {\..*\.} $ftail]} {
- error "$ftail: more than one dot is forbidden";
+ error "$ftail: more than one dot is forbidden"
}
if {[string compare $ftail "tclIndex"] && \
- [string compare [string tolower [file extension $ftail]]\
- ".tcl"]} {
- error "$ftail: must be a *.tcl or tclIndex";
+ [string compare -nocase [file extension $ftail] ".tcl"]} {
+ error "$ftail: must be a *.tcl or tclIndex"
}
if {![file exists $file]} {
# don't tell the file path
- error "no such file or directory";
+ error "no such file or directory"
}
if {![file readable $file]} {
# don't tell the file path
- error "not readable";
+ error "not readable"
}
-
}
@@ -731,39 +730,39 @@ proc ::safe::setLogCmd {args} {
proc AliasSource {slave args} {
- set argc [llength $args];
+ set argc [llength $args]
# Allow only "source filename"
# (and not mac specific -rsrc for instance - see comment in ::init
# for current rationale)
if {$argc != 1} {
set msg "wrong # args: should be \"source fileName\""
- Log $slave "$msg ($args)";
- return -code error $msg;
+ Log $slave "$msg ($args)"
+ return -code error $msg
}
set file [lindex $args 0]
# get the real path from the virtual one.
if {[catch {set file [TranslatePath $slave $file]} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error "permission denied"
}
# check that the path is in the access path of that slave
if {[catch {FileInAccessPath $slave $file} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error "permission denied"
}
# do the checks on the filename :
if {[catch {CheckFileName $slave $file} msg]} {
- Log $slave "$file:$msg";
- return -code error $msg;
+ Log $slave "$file:$msg"
+ return -code error $msg
}
# passed all the tests , lets source it:
if {[catch {::interp invokehidden $slave source $file} msg]} {
- Log $slave $msg;
- return -code error "script error";
+ Log $slave $msg
+ return -code error "script error"
}
return $msg
}
@@ -772,26 +771,26 @@ proc ::safe::setLogCmd {args} {
proc AliasLoad {slave file args} {
- set argc [llength $args];
+ set argc [llength $args]
if {$argc > 2} {
- set msg "load error: too many arguments";
- Log $slave "$msg ($argc) {$file $args}";
- return -code error $msg;
+ set msg "load error: too many arguments"
+ Log $slave "$msg ($argc) {$file $args}"
+ return -code error $msg
}
# package name (can be empty if file is not).
- set package [lindex $args 0];
+ set package [lindex $args 0]
# Determine where to load. load use a relative interp path
# and {} means self, so we can directly and safely use passed arg.
- set target [lindex $args 1];
+ set target [lindex $args 1]
if {[string length $target]} {
# we will try to load into a sub sub interp
# check that we want to authorize that.
if {![NestedOk $slave]} {
Log $slave "loading to a sub interp (nestedok)\
- disabled (trying to load $package to $target)";
- return -code error "permission denied (nested load)";
+ disabled (trying to load $package to $target)"
+ return -code error "permission denied (nested load)"
}
}
@@ -800,34 +799,34 @@ proc ::safe::setLogCmd {args} {
if {[string length $file] == 0} {
# static package loading
if {[string length $package] == 0} {
- set msg "load error: empty filename and no package name";
- Log $slave $msg;
- return -code error $msg;
+ set msg "load error: empty filename and no package name"
+ Log $slave $msg
+ return -code error $msg
}
if {![StaticsOk $slave]} {
Log $slave "static packages loading disabled\
- (trying to load $package to $target)";
- return -code error "permission denied (static package)";
+ (trying to load $package to $target)"
+ return -code error "permission denied (static package)"
}
} else {
# file loading
# get the real path from the virtual one.
if {[catch {set file [TranslatePath $slave $file]} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error "permission denied"
}
# check the translated path
if {[catch {FileInAccessPath $slave $file} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error "permission denied (path)"
}
}
if {[catch {::interp invokehidden\
$slave load $file $package $target} msg]} {
- Log $slave $msg;
+ Log $slave $msg
return -code error $msg
}
@@ -842,14 +841,14 @@ proc ::safe::setLogCmd {args} {
# result.... needs checking ?
proc FileInAccessPath {slave file} {
- set access_path [GetAccessPath $slave];
+ set access_path [GetAccessPath $slave]
if {[file isdirectory $file]} {
error "\"$file\": is a directory"
}
set parent [file dirname $file]
if {[lsearch -exact $access_path $parent] == -1} {
- error "\"$file\": not in access_path";
+ error "\"$file\": not in access_path"
}
}
@@ -861,9 +860,9 @@ proc ::safe::setLogCmd {args} {
if {[regexp $okpat $subcommand]} {
return [eval {$command $subcommand} [lrange $args 1 end]]
}
- set msg "not allowed to invoke subcommand $subcommand of $command";
- Log $slave $msg;
- error $msg;
+ set msg "not allowed to invoke subcommand $subcommand of $command"
+ Log $slave $msg
+ error $msg
}
# This procedure installs an alias in a slave that invokes "safesubset"
@@ -884,4 +883,40 @@ proc ::safe::setLogCmd {args} {
[namespace current]::Subset $slave $target $pat
}
+ # AliasEncoding is the target of the "encoding" alias in safe interpreters.
+
+ proc AliasEncoding {slave args} {
+
+ set argc [llength $args]
+
+ set okpat "^(name.*|convert.*)\$"
+ set subcommand [lindex $args 0]
+
+ if {[regexp $okpat $subcommand]} {
+ return [eval ::interp invokehidden $slave encoding $subcommand \
+ [lrange $args 1 end]]
+ }
+
+ if {[string match $subcommand system]} {
+ if {$argc == 1} {
+ # passed all the tests , lets source it:
+ if {[catch {::interp invokehidden \
+ $slave encoding system} msg]} {
+ Log $slave $msg
+ return -code error "script error"
+ }
+ } else {
+ set msg "wrong # args: should be \"encoding system\""
+ Log $slave $msg
+ error $msg
+ }
+ } else {
+ set msg "wrong # args: should be \"encoding option ?arg ...?\""
+ Log $slave $msg
+ error $msg
+ }
+
+ return $msg
+ }
+
}
diff --git a/tcl/library/safeinit.tcl b/tcl/library/safeinit.tcl
new file mode 100644
index 00000000000..e1ce1a03959
--- /dev/null
+++ b/tcl/library/safeinit.tcl
@@ -0,0 +1,461 @@
+# safeinit.tcl --
+#
+# This code runs in a master to manage a safe slave with Safe Tcl.
+# See the safe.n man page for details.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) safeinit.tcl 1.38 97/06/20 12:57:39
+
+# This procedure creates a safe slave, initializes it with the
+# safe base and installs the aliases for the security policy mechanism.
+
+proc tcl_safeCreateInterp {slave} {
+ global auto_path
+
+ # Create the slave.
+ interp create -safe $slave
+
+ # Set its auto_path
+ interp eval $slave [list set auto_path $auto_path]
+
+ # And initialize it.
+ return [tcl_safeInitInterp $slave]
+}
+
+# This procedure applies the initializations to an already existing
+# interpreter. It is useful when you want to enable an interpreter
+# created with "interp create -safe" to use security policies.
+
+proc tcl_safeInitInterp {slave} {
+ upvar #0 tclSafe$slave state
+ global tcl_library tk_library auto_path tcl_platform
+
+ # These aliases let the slave load files to define new commands
+
+ interp alias $slave source {} tclSafeAliasSource $slave
+ interp alias $slave load {} tclSafeAliasLoad $slave
+
+ # This alias lets the slave have access to a subset of the 'file'
+ # command functionality.
+ tclAliasSubset $slave file file dir.* join root.* ext.* tail \
+ path.* split
+
+ # This alias interposes on the 'exit' command and cleanly terminates
+ # the slave.
+ interp alias $slave exit {} tcl_safeDeleteInterp $slave
+
+ # Source init.tcl into the slave, to get auto_load and other
+ # procedures defined:
+
+ if {$tcl_platform(platform) == "macintosh"} {
+ if {[catch {interp eval $slave [list source -rsrc Init]}]} {
+ if {[catch {interp eval $slave \
+ [list source [file join $tcl_library init.tcl]]}]} {
+ error "can't source init.tcl into slave $slave"
+ }
+ }
+ } else {
+ if {[catch {interp eval $slave \
+ [list source [file join $tcl_library init.tcl]]}]} {
+ error "can't source init.tcl into slave $slave"
+ }
+ }
+
+ # Loading packages into slaves is handled by their master.
+ # This is overloaded to deal with regular packages and security policies
+
+ interp alias $slave tclPkgUnknown {} tclSafeAliasPkgUnknown $slave
+ interp eval $slave {package unknown tclPkgUnknown}
+
+ # We need a helper procedure to define a $dir variable and then
+ # do a source of the pkgIndex.tcl file
+ interp eval $slave \
+ [list proc tclPkgSource {dir args} {
+ if {[llength $args] == 2} {
+ source [lindex $args 0] [lindex $args 1]
+ } else {
+ source [lindex $args 0]
+ }
+ }]
+
+ # Let the slave inherit a few variables
+ foreach varName \
+ {tcl_library tcl_version tcl_patchLevel \
+ tcl_platform(platform) auto_path} {
+ upvar #0 $varName var
+ interp eval $slave [list set $varName $var]
+ }
+
+ # Other variables are predefined with set values
+ foreach {varName value} {
+ auto_noexec 1
+ errorCode {}
+ errorInfo {}
+ env() {}
+ argv0 {}
+ argv {}
+ argc 0
+ tcl_interactive 0
+ } {
+ interp eval $slave [list set $varName $value]
+ }
+
+ # If auto_path is not set in the slave, set it to empty so it has
+ # a value and exists. Otherwise auto_loading and package require
+ # will complain.
+
+ interp eval $slave {
+ if {![info exists auto_path]} {
+ set auto_path {}
+ }
+ }
+
+ # If we have Tk, make the slave have the same library as us:
+
+ if {[info exists tk_library]} {
+ interp eval $slave [list set tk_library $tk_library]
+ }
+
+ # Stub out auto-exec mechanism in slave
+ interp eval $slave [list proc auto_execok {name} {return {}}]
+
+ return $slave
+}
+
+# This procedure deletes a safe slave managed by Safe Tcl and
+# cleans up associated state:
+
+proc tcl_safeDeleteInterp {slave args} {
+ upvar #0 tclSafe$slave state
+
+ # If the slave has a policy loaded, clean it up now.
+ if {[info exists state(policyLoaded)]} {
+ set policy $state(policyLoaded)
+ set proc ${policy}_PolicyCleanup
+ if {[string compare [info proc $proc] $proc] == 0} {
+ $proc $slave
+ }
+ }
+
+ # Discard the global array of state associated with the slave, and
+ # delete the interpreter.
+ catch {unset state}
+ catch {interp delete $slave}
+
+ return
+}
+
+# This procedure computes the global security policy search path.
+
+proc tclSafeComputePolicyPath {} {
+ global auto_path tclSafeAutoPathComputed tclSafePolicyPath
+
+ set recompute 0
+ if {(![info exists tclSafePolicyPath]) ||
+ ("$tclSafePolicyPath" == "")} {
+ set tclSafePolicyPath ""
+ set tclSafeAutoPathComputed ""
+ set recompute 1
+ }
+ if {"$tclSafeAutoPathComputed" != "$auto_path"} {
+ set recompute 1
+ set tclSafeAutoPathComputed $auto_path
+ }
+ if {$recompute == 1} {
+ set tclSafePolicyPath ""
+ foreach i $auto_path {
+ lappend tclSafePolicyPath [file join $i policies]
+ }
+ }
+ return $tclSafePolicyPath
+}
+
+# ---------------------------------------------------------------------------
+# ---------------------------------------------------------------------------
+
+# tclSafeAliasSource is the target of the "source" alias in safe interpreters.
+
+proc tclSafeAliasSource {slave args} {
+ global auto_path errorCode errorInfo
+
+ if {[llength $args] == 2} {
+ if {[string compare "-rsrc" [lindex $args 0]] != 0} {
+ return -code error "incorrect arguments to source"
+ }
+ if {[catch {interp invokehidden $slave source -rsrc [lindex $args 1]} \
+ msg]} {
+ return -code error $msg
+ }
+ } else {
+ set file [lindex $args 0]
+ if {[catch {tclFileInPath $file $auto_path $slave} msg]} {
+ return -code error "permission denied"
+ }
+ set errorInfo ""
+ if {[catch {interp invokehidden $slave source $file} msg]} {
+ return -code error $msg
+ }
+ }
+ return $msg
+}
+
+# tclSafeAliasLoad is the target of the "load" alias in safe interpreters.
+
+proc tclSafeAliasLoad {slave file args} {
+ global auto_path
+
+ if {[llength $args] == 2} {
+ # Trying to load into another interpreter
+ # Allow this for a child of the slave, or itself
+ set other [lindex $args 1]
+ foreach x $slave y $other {
+ if {[string length $x] == 0} {
+ break
+ } elseif {[string compare $x $y] != 0} {
+ return -code error "permission denied"
+ }
+ }
+ set slave $other
+ }
+
+ if {[string length $file] && \
+ [catch {tclFileInPath $file $auto_path $slave} msg]} {
+ return -code error "permission denied"
+ }
+ if {[catch {
+ switch [llength $args] {
+ 0 {
+ interp invokehidden $slave load $file
+ }
+ 1 -
+ 2 {
+ interp invokehidden $slave load $file [lindex $args 0]
+ }
+ default {
+ error "too many arguments to load"
+ }
+ }
+ } msg]} {
+ return -code error $msg
+ }
+ return $msg
+}
+
+# tclFileInPath raises an error if the file is not found in
+# the list of directories contained in path.
+
+proc tclFileInPath {file path slave} {
+ set realcheckpath [tclSafeCheckAutoPath $path $slave]
+ set pwd [pwd]
+ if {[file isdirectory $file]} {
+ error "$file: not found"
+ }
+ set parent [file dirname $file]
+ if {[catch {cd $parent} msg]} {
+ error "$file: not found"
+ }
+ set realfilepath [file split [pwd]]
+ foreach dir $realcheckpath {
+ set match 1
+ foreach a [file split $dir] b $realfilepath {
+ if {[string length $a] == 0} {
+ break
+ } elseif {[string compare $a $b] != 0} {
+ set match 0
+ break
+ }
+ }
+ if {$match} {
+ cd $pwd
+ return 1
+ }
+ }
+ cd $pwd
+ error "$file: not found"
+}
+
+# This procedure computes our expanded copy of the path, as needed.
+# It returns the path after expanding out all aliases.
+
+proc tclSafeCheckAutoPath {path slave} {
+ global auto_path
+ upvar #0 tclSafe$slave state
+
+ if {![info exists state(expanded_auto_path)]} {
+ # Compute for the first time:
+ set state(cached_auto_path) $path
+ } elseif {"$state(cached_auto_path)" != "$path"} {
+ # The value of our path changed, so recompute:
+ set state(cached_auto_path) $path
+ } else {
+ # No change: no need to recompute.
+ return $state(expanded_auto_path)
+ }
+
+ set pwd [pwd]
+ set state(expanded_auto_path) ""
+ foreach dir $state(cached_auto_path) {
+ if {![catch {cd $dir}]} {
+ lappend state(expanded_auto_path) [pwd]
+ }
+ }
+ cd $pwd
+ return $state(expanded_auto_path)
+}
+
+proc tclSafeAliasPkgUnknown {slave package version {exact {}}} {
+ tclSafeLoadPkg $slave $package $version $exact
+}
+
+proc tclSafeLoadPkg {slave package version exact} {
+ if {[string length $version] == 0} {
+ set version 1.0
+ }
+ tclSafeLoadPkgInternal $slave $package $version $exact 0
+}
+
+proc tclSafeLoadPkgInternal {slave package version exact round} {
+ global auto_path
+ upvar #0 tclSafe$slave state
+
+ # Search the policy path again; it might have changed in the meantime.
+
+ if {$round == 1} {
+ tclSafeResearchPolicyPath
+
+ if {[tclSafeLoadPolicy $slave $package $version]} {
+ return
+ }
+ }
+
+ # Try to load as a policy.
+
+ if [tclSafeLoadPolicy $slave $package $version] {
+ return
+ }
+
+ # The package is not a security policy, so do the regular setup.
+
+ # Here we run tclPkgUnknown in the master, but we hijack
+ # the source command so the setup ends up happening in the slave.
+
+ rename source source.orig
+ proc source {args} "upvar dir dir
+ interp eval [list $slave] tclPkgSource \[list \$dir\] \$args"
+
+ if [catch {tclPkgUnknown $package $version $exact} err] {
+ global errorInfo
+
+ rename source {}
+ rename source.orig source
+
+ error "$err\n$errorInfo"
+ }
+ rename source {}
+ rename source.orig source
+
+ # If we are in the first round, check if the package
+ # is now known in the slave:
+
+ if {$round == 0} {
+ set ifneeded \
+ [interp eval $slave [list package ifneeded $package $version]]
+
+ if {"$ifneeded" == ""} {
+ return [tclSafeLoadPkgInternal $slave $package $version $exact 1]
+ }
+ }
+}
+
+proc tclSafeResearchPolicyPath {} {
+ global tclSafePolicyPath auto_index auto_path
+
+ # If there was no change, do not search again.
+
+ if {![info exists tclSafePolicyPath]} {
+ set tclSafePolicyPath ""
+ }
+ set oldPolicyPath $tclSafePolicyPath
+ set newPolicyPath [tclSafeComputePolicyPath]
+ if {"$newPolicyPath" == "$oldPolicyPath"} {
+ return
+ }
+
+ # Loop through the path from back to front so early directories
+ # end up overriding later directories. This code is like auto_load,
+ # but only new-style tclIndex files (version 2) are supported.
+
+ for {set i [expr [llength $newPolicyPath] - 1]} \
+ {$i >= 0} \
+ {incr i -1} {
+ set dir [lindex $newPolicyPath $i]
+ set file [file join $dir tclIndex]
+ if {[file exists $file]} {
+ if {[catch {source $file} msg]} {
+ puts stderr "error sourcing $file: $msg"
+ }
+ }
+ foreach file [lsort [glob -nocomplain [file join $dir *]]] {
+ if {[file isdir $file]} {
+ set dir $file
+ set file [file join $file tclIndex]
+ if {[file exists $file]} {
+ if {[catch {source $file} msg]} {
+ puts stderr "error sourcing $file: $msg"
+ }
+ }
+ }
+ }
+ }
+}
+
+proc tclSafeLoadPolicy {slave package version} {
+ upvar #0 tclSafe$slave state
+ global auto_index
+
+ set proc ${package}_PolicyInit
+
+ if {[info command $proc] == "$proc" ||
+ [info exists auto_index($proc)]} {
+ if [info exists state(policyLoaded)] {
+ error "security policy $state(policyLoaded) already loaded"
+ }
+ $proc $slave $version
+ interp eval $slave [list package provide $package $version]
+ set state(policyLoaded) $package
+ return 1
+ } else {
+ return 0
+ }
+}
+# This procedure enables access from a safe interpreter to only a subset of
+# the subcommands of a command:
+
+proc tclSafeSubset {command okpat args} {
+ set subcommand [lindex $args 0]
+ if {[regexp $okpat $subcommand]} {
+ return [eval {$command $subcommand} [lrange $args 1 end]]
+ }
+ error "not allowed to invoke subcommand $subcommand of $command"
+}
+
+# This procedure installs an alias in a slave that invokes "safesubset"
+# in the master to execute allowed subcommands. It precomputes the pattern
+# of allowed subcommands; you can use wildcards in the pattern if you wish
+# to allow subcommand abbreviation.
+#
+# Syntax is: tclAliasSubset slave alias target subcommand1 subcommand2...
+
+proc tclAliasSubset {slave alias target args} {
+ set pat ^(; set sep ""
+ foreach sub $args {
+ append pat $sep$sub
+ set sep |
+ }
+ append pat )\$
+ interp alias $slave $alias {} tclSafeSubset $target $pat
+}
diff --git a/tcl/library/tclIndex b/tcl/library/tclIndex
index 09a7e64d7e2..c2da6bee4c5 100644
--- a/tcl/library/tclIndex
+++ b/tcl/library/tclIndex
@@ -6,16 +6,75 @@
# element name is the name of a command and the value is
# a script that loads the command.
+set auto_index(auto_reset) [list source [file join $dir auto.tcl]]
+set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]]
+set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]]
+set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]]
set auto_index(history) [list source [file join $dir history.tcl]]
+set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]]
+set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]]
+set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]]
+set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]]
+set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]]
+set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]]
+set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]]
+set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]]
set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]
+set auto_index(pkg_compareExtension) [list source [file join $dir package.tcl]]
+set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]
+set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]
+set auto_index(tclMacPkgSearch) [list source [file join $dir package.tcl]]
+set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]
+set auto_index(::pkg::create) [list source [file join $dir package.tcl]]
set auto_index(parray) [list source [file join $dir parray.tcl]]
+set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]
set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpStateName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::IsInterp) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::PathListName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::VirtualPathListName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::PathNumberName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::StaticsOkName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::NestedOkName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::Toplevel) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::Set) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::Lappend) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::Unset) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::Exists) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::GetAccessPath) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::StaticsOk) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::NestedOk) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::DeleteHookName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::Log) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]]
set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]
set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]
set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]
diff --git a/tcl/library/tcltest1.0/pkgIndex.tcl b/tcl/library/tcltest1.0/pkgIndex.tcl
new file mode 100644
index 00000000000..96b38cc2a24
--- /dev/null
+++ b/tcl/library/tcltest1.0/pkgIndex.tcl
@@ -0,0 +1,18 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded tcltest 1.0 [list tclPkgSetup $dir tcltest 1.0 \
+ {{tcltest.tcl source {::tcltest::bytestring ::tcltest::cleanupTests \
+ ::tcltest::dotests ::tcltest::makeDirectory ::tcltest::makeFile \
+ ::tcltest::normalizeMsg ::tcltest::removeDirectory \
+ ::tcltest::removeFile ::tcltest::restoreState ::tcltest::saveState \
+ ::tcltest::test ::tcltest::threadReap ::tcltest::viewFile memory \
+ ::tcltest:grep ::tcltest::getMatchingTestFiles }}}]
+
diff --git a/tcl/library/tcltest1.0/tcltest.tcl b/tcl/library/tcltest1.0/tcltest.tcl
new file mode 100644
index 00000000000..a2fc5a7f0ac
--- /dev/null
+++ b/tcl/library/tcltest1.0/tcltest.tcl
@@ -0,0 +1,1906 @@
+# tcltest.tcl --
+#
+# This file contains support code for the Tcl test suite. It
+# defines the ::tcltest namespace and finds and defines the output
+# directory, constraints available, output and error channels, etc. used
+# by Tcl tests. See the tcltest man page for more details.
+#
+# This design was based on the Tcl testing approach designed and
+# initially implemented by Mary Ann May-Pumphrey of Sun Microsystems.
+#
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package provide tcltest 1.0
+
+# create the "tcltest" namespace for all testing variables and procedures
+
+namespace eval tcltest {
+
+ # Export the public tcltest procs
+ set procList [list test cleanupTests saveState restoreState \
+ normalizeMsg makeFile removeFile makeDirectory removeDirectory \
+ viewFile bytestring safeFetch threadReap getMatchingFiles \
+ loadTestedCommands normalizePath]
+ foreach proc $procList {
+ namespace export $proc
+ }
+
+ # ::tcltest::verbose defaults to "b"
+ if {![info exists verbose]} {
+ variable verbose "b"
+ }
+
+ # Match and skip patterns default to the empty list, except for
+ # matchFiles, which defaults to all .test files in the testsDirectory
+
+ if {![info exists match]} {
+ variable match {}
+ }
+ if {![info exists skip]} {
+ variable skip {}
+ }
+ if {![info exists matchFiles]} {
+ variable matchFiles {*.test}
+ }
+ if {![info exists skipFiles]} {
+ variable skipFiles {}
+ }
+
+ # By default, don't save core files
+ if {![info exists preserveCore]} {
+ variable preserveCore 0
+ }
+
+ # output goes to stdout by default
+ if {![info exists outputChannel]} {
+ variable outputChannel stdout
+ }
+
+ # errors go to stderr by default
+ if {![info exists errorChannel]} {
+ variable errorChannel stderr
+ }
+
+ # debug output doesn't get printed by default; debug level 1 spits
+ # up only the tests that were skipped because they didn't match or were
+ # specifically skipped. A debug level of 2 would spit up the tcltest
+ # variables and flags provided; a debug level of 3 causes some additional
+ # output regarding operations of the test harness. The tcltest package
+ # currently implements only up to debug level 3.
+ if {![info exists debug]} {
+ variable debug 0
+ }
+
+ # Save any arguments that we might want to pass through to other programs.
+ # This is used by the -args flag.
+ if {![info exists parameters]} {
+ variable parameters {}
+ }
+
+ # Count the number of files tested (0 if all.tcl wasn't called).
+ # The all.tcl file will set testSingleFile to false, so stats will
+ # not be printed until all.tcl calls the cleanupTests proc.
+ # The currentFailure var stores the boolean value of whether the
+ # current test file has had any failures. The failFiles list
+ # stores the names of test files that had failures.
+
+ if {![info exists numTestFiles]} {
+ variable numTestFiles 0
+ }
+ if {![info exists testSingleFile]} {
+ variable testSingleFile true
+ }
+ if {![info exists currentFailure]} {
+ variable currentFailure false
+ }
+ if {![info exists failFiles]} {
+ variable failFiles {}
+ }
+
+ # Tests should remove all files they create. The test suite will
+ # check the current working dir for files created by the tests.
+ # ::tcltest::filesMade keeps track of such files created using the
+ # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
+ # ::tcltest::filesExisted stores the names of pre-existing files.
+
+ if {![info exists filesMade]} {
+ variable filesMade {}
+ }
+ if {![info exists filesExisted]} {
+ variable filesExisted {}
+ }
+
+ # ::tcltest::numTests will store test files as indices and the list
+ # of files (that should not have been) left behind by the test files.
+
+ if {![info exists createdNewFiles]} {
+ variable createdNewFiles
+ array set ::tcltest::createdNewFiles {}
+ }
+
+ # initialize ::tcltest::numTests array to keep track fo the number of
+ # tests that pass, fail, and are skipped.
+
+ if {![info exists numTests]} {
+ variable numTests
+ array set ::tcltest::numTests \
+ [list Total 0 Passed 0 Skipped 0 Failed 0]
+ }
+
+ # initialize ::tcltest::skippedBecause array to keep track of
+ # constraints that kept tests from running; a constraint name of
+ # "userSpecifiedSkip" means that the test appeared on the list of tests
+ # that matched the -skip value given to the flag; "userSpecifiedNonMatch"
+ # means that the test didn't match the argument given to the -match flag;
+ # both of these constraints are counted only if ::tcltest::debug is set to
+ # true.
+
+ if {![info exists skippedBecause]} {
+ variable skippedBecause
+ array set ::tcltest::skippedBecause {}
+ }
+
+ # initialize the ::tcltest::testConstraints array to keep track of valid
+ # predefined constraints (see the explanation for the
+ # ::tcltest::initConstraints proc for more details).
+
+ if {![info exists testConstraints]} {
+ variable testConstraints
+ array set ::tcltest::testConstraints {}
+ }
+
+ # Don't run only the constrained tests by default
+
+ if {![info exists limitConstraints]} {
+ variable limitConstraints false
+ }
+
+ # A test application has to know how to load the tested commands into
+ # the interpreter.
+
+ if {![info exists loadScript]} {
+ variable loadScript {}
+ }
+
+ # tests that use threads need to know which is the main thread
+
+ if {![info exists mainThread]} {
+ variable mainThread 1
+ if {[info commands thread::id] != {}} {
+ set mainThread [thread::id]
+ } elseif {[info commands testthread] != {}} {
+ set mainThread [testthread id]
+ }
+ }
+
+ # save the original environment so that it can be restored later
+
+ if {![info exists originalEnv]} {
+ variable originalEnv
+ array set ::tcltest::originalEnv [array get ::env]
+ }
+
+ # Set ::tcltest::workingDirectory to [pwd]. The default output directory
+ # for Tcl tests is the working directory.
+
+ if {![info exists workingDirectory]} {
+ variable workingDirectory [pwd]
+ }
+ if {![info exists temporaryDirectory]} {
+ variable temporaryDirectory $workingDirectory
+ }
+
+ # Tests should not rely on the current working directory.
+ # Files that are part of the test suite should be accessed relative to
+ # ::tcltest::testsDirectory.
+
+ if {![info exists testsDirectory]} {
+ set oldpwd [pwd]
+ catch {cd [file join [file dirname [info script]] .. .. tests]}
+ variable testsDirectory [pwd]
+ cd $oldpwd
+ unset oldpwd
+ }
+
+ # the variables and procs that existed when ::tcltest::saveState was
+ # called are stored in a variable of the same name
+ if {![info exists saveState]} {
+ variable saveState {}
+ }
+
+ # Internationalization support
+ if {![info exists isoLocale]} {
+ variable isoLocale fr
+ switch $tcl_platform(platform) {
+ "unix" {
+
+ # Try some 'known' values for some platforms:
+
+ switch -exact -- $tcl_platform(os) {
+ "FreeBSD" {
+ set ::tcltest::isoLocale fr_FR.ISO_8859-1
+ }
+ HP-UX {
+ set ::tcltest::isoLocale fr_FR.iso88591
+ }
+ Linux -
+ IRIX {
+ set ::tcltest::isoLocale fr
+ }
+ default {
+
+ # Works on SunOS 4 and Solaris, and maybe others...
+ # define it to something else on your system
+ #if you want to test those.
+
+ set ::tcltest::isoLocale iso_8859_1
+ }
+ }
+ }
+ "windows" {
+ set ::tcltest::isoLocale French
+ }
+ }
+ }
+
+ # Set the location of the execuatble
+ if {![info exists tcltest]} {
+ variable tcltest [info nameofexecutable]
+ }
+
+ # save the platform information so it can be restored later
+ if {![info exists originalTclPlatform]} {
+ variable originalTclPlatform [array get tcl_platform]
+ }
+
+ # If a core file exists, save its modification time.
+ if {![info exists coreModificationTime]} {
+ if {[file exists [file join $::tcltest::workingDirectory core]]} {
+ variable coreModificationTime [file mtime [file join \
+ $::tcltest::workingDirectory core]]
+ }
+ }
+
+ # Tcl version numbers
+ if {![info exists version]} {
+ variable version 8.3
+ }
+ if {![info exists patchLevel]} {
+ variable patchLevel 8.3.0
+ }
+}
+
+# ::tcltest::Debug* --
+#
+# Internal helper procedures to write out debug information
+# dependent on the chosen level. A test shell may overide
+# them, f.e. to redirect the output into a different
+# channel, or even into a GUI.
+
+# ::tcltest::DebugPuts --
+#
+# Prints the specified string if the current debug level is
+# higher than the provided level argument.
+#
+# Arguments:
+# level The lowest debug level triggering the output
+# string The string to print out.
+#
+# Results:
+# Prints the string. Nothing else is allowed.
+#
+
+proc ::tcltest::DebugPuts {level string} {
+ variable debug
+ if {$debug >= $level} {
+ puts $string
+ }
+}
+
+# ::tcltest::DebugPArray --
+#
+# Prints the contents of the specified array if the current
+# debug level is higher than the provided level argument
+#
+# Arguments:
+# level The lowest debug level triggering the output
+# arrayvar The name of the array to print out.
+#
+# Results:
+# Prints the contents of the array. Nothing else is allowed.
+#
+
+proc ::tcltest::DebugPArray {level arrayvar} {
+ variable debug
+
+ if {$debug >= $level} {
+ catch {upvar $arrayvar $arrayvar}
+ parray $arrayvar
+ }
+}
+
+# ::tcltest::DebugDo --
+#
+# Executes the script if the current debug level is greater than
+# the provided level argument
+#
+# Arguments:
+# level The lowest debug level triggering the execution.
+# script The tcl script executed upon a debug level high enough.
+#
+# Results:
+# Arbitrary side effects, dependent on the executed script.
+#
+
+proc ::tcltest::DebugDo {level script} {
+ variable debug
+
+ if {$debug >= $level} {
+ uplevel $script
+ }
+}
+
+# ::tcltest::AddToSkippedBecause --
+#
+# Increments the variable used to track how many tests were skipped
+# because of a particular constraint.
+#
+# Arguments:
+# constraint The name of the constraint to be modified
+#
+# Results:
+# Modifies ::tcltest::skippedBecause; sets the variable to 1 if didn't
+# previously exist - otherwise, it just increments it.
+
+proc ::tcltest::AddToSkippedBecause { constraint } {
+ # add the constraint to the list of constraints that kept tests
+ # from running
+
+ if {[info exists ::tcltest::skippedBecause($constraint)]} {
+ incr ::tcltest::skippedBecause($constraint)
+ } else {
+ set ::tcltest::skippedBecause($constraint) 1
+ }
+ return
+}
+
+# ::tcltest::PrintError --
+#
+# Prints errors to ::tcltest::errorChannel and then flushes that
+# channel, making sure that all messages are < 80 characters per line.
+#
+# Arguments:
+# errorMsg String containing the error to be printed
+#
+
+proc ::tcltest::PrintError {errorMsg} {
+ set InitialMessage "Error: "
+ set InitialMsgLen [string length $InitialMessage]
+ puts -nonewline $::tcltest::errorChannel $InitialMessage
+
+ # Keep track of where the end of the string is.
+ set endingIndex [string length $errorMsg]
+
+ if {$endingIndex < 80} {
+ puts $::tcltest::errorChannel $errorMsg
+ } else {
+ # Print up to 80 characters on the first line, including the
+ # InitialMessage.
+ set beginningIndex [string last " " [string range $errorMsg 0 \
+ [expr {80 - $InitialMsgLen}]]]
+ puts $::tcltest::errorChannel [string range $errorMsg 0 $beginningIndex]
+
+ while {$beginningIndex != "end"} {
+ puts -nonewline $::tcltest::errorChannel \
+ [string repeat " " $InitialMsgLen]
+ if {[expr {$endingIndex - $beginningIndex}] < 72} {
+ puts $::tcltest::errorChannel [string trim \
+ [string range $errorMsg $beginningIndex end]]
+ set beginningIndex end
+ } else {
+ set newEndingIndex [expr [string last " " [string range \
+ $errorMsg $beginningIndex \
+ [expr {$beginningIndex + 72}]]] + $beginningIndex]
+ if {($newEndingIndex <= 0) \
+ || ($newEndingIndex <= $beginningIndex)} {
+ set newEndingIndex end
+ }
+ puts $::tcltest::errorChannel [string trim \
+ [string range $errorMsg \
+ $beginningIndex $newEndingIndex]]
+ set beginningIndex $newEndingIndex
+ }
+ }
+ }
+ flush $::tcltest::errorChannel
+ return
+}
+
+if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
+ proc ::tcltest::initConstraintsHook {} {}
+}
+
+# ::tcltest::initConstraints --
+#
+# Check Constraintsuration information that will determine which tests
+# to run. To do this, create an array ::tcltest::testConstraints. Each
+# element has a 0 or 1 value. If the element is "true" then tests
+# with that constraint will be run, otherwise tests with that constraint
+# will be skipped. See the tcltest man page for the list of built-in
+# constraints defined in this procedure.
+#
+# Arguments:
+# none
+#
+# Results:
+# The ::tcltest::testConstraints array is reset to have an index for
+# each built-in test constraint.
+
+proc ::tcltest::initConstraints {} {
+ global tcl_platform tcl_interactive tk_version
+
+ # The following trace procedure makes it so that we can safely refer to
+ # non-existent members of the ::tcltest::testConstraints array without
+ # causing an error. Instead, reading a non-existent member will return 0.
+ # This is necessary because tests are allowed to use constraint "X" without
+ # ensuring that ::tcltest::testConstraints("X") is defined.
+
+ trace variable ::tcltest::testConstraints r ::tcltest::safeFetch
+
+ proc ::tcltest::safeFetch {n1 n2 op} {
+ if {($n2 != {}) && ([info exists ::tcltest::testConstraints($n2)] == 0)} {
+ set ::tcltest::testConstraints($n2) 0
+ }
+ }
+
+ ::tcltest::initConstraintsHook
+
+ set ::tcltest::testConstraints(unixOnly) \
+ [string equal $tcl_platform(platform) "unix"]
+ set ::tcltest::testConstraints(macOnly) \
+ [string equal $tcl_platform(platform) "macintosh"]
+ set ::tcltest::testConstraints(pcOnly) \
+ [string equal $tcl_platform(platform) "windows"]
+
+ set ::tcltest::testConstraints(unix) $::tcltest::testConstraints(unixOnly)
+ set ::tcltest::testConstraints(mac) $::tcltest::testConstraints(macOnly)
+ set ::tcltest::testConstraints(pc) $::tcltest::testConstraints(pcOnly)
+
+ set ::tcltest::testConstraints(unixOrPc) \
+ [expr {$::tcltest::testConstraints(unix) \
+ || $::tcltest::testConstraints(pc)}]
+ set ::tcltest::testConstraints(macOrPc) \
+ [expr {$::tcltest::testConstraints(mac) \
+ || $::tcltest::testConstraints(pc)}]
+ set ::tcltest::testConstraints(macOrUnix) \
+ [expr {$::tcltest::testConstraints(mac) \
+ || $::tcltest::testConstraints(unix)}]
+
+ set ::tcltest::testConstraints(nt) [string equal $tcl_platform(os) \
+ "Windows NT"]
+ set ::tcltest::testConstraints(95) [string equal $tcl_platform(os) \
+ "Windows 95"]
+ set ::tcltest::testConstraints(98) [string equal $tcl_platform(os) \
+ "Windows 98"]
+
+ # The following Constraints switches are used to mark tests that should
+ # work, but have been temporarily disabled on certain platforms because
+ # they don't and we haven't gotten around to fixing the underlying
+ # problem.
+
+ set ::tcltest::testConstraints(tempNotPc) \
+ [expr {!$::tcltest::testConstraints(pc)}]
+ set ::tcltest::testConstraints(tempNotMac) \
+ [expr {!$::tcltest::testConstraints(mac)}]
+ set ::tcltest::testConstraints(tempNotUnix) \
+ [expr {!$::tcltest::testConstraints(unix)}]
+
+ # The following Constraints switches are used to mark tests that crash on
+ # certain platforms, so that they can be reactivated again when the
+ # underlying problem is fixed.
+
+ set ::tcltest::testConstraints(pcCrash) \
+ [expr {!$::tcltest::testConstraints(pc)}]
+ set ::tcltest::testConstraints(macCrash) \
+ [expr {!$::tcltest::testConstraints(mac)}]
+ set ::tcltest::testConstraints(unixCrash) \
+ [expr {!$::tcltest::testConstraints(unix)}]
+
+ # Skip empty tests
+
+ set ::tcltest::testConstraints(emptyTest) 0
+
+ # By default, tests that expose known bugs are skipped.
+
+ set ::tcltest::testConstraints(knownBug) 0
+
+ # By default, non-portable tests are skipped.
+
+ set ::tcltest::testConstraints(nonPortable) 0
+
+ # Some tests require user interaction.
+
+ set ::tcltest::testConstraints(userInteraction) 0
+
+ # Some tests must be skipped if the interpreter is not in interactive mode
+
+ if {[info exists tcl_interactive]} {
+ set ::tcltest::testConstraints(interactive) $::tcl_interactive
+ } else {
+ set ::tcltest::testConstraints(interactive) 0
+ }
+
+ # Some tests can only be run if the installation came from a CD image
+ # instead of a web image
+ # Some tests must be skipped if you are running as root on Unix.
+ # Other tests can only be run if you are running as root on Unix.
+
+ set ::tcltest::testConstraints(root) 0
+ set ::tcltest::testConstraints(notRoot) 1
+ set user {}
+ if {[string equal $tcl_platform(platform) "unix"]} {
+ catch {set user [exec whoami]}
+ if {[string equal $user ""]} {
+ catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+ }
+ if {([string equal $user "root"]) || ([string equal $user ""])} {
+ set ::tcltest::testConstraints(root) 1
+ set ::tcltest::testConstraints(notRoot) 0
+ }
+ }
+
+ # Set nonBlockFiles constraint: 1 means this platform supports
+ # setting files into nonblocking mode.
+
+ if {[catch {set f [open defs r]}]} {
+ set ::tcltest::testConstraints(nonBlockFiles) 1
+ } else {
+ if {[catch {fconfigure $f -blocking off}] == 0} {
+ set ::tcltest::testConstraints(nonBlockFiles) 1
+ } else {
+ set ::tcltest::testConstraints(nonBlockFiles) 0
+ }
+ close $f
+ }
+
+ # Set asyncPipeClose constraint: 1 means this platform supports
+ # async flush and async close on a pipe.
+ #
+ # Test for SCO Unix - cannot run async flushing tests because a
+ # potential problem with select is apparently interfering.
+ # (Mark Diekhans).
+
+ if {[string equal $tcl_platform(platform) "unix"]} {
+ if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
+ set ::tcltest::testConstraints(asyncPipeClose) 0
+ } else {
+ set ::tcltest::testConstraints(asyncPipeClose) 1
+ }
+ } else {
+ set ::tcltest::testConstraints(asyncPipeClose) 1
+ }
+
+ # Test to see if we have a broken version of sprintf with respect
+ # to the "e" format of floating-point numbers.
+
+ set ::tcltest::testConstraints(eformat) 1
+ if {![string equal "[format %g 5e-5]" "5e-05"]} {
+ set ::tcltest::testConstraints(eformat) 0
+ }
+
+ # Test to see if execed commands such as cat, echo, rm and so forth are
+ # present on this machine.
+
+ set ::tcltest::testConstraints(unixExecs) 1
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([string equal $tcl_platform(platform) "windows"])} {
+ if {[catch {exec cat defs}] == 1} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([catch {exec echo hello}] == 1)} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([catch {exec sh -c echo hello}] == 1)} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([catch {exec wc defs}] == 1)} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ if {$::tcltest::testConstraints(unixExecs) == 1} {
+ exec echo hello > removeMe
+ if {[catch {exec rm removeMe}] == 1} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([catch {exec sleep 1}] == 1)} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([catch {exec fgrep unixExecs defs}] == 1)} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([catch {exec ps}] == 1)} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([catch {exec echo abc > removeMe}] == 0) && \
+ ([catch {exec chmod 644 removeMe}] == 1) && \
+ ([catch {exec rm removeMe}] == 0)} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ } else {
+ catch {exec rm -f removeMe}
+ }
+ if {($::tcltest::testConstraints(unixExecs) == 1) && \
+ ([catch {exec mkdir removeMe}] == 1)} {
+ set ::tcltest::testConstraints(unixExecs) 0
+ } else {
+ catch {exec rm -r removeMe}
+ }
+ }
+
+ # Locate tcltest executable
+
+ if {![info exists tk_version]} {
+ set tcltest [info nameofexecutable]
+
+ if {$tcltest == "{}"} {
+ set tcltest {}
+ }
+ }
+
+ set ::tcltest::testConstraints(stdio) 0
+ catch {
+ catch {file delete -force tmp}
+ set f [open tmp w]
+ puts $f {
+ exit
+ }
+ close $f
+
+ set f [open "|[list $tcltest tmp]" r]
+ close $f
+
+ set ::tcltest::testConstraints(stdio) 1
+ }
+ catch {file delete -force tmp}
+
+ # Deliberately call socket with the wrong number of arguments. The error
+ # message you get will indicate whether sockets are available on this
+ # system.
+
+ catch {socket} msg
+ set ::tcltest::testConstraints(socket) \
+ [expr {$msg != "sockets are not available on this system"}]
+
+ # Check for internationalization
+
+ if {[info commands testlocale] == ""} {
+ # No testlocale command, no tests...
+ set ::tcltest::testConstraints(hasIsoLocale) 0
+ } else {
+ set ::tcltest::testConstraints(hasIsoLocale) \
+ [string length [::tcltest::set_iso8859_1_locale]]
+ ::tcltest::restore_locale
+ }
+}
+
+# ::tcltest::PrintUsageInfoHook
+#
+# Hook used for customization of display of usage information.
+#
+
+if {[namespace inscope ::tcltest info procs PrintUsageInfoHook] == {}} {
+ proc ::tcltest::PrintUsageInfoHook {} {}
+}
+
+# ::tcltest::PrintUsageInfo
+#
+# Prints out the usage information for package tcltest. This can be
+# customized with the redefinition of ::tcltest::PrintUsageInfoHook.
+#
+# Arguments:
+# none
+#
+
+proc ::tcltest::PrintUsageInfo {} {
+ puts [format "Usage: [file tail [info nameofexecutable]] \
+ script ?-help? ?flag value? ... \n\
+ Available flags (and valid input values) are: \n\
+ -help \t Display this usage information. \n\
+ -verbose level \t Takes any combination of the values \n\
+ \t 'p', 's' and 'b'. Test suite will \n\
+ \t display all passed tests if 'p' is \n\
+ \t specified, all skipped tests if 's' \n\
+ \t is specified, and the bodies of \n\
+ \t failed tests if 'b' is specified. \n\
+ \t The default value is 'b'. \n\
+ -constraints list\t Do not skip the listed constraints\n\
+ -limitconstraints bool\t Only run tests with the constraints\n\
+ \t listed in -constraints.\n\
+ -match pattern \t Run all tests within the specified \n\
+ \t files that match the glob pattern \n\
+ \t given. \n\
+ -skip pattern \t Skip all tests within the set of \n\
+ \t specified tests (via -match) and \n\
+ \t files that match the glob pattern \n\
+ \t given. \n\
+ -file pattern \t Run tests in all test files that \n\
+ \t match the glob pattern given. \n\
+ -notfile pattern\t Skip all test files that match the \n\
+ \t glob pattern given. \n\
+ -preservecore level \t If 2, save any core files produced \n\
+ \t during testing in the directory \n\
+ \t specified by -tmpdir. If 1, notify the\n\
+ \t user if core files are created. The default \n\
+ \t is $::tcltest::preserveCore. \n\
+ -tmpdir directory\t Save temporary files in the specified\n\
+ \t directory. The default value is \n\
+ \t $::tcltest::temporaryDirectory. \n\
+ -testdir directories\t Search tests in the specified\n\
+ \t directories. The default value is \n\
+ \t $::tcltest::testsDirectory. \n\
+ -outfile file \t Send output from test runs to the \n\
+ \t specified file. The default is \n\
+ \t stdout. \n\
+ -errfile file \t Send errors from test runs to the \n\
+ \t specified file. The default is \n\
+ \t stderr. \n\
+ -loadfile file \t Read the script to load the tested \n\
+ \t commands from the specified file. \n\
+ -load script \t Specifies the script to load the tested \n\
+ \t commands. \n\
+ -debug level \t Internal debug flag."]
+ ::tcltest::PrintUsageInfoHook
+ return
+}
+
+# ::tcltest::CheckDirectory --
+#
+# This procedure checks whether the specified path is a readable
+# and/or writable directory. If one of the conditions is not
+# satisfied an error is printed and the application aborted. The
+# procedure assumes that the caller already checked the existence
+# of the path.
+#
+# Arguments
+# rw Information what attributes to check. Allowed values:
+# r, w, rw, wr. If 'r' is part of the value the directory
+# must be readable. 'w' associates to 'writable'.
+# dir The directory to check.
+# errMsg The string to prepend to the actual error message before
+# printing it.
+#
+# Results
+# none
+#
+
+proc ::tcltest::CheckDirectory {rw dir errMsg} {
+ # Allowed values for 'rw': r, w, rw, wr
+
+ if {![file isdir $dir]} {
+ ::tcltest::PrintError "$errMsg \"$dir\" is not a directory"
+ exit 1
+ } elseif {([string first w $rw] >= 0) && ![file writable $dir]} {
+ ::tcltest::PrintError "$errMsg \"$dir\" is not writeable"
+ exit 1
+ } elseif {([string first r $rw] >= 0) && ![file readable $dir]} {
+ ::tcltest::PrintError "$errMsg \"$dir\" is not readable"
+ exit 1
+ }
+}
+
+# ::tcltest::normalizePath --
+#
+# This procedure resolves any symlinks in the path thus creating a
+# path without internal redirection. It assumes that the incoming
+# path is absolute.
+#
+# Arguments
+# pathVar contains the name of the variable containing the path to modify.
+#
+# Results
+# The path is modified in place.
+#
+
+proc ::tcltest::normalizePath {pathVar} {
+ upvar $pathVar path
+
+ set oldpwd [pwd]
+ catch {cd $path}
+ set path [pwd]
+ cd $oldpwd
+}
+
+# ::tcltest::MakeAbsolutePath --
+#
+# This procedure checks whether the incoming path is absolute or not.
+# Makes it absolute if it was not.
+#
+# Arguments
+# pathVar contains the name of the variable containing the path to modify.
+# prefix is optional, contains the path to use to make the other an
+# absolute one. The current working directory is used if it was
+# not specified.
+#
+# Results
+# The path is modified in place.
+#
+
+proc ::tcltest::MakeAbsolutePath {pathVar {prefix {}}} {
+ upvar $pathVar path
+
+ if {![string equal [file pathtype $path] "absolute"]} {
+ if {$prefix == {}} {
+ set prefix [pwd]
+ }
+
+ set path [file join $prefix $path]
+ }
+}
+
+# ::tcltest::processCmdLineArgsFlagsHook --
+#
+# This hook is used to add to the list of command line arguments that are
+# processed by ::tcltest::processCmdLineArgs.
+#
+
+if {[namespace inscope ::tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
+ proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+}
+
+# ::tcltest::processCmdLineArgsHook --
+#
+# This hook is used to actually process the flags added by
+# ::tcltest::processCmdLineArgsAddFlagsHook.
+#
+# Arguments:
+# flags The flags that have been pulled out of argv
+#
+
+if {[namespace inscope ::tcltest info procs processCmdLineArgsHook] == {}} {
+ proc ::tcltest::processCmdLineArgsHook {flag} {}
+}
+
+# ::tcltest::processCmdLineArgs --
+#
+# Use command line args to set the verbose, skip, and
+# match, outputChannel, errorChannel, debug, and temporaryDirectory
+# variables.
+#
+# This procedure must be run after constraints are initialized, because
+# some constraints can be overridden.
+#
+# Arguments:
+# none
+#
+# Results:
+# Sets the above-named variables in the tcltest namespace.
+
+proc ::tcltest::processCmdLineArgs {} {
+ global argv
+
+ # The "argv" var doesn't exist in some cases, so use {}.
+
+ if {(![info exists argv]) || ([llength $argv] < 1)} {
+ set flagArray {}
+ } else {
+ set flagArray $argv
+ }
+
+ # Allow for 1-char abbreviations, where applicable (e.g., -match == -m).
+ # Note that -verbose cannot be abbreviated to -v in wish because it
+ # conflicts with the wish option -visual.
+
+ # Process -help first
+ if {([lsearch -exact $flagArray {-help}] != -1) || \
+ ([lsearch -exact $flagArray {-h}] != -1)} {
+ ::tcltest::PrintUsageInfo
+ exit 1
+ }
+
+ if {[catch {array set flag $flagArray}]} {
+ ::tcltest::PrintError "odd number of arguments specified on command line: \
+ $argv"
+ ::tcltest::PrintUsageInfo
+ exit 1
+ }
+
+ # -help is not listed since it has already been processed
+ lappend defaultFlags -verbose -match -skip -constraints \
+ -outfile -errfile -debug -tmpdir -file -notfile \
+ -preservecore -limitconstraints -args -testdir \
+ -load -loadfile
+ set defaultFlags [concat $defaultFlags \
+ [ ::tcltest::processCmdLineArgsAddFlagsHook ]]
+
+ foreach arg $defaultFlags {
+ set abbrev [string range $arg 0 1]
+ if {([info exists flag($abbrev)]) && \
+ ([lsearch -exact $flagArray $arg] < [lsearch -exact \
+ $flagArray $abbrev])} {
+ set flag($arg) $flag($abbrev)
+ }
+ }
+
+ # Set ::tcltest::parameters to the arg of the -args flag, if given
+ if {[info exists flag(-args)]} {
+ set ::tcltest::parameters $flag(-args)
+ }
+
+ # Set ::tcltest::verbose to the arg of the -verbose flag, if given
+
+ if {[info exists flag(-verbose)]} {
+ set ::tcltest::verbose $flag(-verbose)
+ }
+
+ # Set ::tcltest::match to the arg of the -match flag, if given.
+
+ if {[info exists flag(-match)]} {
+ set ::tcltest::match $flag(-match)
+ }
+
+ # Set ::tcltest::skip to the arg of the -skip flag, if given
+
+ if {[info exists flag(-skip)]} {
+ set ::tcltest::skip $flag(-skip)
+ }
+
+ # Handle the -file and -notfile flags
+ if {[info exists flag(-file)]} {
+ set ::tcltest::matchFiles $flag(-file)
+ }
+ if {[info exists flag(-notfile)]} {
+ set ::tcltest::skipFiles $flag(-notfile)
+ }
+
+ # Use the -constraints flag, if given, to turn on constraints that are
+ # turned off by default: userInteractive knownBug nonPortable. This
+ # code fragment must be run after constraints are initialized.
+
+ if {[info exists flag(-constraints)]} {
+ foreach elt $flag(-constraints) {
+ set ::tcltest::testConstraints($elt) 1
+ }
+ }
+
+ # Use the -limitconstraints flag, if given, to tell the harness to limit
+ # tests run to those that were specified using the -constraints flag. If
+ # the -constraints flag was not specified, print out an error and exit.
+ if {[info exists flag(-limitconstraints)]} {
+ if {![info exists flag(-constraints)]} {
+ puts "You can only use the -limitconstraints flag with \
+ -constraints"
+ exit 1
+ }
+ set ::tcltest::limitConstraints $flag(-limitconstraints)
+ foreach elt [array names ::tcltest::testConstraints] {
+ if {[lsearch -exact $flag(-constraints) $elt] == -1} {
+ set ::tcltest::testConstraints($elt) 0
+ }
+ }
+ }
+
+ # Set the ::tcltest::temporaryDirectory to the arg of -tmpdir, if
+ # given.
+ #
+ # If the path is relative, make it absolute. If the file exists but
+ # is not a dir, then return an error.
+ #
+ # If ::tcltest::temporaryDirectory does not already exist, create it.
+ # If you cannot create it, then return an error.
+
+ set tmpDirError ""
+ if {[info exists flag(-tmpdir)]} {
+ set ::tcltest::temporaryDirectory $flag(-tmpdir)
+
+ MakeAbsolutePath ::tcltest::temporaryDirectory
+ set tmpDirError "bad argument \"$flag(-tmpdir)\" to -tmpdir: "
+ }
+ if {[file exists $::tcltest::temporaryDirectory]} {
+ ::tcltest::CheckDirectory rw $::tcltest::temporaryDirectory $tmpDirError
+ } else {
+ file mkdir $::tcltest::temporaryDirectory
+ }
+
+ normalizePath ::tcltest::temporaryDirectory
+
+ # Set the ::tcltest::testsDirectory to the arg of -testdir, if
+ # given.
+ #
+ # If the path is relative, make it absolute. If the file exists but
+ # is not a dir, then return an error.
+ #
+ # If ::tcltest::temporaryDirectory does not already exist return an error.
+
+ set testDirError ""
+ if {[info exists flag(-testdir)]} {
+ set ::tcltest::testsDirectory $flag(-testdir)
+
+ MakeAbsolutePath ::tcltest::testsDirectory
+ set testDirError "bad argument \"$flag(-testdir)\" to -testdir: "
+ }
+ if {[file exists $::tcltest::testsDirectory]} {
+ ::tcltest::CheckDirectory r $::tcltest::testsDirectory $testDirError
+ } else {
+ ::tcltest::PrintError "$testDirError \"$::tcltest::testsDirectory\" \
+ does not exist"
+ exit 1
+ }
+
+ normalizePath ::tcltest::testsDirectory
+
+ # Save the names of files that already exist in
+ # the output directory.
+ foreach file [glob -nocomplain \
+ [file join $::tcltest::temporaryDirectory *]] {
+ lappend ::tcltest::filesExisted [file tail $file]
+ }
+
+ # If an alternate error or output files are specified, change the
+ # default channels.
+
+ if {[info exists flag(-outfile)]} {
+ set tmp $flag(-outfile)
+ MakeAbsolutePath tmp $::tcltest::temporaryDirectory
+ set ::tcltest::outputChannel [open $tmp w]
+ }
+
+ if {[info exists flag(-errfile)]} {
+ set tmp $flag(-errfile)
+ MakeAbsolutePath tmp $::tcltest::temporaryDirectory
+ set ::tcltest::errorChannel [open $tmp w]
+ }
+
+ # If a load script was specified, either directly or through
+ # a file, remember it for later usage.
+
+ if {[info exists flag(-load)] && \
+ ([lsearch -exact $flagArray -load] > \
+ [lsearch -exact $flagArray -loadfile])} {
+ set ::tcltest::loadScript $flag(-load)
+ }
+
+ if {[info exists flag(-loadfile)] && \
+ ([lsearch -exact $flagArray -loadfile] > \
+ [lsearch -exact $flagArray -load]) } {
+ set tmp $flag(-loadfile)
+ MakeAbsolutePath tmp $::tcltest::temporaryDirectory
+ set tmp [open $tmp r]
+ set ::tcltest::loadScript [read $tmp]
+ close $tmp
+ }
+
+ # If the user specifies debug testing, print out extra information during
+ # the run.
+ if {[info exists flag(-debug)]} {
+ set ::tcltest::debug $flag(-debug)
+ }
+
+ # Handle -preservecore
+ if {[info exists flag(-preservecore)]} {
+ set ::tcltest::preserveCore $flag(-preservecore)
+ }
+
+ # Call the hook
+ ::tcltest::processCmdLineArgsHook [array get flag]
+
+ # Spit out everything you know if we're at a debug level 2 or greater
+
+ DebugPuts 2 "Flags passed into tcltest:"
+ DebugPArray 2 flag
+ DebugPuts 2 "::tcltest::debug = $::tcltest::debug"
+ DebugPuts 2 "::tcltest::testsDirectory = $::tcltest::testsDirectory"
+ DebugPuts 2 "::tcltest::workingDirectory = $::tcltest::workingDirectory"
+ DebugPuts 2 "::tcltest::temporaryDirectory = $::tcltest::temporaryDirectory"
+ DebugPuts 2 "::tcltest::outputChannel = $::tcltest::outputChannel"
+ DebugPuts 2 "::tcltest::errorChannel = $::tcltest::errorChannel"
+ DebugPuts 2 "Original environment (::tcltest::originalEnv):"
+ DebugPArray 2 ::tcltest::originalEnv
+ DebugPuts 2 "Constraints:"
+ DebugPArray 2 ::tcltest::testConstraints
+}
+
+# ::tcltest::loadTestedCommands --
+#
+# Uses the specified script to load the commands to test. Allowed to
+# be empty, as the tested commands could have been compiled into the
+# interpreter.
+#
+# Arguments
+# none
+#
+# Results
+# none
+
+proc ::tcltest::loadTestedCommands {} {
+ if {$::tcltest::loadScript == {}} {
+ return
+ }
+
+ uplevel #0 $::tcltest::loadScript
+}
+
+# ::tcltest::cleanupTests --
+#
+# Remove files and dirs created using the makeFile and makeDirectory
+# commands since the last time this proc was invoked.
+#
+# Print the names of the files created without the makeFile command
+# since the tests were invoked.
+#
+# Print the number tests (total, passed, failed, and skipped) since the
+# tests were invoked.
+#
+# Restore original environment (as reported by special variable env).
+
+proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
+
+ set testFileName [file tail [info script]]
+
+ # Call the cleanup hook
+ ::tcltest::cleanupTestsHook
+
+ # Remove files and directories created by the :tcltest::makeFile and
+ # ::tcltest::makeDirectory procedures.
+ # Record the names of files in ::tcltest::workingDirectory that were not
+ # pre-existing, and associate them with the test file that created them.
+
+ if {!$calledFromAllFile} {
+ foreach file $::tcltest::filesMade {
+ if {[file exists $file]} {
+ catch {file delete -force $file}
+ }
+ }
+ set currentFiles {}
+ foreach file [glob -nocomplain \
+ [file join $::tcltest::temporaryDirectory *]] {
+ lappend currentFiles [file tail $file]
+ }
+ set newFiles {}
+ foreach file $currentFiles {
+ if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
+ lappend newFiles $file
+ }
+ }
+ set ::tcltest::filesExisted $currentFiles
+ if {[llength $newFiles] > 0} {
+ set ::tcltest::createdNewFiles($testFileName) $newFiles
+ }
+ }
+
+ if {$calledFromAllFile || $::tcltest::testSingleFile} {
+
+ # print stats
+
+ puts -nonewline $::tcltest::outputChannel "$testFileName:"
+ foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+ puts -nonewline $::tcltest::outputChannel \
+ "\t$index\t$::tcltest::numTests($index)"
+ }
+ puts $::tcltest::outputChannel ""
+
+ # print number test files sourced
+ # print names of files that ran tests which failed
+
+ if {$calledFromAllFile} {
+ puts $::tcltest::outputChannel \
+ "Sourced $::tcltest::numTestFiles Test Files."
+ set ::tcltest::numTestFiles 0
+ if {[llength $::tcltest::failFiles] > 0} {
+ puts $::tcltest::outputChannel \
+ "Files with failing tests: $::tcltest::failFiles"
+ set ::tcltest::failFiles {}
+ }
+ }
+
+ # if any tests were skipped, print the constraints that kept them
+ # from running.
+
+ set constraintList [array names ::tcltest::skippedBecause]
+ if {[llength $constraintList] > 0} {
+ puts $::tcltest::outputChannel \
+ "Number of tests skipped for each constraint:"
+ foreach constraint [lsort $constraintList] {
+ puts $::tcltest::outputChannel \
+ "\t$::tcltest::skippedBecause($constraint)\t$constraint"
+ unset ::tcltest::skippedBecause($constraint)
+ }
+ }
+
+ # report the names of test files in ::tcltest::createdNewFiles, and
+ # reset the array to be empty.
+
+ set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]]
+ if {[llength $testFilesThatTurded] > 0} {
+ puts $::tcltest::outputChannel "Warning: files left behind:"
+ foreach testFile $testFilesThatTurded {
+ puts $::tcltest::outputChannel \
+ "\t$testFile:\t$::tcltest::createdNewFiles($testFile)"
+ unset ::tcltest::createdNewFiles($testFile)
+ }
+ }
+
+ # reset filesMade, filesExisted, and numTests
+
+ set ::tcltest::filesMade {}
+ foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+ set ::tcltest::numTests($index) 0
+ }
+
+ # exit only if running Tk in non-interactive mode
+
+ global tk_version tcl_interactive
+ if {[info exists tk_version] && ![info exists tcl_interactive]} {
+ exit
+ }
+ } else {
+
+ # if we're deferring stat-reporting until all files are sourced,
+ # then add current file to failFile list if any tests in this file
+ # failed
+
+ incr ::tcltest::numTestFiles
+ if {($::tcltest::currentFailure) && \
+ ([lsearch -exact $::tcltest::failFiles $testFileName] == -1)} {
+ lappend ::tcltest::failFiles $testFileName
+ }
+ set ::tcltest::currentFailure false
+
+ # restore the environment to the state it was in before this package
+ # was loaded
+
+ set newEnv {}
+ set changedEnv {}
+ set removedEnv {}
+ foreach index [array names ::env] {
+ if {![info exists ::tcltest::originalEnv($index)]} {
+ lappend newEnv $index
+ unset ::env($index)
+ } else {
+ if {$::env($index) != $::tcltest::originalEnv($index)} {
+ lappend changedEnv $index
+ set ::env($index) $::tcltest::originalEnv($index)
+ }
+ }
+ }
+ foreach index [array names ::tcltest::originalEnv] {
+ if {![info exists ::env($index)]} {
+ lappend removedEnv $index
+ set ::env($index) $::tcltest::originalEnv($index)
+ }
+ }
+ if {[llength $newEnv] > 0} {
+ puts $::tcltest::outputChannel \
+ "env array elements created:\t$newEnv"
+ }
+ if {[llength $changedEnv] > 0} {
+ puts $::tcltest::outputChannel \
+ "env array elements changed:\t$changedEnv"
+ }
+ if {[llength $removedEnv] > 0} {
+ puts $::tcltest::outputChannel \
+ "env array elements removed:\t$removedEnv"
+ }
+
+ set changedTclPlatform {}
+ foreach index [array names ::tcltest::originalTclPlatform] {
+ if {$::tcl_platform($index) != \
+ $::tcltest::originalTclPlatform($index)} {
+ lappend changedTclPlatform $index
+ set ::tcl_platform($index) \
+ $::tcltest::originalTclPlatform($index)
+ }
+ }
+ if {[llength $changedTclPlatform] > 0} {
+ puts $::tcltest::outputChannel \
+ "tcl_platform array elements changed:\t$changedTclPlatform"
+ }
+
+ if {[file exists [file join $::tcltest::workingDirectory core]]} {
+ if {$::tcltest::preserveCore > 1} {
+ puts $::tcltest::outputChannel "produced core file! \
+ Moving file to: \
+ [file join $::tcltest::temporaryDirectory core-$name]"
+ flush $::tcltest::outputChannel
+ catch {file rename -force \
+ [file join $::tcltest::workingDirectory core] \
+ [file join $::tcltest::temporaryDirectory \
+ core-$name]} msg
+ if {[string length $msg] > 0} {
+ ::tcltest::PrintError "Problem renaming file: $msg"
+ }
+ } else {
+ # Print a message if there is a core file and (1) there
+ # previously wasn't one or (2) the new one is different from
+ # the old one.
+
+ if {[info exists ::tcltest::coreModificationTime]} {
+ if {$::tcltest::coreModificationTime != [file mtime \
+ [file join $::tcltest::workingDirectory core]]} {
+ puts $::tcltest::outputChannel "A core file was created!"
+ }
+ } else {
+ puts $::tcltest::outputChannel "A core file was created!"
+ }
+ }
+ }
+ }
+}
+
+# ::tcltest::cleanupTestsHook --
+#
+# This hook allows a harness that builds upon tcltest to specify
+# additional things that should be done at cleanup.
+#
+
+if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
+ proc ::tcltest::cleanupTestsHook {} {}
+}
+
+# test --
+#
+# This procedure runs a test and prints an error message if the test fails.
+# If ::tcltest::verbose has been set, it also prints a message even if the
+# test succeeds. The test will be skipped if it doesn't match the
+# ::tcltest::match variable, if it matches an element in
+# ::tcltest::skip, or if one of the elements of "constraints" turns
+# out not to be true.
+#
+# Arguments:
+# name - Name of test, in the form foo-1.2.
+# description - Short textual description of the test, to
+# help humans understand what it does.
+# constraints - A list of one or more keywords, each of
+# which must be the name of an element in
+# the array "::tcltest::testConstraints". If any of these
+# elements is zero, the test is skipped.
+# This argument may be omitted.
+# script - Script to run to carry out the test. It must
+# return a result that can be checked for
+# correctness.
+# expectedAnswer - Expected result from script.
+
+proc ::tcltest::test {name description script expectedAnswer args} {
+
+ DebugPuts 3 "Running $name ($description)"
+
+ incr ::tcltest::numTests(Total)
+
+ # skip the test if it's name matches an element of skip
+
+ foreach pattern $::tcltest::skip {
+ if {[string match $pattern $name]} {
+ incr ::tcltest::numTests(Skipped)
+ DebugDo 1 {::tcltest::AddToSkippedBecause userSpecifiedSkip}
+ return
+ }
+ }
+
+ # skip the test if it's name doesn't match any element of match
+
+ if {[llength $::tcltest::match] > 0} {
+ set ok 0
+ foreach pattern $::tcltest::match {
+ if {[string match $pattern $name]} {
+ set ok 1
+ break
+ }
+ }
+ if {!$ok} {
+ incr ::tcltest::numTests(Skipped)
+ DebugDo 1 {::tcltest::AddToSkippedBecause userSpecifiedNonMatch}
+ return
+ }
+ }
+
+ set i [llength $args]
+ if {$i == 0} {
+ set constraints {}
+ # If we're limited to the listed constraints and there aren't any
+ # listed, then we shouldn't run the test.
+ if {$::tcltest::limitConstraints} {
+ ::tcltest::AddToSkippedBecause userSpecifiedLimitConstraint
+ incr ::tcltest::numTests(Skipped)
+ return
+ }
+ } elseif {$i == 1} {
+
+ # "constraints" argument exists; shuffle arguments down, then
+ # make sure that the constraints are satisfied.
+
+ set constraints $script
+ set script $expectedAnswer
+ set expectedAnswer [lindex $args 0]
+ set doTest 0
+ if {[string match {*[$\[]*} $constraints] != 0} {
+ # full expression, e.g. {$foo > [info tclversion]}
+ catch {set doTest [uplevel #0 expr $constraints]}
+ } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
+ # something like {a || b} should be turned into
+ # $::tcltest::testConstraints(a) || $::tcltest::testConstraints(b).
+ regsub -all {[.\w]+} $constraints \
+ {$::tcltest::testConstraints(&)} c
+ catch {set doTest [eval expr $c]}
+ } else {
+ # just simple constraints such as {unixOnly fonts}.
+ set doTest 1
+ foreach constraint $constraints {
+ if {(![info exists ::tcltest::testConstraints($constraint)]) \
+ || (!$::tcltest::testConstraints($constraint))} {
+ set doTest 0
+
+ # store the constraint that kept the test from running
+ set constraints $constraint
+ break
+ }
+ }
+ }
+ if {$doTest == 0} {
+ if {[string first s $::tcltest::verbose] != -1} {
+ puts $::tcltest::outputChannel "++++ $name SKIPPED: $constraints"
+ }
+
+ incr ::tcltest::numTests(Skipped)
+ ::tcltest::AddToSkippedBecause $constraints
+ return
+ }
+ } else {
+ error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\""
+ }
+
+ # Save information about the core file. You need to restore the original
+ # tcl_platform environment because some of the tests mess with tcl_platform.
+
+ if {$::tcltest::preserveCore} {
+ set currentTclPlatform [array get tcl_platform]
+ array set tcl_platform $::tcltest::originalTclPlatform
+ if {[file exists [file join $::tcltest::workingDirectory core]]} {
+ set coreModTime [file mtime [file join \
+ $::tcltest::workingDirectory core]]
+ }
+ array set tcl_platform $currentTclPlatform
+ }
+
+ # If there is no "memory" command (because memory debugging isn't
+ # enabled), then don't attempt to use the command.
+
+ if {[info commands memory] != {}} {
+ memory tag $name
+ }
+
+ set code [catch {uplevel $script} actualAnswer]
+ if {([string equal $actualAnswer $expectedAnswer]) && ($code == 0)} {
+ incr ::tcltest::numTests(Passed)
+ if {[string first p $::tcltest::verbose] != -1} {
+ puts $::tcltest::outputChannel "++++ $name PASSED"
+ }
+ } else {
+ incr ::tcltest::numTests(Failed)
+ set ::tcltest::currentFailure true
+ if {[string first b $::tcltest::verbose] == -1} {
+ set script ""
+ }
+ puts $::tcltest::outputChannel "\n==== $name $description FAILED"
+ if {$script != ""} {
+ puts $::tcltest::outputChannel "==== Contents of test case:"
+ puts $::tcltest::outputChannel $script
+ }
+ if {$code != 0} {
+ if {$code == 1} {
+ puts $::tcltest::outputChannel "==== Test generated error:"
+ puts $::tcltest::outputChannel $actualAnswer
+ } elseif {$code == 2} {
+ puts $::tcltest::outputChannel "==== Test generated return exception; result was:"
+ puts $::tcltest::outputChannel $actualAnswer
+ } elseif {$code == 3} {
+ puts $::tcltest::outputChannel "==== Test generated break exception"
+ } elseif {$code == 4} {
+ puts $::tcltest::outputChannel "==== Test generated continue exception"
+ } else {
+ puts $::tcltest::outputChannel "==== Test generated exception $code; message was:"
+ puts $::tcltest::outputChannel $actualAnswer
+ }
+ } else {
+ puts $::tcltest::outputChannel "---- Result was:\n$actualAnswer"
+ }
+ puts $::tcltest::outputChannel "---- Result should have been:\n$expectedAnswer"
+ puts $::tcltest::outputChannel "==== $name FAILED\n"
+ }
+ if {$::tcltest::preserveCore} {
+ set currentTclPlatform [array get tcl_platform]
+ if {[file exists [file join $::tcltest::workingDirectory core]]} {
+ if {$::tcltest::preserveCore > 1} {
+ puts $::tcltest::outputChannel "==== $name produced core file! \
+ Moving file to: \
+ [file join $::tcltest::temporaryDirectory core-$name]"
+ catch {file rename -force \
+ [file join $::tcltest::workingDirectory core] \
+ [file join $::tcltest::temporaryDirectory \
+ core-$name]} msg
+ if {[string length $msg] > 0} {
+ ::tcltest::PrintError "Problem renaming file: $msg"
+ }
+ } else {
+ # Print a message if there is a core file and (1) there
+ # previously wasn't one or (2) the new one is different from
+ # the old one.
+
+ if {[info exists coreModTime]} {
+ if {$coreModTime != [file mtime \
+ [file join $::tcltest::workingDirectory core]]} {
+ puts $::tcltest::outputChannel "==== $name produced core file!"
+ }
+ } else {
+ puts $::tcltest::outputChannel "==== $name produced core file!"
+ }
+ }
+ }
+ array set tcl_platform $currentTclPlatform
+ }
+}
+
+# ::tcltest::getMatchingFiles
+#
+# Looks at the patterns given to match and skip files
+# and uses them to put together a list of the tests that will be run.
+#
+# Arguments:
+# none
+#
+# Results:
+# The constructed list is returned to the user. This will primarily
+# be used in 'all.tcl' files.
+
+proc ::tcltest::getMatchingFiles {args} {
+ set matchingFiles {}
+ if {[llength $args]} {
+ set searchDirectory $args
+ } else {
+ set searchDirectory [list $::tcltest::testsDirectory]
+ }
+ # Find the matching files in the list of directories and then remove the
+ # ones that match the skip pattern
+ foreach directory $searchDirectory {
+ set matchFileList {}
+ foreach match $::tcltest::matchFiles {
+ set matchFileList [concat $matchFileList \
+ [glob -nocomplain [file join $directory $match]]]
+ }
+ if {[string compare {} $::tcltest::skipFiles]} {
+ set skipFileList {}
+ foreach skip $::tcltest::skipFiles {
+ set skipFileList [concat $skipFileList \
+ [glob -nocomplain [file join $directory $skip]]]
+ }
+ foreach file $matchFileList {
+ # Only include files that don't match the skip pattern and
+ # aren't SCCS lock files.
+ if {([lsearch -exact $skipFileList $file] == -1) && \
+ (![string match l.*.test [file tail $file]])} {
+ lappend matchingFiles $file
+ }
+ }
+ } else {
+ set matchingFiles [concat $matchingFiles $matchFileList]
+ }
+ }
+ if {[string equal $matchingFiles {}]} {
+ ::tcltest::PrintError "No test files remain after applying \
+ your match and skip patterns!"
+ }
+ return $matchingFiles
+}
+
+# The following two procs are used in the io tests.
+
+proc ::tcltest::openfiles {} {
+ if {[catch {testchannel open} result]} {
+ return {}
+ }
+ return $result
+}
+
+proc ::tcltest::leakfiles {old} {
+ if {[catch {testchannel open} new]} {
+ return {}
+ }
+ set leak {}
+ foreach p $new {
+ if {[lsearch $old $p] < 0} {
+ lappend leak $p
+ }
+ }
+ return $leak
+}
+
+# ::tcltest::saveState --
+#
+# Save information regarding what procs and variables exist.
+#
+# Arguments:
+# none
+#
+# Results:
+# Modifies the variable ::tcltest::saveState
+
+proc ::tcltest::saveState {} {
+ uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]}
+ DebugPuts 2 "::tcltest::saveState: $::tcltest::saveState"
+}
+
+# ::tcltest::restoreState --
+#
+# Remove procs and variables that didn't exist before the call to
+# ::tcltest::saveState.
+#
+# Arguments:
+# none
+#
+# Results:
+# Removes procs and variables from your environment if they don't exist
+# in the ::tcltest::saveState variable.
+
+proc ::tcltest::restoreState {} {
+ foreach p [info procs] {
+ if {([lsearch [lindex $::tcltest::saveState 0] $p] < 0) && \
+ (![string equal ::tcltest::$p [namespace origin $p]])} {
+
+ DebugPuts 3 "::tcltest::restoreState: Removing proc $p"
+ rename $p {}
+ }
+ }
+ foreach p [uplevel #0 {info vars}] {
+ if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} {
+ DebugPuts 3 "::tcltest::restoreState: Removing variable $p"
+ uplevel #0 "catch {unset $p}"
+ }
+ }
+}
+
+# ::tcltest::normalizeMsg --
+#
+# Removes "extra" newlines from a string.
+#
+# Arguments:
+# msg String to be modified
+#
+
+proc ::tcltest::normalizeMsg {msg} {
+ regsub "\n$" [string tolower $msg] "" msg
+ regsub -all "\n\n" $msg "\n" msg
+ regsub -all "\n\}" $msg "\}" msg
+ return $msg
+}
+
+# makeFile --
+#
+# Create a new file with the name <name>, and write <contents> to it.
+#
+# If this file hasn't been created via makeFile since the last time
+# cleanupTests was called, add it to the $filesMade list, so it will
+# be removed by the next call to cleanupTests.
+#
+proc ::tcltest::makeFile {contents name} {
+ global tcl_platform
+
+ DebugPuts 3 "::tcltest::makeFile: putting $contents into $name"
+
+ set fullName [file join $::tcltest::temporaryDirectory $name]
+ set fd [open $fullName w]
+
+ fconfigure $fd -translation lf
+
+ if {[string equal [string index $contents end] "\n"]} {
+ puts -nonewline $fd $contents
+ } else {
+ puts $fd $contents
+ }
+ close $fd
+
+ if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
+ lappend ::tcltest::filesMade $fullName
+ }
+ return $fullName
+}
+
+# ::tcltest::removeFile --
+#
+# Removes the named file from the filesystem
+#
+# Arguments:
+# name file to be removed
+#
+
+proc ::tcltest::removeFile {name} {
+ DebugPuts 3 "::tcltest::removeFile: removing $name"
+ file delete [file join $::tcltest::temporaryDirectory $name]
+}
+
+# makeDirectory --
+#
+# Create a new dir with the name <name>.
+#
+# If this dir hasn't been created via makeDirectory since the last time
+# cleanupTests was called, add it to the $directoriesMade list, so it will
+# be removed by the next call to cleanupTests.
+#
+proc ::tcltest::makeDirectory {name} {
+ file mkdir $name
+
+ set fullName [file join [pwd] $name]
+ if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
+ lappend ::tcltest::filesMade $fullName
+ }
+}
+
+# ::tcltest::removeDirectory --
+#
+# Removes a named directory from the file system.
+#
+# Arguments:
+# name Name of the directory to remove
+#
+
+proc ::tcltest::removeDirectory {name} {
+ file delete -force $name
+}
+
+proc ::tcltest::viewFile {name} {
+ global tcl_platform
+ if {([string equal $tcl_platform(platform) "macintosh"]) || \
+ ($::tcltest::testConstraints(unixExecs) == 0)} {
+ set f [open [file join $::tcltest::temporaryDirectory $name]]
+ set data [read -nonewline $f]
+ close $f
+ return $data
+ } else {
+ exec cat [file join $::tcltest::temporaryDirectory $name]
+ }
+}
+
+# grep --
+#
+# Evaluate a given expression against each element of a list and return all
+# elements for which the expression evaluates to true. For the purposes of
+# this proc, use of the keyword "CURRENT_ELEMENT" will flag the proc to use the
+# value of the current element within the expression. This is equivalent to
+# the perl grep command where CURRENT_ELEMENT would be the name for the special
+# variable $_.
+#
+# Examples of usage would be:
+# set subList [grep {CURRENT_ELEMENT == 1} $listOfNumbers]
+# set subList [grep {regexp {abc} CURRENT_ELEMENT} $listOfStrings]
+#
+# Use of the CURRENT_ELEMENT keyword is optional. If it is left out, it is
+# assumed to be the final argument to the expression provided.
+#
+# Example:
+# grep {regexp a} $someList
+#
+proc ::tcltest::grep { expression searchList } {
+ foreach element $searchList {
+ if {[regsub -all CURRENT_ELEMENT $expression $element \
+ newExpression] == 0} {
+ set newExpression "$expression {$element}"
+ }
+ if {[eval $newExpression] == 1} {
+ lappend returnList $element
+ }
+ }
+ if {[info exists returnList]} {
+ return $returnList
+ }
+ return
+}
+
+#
+# Construct a string that consists of the requested sequence of bytes,
+# as opposed to a string of properly formed UTF-8 characters.
+# This allows the tester to
+# 1. Create denormalized or improperly formed strings to pass to C procedures
+# that are supposed to accept strings with embedded NULL bytes.
+# 2. Confirm that a string result has a certain pattern of bytes, for instance
+# to confirm that "\xe0\0" in a Tcl script is stored internally in
+# UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
+#
+# Generally, it's a bad idea to examine the bytes in a Tcl string or to
+# construct improperly formed strings in this manner, because it involves
+# exposing that Tcl uses UTF-8 internally.
+
+proc ::tcltest::bytestring {string} {
+ encoding convertfrom identity $string
+}
+
+#
+# Internationalization / ISO support procs -- dl
+#
+proc ::tcltest::set_iso8859_1_locale {} {
+ if {[info commands testlocale] != ""} {
+ set ::tcltest::previousLocale [testlocale ctype]
+ testlocale ctype $::tcltest::isoLocale
+ }
+ return
+}
+
+proc ::tcltest::restore_locale {} {
+ if {[info commands testlocale] != ""} {
+ testlocale ctype $::tcltest::previousLocale
+ }
+ return
+}
+
+# threadReap --
+#
+# Kill all threads except for the main thread.
+# Do nothing if testthread is not defined.
+#
+# Arguments:
+# none.
+#
+# Results:
+# Returns the number of existing threads.
+proc ::tcltest::threadReap {} {
+ if {[info commands testthread] != {}} {
+
+ # testthread built into tcltest
+
+ testthread errorproc ThreadNullError
+ while {[llength [testthread names]] > 1} {
+ foreach tid [testthread names] {
+ if {$tid != $::tcltest::mainThread} {
+ catch {testthread send -async $tid {testthread exit}}
+ }
+ }
+ ## Enter a bit a sleep to give the threads enough breathing
+ ## room to kill themselves off, otherwise the end up with a
+ ## massive queue of repeated events
+ after 1
+ }
+ testthread errorproc ThreadError
+ return [llength [testthread names]]
+ } elseif {[info commands thread::id] != {}} {
+
+ # Thread extension
+
+ thread::errorproc ThreadNullError
+ while {[llength [thread::names]] > 1} {
+ foreach tid [thread::names] {
+ if {$tid != $::tcltest::mainThread} {
+ catch {thread::send -async $tid {thread::exit}}
+ }
+ }
+ ## Enter a bit a sleep to give the threads enough breathing
+ ## room to kill themselves off, otherwise the end up with a
+ ## massive queue of repeated events
+ after 1
+ }
+ thread::errorproc ThreadError
+ return [llength [thread::names]]
+ } else {
+ return 1
+ }
+}
+
+# Initialize the constraints and set up command line arguments
+namespace eval tcltest {
+ # Ensure that we have a minimal auto_path so we don't pick up extra junk.
+ set ::auto_path [list [info library]]
+
+ ::tcltest::initConstraints
+ if {[namespace children ::tcltest] == {}} {
+ ::tcltest::processCmdLineArgs
+ }
+}
+
diff --git a/tcl/library/word.tcl b/tcl/library/word.tcl
index 9bb6fadcdc8..1acc414d37a 100644
--- a/tcl/library/word.tcl
+++ b/tcl/library/word.tcl
@@ -5,29 +5,25 @@
# widgets behave properly for different platforms.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scritpics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
# The following variables are used to determine which characters are
# interpreted as white space.
-# CYGNUS local: Always use Motif-style selection
-#if {$tcl_platform(platform) == "windows"} {
- # Windows style - any but space, tab, or newline
-# set tcl_wordchars "\[^ \t\n\]"
-# set tcl_nonwordchars "\[ \t\n\]"
-#} else {
- # Motif style - any number, letter, or underscore
- set tcl_wordchars {[a-zA-Z0-9_]}
- set tcl_nonwordchars {[^a-zA-Z0-9_]}
-#}
+if {[string equal $tcl_platform(platform) "windows"]} {
+ # Windows style - any but a unicode space char
+ set tcl_wordchars "\\S"
+ set tcl_nonwordchars "\\s"
+} else {
+ # Motif style - any unicode word char (number, letter, or underscore)
+ set tcl_wordchars "\\w"
+ set tcl_nonwordchars "\\W"
+}
# tcl_wordBreakAfter --
#
@@ -62,7 +58,7 @@ proc tcl_wordBreakAfter {str start} {
proc tcl_wordBreakBefore {str start} {
global tcl_nonwordchars tcl_wordchars
- if {[string compare $start end] == 0} {
+ if {[string equal $start end]} {
set start [string length $str]
}
if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} {
@@ -124,7 +120,7 @@ proc tcl_startOfNextWord {str start} {
proc tcl_startOfPreviousWord {str start} {
global tcl_nonwordchars tcl_wordchars
- if {[string compare $start end] == 0} {
+ if {[string equal $start end]} {
set start [string length $str]
}
if {[regexp -indices \
diff --git a/tcl/mac/MW_TclAppleScriptHeader.h b/tcl/mac/MW_TclAppleScriptHeader.h
new file mode 100644
index 00000000000..6ce3853b598
--- /dev/null
+++ b/tcl/mac/MW_TclAppleScriptHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TclAppleScriptHeaderPPC"
+#elif __CFM68K__
+#include "MW_TclAppleScriptHeaderCFM68K"
+#else
+#include "MW_TclAppleScriptHeader68K"
+#endif
diff --git a/tcl/mac/MW_TclAppleScriptHeader.pch b/tcl/mac/MW_TclAppleScriptHeader.pch
index afd6cdba1ea..906134f3d74 100644
--- a/tcl/mac/MW_TclAppleScriptHeader.pch
+++ b/tcl/mac/MW_TclAppleScriptHeader.pch
@@ -25,17 +25,17 @@
#if __POWERPC__
#pragma precompile_target "MW_TclAppleScriptHeaderPPC"
-#include "MW_TclHeaderPPC"
#elif __CFM68K__
#pragma precompile_target "MW_TclAppleScriptHeaderCFM68K"
-#include "MW_TclHeaderCFM68K"
#else
#pragma precompile_target "MW_TclAppleScriptHeader68K"
-#include "MW_TclHeader68K"
#endif
+#include "tclMacCommonPch.h"
+
+/* #define TCL_REGISTER_LIBRARY 1 */
+#define USE_TCL_STUBS
-#define TCL_REGISTER_LIBRARY 1
/*
* Place any includes below that will are needed by the majority of the
* and is OK to be in any file in the system. The pragma's are used
diff --git a/tcl/mac/MW_TclHeader.h b/tcl/mac/MW_TclHeader.h
new file mode 100644
index 00000000000..43a902968b5
--- /dev/null
+++ b/tcl/mac/MW_TclHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TclHeaderPPC"
+#elif __CFM68K__
+#include "MW_TclHeaderCFM68K"
+#else
+#include "MW_TclHeader68K"
+#endif
diff --git a/tcl/mac/MW_TclHeader.pch b/tcl/mac/MW_TclHeader.pch
index bca9fe42366..8a10be868e2 100644
--- a/tcl/mac/MW_TclHeader.pch
+++ b/tcl/mac/MW_TclHeader.pch
@@ -42,6 +42,8 @@
#include "tcl.h"
#include "tclMac.h"
#include "tclInt.h"
+#include "MoreFiles.h"
+#include "MoreFilesExtras.h"
#pragma export reset
diff --git a/tcl/mac/MW_TclTestHeader.h b/tcl/mac/MW_TclTestHeader.h
new file mode 100644
index 00000000000..c47bb97ca70
--- /dev/null
+++ b/tcl/mac/MW_TclTestHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TclTestHeaderPPC"
+#elif __CFM68K__
+#include "MW_TclTestHeaderCFM68K"
+#else
+#include "MW_TclTestHeader68K"
+#endif
diff --git a/tcl/mac/MW_TclTestHeader.pch b/tcl/mac/MW_TclTestHeader.pch
new file mode 100644
index 00000000000..75b5ba95e3d
--- /dev/null
+++ b/tcl/mac/MW_TclTestHeader.pch
@@ -0,0 +1,54 @@
+/*
+ * MW_TclHeader.pch --
+ *
+ * This file is the source for a pre-compilied header that gets used
+ * for all files in the Tcl projects. This make compilies go a bit
+ * faster. This file is only intended to be used in the MetroWerks
+ * CodeWarrior environment. It essentially acts as a place to set
+ * compiler flags. See MetroWerks documention for more details.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * To use the compilied header you need to set the "Prefix file" in
+ * the "C/C++ Language" preference panel to point to the created
+ * compilied header. The name of the header depends on the
+ * architecture we are compiling for (see the code below). For
+ * example, for a 68k app the prefix file should be: MW_TclHeader68K.
+ */
+#if __POWERPC__
+#pragma precompile_target "MW_TclTestHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TclTestHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TclTestHeader68K"
+#endif
+
+#define TCL_DEBUG 1
+
+/*#define TCL_THREADS 1*/
+
+#include "tclMacCommonPch.h"
+
+/*
+ * Place any includes below that will are needed by the majority of the
+ * and is OK to be in any file in the system. The pragma's are used
+ * to control what functions are exported in the Tcl shared library.
+ */
+
+#pragma export on
+#include "tcl.h"
+#include "tclMac.h"
+#include "tclInt.h"
+#include "MoreFiles.h"
+#include "MoreFilesExtras.h"
+
+#pragma export reset
+
+
diff --git a/tcl/mac/README b/tcl/mac/README
index b8ca40e17c1..e4ff695bf20 100644
--- a/tcl/mac/README
+++ b/tcl/mac/README
@@ -1,4 +1,4 @@
-Tcl 8.0.3 for Macintosh
+Tcl 8.3 for Macintosh
by Ray Johnson
Scriptics Corporation
@@ -14,89 +14,24 @@ RCS: @(#) $Id$
---------------
This is the README file for the Macintosh version of the Tcl
-scripting language. The file consists of information specific
-to the Macintosh version of Tcl. For more general information
-please read the README file in the main Tcl directory.
-
-2. What's new?
---------------
-
-The main new feature is the Tcl compilier. You should certainly
-notice the speed improvements. Any problems are probably
-generic rather than Mac specific. If you have questions or
-comments about the compilier feel free to forward them to the
-author of the compilier: Brian Lewis <btlewis@eng.sun.com>.
-Several things were fixed/changed since the a1 release so be
-sure to check this out.
-
-The largest incompatible change on the Mac is the removal of the
-following commands: "rm", "rmdir", "mkdir", "mv" and "cp". These
-commands were never really supported and their functionality is
-superceded by the file command.
-
-I've also added in a new "AppleScript" command. This was contributed
-by Jim Ingham who is a new member of the Tcl group. It's very cool.
-The command isn't actually in the core - you need to do a "package
-require Tclapplescript" to get access to it. This code is officially
-unsupported and will change in the next release. However, the core
-functionality is there and is stable enough to use. Documentation
-can be found in "AppleScript.html" in the mac subdirectory.
-
-The resource command has also been rewacked. You can now read and
-write any Mac resource. Tcl now has the new (and VERY COOL) binary
-command that will allow you to pack and unpack the resources into
-useful Tcl code. We will eventually provide Tcl libraries for
-accessing the most common resources.
-
-See the main Tcl README for other features new to Tcl 8.0.
-
-3. Mac specific features
-------------------------
-
-There are several features or enhancements in Tcl that are unique to
-the Macintosh version of Tcl. Here is a list of those features and
-pointers to where you can find more information about the feature.
-
-* The "resource" command allows you manipulate Macintosh resources.
- A complete man page is available for this command.
-
-* The Mac version of the "source" command has an option to source from
- a Macintosh resource. Check the man page from the source command
- for details.
-
-* The only command NOT available on the Mac is the exec command.
- However, we include a Mac only package called Tclapplescript that
- provides access to Mac's AppleScript system. This command is still
- under design & construction. Documentatin can be found in the mac
- subdirectory in a file called "AppleScript.html".
-
-* The env variable on the Macintosh works rather differently than on
- Windows or UNIX platforms. Check out the tclvars man page for
- details.
-
-* The command "file volumes" returns the available volumes on your
- Macintosh. Check out the file command for details.
-
-* The command "file attributes" has the Mac specific options of
- -creator and -type which allow you to query and set the Macintosh
- creator and type codes for Mac files. See file man page for details.
-
-* We have added a template for creating a Background-only Tcl application.
- So you can use Tcl as a faceless server process. For more details, see
- the file background.doc.
-
-If you are writing cross platform code but would still like to use
-some of these Mac specific commands, please remember to use the
-tcl_platform variable to special case your code.
-
-4. The Distribution
+scripting language. The home page for the Macintosh releases is
+ http://dev.scriptics.com/software/mac/
+
+A summary of what's new in this release is at
+ http://dev.scriptics.com/software/tcltk/8.3.html
+
+A summary of Macintosh-specific features is at
+ http://dev.scriptics.com/software/mac/features.html
+
+
+2. The Distribution
-------------------
-Macintosh Tcl is distributed in three different forms. This
-should make it easier to only download what you need. The
-packages are as follows:
+Macintosh Tcl is distributed in three different forms. This should
+make it easier to only download what you need. Substitute <version>
+with the version you wish to use. The packages are as follows:
-mactk8.0.3.sea.hqx
+mactk<version>.sea.hqx
This distribution is a "binary" only release. It contains an
installer program that will install a 68k, PowerPC, or Fat
@@ -104,92 +39,41 @@ mactk8.0.3.sea.hqx
it installs the Tcl & Tk libraries in the Extensions folder inside
your System Folder.
-mactcltk-full-8.0.3.sea.hqx
+mactcltk-full-<version>.sea.hqx
This release contains the full release of Tcl and Tk for the
Macintosh plus the More Files packages which Macintosh Tcl and Tk
rely on.
-mactcl-source-8.0.3.sea.hqx
+mactcl-source-<version>.sea.hqx
- This release contains the complete source for Tcl 8.0. In
+ This release contains the complete source for Tcl. In
addition, Metrowerks CodeWarrior libraries and project files
are included. However, you must already have the More Files
package to compile this code.
-5. Documentation
-----------------
-
The "html" subdirectory contains reference documentation in
in the HTML format. You may also find these pages at:
- http://www.scriptics.com/man/tcl8.0/contents.html
-
-Other documentation and sample Tcl scripts can be found at
-the Tcl archive site:
-
- ftp://ftp.neosoft.com/tcl/
-
-and the Tcl resource center:
-
- http://www.scriptics.com/resource/
+ http://dev.scriptics.com/man/tcl<version>/contents.html
-The internet news group comp.lang.tcl is also a valuable
-source of information about Tcl. A mailing list is also
-available (see below).
-
-6. Compiling Tcl
+3. Compiling Tcl
----------------
In order to compile Macintosh Tcl you must have the
following items:
- CodeWarrior Pro 2 or 3
- Mac Tcl 8.0 (source)
- More Files 1.4.3
-
-There are two sets of project files included with the package. The ones
-we use for the release are for CodeWarrior Pro 3, and are not compatible
-with CodeWarrior Gold release 11 and earlier. We have included the files
-for earlier versions of CodeWarrior in the folder tcl8.0:mac:CW11 Projects,
-but they are unsupported, and a little out of date.
-
-As of Tcl8.0p2, the code will also build under CW Pro 2. The only
-change that needs to be made is that float.mac.c should be replaced by
-float.c in the MacTcl MSL project file.
-
-However, there seems to be a bug in the CFM68K Linker in CW Pro 2,
-which renders the CFM68K Version under CW Pro 2 very unstable. I am
-working with MetroWerks to resolve this issue. The PPC version is
-fine, as is the Traditional 68K Shell. But if you need to use the
-CFM68K, then you must stay with CW Pro 1 for now.
-
-The project files included with the Mac Tcl source should work
-fine. The only thing you may need to update are the access paths.
-Unfortunantly, it's somewhat common for the project files to become
-slightly corrupted. The most common problem is that the "Prefix file"
-found in the "C/C++ Preference" panel is incorrect. This should be
-set to MW_TclHeaderPPC, MW_TclHeader68K or MW_TclHeaderCFM68K.
+ CodeWarrior Pro 5+
+ Mac Tcl (sources)
+ More Files 1.4.9
-To build the fat version of TclShell, open the project file "TclShells.¼",
-select the "TclShell" target, and build. All of the associated binaries will
-be built automoatically. There are also targets for building static 68K
-and Power PC builds, for building a CFM 68K build, and for building a
-shared library Power PC only build.
+The included project files should work fine. However, for
+current release notes please check this page:
-Special notes:
-
-* There is a small bug in More Files 1.4.3. Also you should not use
- MoreFiles 1.4.4 - 1.4.6. Look in the file named morefiles.doc for
- more details.
-
-* You may not have the libmoto library which will cause a compile
- error. You don't REALLY need it - it can be removed. Look at the
- file libmoto.doc for more details.
-
-* Check out the file bugs.doc for information about known bugs.
+ http://dev.scriptics.com/doc/howto/compile.html#mac
If you have comments or Bug reports send them to:
Jim Ingham
jingham@cygnus.com
+
diff --git a/tcl/mac/bugs.doc b/tcl/mac/bugs.doc
index 114e0d9ab47..a4936e2e04f 100644
--- a/tcl/mac/bugs.doc
+++ b/tcl/mac/bugs.doc
@@ -30,3 +30,15 @@ Known bugs in the current release.
If you find additional test cases that show crashes please let us
know!
+* In Tcl 8.2, the new Regexp code seems to be more deeply recursive than
+the older version in Tcl8.0. As a result, I have had to increase the Stack
+size of Tcl to 1Meg. If you are not doing regexps with many subexpressions,
+this is probably more stack than you will need. You can relink with the
+stack set to 512K, and you will be fine for most purposes.
+* This regexp problem is fixed in Tcl8.3. If you are going to do complex
+regexp's, it is probably a good idea to keep the stack size big. But normal
+regexps will not cause crashes.
+
+* The "clock scan -base" command does not work. The epoch is wrong.
+* The file mtime command does not work when setting the time, it is off
+by 4 years.
diff --git a/tcl/mac/tclMac.h b/tcl/mac/tclMac.h
index 3f121c5ca61..06d3cd9c466 100644
--- a/tcl/mac/tclMac.h
+++ b/tcl/mac/tclMac.h
@@ -31,70 +31,7 @@
typedef int (*Tcl_MacConvertEventPtr) _ANSI_ARGS_((EventRecord *eventPtr));
-/*
- * This is needed by the shells to handle Macintosh events.
- */
-
-EXTERN void Tcl_MacSetEventProc _ANSI_ARGS_((Tcl_MacConvertEventPtr procPtr));
-
-/*
- * These routines are useful for handling using scripts from resources
- * in the application shell
- */
-
-EXTERN char * Tcl_MacConvertTextResource _ANSI_ARGS_((Handle resource));
-EXTERN int Tcl_MacEvalResource _ANSI_ARGS_((Tcl_Interp *interp,
- char *resourceName, int resourceNumber, char *fileName));
-EXTERN Handle Tcl_MacFindResource _ANSI_ARGS_((Tcl_Interp *interp,
- long resourceType, char *resourceName,
- int resourceNumber, char *resFileRef, int * releaseIt));
-
-/* These routines support the new OSType object type (i.e. the packed 4
- * character type and creator codes).
- */
-
-EXTERN int Tcl_GetOSTypeFromObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, OSType *osTypePtr));
-EXTERN void Tcl_SetOSTypeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- OSType osType));
-EXTERN Tcl_Obj * Tcl_NewOSTypeObj _ANSI_ARGS_((OSType osType));
-
-
-
-/*
- * The following routines are utility functions in Tcl. They are exported
- * here because they are needed in Tk. They are not officially supported,
- * however. The first set are from the MoreFiles package.
- */
-
-EXTERN pascal OSErr FSpGetDirectoryID(const FSSpec *spec,
- long *theDirID, Boolean *isDirectory);
-EXTERN pascal short FSpOpenResFileCompat(const FSSpec *spec,
- SignedByte permission);
-EXTERN pascal void FSpCreateResFileCompat(const FSSpec *spec,
- OSType creator, OSType fileType,
- ScriptCode scriptTag);
-/*
- * Like the MoreFiles routines these fix problems in the standard
- * Mac calls. These routines is from tclMacUtils.h.
- */
-
-EXTERN int FSpLocationFromPath _ANSI_ARGS_((int length, CONST char *path,
- FSSpecPtr theSpec));
-EXTERN OSErr FSpPathFromLocation _ANSI_ARGS_((FSSpecPtr theSpec,
- int *length, Handle *fullPath));
-
-/*
- * These are not in MSL 2.1.2, so we need to export them from the
- * Tcl shared library. They are found in the compat directory
- * except the panic routine which is found in tclMacPanic.h.
- */
-
-EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2, size_t n));
-EXTERN int strcasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2));
-EXTERN void panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+#include "tclPlatDecls.h"
#pragma export reset
diff --git a/tcl/mac/tclMacAlloc.c b/tcl/mac/tclMacAlloc.c
index 71b6fb4effd..f06170cf27d 100644
--- a/tcl/mac/tclMacAlloc.c
+++ b/tcl/mac/tclMacAlloc.c
@@ -17,8 +17,8 @@
* RCS: @(#) $Id$
*/
-#include "tclMacInt.h"
#include "tclInt.h"
+#include "tclMacInt.h"
#include <Memory.h>
#include <stdlib.h>
#include <string.h>
diff --git a/tcl/mac/tclMacAppInit.c b/tcl/mac/tclMacAppInit.c
index 05cdc416da6..350afeb5730 100644
--- a/tcl/mac/tclMacAppInit.c
+++ b/tcl/mac/tclMacAppInit.c
@@ -26,10 +26,10 @@ short InstallConsole _ANSI_ARGS_((short fd));
#endif
#ifdef TCL_TEST
-EXTERN int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TCL_TEST */
/*
@@ -85,7 +85,7 @@ main(
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
diff --git a/tcl/mac/tclMacApplication.r b/tcl/mac/tclMacApplication.r
index 10e2aa39053..35a4213d156 100644
--- a/tcl/mac/tclMacApplication.r
+++ b/tcl/mac/tclMacApplication.r
@@ -42,21 +42,21 @@ resource 'vers' (1) {
TCL_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TCL_PATCH_LEVEL,
- TCL_PATCH_LEVEL ", by Ray Johnson © Sun Microsystems"
+ TCL_PATCH_LEVEL ", by Ray Johnson & Jim Ingham © Scriptics Inc"
};
resource 'vers' (2) {
TCL_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TCL_PATCH_LEVEL,
- "Tcl Shell " TCL_PATCH_LEVEL " © 1996"
+ "Tcl Shell " TCL_PATCH_LEVEL " © 1996-1997 Sun Microsystems, 1998-1999 Scriptics Inc"
};
#define TCL_APP_CREATOR 'Tcl '
type TCL_APP_CREATOR as 'STR ';
resource TCL_APP_CREATOR (0, purgeable) {
- "Tcl Shell " TCL_PATCH_LEVEL " © 1996"
+ "Tcl Shell " TCL_PATCH_LEVEL " © 1996-1999"
};
/*
diff --git a/tcl/mac/tclMacBOAAppInit.c b/tcl/mac/tclMacBOAAppInit.c
index 9ec795b45db..4413939ad83 100644
--- a/tcl/mac/tclMacBOAAppInit.c
+++ b/tcl/mac/tclMacBOAAppInit.c
@@ -97,7 +97,7 @@ main(
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
diff --git a/tcl/mac/tclMacBOAMain.c b/tcl/mac/tclMacBOAMain.c
index c08a39dba9e..b21d3866853 100644
--- a/tcl/mac/tclMacBOAMain.c
+++ b/tcl/mac/tclMacBOAMain.c
@@ -147,14 +147,16 @@ Tcl_Main(argc, argv, appInitProc)
*/
if ((*appInitProc)(interp) != TCL_OK) {
- Tcl_DString errStr;
- Tcl_DStringInit(&errStr);
- Tcl_DStringAppend(&errStr,
- "application-specific initialization failed: \n", -1);
- Tcl_DStringAppend(&errStr, interp->result, -1);
- Tcl_DStringAppend(&errStr, "\n", 1);
- TclMacDoNotification(Tcl_DStringValue(&errStr));
- goto done;
+ Tcl_DString errStr;
+
+ Tcl_DStringInit(&errStr);
+ Tcl_DStringAppend(&errStr,
+ "application-specific initialization failed: \n", -1);
+ Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
+ Tcl_DStringAppend(&errStr, "\n", 1);
+ TclMacDoNotification(Tcl_DStringValue(&errStr));
+ Tcl_DStringFree(&errStr);
+ goto done;
}
/*
@@ -192,10 +194,9 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_DStringAppend(&errStr, " Error sourcing resource or file: ", -1);
Tcl_DStringAppend(&errStr, fileName, -1);
Tcl_DStringAppend(&errStr, "\n\nError was: ", -1);
- Tcl_DStringAppend(&errStr, interp->result, -1);
-
+ Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
TclMacDoNotification(Tcl_DStringValue(&errStr));
-
+ Tcl_DStringFree(&errStr);
}
goto done;
}
@@ -312,7 +313,7 @@ Tcl_MacBGNotifyObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- TclMacDoNotification(Tcl_GetStringFromObj(objv[1], (int *) NULL));
+ TclMacDoNotification(Tcl_GetString(objv[1]));
return TCL_OK;
}
diff --git a/tcl/mac/tclMacChan.c b/tcl/mac/tclMacChan.c
index ffb91c73d94..19f970f80f8 100644
--- a/tcl/mac/tclMacChan.c
+++ b/tcl/mac/tclMacChan.c
@@ -25,12 +25,6 @@
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
-/*
- * The following variable is used to tell whether this module has been
- * initialized.
- */
-
-static int initialized = 0;
/*
* The following are flags returned by GetOpenMode. They
@@ -66,12 +60,16 @@ typedef struct FileState {
struct FileState *nextPtr; /* Pointer to next registered file. */
} FileState;
-/*
- * The following pointer refers to the head of the list of files managed
- * that are being watched for file events.
- */
+typedef struct ThreadSpecificData {
+ int initialized; /* True after the thread initializes */
+ FileState *firstFilePtr; /* the head of the list of files managed
+ * that are being watched for file events. */
+ Tcl_Channel stdinChannel;
+ Tcl_Channel stdoutChannel; /* Note - these seem unused */
+ Tcl_Channel stderrChannel;
+} ThreadSpecificData;
-static FileState *firstFilePtr;
+static Tcl_ThreadDataKey dataKey;
/*
* The following structure is what is added to the Tcl event queue when
@@ -106,7 +104,7 @@ static int FileClose _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
int flags));
-static void FileInit _ANSI_ARGS_((void));
+static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
static int FileInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutput _ANSI_ARGS_((ClientData instanceData,
@@ -116,9 +114,9 @@ static int FileSeek _ANSI_ARGS_((ClientData instanceData,
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
static int GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-static Tcl_Channel OpenFileChannel _ANSI_ARGS_((char *fileName, int mode,
- int permissions, int *errorCodePtr));
+ CONST char *string));
+static Tcl_Channel OpenFileChannel _ANSI_ARGS_((CONST char *fileName,
+ int mode, int permissions, int *errorCodePtr));
static int StdIOBlockMode _ANSI_ARGS_((ClientData instanceData,
int mode));
static int StdIOClose _ANSI_ARGS_((ClientData instanceData,
@@ -177,13 +175,6 @@ typedef void (*TclGetStdChannelsProc) _ANSI_ARGS_((Tcl_Channel *stdinPtr,
TclGetStdChannelsProc getStdChannelsProc = NULL;
-/*
- * Static variables to hold channels for stdin, stdout and stderr.
- */
-
-static Tcl_Channel stdinChannel = NULL;
-static Tcl_Channel stdoutChannel = NULL;
-static Tcl_Channel stderrChannel = NULL;
/*
*----------------------------------------------------------------------
@@ -201,13 +192,18 @@ static Tcl_Channel stderrChannel = NULL;
*----------------------------------------------------------------------
*/
-static void
+static ThreadSpecificData *
FileInit()
{
- initialized = 1;
- firstFilePtr = NULL;
- Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
- Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstFilePtr = NULL;
+ Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
+ }
+ return tsdPtr;
}
/*
@@ -232,7 +228,6 @@ FileChannelExitHandler(
ClientData clientData) /* Old window proc */
{
Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
- initialized = 0;
}
/*
@@ -259,6 +254,7 @@ FileSetupProc(
{
FileState *infoPtr;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -268,7 +264,8 @@ FileSetupProc(
* Check to see if there is a ready file. If so, poll.
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask) {
Tcl_SetMaxBlockTime(&blockTime);
break;
@@ -302,6 +299,7 @@ FileCheckProc(
FileState *infoPtr;
int sentMsg = 0;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -313,7 +311,8 @@ FileCheckProc(
* events).
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !infoPtr->pending) {
infoPtr->pending = 1;
evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
@@ -352,6 +351,7 @@ FileEventProc(
{
FileEvent *fileEvPtr = (FileEvent *)evPtr;
FileState *infoPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -364,7 +364,8 @@ FileEventProc(
* event is in the queue.
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (fileEvPtr->infoPtr == infoPtr) {
infoPtr->pending = 0;
Tcl_NotifyChannel(infoPtr->fileChan, infoPtr->watchMask);
@@ -428,29 +429,31 @@ StdIOClose(
Tcl_Interp *interp) /* Unused. */
{
int fd, errorCode = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Invalidate the stdio cache if necessary. Note that we assume that
* the stdio file and channel pointers will become invalid at the same
* time.
+ * Do not close standard channels while in thread-exit.
*/
fd = (int) ((FileState*)instanceData)->fileRef;
- if (fd == 0) {
- fd = 0;
- stdinChannel = NULL;
- } else if (fd == 1) {
- stdoutChannel = NULL;
- } else if (fd == 2) {
- stderrChannel = NULL;
- } else {
- panic("recieved invalid std file");
- }
-
- if (close(fd) < 0) {
- errorCode = errno;
+ if (!TclInExit()) {
+ if (fd == 0) {
+ tsdPtr->stdinChannel = NULL;
+ } else if (fd == 1) {
+ tsdPtr->stdoutChannel = NULL;
+ } else if (fd == 2) {
+ tsdPtr->stderrChannel = NULL;
+ } else {
+ panic("recieved invalid std file");
+ }
+
+ if (close(fd) < 0) {
+ errorCode = errno;
+ }
}
-
return errorCode;
}
@@ -459,7 +462,7 @@ StdIOClose(
*
* CommonGetHandle --
*
- * Called from Tcl_GetChannelFile to retrieve OS handles from inside
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from inside
* a file based channel.
*
* Results:
@@ -642,7 +645,7 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
sprintf(buf, "0x%08x%08x", psn.highLongOfPSN, psn.lowLongOfPSN);
Tcl_SetStringObj(resultPtr, buf, -1);
} else {
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -659,7 +662,7 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TclGetDefaultStdChannel --
+ * TclpGetDefaultStdChannel --
*
* Constructs a channel for the specified standard OS handle.
*
@@ -674,14 +677,14 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
*/
Tcl_Channel
-TclGetDefaultStdChannel(
+TclpGetDefaultStdChannel(
int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel = NULL;
int fd = 0; /* Initializations needed to prevent */
int mode = 0; /* compiler warning (used before set). */
char *bufMode = NULL;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
int channelPermissions;
FileState *fileState;
@@ -759,8 +762,8 @@ TclpOpenFileChannel(
{
Tcl_Channel chan;
int mode;
- char *nativeName;
- Tcl_DString buffer;
+ char *native;
+ Tcl_DString ds, buffer;
int errorCode;
mode = GetOpenMode(interp, modeString);
@@ -768,12 +771,13 @@ TclpOpenFileChannel(
return NULL;
}
- nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (nativeName == NULL) {
+ if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
return NULL;
}
-
- chan = OpenFileChannel(nativeName, mode, permissions, &errorCode);
+ native = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer), &ds);
+ chan = OpenFileChannel(native, mode, permissions, &errorCode);
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&buffer);
if (chan == NULL) {
@@ -806,7 +810,7 @@ TclpOpenFileChannel(
static Tcl_Channel
OpenFileChannel(
- char *fileName, /* Name of file to open. */
+ CONST char *fileName, /* Name of file to open (native). */
int mode, /* Mode for opening file. */
int permissions, /* If the open involves creating a
* file, with what modes to create
@@ -820,7 +824,7 @@ OpenFileChannel(
OSErr err;
short fileRef;
FileState *fileState;
- char channelName[64];
+ char channelName[16 + TCL_INTEGER_SPACE];
/*
* Note we use fsRdWrShPerm instead of fsRdWrPerm which allows shared
@@ -921,6 +925,35 @@ OpenFileChannel(
/*
*----------------------------------------------------------------------
*
+ * Tcl_MakeFileChannel --
+ *
+ * Makes a Tcl_Channel from an existing OS level file handle.
+ *
+ * Results:
+ * The Tcl_Channel created around the preexisting OS level file handle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeFileChannel(handle, mode)
+ ClientData handle; /* OS level handle. */
+ int mode; /* ORed combination of TCL_READABLE and
+ * TCL_WRITABLE to indicate file mode. */
+{
+ /*
+ * Not implemented yet.
+ */
+
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* FileBlockMode --
*
* Set blocking or non-blocking mode on channel. Macintosh files
@@ -1190,16 +1223,15 @@ CommonWatch(
FileState **nextPtrPtr, *ptr;
FileState *infoPtr = (FileState *) instanceData;
int oldMask = infoPtr->watchMask;
+ ThreadSpecificData *tsdPtr;
- if (!initialized) {
- FileInit();
- }
+ tsdPtr = FileInit();
infoPtr->watchMask = mask;
if (infoPtr->watchMask) {
if (!oldMask) {
- infoPtr->nextPtr = firstFilePtr;
- firstFilePtr = infoPtr;
+ infoPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = infoPtr;
}
} else {
if (oldMask) {
@@ -1207,7 +1239,7 @@ CommonWatch(
* Remove the file from the list of watched files.
*/
- for (nextPtrPtr = &firstFilePtr, ptr = *nextPtrPtr;
+ for (nextPtrPtr = &(tsdPtr->firstFilePtr), ptr = *nextPtrPtr;
ptr != NULL;
nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
if (infoPtr == ptr) {
@@ -1231,7 +1263,7 @@ CommonWatch(
*
* Results:
* On success, returns mode to pass to "open". If an error occurs, the
- * returns -1 and if interp is not NULL, sets interp->result to an
+ * returns -1 and if interp is not NULL, sets the interp's result to an
* error message.
*
* Side effects:
@@ -1249,7 +1281,7 @@ static int
GetOpenMode(
Tcl_Interp *interp, /* Interpreter to use for error
* reporting - may be NULL. */
- char *string) /* Mode string, e.g. "r+" or
+ CONST char *string) /* Mode string, e.g. "r+" or
* "RDONLY CREAT". */
{
int mode, modeArgc, c, i, gotRW;
@@ -1262,7 +1294,13 @@ GetOpenMode(
*/
mode = 0;
- if (islower(UCHAR(string[0]))) {
+ /*
+ * Guard against international characters before using byte oriented
+ * routines.
+ */
+
+ if (!(string[0] & 0x80)
+ && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
switch (string[0]) {
case 'r':
mode = TCL_RDONLY;
diff --git a/tcl/mac/tclMacExit.c b/tcl/mac/tclMacExit.c
index ef1b9d38435..892fadd11a6 100644
--- a/tcl/mac/tclMacExit.c
+++ b/tcl/mac/tclMacExit.c
@@ -104,7 +104,7 @@ static ExitToShellDataPtr gExitToShellData = (ExitToShellDataPtr) NULL;
*/
void
-TclPlatformExit(
+TclpExit(
int status) /* Ignored. */
{
TclMacExitHandler();
diff --git a/tcl/mac/tclMacFCmd.c b/tcl/mac/tclMacFCmd.c
index 21f725dc451..f2c866d283a 100644
--- a/tcl/mac/tclMacFCmd.c
+++ b/tcl/mac/tclMacFCmd.c
@@ -4,7 +4,7 @@
* Implements the Macintosh specific portions of the file manipulation
* subcommands of the "file" command.
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -31,16 +31,16 @@
*/
static int GetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **attributePtrPtr));
static int GetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **readOnlyPtrPtr));
static int SetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj *attributePtr));
static int SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj *readOnlyPtr));
/*
@@ -72,14 +72,25 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
static pascal Boolean CopyErrHandler _ANSI_ARGS_((OSErr error,
short failedOperation,
short srcVRefNum, long srcDirID,
- StringPtr srcName, short dstVRefNum,
- long dstDirID,StringPtr dstName));
+ ConstStr255Param srcName, short dstVRefNum,
+ long dstDirID,ConstStr255Param dstName));
+static int DoCopyDirectory _ANSI_ARGS_((CONST char *src,
+ CONST char *dst, Tcl_DString *errorPtr));
+static int DoCopyFile _ANSI_ARGS_((CONST char *src,
+ CONST char *dst));
+static int DoCreateDirectory _ANSI_ARGS_((CONST char *path));
+static int DoDeleteFile _ANSI_ARGS_((CONST char *path));
+static int DoRemoveDirectory _ANSI_ARGS_((CONST char *path,
+ int recursive, Tcl_DString *errorPtr));
+static int DoRenameFile _ANSI_ARGS_((CONST char *src,
+ CONST char *dst));
OSErr FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr,
Boolean *lockedPtr));
static OSErr GenerateUniqueName _ANSI_ARGS_((short vRefNum,
long dirID1, long dirID2, Str31 uniqueName));
-static OSErr GetFileSpecs _ANSI_ARGS_((char *path, FSSpec *pathSpecPtr,
- FSSpec *dirSpecPtr, Boolean *pathExistsPtr,
+static OSErr GetFileSpecs _ANSI_ARGS_((CONST char *path,
+ FSSpec *pathSpecPtr, FSSpec *dirSpecPtr,
+ Boolean *pathExistsPtr,
Boolean *pathIsDirectoryPtr));
static OSErr MoveRename _ANSI_ARGS_((const FSSpec *srcSpecPtr,
const FSSpec *dstSpecPtr, StringPtr copyName));
@@ -89,7 +100,7 @@ static int Pstrequal _ANSI_ARGS_((ConstStr255Param stringA,
/*
*---------------------------------------------------------------------------
*
- * TclpRenameFile --
+ * TclpRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
@@ -123,8 +134,29 @@ static int Pstrequal _ANSI_ARGS_((ConstStr255Param stringA,
int
TclpRenameFile(
- char *src, /* Pathname of file or dir to be renamed. */
- char *dst) /* New pathname for file or directory. */
+ CONST char *src, /* Pathname of file or dir to be renamed
+ * (UTF-8). */
+ CONST char *dst) /* New pathname of file or directory
+ * (UTF-8). */
+{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ result = DoRenameFile(Tcl_DStringValue(&srcString),
+ Tcl_DStringValue(&dstString));
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoRenameFile(
+ CONST char *src, /* Pathname of file or dir to be renamed
+ * (native). */
+ CONST char *dst) /* New pathname of file or directory
+ * (native). */
{
FSSpec srcFileSpec, dstFileSpec, dstDirSpec;
OSErr err;
@@ -157,7 +189,7 @@ TclpRenameFile(
* fails, it's because it wasn't empty.
*/
- if (TclpRemoveDirectory(dst, 0, NULL) != TCL_OK) {
+ if (DoRemoveDirectory(dst, 0, NULL) != TCL_OK) {
return TCL_ERROR;
}
@@ -230,9 +262,128 @@ TclpRenameFile(
}
/*
+ *--------------------------------------------------------------------------
+ *
+ * MoveRename --
+ *
+ * Helper function for TclpRenameFile. Renames a file or directory
+ * into the same directory or another directory. The target name
+ * must not already exist in the destination directory.
+ *
+ * Don't use FSpMoveRenameCompat because it doesn't work with
+ * directories or with locked files.
+ *
+ * Results:
+ * Returns a mac error indicating the cause of the failure.
+ *
+ * Side effects:
+ * Creates a temp file in the target directory to handle a rename
+ * between directories.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+static OSErr
+MoveRename(
+ const FSSpec *srcFileSpecPtr, /* Source object. */
+ const FSSpec *dstDirSpecPtr, /* Destination directory. */
+ StringPtr copyName) /* New name for object in destination
+ * directory. */
+{
+ OSErr err;
+ long srcID, dstID;
+ Boolean srcIsDir, dstIsDir;
+ Str31 tmpName;
+ FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
+ Boolean locked;
+
+ if (srcFileSpecPtr->parID == 1) {
+ /*
+ * Trying to rename a volume.
+ */
+
+ return badMovErr;
+ }
+ if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
+ /*
+ * Renaming across volumes.
+ */
+
+ return diffVolErr;
+ }
+ err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
+ if (locked) {
+ FSpRstFLockCompat(srcFileSpecPtr);
+ }
+ if (err == noErr) {
+ err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
+ }
+ if (err == noErr) {
+ if (srcFileSpecPtr->parID == dstID) {
+ /*
+ * Renaming object within directory.
+ */
+
+ err = FSpRenameCompat(srcFileSpecPtr, copyName);
+ goto done;
+ }
+ if (Pstrequal(srcFileSpecPtr->name, copyName)) {
+ /*
+ * Moving object to another directory (under same name).
+ */
+
+ err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
+ goto done;
+ }
+ err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
+ }
+ if (err == noErr) {
+ /*
+ * Fullblown: rename source object to temp name, move temp to
+ * dest directory, and rename temp to target.
+ */
+
+ err = GenerateUniqueName(srcFileSpecPtr->vRefNum,
+ srcFileSpecPtr->parID, dstID, tmpName);
+ FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
+ tmpName, &tmpSrcFileSpec);
+ FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
+ &tmpDstFileSpec);
+ }
+ if (err == noErr) {
+ err = FSpRenameCompat(srcFileSpecPtr, tmpName);
+ }
+ if (err == noErr) {
+ err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
+ if (err == noErr) {
+ err = FSpRenameCompat(&tmpDstFileSpec, copyName);
+ if (err == noErr) {
+ goto done;
+ }
+ FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
+ NULL, &srcDirSpec);
+ FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
+ }
+ FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
+ }
+
+ done:
+ if (locked != false) {
+ if (err == noErr) {
+ FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum,
+ dstID, copyName, &dstFileSpec);
+ FSpSetFLockCompat(&dstFileSpec);
+ } else {
+ FSpSetFLockCompat(srcFileSpecPtr);
+ }
+ }
+ return err;
+}
+
+/*
*---------------------------------------------------------------------------
*
- * TclpCopyFile --
+ * TclpCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
@@ -258,8 +409,25 @@ TclpRenameFile(
int
TclpCopyFile(
- char *src, /* Pathname of file to be copied. */
- char *dst) /* Pathname of file to copy to. */
+ CONST char *src, /* Pathname of file to be copied (UTF-8). */
+ CONST char *dst) /* Pathname of file to copy to (UTF-8). */
+{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ result = DoCopyFile(Tcl_DStringValue(&srcString),
+ Tcl_DStringValue(&dstString));
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoCopyFile(
+ CONST char *src, /* Pathname of file to be copied (native). */
+ CONST char *dst) /* Pathname of file to copy to (native). */
{
OSErr err, dstErr;
Boolean dstExists, dstIsDirectory, dstLocked;
@@ -328,7 +496,7 @@ TclpCopyFile(
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile --
+ * TclpDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -349,13 +517,26 @@ TclpCopyFile(
int
TclpDeleteFile(
- char *path) /* Pathname of file to be removed. */
+ CONST char *path) /* Pathname of file to be removed (UTF-8). */
+{
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoDeleteFile(Tcl_DStringValue(&pathString));
+ Tcl_DStringFree(&pathString);
+ return result;
+}
+
+static int
+DoDeleteFile(
+ CONST char *path) /* Pathname of file to be removed (native). */
{
OSErr err;
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
-
+
err = FSpLocationFromPath(strlen(path), path, &fileSpec);
if (err == noErr) {
/*
@@ -387,7 +568,7 @@ TclpDeleteFile(
/*
*---------------------------------------------------------------------------
*
- * TclpCreateDirectory --
+ * TclpCreateDirectory, DoCreateDirectory --
*
* Creates the specified directory. All parent directories of the
* specified directory must already exist. The directory is
@@ -412,7 +593,20 @@ TclpDeleteFile(
int
TclpCreateDirectory(
- char *path) /* Pathname of directory to create. */
+ CONST char *path) /* Pathname of directory to create (UTF-8). */
+{
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoCreateDirectory(Tcl_DStringValue(&pathString));
+ Tcl_DStringFree(&pathString);
+ return result;
+}
+
+static int
+DoCreateDirectory(
+ CONST char *path) /* Pathname of directory to create (native). */
{
OSErr err;
FSSpec dirSpec;
@@ -435,7 +629,7 @@ TclpCreateDirectory(
/*
*---------------------------------------------------------------------------
*
- * TclpCopyDirectory --
+ * TclpCopyDirectory, DoCopyDirectory --
*
* Recursively copies a directory. The target directory dst must
* not already exist. Note that this function does not merge two
@@ -460,10 +654,33 @@ TclpCreateDirectory(
int
TclpCopyDirectory(
- char *src, /* Pathname of directory to be copied. */
- char *dst, /* Pathname of target directory. */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error reporting. */
+ CONST char *src, /* Pathname of directory to be copied
+ * (UTF-8). */
+ CONST char *dst, /* Pathname of target directory (UTF-8). */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ result = DoCopyDirectory(Tcl_DStringValue(&srcString),
+ Tcl_DStringValue(&dstString), errorPtr);
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoCopyDirectory(
+ CONST char *src, /* Pathname of directory to be copied
+ * (UTF-8). */
+ CONST char *dst, /* Pathname of target directory (UTF-8). */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
OSErr err, saveErr;
long srcID, tmpDirID;
@@ -572,7 +789,7 @@ TclpCopyDirectory(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, dst, -1);
+ Tcl_ExternalToUtfDString(NULL, dst, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -604,10 +821,10 @@ CopyErrHandler(
short failedOperation, /* operation that caused the error */
short srcVRefNum, /* volume ref number of source */
long srcDirID, /* directory id of source */
- StringPtr srcName, /* name of source */
+ ConstStr255Param srcName, /* name of source */
short dstVRefNum, /* volume ref number of dst */
long dstDirID, /* directory id of dst */
- StringPtr dstName) /* name of dst directory */
+ ConstStr255Param dstName) /* name of dst directory */
{
return true;
}
@@ -615,7 +832,7 @@ CopyErrHandler(
/*
*---------------------------------------------------------------------------
*
- * TclpRemoveDirectory --
+ * TclpRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
@@ -640,13 +857,37 @@ CopyErrHandler(
int
TclpRemoveDirectory(
- char *path, /* Pathname of directory to be removed. */
+ CONST char *path, /* Pathname of directory to be removed
+ * (UTF-8). */
int recursive, /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error reporting. */
-{
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoRemoveDirectory(Tcl_DStringValue(&pathString), recursive,
+ errorPtr);
+ Tcl_DStringFree(&pathString);
+
+ return result;
+}
+
+static int
+DoRemoveDirectory(
+ CONST char *path, /* Pathname of directory to be removed
+ * (native). */
+ int recursive, /* If non-zero, removes directories that
+ * are nonempty. Otherwise, will only remove
+ * empty directories. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
OSErr err;
FSSpec fileSpec;
long dirID;
@@ -655,6 +896,7 @@ TclpRemoveDirectory(
CInfoPBRec pb;
Str255 fileName;
+
locked = 0;
err = FSpLocationFromPath(strlen(path), path, &fileSpec);
if (err != noErr) {
@@ -715,7 +957,7 @@ TclpRemoveDirectory(
done:
if (err != noErr) {
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, path, -1);
+ Tcl_UtfToExternalDString(NULL, path, -1, errorPtr);
}
if (locked) {
FSpSetFLockCompat(&fileSpec);
@@ -725,130 +967,11 @@ TclpRemoveDirectory(
}
return TCL_OK;
}
-
-/*
- *--------------------------------------------------------------------------
- *
- * MoveRename --
- *
- * Helper function for TclpRenameFile. Renames a file or directory
- * into the same directory or another directory. The target name
- * must not already exist in the destination directory.
- *
- * Don't use FSpMoveRenameCompat because it doesn't work with
- * directories or with locked files.
- *
- * Results:
- * Returns a mac error indicating the cause of the failure.
- *
- * Side effects:
- * Creates a temp file in the target directory to handle a rename
- * between directories.
- *
- *--------------------------------------------------------------------------
- */
-
-static OSErr
-MoveRename(
- const FSSpec *srcFileSpecPtr, /* Source object. */
- const FSSpec *dstDirSpecPtr, /* Destination directory. */
- StringPtr copyName) /* New name for object in destination
- * directory. */
-{
- OSErr err;
- long srcID, dstID;
- Boolean srcIsDir, dstIsDir;
- Str31 tmpName;
- FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
- Boolean locked;
-
- if (srcFileSpecPtr->parID == 1) {
- /*
- * Trying to rename a volume.
- */
-
- return badMovErr;
- }
- if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
- /*
- * Renaming across volumes.
- */
-
- return diffVolErr;
- }
- err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
- if (locked) {
- FSpRstFLockCompat(srcFileSpecPtr);
- }
- if (err == noErr) {
- err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
- }
- if (err == noErr) {
- if (srcFileSpecPtr->parID == dstID) {
- /*
- * Renaming object within directory.
- */
-
- err = FSpRenameCompat(srcFileSpecPtr, copyName);
- goto done;
- }
- if (Pstrequal(srcFileSpecPtr->name, copyName)) {
- /*
- * Moving object to another directory (under same name).
- */
-
- err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
- goto done;
- }
- err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
- }
- if (err == noErr) {
- /*
- * Fullblown: rename source object to temp name, move temp to
- * dest directory, and rename temp to target.
- */
-
- err = GenerateUniqueName(srcFileSpecPtr->vRefNum,
- srcFileSpecPtr->parID, dstID, tmpName);
- FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
- tmpName, &tmpSrcFileSpec);
- FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
- &tmpDstFileSpec);
- }
- if (err == noErr) {
- err = FSpRenameCompat(srcFileSpecPtr, tmpName);
- }
- if (err == noErr) {
- err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
- if (err == noErr) {
- err = FSpRenameCompat(&tmpDstFileSpec, copyName);
- if (err == noErr) {
- goto done;
- }
- FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
- NULL, &srcDirSpec);
- FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
- }
- FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
- }
-
- done:
- if (locked != false) {
- if (err == noErr) {
- FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum,
- dstID, copyName, &dstFileSpec);
- FSpSetFLockCompat(&dstFileSpec);
- } else {
- FSpSetFLockCompat(srcFileSpecPtr);
- }
- }
- return err;
-}
/*
*---------------------------------------------------------------------------
*
- * GetFileSpecs --
+ * GenerateUniqueName --
*
* Generate a filename that is not in either of the two specified
* directories (on the same volume).
@@ -928,7 +1051,7 @@ GenerateUniqueName(
static OSErr
GetFileSpecs(
- char *path, /* The path to query. */
+ CONST char *path, /* The path to query. */
FSSpec *pathSpecPtr, /* Filled with information about path. */
FSSpec *dirSpecPtr, /* Filled with information about path's
* parent directory. */
@@ -1071,15 +1194,19 @@ static int
GetFileFinderAttributes(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute option. */
- char *fileName, /* The name of the file. */
+ CONST char *fileName, /* The name of the file (UTF-8). */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
OSErr err;
FSSpec fileSpec;
FInfo finfo;
-
- err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
-
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
+ err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
+ Tcl_DStringValue(&pathString), &fileSpec);
+ Tcl_DStringFree(&pathString);
+
if (err == noErr) {
err = FSpGetFInfo(&fileSpec, &finfo);
}
@@ -1114,7 +1241,7 @@ GetFileFinderAttributes(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't get attributes for file \"", fileName, "\": ",
+ "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1146,14 +1273,18 @@ static int
GetFileReadOnly(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
+ CONST char *fileName, /* The name of the file (UTF-8). */
Tcl_Obj **readOnlyPtrPtr) /* A pointer to return the object with. */
{
OSErr err;
FSSpec fileSpec;
CInfoPBRec paramBlock;
-
- err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
+ err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
+ Tcl_DStringValue(&pathString), &fileSpec);
+ Tcl_DStringFree(&pathString);
if (err == noErr) {
if (err == noErr) {
@@ -1179,7 +1310,7 @@ GetFileReadOnly(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't get attributes for file \"", fileName, "\": ",
+ "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1207,14 +1338,18 @@ static int
SetFileFinderAttributes(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
+ CONST char *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr) /* The command line object. */
{
OSErr err;
FSSpec fileSpec;
FInfo finfo;
-
- err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
+ err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
+ Tcl_DStringValue(&pathString), &fileSpec);
+ Tcl_DStringFree(&pathString);
if (err == noErr) {
err = FSpGetFInfo(&fileSpec, &finfo);
@@ -1267,7 +1402,7 @@ SetFileFinderAttributes(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't set attributes for file \"", fileName, "\": ",
+ "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1295,15 +1430,19 @@ static int
SetFileReadOnly(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
+ CONST char *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *readOnlyPtr) /* The command line object. */
{
OSErr err;
FSSpec fileSpec;
HParamBlockRec paramBlock;
int hidden;
-
- err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
+ err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
+ Tcl_DStringValue(&pathString), &fileSpec);
+ Tcl_DStringFree(&pathString);
if (err == noErr) {
if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
@@ -1338,7 +1477,7 @@ SetFileReadOnly(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't set attributes for file \"", fileName, "\": ",
+ "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1362,7 +1501,6 @@ SetFileReadOnly(
*
*---------------------------------------------------------------------------
*/
-
int
TclpListVolumes(
Tcl_Interp *interp) /* Interpreter to which to pass the volume list */
@@ -1372,6 +1510,7 @@ TclpListVolumes(
OSErr theError = noErr;
Tcl_Obj *resultPtr, *elemPtr;
short volIndex = 1;
+ Tcl_DString dstr;
resultPtr = Tcl_NewObj();
@@ -1386,7 +1525,7 @@ TclpListVolumes(
*/
while ( 1 ) {
- pb.volumeParam.ioNamePtr = (StringPtr) & name;
+ pb.volumeParam.ioNamePtr = (StringPtr) &name;
pb.volumeParam.ioVolIndex = volIndex;
theError = PBHGetVInfoSync(&pb);
@@ -1394,10 +1533,14 @@ TclpListVolumes(
if ( theError != noErr ) {
break;
}
-
- elemPtr = Tcl_NewStringObj((char *) name + 1, (int) name[0]);
+
+ Tcl_ExternalToUtfDString(NULL, (char *) &name[1], name[0], &dstr);
+ elemPtr = Tcl_NewStringObj(Tcl_DStringValue(&dstr),
+ Tcl_DStringLength(&dstr));
Tcl_AppendToObj(elemPtr, ":", 1);
Tcl_ListObjAppendElement(interp, resultPtr, elemPtr);
+
+ Tcl_DStringFree(&dstr);
volIndex++;
}
diff --git a/tcl/mac/tclMacFile.c b/tcl/mac/tclMacFile.c
index 60a602eb5c9..ef40b322603 100644
--- a/tcl/mac/tclMacFile.c
+++ b/tcl/mac/tclMacFile.c
@@ -5,7 +5,7 @@
* files. It also comtains Macintosh version of other Tcl
* functions that deal with the file system.
*
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -34,173 +34,19 @@
/*
* Static variables used by the TclpStat function.
*/
-static int initalized = false;
+static int initialized = false;
static long gmt_offset;
+TCL_DECLARE_MUTEX(gmtMutex)
-/*
- * The variable below caches the name of the current working directory
- * in order to avoid repeated calls to getcwd. The string is malloc-ed.
- * NULL means the cache needs to be refreshed.
- */
-
-static char *currentDir = NULL;
-
-/*
- *----------------------------------------------------------------------
- *
- * TclChdir --
- *
- * Change the current working directory.
- *
- * Results:
- * The result is a standard Tcl result. If an error occurs and
- * interp isn't NULL, an error message is left in interp->result.
- *
- * Side effects:
- * The working directory for this application is changed. Also
- * the cache maintained used by TclGetCwd is deallocated and
- * set to NULL.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclChdir(
- Tcl_Interp *interp, /* If non NULL, used for error reporting. */
- char *dirName) /* Path to new working directory. */
-{
- FSSpec spec;
- OSErr err;
- Boolean isFolder;
- long dirID;
-
- if (currentDir != NULL) {
- ckfree(currentDir);
- currentDir = NULL;
- }
-
- err = FSpLocationFromPath(strlen(dirName), dirName, &spec);
- if (err != noErr) {
- errno = ENOENT;
- goto chdirError;
- }
-
- err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
- if (err != noErr) {
- errno = ENOENT;
- goto chdirError;
- }
-
- if (isFolder != true) {
- errno = ENOTDIR;
- goto chdirError;
- }
-
- err = FSpSetDefaultDir(&spec);
- if (err != noErr) {
- switch (err) {
- case afpAccessDenied:
- errno = EACCES;
- break;
- default:
- errno = ENOENT;
- }
- goto chdirError;
- }
-
- return TCL_OK;
- chdirError:
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
- }
- return TCL_ERROR;
-}
/*
*----------------------------------------------------------------------
*
- * TclGetCwd --
- *
- * Return the path name of the current working directory.
- *
- * Results:
- * The result is the full path name of the current working
- * directory, or NULL if an error occurred while figuring it
- * out. If an error occurs and interp isn't NULL, an error
- * message is left in interp->result.
- *
- * Side effects:
- * The path name is cached to avoid having to recompute it
- * on future calls; if it is already cached, the cached
- * value is returned.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-TclGetCwd(
- Tcl_Interp *interp) /* If non NULL, used for error reporting. */
-{
- FSSpec theSpec;
- int length;
- Handle pathHandle = NULL;
-
- if (currentDir == NULL) {
- if (FSpGetDefaultDir(&theSpec) != noErr) {
- if (interp != NULL) {
- interp->result = "error getting working directory name";
- }
- return NULL;
- }
- if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
- if (interp != NULL) {
- interp->result = "error getting working directory name";
- }
- return NULL;
- }
- HLock(pathHandle);
- currentDir = (char *) ckalloc((unsigned) (length + 1));
- strcpy(currentDir, *pathHandle);
- HUnlock(pathHandle);
- DisposeHandle(pathHandle);
- }
- return currentDir;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_WaitPid --
- *
- * Fakes a call to wait pid.
- *
- * Results:
- * Always returns -1.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Pid
-Tcl_WaitPid(
- Tcl_Pid pid,
- int *statPtr,
- int options)
-{
- return (Tcl_Pid) -1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FindExecutable --
+ * TclpFindExecutable --
*
* This procedure computes the absolute path name of the current
* application, given its argv[0] value. However, this
- * implementation doesn't use of need the argv[0] value. NULL
+ * implementation doesn't need the argv[0] value. NULL
* may be passed in its place.
*
* Results:
@@ -214,9 +60,9 @@ Tcl_WaitPid(
*----------------------------------------------------------------------
*/
-void
-Tcl_FindExecutable(
- char *argv0) /* The value of the application's argv[0]. */
+char *
+TclpFindExecutable(
+ CONST char *argv0) /* The value of the application's argv[0]. */
{
ProcessSerialNumber psn;
ProcessInfoRec info;
@@ -225,6 +71,9 @@ Tcl_FindExecutable(
int pathLength;
Handle pathName = NULL;
OSErr err;
+ Tcl_DString ds;
+
+ TclInitSubsystems(argv0);
GetCurrentProcess(&psn);
info.processInfoLength = sizeof(ProcessInfoRec);
@@ -238,52 +87,29 @@ Tcl_FindExecutable(
}
err = FSpPathFromLocation(&fileSpec, &pathLength, &pathName);
-
- tclExecutableName = (char *) ckalloc((unsigned) pathLength + 1);
HLock(pathName);
- strcpy(tclExecutableName, *pathName);
+ Tcl_ExternalToUtfDString(NULL, *pathName, pathLength, &ds);
HUnlock(pathName);
DisposeHandle(pathName);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetUserHome --
- *
- * This function takes the passed in user name and finds the
- * corresponding home directory specified in the password file.
- *
- * Results:
- * On a Macintosh we always return a NULL.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-char *
-TclGetUserHome(
- char *name, /* User name to use to find home directory. */
- Tcl_DString *bufferPtr) /* May be used to hold result. Must not hold
- * anything at the time of the call, and need
- * not even be initialized. */
-{
- return NULL;
+ tclExecutableName = (char *) ckalloc((unsigned)
+ (Tcl_DStringLength(&ds) + 1));
+ strcpy(tclExecutableName, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ return tclExecutableName;
}
/*
*----------------------------------------------------------------------
*
- * TclMatchFiles --
+ * TclpMatchFilesTypes --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
* If the tail argument is NULL, then the matching files are
- * added to the interp->result. Otherwise, TclDoGlob is called
+ * added to the the interp's result. Otherwise, TclDoGlob is called
* recursively for each matching subdirectory. The return value
* is a standard Tcl result indicating whether an error occurred
* in globbing.
@@ -294,17 +120,20 @@ TclGetUserHome(
*---------------------------------------------------------------------- */
int
-TclMatchFiles(
+TclpMatchFilesTypes(
Tcl_Interp *interp, /* Interpreter to receive results. */
char *separators, /* Directory separators to pass to TclDoGlob. */
Tcl_DString *dirPtr, /* Contains path to directory to search. */
char *pattern, /* Pattern to match against. */
- char *tail) /* Pointer to end of pattern. Tail must
- * point to a location in pattern. */
+ char *tail, /* Pointer to end of pattern. Tail must
+ * point to a location in pattern and must
+ * not be static.*/
+ GlobTypeData *types) /* Object containing list of acceptable types.
+ * May be NULL. */
{
- char *dirName, *patternEnd = tail;
+ char *fname, *patternEnd = tail;
char savedChar;
- int result = TCL_OK;
+ int fnameLen, result = TCL_OK;
int baseLength = Tcl_DStringLength(dirPtr);
CInfoPBRec pb;
OSErr err;
@@ -313,15 +142,22 @@ TclMatchFiles(
long dirID;
short itemIndex;
Str255 fileName;
-
+ Tcl_DString fileString;
+ Tcl_Obj *resultPtr;
+ OSType okType = 0;
+ OSType okCreator = 0;
/*
* Make sure that the directory part of the name really is a
* directory.
*/
- dirName = dirPtr->string;
- FSpLocationFromPath(strlen(dirName), dirName, &dirSpec);
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(dirPtr),
+ Tcl_DStringLength(dirPtr), &fileString);
+
+ FSpLocationFromPath(fileString.length, fileString.string, &dirSpec);
+ Tcl_DStringFree(&fileString);
+
err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
if ((err != noErr) || !isDirectory) {
return TCL_OK;
@@ -335,7 +171,7 @@ TclMatchFiles(
pb.hFileInfo.ioDirID = dirID;
pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
pb.hFileInfo.ioFDirIndex = itemIndex = 1;
-
+
/*
* Clean up the end of the pattern and the tail pointer. Leave
* the tail pointing to the first character after the path separator
@@ -354,6 +190,16 @@ TclMatchFiles(
savedChar = *patternEnd;
*patternEnd = '\0';
+ resultPtr = Tcl_GetObjResult(interp);
+ if (types != NULL) {
+ if (types->macType != NULL) {
+ Tcl_GetOSTypeFromObj(NULL, types->macType, &okType);
+ }
+ if (types->macCreator != NULL) {
+ Tcl_GetOSTypeFromObj(NULL, types->macCreator, &okCreator);
+ }
+ }
+
while (1) {
pb.hFileInfo.ioFDirIndex = itemIndex;
pb.hFileInfo.ioDirID = dirID;
@@ -368,27 +214,97 @@ TclMatchFiles(
* directories before calling TclDoGlob. Otherwise, just add
* the file to the result.
*/
-
- p2cstr(fileName);
- if (Tcl_StringMatch((char *) fileName, pattern)) {
+
+ Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],
+ &fileString);
+ if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {
Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, (char *) fileName, -1);
+ Tcl_DStringAppend(dirPtr, Tcl_DStringValue(&fileString), -1);
+ fname = Tcl_DStringValue(dirPtr);
+ fnameLen = Tcl_DStringLength(dirPtr);
if (tail == NULL) {
- if ((dirPtr->length > 1) &&
- (strchr(dirPtr->string+1, ':') == NULL)) {
- Tcl_AppendElement(interp, dirPtr->string+1);
- } else {
- Tcl_AppendElement(interp, dirPtr->string);
+ int typeOk = 1;
+ if (types != NULL) {
+ if (types->perm != 0) {
+ if (
+ ((types->perm & TCL_GLOB_PERM_RONLY) &&
+ !(pb.hFileInfo.ioFlAttrib & 1)) ||
+ ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
+ !(pb.hFileInfo.ioFlFndrInfo.fdFlags &
+ kIsInvisible)) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (TclpAccess(fname, R_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (TclpAccess(fname, W_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (TclpAccess(fname, X_OK) != 0))
+ ) {
+ typeOk = 0;
+ }
+ }
+ if (typeOk == 1 && types->type != 0) {
+ struct stat buf;
+ /*
+ * We must match at least one flag to be listed
+ */
+ typeOk = 0;
+ if (TclpLstat(fname, &buf) >= 0) {
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
+ if (
+ ((types->type & TCL_GLOB_TYPE_BLOCK) &&
+ S_ISBLK(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_CHAR) &&
+ S_ISCHR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_DIR) &&
+ S_ISDIR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_PIPE) &&
+ S_ISFIFO(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_FILE) &&
+ S_ISREG(buf.st_mode))
+#ifdef S_ISLNK
+ || ((types->type & TCL_GLOB_TYPE_LINK) &&
+ S_ISLNK(buf.st_mode))
+#endif
+#ifdef S_ISSOCK
+ || ((types->type & TCL_GLOB_TYPE_SOCK) &&
+ S_ISSOCK(buf.st_mode))
+#endif
+ ) {
+ typeOk = 1;
+ }
+ } else {
+ /* Posix error occurred */
+ }
+ }
+ if (typeOk && (
+ ((okType != 0) && (okType !=
+ pb.hFileInfo.ioFlFndrInfo.fdType)) ||
+ ((okCreator != 0) && (okCreator !=
+ pb.hFileInfo.ioFlFndrInfo.fdCreator)))) {
+ typeOk = 0;
+ }
+ }
+ if (typeOk) {
+ if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fname+1, fnameLen-1));
+ } else {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fname, fnameLen));
+ }
}
} else if ((pb.hFileInfo.ioFlAttrib & ioDirMask) != 0) {
Tcl_DStringAppend(dirPtr, ":", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail);
+ result = TclDoGlob(interp, separators, dirPtr, tail, types);
if (result != TCL_OK) {
+ Tcl_DStringFree(&fileString);
break;
}
}
}
-
+ Tcl_DStringFree(&fileString);
itemIndex++;
}
*patternEnd = savedChar;
@@ -396,28 +312,45 @@ TclMatchFiles(
return result;
}
+/*
+ * TclpMatchFiles --
+ *
+ * This function is now obsolete. Call the above function
+ * 'TclpMatchFilesTypes' instead.
+ */
+int
+TclpMatchFiles(
+ Tcl_Interp *interp, /* Interpreter to receive results. */
+ char *separators, /* Directory separators to pass to TclDoGlob. */
+ Tcl_DString *dirPtr, /* Contains path to directory to search. */
+ char *pattern, /* Pattern to match against. */
+ char *tail) /* Pointer to end of pattern. Tail must
+ * point to a location in pattern and must
+ * not be static.*/
+{
+ return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
+}
+
/*
*----------------------------------------------------------------------
*
- * TclpStat --
+ * TclpAccess --
*
- * This function replaces the library version of stat. The stat
- * function provided by most Mac compiliers is rather broken and
- * incomplete.
+ * This function replaces the library version of access().
*
* Results:
- * See stat documentation.
+ * See access documentation.
*
* Side effects:
- * See stat documentation.
+ * See access documentation.
*
*----------------------------------------------------------------------
*/
int
-TclpStat(
- CONST char *path,
- struct stat *buf)
+TclpAccess(
+ CONST char *path, /* Path of file to access (UTF-8). */
+ int mode) /* Permission setting. */
{
HFileInfo fpb;
HVolumeParam vpb;
@@ -425,8 +358,14 @@ TclpStat(
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
-
- err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+ Tcl_DString ds;
+ char *native;
+ int full_mode = 0;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &fileSpec);
+ Tcl_DStringFree(&ds);
+
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
return -1;
@@ -435,7 +374,6 @@ TclpStat(
/*
* Fill the fpb & vpb struct up with info about file or directory.
*/
-
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
@@ -450,101 +388,189 @@ TclpStat(
if (err == noErr) {
vpb.ioVolIndex = 0;
err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
- if (err == noErr && buf != NULL) {
+ if (err == noErr) {
/*
- * Files are always readable by everyone.
+ * Use the Volume Info & File Info to determine
+ * access information. If we have got this far
+ * we know the directory is searchable or the file
+ * exists. (We have F_OK)
*/
-
- buf->st_mode = S_IRUSR | S_IRGRP | S_IROTH;
- /*
- * Use the Volume Info & File Info to fill out stat buf.
+ /*
+ * Check to see if the volume is hardware or
+ * software locked. If so we arn't W_OK.
*/
- if (fpb.ioFlAttrib & 0x10) {
- buf->st_mode |= S_IFDIR;
- buf->st_nlink = 2;
- } else {
- buf->st_nlink = 1;
- if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
- buf->st_mode |= S_IFLNK;
- } else {
- buf->st_mode |= S_IFREG;
+ if (mode & W_OK) {
+ if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {
+ errno = EROFS;
+ return -1;
+ }
+ if (fpb.ioFlAttrib & 0x01) {
+ errno = EACCES;
+ return -1;
}
}
- if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
- /*
- * Directories and applications are executable by everyone.
- */
-
- buf->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
- }
- if ((fpb.ioFlAttrib & 0x01) == 0){
- /*
- * If not locked, then everyone has write acces.
- */
-
- buf->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
- }
- buf->st_ino = fpb.ioDirID;
- buf->st_dev = fpb.ioVRefNum;
- buf->st_uid = -1;
- buf->st_gid = -1;
- buf->st_rdev = 0;
- buf->st_size = fpb.ioFlLgLen;
- buf->st_blksize = vpb.ioVAlBlkSiz;
- buf->st_blocks = (buf->st_size + buf->st_blksize - 1)
- / buf->st_blksize;
-
+
/*
- * The times returned by the Mac file system are in the
- * local time zone. We convert them to GMT so that the
- * epoch starts from GMT. This is also consistant with
- * what is returned from "clock seconds".
+ * Directories are always searchable and executable. But only
+ * files of type 'APPL' are executable.
*/
- if (initalized == false) {
- MachineLocation loc;
-
- ReadLocation(&loc);
- gmt_offset = loc.u.gmtDelta & 0x00ffffff;
- if (gmt_offset & 0x00800000) {
- gmt_offset = gmt_offset | 0xff000000;
- }
- initalized = true;
+ if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
+ && (fpb.ioFlFndrInfo.fdType != 'APPL')) {
+ return -1;
}
- buf->st_atime = buf->st_mtime = fpb.ioFlMdDat - gmt_offset;
- buf->st_ctime = fpb.ioFlCrDat - gmt_offset;
-
}
}
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
+ return -1;
}
- return (err == noErr ? 0 : -1);
+ return 0;
}
/*
*----------------------------------------------------------------------
*
- * TclMacReadlink --
+ * TclpChdir --
*
- * This function replaces the library version of readlink.
+ * This function replaces the library version of chdir().
*
* Results:
- * See readlink documentation.
+ * See chdir() documentation.
*
* Side effects:
- * None.
+ * See chdir() documentation. Also the cache maintained used by
+ * TclGetCwd() is deallocated and set to NULL.
*
*----------------------------------------------------------------------
*/
int
-TclMacReadlink(
- char *path,
- char *buf,
- int size)
+TclpChdir(
+ CONST char *dirName) /* Path to new working directory (UTF-8). */
+{
+ FSSpec spec;
+ OSErr err;
+ Boolean isFolder;
+ long dirID;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &spec);
+ Tcl_DStringFree(&ds);
+
+ if (err != noErr) {
+ errno = ENOENT;
+ return -1;
+ }
+
+ err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
+ if (err != noErr) {
+ errno = ENOENT;
+ return -1;
+ }
+
+ if (isFolder != true) {
+ errno = ENOTDIR;
+ return -1;
+ }
+
+ err = FSpSetDefaultDir(&spec);
+ if (err != noErr) {
+ switch (err) {
+ case afpAccessDenied:
+ errno = EACCES;
+ break;
+ default:
+ errno = ENOENT;
+ }
+ return -1;
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetCwd --
+ *
+ * This function replaces the library version of getcwd().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the current
+ * directory, or NULL if the current directory could not be
+ * determined. If NULL is returned, an error message is left in the
+ * interp's result. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetCwd(
+ Tcl_Interp *interp, /* If non-NULL, used for error reporting. */
+ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled
+ * with name of current directory. */
+{
+ FSSpec theSpec;
+ int length;
+ Handle pathHandle = NULL;
+
+ if (FSpGetDefaultDir(&theSpec) != noErr) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "error getting working directory name",
+ TCL_STATIC);
+ }
+ return NULL;
+ }
+ if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "error getting working directory name",
+ TCL_STATIC);
+ }
+ return NULL;
+ }
+ HLock(pathHandle);
+ Tcl_ExternalToUtfDString(NULL, *pathHandle, length, bufferPtr);
+ HUnlock(pathHandle);
+ DisposeHandle(pathHandle);
+
+ return Tcl_DStringValue(bufferPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpReadlink --
+ *
+ * This function replaces the library version of readlink().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the contents
+ * of the symbolic link given by 'path', or NULL if the symbolic
+ * link could not be read. Storage for the result string is
+ * allocated in bufferPtr; the caller must call Tcl_DStringFree()
+ * when the result is no longer needed.
+ *
+ * Side effects:
+ * See readlink() documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclpReadlink(
+ CONST char *path, /* Path of file to readlink (UTF-8). */
+ Tcl_DString *linkPtr) /* Uninitialized or free DString filled
+ * with contents of link (UTF-8). */
{
HFileInfo fpb;
OSErr err;
@@ -552,45 +578,54 @@ TclMacReadlink(
Boolean isDirectory;
Boolean wasAlias;
long dirID;
- char fileName[256];
+ char fileName[257];
char *end;
Handle theString = NULL;
int pathSize;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
/*
* Remove ending colons if they exist.
*/
- while ((strlen(path) != 0) && (path[strlen(path) - 1] == ':')) {
- path[strlen(path) - 1] = NULL;
+
+ while ((strlen(native) != 0) && (path[strlen(native) - 1] == ':')) {
+ native[strlen(native) - 1] = NULL;
}
- if (strchr(path, ':') == NULL) {
- strcpy(fileName, path);
- path = NULL;
+ if (strchr(native, ':') == NULL) {
+ strcpy(fileName + 1, native);
+ native = NULL;
} else {
- end = strrchr(path, ':') + 1;
- strcpy(fileName, end);
+ end = strrchr(native, ':') + 1;
+ strcpy(fileName + 1, end);
*end = NULL;
}
- c2pstr(fileName);
+ fileName[0] = (char) strlen(fileName + 1);
/*
* Create the file spec for the directory of the file
* we want to look at.
*/
- if (path != NULL) {
- err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+
+ if (native != NULL) {
+ err = FSpLocationFromPath(strlen(native), native, &fileSpec);
if (err != noErr) {
+ Tcl_DStringFree(&ds);
errno = EINVAL;
- return -1;
+ return NULL;
}
} else {
FSMakeFSSpecCompat(0, 0, NULL, &fileSpec);
}
+ Tcl_DStringFree(&ds);
/*
* Fill the fpb struct up with info about file or directory.
*/
+
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
fpb.ioVRefNum = fileSpec.vRefNum;
fpb.ioDirID = dirID;
@@ -600,11 +635,11 @@ TclMacReadlink(
err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
- return -1;
+ return NULL;
} else {
if (fpb.ioFlAttrib & 0x10) {
errno = EINVAL;
- return -1;
+ return NULL;
} else {
if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
/*
@@ -612,7 +647,7 @@ TclMacReadlink(
*/
} else {
errno = EINVAL;
- return -1;
+ return NULL;
}
}
}
@@ -621,50 +656,77 @@ TclMacReadlink(
* If we are here it's really a link - now find out
* where it points to.
*/
- err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName, &fileSpec);
+ err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName,
+ &fileSpec);
if (err == noErr) {
err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);
}
if ((err == fnfErr) || wasAlias) {
err = FSpPathFromLocation(&fileSpec, &pathSize, &theString);
- if ((err != noErr) || (pathSize > size)) {
+ if (err != noErr) {
DisposeHandle(theString);
errno = ENAMETOOLONG;
- return -1;
+ return NULL;
}
} else {
errno = EINVAL;
- return -1;
+ return NULL;
}
-
- strncpy(buf, *theString, pathSize);
+
+ Tcl_ExternalToUtfDString(NULL, *theString, pathSize, linkPtr);
DisposeHandle(theString);
- return pathSize;
+ return Tcl_DStringValue(linkPtr);
}
/*
*----------------------------------------------------------------------
*
- * TclpAccess --
+ * TclpLstat --
*
- * This function replaces the library version of access. The
- * access function provided by most Mac compiliers is rather
- * broken or incomplete.
+ * This function replaces the library version of lstat().
*
* Results:
- * See access documentation.
+ * See stat() documentation.
*
* Side effects:
- * See access documentation.
+ * See stat() documentation.
*
*----------------------------------------------------------------------
*/
int
-TclpAccess(
- const char *path,
- int mode)
+TclpLstat(
+ CONST char *path, /* Path of file to stat (in UTF-8). */
+ struct stat *bufPtr) /* Filled with results of stat call. */
+{
+ /*
+ * FIXME: Emulate TclpLstat
+ */
+
+ return TclpStat(path, bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpStat --
+ *
+ * This function replaces the library version of stat().
+ *
+ * Results:
+ * See stat() documentation.
+ *
+ * Side effects:
+ * See stat() documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpStat(
+ CONST char *path, /* Path of file to stat (in UTF-8). */
+ struct stat *bufPtr) /* Filled with results of stat call. */
{
HFileInfo fpb;
HVolumeParam vpb;
@@ -672,9 +734,12 @@ TclpAccess(
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
- int full_mode = 0;
-
- err = FSpLocationFromPath(strlen(path), (char *) path, &fileSpec);
+ Tcl_DString ds;
+
+ path = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), path, &fileSpec);
+ Tcl_DStringFree(&ds);
+
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
return -1;
@@ -683,6 +748,7 @@ TclpAccess(
/*
* Fill the fpb & vpb struct up with info about file or directory.
*/
+
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
@@ -697,46 +763,106 @@ TclpAccess(
if (err == noErr) {
vpb.ioVolIndex = 0;
err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
- if (err == noErr) {
+ if (err == noErr && bufPtr != NULL) {
/*
- * Use the Volume Info & File Info to determine
- * access information. If we have got this far
- * we know the directory is searchable or the file
- * exists. (We have F_OK)
+ * Files are always readable by everyone.
*/
+
+ bufPtr->st_mode = S_IRUSR | S_IRGRP | S_IROTH;
- /*
- * Check to see if the volume is hardware or
- * software locked. If so we arn't W_OK.
+ /*
+ * Use the Volume Info & File Info to fill out stat buf.
*/
- if (mode & W_OK) {
- if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {
- errno = EROFS;
- return -1;
- }
- if (fpb.ioFlAttrib & 0x01) {
- errno = EACCES;
- return -1;
+ if (fpb.ioFlAttrib & 0x10) {
+ bufPtr->st_mode |= S_IFDIR;
+ bufPtr->st_nlink = 2;
+ } else {
+ bufPtr->st_nlink = 1;
+ if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
+ bufPtr->st_mode |= S_IFLNK;
+ } else {
+ bufPtr->st_mode |= S_IFREG;
}
}
-
+ if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
+ /*
+ * Directories and applications are executable by everyone.
+ */
+
+ bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
+ }
+ if ((fpb.ioFlAttrib & 0x01) == 0){
+ /*
+ * If not locked, then everyone has write acces.
+ */
+
+ bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
+ }
+ bufPtr->st_ino = fpb.ioDirID;
+ bufPtr->st_dev = fpb.ioVRefNum;
+ bufPtr->st_uid = -1;
+ bufPtr->st_gid = -1;
+ bufPtr->st_rdev = 0;
+ bufPtr->st_size = fpb.ioFlLgLen;
+ bufPtr->st_blksize = vpb.ioVAlBlkSiz;
+ bufPtr->st_blocks = (bufPtr->st_size + bufPtr->st_blksize - 1)
+ / bufPtr->st_blksize;
+
/*
- * Directories are always searchable and executable. But only
- * files of type 'APPL' are executable.
+ * The times returned by the Mac file system are in the
+ * local time zone. We convert them to GMT so that the
+ * epoch starts from GMT. This is also consistant with
+ * what is returned from "clock seconds".
*/
- if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
- && (fpb.ioFlFndrInfo.fdType != 'APPL')) {
- return -1;
+
+ Tcl_MutexLock(&gmtMutex);
+ if (initialized == false) {
+ MachineLocation loc;
+
+ ReadLocation(&loc);
+ gmt_offset = loc.u.gmtDelta & 0x00ffffff;
+ if (gmt_offset & 0x00800000) {
+ gmt_offset = gmt_offset | 0xff000000;
+ }
+ initialized = true;
}
+ Tcl_MutexUnlock(&gmtMutex);
+
+ bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat - gmt_offset;
+ bufPtr->st_ctime = fpb.ioFlCrDat - gmt_offset;
}
}
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
- return -1;
}
- return 0;
+ return (err == noErr ? 0 : -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitPid --
+ *
+ * Fakes a call to wait pid.
+ *
+ * Results:
+ * Always returns -1.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Pid
+Tcl_WaitPid(
+ Tcl_Pid pid,
+ int *statPtr,
+ int options)
+{
+ return (Tcl_Pid) -1;
}
/*
@@ -759,8 +885,8 @@ TclpAccess(
#undef fopen
FILE *
TclMacFOpenHack(
- const char *path,
- const char *mode)
+ CONST char *path,
+ CONST char *mode)
{
OSErr err;
FSSpec fileSpec;
@@ -785,6 +911,36 @@ TclMacFOpenHack(
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpGetUserHome --
+ *
+ * This function takes the specified user name and finds their
+ * home directory.
+ *
+ * Results:
+ * The result is a pointer to a string specifying the user's home
+ * directory, or NULL if the user's home directory could not be
+ * determined. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetUserHome(name, bufferPtr)
+ CONST char *name; /* User name for desired home directory. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name of user's home directory. */
+{
+ return NULL;
+}
+
+/*
*----------------------------------------------------------------------
*
* TclMacOSErrorToPosixError --
@@ -838,3 +994,30 @@ TclMacOSErrorToPosixError(
return EINVAL;
}
}
+int
+TclMacChmod(
+ char *path,
+ int mode)
+{
+ HParamBlockRec hpb;
+ OSErr err;
+
+ c2pstr(path);
+ hpb.fileParam.ioNamePtr = (unsigned char *) path;
+ hpb.fileParam.ioVRefNum = 0;
+ hpb.fileParam.ioDirID = 0;
+
+ if (mode & 0200) {
+ err = PBHRstFLockSync(&hpb);
+ } else {
+ err = PBHSetFLockSync(&hpb);
+ }
+ p2cstr((unsigned char *) path);
+
+ if (err != noErr) {
+ errno = TclMacOSErrorToPosixError(err);
+ return -1;
+ }
+
+ return 0;
+}
diff --git a/tcl/mac/tclMacInit.c b/tcl/mac/tclMacInit.c
index 218ca12a156..095455957d5 100644
--- a/tcl/mac/tclMacInit.c
+++ b/tcl/mac/tclMacInit.c
@@ -3,7 +3,7 @@
*
* Contains the Mac-specific interpreter initialization functions.
*
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -11,51 +11,510 @@
* RCS: @(#) $Id$
*/
+#include <AppleEvents.h>
+#include <AEDataModel.h>
+#include <AEObjects.h>
+#include <AEPackObject.h>
+#include <AERegistry.h>
#include <Files.h>
+#include <Folders.h>
#include <Gestalt.h>
#include <TextUtils.h>
#include <Resources.h>
#include <Strings.h>
#include "tclInt.h"
#include "tclMacInt.h"
+#include "tclPort.h"
+
+/*
+ * The following string is the startup script executed in new
+ * interpreters. It looks on the library path and in the resource fork for
+ * a script "init.tcl" that is compatible with this version of Tcl. The
+ * init.tcl script does all of the real work of initialization.
+ */
+
+static char initCmd[] = "\
+proc sourcePath {file} {\n\
+ set dirs {}\n\
+ foreach i $::auto_path {\n\
+ set init [file join $i $file.tcl]\n\
+ if {[catch {uplevel #0 [list source $init]}] == 0} {\n\
+ return\n\
+ }\n\
+ }\n\
+ if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\
+ return\n\
+ }\n\
+ rename sourcePath {}\n\
+ set msg \"can't find $file resource or a usable $file.tcl file\n\"\n\
+ append msg \"in the following directories:\n\"\n\
+ append msg \" $::auto_path\n\"\n\
+ append msg \" perhaps you need to install Tcl or set your \n\"\n\
+ append msg \"TCL_LIBRARY environment variable?\"\n\
+ error $msg\n\
+}\n\
+if {[info exists env(EXT_FOLDER)]} {\n\
+ lappend tcl_pkgPath [file join $env(EXT_FOLDER) {:Tool Command Language}]\n\
+}\n\
+if {[info exists tcl_pkgPath] == 0} {\n\
+ set tcl_pkgPath {no extension folder}\n\
+}\n\
+sourcePath Init\n\
+sourcePath Auto\n\
+sourcePath Package\n\
+sourcePath History\n\
+sourcePath Word\n\
+rename sourcePath {}";
+
+/*
+ * The following structures are used to map the script/language codes of a
+ * font to the name that should be passed to Tcl_GetEncoding() to obtain
+ * the encoding for that font. The set of numeric constants is fixed and
+ * defined by Apple.
+ */
+
+typedef struct Map {
+ int numKey;
+ char *strKey;
+} Map;
+
+static Map scriptMap[] = {
+ {smRoman, "macRoman"},
+ {smJapanese, "macJapan"},
+ {smTradChinese, "macChinese"},
+ {smKorean, "macKorean"},
+ {smArabic, "macArabic"},
+ {smHebrew, "macHebrew"},
+ {smGreek, "macGreek"},
+ {smCyrillic, "macCyrillic"},
+ {smRSymbol, "macRSymbol"},
+ {smDevanagari, "macDevanagari"},
+ {smGurmukhi, "macGurmukhi"},
+ {smGujarati, "macGujarati"},
+ {smOriya, "macOriya"},
+ {smBengali, "macBengali"},
+ {smTamil, "macTamil"},
+ {smTelugu, "macTelugu"},
+ {smKannada, "macKannada"},
+ {smMalayalam, "macMalayalam"},
+ {smSinhalese, "macSinhalese"},
+ {smBurmese, "macBurmese"},
+ {smKhmer, "macKhmer"},
+ {smThai, "macThailand"},
+ {smLaotian, "macLaos"},
+ {smGeorgian, "macGeorgia"},
+ {smArmenian, "macArmenia"},
+ {smSimpChinese, "macSimpChinese"},
+ {smTibetan, "macTIbet"},
+ {smMongolian, "macMongolia"},
+ {smGeez, "macEthiopia"},
+ {smEastEurRoman, "macCentEuro"},
+ {smVietnamese, "macVietnam"},
+ {smExtArabic, "macSindhi"},
+ {NULL, NULL}
+};
+
+static Map romanMap[] = {
+ {langCroatian, "macCroatian"},
+ {langSlovenian, "macCroatian"},
+ {langIcelandic, "macIceland"},
+ {langRomanian, "macRomania"},
+ {langTurkish, "macTurkish"},
+ {langGreek, "macGreek"},
+ {NULL, NULL}
+};
+
+static Map cyrillicMap[] = {
+ {langUkrainian, "macUkraine"},
+ {langBulgarian, "macBulgaria"},
+ {NULL, NULL}
+};
+
+static int GetFinderFont(int *finderID);
+
/*
*----------------------------------------------------------------------
*
- * TclPlatformInit --
+ * GetFinderFont --
*
- * Performs Mac-specific interpreter initialization related to the
- * tcl_platform and tcl_library variables.
+ * Gets the "views" font of the Macintosh Finder
*
* Results:
- * None.
+ * Standard Tcl result, and sets finderID to the font family
+ * id for the current finder font.
*
* Side effects:
- * Sets "tcl_library" & "tcl_platfrom" Tcl variable
+ * None.
*
*----------------------------------------------------------------------
*/
+static int
+GetFinderFont(int *finderID)
+{
+ OSErr err = noErr;
+ OSType finderPrefs, viewFont = 'vfnt';
+ DescType returnType;
+ Size returnSize;
+ long result, sys8Mask = 0x0800;
+ static AppleEvent outgoingAevt = {typeNull, NULL};
+ AppleEvent returnAevt;
+ AEAddressDesc fndrAddress;
+ AEDesc nullContainer = {typeNull, NULL},
+ tempDesc = {typeNull, NULL},
+ tempDesc2 = {typeNull, NULL},
+ finalDesc = {typeNull, NULL};
+ const OSType finderSignature = 'MACS';
+
+
+ if (outgoingAevt.descriptorType == typeNull) {
+ if ((Gestalt(gestaltSystemVersion, &result) != noErr)
+ || (result >= sys8Mask)) {
+ finderPrefs = 'pfrp';
+ } else {
+ finderPrefs = 'pvwp';
+ }
+
+ AECreateDesc(typeApplSignature, &finderSignature,
+ sizeof(finderSignature), &fndrAddress);
+
+ err = AECreateAppleEvent(kAECoreSuite, kAEGetData, &fndrAddress,
+ kAutoGenerateReturnID, kAnyTransactionID, &outgoingAevt);
+
+ AEDisposeDesc(&fndrAddress);
+
+ /*
+ * The structure is:
+ * the property view font ('vfnt')
+ * of the property view preferences ('pvwp')
+ * of the Null Container (i.e. the Finder itself).
+ */
+
+ AECreateDesc(typeType, &finderPrefs, sizeof(finderPrefs), &tempDesc);
+ err = CreateObjSpecifier(typeType, &nullContainer, formPropertyID,
+ &tempDesc, true, &tempDesc2);
+ AECreateDesc(typeType, &viewFont, sizeof(viewFont), &tempDesc);
+ err = CreateObjSpecifier(typeType, &tempDesc2, formPropertyID,
+ &tempDesc, true, &finalDesc);
+
+ AEPutKeyDesc(&outgoingAevt, keyDirectObject, &finalDesc);
+ AEDisposeDesc(&finalDesc);
+ }
+
+ err = AESend(&outgoingAevt, &returnAevt, kAEWaitReply, kAEHighPriority,
+ kAEDefaultTimeout, NULL, NULL);
+ if (err == noErr) {
+ err = AEGetKeyPtr(&returnAevt, keyDirectObject, typeInteger,
+ &returnType, (void *) finderID, sizeof(int), &returnSize);
+ if (err == noErr) {
+ return TCL_OK;
+ }
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclMacGetFontEncoding --
+ *
+ * Determine the encoding of the specified font. The encoding
+ * can be used to convert bytes from UTF-8 into the encoding of
+ * that font.
+ *
+ * Results:
+ * The return value is a string that specifies the font's encoding
+ * and that can be passed to Tcl_GetEncoding() to construct the
+ * encoding. If the font's encoding could not be identified, NULL
+ * is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclMacGetFontEncoding(
+ int fontId)
+{
+ int script, lang;
+ char *name;
+ Map *mapPtr;
+
+ script = FontToScript(fontId);
+ lang = GetScriptVariable(script, smScriptLang);
+ name = NULL;
+ if (script == smRoman) {
+ for (mapPtr = romanMap; mapPtr->strKey != NULL; mapPtr++) {
+ if (mapPtr->numKey == lang) {
+ name = mapPtr->strKey;
+ break;
+ }
+ }
+ } else if (script == smCyrillic) {
+ for (mapPtr = cyrillicMap; mapPtr->strKey != NULL; mapPtr++) {
+ if (mapPtr->numKey == lang) {
+ name = mapPtr->strKey;
+ break;
+ }
+ }
+ }
+ if (name == NULL) {
+ for (mapPtr = scriptMap; mapPtr->strKey != NULL; mapPtr++) {
+ if (mapPtr->numKey == script) {
+ name = mapPtr->strKey;
+ break;
+ }
+ }
+ }
+ return name;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpInitPlatform --
+ *
+ * Initialize all the platform-dependant things like signals and
+ * floating-point error handling.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
void
-TclPlatformInit(
- Tcl_Interp *interp) /* Tcl interpreter to initialize. */
+TclpInitPlatform()
{
- char *libDir;
- Tcl_DString path, libPath;
- long int gestaltResult;
- int minor, major;
- char versStr[10];
+ tclPlatform = TCL_PLATFORM_MAC;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpInitLibraryPath --
+ *
+ * Initialize the library path at startup. We have a minor
+ * metacircular problem that we don't know the encoding of the
+ * operating system but we may need to talk to operating system
+ * to find the library directories so that we know how to talk to
+ * the operating system.
+ *
+ * We do not know the encoding of the operating system.
+ * We do know that the encoding is some multibyte encoding.
+ * In that multibyte encoding, the characters 0..127 are equivalent
+ * to ascii.
+ *
+ * So although we don't know the encoding, it's safe:
+ * to look for the last colon character in a path in the encoding.
+ * to append an ascii string to a path.
+ * to pass those strings back to the operating system.
+ *
+ * But any strings that we remembered before we knew the encoding of
+ * the operating system must be translated to UTF-8 once we know the
+ * encoding so that the rest of Tcl can use those strings.
+ *
+ * This call sets the library path to strings in the unknown native
+ * encoding. TclpSetInitialEncodings() will translate the library
+ * path from the native encoding to UTF-8 as soon as it determines
+ * what the native encoding actually is.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclpInitLibraryPath(argv0)
+ CONST char *argv0; /* Name of executable from argv[0] to main().
+ * Not used because we can determine the name
+ * by querying the module handle. */
+{
+ Tcl_Obj *objPtr, *pathPtr;
+ char *str;
+ Tcl_DString ds;
+
+ TclMacCreateEnv();
+ pathPtr = Tcl_NewObj();
+
+ str = TclGetEnv("TCL_LIBRARY", &ds);
+ if ((str != NULL) && (str[0] != '\0')) {
+ /*
+ * If TCL_LIBRARY is set, search there.
+ */
+
+ objPtr = Tcl_NewStringObj(str, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+
+ objPtr = TclGetLibraryPath();
+ if (objPtr != NULL) {
+ Tcl_ListObjAppendList(NULL, pathPtr, objPtr);
+ }
+
/*
- * Set runtime C variable that tells cross platform C functions
- * what platform they are running on. This can change at
- * runtime for testing purposes.
+ * lappend path [file join $env(EXT_FOLDER) \
+ * ":Tool Command Language:tcl[info version]"
*/
- tclPlatform = TCL_PLATFORM_MAC;
+
+ str = TclGetEnv("EXT_FOLDER", &ds);
+ if ((str != NULL) && (str[0] != '\0')) {
+ objPtr = Tcl_NewStringObj(str, -1);
+ if (str[strlen(str) - 1] != ':') {
+ Tcl_AppendToObj(objPtr, ":", 1);
+ }
+ Tcl_AppendToObj(objPtr, "Tool Command Language:tcl" TCL_VERSION, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ TclSetLibraryPath(pathPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpSetInitialEncodings --
+ *
+ * Based on the locale, determine the encoding of the operating
+ * system and the default encoding for newly opened files.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The Tcl library path is converted from native encoding to UTF-8.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclpSetInitialEncodings()
+{
+ CONST char *encoding;
+ Tcl_Obj *pathPtr;
+ int fontId;
+ fontId = 0;
+ GetFinderFont(&fontId);
+ encoding = TclMacGetFontEncoding(fontId);
+ if (encoding == NULL) {
+ encoding = "macRoman";
+ }
+
+ Tcl_SetSystemEncoding(NULL, encoding);
+
+ /*
+ * Until the system encoding was actually set, the library path was
+ * actually in the native multi-byte encoding, and not really UTF-8
+ * as advertised. We cheated as follows:
+ *
+ * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
+ * append the ASCII chars that make up the encoding's filename to
+ * the names (in the native encoding) of directories in the library
+ * path, since all Unix multi-byte encodings have ASCII in the
+ * beginning.
+ *
+ * 2. To open the encoding file, the native bytes in the file name
+ * were passed to the OS, without translating from UTF-8 to native,
+ * because the name was already in the native encoding.
+ *
+ * Now that the system encoding was actually successfully set,
+ * translate all the names in the library path to UTF-8. That way,
+ * next time we search the library path, we'll translate the names
+ * from UTF-8 to the system encoding which will be the native
+ * encoding.
+ */
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int i, objc;
+ Tcl_Obj **objv;
+
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ for (i = 0; i < objc; i++) {
+ int length;
+ char *string;
+ Tcl_DString ds;
+
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ }
+
/*
- * Define the tcl_platfrom variable.
+ * Keep the iso8859-1 encoding preloaded. The IO package uses it for
+ * gets on a binary channel.
*/
+
+ Tcl_GetEncoding(NULL, "iso8859-1");
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpSetVariables --
+ *
+ * Performs platform-specific interpreter initialization related to
+ * the tcl_library and tcl_platform variables, and other platform-
+ * specific things.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets "tcl_library" and "tcl_platform" Tcl variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpSetVariables(interp)
+ Tcl_Interp *interp;
+{
+ long int gestaltResult;
+ int minor, major, objc;
+ Tcl_Obj **objv;
+ char versStr[2 * TCL_INTEGER_SPACE];
+ char *str;
+ Tcl_Obj *pathPtr;
+ Tcl_DString ds;
+
+ str = "no library";
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ if (objc > 0) {
+ str = Tcl_GetStringFromObj(objv[0], NULL);
+ }
+ }
+ Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY);
+
+ if (pathPtr != NULL) {
+ Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
+ }
+
Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
@@ -71,47 +530,20 @@ TclPlatformInit(
#endif
/*
- * The tcl_library path can be found in one of two places. As an element
- * in the env array. Or the default which is to a folder in side the
- * Extensions folder of your system.
+ * Copy USER or LOGIN environment variable into tcl_platform(user)
+ * These are set by SystemVariables in tclMacEnv.c
*/
-
- Tcl_DStringInit(&path);
- libDir = Tcl_GetVar2(interp, "env", "TCL_LIBRARY", TCL_GLOBAL_ONLY);
- if (libDir != NULL) {
- Tcl_SetVar(interp, "tcl_library", libDir, TCL_GLOBAL_ONLY);
- } else {
- libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
- if (libDir != NULL) {
- Tcl_JoinPath(1, &libDir, &path);
-
- Tcl_DStringInit(&libPath);
- Tcl_DStringAppend(&libPath, ":Tool Command Language:tcl", -1);
- Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
- Tcl_JoinPath(1, &libPath.string, &path);
- Tcl_DStringFree(&libPath);
- Tcl_SetVar(interp, "tcl_library", path.string, TCL_GLOBAL_ONLY);
- } else {
- Tcl_SetVar(interp, "tcl_library", "no library", TCL_GLOBAL_ONLY);
+
+ Tcl_DStringInit(&ds);
+ str = TclGetEnv("USER", &ds);
+ if (str == NULL) {
+ str = TclGetEnv("LOGIN", &ds);
+ if (str == NULL) {
+ str = "";
}
}
-
- /*
- * Now create the tcl_pkgPath variable.
- */
- Tcl_DStringSetLength(&path, 0);
- libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
- if (libDir != NULL) {
- Tcl_JoinPath(1, &libDir, &path);
- libDir = ":Tool Command Language:";
- Tcl_JoinPath(1, &libDir, &path);
- Tcl_SetVar(interp, "tcl_pkgPath", path.string,
- TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
- } else {
- Tcl_SetVar(interp, "tcl_pkgPath", "no extension folder",
- TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
- }
- Tcl_DStringFree(&path);
+ Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&ds);
}
/*
@@ -141,6 +573,64 @@ TclpCheckStackSpace()
/*
*----------------------------------------------------------------------
*
+ * TclpFindVariable --
+ *
+ * Locate the entry in environ for a given name. On Unix and Macthis
+ * routine is case sensitive, on Windows this matches mixed case.
+ *
+ * Results:
+ * The return value is the index in environ of an entry with the
+ * name "name", or -1 if there is no such entry. The integer at
+ * *lengthPtr is filled in with the length of name (if a matching
+ * entry is found) or the length of the environ array (if no matching
+ * entry is found).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpFindVariable(name, lengthPtr)
+ CONST char *name; /* Name of desired environment variable
+ * (native). */
+ int *lengthPtr; /* Used to return length of name (for
+ * successful searches) or number of non-NULL
+ * entries in environ (for unsuccessful
+ * searches). */
+{
+ int i, result = -1;
+ register CONST char *env, *p1, *p2;
+ Tcl_DString envString;
+
+ Tcl_DStringInit(&envString);
+ for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
+ p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
+ p2 = name;
+
+ for (; *p2 == *p1; p1++, p2++) {
+ /* NULL loop body. */
+ }
+ if ((*p1 == '=') && (*p2 == '\0')) {
+ *lengthPtr = p2 - name;
+ result = i;
+ goto done;
+ }
+
+ Tcl_DStringFree(&envString);
+ }
+
+ *lengthPtr = i;
+
+ done:
+ Tcl_DStringFree(&envString);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_Init --
*
* This procedure is typically invoked by Tcl_AppInit procedures
@@ -148,7 +638,7 @@ TclpCheckStackSpace()
* such as sourcing the "init.tcl" script.
*
* Results:
- * Returns a standard Tcl completion code and sets interp->result
+ * Returns a standard Tcl completion code and sets the interp's result
* if there is an error.
*
* Side effects:
@@ -161,41 +651,19 @@ int
Tcl_Init(
Tcl_Interp *interp) /* Interpreter to initialize. */
{
- static char initCmd[] =
- "if {[catch {source -rsrc Init}] != 0} {\n\
- if [file exists [info library]:init.tcl] {\n\
- source [info library]:init.tcl\n\
- } else {\n\
- set msg \"can't find Init resource or [info library]:init.tcl;\"\n\
- append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
- append msg \"TCL_LIBRARY environment variable?\"\n\
- error $msg\n\
- }\n}\n\
- if {[catch {source -rsrc History}] != 0} {\n\
- if [file exists [info library]:history.tcl] {\n\
- source [info library]:history.tcl\n\
- } else {\n\
- set msg \"can't find History resource or [info library]:history.tcl;\"\n\
- append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
- append msg \"TCL_LIBRARY environment variable?\"\n\
- error $msg\n\
- }\n}\n\
- if {[catch {source -rsrc Word}] != 0} {\n\
- if [file exists [info library]:word.tcl] {\n\
- source [info library]:word.tcl\n\
- } else {\n\
- set msg \"can't find Word resource or [info library]:word.tcl;\"\n\
- append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
- append msg \"TCL_LIBRARY environment variable?\"\n\
- error $msg\n\
- }\n}";
+ Tcl_Obj *pathPtr;
/*
* For Macintosh applications the Init function may be contained in
* the application resources. If it exists we use it - otherwise we
* look in the tcl_library directory. Ditto for the history command.
*/
-
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr == NULL) {
+ pathPtr = Tcl_NewObj();
+ }
+ Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
return Tcl_Eval(interp, initCmd);
}
@@ -254,8 +722,8 @@ Tcl_SourceRCFile(
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
}
}
@@ -273,8 +741,8 @@ Tcl_SourceRCFile(
if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
}
Tcl_ResetResult(interp);
diff --git a/tcl/mac/tclMacInt.h b/tcl/mac/tclMacInt.h
index 303b1d93060..73b99a3513f 100644
--- a/tcl/mac/tclMacInt.h
+++ b/tcl/mac/tclMacInt.h
@@ -3,7 +3,7 @@
*
* Declarations of Macintosh specific shared variables and procedures.
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -27,10 +27,23 @@
#pragma export on
/*
- * Defines to control stack behavior
+ * Defines to control stack behavior.
+ *
+ * The Tcl8.2 regexp code is highly recursive for patterns with many
+ * subexpressions. So we have to increase the stack space to accomodate.
+ * 512 K is good enough for ordinary work, but you need 768 to pass the Tcl
+ * regexp testsuite.
+ *
+ * For the PPC, you need to set the stack space in the Project file.
+ *
*/
-#define TCL_MAC_68K_STACK_GROWTH (256*1024)
+#ifdef TCL_TEST
+# define TCL_MAC_68K_STACK_GROWTH (768*1024)
+#else
+# define TCL_MAC_68K_STACK_GROWTH (512*1024)
+#endif
+
#define TCL_MAC_STACK_THRESHOLD 16384
/*
@@ -44,36 +57,18 @@
/*
* Typedefs used by Macintosh parts of Tcl.
*/
-typedef pascal void (*ExitToShellProcPtr)(void);
-
-/*
- * Prototypes for functions found in the tclMacUtil.c compatability library.
- */
-
-EXTERN int FSpGetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
-EXTERN int FSpSetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
-EXTERN OSErr FSpFindFolder _ANSI_ARGS_((short vRefNum, OSType folderType,
- Boolean createFolder, FSSpec *spec));
-EXTERN void GetGlobalMouse _ANSI_ARGS_((Point *mouse));
/*
* Prototypes of Mac only internal functions.
*/
-EXTERN void TclCreateMacEventSource _ANSI_ARGS_((void));
-EXTERN int TclMacConsoleInit _ANSI_ARGS_((void));
-EXTERN void TclMacExitHandler _ANSI_ARGS_((void));
-EXTERN void TclMacInitExitToShell _ANSI_ARGS_((int usePatch));
-EXTERN OSErr TclMacInstallExitToShellPatch _ANSI_ARGS_((
- ExitToShellProcPtr newProc));
-EXTERN int TclMacOSErrorToPosixError _ANSI_ARGS_((int error));
-EXTERN void TclMacRemoveTimer _ANSI_ARGS_((void *timerToken));
-EXTERN void * TclMacStartTimer _ANSI_ARGS_((long ms));
-EXTERN int TclMacTimerExpired _ANSI_ARGS_((void *timerToken));
-EXTERN int TclMacRegisterResourceFork _ANSI_ARGS_((short fileRef, Tcl_Obj *tokenPtr,
- int insert));
-EXTERN short TclMacUnRegisterResourceFork _ANSI_ARGS_((char *tokenPtr, Tcl_Obj *resultPtr));
-
+EXTERN char * TclMacGetFontEncoding _ANSI_ARGS_((int fontId));
+EXTERN int TclMacHaveThreads(void);
+
+#include "tclPort.h"
+#include "tclPlatDecls.h"
+#include "tclIntPlatDecls.h"
+
#pragma export reset
#endif /* _TCLMACINT */
diff --git a/tcl/mac/tclMacLibrary.c b/tcl/mac/tclMacLibrary.c
index e3668f5efe6..a36f3733c1d 100644
--- a/tcl/mac/tclMacLibrary.c
+++ b/tcl/mac/tclMacLibrary.c
@@ -2,7 +2,7 @@
* tclMacLibrary.c --
*
* This file should be included in Tcl extensions that want to
- * automatically oepn their resource forks when the code is linked.
+ * automatically open their resource forks when the code is linked.
* These routines should not be exported but should be compiled
* locally by each fragment. Many thanks to Jay Lieske
* <lieske@princeton.edu> who provide an initial version of this
@@ -19,8 +19,6 @@
/*
* Here is another place that we are using the old routine names...
*/
-
-#define OLDROUTINENAMES 1
#include <CodeFragments.h>
#include <Errors.h>
@@ -171,9 +169,9 @@ OpenLibraryResource(
OSErr err = noErr;
- if (realInitBlkPtr->fragLocator.where == kOnDiskFlat) {
+ if (realInitBlkPtr->fragLocator.where == kDataForkCFragLocator) {
fileSpec = realInitBlkPtr->fragLocator.u.onDisk.fileSpec;
- } else if (realInitBlkPtr->fragLocator.where == kOnDiskSegmented) {
+ } else if (realInitBlkPtr->fragLocator.where == kResourceCFragLocator) {
fileSpec = realInitBlkPtr->fragLocator.u.inSegs.fileSpec;
} else {
err = resFNotFound;
diff --git a/tcl/mac/tclMacLibrary.r b/tcl/mac/tclMacLibrary.r
index 8da1a8119e1..7c181a421b7 100644
--- a/tcl/mac/tclMacLibrary.r
+++ b/tcl/mac/tclMacLibrary.r
@@ -42,14 +42,14 @@ resource 'vers' (1) {
TCL_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TCL_PATCH_LEVEL,
- TCL_PATCH_LEVEL ", by Ray Johnson © Sun Microsystems"
+ TCL_PATCH_LEVEL ", by Ray Johnson & Jim Ingham © Scriptics Inc."
};
resource 'vers' (2) {
TCL_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TCL_PATCH_LEVEL,
- "Tcl Library " TCL_PATCH_LEVEL " © 1996"
+ "Tcl Library " TCL_PATCH_LEVEL " © 1996-1997 Sun Microsystems, 1998-1999 Scriptics Inc."
};
/*
@@ -96,7 +96,7 @@ resource 'FREF' (TCL_LIBRARY_RESOURCES, purgeable)
type TCL_CREATOR as 'STR ';
resource TCL_CREATOR (0, purgeable) {
- "Tcl Library " TCL_PATCH_LEVEL " © 1996"
+ "Tcl Library " TCL_PATCH_LEVEL " © 1996-1999"
};
/*
@@ -141,9 +141,7 @@ resource 'STR ' (-16397, purgeable) {
* will load the TEXT resource named "Init".
*/
-read 'TEXT' (TCL_LIBRARY_RESOURCES, "Init", purgeable) "::library:init.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 1, "History", purgeable) "::library:history.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 2, "Word", purgeable,preload) "::library:word.tcl";
+#include "tclMacTclCode.r"
/*
* The following are icons for the shared library.
diff --git a/tcl/mac/tclMacLoad.c b/tcl/mac/tclMacLoad.c
index 551096b0137..e1b46f9cff5 100644
--- a/tcl/mac/tclMacLoad.c
+++ b/tcl/mac/tclMacLoad.c
@@ -5,7 +5,7 @@
* on the Macintosh. This procedure will only work with systems
* that use the Code Fragment Manager.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -88,7 +88,7 @@ typedef struct CfrgItem CfrgItem;
*
* Results:
* The result is TCL_ERROR, and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* New binary code is loaded.
@@ -97,16 +97,19 @@ typedef struct CfrgItem CfrgItem;
*/
int
-TclLoadFile(
+TclpLoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
char *fileName, /* Name of the file containing the desired
* code. */
char *sym1, char *sym2, /* Names of two procedures to look up in
* the file's symbol table. */
Tcl_PackageInitProc **proc1Ptr,
- Tcl_PackageInitProc **proc2Ptr)
+ Tcl_PackageInitProc **proc2Ptr,
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr) /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
CFragConnectionID connID;
Ptr dummy;
@@ -119,6 +122,8 @@ TclLoadFile(
UInt32 length = kCFragGoesToEOF;
char packageName[255];
Str255 errName;
+ Tcl_DString ds;
+ char *native;
/*
* First thing we must do is infer the package name from the sym1
@@ -126,22 +131,26 @@ TclLoadFile(
* this value, it just doesn't give it to us.
*/
strcpy(packageName, sym1);
- *packageName = (char) tolower(*packageName);
- packageName[strlen(packageName) - 5] = NULL;
+ Tcl_UtfToLower(packageName);
+ *(Tcl_UtfAtIndex(packageName, Tcl_NumUtfChars(packageName, -1) - 5)) = 0;
+
+ native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ err = FSpLocationFromPath(strlen(native), native, &fileSpec);
+ Tcl_DStringFree(&ds);
- err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
if (err != noErr) {
- interp->result = "could not locate shared library";
+ Tcl_SetResult(interp, "could not locate shared library", TCL_STATIC);
return TCL_ERROR;
}
/*
- * See if this fragment has a 'cfrg' resource. It will tell us were
+ * See if this fragment has a 'cfrg' resource. It will tell us where
* to look for the fragment in the file. If it doesn't exist we will
* assume we have a ppc frag using the whole data fork. If it does
* exist we find the frag that matches the one we are looking for and
* get the offset and size from the resource.
*/
+
saveFileRef = CurResFile();
SetResLoad(false);
fragFileRef = FSpOpenResFile(&fileSpec, fsRdPerm);
@@ -199,8 +208,9 @@ TclLoadFile(
err = FindSymbol(connID, (StringPtr) sym1, (Ptr *) proc1Ptr, &symClass);
p2cstr((StringPtr) sym1);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
- interp->result =
- "could not find Initialization routine in library";
+ Tcl_SetResult(interp,
+ "could not find Initialization routine in library",
+ TCL_STATIC);
return TCL_ERROR;
}
@@ -211,12 +221,41 @@ TclLoadFile(
*proc2Ptr = NULL;
}
+ *clientDataPtr = (ClientData) connID;
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Does nothing. Can anything be done?
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
diff --git a/tcl/mac/tclMacNotify.c b/tcl/mac/tclMacNotify.c
index db221d72d11..2ed857a060b 100644
--- a/tcl/mac/tclMacNotify.c
+++ b/tcl/mac/tclMacNotify.c
@@ -5,6 +5,10 @@
* which is the lowest-level part of the Tcl event loop. This file
* works together with ../generic/tclNotify.c.
*
+ * The Mac notifier only polls for system and OS events, so it is process
+ * wide, rather than thread specific. However, this means that the convert
+ * event proc will have to arbitrate which events go to which threads.
+ *
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
@@ -22,6 +26,7 @@
#include <LowMem.h>
#include <Processes.h>
#include <Timer.h>
+#include <Threads.h>
/*
@@ -38,6 +43,13 @@ extern pascal QHdrPtr GetEventQueue(void)
#endif
/*
+ * Need this for replacing Tcl_SetTimer and Tcl_WaitForEvent defined
+ * in THIS file with ones defined in the stub table.
+ */
+
+extern TclStubs tclStubs;
+
+/*
* The follwing static indicates whether this module has been initialized.
*/
@@ -81,9 +93,105 @@ static void NotifierExitHandler _ANSI_ARGS_((
/*
*----------------------------------------------------------------------
*
+ * Tcl_InitNotifier --
+ *
+ * Initializes the platform specific notifier state. There is no thread
+ * specific platform notifier on the Mac, so this really doesn't do
+ * anything. However, we need to return the ThreadID, since the generic
+ * notifier hands this back to us in AlertThread.
+ *
+ * Results:
+ * Returns the threadID for this thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_InitNotifier()
+{
+
+#ifdef TCL_THREADS
+ ThreadID curThread;
+ if (TclMacHaveThreads()) {
+ GetCurrentThread(&curThread);
+ return (ClientData) curThread;
+ } else {
+ return NULL;
+ }
+#else
+ return NULL;
+#endif
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeNotifier --
+ *
+ * This function is called to cleanup the notifier state before
+ * a thread is terminated. There is no platform thread specific
+ * notifier, so this does nothing.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FinalizeNotifier(clientData)
+ ClientData clientData; /* Pointer to notifier data. */
+{
+ /* Nothing to do on the Mac */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AlertNotifier --
+ *
+ * Wake up the specified notifier from any thread. This routine
+ * is called by the platform independent notifier code whenever
+ * the Tcl_ThreadAlert routine is called. This routine is
+ * guaranteed not to be called on a given notifier after
+ * Tcl_FinalizeNotifier is called for that notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls YieldToThread from this thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AlertNotifier(clientData)
+ ClientData clientData; /* Pointer to thread data. */
+{
+
+#ifdef TCL_THREADS
+ if (TclMacHaveThreads()) {
+ YieldToThread((ThreadID) clientData);
+ }
+#endif
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* InitNotifier --
*
- * Initializes the notifier structure.
+ * Initializes the notifier structure. Note - this function is never
+ * used.
*
* Results:
* None.
@@ -108,7 +216,8 @@ InitNotifier(void)
* NotifierExitHandler --
*
* This function is called to cleanup the notifier state before
- * Tcl is unloaded.
+ * Tcl is unloaded. This function is never used, since InitNotifier
+ * isn't either.
*
* Results:
* None.
@@ -225,6 +334,16 @@ void
Tcl_SetTimer(
Tcl_Time *timePtr) /* New value for interval timer. */
{
+ /*
+ * Allow the notifier to be hooked. This may not make sense
+ * on the Mac, but mirrors the UNIX hook.
+ */
+
+ if (tclStubs.tcl_SetTimer != Tcl_SetTimer) {
+ tclStubs.tcl_SetTimer(timePtr);
+ return;
+ }
+
if (!timePtr) {
notifier.timerActive = 0;
} else {
@@ -246,6 +365,29 @@ Tcl_SetTimer(
/*
*----------------------------------------------------------------------
*
+ * Tcl_ServiceModeHook --
+ *
+ * This function is invoked whenever the service mode changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ServiceModeHook(mode)
+ int mode; /* Either TCL_SERVICE_ALL, or
+ * TCL_SERVICE_NONE. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_WaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new
@@ -274,6 +416,15 @@ Tcl_WaitForEvent(
Rect mouseRect;
/*
+ * Allow the notifier to be hooked. This may not make
+ * sense on the Mac, but mirrors the UNIX hook.
+ */
+
+ if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) {
+ return tclStubs.tcl_WaitForEvent(timePtr);
+ }
+
+ /*
* Compute the next timeout value.
*/
@@ -346,6 +497,17 @@ Tcl_WaitForEvent(
}
}
TclMacRemoveTimer(timerToken);
+
+ /*
+ * Yield time to nay other thread at this point. If we find that the
+ * apps thrash too switching between threads, we can put a timer here,
+ * and only yield when the timer fires.
+ */
+
+ if (TclMacHaveThreads()) {
+ YieldToAnyThread();
+ }
+
return 0;
}
@@ -381,7 +543,9 @@ Tcl_Sleep(
timerToken = TclMacStartTimer((long) ms);
while (1) {
WaitNextEvent(0, &dummy, (ms / 16.66) + 1, NULL);
-
+ if (TclMacHaveThreads()) {
+ YieldToAnyThread();
+ }
if (TclMacTimerExpired(timerToken)) {
break;
}
diff --git a/tcl/mac/tclMacOSA.c b/tcl/mac/tclMacOSA.c
index 169d578bcd3..168553e3d06 100644
--- a/tcl/mac/tclMacOSA.c
+++ b/tcl/mac/tclMacOSA.c
@@ -206,6 +206,14 @@ Tclapplescript_Init(
long appleScriptFlags;
/*
+ * Perform the required stubs magic...
+ */
+
+ if (!Tcl_InitStubs(interp, "8.2", 0)) {
+ return TCL_ERROR;
+ }
+
+ /*
* Here We Will Get The Available Osa Languages, Since They Can Only Be
* Registered At Startup... If You Dynamically Load Components, This
* Will Fail, But This Is Not A Common Thing To Do.
@@ -1926,7 +1934,7 @@ tclOSAAddContext(
int newPtr;
if (contextName == NULL) {
- contextName = ckalloc(24 * sizeof(char));
+ contextName = ckalloc(16 + TCL_INTEGER_SPACE);
sprintf(contextName, "OSAContext%d", contextIndex++);
} else if (*contextName == '\0') {
sprintf(contextName, "OSAContext%d", contextIndex++);
@@ -2057,7 +2065,7 @@ tclOSAStore(
Str255 rezName;
int result = TCL_OK;
short saveRef, fileRef = -1;
- char idStr[64];
+ char idStr[16 + TCL_INTEGER_SPACE];
FSSpec fileSpec;
Tcl_DString buffer;
char *nativeName;
@@ -2276,7 +2284,7 @@ tclOSALoad(
Str255 rezName;
int result = TCL_OK;
short saveRef, fileRef = -1;
- char idStr[64];
+ char idStr[16 + TCL_INTEGER_SPACE];
FSSpec fileSpec;
Tcl_DString buffer;
char *nativeName;
@@ -2687,9 +2695,10 @@ prepareScriptData(
int i;
char buffer[7];
OSErr sysErr = noErr;
-
+ Tcl_DString encodedText;
+
Tcl_DStringInit(scrptData);
-
+
for (i = 0; i < argc; i++) {
Tcl_DStringAppend(scrptData, argv[i], -1);
Tcl_DStringAppend(scrptData, " ", 1);
@@ -2699,7 +2708,7 @@ prepareScriptData(
* First replace the \n's with \r's in the script argument
* Also replace "\\n" with " ".
*/
-
+
for (ptr = scrptData->string; *ptr != '\0'; ptr++) {
if (*ptr == '\n') {
*ptr = '\r';
@@ -2710,10 +2719,13 @@ prepareScriptData(
}
}
}
-
- sysErr = AECreateDesc(typeChar, Tcl_DStringValue(scrptData),
- Tcl_DStringLength(scrptData), scrptDesc);
-
+
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(scrptData),
+ Tcl_DStringLength(scrptData), &encodedText);
+ sysErr = AECreateDesc(typeChar, Tcl_DStringValue(&encodedText),
+ Tcl_DStringLength(&encodedText), scrptDesc);
+ Tcl_DStringFree(&encodedText);
+
if (sysErr != noErr) {
sprintf(buffer, "%6d", sysErr);
Tcl_DStringFree(scrptData);
@@ -2722,7 +2734,7 @@ prepareScriptData(
Tcl_DStringAppend(scrptData, " creating Script Data Descriptor.", 33);
return TCL_ERROR;
}
-
+
return TCL_OK;
}
diff --git a/tcl/mac/tclMacOSA.r b/tcl/mac/tclMacOSA.r
index 82938bf07ab..26d81128307 100644
--- a/tcl/mac/tclMacOSA.r
+++ b/tcl/mac/tclMacOSA.r
@@ -39,14 +39,14 @@ resource 'vers' (1) {
SCRIPT_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
SCRIPT_PATCH_LEVEL,
- SCRIPT_PATCH_LEVEL ", by Jim Ingham & Ray Johnson © Sun Microsystems"
+ SCRIPT_PATCH_LEVEL ", by Jim Ingham © Cygnus Solutions"
};
resource 'vers' (2) {
SCRIPT_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
SCRIPT_PATCH_LEVEL,
- "Tclapplescript " SCRIPT_PATCH_LEVEL " © 1996-1997"
+ "Tclapplescript " SCRIPT_PATCH_LEVEL " © 1996-1999"
};
/*
diff --git a/tcl/mac/tclMacPort.h b/tcl/mac/tclMacPort.h
index bad2646141b..48f6e8798af 100644
--- a/tcl/mac/tclMacPort.h
+++ b/tcl/mac/tclMacPort.h
@@ -13,17 +13,24 @@
* RCS: @(#) $Id$
*/
+
#ifndef _MACPORT
#define _MACPORT
-#ifndef _TCL
-#include "tcl.h"
+#ifndef _TCLINT
+# include "tclInt.h"
#endif
+/*
+ *---------------------------------------------------------------------------
+ * The following sets of #includes and #ifdefs are required to get Tcl to
+ * compile on the macintosh.
+ *---------------------------------------------------------------------------
+ */
+
#include "tclErrno.h"
#include <float.h>
-/* Includes */
#ifdef THINK_C
/*
* The Symantic C code has not been tested
@@ -41,64 +48,86 @@
#elif defined(__MWERKS__)
# include <time.h>
# include <unistd.h>
+# include <utime.h>
+
/*
* The following definitions are usually found if fcntl.h.
* However, MetroWerks has screwed that file up a couple of times
* and all we need are the defines.
*/
-#define O_RDWR 0x0 /* open the file in read/write mode */
-#define O_RDONLY 0x1 /* open the file in read only mode */
-#define O_WRONLY 0x2 /* open the file in write only mode */
-#define O_APPEND 0x0100 /* open the file in append mode */
-#define O_CREAT 0x0200 /* create the file if it doesn't exist */
-#define O_EXCL 0x0400 /* if the file exists don't create it again */
-#define O_TRUNC 0x0800 /* truncate the file after opening it */
+
+# define O_RDWR 0x0 /* open the file in read/write mode */
+# define O_RDONLY 0x1 /* open the file in read only mode */
+# define O_WRONLY 0x2 /* open the file in write only mode */
+# define O_APPEND 0x0100 /* open the file in append mode */
+# define O_CREAT 0x0200 /* create the file if it doesn't exist */
+# define O_EXCL 0x0400 /* if the file exists don't create it again */
+# define O_TRUNC 0x0800 /* truncate the file after opening it */
/*
* MetroWerks stat.h file is rather weak. The defines
* after the include are needed to fill in the missing
* defines.
*/
+
# include <stat.h>
# ifndef S_IFIFO
-# define S_IFIFO 0x0100
+# define S_IFIFO 0x0100
# endif
# ifndef S_IFBLK
-# define S_IFBLK 0x0600
+# define S_IFBLK 0x0600
# endif
# ifndef S_ISLNK
-# define S_ISLNK(m) (((m)&(S_IFMT)) == (S_IFLNK))
+# define S_ISLNK(m) (((m)&(S_IFMT)) == (S_IFLNK))
# endif
# ifndef S_ISSOCK
-# define S_ISSOCK(m) (((m)&(S_IFMT)) == (S_IFSOCK))
+# define S_ISSOCK(m) (((m)&(S_IFMT)) == (S_IFSOCK))
# endif
# ifndef S_IRWXU
-# define S_IRWXU 00007 /* read, write, execute: owner */
-# define S_IRUSR 00004 /* read permission: owner */
-# define S_IWUSR 00002 /* write permission: owner */
-# define S_IXUSR 00001 /* execute permission: owner */
-# define S_IRWXG 00007 /* read, write, execute: group */
-# define S_IRGRP 00004 /* read permission: group */
-# define S_IWGRP 00002 /* write permission: group */
-# define S_IXGRP 00001 /* execute permission: group */
-# define S_IRWXO 00007 /* read, write, execute: other */
-# define S_IROTH 00004 /* read permission: other */
-# define S_IWOTH 00002 /* write permission: other */
-# define S_IXOTH 00001 /* execute permission: other */
+# define S_IRWXU 00007 /* read, write, execute: owner */
+# define S_IRUSR 00004 /* read permission: owner */
+# define S_IWUSR 00002 /* write permission: owner */
+# define S_IXUSR 00001 /* execute permission: owner */
+# define S_IRWXG 00007 /* read, write, execute: group */
+# define S_IRGRP 00004 /* read permission: group */
+# define S_IWGRP 00002 /* write permission: group */
+# define S_IXGRP 00001 /* execute permission: group */
+# define S_IRWXO 00007 /* read, write, execute: other */
+# define S_IROTH 00004 /* read permission: other */
+# define S_IWOTH 00002 /* write permission: other */
+# define S_IXOTH 00001 /* execute permission: other */
# endif
-# define isatty(arg) 1
+# define isatty(arg) 1
/*
* Defines used by access function. This function is provided
* by Mac Tcl as the function TclpAccess.
*/
-# define F_OK 0 /* test for existence of file */
-# define X_OK 0x01 /* test for execute or search permission */
-# define W_OK 0x02 /* test for write permission */
-# define R_OK 0x04 /* test for read permission */
+# define F_OK 0 /* test for existence of file */
+# define X_OK 0x01 /* test for execute or search permission */
+# define W_OK 0x02 /* test for write permission */
+# define R_OK 0x04 /* test for read permission */
+#endif /* __MWERKS__ */
+
+/*
+ * Many signals are not supported on the Mac and are thus not defined in
+ * <signal.h>. They are defined here so that Tcl will compile with less
+ * modification.
+ */
+
+#ifndef SIGQUIT
+#define SIGQUIT 300
+#endif
+
+#ifndef SIGPIPE
+#define SIGPIPE 13
+#endif
+
+#ifndef SIGHUP
+#define SIGHUP 100
#endif
/*
@@ -107,16 +136,29 @@
* be defined in sys/wait.h on UNIX systems.
*/
-#define WNOHANG 1
-#define WIFSTOPPED(stat) (1)
-#define WIFSIGNALED(stat) (1)
-#define WIFEXITED(stat) (1)
-#define WIFSTOPSIG(stat) (1)
-#define WIFTERMSIG(stat) (1)
-#define WIFEXITSTATUS(stat) (1)
-#define WEXITSTATUS(stat) (1)
-#define WTERMSIG(status) (1)
-#define WSTOPSIG(status) (1)
+#define WAIT_STATUS_TYPE int
+#define WNOHANG 1
+#define WIFSTOPPED(stat) (1)
+#define WIFSIGNALED(stat) (1)
+#define WIFEXITED(stat) (1)
+#define WIFSTOPSIG(stat) (1)
+#define WIFTERMSIG(stat) (1)
+#define WIFEXITSTATUS(stat) (1)
+#define WEXITSTATUS(stat) (1)
+#define WTERMSIG(status) (1)
+#define WSTOPSIG(status) (1)
+
+/*
+ * Make sure that MAXPATHLEN is defined.
+ */
+
+#ifndef MAXPATHLEN
+# ifdef PATH_MAX
+# define MAXPATHLEN PATH_MAX
+# else
+# define MAXPATHLEN 2048
+# endif
+#endif
/*
* Define "NBBY" (number of bits per byte) if it's not already defined.
@@ -136,92 +178,80 @@
# define getpid() -1
#endif
-#define NO_SYS_ERRLIST
-#define WAIT_STATUS_TYPE int
-
/*
- * Make sure that MAXPATHLEN is defined.
+ * Variables provided by the C library.
*/
-
-#ifndef MAXPATHLEN
-# ifdef PATH_MAX
-# define MAXPATHLEN PATH_MAX
-# else
-# define MAXPATHLEN 2048
-# endif
-#endif
+
+extern char **environ;
/*
- * The following functions are declared in tclInt.h but don't do anything
- * on Macintosh systems.
+ *---------------------------------------------------------------------------
+ * The following macros and declarations represent the interface between
+ * generic and mac-specific parts of Tcl. Some of the macros may override
+ * functions declared in tclInt.h.
+ *---------------------------------------------------------------------------
*/
-#define TclSetSystemEnv(a,b)
-
/*
- * Many signals are not supported on the Mac and are thus not defined in
- * <signal.h>. They are defined here so that Tcl will compile with less
- * modification.
- */
-
-#ifndef SIGQUIT
-#define SIGQUIT 300
-#endif
-
-#ifndef SIGPIPE
-#define SIGPIPE 13
-#endif
-
-#ifndef SIGHUP
-#define SIGHUP 100
-#endif
+ * The default platform eol translation on Mac is TCL_TRANSLATE_CR:
+ */
-extern char **environ;
+#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CR
/*
- * Prototypes needed for compatability
+ * Declare dynamic loading extension macro.
*/
-EXTERN int TclMacCreateEnv _ANSI_ARGS_((void));
-EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2, size_t n));
+#define TCL_SHLIB_EXT ".shlb"
/*
- * The following declarations belong in tclInt.h, but depend on platform
- * specific types (e.g. struct tm).
+ * The following define is bogus and needs to be fixed. It claims that
+ * struct tm has the timezone string in it, which is not true. However,
+ * the code that works around this fact does not compile on the Mac, since
+ * it relies on the fact that time.h has a "timezone" variable, which the
+ * Metrowerks time.h does not have...
+ *
+ * The Mac timezone stuff never worked (clock format 0 -format %Z returns "Z")
+ * so this just keeps the status quo. The real answer is to not use the
+ * MSL strftime, and provide the needed compat functions...
+ *
*/
-
-EXTERN struct tm * TclpGetDate _ANSI_ARGS_((const time_t *tp,
- int useGMT));
-EXTERN size_t TclStrftime _ANSI_ARGS_((char *s, size_t maxsize,
- const char *format, const struct tm *t));
-
+
+#define HAVE_TM_ZONE
+
+/*
+ * The following macros have trivial definitions, allowing generic code to
+ * address platform-specific issues.
+ */
+
+#define TclpAsyncMark(async)
+#define TclpGetPid(pid) ((unsigned long) (pid))
+#define TclSetSystemEnv(a,b)
#define tzset()
-#define TclpGetPid(pid) ((unsigned long) (pid))
/*
* The following defines replace the Macintosh version of the POSIX
* functions "stat" and "access". The various compilier vendors
* don't implement this function well nor consistantly.
*/
-#define lstat(path, bufPtr) TclStat(path, bufPtr)
+/* int TclpStat(const char *path, struct stat *bufPtr); */
+int TclpLstat(const char *path, struct stat *bufPtr);
+
+char *TclpFindExecutable(const char *argv0);
+int TclpFindVariable(CONST char *name, int *lengthPtr);
-EXTERN FILE * TclMacFOpenHack _ANSI_ARGS_((const char *path,
- const char *mode));
#define fopen(path, mode) TclMacFOpenHack(path, mode)
-EXTERN int TclMacReadlink _ANSI_ARGS_((char *path, char *buf, int size));
#define readlink(fileName, buffer, size) TclMacReadlink(fileName, buffer, size)
#ifdef TCL_TEST
#define chmod(path, mode) TclMacChmod(path, mode)
-EXTERN int TclMacChmod(char *path, int mode);
#endif
/*
- * Defines for Tcl internal commands that aren't really needed on
- * the Macintosh. They all act as no-ops.
+ * Prototypes needed for compatability
*/
-#define TclCreateCommandChannel(out, in, err, num, pidPtr) NULL
-#define TclClosePipeFile(x)
+
+/* EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2, size_t n)); */
/*
* These definitions force putenv & company to use the version
@@ -232,37 +262,32 @@ EXTERN int TclMacChmod(char *path, int mode);
# define putenv Tcl_PutEnv
# define setenv TclSetEnv
void TclSetEnv(CONST char *name, CONST char *value);
-int Tcl_PutEnv(CONST char *string);
+/* int Tcl_PutEnv(CONST char *string); */
void TclUnsetEnv(CONST char *name);
#endif
/*
- * The default platform eol translation on Mac is TCL_TRANSLATE_CR:
- */
-
-#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CR
-
-/*
- * Declare dynamic loading extension macro.
- */
-
-#define TCL_SHLIB_EXT ".shlb"
-
-/*
- * TclpFinalize is a noop on the Mac.
- */
-
-#define TclpFinalize()
-
-/*
- * The following define should really be in tclInt.h, but tclInt.h does
- * not include tclPort.h, which includes the "struct stat" definition.
+ * Platform specific mutex definition used by memory allocators.
+ * These are all no-ops on the Macintosh, since the threads are
+ * all cooperative.
*/
-EXTERN int TclpSameFile _ANSI_ARGS_((char *file1, char *file2,
- struct stat *sourceStatBufPtr,
- struct stat *destStatBufPtr)) ;
-EXTERN int TclpStat _ANSI_ARGS_ ((CONST char *path, struct stat *buf));
-EXTERN int TclpAccess _ANSI_ARGS_ ((CONST char *path, int mode));
+#ifdef TCL_THREADS
+typedef int TclpMutex;
+#define TclpMutexInit(a)
+#define TclpMutexLock(a)
+#define TclpMutexUnlock(a)
+#else
+typedef int TclpMutex;
+#define TclpMutexInit(a)
+#define TclpMutexLock(a)
+#define TclpMutexUnlock(a)
+#endif /* TCL_THREADS */
+
+typedef pascal void (*ExitToShellProcPtr)(void);
+#include "tclMac.h"
+#include "tclMacInt.h"
+/* #include "tclPlatDecls.h"
+ #include "tclIntPlatDecls.h" */
#endif /* _MACPORT */
diff --git a/tcl/mac/tclMacProjects.sea.hqx b/tcl/mac/tclMacProjects.sea.hqx
index fc875e758ca..73f0e087b9a 100644
--- a/tcl/mac/tclMacProjects.sea.hqx
+++ b/tcl/mac/tclMacProjects.sea.hqx
@@ -1,1704 +1,3063 @@
(This file must be converted with BinHex 4.0)
-:#d&bBfKTGQ8ZFf9K!%&38%aKGA0d)!#3!q8B!!"Cp2Kc8dP8)3!&!!$P'(*-BA8
-#G`#3!aChG`d0$%eKBe4ME#"08d`ZZ5q,G!FhpA)!N!J(0rGdP-!!N"3S[!#3"2q
-3"%e08(*$9dP&!3#[Pi&PXQjr5J!!!4i!!8q,!*!$D3!!*mhGH6DA!*!'kiF4!!L
-bdAJqT3$Ldi`fC,5RjQK+Ai"mIT)55NR(rQ!RhrRB-b[h[pkGBp2c!SVId'RY!kK
-haCaq&5hRD[I2dCBfR+[G08GE9QZZGR51GREPZCSq4k[%Fl9EXc9lIc+GAH0VibK
-8hm)N!!!'!-@fALIKK'IN@0H46AMN9V)pXQQE-(*dNf14,@(N0YNqj@YA4i[+P&!
-VE8XiS4a2m8RI`RHfm8mlVhfQC(YN5lEI5lBIfIENYT&Y!`R[*2YBPdFff8GZ(qX
-kb5Dhb6E*mFJQYmmRqmQ@r$l#*EI2A-JqFJXrXLR3i39D"fa32Z%6XkF%J0`Q)dj
-3`$YbQj,$A`-fm"VDh%BjXN'1l$I,mlMP*H9RIV%Qk@BCjE%VIER@8AleZTaRpRk
-pGTfK3,*`XJICQ3-lqr3@,ff3!&j[HFN@lH+,rR*HZRMN&V)cXT!!@`6!!JJBh`1
-XEjfGYCld2Cjq(q'I4hiK#ePBjbd!2)!m4hk($q)i-XDX-XCEElc5cidhq)3aDcm
-2RbZpJSHRGaVL@VMG6j*kR"3V56`A"PR(ej*bBXE6ZGQXpXc58Y[a4dYddUE*hAl
-jcCZ-fA%62qAMQK0@Pq1Q(m5[C"JakmeDljl#hXilHh3Q[&h@)[$H2TPQI[*Q9dD
--1Fl[MqH2T4$Mia3N2m$@`LZ,AjY"C6qi)24VBC,fcckIJ)[)LDMNl+aDGlGC+qq
-U05drf1R2K#rQAbhrZR5amCcri1TLQS@08Z5RDCJqipr[[2PQ,AST2Bf%R'(iI[6
-DSAid+6ErRIAA2NQN50KFfHJ#Bi[*4TXC@hHm5,X1fIb'fHGe5m-MBj2b'rCk2Hd
-&KeS*Q*RDq5LJ-8$U('H,*T[aqcE#q!PM6V2fJifl'RFpe-$c)*lDT[c@iQl+Hm-
-aCq2CKPYP((q%1#AfV@C0RY1jYPQFLh#[B9c-kPl()J$EY%hfT3!rKA8Te!2f&"S
-lCJda@GZaDT4-KNU"GE5JS%NIC9L#qq5m$#l![r[SQ$VG(2LRB[J958BVjkAl`UZ
-(HLbe)*-#`kT([T(RE,k`9l`qN!!5*j)C*02`,)K!%jUU)j8NR+i[2%-8fUYEl#G
-P'9J1NjQ`12SUF5QHG6MV+j@4['Ua`C(c*i+Gp4T*lVCUTG6Yf'JRDqdRS*ZUa1,
-#'HDf9Aej`HBEEd*8)P(2%EfBdlY8`pRBUr$T!N%1,-8(`jp[pkNk[i,E)e'1Z4A
-h30Nq`9i9fd2N5T)q13q5E6)jNYL@ic&%YLBmKXTfDCG!Z!Yi$*IYcDSKYMr&Bk4
-X(m'M4VB[iM&+YZrJ-GVD)UcT'0Q!mV'bJAVMC$Z,8#qfRAK-N!$Y@M`dr#[E,AK
--NZfGH&"2E04JLQarKdHYE0r$BkUJPekD*KXqp#!fqQ#'E#r'BkCX&q-a5lDVm0#
-GV@`hib&S'[dk(R0NS`CcCD-'mf4l')rj25"E)"XeVC-0$&JS@b-HLf6EJFGLfAj
-1@)%0JBEH`IDAH#b9l@ra@#EEJhK3@b#&a&I)4YiVC52@+YR1`D0H0PM9DYPq#3q
-B%VEIaJ1fKHepH-#fX(fH3#UfIm,M&'[V4qaC,a[pZ8%fmJ&$XCf,"cA("Q8r9ED
-Em0JSfarJFCTX(m+$2XAf*@%QYZrLFBDep5FQ[N3fH[j-fDJ[@)GY#ajJ$MEb2PZ
-fAm9MNfarMJGpJBdDEjB0E#-q8!`ZEj80A+#Hf+J[,"2EGY)'XEdD$m9SYHehm6K
-I0[VT!YQqJ-H&XP(ALkaY)2(pCE*49c!+'re$MYM!ljI,GMdHB!JfHZJ5fHl!!ic
-&pJpi%"2E[iYh3#AJ!*I*"QDp3MCk6%KE94d2EQb[`q0bfFMePE+"LiL-f"3MGb6
-F9$f*aejVUbBQL6T@6GaTNBhHZ&+fUr(B,a[i*r*10IY'Z&meq`DXaUE8!iFae4P
-%$S-+J!fmKYGJ!e2J&pMSJ9I*pKSm`&YXB"lm#p[(m2J&fEk""lfXMUC8emN'2a'
-pBc!a%Ic%4Mq6&cEUp9VCi&Ad+EEhi%%IB32,Ej!!$3ai[E80)3Dm36Eib4YP!fp
-ZP)fq"6qaN31F"4Ymm8fbI3D2AjEYfhM!+p8C5Z`%!l(4pp3('hJ+rm*'Rlp&0R*
-lUfarKXH[bABA(VmZfcrMm6CV'dDmT(qa`DQdMU"XF)2INJfXSHq`8G2INHhGH)#
-Cf$k(aqr*"XrlI@XE6Ni,rQ#Merp30MM$(mN'I[faE265RmMf$McH,YZRmB$IBB0
-2`hR9'8%HHDYXF%9k#KXmKrMB`&ri+6E`iPfb8@YUL!hFSPq`hBX([Bm0[JM[8'F
-NHr%[C+0AhLXE(!RHK`eF)4GXB0clCD0A2b!EHAj3YNrLFCYXF%6iP$Sej1JIPJd
-qI,YXB"JBMJf1m9(C`%h`%"Yim9Hb8IH2brBT21!Df1#&GeVE+'SLIbdEf)pfJ3f
-q5Rf``E[q4MEi!,PJ!fr!&QcN5TpL``G-`rBY2$iV'kS8@+(1D(*3F"8E["G1K`h
-qGVGXF)alC+1ZF!TXB!(k"MEU#2I%"UHKIl(p*ajIYVBaj%rS!0MJm&q4$@lj9GR
-J2(m['cMh0GR!NB1bd4Y`0'ciN!![YKrJFCqeMD8Z!ar"KUE`6GRJ[ImS'jKk[fa
-`%[S4'pK+[f#Mjaq3!)fDJJrBISJ('+M111Sii$NfG)TrNBdHJNGJ!iIJb0M!qRq
-9$Ib#bf#M0m!kE260[eREH'T!i$NfG!eiR+hMH0*b4LF-6e(AjA5Vd)jhKU3MUmZ
-"b%*J!@`)+f!+dB8%393KU""Pb!-%&@)+)3@F)'836`JRB!M"K&K#+#'5%%L))i3
-DdJKCK#4##!!c3!c`!V3JHK!m#"H%$U))5B(33H3!3)JN`!V)!kS313JFa!h#"P'
-$S%(-)'5!-J3-iJAKJQK"X##HN!!Vb!L!$+'#,%#@%%dJ-SJNL#m3$83(a"&%%F3
-Ca"H!'M%%-SIiJHL"f!&T4Ga!e%$-J$!JAL"D)&BJiL"8)#iJ6%#L)3)3!)!I`)H
--3F)JAj!!,XJFC!h5"GQ#C%(f)#+3!$G)#'3,NJ@jJS"!TL!+N!!R5"0N#C)%%B)
-83BBJ3C!!3`J3a!F#!qQ"l#$))6BM-N-X4*!!eQ)d!M2N%m%'d4Sd4F!&X&&d%$m
-3%b"8#,L3!((%&i4ea2*JDJ9K!k%GF4jK'V+*%)hBM&L(i!ba4M4!-%HmJG3M8N!
-@%DNJFJMV%"r%@3Ja`Le%#m%Ai4ELLT!!#HSM##1B)DJLc#,)3YJ4B"%N%&83KK!
-)%3d39"'p%%-JTBLR#(U)1j!!484V4%l%63JGBLBL+@3F-4-4%r%5%48LLd#(D)N
-)J8L*1)NSL9#!#),iL1L)f)M!KVL)1)AB#L&&L%&!&1(`IiiD*UNYp9F`PE&qDh@
-i@#U1e+F52eNdfjVeK@*e[Y@+-4QhB`U[lH&#2HX2M"p&FF$hhV3q19f2`T6'rI9
-XPQme2,DI85j*3cm*k(,*r24dQ%c@BpKf"R'Mi6GV01hbfdllQQNFK66ZmCRC6L5
-c1r#Mb55FUF2CGcZ`f!Va[V5HB)M5LpfF*%fqUB2Ri9ZmQ0VD%V0%Pd@aRlAGX'e
-[q0RXj%`d(l)"P*HUkik)'HkC5V1NhTbKUEPKApZRjjX"mpK66`1EDJ[L,jP1kG5
-#DG$YlFj)'Eed@j!!c)&T'+j-d8MU[Grf3'[J0qR@@TpTqK%0IYUH`8Y6f3l%84i
-2be9jS'[6X,N,KJ2e"LZQRe,ERFdXNNd00[SP[kTC6l0DehK0fj3+I9@@0[dmRrS
-1-03"%4cFYF-0BN%YX@)$LlZ[@E`JM&UQ[,eBHPpT`iEF8aNhq5MV&EPeFlM(i,d
-qECL*dZMQc3Gcf$4db&aIAL`HcVPT4pI"kB`qLEdHeUe"p(6)V*06(4lG0S&bk[G
-T86cP4qa@E@i+Qr-GibCfD(250QqV0f[aERUR8PUqkF,q9M*h+(GmVMLFZA)arB+
-jUE,pN!$ClaJa5XGJ6A8&j[T@+rKD0lHJb,S69"`6JQUdKYPFSpA2iZJ+RPeP+)A
-YHhH'L4b8Xqr3-*pQFD0iBELi1djUU4N)JM"08CB$XkNCpc%MGU"B$E--L04U0J0
-4DmYqUj9E0mcASeTaD#&,r03-KP2c-c0K8V3a(9[NKVM43Nb9TMDV@HLp0T'Y&D5
-i0ic-m&KaY!8BfVd(85J8-p1RKFhFePK255Vf6$'&9"8aU@lahM*Al@'0C+A!*jN
-leIDc`TE1+Y8+Q2aX'MDAfB-HEk#2324cXhS1)@eGrY)@S(dd2QZ,aZHf!"fKQ)Z
-fH,5Pc9+*YJiCD'[$IeX(pYX%jiZ,)hjcCKlMZXR'@j)AX"B9E%lm$,c)1E2E6%Z
-,!l8D@*1DPEiLEbC&Qf`PFT@Pk2Lk+"U0,lULqrL$PZJYrU!P@SSrD)PqiJpDSS[
-iJjES'rkJ*6U(2fL*PZ%2@U+VbD#PeXpNd&*VC$*SUI9''E68qU!-@QV06`BYYCi
-RJjCD#j0"5kf&bD#PeVCNd&*VE$*SkI`$YqKD,R1@38ZA2M*Sk9+$NN&,PjU6$&U
-kl!-CY(5T(mQJTFXqN!""5jFDN!!-@VV8EQ63dQAYCG$5TBiSJjBZG8-CY(5T$mU
-JT8Yp9JBYAHUZ-QMT8Nq938ZAZUN-@VV83'A3dUA1+B1@,[Y$"LeGkS3bD1P5rj0
-"5jFkT!aDZZ`2'E5-%"G%,Bq`*fA3-X)qN8(,#21A3FX)p6FCY)a34j0"b`La33B
-Y)p5lC0!b3Ue,"LdMe,9Nd$*#E*!!3FX)G@JCY)a3FjC"b`LeBKQdM,$f-QJCS9i
-UJjB4ePJ',528MQA3-X*K%"QdM",[C0!b5Kb438Xpp#U$PP(@83BYpG#V$&T'UHr
-*S'@8[5k$PRS!9JBYSp5"CG!b5VeG"LfMe-YPd$*+69X',D28TfA38Jr'bU"PP,U
-[$&T'1AJSJjBaiV)-@XD)F6*S'51Qb+#P(TL93FXBHd!',@2-@3BYBp3LCG!b4Je
-F"Lhe)+d-@XDSBFZJCBbc!M*S'D2q,i1@-HVi-QJCSai[JjBaeP8',@2X84QdM&'
-EPN(,'(9j'E5-XFBbD"PRM@A3-YiEY06$Z6*S'5GZbU"PR"JRJjCaiSMSTA(fX`a
-DaYPM-QJCCpePd$,1@XLJCCbaC0!bc[N!'E5-8r1A3FXiHd)',H2%E1(JFFj,b+"
-PR$-0-QJCjeb#$&V'LFdbD'PC106)c$F%QM1i3+q!Vf!q234ZJC9JMGkb33(9l@[
-jB!cm$pi(e[MD0pb2ISAh`IIJA(!*Ab1(hp(6F"6`bZMkp$BF$PccYA1`&qi"A`-
-2`8H`'Gb'!i#Ti!#mcX`b#%jVM)DMJ-rJ1Y`#6JG'`crm'BHm4Jp[!F2-[!+m"Lb
-$,i!Ti'jqVJ"--M-0rM`$H!fRJE["fH"Nm#li'$`-rZ9VrZ!4Q!9@J9&JNjPI%5l
-9Hla0&`lh&E'P)BBlMTZ"+E@B`cNHpd$F9ELVF3r#24Mh%0a$F3r$24ch50`eZ*P
-1()el$1kaZ-IK(Spl!Zk*Z#IKCYI2&0beZ+ILRSCl1ZiCZ'ILRSAl*0bcFFr"24I
-h20ccF5r!ABGl)Hj&Z"Hh9i#SHbRZCELAiek"HbAZ9EMVFDr'[3EhfRc0LDmdr'5
-KKM&B$pCQH%FKkG!YrLjIqhMUpY6&0j,RJZ&+FF[!4F58Ril,T5[kb()89C9dESF
-#k65H+Te1hRd,mZYBcC3l[ZJM0HmkfBEb"D4(XNY'iH@,@FH1ALeP!GJ[pIbK6D"
-')K'SmlrpB"ZBbI31K-0E$f-jb%i@J-@dPdhf$59cL@U+&bUNRR%A"rVEcm@"([G
-hFD$2!e`F+2C!&`IdUR*aS1R9,Jj8IT!!L`2&(qcL)!%-FA%JDd0G(+5%B5i1k$I
-Fa8'+'1(L`%K'ZMK)'68Z$P,(D"F(+@5-Li0F-YE&38)Cjq)JTBahFC!!@bDi1%J
-b%edFC*Y*,Jlbc@3A"fPRLSZ$r&2ViL!$6A9aN!#+TVNib%R6A4bNTKNZ$P,86"F
-(@@U@Li0dGC+,Jl`efm9"!T[MiL#6cA9aN!$3jVNi@QElF4`Nb38Z$Y*HRBZ$Y,I
-3a8(k@q6L)!qZHb&1-U!R)ClLiL$eVRGaN!"I0lJi5-)0,Jjbl#iA"lPfYiZ$*(Z
-jLi1FqdSA"eRe#KF(qAL2Li1F[YI&3CVHjq,S(9!rMS1FIk@,Jibqhm9"jQjp28i
-LRR)h#ckYLR(3ppKiQP3DeB*Lp6TcAh-1Ba460'jPD6XE!3S",TbeVlN6@Q"0Hf6
-8cRE3qY'eH3rBelambp,5SpTePca26YrBcNlhFQjQ-[ba5(mGNKQ$p-FIcGLM2r+
-)2Kq--CSe61@e5Ik)S6pDL*k*9SN1DFB,dIh3p0$Vd1+#G8TQMC+r2ZRiBH$`b#b
-5r33dl!1$F)R8'$N8flRHGGi*"@eSeFIMZFG2"&MR,hD`",6#-!aQeQT[M9iF8kI
-PR2l4irYk*i9kb,ZpYMD"6+`a++@S5kkKRNiK-IqUIQlJ[(rpUm1c*`9ZHAJ$"8b
-@XQMcZI2`UG'U!hFVUDmrX1V4"pYVLjdKc,TL9fI034pJAGeXd9"lmG8N)P1'hTV
-[rVJ(i"k)Z`Th0Hj"Z!IM(S*l+1jKZ)IMVX%p#[GSh'0`Mm8p$[Gih"0`6m3p#IG
-Nh&0`eq+HLRXDlZQiCq#HLAX@lT0`cmBp"rGFh20`cmHp!(FGlS@i&q&HM(X*lU@
-iPq&HMRX&lT@i9q'ZaldDpaVFDh'r+2mRK)(BS0'aQZURMCeZEJX#8!KFf!6J-[2
-r"6ShfIYLp6QfKi&UD@0r[C&pjX6a@b+GbrQ5ack!kdpdVFRD'1d8h0j#)FXNfVR
-q[!6,%GNNQ2!i&F[RpKedf"JhXjkjDEK5l5cJblTjUrGNDer@epr&Ph,EAlUieEU
-Nq+a,4hlLQGL6Ph,G-9-2LL@r9Fch9#4A"HC$q*X61eb,&3S+QPjcQ(4M98BqL`E
-X0FaQS0C5EZCfa&bPVYPdeV29abYA1CcDXa82Ij0MdM(B$CRd6'q*6''$f3LCG-X
-YAFbijXTN&M'QUT(C+"NiGV5j,(&-9GTEYYQ4JhKf*'&f8QDm#L8efcE66QbXc(U
-dpk,CBTPd5qqc6,TYLHH6)+ckdb&5DCiqdN,Y93[fHDBJ1lhCddF%lA8QGXHQdBm
-0SYiDR+"-'Xl8ET`@V-I*HVfdI'LTDcZf'1F-["M2A!@0FkD)DGF--KR2G+F%MTN
-@$lcp,Jrm%QfG,RJ@[YTpNq#6pK83-ciC0Q%mdafBFq`X6'GlGR5jFFm"DBGc9cR
-6F"Si&Y[0J'VJTh%ejj3[G3CGM@F'B)eR`,Z-EjTk"BljFKN#PPeVR%2%`$m0LS&
-cJ)Z"I`BD!qmd1JE1"L$c[ZQQc3H3!%E)ZalUK3aBGVNR!#ERlN&Qi*C'cF$C!'H
-REhHTI2J-r0S40)J3J'M"re#C$C6QIAXD-`@SH9F`YG1[d!9TC!fFdq!D1'Ia0A!
-h%*[h,G3`VA4N&FPflKN%b2$2`$[(3B-!@4iDZ'HiD1#GjU0jj`a*bNG)l[TZpbd
-f4CDIG[NR59h1AhKUi*IKUS&hQUpf1KmU@)+h"SiGh$8)NH1[K3$&FUGjE0kjYdd
-c+pREI6@RlA6XESF-Y`fm-r`fm!iiEZ#IjVPjjqj5&Q"BYZQ(31b(k)CLhlm%aRk
-)3h$X"qJ'C0qr!-R'[E[E6Bcf*M(HBCXFJZC-K$aD*5,Ni0Rhl!CShlm!d@Rh8[%
-kB0Thl3&U2dJ*UV-K`[)Ai0UiPeZi#l+0GaDddkl&"ZN'EYqr'lTprb*iqa%+m'h
-FLi8Y3RJII)I3h3IE2C!!(F*e#DV,-&f%k")mpd*c,bah3A))ab8S$Q'i!-%9q1f
-$hMlB,8&Z'@k,8&Z!f4,%K[!D3QX[V*BJY3LRh9$D*dQ&JP5I(08M4S959%Q)+XY
-344'U*%(e#P#pmP1Aq"4+6bAK+C5G#U*64A,U%jckj+D5f&5@QST#8d&Q+SP-SF3
-8#NbpmP**A#T+5b9K#GIJ6d3#2%cmHNK(5UFZ"+(pJBiZ`P$+6G2@I'iqmSHjNAr
-q[cqb)GTr!b3E)29A)&R2cTm%b9DTV`+%k+N!!ESUJ+IPkcG&@''KRYe,Y0ADLd5
-FF)QfL4-Zd6Ca`LAD*Nki40[%#CGSQcMK%Qd6*ebLEH+%5l40R(#*YSN6,Y%fFF)
-PfLC1Z%6Ea!QAD*Xii4*Y%bGFSQhLK%Zd6Ca`1ED*%bl(0R(#jGJQ6VJFfm3*Pf1
-E11&bE"-RA)jYiS6,X8fFF$QfL4-ZacCa`ZAB*Nki(0[%#CGMQcMKFQ`6*eb1EH+
-%bl&0R(!jYSN6,XFfFF,Pf#C1Z"cEa!QABjXiiA*X%bGFMQhLK-Za6Ca`1ED*%bl
-(0R%1,mG@F3i[aeCa$Lr(9R%1,mG@F3i[aeCa@-CA@BkYiV#`Vl)F@m9KU9pP1ED
-+`q+rbR*X&BIPJ*APf#S1#`3Vbl&9(*B-9TCMUcJX)U`XaeCa@&CB@BkYiV$dZV)
-F@m9KkA9P1ECHKfA,A)jp*%i%2a6LrmkZpHA8p*9'"iIkLRf$!q-$H'iD,ShV*jc
-X2FFG`N,1D#kplRMZhf&X-mIrNaVZSH8``fDZjQ4R@Z53!*,D2+PqrUTa[lRb`D+
-jl)%ce[%h'bF@GTQhcpBLrNl4RGAaXG24Djm[$fhGe[l6&krr)MFmh[l"UhX+0ca
-jD'PKj2SPrAb8lH"deG4HF[6I*VZQS%%bqII#H[d9Z*l*fY)+JrTd2G![F&Pc$Mq
-aj0SGh'U1T"pTUffRJ@`N"kSM%NHFrrKGhf-C@c,mR111T0Eq&8V[9aKYCiL4`J2
-q38RK35F(Bh,CeX2"V"eiS"I#&r&!r56TeALV@9EI`hU'"dSCbr-$MbRZ$PF`krp
-Z2&$m325$0"iSUr@-%"6`3%mZG1cmY`%G5m61Ic[)(q&CEIjEB-5cIpYVMLAL[`9
-X,,mKmN)#B4*--BRFcdpE9drf4m9Y,-F+0rfT6m5Fa"pCb[`DHrD-YlqTG2c`Mm$
-V@bhpA[,a2*V+)rSpkH,*rUYpjfQUM1LhT8rNXDfNhk)qAYI0eE%A-R`UMke$%q2
-p8l-Q501r'ZqTQMRjTrTYD(ALTqDfp-rVbh'['XdeVXL"Ac)0,`rjqHMZNrl[rF,
-amZMp3kSRmZJYb"0jp!UT2mQM*j((mfKHX(RiXVCllYlpEH%pkPf'(d0qrCDI'Hq
-admlGqi@ehYl#Jl"rYah2[DU64ql[MCqU"cX)G4jp1R2bKrf,KIAb82Z8,3&jl$a
-@fA*Gq3XY2im3L4l2BlpK(fkjqSGj2jkrk9j[r+fGC8(Z$Q`"GVbYhYBl)UqmRcr
-Tl-$r[a(R6M2ZhIGZrXkjPdHVQAd&Tle0`di1e)RXXMKpAQPdQFF3Bq0V61E510!
-[HIrIS5$ldq3eeR!NMpECD2PAZG6HjJSrDmhQ9`M)Je1(*RQZVJ`+#1-ZbUrf$mC
-p5&0lQR%Aml!'-1kccpZbr#0L6CAYbr@`I$$hNJ,k*(1[j('8Z9Ib1-VF(mRM#(-
-[jk'Cq`qZaDd`1hS,GQGkc"h5*mcpR%rdQ2X@f$9IpcShNFGMc,e3MfHCHl'`6c(
-hFKj(QAXKM@HBHcQ2,(0IGmUrQIZkG8mcpqBCFa5R(55LIj+JNlNIc((DqX'iPfr
-LlpGhR+FCpk%m1*B!aUeq[1$NMFAHAa4Ncq!h'00jQlJbYSKiMc'Q5Kj(QFiMH4a
-K1Z8m@N`F4$GIC`ThVcHR6(d(EYZphE#2HZI0X&hIC35UdC6$aP%JAY[02mlp,rr
-@0lYj+'CK#FMM+,-Se28CCP(1S`q%94lk"b$#'&iHcDRCX1%PCN%5cDR!8pQ"Xd!
-"5#"R+3p$i6"RmMKiDAZSYIc,LLR&aQ[BEL6I0cAh5KjR6mdYje'G8kV5e1+3!&`
-lfrcHNlbVYVjFqBjM+Tr3cU`!H64%D@Vk!rjHhD%m9#2UBGj3jG@DPa@J(PUVXJ,
-Ni@Y9B4k2De@lXNCNAQB%DVArkpjcJ4K!cBjE$M1#flNShF[MFRC4X4k2pTPS",Y
-E4rX9MD$)lEdmQ%4h1,"rSZqe4Q!&k&HY%9J"mY")VZ(-q@pGG4lX-cM4(`2,,`k
-Zb4P4'YP@"4PURRkcm[`HUeE")9@P22,UG3l*8F'Y!(PSp9UeBZ[42!,e1Xm94I[
-Sc51VVKAc8%cD%T!!Kk+ZPS!mVNL2e82pMN[QcaFcH55i[G*LE!(e8&U-(5!2"@G
-K(Q8m5qDK0)*MH548jedQr3qq*ZV4BLM'K2f49Td2p3FDNb8J$k8a(H[AV-CN!mM
-M3'VqefI9[4r1l!aB*8E`X(IJkYqE`Td6jT5(VZaiMrliRBFU4ME+cX-pF%dq6a2
-j`$[)fj1-`"+3!)GL"*D!2"55f`,bD&NKS+kl6+[eCKl*Z3q&9-Ibb#,9mhP`k[a
-AmH28Ja1*NNXbMdXHk15aEb@!2+Tl[kA8LAMpFp@`kIlE9hePmYaFKCViI[jQKRF
-Q2[c5PM)96aFU0M54G94$+d!H@U@c!Z6KUh4K(RQ9,TR(kGb5j+YL2I9!&5[@`mY
-$Ue"@J,VU5C86HI!H1MEVYp+iY[JL(aTVNH(ZXeF+3!BE3"i*&DU84hjV3G#*#4A
-Urr0!PlB#e09$2"Y!(MlL+4,c11*4fNl%fiQ*Pe)pmY2LAANS4Q8*b%0aB%Y!(SS
-$f`,bD&NKS+l-8*j!mJ5A2PD20*FqPNH@5pX!mYLIUf)pc%ZY#G"!hG0RVDrQ)GX
-'H[,3f`E8U&1B4hlE3*!!KjjVS2&2i,eQP&D!2$5Mp"Uff"mG@`+#ZZVC4bY!(Kb
-YcKkV+a0FCmA0jc82rlMPFQ8&J!e`HMkL[&9Z`XT[H`h#NeHKJQ0MfQY`r&L@pKU
-dY)lY%LMA0D8ep*bmbY[C(qa(1(%X)2X4#J$bc(k%dSj+1m"qK2*iK-a(@!%kb"l
-!h#d9c03+J*af"D4kp*5A3eT!0"f,bhE)m&J)Y"Kld(E)BmHbY"hbF5fQ+a%EJ4E
-6'd2Q2RU1I@[,C(RPPA2b'`bZY0RR53CAbH-SJk[NFC6"2C,(%3CAcZ-ajPA)ieR
-Q95c)8mbVR-G4jP9)iaRQ9FRM-HE9PBLPB*GAk35l[,U2(B!4k$bX%VZmbUZmR,H
-Y2+%Y0SaHHh46B3)C+MrQSAH#@3(b1'-ZQHl(r9aGB4D@%ie5laBlhKr*h@,(qp8
-HS1RSh@)Rm)1*c3[UV@90jp'kfLFd(BlX+(ZqVMU2[RqZ1Cb(prGpr"0622qE-[k
-rSVlKVh6frfbp*r@hGI*hECDm[qqcqIchMV8$$a429hp"C-(lqclEfpr@*IlTU65
-TDcdpUApkkTQYXjLF&ek+rr38!3&6rebK2q[,UHNVM3i1p4Al"JI'"r$F0&`DleY
-CT3'X-"KJL6Qf1"5`ija4RXA+a,paH*F"8'@ddH$T#rN%TURq`86GQr'hA*`Yj[M
-m[CArcUA1ZG"c15meaqA[E8,B!hTITII9HVITICij-AqIRrrGSC,IaHp#[5p5[Lq
-6r@,PZehj[ecjlP$qPqLpdkc1hjFUEV2LAQC1b0q[@,%KA`i4L%UQH*%4dBP)PN5
-X`Pf0QqiBM(X)lU'i'EdBMRX%lT'iDpLKkKk0H`cZXEM(U9FRi*k)Ha,ZbELRi'C
-'BLVZDELRijk"HbEZ@EL4R'IMRS0l,QjQcpJM[`"h(Hk&Z0QDZaMh%Y`RifEreM,
-Fc$1Y`,d5pbVFr%V9kK8#m)GZLBk0MSiIG)UH2lDY2ErPRM5`Y6TFj$S'rEH(9'I
-Mm-J3!VYk4r51kKh61kjh2lhlkce!li&k9qPGVIFJ[3IV286[SAS2dhZihLIV29,
-['VfAkMe+lp&kMp&lV0lMp"k[p`5p*qSp5Hr*HNr4ZeE[UAT2dhZkhM2dRURh,,e
-2dRZChX[eAU(h5VeAk9f[pfUpeqLp9ZmApGSeFL,qZHqDpSrA!Ad5C,EHFr5HUrF
-m[HIV[D#A626iCVLl1MbkEB)i+J(Up&kSpb+p&qZp*2q$60@9r6plcGkPTDIqIaP
-rl$,(aU-i@QI1QAmM,Gf6CNHQr[TI3VUVr,+ML6AhN5BV[lf(r@*Ia'-fr(BIpKZ
-,H!18Ar42AEpDq296IXC[&[`LbXriZH6#JeS*rLTJf$hlZThXN[-ZXRiANA0l#S$
-MFG[m'GC[d51`H8U#ipf1a`$VYraq&Nlm2S$(9ZZhE!Jf6eP`#Z6qbkhIYGq&c9-
-@R!,(%qZXhhANqjl#i"6B&j,IlG3$2+A#+HcUqPhf-'bH%Z%82XBDH(lVYm*'[[L
-pTZ[h[Xr"K[k!h`eih'Mp6[deHm,cLd+,F+qaIUYr"`Gd#XU&hM$HqYh)(PGaG(q
-IcQEfr&b1*+*EU$2b*mJMS[jJf4Cp4c[Fa+EGNkA%Ja5+,[Jf5M#JNHAcbbQrfHK
-MjrmD@43IpS[GbaUSH1"%bQr9pq#lY*(0(-'$YAp'cHFh@LRLTIcFFk#A42C@4Y)
--f9"MrBmG+SF[GA()j(%+kZXL[aC1A+EbM[qa9eI"$XiZi'+LVNNrpi0rkH@4LKG
-lXPIAP0p'kM6I8aqNr2T4Rr(kX[&GRi40rc@-Bcjb+f&1qcAXfJB(CHHmq3l%p2#
-[i4aU3qq`IQrl%DDeGeQrhq"HeRGD[rASEhH0pIX[%[Yh+Hpc#-UHhrd2`DEk9rI
-"hF3Hcqrlh'%26K)2h"aLrDiP[Vl(qTd'rFTGEHZhj$0`i*p)L%IpepKi0a22`%c
-mhYl0irf6X)(KkV`BHTIl@qYh0c&'e9R(ibherSmI`+Chk5XGiZ)1lMCF6La8Z-&
-T3diaLrF00r+rdm"cmU"Q(SifRNiXqk$m90mi8pD[rMH`h@EpjRmIMj8fM`p49m0
-1hJm68cfrYh`CYJm,4p([2"aYf(m!0QT&2j'6p0-[FREp)pC[hKr`q)601dTqm&(
-VGcVqm-K9AcCp'JiIXhi[BIeZYAl[TTC(hF"TaFq%pc4mD3YX(lGq"k#I403hhq!
-'K$Z%dp4TK[AlqMpKZe0qF"fTdkA8EF"RH#'Fi"EVpa$c9Vb!dm!qPMl6Iqh`5G8
-EIL*i0Tjk*rL[cN&J9G@PeQrG&A$iP29l!2m9*AM@H#CVICIeqmleA6alp4JF2Uf
-m`9h"XlZSNhj'HD1AHRh61%4-qDcmeREUfPLN$[SjqCh@aD(EN!#6m`[VerMh$Ti
-er)UB"6G8C`llh-1caJTj&6K*(Q#cj2&$lK5iarUp!AU[i&RMKmLT[U"ic)e,Ael
-2H&m8(UKi2TkpPcJ0Ie(R6F"4(mmZqbSFlK9ZS60lH0C`"@[`CG9*e8r`V#&NIm!
-0b3rq)(M@6!lb&H%@HV$JfDhXkDqU6X6`m+aa)hXH(--2AL(pY**mpf[@lie2G2#
-X)HC#"$J&&&AKV1"Cid@2`3(1Umj0l"r"XeZ)@h"cm&ApRjD2CpIZKZdqblIU`+Y
-m2,Z$I8`2JP[AGI(X"R+8EmU2AT%kE3'(FiLhkQ`JMJLHlHFZJ2Z&+aGfmHbf'f'
-$$kUm&i224baIGcj+A2Q@p6XCZRpdSr9l,E@("p3Im"!2rjcEVSEY34Y[aBHlH@a
-McceNr9C"'IIcH"8A+JKA(IQTEKkhN!$M+IkVH3Np1UL"R4**$NNHDpLApcEm)rY
-$h,-'m2$kUASGGbKm@hJ!rRNk4p9kiK#p#Fm!(ppUrAC3d)A,U"6@SjrFNkhIIC`
-lJ&XTP`hJCj*IeFAA`30q4*m4@r*lN!!jJ,(Uh-bHp[+VANh1iqd3Gd[S0mQ[fN2
-0R-ITpM-!!!d39'0XBA"`E'9cBh*TF(3ZZ6IeFJ#3#!Fhph4)A`#3%4B!!%*P!*!
-%rj!%68e3FN0A588"!+rBraHbERkj!*!&!3fp!*!''6N!!%21!*!''hF1q&l+kA@
-CJmc,V[2AlIADK2)hYqGQ$6`jc5YD9%k2kcABGXEfbYE`c&EZ1QL[(cq[K9YXiBY
-N)6YqhX*RjAHmLbrR`-@*REFmAcMjaF[cbmk"NFA)BVSS@FjMC,[`4Drc&Ni@RTd
-6J3lJa1H9$6JGj&RQ*CmXI$R#"d8'ZqF,f`+`"CJ!122kBZPd`V+XN!"P"@CE!FZ
-a!S%YPMAT12KF%JJ'S'UT6VFi+k+C6$bG#6GQdZFjX9cHei`LcE&%Y+dYi@4MQAK
-EERjeHcDA6SE2G$CFN!$1Y'5lh+YL-5HE$6G'FfZlICZMQ9BR&fjbFVPiUVAE[6D
-HF-)4H23kRpiH6l5%DpER-Y&Zha2RR4PQPbjf8VfZLq,CD$EV*&FRR%b[IhdmYDl
-IdfhhVKBiY[USSj!!FE)0&HX1V,f"'+RH1PEA4T!!@CGAhG*`3eXZRSaIf*22NZM
-jdA"$HkkY[EX3bR@J5-ThHD6,,4+0065&)`ik%8fDFK*G!4UMf9Jd-9KGFGpHhXE
-'kZfY50IK9U4rIb[5Xl'QYXqY[rK`VFSQq`Zme,P`Hh@EeYE(9qp%1"fM"(-k`!M
-@k4M$J+FMP&"2"aL#2Xqre(4HN!#qc[2FqrY-qQ8B$JXK"N"$3[3#ShBYSD-1-!5
-4[[p`#I["8[Z1)UD1-J+E(6&fY-%3J(VqB`dp#+@HH`qHqVkP6LNKU`j3JPI9iZY
-fiUX%+3'X4"K"@!Nb$,%5SS5a%Q%)C2d!TDEdSr4eTHrIhhTZi``$E8H-!BKaBr4
-#VIL@X&BL$)&Y)F#13[E$V6L2iUf%'3(FBT!!NABBJP`r`+lf(J4Ghlm(G3[1`be
-6`Pf*8!*H"0q*ZSa3JPbkMq!Y)`b$,Ie,5%[h)CKe[8Y0k)ESkd$AZEr$9(F-3kX
-AB!")9)"H8+9M#9(T2J5RHHqKX[8$+6e(8C3a4L$8Me!Uqa"iZYilQhB30PhR(Xc
--H`lf43NYkGi"PC*&@+&AI6cEchXA1D[E@eZG6&M$B&q-fZE'%M&H2qp%B&r-!4D
-N8i6C353IbG9PYJ2*L[YiYZb%N939U!rN5Gra*(AYM`rA4e1Yl9'!dBk*f"b&*@'
-!LC1*-UQq+#H-M&$QKUYD@Z+-$ZJLp+)fr8fbUb`5D,3Z%QD`-1)rAKQfeDkb--T
-S64KMX#"dlUY'Reb-Gj0P6IQ*C8eel6ABQD$8@Z9+Ai`h+2'mj3R6JJ54qHY,rYM
-eX-)X$YibU-[`[JZQ@CC93ArD6j9kRLE9A-#SlpP'8lHf9dq+U[3"D(Le$@mjE1T
-4jNR5(j2!dFj`SLe1*PZjYUpH2AeN&re95[RDUV6lfX,D'qmqH#IMRB*h+Yj*H#[
-`PZ1GL0I@qDM#k65#36U%3Y6JE3@Q&e'N-VXfXIUPAC*k&90PY+KqmFVBZRJ,'GL
-+TXCUeA("2)U-5U(,9#p1)4fZ6T!!E@BV,ibhG38mTkia[+4UHC9d9L&2!J*,`R)
-VD$!h3*K43M`dJ)TQQH$Lca[`(NS$'i9b'0ih&KcHK2I)JX2KH'F6KmSdC"&M*q*
-9X#Y)k[BN8CTj-MCc0K68&NQqA%q%R#MPdrAd)mcGb6cHJXUUH!1b0pk`KMp3V!i
-%,0%2)48HYG#`T3L-,P5HEJ5XJb)V9J&rU`MI63Uq0IQ3!-(9)1Dp#+`GTE0G#2(
-`a#YU0eXTi[PNMdUKljBeeP@fCC`emI8$r5bDQj!!UarLPq4N`4C9-EIh)4IiMAk
-eB"(PXfiV3ElTBp@p(Li44K51d8BBB4r6YJ$+*,'49HiMYRHVbQVECLK6a(B$&%@
-YBIXLP'PLqbFSqiU0,6pGfi)(3pP2E'q&-N0XEi-b8f`NmrZ,l9)SB,R+pM%S"iM
-Y5e!1&0[G8&iRlFRq%6`,%4S2%PXY&1C1'cNVqiZfhb*qLHf2"&*TBpmSD)AYai+
-XE$hfJd*Bf,Ka5B#PV3R+Qm@@%TbPlA)AEf'l%FS4B[X@J9PXpd-j5Y[+f$0(Lqe
-%+-H)MAeI+EB,S4`VYSp!B4eSq`+8im9f&j3jBRX8bJQ#LHb6Z@)l4H'lYN@K-&r
-DIJ2+5@*MImm6fpHJX'GTBdr-elCbiJ)aLMEQaVaSDiCbUYMDSC`QYJp#)Fl3pZG
-3&SVYZe!)aE3p"Z9dEDYJ2eH,M6NX%Y[ESG5)l4)Sl((D2J'&8ahD[JlP$,'aCRA
-D0S&iY%4Xl!h&)f"VK&)[0Q*H4'c%el2%pLG3'X6f(5L-5GY2SCbYE41*@8[&a[i
-K2Y#f!JVlJMEf"$'@YJp!@5ifjXFiY(dEbNUar4X8iL6KQVK*6+#0Z-"HS)heHSI
-BeN%j9fc%dAH+lD039SRYUe!`59+f(d%K$T!!!T!!!mL%C"*a+LBfjYFLY[1J1'*
-l,j3eB[X$++eL)dl,M'J518&FE!p"BAa5$1)qDd8EmB2EcE5aGNQaXEq*Ul4G$b8
-Y0Q+5d,Tpf0rX@9)9mTb-f)L2-L#Fc&k50HM*R!Db"fQl$XVjB[X+&()VfKk!)Y4
-Y#ZZd3@c%5Z)`EHbIAa2EEd+j5'bIK,*4E(m*KIN1#5T@&Ue-Bj[L[f8"T+Ua%IJ
-9f,35FmrAK2RNMFX#9`3Q"+A1VJ5-!&PfbXJXp*9Tf35p5S*&P9re92rNljGXrm@
-*BFFF&Y6GaPZ'Gfqm%r(ZKEFFE`AHbALRiTf#PfbFk-XT!DF$R!T`'X"%1%8J5R)
-+)1aI64Q)r'5jC(9Nq@6hc)2-P+b*l*hXJfK)PNkQ3eE1@K*"LC`X2j'5E*%XNHc
-3CCYN3f5&C(*%&aIab6L*pQ5$l&fb2l)qXMfb2,)lXMUb1E)iXMHb0V)eXK)L-KN
-#8CNS443QqT*jNA'4DC&KNEQ4QC&KN3f3!&'4fC&4N!#p%8r)V-LSb+6)3XLFb*L
-)p'4)C%CN4'4#C%"N2Q3mC)*N)'3HC"c%($)-6KXiCA!(GQ6KR%DimcT1%6M0)$[
-La),-L0-%GeV(U3&C'+F%R!j`+N$@abN!f3eC2pNqQ5ba8pK8e`d%UcDHbA)6VMA
-TT(,@I%dhX(S5VNZfT61j-1GTNFB9"I2Td83LR8k&ch!5E9CN49M[NkP!+l!iSpD
-XD-9UNS@0Td,Sq4ld2VAZdVGTdV2YBH9L#H`E)'!QQYP3'40l3e09KbeMqI0"CPH
-AbMQC0G'B3f-%Ui&+EkS2,fe2BDR03@U9LqVVPBZUKrK9q['iHPFER6dh[QTHba(
-D%G%L+b38('3'fC@%GP-4rHjL0I-G*%ET)&VelTHeXVUK0Yp'bXrV+TUjLU#D)3l
-kFk[9eKElQ$5(04qqal#`#551ELSk`N%j-L,XZJRT1Drb1!C9q`dS@lHc9&2jD`p
-Y%hI2@1cF2Vp#,Y*PfU@cdECRRXm,P8bQFqPH&2%#MKHN0eDi+GfHL6P@diCXcNP
-LYdlDM@&dC`b-T#[EBQY4e[`'SpMmr8lYi1m1GUfh&TGC1eGALiZU(@ZTA3Yah[T
-EcdCPaaTKBAZeHeI9VeaK$l9ckl4cae4!X@0rY,"ZfEeFkEH$ZcKC@*2X@)VXh6(
-Vf5McpmGHf"BcQBUl9F*jMMYciTc"h5VK$-,G+Z%-`GdUi3c'h5VKh-6G+Z&Fa0d
-UiDc#hAELr%@f5Y6XaCdV[3q[E*9B[iGAYNUXcq19V4,V0UN2K90[f5UarK'[E*9
-Bpq'9V4+,@`fb94*JA@5V*-!FC+XN`&Q,E*8%1&q5VC)!jc5b94,Jh%Df5J+F-XY
-@5H"++,*9%[J`&*P*"MiY[82Ec9"NUb4`1a6C+JQ`IV*9%[J"&0NU#@!2eGdU#A$
-$3EC+JUbIE*8%@8IC+JNbVQb9"$RMNDf5)'GRXP85j-a+YNU#R&A*9NQ3!(dT@b9
-"eP@f5S+FG-Y@5I"@+,*9%Z3NAEC+JY`HNDf5)1XR@bA"ak()9NQ)[5GE*5(@3VC
-+3Ub0E*@%L"Qb94,LV%ff5N+FLmP@5BJ6C0NU#E(RC+XNa#d#f5S*h34&YNT#h$+
-5VC,3R9"NUb6%,5#C9SHib5"E*5(LK'b9f-3if5UaL3Zb9@+c$f@Va'B2b&D*c4a
-NUm6QV&'f5Qc1$Q@Va1EX6lC+E-lkC+[%j[a4YNTXEKR*9SPp,46C+V%r$N@f5Qa
-LS@b9f1a,f5Uali!L@bAfhd#4V4,l(LLb9@,r$)TXPA!Xl'k9'#+%Y@20h$PXedb
-AH%L-)bmKGf![%[H)DF3lBL%aKeK'E#-QN!!2N!#MX2F,-f&L"c'!q%$1`riPAf"
-2XLq)mqa[BJqaL,K!l#'@%3q)NF3)mJ4hcNfH3!j%AN#F*LFJTT(c%2X,-fMf-RZ
-BA)(p5`j!A#GA)Zkife(%5hH'5b'1NKm4FmQ0L,IN6Z36K6NmF9@ial1LeS+4Mj`
-&a!k"5rQ8j,Fhe*idqQ`m$[YZQKGRC0qBlYXJBhADNd')ifik8kqi+AAaVGZfA5H
-EIX8J4MK4qfmGkrfm(J*q$YbiFYZfacP,-VF*Vp"iqjSD&iiQ,Q#9N!"EjZBfiEj
-Y&emi#VK`eECYGh''E@U6iVdVL"(Q,T-"3&DYbZDL'F2$&IX!G[(cjp(qVikQKf*
-b)i%E"ZlQ9Zm0+rGL!+GRl[D@+8"qH69"hbj3YF*U"bp&"'4Gb1!Q"!01J0@k&a$
-"+)F(i'TBbr+hmG@'ZA&9HLq['&E%#$FM8"+dbXj+Tq4HhB!%)T&'!`"$j#4#hEH
-ANbCp-NhIDGXY2%I&'c4QJ$bU'cERVdCY&p`VBQ&ha+K1C-I1UcbGaj,c-QXUmEj
-D9kj-4eC8bfErl[jBfV48VJAXcU1jCQ9cjHVqXpQZG0cF'K#9apTFmYAQChqS2-i
-EkFDRqeAPX4-lH50X9(LplcAm)!+I%fq6b`flkpU5MXQ0b0epRmPQj)EQlM`SPH$
-d`bMlG&e9(NpG6h`jMqi,9ehb1[-%diP%kZ8'b*!!G0l%kkpmBrdB`Mb6Kc'!S65
-F[Q3AFKD2qr@*SB,Tl-61MX1%1r)i5QlL[*E(5%&Hb'-(!2pR(U0)rQ`Hc[U4JSb
-,CUDlqcA26(G@ShL$XP520Tc)-`6NJ30rreYA(P*amaK'SKIbD0["6NIVQXr$#-$
-F94jC4birriqB*aMhdhq&k,amfLICA,XK)!p+*CVNeEVb1&&K-kC2bXd6c0e3`8b
-0!-KT9N#UTkAl5'QAQ$pQ1LMY319IR1N-j@%fQ6Sr2iXCl)kACM&MH6`hLaR,ilP
-Cc+imRTh&M1CKATM&$06M&l1BSF+q1)XCcH1j@Fa!'Ur-BXEbH(i@djq)L@!@-a*
-$lSh[%"iM(mfeqf$j8f,mQ1N-!Y&,-jd5iTX#CMVjUlcQ'F%pLp(I944q6k&I,K+
-Yr!X$3Qd#rMmVM$&Iq$'$(&RTq%51ZN9JIT0)8eh0028aL44qG9#c[Lf4cVamND)
-18b''aA4SC*ICB#C"-(hpe5d$$&(Flr$UKN8eKiF2Ae69A!@eXDkk@@lNQe*NJQ8
-I-23$MQFNrl8aBi$XqM51&U-!H0PGphX$Z,`qVGJAaeI+K`E-+B,bBiqR,S@[Ed3
-6q)0(E5DU[rhb[2aUG+,cEhBbbAJUQ[Y&qUU0c6AM6(f3!#p-f&2Ir(RPUhGl%JM
-c+28"3hbc)[mPL'!('Fr6I-3KjCJe(SHXli$a1$aH'Xl(i9IrqZ[$!kE(M1I$JkL
-9!eqJq(8r$VRAp2&mq*@,+D0IT8!FI[&Ll%X9L-0[B*`d(SFEHe-0bPqd)&["F6P
-Sr#r-"!2G8@,L`Ia@rNdU(M1f!B1,"e"$"VSMeF3$IA'PUEf0Dq,cjA1e*M@8m2&
-!mi1)NmZN,h!bkl,KTP`de4,0Y-Jhj$E-jfIcm%pUDZPN-TfDhpLq1K'2KHY5X84
-lLf-'J`dI$qcr`!1`##-C'"6aS%c2NqC(X(2$l`"Q`mGAcUdm`E3f8I$aS-+JFGV
-%,,HhES`jFf1+qI1Yqp(V!`GqeHPGcHU"M-,IV%d)[ld0B4DME[S8XUC4[Rr068$
-q,8rrHpCSpJFJ-EakBi&eG,qLr&qL8RreaN*&lkIAc#p(-e4hEjFp#)3,A[P[#C@
-q6@%mPEl2AjY9C!mVjPY#Z$44["&I[+fH2lN!,ei'mQkV$mAK[aEf'ir$S`dcaZ2
-`L[2-m6M2h*a((0kF2f,dPMbmH(2qZ2'mH50ql*Bmi["'r0JYHF3KI4Ul*Drq&M&
-q5ajaH1Yq6[j@pN!Gm`kQea[a%rIi(fl%llA([A!MIS*hFE#d2@XmPH,&`4dVEkB
-5fF1+Z6M)(ILCh5ZIa@paQ`Gq[[h[8[`9'prq-i)p8[K$@djprJNJZ-KC%dmjf9&
-kBa`4!m`IfS``rkJca)JT$JA-1$*$cYIZf5F`TqfbCk,!UE"IL[GNqDMP+HU+['@
-G+Kq42%ff4KDSZr)mpU)cU4,pG0'V*FiLp@F'bkS4[eV*Bl(kdi*PRB'2Q&,Uj11
-L5d3r8q)Y&Ee*p'E4PiPH,h@+L2dXbDp"kYBSG6TEe80rSp5'UI#CdZh#e6Z4dUS
--Fc*2G$N,%PVDd0"FF!SYAVT-E5R40V9T3cER*19@DpcKYPT&E9ep$GV*&Ve-p,e
-%,aGGa8&(+$Ydecl46c"i)"DG*,X0B4b'$6HY6@"eYcVG`RehP4T#lLdT646GY8m
-@IB+I8Q!IT0639"A1TYXcXA`@U(9)G,GJdd5I+Rlf9GFZA"FJXMcjB2P9Pfd5YaR
-8bkqkeK,lrU,2XZkqqqk1efe`hHXGd#'IF$A0L(QQ)i`mq'&3i@R'QElhHp9NLj0
-@B$EE1CR0G9iVf2r[q&%$q(AHG3NIcCk(AkVS0`ej@,2K&brk(BTi&C*Ik&l2ldM
-ifCYdIJ@rbNqM*[4$IJ@ria#[c%VQe*dC[iZRFDLc#AkF1aAm[X9L*A2CVRJ23TQ
-+H+b6llFIIi!c+CP,T)Yqqe+4ZKEUm4Ef`G(*YQbRhdNVd6Ieb9aVCehhCAmFf*C
-aePKP%rL$(Xj')3XI44mFTrcXMEcLm(VY9h-NmTLNidhNVcS1dRjRRSL2rYbMr6D
-H!SH$TAi(S'cPfQr$!h!i42,Q2CeC1VrE@%bj,EM[19!QkRMRrLYXEa#rmk"-e[%
-HrN-fX2Bl#(J3f%[(1r4q1"`QmGC$18AlRI-jf0iSIRrXjE(ahE#p5IZGqP(NFCH
-1G`b[+,aCiRfCrDIpCR-N*m[`dlp*80"jE,QF[DMpVN6HGTh%Z`B14dLmak(B%Zp
-k!Shim5[3UlAIeLGKNdXK#jRh21ehaqGK3eqVIU+bMrDl(,eP(50eBMhfdhQI`VT
-@5RlX,Ge2pKFq"GZafQr"a9"Zer&D2d)JdhkVdHF"kF[h%T11ehkaZ9"Zd2&QmIG
-#Fb5rUr*p8$E[2YK1d(jaB%03qQE10q$!q*!!((SPMjFq5C["Sb-ZA[Tq-jH`'33
-[#hkAqRMTqqhl)i@,'Lm,m6lKiGaK934+lEF"pCLm5GIlcqJ!(+0Fqb82jaC%#+$
-DlhG45aIRbRQMLKm6Chpmcm1j-lm+"hj@R(NM$aIRV[NGf14Bq(6q%PrkmZU(B6Y
-CiRhA`kF(ELH'DEm%IV6NiP`VHq48LII2HCbc(eS+ffR#NhKr3qG4GNJ0'ell*G'
-l,XiGr'hfPX6Mp4eGEr[qRm2'(U%Im8j`lJPZ(-JG,1G22Ca,I4%1FRPN1RQ#aVQ
-bi&r"*RHU$L(HDC`VUb+RB8fBhiFpR,[r*l$*2CMpPq9aVQcZ"f&E,(iAH6LArQ[
-BcK$m)(m3hV#F[9HRr9UfjR(1rKalRRJ#53'V"1I+cQ'Gj"VHqrM6*m'jeHq%6Hk
-3!"h#AK5F+rppf)J*M(G,(ZIXcF6@Xl6I66Il11GrffNKqmI&1Gr[B1"(RKIkIQf
-dZ6MRqbQkG,6JA#(Hp$c1fCrP&q-EY0mYU)IJA0PbrU*+PJkq!V`@R,0rb0c2eRj
-I"eki1"Fp(`l%&XLPYq9ac[i1b8L6j%dH)MMhCI)cfFcBr`S2jcE6Khh0IRV)`kF
-31GYblAFCHYV&ZAUHdPQKr6D60`ZIHpIlB31I96K%A*FmPP`*fpZdhjBEmMKRhdc
-q4ej*2flM#+krp4lBhLlp4hiQrAd4qqBG8PIJNH#FrI&9F$KAH!B[K`[19A$Z4+a
-JIV-m2[FCBKYMXYkE2CblILCXFQajjSFm2[F2c%h1)@mK(p)iChqIh%2Zk@cjE3r
-RbXL2jDE2jCGiI#j`,B&2qef"qVPmlK[-3BiaELA[e6KRIrq(X-NPp+hNDS,h(q)
-'NpcEh2UBKh0r5kiLCh%Hq3cb@pKBRmeCpL1F6mLFC3Ea[M'ClH*R-c"Ab2[jZ$@
-GJ$B9m`cb%(r1F3qfRB)9+QrV8k`Cj`#3!(Z"dk%jfZmka,$NZ[b9l%10IpB0ej%
-iDErl`'IF2+iQRXPPUKq$*lKjh)*CJLAcS`H*!C,(9[*TiLcpd&YZ(US[j@VC3mM
-9c@-pq40M3Kkqdm[MlmR9C*kej31UhVL*jp9DaIXA+0p,4V[Z&[lX#E5&QXHmCp[
-2,i1$A0rkk4h%@TeIJM-)qDEm)j`0A+2pPY`)Qpc(HK3i(CLUrGj2IXpHJ$`'2UR
-cXka,L*FAD,r(f5H5hb6dZX@j#[h)Db@rGH!@eJEYp`6`hFe[lar!3Bk*23RFFI0
-Ep$8iX,mJfiK9NYqGR(q3!0r4MhdJqGe)6Vj4Z3@SZrPP1%rL(-2kI`!!$3j8Bfa
--D@*bBA*TCA-ZZA3(0r9b!*!)"cIhG)rF!*!3+,`!!([+!*!%rj!%68e3FN0A588
-"!+qqEj+bElZd!*!&!NT8!*!'128!!#Hf!*!'dPd'q)ZeF"X)Me#qb,Djk-)A[Li
-mb@CGAT5lr9`BBG[)`Qj6lYP(,bAdZXeZHE)F&mr@NhQb@bI,kP%HlBSXXReNRf3
-jRr#&lL2lA)jIPr(,4C2`KC0pV#2l[&`'I0&EMLaNGi6AXHAj`PU14rLLNH9iZQK
-TC%pFq'*2XF)VeHUDq6Ze@!5!E,+3!0pNNadC,@5`N!$EV3YClA23p6EXl,aSPf1
-EfGY)ZclDfmQG0HJm-hZhjb#rJI[LqCf$aFY,FcPGH'CqRJdb2kqccXp*[,0hmHb
-XmcX[MbbHbdQ@LAPN)C[F3QB,"m!##,M9Ep$PGq,Ca)VYmp`@Lr",XMqbG6-#`"E
-m!HI8UpaXeS)JQ"F%i4P"iB*D82LTp`6"Mhi5Qbq'KC!!Tr[90L[aKUMGVMEEa9+
-lZ68ZTaeE5mSAcfXKmVI)l`A"Lpm5"#I0kZp5$DP[Hq!Fh@h[Ck1+CBlLhr@hliZ
-5Jp)H!KPAq5L*qTZ6caAkE*Fkpb([jH&dH'cKXRejF58C6S6"c-bXi6-cS6j8rGf
-6lpeA"F&2cqKA*Nj`l0($c8C8EMkAUe4`4R"FH&GKCqIGR%`Rq(LiYl"JhMR"1D6
-Ki5"iH$MirlPj*$KZI@PeIkXGEkP129mA6TE0l+F+Rj4&JMGPLI9I+YPqI*k'A#Z
-TANPH@QK,e35-0R#L#kX3KkfMTlaDEe)M9SF1NUrkU&@RAf-k%kj9C""jVZ@X)I2
-K*['X`P'&&I01k6DKK0@m*0*)rF#R9rkGc,KmH--PkmUe9A&8LGZPdX#ccE[`*9e
-j[0S4cVSN5D2XXEQA`r3APRr@aDr+2ql,[q5(j@-0qGaT,YF,prYc++TGAcJmq81
-5,N$6[Xb3!'5Q*('cS$[ij*,M"1h`MX,TKDrN,AG6UrbKSHVQGY6H[Y5f'4A$eD3
-Fc"QZV$C'"iS$cAUV@S[Eqd`[Ah)"KZI'Jh(M5EZ&eFDfTpfCT8PJ0kG56C[lAFe
-Y0[ElD)b5FP3lN!!'X99lQ3h9aRLbchCqG'RdE0!Qhh1QdRDdhfIYC*)fkm@,iqe
-[D,BVqfeVbZ8i5BUP+*hBEjLCV0BUcd46YH6LCiX%ZlTU%L9*A0rm4%SahP&"Q,8
-NXrDFJE211P!FVQPVEG5Z(#DJI&8dUY5ENi9GHl)`hT%Xc"TAV(c+TU8D'`H@*hA
-+DN0FffHi*0ja)+r,S[CiR"E(iM4p-V&cm9Ba(,9DQ@A9NQd(ZPaJ@1KbJ@R3jBT
-fN[DLQ8PaB#GG,M$4A5kARN+Aff'EVH6!0YIP@[)YI5N`,ADj`$EAj3,$A*F,$)-
-Z9l6,0BkLmBi+#VTF,Q2j,YGXfPSEdZ9b9H&hZD*GHl,m,PFdSmXefE48Bp$P!X0
-FP`X-LedZecebABlqThBK5bF`EalQXTBlTVQXEA'FbaRk$6jR&h4c,riGdeV41$H
-5C)hp@6"VNad'XaC08ee6j[e",'[E-YGPMCX'ZkaPdf5AY5b1GMR$TR%TCpe56XA
-TcNYFmhKAX'dV*Rr!m`UN-1(P$-1F&@DmR*dCm[*'VG9C(21bPNecAYDbCG$c@N1
-Z"jVLeeB,UmRq'E0qY$M55U[ekSl(4dRG64C2TLefr%ef+iEhf64%jC'aiR"-6PV
-5f"4M[QAj3HB0*FUX8A1B3HI24GNd"dU3!%ef+XE!TLA%"Ir4,(2'KIR3Yf`H@(c
-MiPcZQaB'5pmb2eN@$![6@X%k1ki9l,cC,%KiFETXX[A(bm$@c*Hq6D&!IFYmK4B
-0@a2M&Dp[Y,pkQaF*cFCYkFc2aJA$X0abdh("cKf2LdBYU5i-b,jPB8,f,CXf0lj
-YIR96-'a*9c$4+U-TrB[lNiRD8pd`X-de`m#`f!X$fh`V$#acR6!`$"TKd5jAQ%9
-M5A64V$A2q5EBE*TY'MP6Y`8'*VN1'"J'$E$*VL8PT[d&0XhG,l!Z0VmGYUeT$&T
-IdDkp`2c'9c5MlcACl-K`VZX&KVQQ&aJ@HPjJ'V5mSYf12"8DAY[XecEhYFpm1qH
-pYPQ[GFi,Clb@qDjeYYXeeqfDkBVcA0XXecV(YFe`6I2ElYQYI@jVRpPDjl9`9QZ
-CdjTQY0EjV'df#rFfCVe3&fqH("q2fdAA(A+fFpH9RPlediVQ6*9MLQeM3dfQZ2B
-SKK6BHL%9Gr&0)H8@,5eTm[TA,Nqj)A&(S[`aXMP6[R'3!+V#k0QD+j2-FF@KU$%
-q'G%e@P%2il-q8%%M@0Z1&%61HX)"$-M%i[)++eIP6A8AqTb+29G#,9%(pXe4"pC
-qe)&CDp5j'YZ9l+b$YQaRc3[TcYVYc,GIKfd*pafdC0`hckAFYfZ0h!,j2BRm#[+
-Vb+H3!+13!+14P8L&%ibm!MN514Bj$MNH14`*-m,*b'R)3FLr3Uj"RSXFLPb,2!m
-j'$N%13%j%6N*@B@FM*b#""(C(cN9@Bdm#9Q"I!`j!$N3q3hN0j&rKral*%`0kj%
-EN!#J@5p!ASMFK,`BZ4Pj2[,cb0FK[i#Ne3,@[34j+I)b*($VEFMA)m(Tr`(b#Z3
-EN9FL!EqZ3ek09"`(N8mKhibm"[N%mUq4Ad*q'3QLZacC&GN0f3RC'GNGf32C%eQ
-'r#35!'drC!,j+H3Cb$14DH4VN!#[4B,e6#&l)AXMqb!K@6JHf4GTX1JR)%p%'T!
-!p+H4-$!!P[iDmQq3!(q,r$Tb2R)"FL'b!AN+XKkj#,NBfBJ%V[eC*&MUdj!!GFM
-2)Fp#RSfFJeb02!GCJm`J6d8Z35j&,N-Z4kj!cN914kj%VN,13-j%2SkFKB3eiA6
-N@j&rK(`EmZh)kj!!Ed(q-I)Gb"Z3!0FLra$j6Z50b$p"+SD1b(Z40b(r$(Nc%Jc
-Y,FMh)'p&[KGj'r*kj1h)1j!!ld2HLE`2qAlNrFJ2),FMld8qJ(`3q4$b,Z3pb!m
-L&@BfFM2b3mJ2)ap&IJ6jjmLr3(i8q6(Naj&rLI`%mZl$h9G9r!&ZLIhI,,kD8SQ
-DGRCZI"+ZrHYiXXTQ$JYDM48JbYcR!IY0K0D"!1dXRrf"Rd#A-41-RHBV#HBGcf*
-S0$[9bPT9Xe664ar1p@+,3YAk84Yf!6kiNI)d(hbDhN1)E4B`BATX"9P'!NHZSmJ
-BXJ5C3+D43j!!TFM"b*l)l[YTB,a3)L(@E"8)9)q$lj6E%XZ1Q3IeB2dLYiSE!9'
-fNSU!"0MT-rJ1Fd'm6*5MG`AP!K,8eV68hp+rSkTY4qilIA@TZ'Ejkc@9ac-f%&1
-p,N@,i9A*4R9`bMUF@,pL24)+3eQK!dile)-#6[bk1@@RA@++Ac3dZ,'mV9S49Q(
-P'2`[B8VGr-I*C0$6GReXFI`+f2QCM[(6`YK4+Rk*Cq[QF*8A8X0kUC0f2lTCjJ,
-8kk69ci4MQrP-F5(,Kq1dhAa$h0k@&$-)cp,64SYRKSYhh4!ZhV*Xr8KaG09%F(T
-a6+r-SP-[$-+e,(m'h0ehkTTJ[,KH#lAphfM0*&hUD8Y,aPb,Q-(U+IV5HMV1UM1
-fGmjb&N[)k0Re9S,2['A0ec3R03k"HSlZeHU29DVq-Srb'2C-6Z1Iah,Ee6Z$lBp
-SUSU%CehA&pkq9J[BcfYULK3qI'f`r3YIlJ6*bR1+Xha5UlYXPZQXN3A1mJBY09N
-QkZmUHSjcRl1m8#XqeS@Z6dDeRXjbQaCS,"(e0eZVZ9*RZ9AV0eD,VLA,Ymmjbkp
-S8FV#8Ap[BVhTR1JXTfTeb"T5Ifr@i[,McR+ePRXX*pfDB4@Xjm0)i@50ND`UpAF
-05pDSjI0*,4&CB1V[1Ufcch'@Rp4DPc@TDkN@P-FGl5bRDd&)KHM[0ZAMmRUD'-Q
-Jppe1bhFHS!Fd@GCS(6QfRYDdiXjEXX`eI50RUGIT8MIId'UAeE,lXEJIj#blD!R
-+`YRpU!E*fSeDql1#GMpmh'"9b'+CHSY5fB`UlTKRHIPk,KSBZ@M&SZ+LLjD[@mk
-cFIA!1QdT,#UI0BB*,'hE2)9`flA0krMX!pZqClIi&S*[0i1CTD*,-+!T&&-DY!Y
-J(DeAZ)prE4hp`&Il`0Fii"*!mLJ)L3eKFH95ZfP2TP31li*8+qj!NJ4)%9H#`&N
-P**IYi!XfbQBck4Sb40SQf$PPSfF0B(aYaJdaP)-c!hF@B)pB5l#!!+I%+JEm'Z-
-f1$I`DH$1k+kX)9KRJ'd#e`5Q#D`5Z3,ra+U#IJ#Q#``8q#c`91#j'2["Fl%bB$8
-"$JVX(0JZPM)X2eMMJ+8#8d@(!'m&9JiF&ZXU&KNX&F$%XFaK23l1La)!'dCGJ!P
-J08'r!U-(GJj-(GJmF(KJkeKUJ-d$5mED"r`HNa2,"mC+Jp0M,3+1N!!2E"ki0E"
-Ei,*BN!#!Vf*""1i3l"Bi-R"Ze$'B16#*,*0B9,(1B&N$2K$F'2JhX'+XUX#J8EN
-X3`c@$!`D',-!G`Ifcf$Z`2#"A@64"PD4Y4Pi4A#4B#)0pT'G!)XCF*-'6fP`PQ!
-X@ES%q%V`H@!$'3V!")+LB99'Kf2*#kk3!*(&B1h!"`EB3jCP!Hi3$1%Zr#Ai6B1
-p"1m'MJ,-RX(UdEI"j)(RI+@EfS'JA2D3!'r"B3C8jT,SBIXi([EB,mcSDm12QHJ
-L$5T+[Ri1)&%!V0J%jMpE&1`L`e"ELkb$*rQChJZb*DGfKMaB0L6I+cjImI[EH&r
-eqe)FrU$#acE#S,qBkJd)K-f"391cqG#!528aNl"4i'1$SpH0kQ0lC$#k)0EC0[$
-"Y'$fDB"rf$S32Qqp,&8kYKTX)Y!a$3RZdY''K@d%1MBqJU9c&,IHTbSG@aXf&1K
-J4'"6J3jf"cB@k(l#Jmd&U5ChE$R3XA&KXi11lB8q28(Tf#*4&qMB','Y3FIQLBd
-01MCEE'l3XC9MJi-1"JIL3JFN5U"68G8G@ae+M(MBmU"M5m1Q"adE26Bqk0KQXIP
-"ar6)"JJG'b8f3HMBZJP+*+EFbm3D%m-&'b*drm@$64(P6)fa-8*($'b1d,'CBB1
-%MXdG@b4da-e@#4hE-$C,k0LBX@&#"d#,(+,MDJHf3qKqD2f%eN%IB9Z%MVbc08,
-(eSMY%6Vk$ATdE1$B*+&M8mG'#4fE41S8(4Y3YN[SU$Qf61LS1EC0Y#RkQQb,%kT
-E2@NV(6PLXiQ1Z0PXSQ26+-cr#@dkfA#LBl2(4K)Gfe@fP1KJ"@&$LHjT(Q`"d9(
-Ve$,YN6l#&K%GF3X)1+QiNHMBAV+04-H'Nqd#1VDZ-S8Q"@S6)&a5,"`#I8Xqa%2
-!EVVp#V`YT4iNJ,D8kNdJE#R&,k#eP1T-B'STp6B"TU@dr48S@NUX&!)q5iR94@"
-J+H9EJ&qTEr)3U&GDrCGY-cTk%aYKG032ffCdf0$Id,%*&Ta,@YY"CJede"Rj33I
-,Kf`0drIcN!!YEPUpMHdf)`Cc!KYSG23eDKNGY8TpS5-fYX2Sb$FEBA6NQqdi1VE
-VE*V4`@3M0`k8UXjNpk*('1B4G-`!E)(4dEq%L+P-Y5eERc,PLbdd1ME@E+24XB9
-R)ik1MDN!bm[%T-0@(pfrmf"VVlj1QV9N*p4*X`6EIh6d1rSN1QUEh+)Mem5,MQf
-cX'eddVDIV6XkQ%ES1HJ!!i)132HI22#T[XkDrCJld0&Ak)hSk-ZJ$0$4GpKdSk0
-Qf(LMime'("hEGZB)G$#EX29(aia)lD2l%3rQ1r9edD`'@J!GFi-'PLSGI4md!6V
-k)fJ(G05r4ZmV(EPQiik11Q0,M`k%!h-%1KKhQ1238Grd!I@9D`E'*cVQ"[Sr1ZU
-ERSb1Z%&1S+1[J*C!4he5AqL)RlNB(A'$QN!(q`qc'cTepBK')D!$A-YXTEkZkQH
-J%Y!ae`Rl5eI91LJ&G24ZN!!+k1KCS"238EFJ3Y#44j!!)HM!*B%333H6%6d@hAG
-iN!!IG!VkUlIhkZZQq4c8#6Vk((-Z1ZBpqL3kjKpQ-A6-!#lf+A+#mJ'V$6Tk!(-
-%1R)0b`dkpJ6-0HLB,HK&k1KjX0qJqamHp!VeG9G0i"-GXc'X11MS3mbrk*L4Q%R
-4dGm"Qk+Ma`NqUEYU$*BTG0M$%)81GLJBLp$p0`rBLY6A3c-0-`JkCQRQ2R6dH1S
-)(I-'GBf1hJ1V%cVb$G3C(A(5Fp"4pmbYk+KlHVlkHQS(!BX@1[S0-`JkqMSeJSj
-C"9Jf1RSPc%cSU&9Q3h6%3$p(ada-EYAA5d-Lq`&dl!MS[HLBAGQCS'01BjDh&Aa
-fN!#c18TBB2RFTbdZP2R#3lD@Jbr!b(Pm(AlpU@@$TJhe#6bYUjp2@fTV+3#&TT1
-PUZhYXpH`UZdk)+KeDl(i-"Ja0hXI4Z,rKRmXQ'iDfh%jip4H&eH+MSKXLmEr#YB
-6NBahH*h6066EX8M@YjbGNA#[6SX[afj6-%GK9YNU6`4TZBErQPUY@Hi[QlCf)QT
-dP(-DPhCdG@Y(1lUj!r9+VP5KCTAeM64Z6lE5VX'kA$PRUUYFe%bV@lChe)VDHPf
-HKL9adTaXPr2!PME,fcV+CG9kEVQm8Ch+P9ZVYBjbB605QME(ir&8beR9*0XE&Q8
-Q5QB$cP3E9*LVUpd@j394LdE#9LQ[@G94e3pe9!drDbTGR*)AP(1Q@QfRVBY5XmY
-@e*a,iiE9`TbTZ$`jkm!V,HTU865Ek(QaH6XP5LC-SflCf$LEY[T'*CiDfEae9U[
-+8&*H2c,lpSUMIU36*QXMSpQ5GL+3!0V4KE611J,Cf'*4"G@EGGSBY42,9q1fF90
-XMT1iIHQXfHECdQTX*Y@TXG3U4#N81ABf%!TF,,fNVBKNXTlZGTkk@f@P@3iZUY)
-9UB,DCN[CS'L-DQR,Y6pdPp4)cPB96VBlLUiZ6VDPcGE`Z),,'VYh##L,,@Ql8Bk
-5Z&aAiRfkmTCqV2hV3d1+[9FUDP'cS8))b-FMY)Q0lG4G*U)Y+XTL%Kp5T("d$p5
-mrXVH$9YabDa[TNfkZCLX`i(d5,aAdZY-rh0GH[e3p*VP2dXc+3(TFUTC1lDk10!
-[8e+cP*kaUU296H@mU"a,f8!eD4HmPN`fZ)9JEHDPBB0T89E2"8TUkqYCXT9*j(A
-UXaXEP-j&QNdUh1N&@#UPA$D!9Kd6%(&R"N3f$SbXA$NAJcT3)&$VF!hKMKmZK)d
-0T3hle#CJ88V!D2fJ8"08GM[F-$E8V3qdq4Val1Z'KM+Y9)-a@CT@"MUZLl@c"[E
-hMB`3@p,*c9PrfPCm21$6-S0#c'SJ8JfLi-NcbRX,k1G0EYhV&Y`-"b@%,bm3E8,
-VmNe-+S1UGk0TbV!%+FPC2*D&)fh%YDdiircU*8XUChDMFJf$'T'8N8k6,r(ZTM5
-SeVR9GU)6*-k[-fa&PMViIQ[+#a&9M'@Geq[aIS[2C@aZ0*HcVG[fG9Qr6Mif9j!
-!ZP@e&*,R3MHH(H@AV9aQ@CP6eBKbAPBHUQ%8d3#ZJAm@4I'+Lrca&S@E,I+R@Z3
-ZY#JHXe!iU+*`4i9hh8,ZF)VJ6)QQkb6m,*TE*))6*(+A4a3233RZ1fQk6m@rm53
-EMI3X999X(Ll+aY@@Q`qDccc`,cZ`%4jcX(9d[((-kUb,''3rZd%3qBE2(d5Ri39
-L"`a#2rAIr,00h`%'h9`m+KeJB$dqCK5'E8$c-5X23c+#CQX-5@"l#EKePq0&Xe*
-`SS%"hXIHXj6HY-IqEI5Yd0j549!FI2P0AGZhE-A'G4RFB&mFh[S[plANp*8ih!m
-iVml(jU"C2ZQKCF'mbYjJiH#Q`TkC6iISR4-KP[$)FlGG1F[c84(XZ+`[Q0IA@E"
-Jqc,FXMcEDM9Z',#09T0rfa'@bma2S1(02!dEJDPi805'+3H@%c1l`ZKKQ(,-(4j
-mS0)0lJViS@(+J@("6&N-`F+8SpN%K#P(SrH&+8HMh`e##,5j-19SG,GKRIm"8TK
-b)Q,"-8`jj-X`j@"[Q(*JGa#Q(%G--F+8i`L*,N`jMTJmK#R(%91*-19SYKjKbR(
-%h#&-1BlQ-'(+FF45)8`jMYJLK#R(%@Z$-18ibVGd8%FX"X+8iiJe3*Kb(#(cK5R
-(%G*GQ()FSGQ&+FF43iN`j6L2m"#Q(1Fa(M)p4P@6`T369Fd)8dj8H45QR+Mm#P0
-1928Y6$P4)E5%+5FUYKGKbSQ+D8@BFU*#dJY66P3X*-+8%pA'3jKbSQ,L%+DFU0J
-aK#P(-``*8dj8M!A#P"-9Di-`j86&RL"-19'a'mJJ%&90#&019+KqBFV4M%6#P"2
-p1JpKbY'Y6$$M-I8JBFU*U8F)8dj-G5K-16(P9'DPQ')6TTbB@!5%+5FQ4K"KbSQ
-*m8@BFQ,U"m+8%a-VJc$Pa,6m%DDFQ*JeK#NR*YB*BFU*UFm*8dj-Y5j-1E&ri#&
-6D%`X8m+8%eGp#e01A,N8TTbiHT-`jF69#i3T*kkk%UDFZ()N6$Pa-H-)8djF[8f
-BFZ,+T6$Pa-@d)N`jFE'C#&01A1`K`T36&aZ%-1A%aC3K6$PaeDi`jF6&"#&-1A%
-aFmMN'[p((X)Q%"FlK6$PD(BPBFSTd9`K6$NPQJH%+DG%r95BFNV8Tf5Z,P(Y#P0
-1LHT0Q(*+P%GKbLQ4Af(++4',M6$PP)KP4*Kb5M5[#&01L4K2C2G5)TB3BFST%G1
-'M+iPBUb3!#ehbAdmK-@K4(eDQ(*+a+)N6$N*p@CKbNQS[`X%-U&q*a$ZK1TCQ()
-5UKpKbNNS6Q(+5DK'K5NRSGfL-18Na+iL6$N*c9A#P*03Ma'QR-6RH!K66N+-4m+
-8Ne4I%DDFT'B5BFV4E%r#P*08Ea@QR+6kPc$P*09hK#NRU9S9TTbNDN#BFT,+K6$
-P*$8R#9018Q`I`T56&11*-18Na6!L6$P*eCB`j56&V#0-1FPrib&-15R0Im+8Np,
-F)d`j+G@C-1@N0-m)8dj+mi!`jD686i8T*kAH*%`j+I8#BFT*UDk%+5HPh!P66NU
-qK#NR*BBDBFT*LIP&Q(*5ADDFP(U'-1@N2XY$Q(*5$r-3TTc8[r)3TTbdHVm`jD6
-9#i8T*khH,d`jDI9qBFT*Dqi5TTbdFLa-1@RP@*KbdZVG`T569Ym8TTbdqTd`jD6
-9Ai3T*khD%kDFY2)P6$PTq4@Q(+[&"dYUlR0Q"h1VcfH*Z+E',RGkJq`PSk!%"AU
-r,UU"Y*[EMK`%mUFI2Fd-mErkG1KZr-[LGKeJrGE[Kqpp!IQ44d&rFdjkj%2jV+Y
-I3%0JDIRXFD4(0Y46b3TV@li%,!@+Vm,Z8T`fK0YEc"PAhHGBXi3PSLNA&SEXH*r
-U$kc'PKFkR'(jI'LXRHZ(9V,LS"qRk`I8ij,F6ki$"Aj!4+lbmB#+210J2%&q3+Z
-GkH-'qEMjN!!I[bj!3QleIN$([2'J(d%-D6mJ%&IkH&Jj[b2hdhBVQ2)$H[*LPBd
-kjZ#C3r&BF*J5h#[*)USh,[AJBSm5*%HcUF2K)XHS'5YCLLa$GN*f3CBMZb+l)EX
-MHb"l)RXKHb2l))p$(SrXLc`"H5+b(j*VqNp#9L!()!FL6dB13Jj'$N%143j$$NH
-13)j%MN+14PBLab$()XFKab-R)#FL*b'VN!#6N913!&14eFKTb1R)'FLCb&R)fFJ
-DC!CCLka$cN-Z3#j%0Y"kD$pcN!$eb2R)"FJS8Y%*kr1m5T!!A&H3!%5QN!"TC#Q
-b$0N*f4PCMZb+l)EXMZb"l)RXKHb0l)-m$RNmXLrb"15*b(l)rXL6N!!9b!()JFL
-6NB13!)143j!!3j($N!$$N513!#14Sj!!Sj'9b$()XFKab2()#FL*b%R)+Z4Nj"6
-N9'3eFKTb1R)'FLCb&R)fXJETRIhKUkac'"Sl,+GfPQM1c[,Ciq!PlXk8[56[e#h
-0hrhBc-ae3UER2N-6BhRl$Kr&fIETrC0&i-Sd6$9m`,G3kXJPYfap&f`59pKY'TD
-fMe9`X5pF3&qSRCQjbaJi,'hI)X2r"(eK`beETf#Ek[m$EN$,f2GkKJA$HQIk`K[
-F[2#%-I"BfEjdF03*6p'TrqpR(lLYj[NE0kd#3"pc"Bm0K(A&h)ZqLeXD*+Hj0a%
-q3(22H[(1pH+GL5fhUVIFb`JPPER[rCIh-TUlj)0l'AIGYQMZ@S46XAM6)TXeFlm
-k)&Zi%)8$dEE`c9dpY%+!3RN2Y[F3H`qepc"l$lIh#(Z2Y2FSHiqfGk@papKlV,h
-(fAZm[5IBHk+p*pQlbYk6l6h&hP2YA@h[DICH1$LkI[ENhrK,$YdPSRU+q*YZlaR
-fRQR[@IDHEHmDHfIXA@[["IDZkmDG1[(J84@UeH&1p6RcMRAGTR888[ES#Y8Dm3%
-)f2G41KplIBb&a+$X5qbGk2ST@l$[@![*Yh+LkeS&VZY9kBeGGh[h02[,l+hVAle
-ehDVhTIBHdaPRh+YDFeKXZEhDK[DeF[cCAmJLAKh+pAH8"X3+3)9QXk%"X@IFlQ@
-A`jG,Gp"G`3UeDE-)I*CB@NVrY#!lbfH2i`e`cdf$ALPh-YV1ceaiSElGm(%V38a
-UmE!0H6Pb("+-hhVN"Z4'j#ENaFM0b#h)VFK,N!"e5&!(Fj(cN!#R)1Z4mj%,N!!
-,N3h)4FM&b%ENUFJPb+A)CFMPb"A)PFK9b013!+FMcd#HLA`0mVA)Xj!!Cb0A)mp
-"VN'HLeb,2!pj2[)#j$VNkj!!&b+jjRNmFJ*b)R)5XJSj'6N&149CMCb'R)kFLCb
-&R)fX3@D3!&&N$$N'14Cj+A))FL5r6HjqEECVllEGr#ef#FTl$#GlUcAHpaUHqME
-V'JrEqa&lImMH(lEhlABKbKf'chqIfGeTllXXhZfQ[p[L[FIL[pIL[FrLIlqpllF
-,9MjJIKm`[`rDe5S2@EbZYBhLeL#b'mebaTNFd(-k5jH1Zl2hV'e$0fe"FfHb4pI
-pB(h8ZkdA&2T"R&R"@HS@mNXR@cVQVYTZCV5T03M6$a6BK$Xj9$r`lSKDQND05Y5
-Zc%*mUl2cqI4,GBhUdZ6Q'ZG8eMI+YFP+h$1XCjKqS2B(*IrC$p4PQ$DcHF(["mR
-[c3H+['"pXcGC@r$l3HUlrD$j2%M,@&I`qd(Dl4HTpY9TllB9Spm25PdrU1j`fP5
-mU[rmr[0kVA8'[aq8'6i&l!hi&*NAMUNAm#QfZAf#I3k2)22L)IbDMD`Cj2Z"BVk
-cc1%48YRq1HEiil,m#0Df[K"mXQp-pTc$)mMmD*($)b4keI&Pj2T"PX(HRYB4r(l
-!C6Yf1Ei-Q4GrL8qaN9(Ur!D[C%IM9dVe`1I,f2H"BeVG[k0UemIEDll69jH+DjD
-rIVPNHAIkRKpG'KA(6KXYRKNZhR9$Z(M,X[8MaG&9%m(Ta6'p-SY1[6!)eh+Iqi#
-lqdjG%i`AerrJZLYed8aMP*5MQZjNh1PMfBU0krTECEY3[cf1fR-'cMVVU6"DF[T
-+(1l(cEdk(jZ$C[QNKjB&mbTlJi@$Q`TlCMiGSRG1C-[TA9Qbl8SlMce@$(CFeKI
--kqXF"BRYbmFpP'HEMmB0!k16ME4DImUrY3LYjal%SdiFhAqRV,+#*c[TrG!P8Yi
-2I0TTl`I1S&,["rlZ-Zq(fDQ6p`0LY,2h!cpi&qm(VZpbliICVk[h!`pk0qq(QdK
-kH$rF6G,6qq&fJPlH$rHAp2CqZ0'NMrI$(5I(H6rFHR+mpm-p+(fp(fj'1F(liDk
-8%ldIENrTjre`RdTrl`H@rC1m(qjFUI"qZ)9PJ2I$[5`$[4pZDMRCqq(ZPN(H$j2
-RB1q(qef'H$rFq$,8qq%1Q'(H$lI#$2GqZ#GQK2I$c6%M[4rZNKRPrA#lc'M[KrY
-Q+VdIEU!Cire`*meBliGEDXCj2paE-plli5DE#Gi2GpY-p(kil@D5pm2p0eAH$cI
-L62CqZ#0RL[I$V6P6[4rZdDRfIVKCCjVh`edldldIEYqCiIe`(mp-liI&d#c[KcY
-lCRXrh1*6Fq4HE'A&[6iC(`mhrG4k2pcp8qIpF"[3(1q(qi(QHMrF'$62qf&[H)V
-h`ke#pGl22*l[1Z6(9h"3q%hHMcT42[*4lkH"CrFMIVb%C6(JHlpM'!3rpVKEDQ`
-iAbmEjHeap`FGDd&-6KD+TXNPG1Uj#pQG46)T2dT%KMYq4,($$mKZ$`%HqJ(Cl5(
-!3cpjC(IS"f5hKa32rB$XpK$JS4q3!0dH!McdNdGfKhj!GRY)mG!2b'i2!4lk!GR
-Y)F"$2ebmk5(!3cmJZcd%H1J(C,H(!!rpJ1cf%1#K(j!!h4i#22564hE([Z8RMq`
-1rH54hD'I2,)lp*0(GSGqmXMZd%mHf4hkb51l3cpjC(IS*irX$[hNNGfKRcbb1r5
-64hD(I[,)lY"2(YNGqXNMZd-rH@4hk#H2l!lpj*(GSCmmXM[dNdGfKhlbb1l36al
-C(IS"fHdKYN-r),Xp"(MS*irX$[hNNGfKRcbb1r564hD(IN"fHiMYd!r)EJm"([V
-*)lY$2hPNGqJRMq`1rB$XpT!!f+%IN!$G(J)mp!1bfd1!Khlbb1l36alC(IV*)lY
-$2hPNGqJRMqb1ImX2b'i2`4ck!GRY)F"$2b#l234ik!GNYiF!$rf!l2B3i+'I2,)
-lp!1bfd1+Khj!GRX)m0!2PqVZ3RCR2q@RRZFZC(IJCcl2AFMZ`!p)m9h)lUE['"!
-"f@d,L-+lDb24HqkZ$GB*e[Zl0UaeGk!Hdf$FY@&!Q5jM5JkMUC3f'ZBKqda&@(R
-kKi@L+1`e2Ff'q`RIfT!!`G(e*6-TRFqUHAdcED+,VP`pY!+@XK*l*lTqbKC`!dd
-@bi4MF6*BEl@E''PkBpIGhMh0rM*l$l(h@(YIDQpBCQE2Imr@,`CAA68c+j2[[QT
-k6Tq6jffj1d[0GqqrreNC$Bl2lkT4ZG[`p&deICHA5VTmi-Kh0V+QeDVe"SLMBAK
-)[#0l2e@'&D[V3TH&jr%dP)C@pJL)Bq@!H%XX!(PG-MCk--,$FHJVHmkC#-T*XMJ
-)(hYVX'"0fR'3!,Sadf@L@UhCE(!dqd@G#iqF+kr1G-lBRQQpG4aVRSqhiqSI,ik
-4iR#b!X5a,b'rL'2IB8X[a,%hN!"$FDbGDJ@lEp[Tk[@$$dc-2,SXP,lRIA!ZE,X
-T')eh"$r"E*)DV'3eqY3RqV"r10apqkE`LKH*YmQ0BqqY4mrQ!i)q(FHqmRMKqU6
-9QS5X!((mpSSPpmYHRk6Lf01*AVKLUD-qU0LpRijM5c$aA*p@DDK*kN(@U)eTX8q
-['KKjBBl"apc[6$,R0XZ64q,Sq*Jr0LIYld`02ipMbd4Yma%rM5Z1C&A&XA@b4d!
-FI*88bDYjC9FJ%hI9NSYlPNcF+V0Y2PkFZ--iV!%6pq,AVE%VXm*2RBae)"q@MmQ
-p2DX[6Zi(iRKZFMm3ah16ql0ar(abliLMBh,RNmRGHG[#66d!*[HGqAKjFJm6HhK
-bliMMZFPpCaJ[6HiGF9J%*[HeirpEppD2LEYUbEB$2PkFZ0[Mi,-%60`VUihccLe
-1,ERJi-5Gr[l%T1,BfaQHRjJ1a2(FT20X($qIG$VLH,k6licMT8lH%FIqTUIL8(A
-rl'4H@DXHlPEq4Q*hKDJi0QlHqP`FLcG[I5'1p2!K')CmUH(KJ9AIDhrYhmmkAUf
-Va'IMZ1Mj@9(&F9'8*',Xf!4)ZjMFE%@I'frT%C!!ek-c3hD@hMq6(iUMSh2ZVl0
-XI@`pA'BrqmUbda4hpjJZfICaGH-1YNVY@kL@cpY#26hGf6jD!H+SV59*3)Y4$D3
-p$YAVb@[NZ6fjhKTD!I+KYhe@J$M-YQp2()HfI4HNp9T`FmR&FGeZV+m,ldAIqaF
-AKp0hYB,6`KYERlTjChM0Dp4-e"d"j3hXV`T[V0`66Mq)2iRMGDUL-"m(kdbf,1Y
-DhkjA9Lbk%Hf1JpXU)cT"mfMGkbf,&D"HpCE&#K!(Rp[1&"rmlr+Uie$P%IPKI5a
-U0Z,$)i-c2&ckVh-VQcki3MY'MmJ*[5H3!!qe)qrmpQl+r8b0lIRd$'-&L'2qe[D
-@IZ5VH@8UY9GJ&[Gm,E03mI0QSGrAKcF,rEjH$fkF$kbEeDGRSD2pJ`jmHVAe!J,
-RB&lY%jYV2TQTMZ49al(rkYQ$FA4![#)Rphl$H1hj$NdkGL@-ep(2XS6afY3k2*e
-fj29jV0M"b6f,&6[k@8#`BMXEb%YBXIC1E3[!LVQ6Hd2F(Mqi&%hfRTMF,4@6U4@
-JFpS91YA"Vi-Sa`+bdl'i-1AXq5`%ZaJl%&21dFqba*4cD"I6&SL0B"HcciF`lZc
-pl&Z-1ah`rdKIV`Vmrh-6R(f$4q$jb@YR(#p2AQ&#$NpH(A&B*rJ4$NeHEB(B"AJ
-@h$Jd+fEl4a#+[pdG#RElX30-"$S1U`6[J`@0LI0KKp#ZcYJEpCGUI8h29S6r4ql
-iF[CHmh-CGXh#Y&mFXf2C(+p692UG6*c+pLRNTX)jEbb'ApbMbb3Y8dbF,q`&BH*
-Xlp1Y6*b&2QdTCq+d+8cZGL#8pTl*RFm`-[l6[BYl!%cZGLNQcU0eIdc,`-5jkDY
-Vf5UeEk&D2Qm,GAkaXhfd!X6K-h'fap(+1&MBLZQYS48J(hVEC`@))m[%Z6Z13pX
-qc6khF$TRiSc1,fa%VjJiSbImr'lZKTldQ61'2PNSlRN!PiU*Xq[RXIp-iG9rmE(
-##@r@KF!qqebBMi0ejM0aYXI4bX4CL-0RiMb5$lePX3,8Upkb@!(Li"2@Z#0jeA'
-i6*a(iMK'Y'(LG,mS8ThQ'IN4*!`a#@35Q8DQN!#Pb$*N*b36D'GN&f3jNVEB$GN
-Gf32C%pN,f4[C"kN`hj%I3rC&RS!m%GN2f4pj%K+8e!$N316*b%()`FJKb+()iFK
-Kb"&)ZY-Sj'JNpi&@)X'3!)p$MNGbCpSNj!3N'Cq-R)+FLZ4)jZR)'FLCb&R)'L6
-`4,D9dj!!A%0+2f&E11GrD[ehRkNpkSlk#fU[THiDHKV8(R9(r49VMlUMrS,DSqC
--rEA8([99V$pUMaUNrS+kSmI-3aV'%HU5rN5ISMr4TqU4mj(J-L`!fqrrqq`dYrG
-f'KdC@6GRP1VH$HXX,,9M(65qVPD0+kbh9eILYZBc4hHr+[G1eePd2Z#(LR9PS4,
-drE$+AKmPUpiaHmIYVBq89Hq%[C2f6YNlE@ppMkakPpQlNldEl0h&hZAflQV[E[E
-@H9#0+0V08qci`EJ4YcR&hFf9[Re@qHTKlhRfeVI2URF[HrHfGapl(fI[iqhGepi
-Rf2Y%HrHcGhplRf6[#RX2X2G!HjpXld(feMIDUVHq[9DpKpTlQ,f(fhZ%[8dq4pP
-lY,dVl6h'h[U'@r8HCqrapTjJliRfRQ6[+RY2Y[F8HdqeGl@pTpPlBEIQiLrTA%%
-q+L2i@Cd@AdlpXCda06lGhM2X2G2HXq`pfpiepXlBZpEH#qaGeidlGH,BK%Ed0Fe
-+6-"UZE"aXPh19Jbk0DRja,aMAEITifN0jSaldql86'1pZ,hArj,[ISG@-mpp+JU
-JkT-+EN*5Yf5hM8V+$pZ3!#V[Kqh,C1m(0T)ThJp!ZkRH$k`AeGi2@-YThJrEZZR
-HccUH-l`IYN!c[4mB4@Cj2d``XldId!SehXm'RKR[KlCAkrh3iHZmRiYjc[&qf-[
-2pAlSY21m(jD)ThJrE%RV[Cp,HEkpibHK48MfbcUPUk[R1cTqNPU@Y-Cc1FphjAl
-DifC-ZHQ)Rf`LP$PAbHpeFQb)i-I1Fr'q%al&0+QH"lb"5T!!Vfhqp'[23T&RZmc
-('P-pParD6cLhG[b`N!"BFG#2dr8$UZ5+JhZ-UlYaJc3j`qmlf&*HkIf!8VR+q`(
-*N["l%G!Z5Eqh!4'6mRj!cD5p(j!!0DAH$qLE-Zm(K%iRl`F86fI["k42&qm(0&#
-jp`0LU+[h!kUSQrF$kUL(p`-bUDIh!hUTPrF$`UQhp`-+USrh!dVU11m(*0AahJp
-SUllH$iLX%l`I8&XRHMmJZ2Tj2k#mqRXr)-&1mRj!Le9i2b$V"RJrLhJ1p(i@mcc
-Cq`(Q-FMl1CARB1pR#FmKhXp5RN1p(l"G`lbIj6b(HcmVH)l`IPEb(1RpV1)jb[X
-jMHGSlqGdRTAHcaNmahJrCr)FkrfmKZFilqHe2-Gl2fIaR1$p3-N`dIZaT10lP"m
-)EVVr(b3""f5eq*L`b*fD[FTkdL#5l(9I,eZaf'P3I(D@calA"e`qV(GR1-9)F(A
-'V"8*hTHaE%@#paY3pEdCUe3Nq)"eMGXcaUe)F%h'1"8*VM@l1qepPm@chI4h@cc
-h@(ch@Mch@Ac[YrIp'F0A*2KYmrZ!qAd`BrZ+""qaH*rr9"5PDdI@,KpHdEpLid(
-5-T!!DQjBkL([jH&dH'cKXUkABcb[U``YmeFCfXqB1-FkK2Em[,'PEXadV3MrQkl
-1G-lBRQQp,8claDGZfcR(kq4)RfIL92AV-R%kZcr4Krh$iHlE0i9A[%LAr9LQQ$K
-r`HHPQ6MEqh3V%fHK6e[+Q6KY#T1l(3LP[@Gbjj2*hARE`Ndp!#ChZa36jp'k2kC
-PB1*FhEL$V9,l&UVPmlC36dphYSp@J$Km*Xlf1&SC"`YE-EdeY!,N3frlV!"aC*N
-iGmGaD0ZRfHFH+H9-R-lPiEhS&41R-heA+eJDhV4peFdl`fYHSfDLQ$M,'pKI&Gl
-8Z#HFIK"r!IYFQ)q$GHBcFEE(dFV%@BM$Cq)mNJqpCE%#e+[HXPJ"iZ!6eVJMHG9
-aZ%bF4q)i4V4KiS`Fm`h"XYFRkH265HBDlZkm#V[#4V!#Ic(CF4@hrcRRmKL'(9G
-rqpq+Yd",)r(&pZCfkri8eJRX9(b"h45ZCBr*6X8Af*9Fak1deBDT)AVVlbYJLC[
-Ve3FjZiGeDDLFMHhm8Zj[`#2Sj1aXjjGjh1MXVKBd8Di4MEk8ahaR0qVA&E"VPlL
-CaeKRYrM[C#"fhmrpaEk%cVeb0&,iGbA4YEYbS3V-YBZT!MXlZqfkc0fpKM4bpQG
-*JF5a6IfPe1VbD4ipR9hRMk!VXcMSGhfGh52##,YAR%BqrNk1f,l$f9hr3FAUfLA
-Tk-jmCpIicaKdX6Li[[diCeIr*qM+cBlH,AAcJ(``pQ"hTAblGJqp%PdhCcH)klk
-GSkdZKf,3hHVe34l6RGd8jDq(aI(f2)j2UAp4)qSEr%ELq,DcZdYRR[Db1+EQGA#
-(iZ2@9HbiAPrb9+EYEKqcqcFHRh0fN4pAMPflSI39ar*pVbie2plC$9-IZmrCI8H
-e4"qJrZKRPCQGm`ek@14NCcIZ6'UmNr2ArCm`)%Ee,D*I*XcZKlq*36rA$Z,8mi5
-hQlrq@##*Mm9(46e0e&rp1fjrr%H8iKhe00[%qhEAIJMeLI@dTYcjGL@k'VmVrZL
-l[PhXYr,kq0Dpk%ib1fT4qZ9`m5m)5M(fPlQrDbj(0m$X[T2hbmrV)[@"cQkQDNA
-keKTb(hQCXi[IN[I,Y(V'),1MRiQraekPJKFlkNrkj6A#f!ba[)l+qqAM!Ve5qm5
-YkYMdbqmTjQ(QMlU3!$karMI3U6V9GFBi+IhbIX8k`YPpNILkl(4f0k[hbH3liG9
-j[la)[Cim%0qEmhjjSAc4!iR[PVaZUPAhP@C(r8QIqqiDG'1FhF3,mhljePp4VEK
-f)c5h5,qm6A-*08)Fe*2%mB6Q@2U5qMBc2dQrG,kZbpNR1,[KUNqTJmIr3!&,(*r
-TpS2(d+Nmmc@SrU9IhX*X&l&*F4P-BUCIIRX8JmR1VNTa5,qm3GGe6E(mcHcdbqJ
-08*&&e,I9Yj8k-2hb(lk#3E@cZqbpHEpFShPVQK[2TY%A6Ep-d[-Le![I$-h-9eQ
-rp%k$GrlI"lVpdV1,A(jRYerkGX19Ap-[I6Y(IF6-Lmb)-bb[2mRljIhb3CkTTbr
-Pr[3HFCDcQkaeX26,kkp(4be6*Rkrr23JZKV,KkTMdrpkUjm*FLEeehRrHi0@"l,
-RL'Vl*2hebr)Rb*DSHV$%edeV$$Q9Gbhpcr6,1c3Eb3BjqS@m6b39!cNKhp54p-Y
-rr"Gd`[Vd6IT"ceh@Aj8ZXYVCV@(q0[ebLZUBANFFc"#QAbj(*rLjiBT(kZB+HRR
-%N!",`q92qYbYbJAcRIUZZ$E[Pl5Yb&UEQqPVdLq[&6IaBS[l+hNFCkYAbYVPM4r
-1jmX0QQY20Ar-0e)(kj3,HKhji#ejqUaf"%ZGhD@lmRjCU4`XFhCA[6R[Pb[NQjb
-6aRr1qf9Ap8TbcVM"[#VpmM(90R1FqUjRjf(kj51rJm%UCrF@,K`crA+FpJG)&I)
-'kYMdbbI8NpL(%$il$c0IqLIh[iPql$aJrG+h'ri,QU@NArTfSqLMfAlTfphiHr5
-SFq[Tq12l'kKGSQIA@`RqI$[RHZEDH&!D5P,f*I6@-jcK*&eR*RZM))jEbDXc6Gc
--20jFkhb3!0k@YI2lpcP[9em8Zb#[l!ZNEZl46(LQc6%hj[9ArrISk!Q%4&h%RGd
-PkYR8"I9+McR(fAf9R8IN%UX2qV%EAq`8l9f%&Q+%qV%EAqbiGk!6iSDijQq*lfZ
-D$f3A@+9pJF4hmeqTX8TmAq[%PjMr'$UjHQf&pJjZI)NpUJq"MFC[l-5Aq"R0N!$
-#fA,e9Chi%Mpj!cT""Ur9r(Hfp3R[-QIReLXSHp-RI,[Yk*aG9QHHAH5eQZp0Rr$
-Y(QC'G-kh[Z,E6G+FimiCQ6Xe%lSlE1H8YhEQM-b[DTk3!(hLrFcKd[mb-qUjlZl
-6fFem)rd[Fj[f@-+EF`eab&b5ZIjK$'52ZC`q*(0*l5Y[3bHBQj'DPpaqRhRSAHK
-N[eQ9lldb[kEG'AP8hhZS'jP,-Tp6h3XUi1T[GZD5fT-e6l!cB5iN[a)(kiQ)l9[
-[T"r)A*+j8ce!GY8c0#Y,[Vq[2LHVk9'DNpbkchcd(R5bDrm2jNkCmfSAD*p"Me*
-IbIXkrD$fYCVjf48`"c$2ZrdJmk"fPTGEAf&qFqI4c'HdCpeQF6rDQ8FcIkCC5f"
-2LpJlb[a8frpqG(*ap5MfHDDH(U)@)p,6epR[Z206CNCaA1(XYM0cbra8qc,0a1a
-[eAHhqUJl2pAfDhDN(TNrf-ZiG9"lK[S%HalehB-2QCmbZc4RU,P-ckRXBGdj2[2
-RUJPfHZUEUGlTjURfaCTVfI23CPArNcQqpK9rV)BLF91hETePVY'-IUh0(qb'hIM
-UEP,2)Qrd&HC20lkk0fRq82-Xhk1DVGhik[j32CJH3MpM2b&er(AeD2EHc$(89Q8
-pH@)1@j29JGMjrA@NjX"5jLVkNZp['[0Rp*JX[XKbl@)rjH+H60h%cR9f%lA,B(G
-%(16HlG14,kPhX2p4hiHBUd`Ffp8$Q"29p`ccLBPMYRCEHQKApF%X+h&FS9apeX8
-G[6+2idRYHqM2bLl1AXI%FIhY@$aZGFNF*A&d9[mM2l4kVN#81,CU"rB&CjIqQcb
-1(kPf[qMLZ&BcQBlMbTR(Y)YKGU!pXT2V9!Gpkp@-VPIfYPq[4dmJT1pJhR,F2UC
-ESYdp[BZkB6Hfc0PpG!mkCR2Q(ZE22h9f3l3rrV,,dphd9kI2fAe#ZAM5fBeRab$
-aG6rU85cBEc"AX8Z3!2Jdf[UVcPpRj8$LqaI0Z*TM,a+H4efDq'lA(-"Fb@M'2#h
-jZd'pK$d`m9(6%Ymbc8,-T-V9*1de*Ei'cCI8S,+V)KmQ[KqSCp%EPFQ(U6Z6[j6
-Q''T"Q6a+hC[iIUbFXU2'MVf8a2F0p6"9[pKpK(R!a$G-ZrY[bHcr!3#3"!d,9'0
-X8fKPE'ac,VN(,iYd"cIeFJ#3#!Fhph4RU`#3%%*P!!#br`#3"2q3"%e08(*$9dP
-&!3#[[Qr$XQjqU3#3"3+2k!#3"ME&!!$,f`#3"N,c"J$&pZPQ#lY0MNBf)j[X6V)
-pr-)@[M$V1PFQcb0XBB4YYT!!BlBbmp[VXI8@DXHp&R)l,Tjk-TAGqXEa(m[I,XC
-DMYdQE$PG'+&NaaG1ET%X6pKf)F[aLhAZf&9Nkj&0EXF)f`hi3KEM#peN18,j3ME
-K&f(,bA)a[RJ5RSX$Zl`Sd1'9DNh+kqMaK3dfff3P#eR)-l,*M*2C3REijI"pjcI
-SE##hYkGC0V"&4eiMYjf[CHr#VR0VNlaFH+a"TjhjRBdk,r-beLfmJGIR`1[bmfh
-U,ClAjGQ)E"Fl,hkG9lbhJEhAahY[1A,,HpPj'3I'!JLimTX`E9E8LZjM84jE@(B
-,)fcKbr%"h3#-!!5-"ajj$3UZ@eC+c92+@+i5pcbT%VYH91VY,m2Q&dE#`+rrfYb
-L[GRb2-Iec*cREVF,3F2@NI*USPV`cU"Dj(IM"j4kKqLpHeK$mXi066fe@b8Qh)[
-a9Ep$aB9M-hri)ET8k$J-Xr[K)i%INIlhN!$A@L[TeLm9lVjKU[9(r`mhKSd&L3m
-f[D6(`mf&lHFZ5%SqTD%9[Zm2dmklI``Z-II8pIUA4k(X-mC262`UbPAIB+CVrX[
-,!bq*NUf2#8!18kd1JGV,S*!!M$""eB6PSbANc8YS@kX[qeYEI3Qei,U-@l8+lU8
--Cp9bp42'UF6HaRqj"",U9iar0%ER,9FVN!#'kj6ked`X4Ch'Q+h*b@(2b!R$qS&
-FEl,QfGZFAImC$hm*Y8J`S#QcqDlq3VR(YSUfPmZPjRa'VeDTYVa6UC9Y%kjEPm2
-YGY-ZcR(m8QFZPeCUiA'!`%pd'%HGM!QSLK89X`pHS'f#h%&`CL1TQiM6Z"f`CjR
-a+H2Ca(HEf"09qLD6C#9(V(,F,+K&*`"L18"HRR4S43MeN!!+l!)+UXRP82p8FA)
-+fhYI$eA[iVe2iV[2f3aTLmSP)-bA3EiGD4Cff$LZpp56Sh[Rrpcf'TK2!LaU0$b
-0K15r'GE0Pf[45*F!)IA8@b%RkaVcEN4N,c3(XKIihT*Di3mePC%LQ5CGT0D-iaI
-8P1Q46V8[CDEF5XdTfpkdmEQV9X,d4,[EVTkhR1e8GlcUdMDY#NQBlaHXmPbSDLe
-pVd91GFLIYYkrk!6ZM-ZCER8QaPR@6QXZI+f"rAF&RM86Ae[G$pb+qAjlpcfZ9jb
-ahUp3X(hIc&P"DFCdHYdT&eq,DIG9ljmY(LaR1,lPqhCPm*95`,a5@aKf*,GY4HV
-GljiV,GqiXl,D0Q339V&@jK)5fP1(C@rU-+qN$X1jA4XZ@(98kpa8Tep"b5fbbp1
-QKpTljM*pQ180fB'CYi2JI+TR`Q0VaUV93YZPT6Q!M#d,q"ME4["B-Y3b+0RCI1I
-M,f"MZh&3`,'a)Q0XBi!aYSKaXC*jKE$BYSL+XA%-LV&PM)QaC35**F-B9NV@lH8
-8i@%qFANiA'lE88`+K[N##E'`C0L6Xa!*5hB!BGQS8Td4$-D@-3V'PN83c%0$M)&
-L-DpNPkIa,l!UB&pJ&q&HE+3*MfeXAR1a&V#ZD"L8CQ#S'"IS$Ei&fKME5KP9'!V
-XLTJ@'-Ci&PM&@"CB46J@'m9i%&X@5b2#VPabmVK9X#XAKZ*9,ZNK9X9'(AN*-5U
-f!Crb"UAULR!TX)Sa+E!UiP'ZM'-XfRh9MMP#PMFYS&,H1)+QXU8QZfaS%ea)3J'
-T+YC"9HDY&E2b4JDimLBaHRA8J+*2hVL)BhRV'-cbTM'Lj8dM@#YEaKK50Ur89S4
-bKIcPSDlGZ,1b&23+Y4)LApQb0h8K"TB0!F,P9Kh9'N&LhM6'aEaT%4`,H"%MT-8
-$BcAEm@Gk*JIeQGPDi&5F2HFD)`CP$UN(063KPeXHNCQfQQ-9XRNcBb-jlH3cMV6
-FD0"!biB5Cfa8$M-J"h')HDkRiH@0*,6!S"a@[UcLf*E$X3Dih&+Lc&Z93rAKU4H
-T5`jLX#jC&a'Lj#!2%LAc'1p,eK(N9iaMk+ai825Xf&US,"G&([ill3-'8,Eh58$
-*,LlYNR98h4h'h3Qcj9mbI"!"LMbbbd&2ZL0k8c&qS%a$NP1aKHGd'(D93maf5YB
-ai5PC&`Kmb6lLm"AMVP3@fNh6Zep[q9M6BY2(fLh[@9M68JI0'KCE4GDZd#b+c)T
-YQFJfejL*V0V6@fSDj5fMYP&J'651V%@4EeQl!Z1+cCBR)q4LeU4#mUcamQCJ`E3
-pIB8q9f6@99,jAPGNTGfZf+5Ff',(bpVe6L2-X!IV3d1fCfSd+9M2l-qp1Yi!L1f
-rUf#M'"GA#8dPpPf-+cE1K9@D2#K&&4$QBN5"B5kDZ+GELL42LS[Kj+ec-CAlF+A
-!5KKIM+e-Ki2`+[bJ&''qqRBadeCeU'i"UcUR5+D%b0-+k$R*XaK)`AlUh+60VQC
-R%8e"m5LS"YC+$[*&fKjml+!FHf`HKKlE95)2#VSpkX#i((&J'NBEf&3LcCGjHlK
-j$q@BmrCKi(R$5[3P&'K23-P*13FP&f%D5VD96$J@APeVk,$r-A(XccSRpQij0qZ
-j2Tj!f6lF+(%k"kV!I6#0QTri$hFb5-KE3'BJ0i*XJ4`(@3rC"$N5FL,NPT!!Nm*
-4cRM39`C!%j!!5FJ8j&M)@XJdC!Db#E)4XJ&b&()`Y-bLkaehPapBiFmCEq#&30i
-F+r`jS@ZA%r4Be5,Tm-02TVh(6NcH,bhG![)8$pq,hHciKmPl5G-fN!#YN!!Cb%Q
-3!&Y"ELef@d#f30C$6Y"6[(%J$S48Z9$H%b$P%-#$H'Bm$6LQkG9@CYYTDA+28jY
-aH(4[cYcBH8FR9'k'V4DjUIHFc4TH*-M@0q8Hm4kK8*Y#MSGXKC`)kqp#hJRj2FM
-[3ji-Z3$b&-K6)9m!q8*)GL1G"VN)mL6),d21Kc`(mRM)[i0m1H3bb"-J,i9N3[m
-ib1G$XVU!fMXG%Zi"i3BS6Q3*LM`,mQc)Bb#I"hNcj,'3!(m#q32)Zb$[K[`Kj+X
-KVi#m%[)eN!#A3li+mV@3!+q$P'e%hUp$hJ,j5XL[3,iHmJf3!'q%I"-N62*Ub$G
-$[JAbcb(I#[Nf50Nbi(dFmKf3!+q!I#INZb#r#RN0j,XKEi@m$I*VN!"r,pM"hSp
-4N!#M)9P4`$U!-C!!Bb(C4Y!!qAR)6&LcE'c`e#R)mb"I"#PG!BqFqha)0Q`)HTR
-p)H-J0iCNaG+QN!$M#8pDhCY"ELl)!Q*mJCJL%Ri$F0d1qAA)Ed"q%h*lb"dJGi5
-8I36HcC!!ci$F'A)Ab#Q3!$#lQb#hKR`Qj$D3!(m0H3(N5b#hKE`3NRl!*-LY)+G
-#lJUj'q6ZN!"l31i*#5ke31i&13eb!Q3Vj"FK`CmY)6m)q5()$d0H#rPHb!p!bUi
-%laMN4b$I!rPqb)p#AJpj!q6()$m1+Bc61`(j5FJE)6m&q@R)cd"q&K)@qMl)1b#
-r"IPYb1p!cS,mBdKKV9i'mN$)Jb!2KM`%FLlN!C!!I`-*Q$mAFJENhd*H"(Naj2k
-3!#q$[!35$M%GmMQ3!)G#cS-m$2*`b#-JCd,Z$ANNj&'3!-q#I$ENPb$KX'E0K(2
-KfGaCl+DqE@f6Br*)cC)rDS)k!5I!"2!$,N$1`3rb6Hl*,6NQlq!hq!p()2p`#(!
-5c!$(`!GiJH8%e"4e"1q!Fm!Ai!j`"I!6RJ"'J8&J)*J*6i'[J%p`&c#&'UDZUA&
-`'#bMeX")X)SkT+BY6S&0e,DY3fS6c!,r`$8`%9`&hm"-m"lX"CI"Gc!26)A$`)R
-!AS[VB#ki$Tl``!3`'`i!YS1rB$jF!D`%Km!GX"8H!HF#-q&*CTq3!1)pH!5'`MR
-J"Q!4q!9rJRI"cq"3F#a`$Ni"0i0$`22J+A!4Z!Qm#li"*i'l`IRJ#Dk$4l4ZQZH
--fDr8er+eM4lEhY@@,cp"blA5Q''dU[6+a4DhI2hfL5ZKQe6Sq`$+p@3HTQ%M2lD
-PRI2mC+5Vqdc`!MB`#9ma'jM3,pBP*ac1Mq2db9E@S'lYcXI(3#&HZfJHkGZ10%T
-Nmc4Sj*GkPE)@"Z)@@"d&iPYHak1DU(V+hmV-Upe#,@DR`*B`9madLM`D$T0CQ5+
-hZ3*1b6FEl+`QqEIT&'UXM00X#AZhm6RMqiNA*VG#PQ[6!I3F%6-+DjKNrdj"H42
-KSFqq"PbLaliE9T6U!'EdZ!`HQHBQh,T@--jf13f&iG(fSc89'0KqCf!3aJahY3b
-8(TDr1pM[YeRmSlGQAG0$J`[ak#[kl02[rpPZ%[dhqS)mHTZf9mkm!*!!cQ-'`*!
-!@(Rdp1N4mZJ[@cj0,jPH*Bpj"rTX2(V)p-ji2iDNEmIl0dMUK2554rTUk1MadEG
-$4bm926VkI[32dG&A*2rSk*25Sd0(rj8q+6TkS[3FdG%(TBH)MTiT[84dc$I33d4
-($jeidG%6TiH)MPc50d6(c!Ip8R6hiSHH)lTIi)FH,H9*,ZQISL-Ap(l4d8HP$iZ
-1hU-L6**SS00K5IBJkCHLSip*cY(4lk3[LJlQTVh'*(X+p&(48D2dQ0(4rkI(M)j
-FdS0'ap`*r@"dc,'3!"0dpq'([LfkAq1(qJ*H`!M`""ee52mA(IQP$ic1pRl4d5Z
-L0ib1ALVpB(6dR1NKSk2[M%pdB!apCR6-M5KV66&RfYp2FBl%ah9[(QGDk*qMqeI
-mk0"3$A'0IM3kkTEk3NHq`!Gdp(VT%k-$KHNES`-RX%9(rjNH1$TQBV6h9F0C'2V
-Mk-!rq[VSQ+fJGik113GkrZLB(G(qG3ea!KU!lTHN!lk1)8M$"Y#"PBB9L!jXJK5
-J!`ZB*8"(AF%0d*&(`a&%4jrE%!M4dBG'Mikj"2V8k*MhSFq0MPa5QqM!#@B1d)(
-Ip-(4-Dm$Ad!(CS0,PNS`Qi!1(+FrMSimd6G(4jdcji#12&&Ik-J&q8%((Y"64dG
-RJMN%G1!Ch!3GH)BIG-`6-Gq!MPN@jL,3-@F$6U*MYNLE1@RLK(,%02E5QlN)G,r
-"MmjbCXKKG*!!180ZS#3h3mb&,k!$"jP43!IZ`*A38I2D--b`CTKG3%IZ`""da+P
-GP`cR4-"`G-a)JB(Sb$'fk*MAS@E4-DZM(CS-jfQB,8&(MZ%[k*K"Bai&(68+Gd2
-h(rKK2N9HP[b0149di$IeKBiFqaYKh6F[#4`2eZ@lAPjcHbUl[U[GE&rIfGq*hlQ
-pUAiKY+k84l2AhrdL5f6@Ka"dHQN(eDa2GfmTl(#+h0&bC"iMX!pMc*UH@$be80M
-$VEN9&c$RA0F+KHdMGA5Ya'A,H&qVf,9LjKq'f"Z2Q0D1Zqr[JMdqXp(6Ua0E54r
-pQ`3LT+Hc1[1P6)Pb3TK,lE!PP'19XApS(8EmBB1"GeH!K38,UPE`4[JZQcNc9mb
-NKi[LqJEA4%Bd+mi$TVKf'Sff00h`TeL10C!!@1LDQqN$fSHQE9JV48MId23,V@X
-DKUC4L!&XG!ehK9(0[q$$0I0Xa5#E-REJZIIBhJlIC+'ejTIfQ6FC(8FI-6UfV4h
-)QRdp*A@MQHIIp2BEeLKM%cB#62amf`dEp48'LQ%'1#Em[6#)j%KLc@22U!-($Sc
-,a*Q(YkTRRhef8Pk&HF0)rrl$KmrjH%5fjl6LUaLlqd(Hq*R2a#6%DCml)ZrJ3jH
-YN`!IIKHlBkkADiIGad`-ZqXUdI`VBd8IHVLIf'TV$rIJS2(Ck[eb1iVm'lBDkJ0
-Ce&IYqZdVE,8DFlXqHRejU1DU+jDUA6'ZeA'XcGqkq,Vb2qL[2HiZ2f[VCRA09Z1
-`A)2HRHhf-APT*hpTipR*AkEPE010#6!lqFYNTChmCD1@lHqcjFT1r[i88[ZIM'l
-BbGm%*epemMI"6V01rLBiCDK6'@Dk9LGr%p`dTT1r#@kSdXRI"+IBG2)h`HeNG[,
-h[r#MNlp*jPJRIj1FAYA*hb3R-RAb0mP*3Chm6A)56LGrcI5V6[iQZ3&,*hq6h'U
-QNlp*l&QdNlmTeSC1rUBirD'6[bP1,qVNEiVp6Thm6A'#8#Gr8j`-eFRI&,HHkH4
-[LYZcG2)ha8ea1[QEiJ5LNZXDeV"1rYB`,cVj@m1DeXRI'MCIGI+hKK101[PV*P*
-emVH'FH[NE`dhGZRNE`fhGZRNEmhAmD16[l@X@jhmV@A-1[PEbdPFRIbYjD5T6[l
-@XQZYNlqeh!URNlqeh25QNlqeh##QNlqeh*bQNlqe,q"(*hr6a"'Gr%fc(R6bedb
-*kZ4[QTeRR@*)XljemMI0+8QGr%ec@je1rUBjUDf6[fPZAY2*hc4cS*1rCJ*8*hr
-6[%T-*hmca#DGr-f`$R6b0m2iGI)h`rV6,S#Ck06*h``R,(AbedaZkZ4[KY[BG2)
-h`iP8RIc0X#qRNlqCV`P@!lpJJ%lqCSN"1[QECGhUj'q@HGI*hbcrGI)hbbPBRIc
-0%[pdmMI,cA`kqCXPrZRNEjEiTj1rfHIaSj1rGF4iRIbY)bEUj'mGke`RIqZB#jh
-mVH1NV%lqeR&b9#GrkaLh6[l@F@T94ilUZ192*hrVL%-kq9Y2,U'6[rA%4*hmV@H
-qGI+hR[(Vj'mp*fYemVHHf`TemVHH,&mRIqZCBjhmV@p1rYCr$cmkqGY!2U#6[`h
-%1jhmE@$0ki4'!r1SNlm0R-69bGm'EMl8b9rfYGV*h`ELM8lq0Tc&Mdlq0T+ck44
-1)q2@bGp'BV&1rMB5&h6bYj'jeXRI4Q+-pYXEZEG(*hmE'EG1rMCb3k01rMCb`k0
-1rMCq!cmkq6Z#I%`RIdH3!&ISj1m)BU91rSiJAX!Td*%l0N1LSkDC8NE(TN$`(af
-E!*NN4mH8-CXPjBdN0i2hSD1fQ1T("fkaF4)GY3H'Sm-AYBb1$BCXS%6(T$qE*p(
-GJamQeH8eNG1bU3%G(!cX43G2S%E3JB28+6VUM4bLBe-P'b[4XH%326Sf'V,"%Ke
-6i@bbP$H+I*+0PZMJ5r!GG1!lR!XG'!5R4NHG-*f1$Pl#GJ"dE!0Jmb8klRaMdPi
-HTcDCMBhS`(if,D+METJ!4dHXa))1V'6M)cT`!Dk"MRU!Ak0M#`GeK)lYL0S"'me
-0S'b%42FVr-!,j)dKhmBR1MJC@`c3`FHBVNF(pS2Rk-JhQb24N31`#"fe"$kJ``B
-qL!lXCjX!1MJ(facNM5ARCY-N1R*22D+$Zm+GdF(CG!rb@2)6qKAS`'+fIk)$,pM
-FLBlDJ!1L!crJAqMBD-(@6(R0l*A3Id!(2kFfdGPYNZM!BcCpS)0,X#N$(AM(GP9
-de$CF!adaJ-2Sk*d3Zlb0b+[BRS!1h'AV+6Si*02lk1!ce!Jkm"SHJ3jFB2XS1[*
-#I`BGI3Xf5XJc,4%i2MU`N!$Y+ZMJVq!c1R!GI%-(4k)AJ3iFeeQ4FF310JLJ)ip
-X0N%(lS)EmMCQ2iKH$6TU&'k&$Ki,ld"(I1#EJqM&"aH`-E`e2%[!blLia@CafF)
-&%-GlPVGEC6D,DS%GALpJ$9ZaZEbecrEGZSI$-,`JA'QqAkh@@h@#C)(k`faI0'+
-C8k)jC(!lP!ZG`3V#hE(S0R4HEaA6a5q`#ME#p2+pfB%Y55a[hT(D16Jp`r`IQHU
-V9h'!a8QKfAkEmVeQUZ&&8V3$G4+3!)CZNl6Me!%ZAUi3(L1a`#kDHMiMGje"P'J
-[5R)dc,&MV9#LQcf6(8Qr9"i29LTJS9-)lb#3!(K&'k9UcQE4STcVfDmN`-EDZXc
-%`3EQXJ*[BYZlc)pX0hA+J8N9IX4P,P08JEJa9@#ZbM!D[jiNKU"`CPV,EhG@V#V
-HP'UBDCQ*ZV9KE3bRR6[i6UaDHbXee`Y-k,ee9VRXZP8NFf'0Z1%IeB'P+29'$E4
-b#)DRMm6`YU5b'cC-a#!RCN6U1'DlkRjD!kjD8Aej(kC!`Vb)hX[N0NqUE@C8UCP
-"'dC[M1HPJ5a"*4`hAJQq(5Jc)jd1YIR+bYPEE3(*a+))$@+LqJ,HGB5[[U+)3rH
-NTAKTJkd68bDqmAE6QI#YJS!LZ-UG35)PThi-l&'-2QBZ$kqpH[d3b*,a$cF3FiP
-haa1d$FL'U(1f2KK!@N*rIT%%,XJ2Pjp%,N!p[&SX*eX"23"(Bd1,Q(JdD6@`9dJ
-B%4D0L`84N!!#Je3q*KIa18qVr("%)HHb,,6pJZI8!Pd3S8%ZjXL,$65d-INiGFC
-6P+@mTDQZNNQ"em$XTRH$Yq9Z1SQaGhUhCJ8Ri)+,a@8lk3Ie3CqFle6i2c$GYG1
-Z"U(H"(4)[K-kSk#ilF8Ti3NXUSX1jbQF*j1r5DC`L%cqqTMij*M5C55&%h[bam$
-NcL5*,hq*,QXTRG-5CY3HcK*Gba+Ib",IaG*qN!"4G'T8kELSm*bSiK&"hSAl2FV
-RHS6AH951m9$1,V'GX-iYlYEFhIhpp2l)M"a6@eKM,9VYc[Z(5XK3d8Srp+EV@Rk
-BYkK[qD'Iha$jX51**6r-(ME1q['DITK&(0Q+KaQLdE0q,QVk-4G&2*K(jKLI14G
-hU'#QCZq@(fBHRphb``cNl-K2ac)A[Fdb2CI(8-(Xj'9ArH3+`!bFPUG30eJ4r*M
-RLVRdSDm#)*[f'KRQc(+q(&#E5A6dd@iQiHR'Kf!cbC2E4b+pIB1E5BVqUh'[bdq
-8Mbkr$m8p[*eP4Gfi!qT[R4rhJHbV`ICDlF33Ebc@l0)'*m6pA3k!Plff&G1YmU4
-h-Q*U,V2dbKH"Xi[&`A!4H2'jRcSA%fq6M6$K6V@qcS8EJ$dAp#Xk&i2GKZ,r1[E
-FVZq+HcMIrjF2pd(FkrDCpG9NPlrU,VCL21f[&)GEEJ1SZ6a(pRrPjUALYPD`09h
-mX&IZ`*BIGMd0c(2TlZaM@hl-*50GFh1K(hE8lGIb`rcDISejLmkj0,&L4pUc@Rk
-BAfZ)$r$MMVRL5SBJ4jhEPl(Q4HFPZJ'D0bZ2$$#Y)VI!!`JDql*C@BhR[h4hhm$
-i9@L*"G&+(*PXRGQElS,2C[P2bRp+rQZDRT0YjeESj"c@bRm8DQV4j)SGQ4G9*aR
-jVq-r0dcUIk2B@6p0mMpDl%Ia(hcRR`XUq4Iifd,daTri-I(*Ie-c'69K$bqhTb+
-AZK(L2G2dPPNiX5G(dUS4Q65,VaD*I),%B$-h9M,8dSbPIJPM#GIRq-Y[0!(3+Id
-IM`@A6V1$)DA$EMI+r'mU!Rl5FGU#8q"5-$EGTX,q-IH'X[-l)8Y+(@q22S3"%2"
-JfK!hV5`Sa,B"!m48jiqj)d6`i$3V[Jd,#RK3bd[5p1EVHI8DYmj0Ncf!,M@!X(J
-JI*%E%)Yi%23&h@Q)%1)"ppF)(Z5QdZB&f,NkhbZ1GebRKAXQTkecUR&Qk'$aJ*Z
-Q9q'"q9YFUEM9eERk)0VTVEh93VPHM!NM%5%HC+lKJE"+*aNBj2%JUrZ,,*@H(m5
-hY4K$2+M6H$!YihSfPq%Z0@p0hTkm,@i0'8)mU1HN8QRKXR2ejHpHF,)mCpb-)T2
-FmLXh%KYeprjLmF1G(J2lPF82HiklpN3%`BNIpN3mUq@(IF2Gqjp$2a`YdVhA1I6
-$(6VGqjT$2qc2f(3f(VfAa[KKImE!2JkaBRp'erlXb!rhPR6YiilmF"Y5ejlYb!p
-h)hAYG5ljbHh2H'#8hL'r0pN*fdZ-VmPaXcaRA#r4%E,Aei&`8k[Bd)a,d9BNCjb
-0J15Ze64NKJN3f33j%T*6[TVPkJSAa8fd5E@`l5Vp(ar@`["M05a,`G`!FFc*T1A
-'ZjjA1'QTmZENdR,lhA!F4kENYVbRmhTS[Qmf`M9a(0DeT6mj@&)&hqp3aRIfU88
-E)b6-(JjemBe2&K$Hm,&3PmL2KVHjQ6Mk6m5*ci2UI(iFcj!!@`Ar%-F$#ANiMJI
-@42mqMK@"$-9adUkD'RPLVklADdqAaVkpeU#q'HHD0Hjq,$bfUJ@%*0XGhY'A'$R
-H"[[VM*%6@if$E`Y[-c4ak09mMqI$R"K2(!q84q%5V0km,X'G4Sk!114-VbIbbJ*
-@'dFI%Jh&dGmPT9bVcm5a9*8ZiE6Hef@!fTS@FCVMZkUaPJld@[lNIM1pDr$r(rc
-M$0q,!6JXL6M-f9,pVh"R@19a`*3E)!kH1A,YLFHD6'AFiFe2KHIqB0cPkfMe2F+
-iHq*`"M$Z3pCYP#XqHelKkV6+Fh``pqkX2X,F"q*BaG`(iPM&h&I'm6[QASfMbYa
-jbY`6qjGXM3&JlThjH)bjpb4f$A1[aV'+ZAH'm5KcVmE4cp`PMJ(blM2hNiEqYqk
-G(ibEfq3Ula('h4d(ca(!Z)pdUVHpepbeDZ8Xikll%@151&BJ`d1-D5#198aRC4b
-rBcV91"j#mXii(NAbDKcpS#Ga50f[C1EQ9X$H&hBNHLY%iPJm+,I*GMbjZ'iJMVV
--$kB`XjP-5Ll6IIVp&[(N0$iUF@8F#kp`4BQ$+qjcpr&e9[5*YPb$1jcABFi3F1P
-q6Mi84a8jqqXXU)mc,jICEep$H1K*,mD-$,Z2mkZI49HTZ`[9rR*GU,Z('pe(*d!
-FE@AI9i!B!C!!lMJ%kmQVGkP2EVU'6S"mQ'kI%b!1fqhVLf1SfhGb8#QVBlKEK$L
-@iEEBa)H0Tk%IGhH(-AbUTJiE4ljir0KHip$l##Cb'h96&IB[0BjmBEdar&aiLkb
-*ia4@88mq"ZY-Zb`,DKIVP4D,!D,H1,K8aZ0"0m0eElSX6S"k09d@*d!F2"r1j!E
-V*r*UiT!!m["qA"m(Ze@jalNVJA-bZ4L!V3"XdUp5$fpar-6N3e[frSZp+IrC'ZY
-lKX-i!H+BYGhEPS4m-Uq`8RI&c',IDqG#aCIM3NrA4ii,29f[lS"C-F1&K[%$"$l
-DUIe`!QF`Vqk*cM921G96H69ap0m304K(GF6,HfImfiaAhaYL1QkP'DrKjeLDm9T
-5Zma1UhPe%8ajbkcBm(1!c)Te!XLMXf,G51d+Q"@,,PHZ[%cm"(0h9$"6*`"bZK@
-3!'V`$Hc*FhrdG"`ZQh,kRS1J&q-'fT3cr"a,Qh+'HM%GJ6J*0ZkXH,TaCm9cEfh
-FUBlrHfea&I2rUaLFHf12`%2-Uc11ajKA6d,@-+pU(-k*r3K$c+XM%,I!RJ8r$R1
-*A[FM#,PZa#F&[AlF!)c!a1'8f2Z`!BjbJeaZALREQ&GbbFfRe-E1cDHNiqAQ'EQ
-"I81)B9l*FBB(DqH9A'4JN!$(!kIqcF6qCPmhkjf6FYlN[**GMQZjFC,RMVYcNYP
-90mfVKCLIG#rG64RF4ZNC@!q*j+b3!+01aL$N*X()9CI%#NI"F[-jAejcHbUl[U[
-GE&rIfGq*hlQpUIlfH*8##2Sk[EH@1%qIR-rQL,f&A4j(RR-G,IrCakXIqS45Gpi
-eib3GaiB,j5Hp,KG-pmJ-5SeTF-I@jDN0'I44Y[Y4#1*iYQi*0Kb2"fJ%KSdq6`d
-B`mD#a!HR2+5q`MqUeaP3`6)KP(q*m#Tmempc1e`"(C5a!q%Fk0c4e!ZXXV2RbL&
-YICAbC,NF&k$VZD"U"@q%EmM3@-d#@N-DX,4d5ke@Q+3"f&Q89`4f-66q+km4%Xj
-I"pN!#CK6NM!mU$ilbRMd"*+3!1k&k3rLRhreTM!Ac12#Y9QGGh450M8Rqmh0H21
-@pTNh'4e((c%kYUdGb*Tp259eSjRRhr6f'pBSBp-*TAlkmfdhE&4$jN"@!iFI9p,
-X15UD@a0V(RZ')k&',Iq*-`p[RG!(XUL[f[AEYqGd)1CfII6kmP$099FX9EYLA+[
-M@*ZrGI&ejAr3Ah[FAAl@eXhUQZf*`jPfVIQKiBAIjQ9l(Z"[j3V-Rlm8kK)2(6c
-%I`I6$8Sll9NlFIY[N[VS@R06[rkej[2p(5EXrAUpEc4X0lV!VM8[ih6P@[-#6V[
-0Vc9h)M"h0p!PMhh-hID0h3(-h5eeVIP`h@r3-PaVIYfbTp"9kZj#YEpF&qVU3ih
-ZSa-JM[+ejZ8i+PGT&lTLTQ[S"-L(kIBj!H))VMA[M@1SffFZP*ip(&eVRTbIf!+
-pA'ZHA2b"%I9mBZAqPp-R%qESDEL8Dme(RBApja)VlpfA@(aI4b-1Fk&d6ci'kka
-mVANjMXUejS8ibYHDVmq(kE)i!HV9G&QF!((`mYHDVmqVL51qeRap("Z)0YHD1qB
-fF3ClJZjmHlKTf%'eLE-&+pTeVj2BhXTk6DkieiaIfm4Ca'NAr#E1TjLl#fN6TcI
-1h"0IIVSM"S#jZl3fF3l8r3BY`bE1Rhhb5f#Vrlea-0H&f[*SSr[S")MMm8fFaDk
-Bk4Sk!I*KZRe1J$KXYkm[MU&ZhmT0R([FHQ%6jal,cfrLl-R(B*dp[SQc'-IMQcL
-,FCJZLa1JANfAa3N3"frG*XjLANdFrl1*XaM("U,0*NkZH8f&IfQXKKN4(hF,YKa
-0HMrR0JdH6"ZbUlER&',EJ)($lX!$qDh4H(#D&Gq'"38mU-8Qjm4U2D!bVeiMejc
-@BeY&fr2Me!$#iS(`aF4j2*!!GXBCPZIB-@U)%1*"mM`HL0De4K&#2%KT2-KGFMd
-[X+T&bbYL3!+@F0lU6$jYTPD[FkTaCZ"Jm8$kcCRraJ2cYlK5FDZVFrA"XP-`HkZ
-&FVdB%dBU3cc)AX-$iC&1-M$)id'GlMHIJ2@Gmi2iYTCcL!Ie'JqQC9c2hS#&VN[
-0@j1h*fq,@d1'%!mDS+UPLGLBcHEQ-DALUIE(Gacq9D@'BJ*fF$LlhYL%aSF)&hC
-qI2ZZIU9+[a[VKJXEcAX&&`l3Z$#6BplZYYF+%LR3%12#&1,#r@0RAYqcl%4ldd%
-@-Y1id!CF1(aXl-@IMA&$"Aph!VM!lS6'rkY3l%j`b-h+Tf2RCZ9Aldj`Smh+Cf2
-RCZ9eGi*$EPDq2YbZiUCj5DcQ&D`dRr2P0EHRXZZlfXhfpChpRILGfj[UEipA+3!
-R$!BiBTkJ3-)`hJ6#*,m$hX+G!DXTeZ#'EQ&Za*p*k#`)2ZA6NIKd``qKelAm-1'
-HEIPK3m+@$6r*D$"HhN902fRmMSRma2%NQRkBP*h8m*1DM#H+QkdZHmlk#B)c%lH
-H@Yhbdi6II9TqU1*p@hl'i(Gf9$mG&5pqaZ)h29GRSCpQr#kJZCN-kiHE`%m9`0c
-lIS5G$9`2jMapE4Xb!,pVmNkP9VEl#c%!Ya!j1*icES1*-ki(lXCj'dQleKdh0b,
-AQ)Nm6EB),JThK(R+PHea5f3mj(6C2RQ'S-BPm[pbq9mQrjI+rp*`eX&6J@bj28[
-XcTErFb6HFd9rRX6l)SRra4,[q4,r"I,r%[&hB6M$`HNp[[iLmAmaTNKj,`[MGKA
--a)b3!(mL`K'C*&Sb4PE)"&NN%r@3!%b(8!dMBcC3JDcC8L$6C*K-GfACVhHh`U1
-k(4KPY!qHZAE1E(bHNHlH8YMK&(1HZhec2VcQkQJNFI,&!'T3EAhfak!5Zqee#q6
-ifCQHB0C*r*JD$[bNAjYe%MpEi(I'V*mJ12(6JYrp@hiQi(GQ`dpQdXp&66rFTTQ
-Ef5VN-I5c*Ai(CTh%cb6L9hA@5IaX4Dald!pE0EYRf8)rfq"hB-E+qYN!4*LamRN
-K2"mH#GH(L0K0j&(h`qr(Z"GH8LeXZhTZj2MiVQXM6fMFDcdV1R-YHcM8Y9mEQAM
-`Bk%ZN4mGjVq$kGV)@jp!2jCk[ICdDHcED`hUQlq)[Y*jMi@1@X!hXYhKlGf*NH0
-YX,r1'$Qae6MiYYXEFEL6VShXRj@91!B1KG3V)8qqK00k*D3"DQYDa'RheT@3!-U
-iHmDZh4q-f`&dXl9MJEQlJ@kfAXAF%rZAE)d"B1lZRjZYh3+h9JrA[32NeZT6Ar2
-ak+h9RA(`(!'-ZhUBDeeFa9fZcSPl@Yd6GkFk!Hj&03MMP,M2Y#lcqYAArXYQ-UQ
-HDr$ArAk,H'fk%PI'XI!+9j3i&PUqcchP5l#DYTMFS+*2Y,I&"14eQ$-%A,UIN`r
-&88A1rMS,kZ2-(ab9r1"Vf'MYY#jKc-L`qcLrqPPdPEUl81d[ei@kHlM4IA3#a0&
-@pRd&L"%!kBj$X*kmHTIkj+CVk!6)KqRf13(LX0fq[ML'ZRdR"j@b1SDpYX5aE!6
-@bibRS4phGiFaI+UQEMD1Y+mkYYFip$k#b5CBNVJ)pLmeMPcrCmE`Fr#RFCc#+ZV
-*af#GDCGP3HeL[G*P-8$8'mI4[6P6*IGFMQ-`(kE,iJ5S9p0PF3,%`I2Kc2ZI[*S
-iT$bm(pI(`@jepJ4pkh"1*KF$X"Z1#fQUe-0E($maqG#@[IpLEmTrYXEkRZ%`6S!
-iCQhhYL8KRm`VV04aFL'pi8*2edH1#ceGVqk!MV2K3X2i!3)IlG4q1)%cQ&Ih41H
-DTjcUUEbD11"8`r8aX&PcXrLh'Dqq0m4dh%ScAX22X66M0A54I%FJMS*CXH(R!*N
-9k`53!%GRaEU4fK8`+qBcpcQf0c6E&-h%6c"h4`8cG3)JTeX"U3CIG9'1!k5Rih$
-CP02h(!5p'$I3TTcKjeMDP$28LqN)a%A3LhR!KflF@I(F@aYhUZ2rAPYFaIcr+JE
-RhYJMm"$ckScM-HE9Nj!!0FbV'SGcBMr#%22U#-3YX'I"Mq1Nbh9'%(+ePNm+H[f
-i!4L"LF-TXII"RED*mp"`Hk0jfCl``Z$+K2r2A`TeLBF1(Z+rJkQrZ01HY40lRC,
-8fle1YY'NQcMRqcY-f2[eHYpSH+q"@fS6jqrlJZ%QcM*19cCa&R$DEEk*diR!h0e
-!8pTpc0eH1Z%1B1l1SdfF$qr3PZRUiEVIS'ABa(RGXUI39HVZ3V@rA"IUkN10lU-
-6))lb*Xjb(*@0Ji@ZQ1ND1J(bBETp6S!iJNfF[A%-GI[-pVRC`p%QcZ6ma"ESC40
-RF[%(4Y6cLCAlAdkI6*LMTq&50R'11J[lcb9@hVX[XILqMNBFC[YF6ci'kkbmLE-
-F4f86Cb'1mLE1pIN`A4BR3,fD,SX6)!jHIK2RqVbD11*0R1[Mf%#dfF5j)Cp`#rH
-'X`CcmTrm)b)!&D@,"NrG-aAKj-%2"d94Z!%a,@'m+4(q$RKM6&LIH1b,b9f"#dk
-CZJpVG81"!5FEql,CrJQMG(II`2KQL-5#rN,Cc*IX-YH`e@lS6AI"Cl2m*q8r*Im
-EbAp0-i*N@mB0A-mYFprjmClPlDD41V)"45'R&Q'0KZpU3EJQBk3ibFKr(IrPDT!
-!"[P[&$[VTdRq4i[p+2kRP$,j,i"Pr03Up5l4'hrLam3Rrdh0C05mPIQAC4b,kei
-Kc)C0h3MaRQPkbbbNYebDda+45E2iDT()*dJ-0R0M*8-Yc9MUPc!@pYmY+&L"Jle
-VE@k4LaK0!X6CT[)r2R5hlr`(YRpeV2Nb(rh)hJPplRhMdI$pkY'A%+@8p5DUiJI
-6Qi!1ack3!%ED&EE[6Ii'DJ+l4G0!-SA'BVGJbQlqH"`5AqSVNGeHf!q6fD[MLqb
-f4ha*fNPmN9eQ+8YLLBHV+*+RILC#mZ44r'bPl@lNVLSP*-Nl)hml$""9e1jfr,a
-@flhbMeMJ#MVXNCqPlIEi$d+GEeIl([cXUHf1iFDqY16lD2b-d(C04-q-YXYbrmR
-1fZjbVZ(+LYh98AcArLPdGGTZ&[c9L0dPIm@FDI8IKCpQEEIT%ZJD*'kfTilAGTr
-k!Y(EYb1Ac8HehHXBm`LT'mPIBVkfHpi[%8be$VKrIa0YGrJ+k*SN[Vq+kZEMRi0
-1Z9k+G6C5fhhLYk!EVHff42dQVY0fRrp0')b4ZZ(qJVfeh3cQEkc%mCNSMLrakQe
-Xj@hp!Z,iYVElm+-`f%Mmh4c9`3FBhcM*(pXP08rM2J(GaYTZUc[`Fj1fDlL21IE
-YGX)DRB6Nqb2%J%dP6papm&jYGmrGV#fYearKCdGYPrKRk$E6G[X#Nj+,Y&e,(``
-fehCrJEM6B[I[a*3YY0d0L'rUEfLl,Ai0"Ld5(e[6@LZ"6h`0@HPT`-[-@bT"Z28
-bY,ZH1GZc%T6G+EXd,b!C"ArJEQKAfm6,(l2@*dKpIc(#bpeZB3l8EPRNliS[3cG
-4q-rj%9lHpK3,A[hp,-+c4Gq($Nb'!S#rLTI0cc"@c3HiShKjbd%@[1B[a-XV(S&
-Z'l%,mI*@BXDffZijU'H,PrGb,G0Nm8Hp+NkFqehSYY0fGF3MaFXErKUk2p*f2m@
-raFYhXYCdbp61pdGiH3jh+i(ra-'riXIC"k#MGX!KI'MGl2mpBSEL&VGP+-lpj'%
-#N!"[Ya[`hH,PkmmbB)d2EU&iqElIJfiA`BQT84bh%brK@I*frfL%Paka!6r%38e
-S(Ga'E+,fi3(JZ-8$X'!hEEFrm9(amYej"UCf8VX@,hrmac$B3h!DI&5mI-[2XpC
-pZdRNMiUAep2AAYVZi$q*m2+H,!bQDEX2246KjD*[`Z#C'PCffK6Kj9KLbGk5ekm
-em6*X1Vd(H*PH+hJCfNhk+QY,m6+dUqpXiQ9SPb3Ae2VBrTqJ)lFNK![0&5p[)(i
-r@qS*(UMqM[Ppk2E4GJF3Ha3[AdFmjY3%m[I,#-qqM0alc!2Pr-N),bGq#$VG8TY
-q1F,,CBHKdjeL+I!NLjI[C!jeLf`0HBA'pmeICJ(lGQFp(Z(PjX4[hGCB`reXLK-
-IC'`(50h!Ka3[ac#[HQ(0Eh$+NFA,HmPh$p*fCqk-m2)meX3XLB1m+RkdSFrJbDl
-U1YlLSA9c0R&&Y`42BRdVcPe'VMP(fme%2m$LjAXq6N"4RJ'1+&lH3Li1YP#UB*l
-'F59jJlC6cJ-f@l`m&4M[rB,%)IQcGA$H%p$"kFJ(q+ej1T2B!$E+Hr&SK*GI)Cr
-@cYRji#X@,rFL[k(R)1m#e*r&brQmK!Pq5YbA4hLj'E$FfkcY,[jdK*HhN!!(d!H
-3!0$'`*r&bdq6-p2I%,[Mrb(#bldr"3YUJIMJm4B[YII"Zq38-8ha-V5E62iNZ'M
-`-V5EmYY0[!cY%Z4G@KpI*aBFSqfQlS[`FL5aj(Q#Cq4&rEf@(1PBEAFJDe(amNc
-f4DJTD!Xmaq)@r2)ib3IeV(MjpSp!TbG26#%R8lbmmPqJdk-NNYb-U(JjJALJHqj
-f24R&G`(jVZl4H`RU`Z,PYY`CU(HNl%jX9TbiLaLR+p&hB5p%mA*2FJ2r(T(%JiK
-ch%PYp`2bB0ek[`ciB[(bApK$d6f*Zab*m2)UaUTpY'fIM1VQr(q(6[IVlI,R%Fl
-Gq#hSp$D65i%,&LrI$-cfT(qhbpp&H(N-Hc'keh8+qciDadI*DE@[GcNiSXA,,l"
-R!#lJljUS$Pj0,0I0Nj1"3cC2Ql''kDA)qqJR)lcFQER`qib*Gc`BiH@9a!Pr(f,
-L*qP2mI)XpR4drH%8FJM&bbq`$[apMSQI!TjD[2aRFMl`A1`f*bp8ZaELk$RDlTq
-3!#q,PdHa"hHZMQp2pKZH,hLT28(mI3fkG%R`-QIRhFJq`[D#Pk(G92C&,&k'FA`
-)IC2kHb["d&5r-l%8pCCm6kAQ`epSPpcj)ZRTh,3IJ!H$+l56i8p`-Zfc4R(mL*c
-eHX40(HAk3)QELAG[&lZ3!1rZbVl1C,(,iAVL1H,0Zm3ZbLXmd+qR6)EF5eF-Em[
-HJeqAfAGpL36*YkYP[ka'qlZ2r3ELKGi+Rr-'YGfpj!4`9H+$4fPm&j,,JS(82Id
-Q2ll-hj!!keiSI!*FpZ2,[T1p*rSHd&*mDhc[B%q%(L$a`4-d[P1*6aGVZeRX,fK
-mhb'hJq06#0+hX2Rl'$%GAL2[&Gq*iVZ&ZAQja!Fqq2&PhmcBk+H"+pKTI@c&HVT
-8ffAB4p(ir[-[SB1r8-,JSmEhFr+$2pATZ)Gp)SY2fTXfGY+I#2SISGdrXPGNkcj
-RjkeN6"DI3VZYLI'#"`E23VZTl-Rjr#CPNG2#@b@qM`1(Y"q3!2S`Bi+,LGdGb)2
-LEZS@FP6iR5$2424&,1kqLM(5ba9r@j%h+aqkRG`1lNcF`P19$k8kL,9AL"fFaZF
-CUAh%2rScf0&h84jc"hYYVp(aEBfHJI+Ke##j0eaEhPcb2jm2TEDb"`D2!aITR@X
-F[f'[aEpP+,%-26cP3kNKFNYi-IlS4fZqPj!!%`Z[iE84Mj5[I*JFlidkMQF!!j4
-ITJjm$4C[d[kbl2[iH*!!r![f5Um5QJeqqAL3!,VZDHMJ+I*QN!#Rq6`ie80FHE2
-%$ArbHA$UqVq&lLf5ThG&[1dDaJ3R`LlX%hq@24[i"A($LAhHPUT`YZ&YfZjQp&m
-XEl[c$iJa[Yefl(%UErXemB0H$ALFUi08NKK2ld[mh3*-9Gk@1M!'#f)"RqKhq2f
-$e"TL$AQM[Z%EQUIVf0Z&KmUlJEALp`p5Gl*R4km'f+([S$cq%q6(j%IHAUceZ49
-rTPrHaYkBY3YjdJcb#@XAmU%Cj%R@,X*Aq-3Sm$0iFGJ[1BKeq3Va&r+YV`,[Nfm
-*mq5GB$m-h"1lli'ATYkVl3jR(6#,3AcdjAdmp[DcEQl5rZj#Mp$'m5PL#Id"-6N
-F[-A'F41j2MJ2G)#A'XHh'$FF42`GaIk6aV'-'%'HaH4Sp%jX(*Ha[mZX#R8$TQS
-Fah%@jF[Dhl(NVaV("iMTp0l&j$Md0@dFLmJ4QHqJRUKEMH-ZcP[FS[fG!1bhFAb
-5I46U9%a13Rr)a['AV%Z`MT+N"kpa[)#B"3q5GaCaH93&&bcNDT+kq5(lFpqY@00
-A4L4,i*F*h6FDrB[Xh6"V)bDh%BF1dhBhXdp*he,XrS(qrdcEIB+FQhk,a,%!r#(
-4TZfH5rb',i[G+F!e'pq,L%0Ieh(mL,@LmHh$rJ5F92bG5VmDhlICXb!@X9X)EQ(
-M1i+e4"p'l%k$$a[I%HaYI8[E,5+IdrMZCKm&2S8GGD2aEF)krSkf@`aqCH-E5kb
-P"X9Z#A$IaMH&f(5RYMZGpDEahI&ek1J*L0dCR!2aia[e6FkFI&rXT%pTicZBR*!
-![U[B,3AZf2MH5Nbm5pZGbEkiaVFAqhRd2F6Z,2D40Ap6f31'[f!Rm@KmSrk0R*!
-!2UIhr`#3!`d23Np"Ae4ME&0SC@aXFbkj"cIeFJ#3#!Fhph4`f3#3%([+!*!)rj!
-%68e3FN0A588"!+qqEm1bEl`a!*!&!H(X!*!'-DN!!"d(!*!'R,J'q)lh$M+bf4&
-qRH6jN5fHl$0TjG1ZGc2#0NZbMmPTpVDTQpkQAl3Lq`KhcI#F(TlGqXEa9rc-VY-
-k2lE0M*(EAZq4rB346MECjlQpcMbbcipY`RZf6h+EE-+IX+iME,mGfi4hAK*1pX$
-HMQ`l"e%XB,a!9'Q6[Y00MR[ENe#bb5Dr#5HE62D4iEk9Y`,36lXqVeJfd"cPjD"
-Ll[Gl&lE2KFFqqic*[HeCAYlLZE$YGel(ZLlZlII+LcIaHUphdBB0[(b[3EjAIJl
-X1MX[1bFjb'%6Vr0kXj'$TJ"B!'IP),04GVh(ciAGCXYa`VmMQh#bbH,&h3#-i$X
-!S$V2ldY492BmEar2bdhcFRI1p(*h[GhcAVk@Q1Ybq4a(qkf0KS+"BKb(8Hcha0(
-bS&4[a(T5[VDX&Y6&r,r#mikHkAR(#-qpcfT)IeGklU+VdKYE8l"`GI2EFmHFBQX
-dZV[dlTFQ5`jb2Lfh0VGrrZ`GfE5jDFpjBf2MBImePV-2U0FGq9jkZHHpDFaq1U4
-P@bhXbPVEhfrCmE93AA1E"03aZI!*e0(YeD1mr9p5L+V&8V3l4ahH01q!h-EmkXB
-j5k,bcXhp1,GjRfRHG0*`JqIp[0#FSY,)P$+S`"N*,rSG+ZL+h!fj,IP(YPC3N!#
-E)Xm9XZ&pb&V1QmVrU+9(rkpS3X"S&9i*(kqrTDS1[U2jYlSRjr@12dprMq*rMV$
-,V9i%HaArH@'rP@EFITrK[e2BAr%[$+6X2I1%$A#B,qaB$JF)1j2$!Q'2jE"3f08
-F$K6f*Y80f1pb@#6X5a`1%[DI("D,"-Ra`F,ZcZ%3B5Ga1&6B"4`1%rC8$NZ%[B4
-$Pl"I8lf!IC4$Yl#rj0$MX&DVM9jKbcMd#EX[KhjKCh!Jrf!r`i&l`*l&B9$B+cN
--#IY0$XZ&r5'(B@&rcf&%0%`0M`SM,f2#U'Pi"H`d$SF,JlU3!,YJ[(ZP-0ip,Zb
-p($4['1ac(+JGX(rJF!q(cE'k28)BEcj5f$%FY+)ff)-ih&-BR(B[B5MYH`[l&I%
-2f,Xir)5`6h&B*Ha[1Gc(BHh')p38'2A!Hm')q8PKQcM!,@$8Yq&-M6f*`fTKeh"
-B)qaA1D`9pRi1a`NM"qZ%ICR$mF,qQF-*$XXE0jdSM$Ui[c$H$mq!8Am2%2C)$ZZ
-&2Cf$m(,Hq1CNB@rNX%(Blh$B+1b21$a3f0q)Uk&I11"8BA!!q3HMERNl'(QR(X%
-iRbi-h`KH!S2r(LcX&cM!b@$`heR#i$rY,4RXDa`HiV"1irL(#S-6caC'RIqd-(+
-a@GK@$Jm6pN`1j`MMhHF+qh81j`Rl!`i2&`B22F*KFde,R#m-6U6H`FJhY3E'qp%
-bB*Gb)1GJcqG`S6#YNA*9BH4B*0jFUr[(#2Yh$[#frZDC(VKB'(a(2X'SHG&[mbb
-2D"Q`bcJm6YM,1$aHf$XiA#)-[L%rB&rPm!5(c6I0*ZTZ[VhlLF,JBMJ0$&li1@(
-NQ[H#`6'L31HMCA2R#H2Ge$[Blh0iQV!rim#GB0rNJ1l6h`'Qaki3KUjiKM#iN[S
-&Jbr3&'$NlNTKe249`Yl*!Ii(q`+(j`Ml&`l2GGJ#dfES2M"U#am6$0jkRM"U$`i
-(ibjU'Hak$Lm3pM%1,a6f&aaHj,#&TQPI,!`0"[H#S41S%6"iN!!k"D2Hb#(B,h(
-i4@'r`3%Fl)XFIPRBIh"iZF-10$fTA8D$SCI31f$`1jS,$!j#8i04*km@KLkj9YM
-[FEK1f*pcH)h$lQ,Fm&TKF2rVK&%hVaI'@hN,'&cj"Q(`!PS$M(T!Ai1pK30e"2C
-"$R!Mf*pbH,1`Iq@!,Y$I)Y2Eh!Q'*RZV-26Bfi6"rI!j'2PqZc"b!"H"88[`!aJ
-ak%%`Z2p'B@L1Gc[X)02Fla&'lUP(-,3VfKN-cBDH"81Ii&H!`F@r,3b1H*m`mSX
-'"2Xi"r3A'(VV!`jEE"i(rJ-B@ThD")-,U4F`h[SKBA$kKi94Cam44QfJ0F#)KiI
-"i#Ui5hm(QlBM$f$i#jm3KUlqT$"iN4S"3fqJ)m$J`8m,SjlaCm"iffH&iG1JmI9
-Rl*(2#d0R`-pJD$Mi$3bGL4F"KZC"Ni,"dAmX$,li%f(N&0i!qfX1H$Ak1p6m)l3
-9'2i&ZJ--(3krJD%K[b)-EB-Q!S-RU"%`Z!BI"ScD)*pJe#YFSEr$c)ILl@$`rGH
-&8DrF!iC@`fF!3rrmR6#i'lm&$1j!Hi*4!rmS$*hd$BFY-6m!(!a[j9[#d)AI&JE
-rrC-`p!pq!KKeJ`i#)jG`,"K[rMH(GGRld+&JF$aD!``[!1m,$)dU[QBAZXKCIPh
-`MA-fZq!!*Iq[Le`VqAp,mH#-A`HQr5!PrfmT[SD5rlF8RDcNrbe&MbRjIdZT45A
-rEbPmT16r,5AA5[jI0hkFN[rAM6qKj2peSe'8r,pZY,H5rpH0YP2brlVK-#ArVaX
-19I,rZUPR*Iq[KcFVqAmpq!&+rPm2[+,Nrr93kdVqA`mk@FRrkd(M+IPr2@J2*Iq
-["dj8m[pki!)PrkqAh#RjIlei2dVqAbqD3mRrkd8(+2Pr[@JGihq#D9j4m[pkd5G
-+rPm[[+,Nrr95fdVqAamj8[,rqUaZa2rV`d[526m@dpk(N[rAKeCAm[rkd)T+rPm
-IHNE*rqZ$6jAm[hlUA-RrkbFA5[jI2jTBbIrVakp4m[rki@-PrkrIkNEm[hjdQT,
-reipQ82,rqZ&(*Ip[J"T@m[m'M'2%raZ`A)Vr0i$[Sq6r$H![+2Pr!qKE*Ip[!(f
-Pj2m0S!H8r,pPF*!!mCE"G2dSqAr,L&IbrjEKCbRjIm[3CdVqhc,dQC,rYmab+Il
-I-UY,mImS95ArEj!!'PEbr`D0Bm6r'm628[,r"Leri[m0@Lf+rcH)KP6br`E4+NV
-qhj!!mBViId28YT,r0f3F,2lIN!$9Z[Kr3rJX5[lI%"k"N[mhC"`TrYq3!2'@q(r
-,i8FPrfmjYDVNrbh(me$brjEM54P2(NcV5#ArElPa[2Krbp'@5[lIFV50N[mh$#m
-VqAr$m)k5rcG-c5MjIm1FPIbrBE`L*Ip['%p(bImE0ViArfmBlDhNr`fM-jAm[f(
-dNT,r0f*j&Ip[a,KIr,m4ic$ardE)YC,r0i*18[,r4[#jP2br%E`B*Ip[""p"bIm
-E-6i6rfr%q%cm[e(dLC,r0fV[&[p[&-ib[3aJZMk9r,p4hUrNrihDZmAr'mAV8I,
-r4ZhGi[q0SSH9r,maY*D5rcH'(P$brmC-2iRr0dDZPIbr-I`q*Ip[$,p*bImEXhS
-5rfm-rDcNrkf`(N,areBBpiMrY`)18[,r9T!!4bArE`AHLC,rY`,r4FRr@f%e+[l
-I#[5UN[ph1$V0G0Vj@6jm4Uhl1Z%@)i("Rk*1QUHU'qGTeSP$ej'fF)f'$dqkAmP
-q54Y6EPpkXmbI`HHVPfKKBH$8rP*j89!F#Z+H(JQFk-[kc0V5&LMA*p@D9qYAe$F
-90)2CjLAA3l6V@mbYSPA,Ac2[`C-[ZrG4idTm"A`'2!@m#V+$6i%riIU5m$2)$Gi
-%rJ(H!Ti#IS2i$pk#Ve!K1Km,&aI2+,DALdN5*+fV3LQ*`RGQCiqrZ1eNTdV2h&-
-Ij,Tp6raCC(mbAK0!X9BTKe'V're[l!%G2m,r-2r,q4rJIaRrJrchm*rR(cqbPrp
-$q*r,rd,q&r!rTMBfbSd5T$aG@FV66%P5VT3Tj8Mj8XU8SpK!hS22N!#$*60PU9R
-"raMr9!%15*lr3Ik(q&r1riK9K[l[iEqArlRmBqaSAYaHL)jFSka("%@98#&NRbS
-Jqe3MP8"PL"(Q@IJJbC@@)2fr&+PK"B9`[rX[#S4)'-MR8QF#jblTk@bYaF&TS54
-ZT8JiUBCU@E49YDaG8*Je@mj*mFlS+qL8L)9GcqVY,)aV6NF!h5+ipEJXZ!3SGSS
-I&i@1%aa[ZP(S3X'Y`FR"@F#"31QMr((,F1e`dh!b825i$*3$lK21'Xi0VJiZ$+i
--MJe1#Ui*$JQZ%fSHJX!Ca*@%I&$[+(881Qi&cJ%CT"-'T`3h!&@2iNHj3c5SGP`
-lh%1RSR!3F"4`)h'JF+G`VL!Ph%GF0BJ-K`rR$5'*HiGVKd1(@iEEKXZ''iH$KeZ
-(#iJE#3(L!L)2B!HF90aA(&XF39a(FEK-jaTZ!Li#lJ'Z!@i"ML911FiVMLY1,T+
-&ML&F(K`Ah'!F@0`ih$PX1JJ9p`-(&MF,0pJT4T`Zh&L)$`FBT`rh$RF,p`UR#RF
-,G`P(#JF',R*GX6K@Z-8i3M!+EK!Z%!ie*)m,M@X'Td,i1&ELYNjp[-`(d2rY!IP
-d#A3@JRJim,[hY%02IFIbVHlTk8UP30[mVS9,5b[#)4YlFASIBVKT0`6e&qYPJZE
-hGRI,A*9U2D&hb6KhUIh4,Iep)d(C9%"q3@GA"kAIS[2"1VIUh+EcS6SICQINC[L
-LPLQ&U"l&8ERSGi@$F6%fLRF2QU0cqm5&V3F@"R69"B&a8BFZFGRSe(Q"cRI4Uh[
-YM*3A[%Ii`SR(YEh-mRY+N!"%Sh%TICh,j3'keEfbDq,@r%[YeN,k60ia%H612Yd
-jAqH$,VpmM-,-rTZNZ0X@SaDT3fU11U3'U6[H6Jl*'f9&59%a9!Z93T8i9dPjBE%
-FVT)RIHYhpUP*[CJH,[i2SCeG$f)[V"EVrhkqCE0Er,ViTP[(S$4G!L[9c5b&U&J
-p!Q-2I!*M*E`(qX-dSZ`H&h0GlZZjar-2EK[PJ+K'`(2ZZ$lkmR&MB`qV,5!NaMX
-5ja[lY-8cbkil[i$*G#[*'8q`j4h[#F#-aIAR@PBm!TmED9*iSHH'0(Cr2e+chS"
-2SI*&PRSpT(QKC@55PUaU&U2eabElpeZ$*M-6ZfSf5h3@BlNDeXAE0Tf+VKF%`pZ
-iD#i!ar["A0RlBMN&f1#Q+G(FF,Z"6mmbC[BYVim#c1Xef*HQ`aYMb1Sb1+J[V06
-+J@q'hQJbFQbY9P+hXIf)Xc+4U5DYeT@[ECXc0(h"Dr#T#8(C*&!1KrT0+FDVq5B
-b`ZF'H[PR2Nf#KiS%eh5hrB8)GFckl54)F@pU`N##@P)b'kcFS9AkC,b#TC(Qq`S
-G9IElJ3Lemd#B!m,m$qCq-%Z$H5(-r@$H"h-qQ$I#2"(QI+!NQ1["2!rQH$#rJlN
-Gc1YJ6JIc1CL4`6`1jR!`Id22*@'H!A--Q&r!h!,Q)6$[J,N&c#YJ6J(c%TL(`*`
-#jK-`Pi"j"-`KB2i!F`HB0m#F!HB,-&H!H3,BYm`2-(-9k"#LkiY1*,U$k,kLfiF
-q%$V(k2M#'D#ML#ibZVVSfU)VLbiLZV,SHU,VL+i[h'XN,Te&VUX)Bi)Z*,UBk#b
-M`icZ)VU9k&+LBiaj)F`*B6i)Fd'B0m)m%HD#k-B@8i,-)p(c4N`a``rdHfZKM'C
-Q[JGc2CMR`4`2jRF`Yi0j(FcT-2-jQ1@KZmlS#kFIR$j`jKm`pi"j"m`jB(i#ma'
-BFm"m!qBD-&q"IRCQ+0$,cR`$jKS`ci!j"X`[B'i"m`UB8m"m!ZB5-)q!136-(f$
-Z!2-B62mlR9p4&alGBR5)dBe("aaGI(54d6d@GI24FdhE$l1GQ1R%,#IQb6#lLCP
-0c(YK4K1cQHJqBbi6mjLB`m6m*GG($'R5kH@D9qNqSk10VLmklHJBS9-0+8AI#je
-rG0YKG*)re`j+4aVGE(6%dB9'4aNGINl-d5e(ee[D6JV0-Sq)186-(f,Z%21-Q&I
-%h#(Q#6&RL*Nec$0LcK#cH*Mp`c`KjXX`2iLj3F`,BNi3mi'B#m3m)1B!-Ip(cdA
-#M'9Z!2-#Q"2!I"AQUM"2K6NUc'GKrJTc9*LI`Y`8jVF`ii!C,F`hB(i+Fe1BPm+
-F&1DM-"H&H5M-3@(q#A02Q(I#R"2QQc$AK(N[CLB#(B"dcp%Y5$FPhB4`,af8G&R
-5eBJ)drHElN2p"Y2C5"HNIS[TS-48eZmdAC4d-p+K5'FLABLZSe'rfA34dX9)Gk2
-1Nl'bG*k-UF6X,'CQ-5Z,Q8V-hQ+f&V0lQ"h&6#aQFc&lLjPBc#GLcK1cVjKja9`
-VCP`afiUC9XbbBSB9XkZB@B93C-B*-d-dIc&$JGN*c-TJ4JDc-CL*`D`0CQN`%i0
-C'-c!B"B(mb#BYm%X#'CK-!1$f4I-['$@"6-ZQ'h"6!YQ@6$$JYN9c+aJ9J8c+TM
-GBHC(d!9+ab-GS65Gd&P*Kb4GSR5mdZ0&TbAq)3iDRD"dQp+C5MFPhDGdU',,dHh
-U[$KR`H'md8e,KbZGTFlfSiZ8VP2A9HSCq,4B[pCTH#h9M@GP@rC+VACa+ehBa0C
-IV!j0Y-&Y+j8,a9*EVGCC$HZY*F-h"BN3(9N!36B-,JIF%Jj@H1li806!FTe9615
-(&dX"cmceGAB[@GU+-cYZk%5a2T+H6fr[(Dh@`dU3!)DYINYITprHZ%@RD+9KqN(
-bG*HNmGK,4LD5[V%89@TK13b'I'F"QrcD-SLkp3T*M[cLm9TTa+ijZR9'Dc*5(Rq
-XVS!YBDPB$k-Ulp9SP+U*!D'!'q2Jb35iYrBIkFqD[F+h5H@jVAkMlJ-ImiJXeLl
-hk#X,QD)+p$@Q#R4@0[5PL+dRrBDJF)i[6TXC6TmpG&4l)dc+6-2pM@J6Z'TV)R5
-*MAP%pAG@DP&Fpm&c*aA,j5LUNX`Y0H10YG2EMcikMG6JaQ*5+TC6p*4JPFGjG9,
-aPVCh,eL`p3dE1lE"mCZGal5U39Ip9&pbKbQ3!$!['Xm9HJDf`5ic!NTQ3-2AQq"
-6Zf#@S",1(Um%'`I,(0I9PD**C4AL(9TN-Kf48S-1%Ec)GlARbeh4Lm2V5BZG'K!
-5KG5*+4-E2,BM%cBUH&"%9cC8#%rZ-E4(-9V1,$q[8Vhf#@6*h)mfd1(k[H-h@f`
-J0M4FL,9NJ'J*ll0&%Pa"IPCCbX-VB$eZG9a1YJ*j!)r'JBiaZG'NeG"H-@'m-!e
-1#b)3"BDT,#HRr*c)+[XF$@a'3*bAP1+`9RF&%3B8hKcGiKiDaTKm2'VR69'@NNK
-6AD@3!++Z3GQY@BKZdaHY@HKU2Z,H03ZG+MJRULC41@K0kU1$L@Qq4h(rL9dGC`6
-9HSTcr83aV)+jqpFXh%i5J9"EXp#S5h+`VVm$8CAH@G4%pNDja)!&2SSj-ATDN!!
-3"mG+PSJ0E8q&b+@&E'eSQhKmjSkA!Y2FaIGEY*'pj+QQ!$HdZ3UN3$Hd5G#MrU"
-2c6FAVD""b`DJ+L4Jl@K5MbVqQi1ccScLSF4V+m&3@j&&fdDJTXedrflcqi*k2D`
-1*pk#N!$(6X!6"Pdc'TD(r)k9pELBH21$`G(Ki5$fhCdj*l,@TKUACaTBlpe`NA[
-)TKkHH&&3pMTlrHiD-N1hV9eXZY#Sf41#DSSG&bE@lR6KS$dKc#+3!&CVpL`l2&K
-0+Dr5)V2`GV,YAJ8@[bSX"5$h'P%mpr#lLYAKd5)pd%%4(1%%Yhl0HA%UpA-RC)N
-pbQmE'JSY5SY+%U[Td$rJhRJ"[dl-kjV-f2Y&66k,Q`+dpYc8%'fkk3TMQ(`!R`p
-K`-UYmbDDDGdH@3cf#Zc@N6e@aVKkI6j24-0iar-c#hdURbqQdAP+d%`A"j6LfSh
--4c-Gr@#&*R3G-(qm`Ae2%hS3d%+[M4d2i)'Td-8YlGhc1eVmP[PYr@dF0hDfpfX
-BYLrPmm8-G-Qd[brLme1-&bJ(qAmqhm6SQhejr'%bY4-k88`2jh5X$1Z,k)fNXq#
-@,2S)4KAFmY'R[IR2)f9m-jmEX-2r`N*3Mk-cJhK&iYYFR[kq9rIk4q9QA(G9EXC
-TmjCdqlf,4V`Mr$ilV@NjI#i$!(6(mm"Y8`jIl!hl5paQ!e,V,BGr4mU`C90qlM8
-rp0DX@62qVqllp$*[bjBYfrjIbY$1#(rpq[92h((EIb@ReE[5YrXIrQrFX+&*`M[
-Gjir)1rc3L285m-2ZYmGpjD[85p9I#*25pTEc930KYGGD[D4$+`QqC2DX4Vp@&LR
-0@PQJ2,FB+IfppDG+G0#qP85[Sj2Vd6Z[2$kUlRbM%3$ejdX05*GF%TcfhLA4F5G
-H%KThhL@K8E0E&KQh[QAKeGU+fZ++q8Ykr#V"pFU5pVTLVB6GIeRN91V#cX!XN!!
-q`A*8V9UM(X)N01iS6%,6,XNLAm3pNp%-JS3JimJL2mDa%6f@!U8-5R%ZhmRlLpa
-B#3i+1!i@CSaM$$('%6%[9M-[&"E(TU`B"mHN'%I'R"K(4T4B#SaTT44G+DH)$j2
-%*A4BMUd9Nj!!B9)J)4H@!TXj#jQ`&!F4CN(9kSaS-)k-@6#16%N`SBDB!ph-J)6
-rJUJLp`9a%Hr&3C,`1-EPYI$@)YHPJ8&T"S(#F3&Zq#e!BfiVC94S+)K,15d)60U
-YA96-C8&8a'0a8-`(F@4D'K&h&C+6m&Ba,LZ-`M3)5AV)9A&3,5mK4m8am&-58+U
-ZL*H#U*L6JUL8M`TP((042%dP)D3NY-K+5A"%69PNd&kH"VS%&j03C+TUG&#95E4
-`9K*NL#X*LGQV9J2#2NP`bQ0*G%aQ5@M-D%PSdTkI4KDEpG2`DQe&,&I-Ad*ePH"
-kC3RT&@XPC,iXFLTe)3GQJ4"K1DT@V4%P*U(&'3K4D%U14Ek)'G,aJBPD(bBl2C0
-iJ%2C&p1YeBqK6kXFqD$#MLJlR-*fC*I&Crc5c'L3!)GQJIUGF9$fc%!Fa%p-Y*i
-m,`R56`X#XQFPC4@rV8c(mX"bT(jP%T8p0Chh8f,UdJ8a@CHL8iBSAC!!N!"%+6c
-Qqe*d42R9i*JkUcHim5@9f'5)4j2qkr'"!XMLV3JSaF@PABU1UVX@2*N`9rkP`*X
-C)0@4M3ZDkBlN669i4jQ')UFDLmkT"6E+)9BlTHKBm*5LL`+q&"pTq'T`)j9&ZdQ
-')e8X(aHDQMiZVZaCZ0#5JqB#8k[)a4A0SLJXY@@Lf))a%d99dPXbMC,)b$B+)J2
-Mb%@NHX[&&49A(&C14UM&A%K9j,RJXKPB$+fNVqKc4@'0NNUmVLK+h+ii*%YXkRL
-jZ*S2DfCD0Iec'ejcd'hXT)PV`qZY$$DijVrEf+S$A`LYqGQ&q064,N5@l'XTJES
-6(d9RAVa%&pei'eAc(QaXeAd)3qY*+RN60Qc+",%A6(CYa1'0p&BE#`UKdk9BD5i
-S4-EY"@&B,IQe&J-E@cHZDZb@aYFpb"UrTI%0ElM-F'P`cF@XFecPJT)GQ,&FU4B
-DEQD9jdVKUD0CCVSdZ'C8PEQZ'Kcl@!ff5fpSfZ%e[L[&9chD1Z09,UJACZE8CU4
-AMUfiY@ADbfB9lR$dbZ4AMYrZkP8SX(a"dpR,L,!HhV505R4BMkik4&95R,bKCR[
-&e&L1E$Tp'8%f`UH59rAl'NaC[Q5ljeIMbmS9$Gq[cTVe1jSPA(Ar-[UXKGFG`$+
-*&LGc6MNM0VjZMGMJTMGLia[QL)fZZb-fZ'D2&',VSVa`38Q9&d)cr5fed,")S[#
-bL5$KU8PL`qSZL3fZf54KE#09Q9&LikDG%RY$dbU*ibI6A$0,#V(E#l0UPa4#%lm
-NM+YA3GdaXF%0bk6'Hk8,'UC*MIP+&dcD*QAZ+dAAMC-kqe9[b"4kaRpC88bD*e8
-'c1*,pNQC!d[4G31Pc)+ek-4#DI"JkBST%kA'K0N&04ZPcSA9'aTP@RC5-MUX"&H
-pP$)KPNFRlh46bV4BZ@#(Re)KamS08ij+4T'0q#P"AL,+4RK0GeITXRP&h9L)5E-
-51Z@XC03j'6qG`TUjdZ$3bLdll*8DNeE[Q$4BkRcDZ'5US'XH5dDXpIL'be+Qeh$
-JH,AVbF@@fTjFB+A[bF9QM8mZXY6jj!,6eUFSVY5S%`@(R6T4@05A%q3jDhp+3Z-
-'SL#dd!$P3NSG8#i`EB'+ibSTLCUJA%bY#mT&9pUJLV(90+D08&(FC)%9@k'L-0F
-,&FH8-ecUKR+"fefrG$*p'PqB4Cp'dYQhEQ8TF'2FTqJ`I@*9"`E2V%4ARaUP1(e
-Lc*("dk+SkT25&&F'h+GhC!2[da[#!IKTD(8JIU8#+TQSh*0PSh*,Q*&+H$8V8I&
-8XK(&CeQ)SX2A4f%HP18!@*!!9"qlmSe0Kq*aKLURlEIe2@ETdF)pE[9qZDK`$l[
-QV0je6r!iI3rlk"`cH3qljXbE[)GpG"C-hX0q1i[qQZr`([DT@E,V2E+2VVQ(!H[
-VXhYU%aje&,[BG%bqQheYmT2hX"01jq3pl*DcEGFp8AlB2@IVj$f-,6jrmKif%pJ
-bH3mlm6cLZAX+K+5A3Y,I$+pjPHp"'$d@(RFci0ddkFGG(feJpkd$Y(1cTqel!U6
-JGPYf[(!TLerUAE-fD5Gj6p[h40YMYFJ,2`X[M)q0VG%qqckf6l6#V"HTldQmb2D
-R[8Kp$elIFE[Z#4kRlm(V@cGj$hZ9(Gqi*rqd*kM[`41Fp4KPiFGCle$IJpFhkah
-UHpJ4EGBle2IJ#FjkKrSH[,jC$drI`rjTXjkJ[JG2F0CMe2IJ#FjkPV)!Z0rE1r3
--h-1Zc2SiUAqF,Y6hQ!@%Eli(Mf*5*iAhi(h1REa(rc9l@F*ld-'c[6Ek(RBcR1a
-j#HpKhm1ll,VR+42hQ*d3EmiM26lhHDlAaZ`JVAILZrNHGSkCeF(k(RU"'[SaHJp
-l+6EdD(32ZbXfG'Cd$lXY0R4`G!pl,ckL`92eHr`V[1aY[XIT$E5D%e6S(5I#m1+
-F"mmZQDjrKrdSh3lHl(AUqMIB%p@Y@-XqU'K22RDPG([IX0FSHi6bXE-SZT12286
-4PRcXPqQfF'@A62T!qGMrdfh+`KkID%FqGQYP6e%qGN0&+j*HmXMHSQ$dIU)0`I"
-S`F(`"p'#B1c-5Il"f0f5R8A"f1d5I3I'$UaS1$$f9@@(86"f`m4,"Q-I8raL-(E
-Sj,eJl-3TbhBTbbApRQ$X#)[2#mBHX(LjB1bdLPp,HC*,2&N`FN%[*KMlIXUD5#f
-fQbBq+aKE1-RQCbffRbYq+4JlZj*c-2BeCIp3-,C9N5hq@k`ILhe%`DK4pK)&Brp
-2pK)&)jIX*`V'6UEX+3V'9LAN")apCYP&&)cpADN[k!@1J%r!U%0f&!8M[q`U#XD
-ZR1`U#XDZRZ`X#XC1X1a"#XC1XZcA#FD58Y`*"XH`CbFBHkl+$NHYPM2CZl29pN@
-eDcARpV&pEGRM%i`pDf9[k$EM0AEr"+0ZU5m`mJ8rJ,%h+,Z#JV(p&,Z%JX%6a)+
-a)bXlKi+aZb[j"'0h9hB3"B2rf%88M0e+f888M"eBl@BaZ4IC$UZbIhkEm36V9i(
-Th@AY,Y#DSZ&VmJ!'9mTDrh1-QeM'#J`ZB$p4-1U+RDc!b+2Cc8TMl'0V&VI5'$[
-IJS1a2bRlfB+aPbalfS+45fS6$*jJEeX`q*[pEm(Bca@p!!CR`dY15V!l,KJmcZk
-iB15*hA$"U(2C3V[GmN4pJC%,mJ-'(l#c,KKl1V'l,KKmKMB"BaGDlJ&Mee9ff38
-M6qbd#dDHi%N`G[U9VH[E69[)2MejdcEXX3Z'CT!!hB$bPM-C!*!!0ck5lB2b9Y[
-S"6$UK$eh`6LMPF$Bk9E@$-lElVEX"`X'(m!KB2#"l##90kk9jHMcYNF`(!M'[Vb
-bX&H(D5eU&JcG)P[TG*K1N!"qP!lMA23,',c'IUYJm!MD$BbDC,GI-(,0MVpJ[%(
-k0cYXVecfr39$0m"eB1bCbaklB1`-bceJE*K(cX()+h`#aYkfl-%,aMl&l--,4Ym
-Ah!j'MYQ29hqGPQ2fi`9$6l!R,aLDLRej`G"#l-X,4Ph#9f"`+hS0$)iMEck%6bZ
-,dKU2hY8[AE(6`r,T,J%a0Aa[RpGQ+I9S-rYJ&pE`HhbBM$bjP,SIB(20R9qdP,V
-eKLq6DrjNeI06j)Sr9Flkdq5H2efZq`YeIT(1,pEj*6TI,QIm#MR`ce$F-h9qPYj
-lTI#Vp0jRkrh2dAZIUrGIVI22blPrRZkp4[FqAflp#p,hqLQfd2-FE05QYT!!pVP
-0S,CQkepNqiD$f+hCA!q,2TZYf8)mq%raQELGmC@FcVkjJNIIG"jQFY9ibdaFqUj
-EhR&lrVlr[NEqGpeAHAIMRY[VjTDDEEl$,lICTVrJfjp!8+YiKUeTAqjFI,"$QXI
-e*Y"$EKTQiB09`cBBqB*5dcCL326+6!'Qm@NqZ,$B[)d,LR``ar("U[U+fDdcQVI
-*"-F(fMmiD"XI'*RJHH1$aG[ii**b10L866H'I(!`h6&UcS4VI@UGrCShad1-3RK
-BA)c2QP2Skr,Edj-HNl#U,aU05d(6-Fi)rB01a`GQ)-DTSl9D&0IR,!U+3d'F0&-
-6#Si2Y0qXRZ)$U``Z#*US-8,)"bhrd)YV`QSc-hB)rB2fIrS(HS@F#k2UR*l4`A*
-BmMZVTI,S8*-`%4(b3IjIIT+2M!`52ZK`I[-jE)qdZGkmV88Tj)01p4p-4(&JZfG
-YpBpVRGPk3V-eCJMjB#jkFGk8j`B`GVR*8RGqM$YGADXe!4K[acXQ#PfD8Y[mY1$
-YlkbBBdTQDhG-p(4THZfqGjcHVZQiGqEeP,lHA5qmp4fE1TEfY`k1H+8NQH(PrRL
-qGf#[TXIUVf041JPd6E&FMU+U[bJS0kCQU0mpP',UbN[@fGQm3fE30Vk*!GrYK$C
-C(HiGKf[DmSrIX5-Krr11(F0#r[FGfaqbpahRVDajdeI0Fr9kr6dMB`r2baZqq'j
-QJepkMFFDD,Cq6dKVHA1b`LIHeZ[A0kHcdF`lC1l[$r*K4LAcMTfc923lC)ZfCQ,
-Y1r3#Fjk!Gjbc*l-cH@AFVh[(0"2YIFI11E@ZA+FrmikYhXKZRVCV`H95SRDK+8q
-IdGkp9mG`ar(2+TPcSj)Q-rrIKrki1)QI93flhl&eT+aTf-e2VeFhUmqfeNHE",b
-$Ej`Lq9&H'9XZLM[FbUriq6m8YmjXlBlE&(Ic(Gi!aEhKT-AD3k$j6I3-l-f(jd1
-j6fEe0Z8qqiipbRhf(AZ8qdh[f+hFCpiaSpcGR#arJ(+[jq0lbVfCf&Z9qm`lpLM
-hqM1qUpaRhV&6ZHYhc)ThUpc2'rjIhAXr&,IH6,9faff+Hr)GI*i!aDdAT$rbH(p
-LdrRLerQmBY,[f-i-he&-XqrBSh4ZHXGZT62cMZm`HIdGhfAbQAIX*$hp$V-Br`a
-$M$1)BcSqG#5Q+N5rip'$fUkLpQdBA,lh(Cf&CrGJk#J8fV9EajhIIc1HhS@85Vc
-T(9[qTKAe1lD`1QPKNG&k4CmED*q0IARGTaN#,Ee6Nqppa`aclUbcS$kf032BUA0
-H1ZjcLQ-@T1lM$8IHJDXdk8*9[S),pE*e$II4#r#1YH8NmD!B65#6lp"F6ejcZhe
-biaTk!I*Kh$i[`$ZFfcIpMVeZhrRe5YRV@Z[HF3@EQl6XQem+IXMT-r*6hl(*qeP
-qeJ9rk2TUhYpXQjcS68d1[*ripqCRRA0qIZTjk6BcjKf2Y#TUjQ0ARBR,FN(YQAV
-&BM&%0281jYAQE+c[[VSh,SXAS&k0bq)&H!HIT61p4Fi2mfVHSFXMpprk1$QUDU1
-B4J)R#Me0!2BbBAlQM26)6@dqdIQ`Y[[LCl`TqlNDQrk-K[%#[11NjI&TVIcr++q
-S8Rp&cq,d9p&#k9I33RI@4d%,h9Q[rS"H-D1&p[%($(aQ@0[EJE-VVri*jjT200A
-rjp@mBqFNq9h[Q'RabKhDr+h(DrVEUh6m5MeHqcl28SrABfTle1P-ARd%AGkk9fc
-Ij`(T&DX6b(Gla5DCfKI3+aDZ&9ql*0pm3VPl+T5T&i!jr3T-YHZEh96-rq(TH&`
-Qj8ar(J)[aJmd+@IIjeQDP,2ALkNpa%X`F@Il*a0hYRrqVBNl-qhrZ5R0+[VrpbJ
-irmBFJHmSVrSl[UHmQJQj9AR0[--l-4pKVr+U2F3[-'I"[Z1m2AA')r4-8LX+TZl
-a!bJ#m`k[a0b(F21JMR3cL2hpKmf$&MfjHC!!MqfEh%6*EKlNHpY%b6HhHC!!E!k
-bAm@aHC!!hYPiGNDQpr4EZk!!q9hVGV[ADphVlHjp+`AJMCYaX*pUYSA@h"FU%&Y
-SHGliS,+&PSIYblE3fJp!f$V+RlDP@ZF,'BSYY+EQ+AP22leePYipkp54S0adCIX
-XphRAYp!k+4[UdV%qaDVE,EcSLK46IC[AfYR$0&[[icHZhVV6M$)mfN+V0jFEhfP
-'EETT#[%hj$EG[#ahb8%c'qr`I'fKPI&dG3ZY)NrlcEI3mL)SGcr3KJ,6bTe2P,Z
-ki1"P63#8ZepU#kepGEpIbl#&eZEU,EK+Nbj8j5Zi8&pHfh!I[3$[b,E3bYj4hED
-Tk)SCep!,N!!2irCj!Gi4E+%epBkpETrC[1M02GN@@ZV#h(I"p4CDDZh'QVFqGqh
-G0heqG@lGL8BQHJZYK9ALRjblpXljZE8rjEjSmk*Q2RE9@ED&9[D1kKCDaAGN@fM
-GN3rMXRJ"kY@i,&k!Gr!P@fMGN9IcMRJ,V6[HXCpSXi9@#fR48eR0cr[b,@jTljl
-IdH+hc'rVEq1iXE1p[k@j5J&iB6M!%r2jCeM!AmZ,2V[[B1B2m[RRP*-qmaH4JJC
-p0"cKje@DrJc5p2pT)CqNP[EaZK5j8mlh['1m5P,Id3[HIJ3V@ckCZ1,mPD1Bjpp
-ZF4GYMe2(FaJPlS,YFIFjKL8!j(fY$f4a,er+!#&jAa6AYjJ@8(PI&$IR-!jcDc&
-cX9Xf[XBHE10DhXKKb-AGD0-+@T52EfIhV9`#eUVlk(5paX8pqe0JHK8S%rG0$LH
-jZ([rb4iXlkC2pHiZlNSEV-#@a-3aH96ZZriVB*fU'jUb&lZi*3H$X8mack3M@[,
-a&GYjS%pjHQD@[hXH#bBcqY6EX[ZZ[KGX`-@ehTEPla0hJ#h6IESZA6iZHKb-'Z(
-G0#p,rUkq#QaBF6GNphhm&M"T,'el*-[I*BD0ZELZ6eTZ,U`RaJG5BhbA`arYmbV
-eG%j2'0HpN!#$MYX5EBqEBqmqN!$li)N`VX9U3[*pejq!(D1mXZ@,e-IEhJ0'[I1
-1"GPpChd#l&JAG`rV&jIkH,jaK&PG@0rhJ5cI(lS5E,AULIG)IEc+FL*cH9U0hq5
-qcli6E*hLhT(9aaZXdjXmNkI4,"qIlJ3lbm80fp4FbGq#G@!rT6U$Eq@qDeV"(U,
-m[5I,hcEMPBIU(F4*2VUY[Xp@hA#3!2ce@4e,*rF)fffjqjjNr#'GiL-rb2,h*EJ
-fTq&H9hf$1PjIU3r[i114Ar('ZeCU#E84a3hb(V@kTbZTHrQ$V)BZGA&,M#G%"d6
-hGIf#`bZSHcVI`lTIbVYcbm3V`VPmem#M!Dq%FGh[RAK(&(IN"+q%F6f[jh#dH#L
--'lQa8CHYFbm#)fr8'H0-T5j[-1kleX8pd1k`GGPkLR%6fN&rpcFp)(Af6Y-FVh&
-aiarJX,'5l15jZjNHF(&4RY!ZMPrEXlLAd+5Ihdpe%-Eef2[HUMS)ihU0ee`GK((
-,dA1jZDU$-'l#*PqlI)4a5daRG+9jlCMk8@SGAD1r'p%ahEpfFIG#NkLT,Zkklh(
-pr$3ZIr9Ma#ebFCp$jaejNEZ[l4A%(H6L"Vi&PRIhIH-8-,35lriUKm2FIDGpN6K
-pTq&,H0$@CFGKD$Ee5Yf(9P[JiZkhJEK$AGb+3m(DhIXqmeN`2HRGm0"mU`0lhq&
-h%EG%FHb5B0q4Ir`KiVTFh1'@ibqiqp4R`25lM*j!4dQqRiIf9DC2NA@Fapep$rX
-FF6dZlJCQG,3jRXK[SFl8Ur31G(1ELhYh,h'L#jIGD9aZhh%kR+'N#eI#alRC,Zl
-i!iJ6A6Ki-SF$A&cR'F5*,Zbb1-[hqIY[*djdBCG0DT!!HMUC@PI'$r!%ifrHlq,
-QSF28DehF%Ge@3rBG(riDQ1M))ffHifYGh&[3B8SkXXX'9pJkb$q'9MEk5"rIm5"
-dD1ZQSr0X!Tbq4!F)hh6!LmVT-'8jF(ac00T*14fQTP'lMQmq$cFU0iG)YIiSijY
-HhU#Ncqk'(R0mmd@cU@9hL0kh0[JQr`!k6jPf)aAk(Diq9U,9P'NPH*Im#YqXXcc
-*&-B6m$Q%EcS1J918jYreEXcijYk@l`R&`EIbMP8I)qjNk3Ni`2*0rL2'SlVZc(f
-2crMQdqKATH%GieXb[PQ%PP1@6rfp(Ai4[ZNidAK)[m[`$IN3[[N'QP2e53paVq@
-Er+eS(GA[iSkb1KDq1GIi!bm&R85mm-f+$a%(cj!!*rMBmNh(kXZ)1edklpPC2Dd
-R"`TG`(IA4aYmNlmHEDI3!R`2X(S5(I"!0+[a3j!!ZZKEbcFGCE5('YICm*I8`4(
-i(%SkHq+HM'm@QMi3R6eSHY(b6Ilf,a&RGEDb)AM#0rRISl'8dpRUA2)PI00a#$@
-Xh,"YG3(qK2"0rTYI)%$'BDmhlK'qqG`[l@%fEXLdZr$0ZfmJ6R4jRqNPUBrchbA
-I!cj'r`K2('Bk5I6k"[5dijZ6H*25*2aaibIKQc'i8QRHk[!(XhFFJrC9QY"c#RV
-&mFhVb+Q5IcImmBa[[[CYiQ5bbp)2Claq,Ck0dPB!Tl&'Qp-hhrSYFH)EYTh6i*Z
-13dfhb85a%dhhL,ijbh)TIQ+[k@c,0rR,,+rS9I3pHX2b6Ai62Tc5c+2KUc0pmdV
-HUNkA6X)lNAUkZp@Cq*ZRQNBA[[NNRU$5**ihh*IacIRN9'R`cK[KB+G[[[PpiQ5
-5d)QACRA`((`1KHELHbYFi[KQ,MP9aY[kq#kmY*EpdVMF!A#Y@ZRL2[BkI*)MA0`
-TF+L5Mc*NRShPTe`!KbNhe%hG!NqiGkc%%e*S#Z,HLejelhMS&343Gk3)IT&hh0I
-d%ek@2Vi2IH,Hm5UV!mdja(d!2mqpil2fMXY86ar-hR'9m3Hq)[a+r2`+Xb%,hJ(
-IQma2q95PZ'0qTlS9hD#FAj@l$Up#R5HGXC!!`bBApfSdZRUhLpZ)&XpGkZ+10Cf
-("kL2lm&6890Fh0IH!+Ec4Yb(M-2NI9Y0cehZhV'*ZV6[ZfcX%E`$GD',ZplU80j
-hlFh%i5rTiiIa4GclPTM1`kI9airJiERhhGGbq5cTHh`&bGp4q,,+H%`I2iL(iGk
-h$8fThZrL2QUEDFMl6[S0'2SSphm!G`)!!!%!N!0AHJ!!9RS!!!*kEf`l$3N*CR-
-ZF'&b583J25!UC'Pb1`d*#8jKE@9$Eh!50#i`)&0PE'BY4AKdFQ&MG'pbFJ)!N!0
-"8&"-2j!%!!""8&"-2j!%)!$rN!3!N"+Xp[d9!*!'@I3*#3d*#5TfEf`J25"QFbj
-f8Q9Q6R9Y1`d*#5TNDA)J25"QFbj`BA**4$X0#3P1B@eP3fp`H5KQFbjZB@eP,'j
-KE@8T1`d*#3d*#5ThBA0'EfaNCA*"E'PKFb!p)'Pc4QpXC'9b1`d*#3d*#A*PG(9
-bEL"bCA0eE(3l$3Pp$3N0#5Th!!!#L%&%3e)$!!-S$9d,iCE!0Qd2b6Z[IH9Ehp5
-Ue9CEkEAkC*9FPqJ9+UeD(CpNDpA*@5)i3-Q)R'5k55HY1-"hcYF,r!1f#E,M5[U
-MC@C+a!jlH+aC@B3V[%icXLX@fR,DNr0`SMITBMNC8cDC6Z*'D,'pk"KZJpfp@@Y
-N0fce%Me#6X-#1je1j30JAcZ3!!lQ+MM%ppFL13@,l3`kNiq#Xra)29V1aZ2p8$e
--6X$$l9JkMKI#GRp!ljGYH)IYT+em*paYXfN1h`AcrADp66EM8cD0CR)dR2%&qSc
--`1RqK$iT8r%HQd[cZ"kHY4l823UZ0RLjRL2VFBIRp%(CJ[IC4YV%pd*IreFIPcl
-iY(@PE[`Sl'hl8'rq(IEcAE4D$X)KIUZ@bRMmhLE5"2iFIVC40*TrJM&HU6r)*&a
-MlDNGr`LGr#[p@MVJ5&qYUk3cVV@a0)lA34GE5X[i1hM(rpDrj$emhrr6A[)FrQm
-Id,[m$hcUYIUPI),If"+DaGp#2rZB2Z-'k1NVp3[TL1IC#r3+A`5[qX9kSEb-Jra
-'[88'i`hf%Ah)em-)[dU[PQ&iV8fKSA`Gh'3$D6KI!rhpCLf6!ILDAk+AbZYiZEe
-*Er%9F,kp5-rcZI#5Ak#Ab4Y4q[3RrF'2`GYqT6iN[q#[rV!q)VmK'T-`3"4Cj"V
-@eLC8PNBMkcLAbb96p2B`aCDaP&9&U@-[5hXk6QI5UA49HN(DD[*0fCDk4QmZA"b
-hC9*QKDeY8Bq9e54!3"2#XdXQSE`ZSEJ`S5P3&#J)Y)Ab`R#S$SIkd&B5D'e1lV3
-f*HZ5PSJk56D-!bP*#TP!2[bb3,EL8QK,"6+"jSS2"5`IY[4X3MD3!)N6iRa#69)
-'!*!$,d&%3e)$!!"@$8X$RHJ'ApX&YA!,!-!YrkSA!!$3@iYDH!'Kj[m$@)8Habq
-AC[SF!*!'*lp"4%05!`!rmJp9$AC'!4!aiqGMIjYcMV()-TE9'U0IM"@MlZFhK%X
-0M$Q(cV&kM"'6f&`D[K#b%A#b!`R2br85Na)aK#$0iD9FNLE'pSA*#4a,Z66Aaq2
-4A%Sje-FeP%XTKkD%BiLe3#RJ!((Ipr[[lr[QCJkplE[hrI`('k5R+%%3*%%52*%
-"I!+Dpk1@k$81XCK2KMmBkh)ImdEZFT0$AjL%ESQ#Q[A"f+5lUd1X8%03`%TJXZ0
-G8#P3K%U%iPa9heDKjeeZFCT8f%RNL[a%6Xl(Kq@H#NEkblD+H`kJd#!9&R6m19E
-#N!"@#`8L1LLBQkT*bA,EbTI8INfUkU#1afYrX(Z[U%d8m(MZKZ%5'MEBDhm3C0i
-JK)p5BU8akQ"S@![63Pml6kiTHVpAihr2j32Lf+fkG@ZlZ2qbbrfRcfYiFSC,bG5
-Y8d[GbakZ`C*!PqQbISC,9cUh[kq,Qp3XJ@&0&dqqhqhq(hIamEjq6RGIeV6GIBq
-pj1,qPhCcdd[G20RajrS$`9R3X$UYkqliY"IALYEQ6KjA1h*[iHHed5N0*R[[V!i
-NhcQ&U81EjPqfE9TdZ9HB2YR2ihfK63fRECZq21eb,hd!JqT8iV&%8@1[1[8Q"(U
-mB&C#-Z4L!dNfeDUT$R9UF**EDh0$am8D%VjcI3Bl(HC)AEh(&bT[R-U`MaT@Jph
-SYKeETNk06r)iPN6GqD*Sf))1(1bLli`H9iDUf$lE2P[YrafP#h@UQh(Y)eAQU!L
-"dYE4-rA'5f-6,@jF-Qe%FM+L3VJ20NjCD2[LY!M#e4HMHX0pp*'1e"CVaQ'`l%a
-NBCU5(l-J1fM"hCpL`8$3JXIql3+aM&$4Hci))BmbK)3b8IXe[G)kX8DXmGE#9&M
-+5leI#B-maQ2H"K3Xh1,p5L*fe2eSD8VFMHJJ,'U-N9kHY$IM&A@14GXKc1b`Hlk
-a#dE#'"h5B*,%,2(+4)Bb"DC5Ha+[)UFl$+3fh58MPq2TKVX`,*Ffh(9Z5fmH6'*
-kV36NJGU[XHe(eBR)*"IjkhBV*CH*BS&Sc6Z#@4$*j$*aR`5JE-J6C6Ipj21m0$X
-JhJ(&3pi1JdT0KrXQ%UFk2KPJ`VB,"cZ,'"TZmZ(lPR9cGr$a4m0KCXk*TNYKFSp
-YHhhhRQ0,4l28MU&5Yd'*'I5aqTrc4RhL6FjhV[TCfdHr%IGq0&dXBm`2Mikc4%,
-+@0*N,QQb[)%-qeJ+-%*D`qVDc`fVFC523&LG+9bj#Y#X0$9Ui43UG*CT1*UeZ$-
-F$A'rYYPZ6BHdUY$*Y4Tq)8-aGJ&aY'VER[)M13EffUT"Na`H$cDX3T@*GS,X08Z
-"CB0,'qRUekSEZVA*YMhDbLkheN3,(9Yc&$4Q-14,NpdlLXR5TB0q3RQIrN+'IDR
-`b5[G0QfPm0'CPb*#")P`%e"+4ZV'kRakDTVYa6dZ0+%Prkm&#-&!I"N-DG'NMce
-bMIHiTM)8,Si3q[-$J5YPmE@i8MYGLDH6Jc$mLKi'SNEij!B')[YiVD9UbRj-DG0
-1[I'i'*K'!T*0Y$1`(BE&`Z(N'&8F"N6`Z(-S%G,''V#KcX`0"D*)KeKq*2GM*E+
-K9rK`Q(+8`"Df2d,Ej0`Af*!!0%-d""9Lh'Vi%L%'#LqX9cXFhmY4*SpAS4&M)`E
-+)JL)i2AD"&H4I)(XkdYI1mk(IPL!6"35#,a@i(MZe8,H"d,$!8*94Z-S*BVF#+$
-U[H0)p#,f2X1rJ$J5[Le6M#a%jGIcYS$XYr,iXcbdKC(G3Q$fUGmKST5B)N(k2K)
-L(V39,*!!!15+8"J+5V)4'G%bL'$'UYdM6b%m8d5NaGX18lL%KTpj[R"peE$L++d
-DlUXDpMRmUH(c!4,V(899``%5BijNeA#!4"5Ek8#QP,C5hSp-d"F@e2PQ3jiX'qD
-,qILjGK$!Liqdl4Ah)l"e`f'%dRF5Ri@14)kbKYZ6L9))T%24-2H,C441`DF(`TL
-d-03V[S2N*jXYf4TBBMN+BHf'I'!b,*l%0$(mH0L56,$k(DU3!0%X,G3*FKi3'3Y
-eLhfXH`X4!ZReSrjd*&f+T!hCc,b%e"8,AcdFFXZ($0qUr8TU),,5NA%NbL0eeYP
-pif-VZ+Af+erhKBa,h(,6B%rV$#2G(GkR$akADkj4Q'm00Aid1*MPE@CS`#dU)B%
-MfRKL9"rjGpSdTkGcXpSrh,rlMcbZ3rM#[Icq1h-I8)cYQeAAX)Z'ep,`RqlrHXB
-$1-bMIrd04*+P40V9dqmDI19Qe$XqG&b0fa&98hY#%r*H3eMH!pBbA*JI[-RpFS8
-b1T3Rm[kM!mQ%Y5&2VR!f2iY`XlcRi"PZN[FVaKk`$i"Gl8q%j6)NSrj,XhdJBqq
-NL3M-`E#mAjV)3arTX,bhkVLF3)"Q&8-0mq8$GM@5ar@bA&L[jXQ(3&"f,lXrZr(
-NX(ji[V`A8mRi16V`ZHT#je%f'4HhTG#pThGPRPacLF[,-F@Ke"3e6fSZePkQT*Q
-)jMk&N!#XP$c*9`MCd*!!NY(FBc"5`c`)0GZbPa)STi*0K@%EQaHR`18J"F$U,1q
-Yj3MD%YV'R(d4&`*2fha'CjJYeSN)I&NDf2,@l5jAeR+@H"9KLbGad1mj6#'p21q
-J5clY"[$8i&X!3R0,fekj"JKd!S9(@(+I*hpLKb#T0"ZfJ$8A@EI)qi2-FF0mq33
-Y*mEFMk('RY#0'lB!kHb'e835a#CUrkSC*p5Vr@S`UrBd8kSQ*MV!R-X#[jbIa-F
-rq)kM35QQJ1l3fGXFE'MQRilk2V6I&$iL03Xrc,ZJ@LN`j25icj!!bJ0NAS6NcUS
-ZiRiS'4Ui"85MIXkG-2A'r(-JVXF`e(Kp50pIaZ11q*`5CGjfZVBkYU,V0#P2&!l
-f&6Rp!2AbB,,f0!AS@`m%+3FHk9KM`V(bq$K,[19Y8R*mQTRf&l&-h)"AXcJ23h%
-44bUHTLc,$!N3mk"dH+9&FD"l+eZLJZdL%TK1PX#%m4QR")BP+pP1[d08aX!XN!#
-IcdLUM'3m-9pX##,C(#VijlEGCm@5N!"02#V'S#l24!EH54Rpr$2f2+",#EE3Md)
-P3UlImhS-pb&6MR6hT(@f5lHIS!j#*pT%m9"#YpRSp@#k'`"YP%hHb5l9I4$0QTK
-!Pj'3!)4e&50"baHc$IHaaF@%Q!k6pbNb,80KjjCZTXUr4U!m9rM-HIU%`m8%a')
-N&46J&&Y5)!QUD!Kr`R!bj[@`j8m4HI`$&F@j#9e@dZY*63k`XL&FhA#3!),AR"2
-qFB$`q6m4N!#C3B$-C@3`P0`D!%)!d(RqL8)"%!+`DYKfr[QdV["5(SNX-6VXK#k
-q)m8!FQMk)-lNPeE394+kTlmPG@)5NcmeVI!aPF%%RjBQRj9"M)H%$fRc#p0C%)$
-c,BQfLL-m0j6l[0Y@2HE0mmVN$##+kRMZYPTVED+f"HVPIr&1j+l*A@1`-j%'dir
-8*9YIc"0r8Gj)+1%mVkSBVKLTbh)JJdD"L"EaGdi@,RGBAY5A[dX(k-blG8jLmff
-AEGC)AH[bK'iVhk![hi@I-P+(b[FDE18l0a6`52QqNESM2Q6hJS!5YF'QM4fZJ!U
-Q(LkMB6M$',[e'r6DT-'QM6#Q,'a@5$X'pBf!G!cU*TYVIiGX3pY4+!hjDhm(Yje
-EdQHdpRFrq&Yh&TCj62U5%V[TQL9!''Lm#kTIc'(XdQZ0KXAP0EiXTj@TD3R@$&Z
-"2&Tlj-dDEM%C(5Di5m#4JlF,kKUIj*b5#--@8ZSTF8MVB&Q!FKTe)V'49$Va"T*
-mZ&)B`Z,AKY$KbLk%BEE'S'lD$PH3!-*jZ%bViVU4&p(%D6I$D(!%kZBK8MVAjIV
-d!aP1AUT9EFHmEpUd8AkGLQd9@jB3f$L@9SH(3'G+TQN38kmVp1QRD0%l)h9KE'f
-XPCC%ER,,PKCR+j3i*hjZN[VVYXN3K*i+Al-J'B9"q4TR`rPEBaLZMj!!NPmjNI'
-m!9F*D5ZK*$r8Z!cCl,F1IfiBcE%IcN@f6@iFma`NKG8qr85'diUK%@QSJSEXrQp
-L-5ArCkGke%'Gb8)L0E'3!"Jp2%mJ$M-E('YH(Mr4YJ#,#Z11F4L9jlbS"cKj0)f
-f%Nh"`SQ-)%+F#1hHFeJ@&"pe+LHFJ-&"-(3Np@)2`NF($KE`E@5@`Bq4b#!,fJl
-)K2DeCEl3!GNCTd-rA!Qe,FpY1h`%2hX(3j[3J+[c-29#A!I*r(!%Qh6N-,Nq[8r
-$)h8[9!0ajM#4!8Z#d60L-h4V%fKZ-qdH*X4K'hqp8jJ'`KJNi0Ym68JElS5iN!$
-2frhNR)1IDA$QmU@,e*!!20#i@*jUI1`X'8`AFpqd%J`U',``Y`4ESXS@Cc-fe8"
-Eh6`'iHFc#'0*fHHX'f4UAR-FJr0pa8Kd6bqmH'ZYkMrj"`5YLN$-N!$Q`P%QFe,
-('K!fr9Mmkli!S*DhI,h1YqLkkG$K)i1K`h$kDVh'",@i8fhDmFZEK+ba3e)hYic
-4J3P#P#1CSa#`X6N#@PT-,(X$aCXI6d2TH0S4AVcaHZh`50hQkHN3LNqKDcU&BA!
-NR$IkN!"KS#)XmIADNiD3!&P@M-,'%1UU,a2!CRNL!iX+KR&3Xh"3XdT#EH)RdQ&
-jQS*U,#-3P625SH(i)f90@9km,&eMY'R(NB[XNM'Kfak9%'HE`p')F!pY%'XqJTE
-%YT'5#H6l"0HX(#!aG46Al-6R!XU5'flbkpSSblJir+j1GY8)3jUl)h9l)aFb)+!
-%LE5P6*!!JQ1$XG8BcB)"*KTTKhKAk&cMbcUe$80qChXNbE2XSc$**,P&BMMMp2M
-DZH98$-0qER(5F"B+ULpNVT%QK!PhMqj#"LAEKbYIe*YV*$2,Rf2,#!"I[ZR1UH'
-%MTrm[Q[BMF+(UedrAf+2NBNk-ClHQRYb%!DpN9I95p6JFFZ`@dQ@VYX-MdKma[E
-TcqS0!amY%@ZfVB!4-0mdrj8#8BBE&4PiYYS02TMPmP3-LYc%TNUm3SkPq0JmI'B
-)(bCZ8PS0cl!P*M$(l&%-qc'F4+%84T0RZ$r5adf@G&imeQG*pqMAkAN@)pBFlH2
-qcF2fj$SL'ShN$iUQ1eH&ckfa2Y-Bh%6rfcBGpcHSprd($2&YVl6aZ+r2p2Y6pGB
-qbdEFB8F%aM"R()$2AAF64rId+rQQ''rfjCGUEGfBZKR,G3El4eLZI[TQIRb!ecZ
-L1BTck-fEI$hhj'3j-eqibGrLL4F+qRY@IBHh1LcS6VjbNhYB+15+ZQViq)9205[
-+,Skm5eZY-QI$eDid1ARah-AIGrhXchB)+ccb`@*bpKc19NCKBPq6d*9p0)cKHDI
-Y5GpTZeA4lUlQkUmDBI`RYK)$JZNm0[+NHK`CT"(X2FVHfdqF1irf5E%ppra0&'k
-GrkrREk13!1diG`N44Ik*dr'ULX*lrh4,T8,&UDZh8,"N2[Gbi5N8$$BE-9KZRA[
-14SAX3T5S`+8r)-iM`pKLKcrb$(m9,X$@b$0)mD*1IipH5FEk)Mqr8)+-S+!4Ka-
-LL[HL!@"EKJmI0Y&[5G[lT%eEVhjk&1EjBeX5h`Ul)rVaHVXRSKqXYmI`kS2j86r
-H"mGD##HB0Zi!1MK+#@e"LJXERGHDd0&4$V'Mr*I5e5kKX9L3!1e-BJPANM3!Gd3
-ZcaD3!)&lKYh@HMZACmhM6Zh[rd10SR-H3qCNPVmSZK@K))BHRLES%5AdL%hb,,"
-I&&$4jU'V4Ai@`Bcf#&kP0[pC[3#JV!3$jXd!B(f@k)*XHjbF&VR(Qk'1JfhY6`i
-")FY&KLq43h'XhUf2rG#(%)bp'DqNhImMR4,,e5N4iI0Y(3*%ZMM!'3GDU-I*r@@
-N%FV*E+!Y%!D1SA!YiR&#Q+N-eV9-rI3&U0EFbKJmZ4q$SARN5D"V"S%63qM*kFr
-j@$'pr6%5am#3!"&$aU#KT#-V4e(mMUbhP5D-F6$'Q`a&-"5K)8T++*3%%A%[%2M
-6N8BFaMJ3)fQkidcQ2KJ'%cPjKe2-%l82i5$m`pP)LU,K$b9Re%qCZ[!8#@beZFJ
-@%F2VkVKp''lT%iPk"$5MGXmmr98%CFqffC1aqRHA+GTBV%HI'djP'aa$5cS,!NC
--I2c"$&,((C`F5N8MM1iJ#!&X(h2(K)#"d+BaM2!j,4D1pkklYhrUhNml5%N8@d)
-N&MjqN!$F4ID&5(#T#5BT0a`mcUh5iMJY2KYBA*c1`N+2q!i@@X@&M04TU*1jca+
-j$eMJ-SH4+jE)[F-!M!,!p`"B23"l4#)H)q+I6[52p,L#L"XCm4JM(K')`qM8P1K
-E!P'SJ'qVIa(q3G`64,ajT2%"ZV4VeBMV8q(D%[Pp),HI!GVN)-f2-k)a!,U,$T3
-18MV3#SRiNL$LS(eIGaAa#R)#V!qc`%3F"XCQ'&@XNAbdI@rCeP-@qm!&dE@#13*
-R#Sl!05X3EUeSq0"ZI$"MN!!C!mIphN`F[4%+F#-6E(F&ZJ4AGlP%-qk-B$K-Rc@
-c0H034U*`r[eI8%`qH6#$`XYJ28)"$&`*$-iVM2f)&0Bi))5[j+2S8S3&0!@Bbc#
-8q@#''XPpN!$#e)0mh&qlp1"a!U,f(c6M$K-F%Jii2G)LFQB2XdRQpBdVXF!``1V
-T!eK1NmErjYrL%-R&AGc)A"CR"Y$aT,$Yr@GGUcVkHcXHl1I-p0qRdd9QU%Rh-JT
-Z9Jp2ZNR*RMMra-ZN[0EQKXG(1kj`YAGS)YqL&2VmpQM-kLkTd#[q@+Dlj2D1jGc
-R[fpTYppA#TAL$GfS#V(M-[Im5@"4`T&5[Q2lE$-#E&((TXC5'S!,RU[`6PG(GGq
-UACBf&(453EpU&ip"K0aFh8fL9+PBlF+`6qSHN3Sp%Y[6eIF5ffDaHJ$$&k4Z45V
-FNYLDUfm5fcUaqJb'mk6ZFe,KGY@89k3T#c"F)R9IP!VCM1@'a(+(QC!!"&0p&Sb
-Vj1`GSDDjjh8Nekr$058kV,I#FELRPlS`''[S,Cb"KMiD&*UaEE`MK)XqcJi%(5L
-,D')8K(0DQG)-pCRI%04RT4iG1j`80SY')Clb)JTP34aI,T!!K8%BM0lcETYjP[I
-lJb%%Q'SDEHBjU*!!mHqDN!"jfRXfmdbB'M#apmE+ii@Gp'(Hllhah['JiH6Cd-B
-lbPjdPG%J%X6-L3c@I4(6`-(!dS2"p`'@MKe"039Zl5`X[ZL(%($,&N%FUdjk[mh
-#P$RiD2CqQc%P'C-a&EUV!RBk!lD&!6ZEJ2ACc!XZ654XjRRTU#$@E'UKJ[FL#qa
-3#"-+qkCUB4#-#kSBIp5%dF3BC`Q$!$P*Nd2GjX,N[XAQKCF+ZQcQcmUAi,@m[!A
-(Y!6(Y$5b'+%2MZj%SKI%mbeBBUk$S28@%pd-l9`DA#J-3Ya"SCdVQE4!BJBEXD3
-k%k(bkBdZ'%YQNqX!1F`-3!cJbl"a$"bfb4r$K,)%2p-hf-b9j5eil4-@H,m2BLY
-C85XJ#aaJSZrLmR5T(Kb@-)b!B"4J93@5Q""`6qf+VZ2QP8$L([0RH'de,m9,-5r
-I8'!aQCIJ)f5HMYHRjKDm$TTRSi1E'r'K0mpL(62a'M(2B4h69*YjTF28H(*5MbS
-6bC1&h,4"Epkh$8,)*e-EfXb9kb'XRi"c`!Qpql2(),*[-*42aq"m$#ikdFB'NdN
-$0k*M550G&SFb#eIEd&EH`P"PQ)4AZLc3BbrE5*i+lLrUlcUqmEUL"V%FDFT5Zij
-BK%-e!*N01"cm,$!X0YIKCq&JU(bRpbjHqlcAT9"ChE2Cl2L0`L&54RdAl05TdQB
-'MTB0JXa4bQiNk[PZ`[4#KM'$3fa!"rYBik0LR"LkEQkCCMk+c6Y+VM4NmV'6dGF
-BaP#A69i$aU4$l0+EMkTC,)-4!&8Lj1ip-ZpDTD8%bJ*cN!#$c%%%L(BXB"5b$*!
-!q-h)5X&N3[&V[$dNDdJ-&qF,dbDbP'faN!"X1G8+HrS,GZXCB`mr&32E'M$0IPb
-[c!*,6"+I66fpe+@X&&#8"&K5b'-S+#UZS[Uih3U6Cj5-Mb4FQV8NB!SX")+P[Ur
-!iKX&FLJDZ*-NJj`&KU0G5,b-U#,6aD1Q%R)D1"G'&B%i-piXJFT[TF9`1NMDNk0
-ReFh1P55`eJZ11%H`aDqLZY&Lmi&E-F1@3Gh$6e)6AIY2[R&lM$SGHBdIiN!2T$)
-m,F)90F5m854Q)0Pb(0JB(9K#RdCie+YJHC`kiIUE2j!!N8UNf-ATD(8q#[V5jQk
-$)H'Y"$N,5)P1H5*PEUN+lMmf8[H,*B)CJE+T41i,#TKUT0!e"50(kM)253I13Kq
-EbJD3!06+f04IPl&0XkB-416NCRE#%4JQKZT-r#cVkS#"#N(R,TF8d)i5-SJG$"Q
-D,Jc$0(88`D2N)+T@aGr[+TKilYc,fPKA`GP98bm!S9)NR[E"2%8U+Z6&*C,4dU6
-Gr'qQLY08mVke)5e$#CQ-`$1!c"GN"ej6mXZ'qk`KqDEli8'Ul"#5E9)K,48+T3)
-IY+6!-Ph!346*&-Vbf'%fP8IPPjR4**k18"JrqID&$!6`*C-+NY*T$6EjPPeP6*Q
-8c$9eVCKl"FGj,i5CZQSVVM@!+af5c%flYRme`65lp5db"FP*ZP`J'`VC$aR2+Q@
-mERCaLh4aK9em3(jCJa!X,[C-eG925B@`9$JM&5b"UeZZXUYEF29kG[91q@8!Ib(
-iqNAHl9cIqH1[rim&)h8("ZMkQi`-KHY6drhL-Ph32-T-CCc2&G"YlYbe2(a$B)R
-H0YP%@IE"K'4QaV*Y+-VfGPqrIC+51&PM9`'Q4TZ*E$6,RQQbbFJR5G[2GQTEf5Y
-653U$'fbb6eX2CJ13!-dQZi"U0VP$fiIAK&BA3$Yf!$kl"J6Rf$YTBZI3`9j82(#
-*+j!!*CG4eSJi`iZC`Pf(Mp1Np#V0U8[Y(#0!!@$%&j+(cM!hM*`fU-JlUi*R-J)
-B5El1(Yd!JD@m8['MLC@U1U(D+"b!+$YHXd5-I2ajIrd+2SkTGY,%QrI#I(kekR0
-R*-aI&(I#F*k%N4a&9VeKjl-VH*Jre)-LUf##*!9,CX"i5L'fIa5BGQ[j3k`i)bF
-Fk5epp"*9JQbRJAHT+J008H8fNM`UQ5+,dk4BlF686R+-LT8%9dBCTdT59BN*a,S
-l!SUEMK#`jHrKjdJ)4bkHa'Y#2#&Xl%&XLhJDVfla-MTFiN*m1-9jH0d5&`J)-D2
-&`hfP-2"(fCDl8S'ICr9LKUr8RSNX0HT-iY9TE`D486LN!h(&q3VX3B3Z6Mr!b@!
-Ej#H"9ET1`#!r`V*HGb"4)9-bQFd&jjrUBX'JE"V&G*e-Q5XL8NNZ12"dSH+*YYZ
-(+c-8C4R$%Fp4N!#m1H(ZU6@%4&N6NK-!5b0H&`c*-(XhrVL'&35[DmH%jMA3X&C
-cbDbG#d*Va1[5iD!CKQQLl[!dAbr#0dQ3!(p"YV#'&Dl-V'P9cm#XKXD9@iaRHmQ
-F,B![qi4XCh%(VP38EJpTTqJB!-4*C)immB4@Y`&1qpSa[%jVkhfi$$Zq*,Ij13C
-+l4'`,8+Q3M8FV4((N!!")b%GHj38#FU!k&U)$)S$#Kb1$aR)ILXG%V9)jPBLJ*)
-0XEhi2lI!H,e0YBRDiBjI03*Gka`ap5pNd%hmK@@qX,J#BLLbh82A#)`H,),!"'F
-*XEJ"cLqfT3,*U0D`@$MiJ3a-9@drFl"Eb-*JU"BbEK3C4qNjfrX'!hNpMQ!XB,3
-[KcTbE&rJf'UH9*28P)9,!S-(&J!B)@RMFR[!P#iH*4@L+Pb(N!$q50e[@aRk0GZ
-Mj'3#B`#3!*-E!k)c*3qNVUcD`kpSG+89bM"6*&G6dM*cfUJqr,RhI2J'Z4M@rKk
-Z"(rSkCh+U(+FcI+1qcjdcJjbcMa%$RF`9V$Q3c2*Vb1TQ8Z"369dl-XZrE%[m,0
-LJfYMYX'fXG9JUmj"H1N+IMLDT8r`8lmY9$l$e#EZX-GJPDhfYr'R%GVHMm4kEfG
-)GU#`-[)BjrFFX%8RG9436*0&%,)3L$!0851@KU0$1R5X!8h,LXXA"@CFe@U,MNS
-,4V&J)j))bb%JiKNimY'#"4LiFIN2)hADph`ADF'P#ck!P9FYC%RY)CBCh$39$"a
-qDBT'harSF#mP`(b&-D2Ke5jKc+dd$CK,*I)r)PCKdd50!$)H2##!FJDSdCN18G-
-A[3+8(+2%X%Qc9ScYZ*d+B@h!SCC2DqS8@-U4)$RbS%cMN!"+)-$KXV+M-+R5X6&
-Mm$d(`P``3%&B*b4mKT!!N!$#V&fpD*`QY$%KmiG$f[VfV'q$(&#[UTV)50fK'Yr
-G2%r%*[j&LbUC`X'8cjh+`*60T'JI@iiNrdF$'D5XmQ@TTJFErdA$iQ-Vk%#1)6X
-Fqa+&,mM4M5&QK+QA%D$,&cf,Mhe"TS)Q6S"@##20$A5e1"9rMb*3'+qAb%@[(Lk
-#%8-KEiFEB$-pm!$'A,Kdr3J"Y%-MkABq",!5!![9D!29q1N3I$Gj,%p,46K1)jZ
-8'`11iD`jY$*MBBf[%)c9QRBHSkQ%#GK$&)CH+N#9arDAb%@`(P1@![RQ5YN16GK
--V`D"VN-V@D0998NH6IblpMK0kmL%fCK9pFLTFLH%JY@-CS(%Qk6JeTS+[C)VbSp
-RBikBriD4A#E`F)US[CiF'[*H,5aN,Z-!6h!#dB`(h'5C'8GJ(`-lBb,h#c)(1U8
-VL9pUq%"'X'XY1mL66PBC(qBm90Hh5`fP4(Bq((Zdq+Pfk+K#*BS,m92'R$fd31S
-qE`DF+`U%!DT-LF'eE("ZC$kjlSLI1@G&jM1hRqA1*A!5LpKeM(d[@,r,@0Z&!BQ
-%L)k$V)-D"Y(1(R4J1!RA"J6aP'E*r+Tp!BBBlKFH+'*1+8NcbE(f'JH)j%Uq#`e
-@(6QPS%$KFP59P"F*lL4b$VNDNT-+'BFB'K[46)i+3r,q9Zj,3RL*UNphjQreGh,
-D!-Ij2*8pB!3L)j&2EB,6PA)h`HY9"lPel+Tb8jSVZ#Q"6C9!ZTFf`@NP9c6DPT3
-,%0XScYmK9b!NPbHfj`L8qceQbUfXQYV*MQjZP6Y5TH$ZJki1iH,Q#MDG4Q#Nbc-
-(-B3pK5BLjH4$KPlKD-`,fC+)F'"Q,hdbB$Tp#01S4ArrQS'B&0b0T%@251aAT'R
-2#CFeRi%lmPkqNicNJXU(V6R0R+,)l63ARcNS[)e'ZjL#-*,,f0X`3cB2!pA34,m
-IP"NX%(6L3VBK!5MPPN0,i3J6F("1`T8QU54lHTAC$Tj#GMP1e345&9LZm3)%!aZ
-q4*8!M`HSm0dTMXI)E0%M@0[&a)S'Z!R'hB@FUKG4*LL%+f%Fj[Tc)CJ$a*-(Tm6
-E!,d!S#Z8C6AFe`[hNRcQ%RI0EN`4h3+95#*k!@5QiHGa,0iABX&@XB+4U`'C&JU
-l%KRRHVJp'C(`Q@Kk(16%50hqDXdiN33j9#Ak,Ki9Jkj62!9Jmd3'Ueba,0KP1RA
-9dEP0rNqNR*mGr)0K04T)"R+IHS0,0!i*lV9*5P+J20p4ZJ8AkmT)H"aC`)9(R-$
-pSjeIFFfiUaE"fA4)J`F$)I4!4TTkaN*'3d2ML@'pJe8PJ!0-9X#P'C@,9J[*dVr
-@898DYS6F38'f+RN#XX,4&5#NT3S3+A-)!l12h-+TfJ-fl*h*l`ceYUjc&b[eQ8E
-hBjGG[[km0EjqCj`HL0+!#N#h*JGZV,aaGCqLCPS&"PXV'+b*6S(K,+Y3iG2R*Ep
-jr4[6RjMa[eZHMlBE*cmC+PDmhjMZp!pmVUaTAcH+!69qm[0+226KQ`prFVd5MmH
-i&%[(@B@5-lePc1'c1Cd&4e#UG$!3MNpNU&NR2rpQb98Z2JQ6qmlYEC*UR2c9k,+
-Uelq2PJ5lU,0!'Djj9Rq1UhpAr`l9YTSk"r&3'ULQb(JNU%A[3&L@QVmX5Zch96A
-E3*)$DjXfd%!e`C5`6jG9iA)QVd5RSi,H&@lUj9R*AJ6ik[b'39f-*TK*9@8d+pK
-NU&3ZjKPX)J`3BUA2aC4kPm2kpq@VpP520YkBe+H0JcT,Ql!-XYfAh%m$8-jRZQr
-UbHeX#!ea""e48YQ)B04+"K0P#X,[8'"a8I8`&ZhqSjkj'q#&cj``((r8)+BjQKA
-"a)Z@%d!T`N9IN!$aJ-H$8Bl#5E5!+Y$4Bk"'m3%EFL,iU!l(QKk9HjNe*1lj9fm
-*VJc"V()#eirBH,fiblCNE8MFEqVI)G+M&S#SR`rT8D89#"ATjj%mDap-@'*P@5i
-Yq`V,P!%D1"ICaiEm0LJRZpCDKi[FIhrdJ9Q,aCfME3T9NZ(LSh$#4q8e0'fS'VH
-@UdAZCBpQ0a+,RNMX+b%#C`Q3!,0S)&[keN@k88Pq9%hf&)1Y!T@8,dD+bDR5&LH
-P,RQS!)NiA4DZ"bj*`(i,9CjVX&"c5j2``af0hkYI3iqb@"&m'&Vr6hmB4-cCZSD
-1C(HTb+iDVlTU(0I[")[H+B"d&5,NY$@kHm6P0R%rBpj4aEa$h*AFcGZDEN[jPIr
-[E9NX6[XrfjLKi)hTC"[6fA4MKYki-6eXBkaA1#TkAh@)MGdDIXAbDe[65aekqkH
-rP2V2MApVr&YL8Vkf$%GfR8fiP`(m)GKkqK2p+l),Qbql%[f6c*hfG,D5a%IbG(C
-LGbFEZTaGGr'5[kii$bjh24F&4%QK$!*p*i04a[mCS8cN)KXbjI1cZjh6&@k1NaJ
-V9Z#kILSJG,*lEVCa,VUV&9kcLbh&idCD$b"4HP)`S*0a3Lk!)D1!URJqQMfT9cb
-M(ErG)qidR-*MTC!!m+jC)BSp[4-h)VeCIPYPbN3ZK(l*+-3U58H%"f&XfN80pa@
-Hcrrk'b5dlXH,eBjhIq1*ZIm`p*hre&+hffjF@aVT&d@R(pPk&"ArL`SX$mhhp9r
-+(-5@$4E4BlRiF,K%DNa1N!$`dY-pm2NA5)5IQ"IX8ZrJ3f"Ufb1rBc992'*UicX
-D%kMY*(hm8Ip6I"VBCmP2qM3CK+)D9#9T"f[D*R&aQ0STN!!DbCXXX2`k$a8G2)P
-q((mf*6H6qVljh2V$AQkDiBVdalJ0CLPHTr1EA$[%6VmMXR0arU&Tl+%DpfH[1KB
-e#89+TXK)D)q4NC!!YUE(*KHX[kXi09EPDV5)FhYBf#`NP6[a'!Lrm,RU506[Fk&
-jKfY53PV@9k,K5RX6GP-9ZfPll&89cYmA'#RlU2S%,S,M2a*Fe4M9ijLD0QQ6me(
-T$Jri#mim[cbcrFccm1+UM"0$aQQKM%,KQ4dL5`VQMZVleYhQ(UTbM+lp,![p&3Z
-fq@'Q')qdmD+VR"rGA@eC2kYYeLpMI14GHMJ!&YmBeIHi2(Mi#+m-$*d9KQB&KU#
-QNI#q6%S`QP-2#VVrJ4m@#`mZN!!BLjXQ'9Kd)cpV#6,h9$F$MAAG4ee[)"*8BEq
-+Q$+52dL,NpfScS2PZpMb(rbdbf1"6iHPdHmT)8@UTlHZpbUA[lJQ2AVXrZbAlNC
-0E2J)QI5&6&4c,kUk(K!H##"Abh2N#M%LkX8#SEUl`Klq"A6B)hp*kX&J9J`"9RI
-*)%mE"GA&('1CX"G)rVdRCU8UUV-+VAh#eU0bPT'bprm%SP2P#50c54MiI#9Pf[e
-TUZ`LLEFETb2a+4%$&D@4h5Y23%'-GYR%LZTjAEh9#j%JUG8V0pJfCPF[-LbZIUp
-Y6r8R9B)rJYj8A@"T!`(PJf',c%(915"6*i3RBI$+&J3+CY$aerlhVZ0i"*!!6Gb
-,kSeiT@2HMdCHp8k-[!S!!!*#!*!$#J#3!h)!N!4#H!T+RFj1ZJ!d6VS!*%*R5(N
-!!2rr5'm!"%KA5(J!!5)krpC1Y4!!)'d!E%k3!+Rd)MVrbQF%6V83!%je@Bm[2&T
-&8Np#CkQJ*&GCMbmm4%&838*RUD!J9b"3)RJ*##45B!ibf'B+-KTJ!N)C8FRrr,[
-*CZkTSkQM@Bm[2%4548a#CkQJ)&HJ*5"3iN!N$@!'-KM9Y4!!8FMrq+QM6R8JAc)
-B0"L`@&I*rrT+3QIq6[!Jr#"I-KJd',#B9mRrqNT#Crj1m#$k)&mb'$3BX%*Z#T!
-!3@d'd%""m!!#-""RrNl`!!!J,`!%,d%!"#)[!!J[A`!%51Fm!#3!*J&)3X6$+!!
-U!8K&b-A84%K#N!2!`G##60m!2#)I6R8J,`!%,d%!"#)[!!J[A`!%51Fa!%kk!*a
--h`#-)Kp1G5![!!3[33!%)Lm!##pI!!4)jc%!6VS!I#!"60m!M#)I6R8J,`!%,d%
-!"#)[!!J[A`!%51Fa!%kk!#a-h`#-)Kp1G5![!!3[33!%)Lm!##pI!!4)jc%!6VS
-!$#!"60m!M#)I6R9+J'SF5S&U$%5!4)&1ZJ!J4)&1G85!6VS!&N5!4)&1G8U"DJT
-%J8kk!!C%J%je,M`!!2rrXS"M"L)!F!"1GE#(BJb!`8K!-J"#3%K!6R@bKf)D,J"
-#3%K!J-&)3%K(2J")4il"-!G)4c)(6R8N!#B"iSMLLE+(B[L!`F#(-J2#`#i$5%I
-1`%K(dSGP#*+#BJ4%J8je8d"Jj%je!*!$A!#3!i!!!!aB!*!$B!#3!b!!!$mm!!1
-Tm%&%3e)$!!"B$9-$R1S'YiZ&ElRP&ZjU#kJ&,-#Y&VE`,r!YGe&Vp9i!!4lq2r+
-65hNQLaM%"%SP-R')#kJ$EAISXa!"!*!$#PM!!!`!N!--!*!&I!!"!*!&D3"M!(d
-!R`3#6dX!N!Fp!'!!miKF9'KPFQ8JDA-JEQpd)'9ZEh9RD#"bEfpY)'pZ)0*H-0-
-JG'mJBfpZG'PZG@8J9@j6G(9QCQPZCbiJ)%&Z)'&NC'PdD@pZB@`JAM%JBRPdCA-
-JBA*P)'jPC@4PC#i!N!05!!%!N!9Y!'B!J3#L"!*25`#3"33!5!"R!31)-P0[FR*
-j,#"LGA3JB5"NDA0V)(*PE'&dC@3JCA*bEh)J+&i`+5"SBA-JEf0MGA*bC@3Z!*!
-$6!!#!*!&-3"R!%8!V33%8A9TG!#3"3S!8!!F!4#)'P9Z8h4eCQCTEQFJGf&c)(0
-eBf0PFh0QG@`K!*!&#!!1!#J!,U!#!!%!N!0q!!%!N!96!(-!C`#["!*25`#3"33
-!53"&!5k)A8&Z)'PdC@dJGf&c)'0[EA"bCA0cC@3JGfPdD#"K)'ePG'K[C#"dD'&
-d)(4SDA-JGQ9bFfP[EL"[CL"dD'8JFf9XCLePH(4bB@0dEh)JC'pPFb"ZEh3JD'&
-ZC'aP,J#3"&S!!3#3"9d!F!"a!+`%!Np,!*!(5J"9!41)1P0[FR*j,L!J5@jcG'&
-XE'&dD@pZ)'0KEL"[EQaj)'*P)("PFQC[FQePC#"[EL")4P-JGQpXG@ePFbi!N!0
-Z!!%!N!9S!(S!I!#f"!*25`#3"dJ!AJ%PL%j6EfeP)'PdC@ec)(GPFQ8JFfYTF("
-PC#"LC@0KGA0P)(4SCANJBA*P)'j[G#"cGA"`Eh*dC@3JBRNJG'KTFb"cC@aQ,@9
-iG(*KBh4[FLi!N!0D!!%!N!9G!(!!F3#X"!*25`#3"dS!93%6L$T8D'8JCQPXC5$
-5AM$6)'eKH5"LC5"NB@eKCf9N,L!J8'aPBA0P)(9cC5"TG#"hDA4S)'0KGA4TEfi
-Z!*!$+!!"!*!&c!#1!1!!dJ3)3fpZG'PZG@8!N!8%!!3!``&L`!)$k!#3!``!+!!
-S!,B"(!3"998!N!--!#!!#!#L!4`!JP99!*!$$!"L!*)!m!'B!)9993#3!``!+!!
-S!(8"2!#(998!N!--!%B!TJ#k!GB!KP99!*!$$!!J!!J!SJ%F!)"993#3!``!+!!
-S!+i"6J#e998!N!-2!!)%)'pQ)!FJDA4PEA-Z!*!$-33!J!#3!`-d,M!Q0#i`,#!
-!U5!a16N`,6Nf,#""E'&NC'PZ)&0jFh4PEA-X)%PZBbi!N!-D"!#!!*!$!c3Z-!p
-6G(9QCNPd)&0&35!d,M!!N!--#e9Z8h4eCQBJBA-k!*!$#!FJCQpXC'9b!!!%-d&
-%3e)$!!Ch$9803b)5%HCHEK"N,4P%D[*%*!X3@DZQ*LHh2BZ-i(ERb%Qh-e2bQAp
-h[qrELM`EhmbhY8#5eFlXbH4*f,ilNa'5j9ENLDc)laq42j1IbEcCeRB454B6XMF
-Yb5)S31)(rdjCKT&84$LS#cYiiLGf)5c5J1e3aD%@GK*H(mq1D3bR6lpC+R)6)mR
-Y[@4[%r6@hmf'R%[)+8FIZEr5&V,ejRAjaL3*5bPTf0kN&a@6NPGC,a$mi-RK`KF
-HI%V$*QM4BN6+hFfqTX2b,*5j55k)jb(*(2h&i)XDJqim&Fee*9$cG*JIMZ6*i#S
-GjViNe#Xq)@+3!*h[`af,NK")heX@$ED[(5XhPA-`LA1fRcbNbSE0RBqrZ,m'l)Y
-Vm[NQUD!A@)"Ck2@aqNDT+'b%UlJKdF4%D4j'8D8QKLJRXm5(8JQR40@4X8N6+L,
-JmB-'82KL!,85ECR3J#8d%@TbLdfC`eLTT"qR$+aeU)[Di0J#T6DMFe4B`aLflrd
-NJ-)Z!m3jBTLiESAmcl%RFHbLl9fAJNh,JDRU`pD$+ZFdM(GdeX@!G"Z$#pDfYBX
-aSNc2)HBbh"2bA1lEQ20L2d(0f,[Q&#I)A'ZQ2(KBb@@qIDUNT-rSkShVZbh3b(2
-j4EE#Hi"%aD`5%YXK48JPi!JpjfESS#*')G-lpU&Zma9#N6ZP%AF+hP-PhjBJ16h
-DlDNc*qDmR%1jlK@TB-cEfPh+FK[jplG1#3aZ,GrmP`rLNbG@J3Mpl)N"@`NmD#E
-1Ye,'NV,SJ&0-'N"4lGDH(L15jV)kGQArf*KLjXEBBNT+ilSFVqIQ2L6S6,2!-qd
-r5A,SM5rZ8%e+qrrFIEa)TAK+(ePf3"KU9mH96KeiJM&J8-CCH2(UplHlTpQ8&pI
-V!mfS&!eYS22Y"H59K,,GX(5'$iDUN!!D1!1%4[Dm+R'd+EK+q$Ll6eBP[SHY1Jm
-&+*f0f9@c1LPl$U`!LB0EA#,N"l-#h9`&eEjM4RfXIVf`GZf$Y!rlJeGII3NEUUX
-[JA!5-Xp,Z*!!K9k#PFalib#6LH[)jR!53fYB8Y@+#cA4e!fZkRA5eL(bC5reTB0
-Nq+`1N!#ULm1*SfpKL@KA(V8&MK(J'6fDpK)ZJ-$X$'lTUd'pQXb1L-Hl60lqhlJ
-2YkIbbBfVNkBAI5lbXT26-1CCQI@i%dADZX@J'V("P$45$f-VG@mlh@!+D@pipZK
-GMr,CUC9ZcXXMqF'dI'XXGU%XA8IkajQ+#fPh$2Aj@FVRjqVrINKT#[0r9hl1a'B
-ar[EhjGLF9@FZ6fPZ&[UQ90aX9RVbi))fT0[hNY60m9Pip++5qIc2PqqBK`c8pE9
-GaLXRlhFHm(""&mY9YB2CTqfiUkZ$G385RX(1bd[ERX3qk'4JZaVPpDGj!R%'T["
-3[!PH+Gc$PhJ`"hHqIVA3@F0Eeq31!!!",d&%3e)$!!&Z$98,Sa,3(`,[MX0G"i1
-VS')4Q(4+"CeP@S'Clmb(SM82Ip(I(*K(D4A2I'$q&[0K9K8c&"2&r$@V5EkTU*K
-9439&phSP6c(*!"1aC5A+J0LHE33'eM"R5Q-Af($455FbMP!J*%5L5"VfFJe#ABT
-bVcRA4B@a96dp+RHhD`rFF&F@))QYk$RCaCMM3iY@r'%I9"NNRi3H&+6Nb+Ekq,R
-[CKIQhmVFF$J`VdQ5m'YemhE`p&D5E6j5(VmrPl$l$k3rXTPHl)!0@&jc$0ZABIP
-&mp&"JI!#DaENdTMml81I`#icTcGeq@6Upd1K&[m+1ImYiqD1UMI2ikh!"rA+h@G
-FD3IbmLC@e9$jp9!k6JUl9a2!KP1+'B$U)Bc230$[U!%J"*%91SCK"!!!#4G"4%0
-5!`!1K3jG#k55),ibhjhrq-jHjTcIRm3X@FlH1F3CSh%X80,b[R0QLXqEJ*aX40@
-UcFUD#%5Rl(e8JllrGqBa*dc)b``NKG+`*T5N3Y"1UPMIThV[djD9N!!b0-6@8G9
-SS`-*3XV@EJZ,ppfG(@H&VG9l$HjZ05)#-d3M(d0&9JkT3rK[IJhrMG+c8Cl(B+4
-U`aFMihF0N!#jkkJ(bAf)aK,IG)P[ca,IG-NC,*)9Q2S@4ApLIjK&+S'Id[Z4`Ve
-!C&F!hk33*VJjb0NB50)-%!X)p`RCp6"I8pTh4UI[+E8`dFID4ZkGr@lA$AQDlbl
-dTY[ZH@,hr!+XiD9#H+cpQa8c%jVX(JTT(9@GRD&+8bJflXSeSl4`5cY$Y5BUZhI
-&Y(p9rDdY9MhmA'a'S26RfD0D,'"MJPS)PR+'Y$*IGS48-42MQe(`[2"&@fPYS(Z
-$2,ZVS#hMPle6m-bhq8GG`NZPN!#-)R+V%99PNPlh36fhm*9bM*6G5(DLl6*[`RR
-N%1kYe0apJX"08h9pBpI"UeK@ZP%fDY[@f0f"j$FB'16,"hmb'lqqr(ZIF,[qqr(
-8P4F2LPmU8Y6lJ@,C*HD'0C[m5%SlDaYhr0f9c5@RlpTrl%Ba0h%pIrF&([T)hhC
-PQkhZV!V"p*ICGPYr00)ATYFTIIZZ+Zh!F'lqJ+RpekRmf5JSrZ#`Jfc9YhilkVT
-Hh9L([6AGJPqp[j5#5'i#SGl@1!l!f0$([Z4B9)JpbTMr8K%pV8&b'lM9+a*8%hV
-&U'bb498Z@DQS*MRZ&3U9S9IX$jNN*bhPP@UI8TA)Arc+eR608jlGh#RG(Y%mCIV
-ZHjY0eR5&1qC1dXc90emD5,Ej@(eFD1XV&rqi5CRVdF[i&43@eN[fU#"2lpYa(Vl
-C*ZUUNZp0XGNQB,2*LUI#aR9CrBK0&Sp+b8*6C1J9E63Tqf"5i25flDL4ELQ!0#R
-1JdB29[1P&-F&`EQV34i-5ZXME9iP2CJ#Sq!JM5UKU,HpAUd@9Ujj,Ce3erhrA2Y
-0)fVEk2m'%q('2UUC%2HLD&+GqD$mXUXk4$HdCk9'VaEk0mH(e6-fT4pmjRa9e3I
-09fm)JH',*UjGkCYBVDUp[eRI+)5dJF4`UL@ija2YP0UeSHUUm2!Y1A!N#i,p%r+
-mraE)KC!!h)mYI"M-*-j`h-92m%VhR)6A)GbRK)!S@)q!m3bE39ZF$L3#NlajP54
-K$2XaQX4Q&+bEm4`j1AMiN!!D$8bLH48j)NdQ4ZlPFU1$$j(RK3$Nj8cC#bja3Z9
-@VceajE1aV$3CP1@85*e1e)0Q)jGcLA5!ibD49*QcdSUIb6+I1lrc$,UNCTa,i@!
-(l&NX8Z!UXl)Fc@N10p%$TmlaarF12*%VqVQP+IbmGAC[Z(*i4%i0ElMdXHT++-Z
-e+['9N53H0#4Y9,3%Ib#8d),3L422HK!GJGBFY,LYf`X9ljIeI"9HZ54kVCUF308
-$Ta+%AGi0FXiSpX5"dhYD$!,RQ3U0(P3fjfdBeq`NrZ'e,erl6RVGI#'mVR"`phb
-T-2,3[')Sd$cb3&!%V`adK&KR!aa2Y%%,Z,h0rNH#iVJi,$5IJe1*KV4GN8AeTLJ
-dhii*%jh+4+0lL-6G`Gb!1(p'+l"R#Xqlj[FAI)G0QQ+9i'Uh+QCdXfkhYb)Q$Qa
-("&X5L'&#mPXXm@0)Ucd%5eJUcINKX48pJ6d%PbS*K&[ci9Z%V*(I3hJPL`MrdJS
-I3`D53``T(FqmS[EkqkCA(rKLZIm!-KZ&[1GiTPFGl*ZpSH[blmr0kANl3fU1pr3
-DII1R0R@Yr)*!qJH3!1C*GFpaYEH[Hmh&ZN*A@%M6!%pD0diEiCSl$VHQjr`k#`[
-26@IZ9DI$daI6KAA2pN(q9D3Y+FMIp2MMdq%6Qblq,Td1hibPQPH&k,ZJH0C&,1f
-SJfdU0CD1i33[B404!YdjT'r8eK+UMqe@Db3GV(dcl%e2@"m1dpJq%Rh(6&#9H,q
-%2[!CM`9RLm[r%li9iPZYi6IUKXJLDiC`*LQ1j@0C1-R3A,AUd"L@,!$X'#)f9Q`
-GU4qjDTIlE$mqA(M5%LlfVkUm(4R$6f-Y*2qH0D6p36il*,[YSYC3Ef@,rIqX9*l
-!Ebf0'B$Bc0CR("AbR`1@-IY,[Y#8e9pF9R&@mL*83(aXZ8)Z"La%VB`"J[[p584
-Bj!eI5+Z3!-m'FQle8ke"Xl)9E+f!P-EiV3U5Rr1e(UmFZASXGdNpP#jSPS%Mep0
-4%N&XLQ8J!kB+PhfShJLZT1Hk&EZ'!AIMZcc23,,Q+,p414k9S,B6,'a82bfhAaY
-ETNrA%56ja02ZG*T5j4lME!"-qUA2Y$MMJiY4T!6X@Z)k)D`B8d'!AjJ-cVeXTE3
-(16-(E(Pb4Q#Tj'@9#%5hl5$Glld`DH2L9KVmeH*EFa9hpIDl1`$QYF(BlY&bTX2
-dqBA$reLmd2TDRl(Y0,(GBIAPhAX"rrC*9qj6Dcd$H#M1@jc&$Y'NGA48bXlAXh*
-S@kH!Zkfbli`-Z2M"q(b&pHX4I'G4%de6YE9A(RA@qh)a&f[!UpMFMmNq0q"eB[p
-iVX)kEUcG1DPY3V0$`62A6#EC@@pc!%i&h!kia8UMBYEe3)A945F$!Zi8m+KTci2
-1HV%pT#rHl4bkG*dEl!9mF@EmL(@Qr)X@N!!HQJGM-lYP`%2C`r@*QVC6V('0%["
-TN!#F,[k0%(eX#hU3!0aHNqRj@JSe6JF*I04KqTHADUE2Tc,B-J[*j9f1hMkq&-B
-!U*!!KfX`AB-8B"Ah@IS[4f&li'IQ$1CAe9if%aiqGN!&Q%S4&CiQhDIf@FS1cNU
-jaA2YaBpQiQbY3i'CP4mCLmX+L8rILUK3`8dZHmjaV0YkRM[jP2ccRlVip*4Me-q
-APMjP-@A,$9P,I85&#Ulqe@iaGfcqU-aPXh*qlF1-@ZZSlH5C1mA0TJqUQTkf2j&
-8)5`qd`4i3-FVSVN)cQ3YT[jL52V`9&+&J$mj!EMGASjQX`p@2&,*6%A`c5D4[Tl
-00DT3H*AkL5leI''P)l9im[YlhCrhTp2DG*J[E4#Y4L*[6e`je+K#q,'4%64@!PY
-K&Z!k%mV9AKd1kGd&SBA5Q+kqLIFl@5H@2&IJeq44!*!$'!!d!!!"(!&S!!%"!!%
-!N!8$k!#3!j3!N!-)!#!J!3!#!*!&('&eFh3!N!-"4P*&4J#3"B"*3diM!*!&J!#
-3!`G"8&"-!*!&!3!!!3#3!`+!!!!%3!!!#5!!!"13!!!!*mJ!!%%%!!#"!J!"!!%
-!!JI!J!32i%!)''!J%"[m%#3DP!K-'[3NRc)%-N`ek2NN05Jb%$Ii*!J`i!J%(q!
-3!J$!)!%$m%!!J!#!!%#"!!!JJJ!!%q3!!!R)!!!%N!!!!!)J!!!"3!#3!i!!!!%
-!N!-$J!!!"m!!!!rJ!!!Im!!!2rJ!!(rm!!$rrJ!"rrm!!rrrJ!Irrm!2rrrJ(rr
-rm$rrrrKrrrrmrj!$rRrrN!-rrrrq(rrrr!rrrrJ(rrr`!rrri!(rrm!!rrq!!(r
-r!!!rrJ!!(r`!!!ri!!!(m!!!!q!!!!(!!*!$J!#3"#!IU5!a16N`,6Nf)%&XB@4
-ND@iJ8hPcG'9YFb`J5@jM,J!!&8J!N!-"GJ"1F8U$CKT"l3!J-,`!#$&m2c`!!M&
-m!!%!"$&mUI!!"Lm$,c`!!"5Q3IVrd0$m!+)[#%+RB3!#*Ylm!""R%NU$C`4`!8j
-e6Ud!)Q%!!pDTp%ja5S0Q!URdF!"1G@"b38a"4%4$69!!!`#30&"b3@e)jf$`G$+
-I`Lp)!#!J6b*8-@N!&!!B)8!!*$&m!!%!,0+4)8%!,U!#hm*-h`m'6R9+1!THC``
-J+J!)C``J3#!3C`B[1[q%6R9)jam'3IVrRR!-)LS!"-+i!aTKT'B!!4*)H[q16VS
-%i&K2X(Vr@QB!!1bK'Li)##S!"J!%C`BJH!+QS"XX+J!%+LS!#"JU!!5Ae*A8)$V
-r9U%HCJ!!c#a))$Vr5L)'`VJ$'PK"B3$r8L!krd,!Z!-D3IVr2L#!5S9Q"+%LB!3
-J4D!RCJ!!Q#T),cVr!Lmkr[S[1[lb,cVr!Lmkr[T)H[m5,a!J1[m!8B""q[lf))!
-J$P#!3IVqk##!5(S!HQ%!#L6Hr!!J5N"R!URr)%kJ(b"(S"Yb!")%j`RM'H34!!%
-!)!)"!1!J6D"T!J!!(i!")%fJDYA8ep4"q[kB5T!!C`K`!D'BF!1KQ#"0*8J!#(!
-!60pJq%je60pJq'!!rZ!J6U!IeG6Ae#"(S"X`1!)J-F!+B*()B1"19J!!51F!1#K
-Z!!a(q[jD4IVq@L!8X**Y"#!5+)"+J'm5)&-LEJ!)SLiJ&0'6NC*`!'!%-$crf8c
-I(!"1ANje6PEreNMR%aJX,J!35IVpmN)(S4SY52rQ5Li!#fF')(J#TU!E,c`!!+$
-m6VS#RLe!rqTB6fF!!Ai[,[rU6VS"q%S!@%pR"R!"B!!"FNKZrrK)E[rd5'lrlNk
-k!j)J,[rdS4iY52r`6qm!$'F!!8JJ,[riS4iY52rmC`!"1LmZrrJ[#%kk!qC+VJ!
-88%pQ!!#8@Bm[2%024%9`!$m!U"mQAb!,ChiJ%h)Bd)%[!%kk!Y`-3!!$@%pQDL!
-0FLM3J5e!rpSJ%h3Bd))Y32rH,`"1ZJ,`5-!Y32rL)%ZJ+5!Zrpj3J#P!!#KCMbm
-,6VS3d#!IFL#3!)%T3!!X,blrr#mZrr3[,[r`,`B[,J!-5'lriLmZrpT)H[kX6VS
-)9Lm,UD02l`!N+@lrkJ!-+@lrm!!3+@lrp!!8+@lrr!!B,c`!!+'B6VS"L#e!rpB
-[2!!!U*p1ZJ&k)LlreV#"9X0%!dL$5--T3`!F+8B!)#PZ!!`!*%Kkr*!!2cbJr#m
-m!!#Jr%kk!54BMam!6VS3@#mm!!#KQ%kk!6T+J%r[!!aR"%kk%&B`1!&Di%!-3!!
-'CJK"qJ!D)FJ$2(i")'lrjU!E%!G-lKM)rm*1ANje6PB!!%MR!4K#"bmm!!#Jr%k
-k!2)S3#!-@%pR5#m-6VS!8%S!@%pR2#C-,bX!$$mmS2`[2!!!S2a1ZJ#L@)mI!%k
-k$pBJD`!3S"mJD`!BS"m`1!&Di%!-3!!'CJC`!#(!!caq!4!(61iBJ2rd6Pj1G8j
-@!!")ja!)+'i!#(B!$+a"6%&%!!*Q&!bX4%008!!'CJT`!l"X!!TQ!RB"%!0-lK!
-)rrK1ANje6PB!!&Q22cbSER!"(`"1ZJp-@Bmr2+TZF!%I!%kk$ciJ(l#ICJB`2!)
-!B!3`2!3!6Pj1G8j@!!![!c!m#!$!EJ!+FJ!b!%U"8X0%!fF%F!&J!R!!*Llrr%j
-H6R919J!!51FI!$iZ!!T)abm(6VVraKS!F!!3"3a!!!&B6fB3!NF(rdkkrhb`4fi
-%F!"J+PQ22cbSRh!"(`"1ZJl#+"pCMcm((`91ZJkf,"qiKPI$4!0R"(!!B!)J"Nc
-Z!2Mrl%jH6R919J!!51F4#$iZ!!iJEJ!)+&"f!(!!-"3-J!!!384Q,R!!-#`!!Jb
-!!!"$8QBJ$%IrrfFB)#`!"%*!5%$J5#)m!*!$rm+!5-HqJ@B#GJ%3!dcZ%)Mrp%j
-H6R919J!!F2m[!%KZ!!K1Z[qB5J"36fFD)'i!##!S!!4#3%K!i%JL2!#3!rr#J$!
-"B!*`rdjH6R919J!!F2m[!%KZ!!K1Z[pL5J"36fF3)'i!##!m!2q3!m#S!!4J!R$
-r6Pj1G8j@!!")j`!B*Qi!%#KZ!!`JEJ!)-,`$!A!!+)!'P!!!!53'P!!!!NJ'P!#
-3!b!'P!#3!i!'P!#3!i!'P!!!"*!!"T3!!!%N"T3!!!53!!D8!*!$I!D8!!#!!#D
-!"T-!N!-N"T-!N!-J"T-!N!0)"T-!N!-qF!"-lKJ!rrK1ANje6PErp%MR%aJQEJ!
-),8[rp!DZ!*!$*2rd+'lrp!DZ!*!$)2rd,@lrp2ri"Ui!N!0)rr3YE[rdrr`'VJ#
-3!clrp#!Zrr53!+i!#,#Z!!aM"R"PB!!!X%*(3NCJ4R!!-!F-3!!%9F0%!fF%F!"
-J$(!!-!GCJ()%6VS0)R)!-JFAJ"J!F!!`"b"ZrrM3J$''#!"`!$!(%$-)!()"iDR
-F36!(8NG`!$!($%!!*'@`3NGm!@"'F!!`"`a!!!&9`d3$C`4`!'!-F!!`"e1!FJ*
-1ZJc-FJ!b"aQ!'!"`!$!()'lrr0#!-BB)!(!!-!F30!J!FJ(KUGa"-!G54h!!-!F
--3!!ICE"`!%cZ'-Mri%jH6R919[rm51F2'#CZ!!`SEJ!83NCJ$R!!-!E3J%*d#!!
-`"P*'F!!`"R)!-Li!%Y+"XS"ZiN*'H!*J!!#D3N9#4h!!-!BJEJ!)jB!YF!J!rra
-JE(!"`+lrr0j!F!!`"A)!-JCd!"3c'!"63NM#Y)"[+(!!-!I3J()!-M3)!%U"CJa
-`!$!(d)!jK!J!9%4`!$!(d)!q0!J!B"K`!$!'FJ!b,J!5dS(5J(!!-!I3J$Q"#!!
-`"9*&)#lrr1+),8$rr(!!-!9b!$)'G!!8-aJ!Y%"LJM!'8NDmEJ!5C3$rBNcZ'2$
-rj%jH6R919J!!51F2'$iZ!!iQEJ!3+'i!#$JZ!"Bk"qC0F!!`"h`(c%"q!(!!-!8
-30!J!l#Kb!")!F!(!!A)!%J$HJ5!(d)"b!$)c#!!Z!9*'F!!`"R))XS"Q"N*'-!9
-54A!!-!63J,#(BX"`!$!%d)!L"j+!%!&-lKM`rqK1ANje6PB!!%MR$`Ji,J!52Li
-!$LKZ!!Jm"qC1F!!`"hS(bN"`!$!'IJ!H0!J!F!!`"A)!-J65J1D*CbT6J@F@8i&
-Q)R!!-!C8J()!%M3)!%K"3N'1JA!!-!C5J()!%M3)!1'*MS&`!$!&i+p`)*!!"(,
-ri+R#Kc!"61i3m2rX6Pj1G8j@rqT)j`mB*Qi!##KZ!"!'VJ!!!53!&!DZ!!!#5!!
-8,@i!&2rd"Ui!N!-J!"3YEJ!8rrJ'VJ#3!i!!&#eZ!"6rr"!6jJKb!")!F!I!!A)
-!%J"536e"rqS3%q))FJ!5!(!$`!&b!")!1!&84(!"kDJp32rbF!!3%h*!`J"`!"!
-"28$rm(!"kDK6J$e!rqj`!"!6FJ(#!'F+F!!`,[rZ8i"J!R$r28$rl(S)5Qlrm'G
-@,bi!&#mZrr4`!$!Zrr)[!#!,8S![!%kkrcKb!$)!ji(D35mZ!"3[,[riF!!`,[r
-b,`![,[rd6VS)I#mZrra`!$!Zrr)[!#mZrr3[,[ri6VVp)Nr[!$"#4f!!!2C+E[r
-`Cc*`!$!Zrr)[!#mZrra`!$!&,`![#dkkrGjm!"`!F!!`"L"Zrr4b!")`#!$D38r
-[!""J'R!!-!3[!(!!-!8[!#m,6VVq,M`!fN42l`!-['lrl'B3-!G54h)!-J"#0"J
-!B!!!MVaZrqjQG%TZrr"R-R!!-#lrmLm!,blrr(!!-!8[!#m,6VVpF(`!(!"`!$!
-')'lrp()!%M!)!0T"6qm!%'!DF!!`"#m!F!!`"5m!,`Y1Z[h!2!$D4%r[!!a@4Q!
-8F!!`"e1!FJ!b"aQd#!!B!$!(8NF`"P0'5N"Qj'!5%!E3,[rV-JG54h3!0!%CJ#J
-![Qi!$Q8!r`C`!$!&AS$QL%cZ'2$rdNjH6R919[q'51F2'#eZ!#6rj!DZ!*!$*!!
-N,@i!*2rd"Ui!N!-J!#3YEJ!NrqJ'VJ#3!dJ!*#eZ!#6rq#CZ!"c@r!%Ne[`#50E
-m!#$@r!#!e[`!J#e,rpM@r!53!#e,rpc@r!%N,8[ri0Em"*!!,8[rm0Em!(`Y5rr
-)er`!!)!!)!Z3!+i!(,#Z!#"M"R"PB!!&8RS!3NFJ,[r)d,`!!)!!,8$rc#KZrmJ
-YI!!!J!$rr%KZrr`[,[r))'i!#%k3!%UZrra36fB'F'GJ!!8B)!a5J,#ZrmaMC#e
--rlSYE[r-rliJ$&+!N!#ZrliY32qf)#lrZT!!V[r),8$rXL!Zrlk3!+lrZLe!rkj
-R$#"-)Qlrb#!ZrkkL,LKZrklCl[r)5'lrXLmZrmJJEJ!)6T!!)#lrXV#ZrlC36f3
-'F'GJ!!5U(9crah!!%#lradM!d)"63$e!rqa`!$!Zrqc3J$e!rqiJEJ!3)"$3VJ!
--,8$re#mZ!"`[,[rF5(J"*#m-6VVmG()!-J"+JGR",bi!(#mZrpK)H!%N,blrh%k
-k"E`[,[rJ5(J"*#mZrp`[,[rB6VVkCLmZ!"`[,[rFF!!`,[rX,`![$%kkr#jb!$)
-!5S(C`5mZ!"`[,[rBF!!`,[rX,`![,[rF6VS&FLmZrr"`!$!Zrq`[!#mZrp`[,[r
-B6VVk'(S!3NFYEJ!-rp"2l`"JB!!$X%*'B!!!Q(!!-!G+J'Cd)!a5J,#ZrmaMC#e
--rkBYE[r-rkSJ$&+!N!#ZrkSY32qL)#lrTT!!V[r),8$rRL!ZrkU3!+lrTLe!rjT
-R$#"-)Qlrb#!ZrjUL,LKZrjVCl[r)5'lrRLmZrmJJEJ!)6T!!)#lrRV#Zrk*36f3
-'F'GJ!!0HHJ!D((i)F!(!KGa!F!!`"L"Zrq$3J$``#!$LM6!(8dG`!$!'$%!#5'8
-!rf!%4J*)F!!`"Ja!!3"N%#!Zrp"5V[r3)%!3KQ!!!ZS%4J%!F!!`"L"ZrqM3J$J
-`#!"`!$!')'lrj()!%M!)!$e"rm*`!$!Zrm*+J'-!!+*JH#!-8S#`V[r-Bf3Y62q
-Q,@lrc2qU)!a5J*!!V[qU,8$rSL!ZrkD3!+lrb#e!rjiJ,[qUN!#ZrkBY32qDC``
-J6#*ZrmJJ,[qDSLiSE[qDfHlrb%KZrji[,[r))'i!#%k3!#!Zrjk`V[qL8%pN"R"
-RB!!#G(!!%"c[U)U!8%G`!$!($%!!''-!rhj`)*!!,[r$F[rJUF+&f%&`!$!Zrm,
-JVCjZrm*#4Q!!!*K`!$!(5S"QG#!-8S#`V[r-Bf3Y62q5,@lrc2q@)!a5J*!!V[q
-@,8$rML!Zrj+3!+lrb#e!riSJ,[q@N!#Zrj)Y32q'C``J6#*ZrmJJ,[q'SLiSE[q
-'fHlrb%KZriS[,[r))'i!#%k3!#!ZriU`V[q18%pN"R"RB!!"b(S!'Kaq#(!"`)A
-F3(!!-!BJE[r`d)!m-!J!iSd`"e0(['lrlQ8!rf5FE[rZF!!`"L"ZrrM3J$e`#!$
-ra(!!-!BJE[rdFJ!5-!J!28(r`R!!-#lr`NU!B`!!T'"i)!a5J,#ZrmaMC#e-rkB
-YE[r-rkSJ$&+!N!#ZrkSY32qL)#lrTT!!V[r),8$rRL!ZrkU3!+lrTLe!rjTR$#"
--)Qlrb#!ZrjUL,LKZrjVCl[r)5'lrRLmZrmJJEJ!)6T!!)#lrRV#Zrk*36f3'F'G
-J!!$qF!!3(1qSLS"34h!!-!F-3!!BB`$rIR!JN!!Zrm0brq#T`SA6E[r%F!!`,[r
-#i+fHE[r#F!!`,[r%5S!QE[r3Pm#hlJ!-C6BJE[r38Ulrd"#E)'lrd&+Zrp!3Qb!
-Zrp"5V[r3)%!3Qf!+)'lrd&+Zrp!3Qc!%8d4+3'EZB&C@4#!Z!"M3VJ!8FJ!b,[r
-%*#lrd*5Z!!b5JLC!Pm&J$L"Zrp"5V[r3%*X`"&0%5N4R$#!Z!"M3VJ!8X)YLiLC
-Z!!aJ#L"Zrp"5V[r3%*X`"&0%5N"QlL!Zrp#`V[r8C3$m5#!Zrp#`V[r8C`4`Cf!
-3)#lrd*!!VJ!-)'i!%##!F!"-lKM`rfj1ANje6PB!!%MR$aJQEJ!81#i!#LKZ!""
-J!!%`2!3q,J!18NDmEJ!1C"*`!$!'FJ!b""!d#!#`0"J!CHC64lK(C"*`!$!(FJ!
-b""!d#!#`0"J!BZLq4Q0)F!!`"RS!'M3)!(!!-!Gb!$)''E3)!"J!F!!`"aQ&#!"
-`!$!'d)!k-`J!F!!`"p#!FJ!b"Y+"0l-)!"J!F!!`"p#!0i8)!'##Z%GQ"P*%B!!
-!SR!!-!4k!"Sd#!"`!$!(FJ!b""Qd#!!B!(!!-!FCK3J!F!!`"0#!1M-)!(!!-!I
-3J()!-J65J6Hc#!!B!(!!-!I3J$H&#!"`!$!(FJ!b"*!!JA)!-Li!$R3!0!G5JT+
-#XS"M(Lm,,`a`!$!(,`"`!$!%,`"1Z[lQ1!G54%r[!""J)#m,,`a`!$!Z!!i[!(!
-!-!G5J#m!6VVqa$e(!!j2l`!3F!!`,J!1FJ!b"*!!JA)"XS"Y!2l!61iBm2rS6Pj
-1G8j@rra)j`mB+'i!&!DZ!!!"*!!8*Qi!&%*'B#"`!$!')'i!#()!-JBCX!J!'!"
-`!$!'d)!hKJJ!-!C54VaZ!!jPfLm,,`a`!$!Z!!i[!(!!,`"1Z[j)3NC2l`!3B!3
-`"P*'['i!$Q31F!!`"R)!%M3)!%U"CqK`!#e!rraJGR!!-!C+J'-NF!!`"R)!%M3
-)!(!!-!C6J(3!&$3)!**#5-%J,[rmikJY32rmF!!`"RJ!'$3)!#SZrraq!'!1)!I
-ML()"`S@#J#i"iSd`"&0%5N"QkR!!-!E3J()!-M-)!#"Z!"$PJ5'('!!`"P*')#l
-rr&+ZrrbmEJ!1CB4-lKM`rq41ANje)PmJAk!P,S"U!N+A6Y%LAa)I-"p+!@F%TdC
-J!U0',SK1d5*I%Km`(b"I5J&R"+C(B!+L4dl4)Pp`!D'B6Y%L,`!%)#m!#%(k!!S
-bI!!#6[#5rQ!'6%%)!8je6VS!*#!"6R8L,`!%)#m!#%(k!!SbI!!#6[#5rQ!)6%%
-)!F0!6R9+J'X85S&V"Nkk!%C1G85"6VS!2N5"6R9%J%U"D`T1ZJ!`4)"%J8je4)&
-1ZJ!N4)"1G5)[!!3J,`!)3IS!#M*m!!*1m*,qB!K-33!"`d"1G6m"5%&+3@BF)J"
-#38K"C`U#edK"5%!`!8K!J0mb!%*!5%"1G8K"2S)[!c3!*J&b!8*!5%"Q$%K!-!*
-b!'!@dN&P%Y4#dB#`JfAdN!#$dN%)`3!!C1iQ(c3I6R8!!!%!N!0AHJ!!9RS!!!*
-k!3,f[$J`!*!$(!*U!"&%394"!*!$NPT&8Nm!N!1H4&*&6!#3!kT$6d4&!!-!YP0
-*@N8!N!2Q4%P86!!(!2*"6&*8!!B"8P088L-!!!'QGQ9bF`!"!E*69&)J!!%"bP"
-cCA3!!!(L8%P$9!!"!Hj%6%p(!!!#"NCPBA3!!!)53Nj%6!!!!Kj'8N9'!!!#+NP
-$6L-!!!)fBA9cG!!!!N)!!2rr+!#3#Irr#!!#M!#3"[rr+!!#[`#3"3,rrcJ!!X-
-"![DF!!(rra`!+SB"![D!!!$rrbJ!,-`"![A-!!2rr`!!35i"![A3rj!%!!!Y,!#
-3"!3"rrmJ!#dk!*!&KIrr*!!YZJ%#pR3!Krrr!!!Z%!#3"BErrb3!,Q!"![C-!)$
-rr`!!,Z)!N!@errmJ!#p!!*!&J[rr!!![XJ#3"!2SrrmJ!$!3!*!%"!(rrb!!-$`
-!N!@#rrmJ!$"-!*!&KIrr*!!`A!%#pP`!Krrr)!!`E!#3"BErrb3!-(`"![CB!)$
-rrb!!-)`!N!@"rrmJ!$#F!*!&J2rr!!!`V!#3"3(rrb!!-,m!N!8#rrmJ!$$d!*!
-%!J#3!b!!-4)!N!3#!3!()!!a)J#3"B$rr`!!-5i!N!9rrrm!!$9P!*!%!qMrr`!
-!0TJ!N!3$k2rr)!!rX`#3"[rr)!!rc`#3"B$rr`!!2pX!N!@!rrm!!$rl!*!&J2r
-r)!"!"J#3"[rr!!""#J#3"!C`FQpYF(3)a#"cG@CQDAM(93:
+:"h4ME#jcC@%!39"36'&eFh3J!*!$U[S!!C82!846G(9QCNPd)#KM+6%j16FY-6N
+j1#""E'&NC'PZ)&0jFh4PEA-X)%PZBbiX)'KdG(!k,bphN!-ZB@aKC'4TER0jFbj
+MEfd[8h4eCQC*G#m0#KS!"4!!!+Vk!*!$FJ!"!*!$FVZT$D@P8Q9cCA*fC@5PT3#
+PN!3"!!!c!%#d(A&cYA@&T`#3$318HJ#3!mN!#QN8!!#U-3!&G'0X!!"plJ"p!"!
+"f3(!!q!!N!-"!`Irq2r``d!!!)!!N!HPN!3"!!"!!!#dSEb`YA@&QJ#3!h)!!"l
+l!*!$FJ!3p(`!!Gq)!!!GcJ#3"!m!3Np"Ae4ME&0SC@aXFbl2J!!!Pla069"b3eG
+*43%!N!q!!*!(3X(8l2p5hM-$&C9ribC2'j,ULBN*qKDqd#'1YLX&QfqFP)&&aU1
+`bJbB$#pqB6Z,dNYIZ&M+&rKa+M(Z[NphH%[fj#J529$lZ82SQ*hD8*h%!aT3kpS
+j5-Pq*b&LiZFM2AVQ%85qik!QZSAd%"0B!Da(*4!lBQmadjIRR0MNc-@1a43-Bf0
+R#rR$[F$ZN!"e,*iqp[I`UMble)lKD5AN@LCXcI0b*b[8D9)cdE@DN9TKdKS#H4!
+[(66X3D59CGDBmrE6dDq0,`"*'d%'(3i$!r1V#+&JU5P&C8PrXq"T`8bBjjGe%8L
+kKl'aa')@MQlj9Cp))PZCM)b,EX&cKJYH-d%eScP@)MhmM40bq6@6Q3"SIB%0I8k
+`dKmMbl&5)PeQqE(3$"!3UBJ`"NhF!+[re)Tq96+qLH'"LmG*m6BT-XYaY!f-k9q
+qRkLD+K4N-S$%U!,XBEKZPSjd4#EFV4q0`-EB,3[fp-&BTX`8)Jb$6`'4X(6j#BD
+0'J2@B`+3!)$4Y9cD3em!iVf*@&$,#kE)Kc-hRK)k,$@l(8'[leU`i"UP2$Gp6FN
+fEr9iIKV[Yhbl)@,8H$kM(&@ZqTQ$##J3rZ"9[U$b4qKZH[N,9ZldAqp#X*k"HL)
+QE#2+ZRDr'VG8[S&%dX62Gc4!XJVfEU@0'3[9+9RRfDYNhApb&[UXDc2b+64)-1V
+ZY1-amDKqY,aYC-f"6YQU4S#)fdBP(U#2EdKRD1K"XM9V%bS$*`*2$%GfA[D*&QH
+#8#MCNkK",CPC@1JrI"FC"IIj,(H[9D"mJlb)p3Yr(1NJ39AiVHq![K+Rlem1F(Q
+1m+1LKR+de+d+8aL9j$q[e'Gq4&meFp2[+kS)D8i[)&8jR69YVLrZ-*`!,5")kdp
+Dir1QSi6,h#H"1@5hIe9L)BLRaGbX-+ahh0m4qXrCdV8A3,@5ICdT`U,`,bNLGEb
+SeF`UY-624'H4-)dU-cVPb$+IlYABlkF[!#mj!de3MZVPDPNjja,5+qcR1J-ZS&&
+P"a'@1rp58h2VKkfEh9T8+q`4(hb`qH``[c0F,j+&FM6)2AcRad9PkrhNYKMX*da
+A5hB6p&3+(%8S5Aq9YJ@MhPpP`8p&iF!I3)UCR$ei(*4[U1&YcpU60)'2GN4cqLS
+Yfa6"'h0P0Dd@TmPY@$Y0"MFVY,0F39'T6UQ%['428dZC2`MSr'k6aKZ6d#3(GDQ
+UScLm!)K`SK9-2[$jiJADf3"VrXe"iaa+5TrMmNa)H6X,iZf8@4A8S$mSbF#*df&
+FGK*fehqPEC!!q@IaSlrMlb-i-VX8H%mM-V#05-Ga@G!45#ISlkhEHpeF&S+"pkD
+lqf!E,40,$'a@)0V&R4Rci5Mi,$+[-&G3"ZAPdY)-6#96EVV`mHPd)%I'H@c+,8M
+hU+CU[%8dL#AZUZ*c!'(kd2cqXPcjXB$XD(aJa%TZ5Hd([h[mb`%l1D,NiY5Ac-,
+Pj&EBhPhHRSj6"Q0$jaf0$F,e,$K1m!a6qrk@UDc'ZlXaTmD4Y!eQD"q(AVq'%0)
+kkRkX)ZC8$CXpX[,EEAF"LBTe'AR+leqpj6*-SZ'-Fd+Fb!IK%HKY+Se!jNde6R8
+lQ,M5)(TEBkIc&h4ekhTrS`%V3*0S&qd"EL4M15EPimTP90l'fi$60)M9jB5TC,i
+FL(FcZ&X#&S$eJQIVJMc(Ga*c`Ep+$SQCG0[1309C9Z'1Yfa-LJ1&K([rq6XJ+AL
+-lI)NeA!G,b19Rib6T)DD&Ea[TJc&#RBAGHL8ibITA@$P+-Ii1XXM,j+V"VZJAc,
+[!+9(HcYFGJ(aH'T%F9'MM)lTKA`&FiUE0m6kE$01%8#KcaB2(e$S*cFi+mT`-`L
+3!%GACdJ%ic@EJUH&ZZNBTX)6+BcMf'BHUdA+$LNGCM+f%ZRYNA1!j5`DL`$mh1[
+pA#6c$I*CiP3BZBI+h`%Mlj3L2G%65RBS@6KBc6D$$9LBD0#Ppa%`HC6FAV-J,e!
+G$hIP-DP#cY+f'd,BR6f@@0*%1c'r+kra`cE&Mq`$D2mq4'EEC@$G!,)Z%IJ(QHr
+A'a@0QmFqS6,qKSBjZ5e$I#$P@[dE1*2F@NAGhaJ@m3VPKS+DZbfZI4Jk-q15[AU
+1fQ5LVdc,ed"Z+`PR!9c9f"E#B-[Vp8bZ)A'@82Zh'ffKRG5kJV8f2R'25)QEkhI
+Bm,j64@Xe&C-lVL9CGNhc$9qXScZFF)m$"S9"C9c1K8TX)bC!h#$5c80(8ALBakU
+SbViMhll3JpHCr$pqa&l&2YZ8M'hVHbr8k&%Nl%K1Jq0)h"`q#I+3!#-(GHYjH#1
+`&13'BDl!6(V#`[+iY[F,`Pbm+frfN9MGLe&FakGS)'4'rGddIZhDr-l88-$NES#
+FY(1iXPA'P&EU"&'@elHH0ZqqqlGjTYaV*KDSJrdfYJ!$3HH[@C5XCdXB5!XUI)M
+rJjETV+q"4Hh1#&TT6p*e3NN[@(U$1ZUb4mUh&'0(LVSRI,r8J9j#6K)be5)VXA#
+f,YmcmT!!jLqj,GA*)L0)UMqa*bmMeV(i2FP,CZ@lXqSE2"cP-QbNim1KNq(QK"#
+leJ0i1c3VjM-`IHkF3#m)4Nc02Abp"!1pTCM2fjTRLF4X%qB3PaCGUBrq0Y(3qMk
+ZHM&4i`2eX#i@DP39eHCDb5f-ZhN&V,#8VVIYAj@82NYGKZ6fN6&*Q"HQc`FjKLY
+#Vc1KE)!)3HAA9[IL2,U%'XeB+HhS2HT#Tkr4Pp%eI0-9PSrIX#%`aS%2a6L05q-
+*)"XPL-fCG%0XbSM&0SFlm,,IV5-(XKUjhQE4eZU&CH-58"8*&N,ilIfiL6JbhL#
+!&1-JQJ@4N!#VQ*k1VF2*3Dd56aZ1jc+VH&RSfRJjYI2IT*)'IE2EEj58H43XHpR
+PeeFliM6FM%1)S9N#j!rb%D+9*4ah59hH"#,DD"3IThPX6'bUS""dC0(pSY9fCDN
+8[dfpQI&Q'-aEIEHh6eKT&G1G,Dm[8'4S&#ZQIiXPS5e'Y0%JTJ$QI6,[A+BCB3j
+VF1PPNeq62)4VpGfEI#38Z"AhZXPKB5h[$5'mDEB4'h,j$H'P@a&%+kpJ@9kIeH*
+p'F#`N!#kqCZ[EX3F+@2hG(!QE4&YdVR)1FekDAa4N41HhXfimr3'IpD,"5,hEA[
+"PRFmS"hLBCk3!%$"r3-@E$r0mZ+,+(*F0U"Q,5mbKS-lHJGD10!cVXFFklUiL,*
+(5KLJ*e8i`Jh2iBB+'KCeM2'#j%N*4[+EmIlSVV2&**LX)8%b2N#E'-X%LlcETRU
+QfhmcD[fmrIiS9Eq"PaBaja$+H$iEL"([#ih*q*Vm`A,JFC%ImEqMqC*A-l[dK2B
+lR5l%$5fH4R#i0[ETZFc0JXrJ#)TN!@"+mCh1E#dGRUfdlflK!CR%lZAJ@hVPfI4
+%(rN#G55&#C9X8CC+"X),-rj-#V*S4$@-BKX2h5"T)I)iJF#@jCTTDP2*EFJKL5U
+UAJ+eEaQBRaXSfc3DD0dZ96K0@hPcb1Rbe89c*Gda,2L%&9R3[Dp1$CKb$cm$4KH
+fK8k`aH+L4*IeI[fQGDpY[N@j8jTX&*rQFB'0c'1I%8)E-VSYb0E5H)@3!%I)m*3
+m9,YfTe@a6q4(P,dh6S$HKK`599HQR-Xp#(DdJJq0*b(jKT1lqp1T)NYYNGrQFS6
+9),DR9@%-GA"$'PRlGj`+3Z)kP6pB8Vrk4C!!K1pkl-Gci`)&Q!aNTJIQaZ+Uq6H
+h-L$aD0d"'JVkc@eSPSf!&IJh$`V)GSiTA+M-H!r0!3KK"K29XHm1Q!eMZpl"`S$
+NSXdhmQKae@)EifJH"4Z-U1f!BNhPNN!)9'X5ffjGJJPSA"P4lfm-a$ZL$6e!)6F
+N&`M#QVPT"QSpB5XerJDH5&KKTrLk99Y@UJD@"JRfe&"a*UNNJ1fGQZDZ+V,PL1D
+cTUhlmT(9B94l%*cKL4DDRcN!Xda#KIHk*FM1XfkSa2f!P*L$Vq)$XGkNCTLK(5[
+VPcb5U&"!Zif8QM!GiX!A#M8rV4*0jZE%jeEH9m-q+a-!@`!aM(k9YM3bGmlc&c5
+M'GdFfrZpLCJ336qhJdPLk0erl&P%D+L-IVT#fI2ECMUb9,"[S![aVLGl(c3-iJS
+`cf*DRmUr@@dr!8dND!IPVMPeLZRkGINNak+d[LZ1X!C4HVAjr9+-pVdiq"9VGjq
+E+pq0F'RA51YelD5RaVFN+2`qaPK44"8IAeSU,5*T6R6E%Q#85mCI'V"N!3ee*ZZ
+-)&AE!b`k,,T!p9hmYDC"qQqhA$q6Y8JLCDP%)MB&qh[CZ",E%IBQ1Q9eP$GNji"
+UT"K)L@aLb-0"ETCRhe)fVL9SL%kN2lQh1*aMH(JKXl`$i*8abj8[*f)K*%ITU#@
+EYV,NPj-3[-Cer-Pbi*p+++LNB$$h8JeD59a8!-ZUJM+dVA#9D+U5)PC`IT[5U"9
+AMFb5japbi)*`8UUCK3,eHLT1I&i8r60bkA'E8`q8De#li441*4H3!-[T2h6SBF%
+X!TcU5Kb4Gb#KR)$J4b6[Y#Y-A)*'JX-++p0LGhFiQB,&69SJr&2I+'9*@GfpMZj
+0EMSZbfIf"3L+lEcLcQk*P1Z[j1SH1"VrZiQ&('1#MFJN9iXpp+JN3iR%DE@hS"A
+AMP1H!GEC3Tc8VH$(A!J,TaUR&(hTZ'Xh0f2D#R6@eG[,jFDl5dcqfBipBL8,I2)
+-GGe%Vj!!2I22H*!!&@0D6X2Cd[SBqdE9i#0IRQ8Lci9$DVZ*hpLl!#@5)4p`C2(
+[PJp)Ei4IG1k,2-B@T5krfC5p$$TH%4AqdK%X"ABR+Y3K[$flD"#B2E-f"C(aqA*
+!(3&jLHjLESjdG4S*E2a)HHEHS3P+5KJDAfkh#QDL6Z+"rc4am&h6bQK8X4K-+&2
+F`a#QH"K1mPD&$,FcNi[",&3-4-6rI"El9C+QX-iQB$TlAbU03#9N6ea%NcEbeEJ
+"jZFK9G`b1LjYe[5lR9NS-%+LJD-q&V-dEQ,#90kFBUeHRlPT4(apRrT*hH-(B"%
+SB*!!C124K89d0IK-2-)JE`Dc+!)YJMqcd15!''&,X$#8"kQpBhK"4fdiBQM$'2'
+Nd1[eI8liX5pBCZ1hQAa8LS)!"5,#[N0I"#PcF3"Zkk8fEAQ0h-&@`$h[`LhmRA-
+&V&(&'`'0$dT-q[*YV2jKfb2[p1KJT8&%li3FNPEI[r$f`p9d!C,IUKN+`Y)c`6N
+3PQdqFI9MSl'MMlA8`-5*EMXX2XFED%)frES+b$H)6F)fE8J*T[rTI2J#m8fYk1Z
+feNP%A1k%,b(BBK@D1a*6-EKKHB'p62RK'#Zr1kl1IdQ40(*@qrZ'p!XQrjDjBY5
+2X$&@6PdeK!#@YY#%(MpPQiP[29lM!eFQiG3ee$miTjA`G*!!)%*TH4R4PLBK4kA
+ZhC!!R15d0a*#(M4%k''GMTNbbTr-X2Y2Gh31`c8E3$r"L*r98XiePFSQBZphI[5
+aEQFrqEMCVeq0*8C(lX2I0kH8l'V+PI'11YVD(H,Q1eU'c,QV,V"m5j'0SX!(Fml
+8"A#`lh189f(E3EV"rpKk@L1b@EDIhclE)HMUF-0dc)H$cacqR([a!P"$"'5N#VS
+!ZGVa&4X)p2ce$Ak8IA"6LcKl-dM#9%46f4T5RMj'%,MeX)`0qX$GRX'SF#PA2Fh
+0Fr&AB%r21lK#kV',ebP-*3dT)61fMf$`$Ah8bMS!i$1N&Im#[9JN*dUepN5#a'Z
+L4NG0-CNPYThMiG60!T6f9C5RVrc3Mc-p%(9'aJ)Vr[S[%!*r*0a[LKFHXkM5&N,
+85&kBGLC0i6-U2YYCmL(cL%cYjXV,iS2&ll"!H#Ra!#cqP!i9)r-B$R08F)p221$
+U`"FqRaMVSKX%d)#CHGc3GGb"#AIQ5U%TDhd1C'J+CmBq+"4%`%Id*%GFDZ*kjja
+32JjDSCV--9EYhq%FSR3'%PH+feCichkYJ$2HXcAN$kHki!fk[S'*GRiSlMb4-1F
+@e56qKjV#4Mkk8Q+a4bQ@1S,b)9f$!VRp*j*'!3bZD9*61h,c9&,[94$GN@L+%)p
+6miCX-@%&+TNf#HhRa6GSekfiXcMYb2(e"DRcc,LBKCEkeI+`N!#l558VHee)5`9
+R*H[,3BlL-CH+68-UR&-F*-PhTfI'JfXlpRDV9YITdVD4i6K(i9E)kpSa(`5,E$Q
+Q8&b2rH8Pbm!#$R*0S-pBrXc[YI(dNB64Cp&bK+,@qbjbeH#D2bZfaNINJmHR0-C
+,bi@h2FiLX#9RCk&0%'R'*mje0H#Rp9"Y!XHEqe3JU3b[Zk`IGr!YhRj$8AAR"5G
+HG*['#jQ*"+Md*5p*#+Z#T@N%Tlq9F6L@NNr'qUGq9KN8d"YeQiJY*iI#`1,k[i&
+FMkeb6[-Lpp#hGfiAY5rVlR9jc(%f2U8P82EA[`2DC,AV2m'SB[X'-%r(6[hG!RM
+6eUC6XV*bFjdX3%LL6A3**R#Q`G4A#)%pPJAlrhU6dJR!IBhJ!EllI("ZQ)Br@UH
+Ql-dB#Gp3$rI@34J(D#JDV$qqh+hJ`f&EkYJ"&Y'VbM4mchd-S0iN(35NeVp[P`N
+9D8q"R3[8[Ed3HZRUHc-*dMfiXN!56RBiHa*2H6AqM0d0aIK#$CJfFa[8HYJr8la
+(35k[fi@!`e+MVXU[APD'kV3),'m#F1QRH9J%5'kSd13peQab"6K&2SE"#cRNCrJ
+,a2Q2j3`$[`pRb%$l-iIY,+0mi8,qkAa(j(&!A53!c8E-CJ'!LpKCqVj+[GjR23R
+)Qh8l*6$('k@,2b2c#&2rc#D-hiEV%V0DY1EaP-jFU#cVZc,@YeF!,X14@8B13EM
+2l"ca%Dm@`kFE'0GK(@klH-9re'jp&+d@S@q3!1@3!1`U*3%%fDbYEdpE43a2QjX
+2bQ0"lYNK(5-NVeHcj1LlI1,ZbAr3)*jHC3X204%A)@Lj9&ZNa6)qHe1R[eq$-Er
+V[!34E,4@-#apF*Nr-9Uc2"L3!'Hl*(B`LBeVe%8rZ[dX4AcL`qGVZ9h+cNN5K@P
+m`fHereF1'NK0ed#"q@Vj(GZG,BP$bk50DLB8UI2'peqbBh9Vf(XbZ"Ci5Fc"[91
+CmUMre'+DqS$q($P@c(Y&1(e-qCA9PQ(Fqe9i(N(eH#q4iIKeBfaK`QHJfYM98F1
+2(0m!*YEN`RZI&`SEh*%d%9DjBR6plT9)-5hdG+h1cCj*[(pLFj59-ab'i2cT,D`
+MTP2KV3r0h'l"!eCUFlP)pA)TFQDcD%6pJ@`-[r0YAJU3!([J,LMD!!aTd@*X-'a
++Na%bT4PkUb'ZSP9,Q,2)+ZpE'B(P*PrLFB(8Yh2`GEJ9Fbp[k*9T5T`-@i8Bh2Z
+0P4+hhaI6Xe*H4RFc'#[q"Pe!`%PSZ1&QjHKAF1rdq#XL(1I9)!Ha6C1@NjFYk*!
+!2Rbh9l[%rZSGFTa-fI@dIf!8fb83a&iV6X-'d0KUm`8)9KM+Db14k8eXKIXe`BS
+Q2`6JcpiNm4XS*r'+&3SB'$pV)bh446)*VXc5Va"cMbldQ4fGBqHHJ4LkbRKaA`B
+Me9lYk)%NYV91HGLSbqhKe-!aEYF+HEq2#f4VS[&ATMTDeL%Q0R-8CSYZb*)Ehd&
+FP0jmeI5KIRSLNZPjPr%1D4S4dlbe[4+dAB'NGG-1TS!D94UE6EbVYa)kc-l,(Fm
++Xib3!%`Z1aQDe&VpjB"Y-3qRS0Z&4[T566LNaJ)1em6FmkEhEH&DLb#9339"))4
+f@*m`ZU(rh*ILmbhIdVTZBJ0ULIrF)3("rYN95$Sd-qc`fd%q9m+S`MaXRKf!p91
+$@qhiV*pKSN4B#VJbb)ecAd#DjNcJ&hjKNYh$qdYD5eP,CI"*3f`k,YN2![a[fVc
+chk5T'(%Z&HHBR5$Jj(V40Zd1r3pIbfFLDilQbHfEr%3D,H'pe($*Q[#k#c05FH4
+L9b42(UfP2HarfQRf5VN@@PhEaY+((5H4S`M`4q)Xr1JqXp1e$'4)RP5Ypc*-5S,
+h[L,YL4)Cdh15$hh,X`*Ma(D5Q*i-L(62CENM62LSYJ&Gq'Xddf3%1a,d)S0CfQA
+ATGr@hbZFNVfLPBY6&ji[Sm&YK`b[qJUARa$Hb*aPhkQ'h5[K-QFj5R9F*AaU$f@
+R"C'5hE)VCEaDR2P@+E+BI3,AI)CFN!#Hd)LE4'@RMS!BTJGYb)ZJ`'TmchRPU'+
+jhqGpLaJ!ml(LlD0R1QRa,ir(LYahAUmSVMLfEFfUFX26r"I&eX(!94lPM&FZP85
+$1QqZ)[Q#K@*SF9V$P(R'Z,cT9j+Ad6SFPfFL1hpFe[[9T8C[3)rRUX(['1UDa,f
+-E[Ba1H3*(E-@$f"A13kIU[JNQ-IpGqK1C46"A9hAGjZdVLB6V#+`$k(,eBH1!k2
+cE(6cFG5Hl#I8-043`$3&c+DllHPc"hhNHUb1b#RT`l1%`SMB+B[jU+rePFb93Uk
+4T2hKlq3(,qaSq(E2!r6a*V9UVNUrbjrDFM1#KhaCV2FA,P$`Q$4YIb)pm4mC)Sc
+lbI%8J3EfP(AG9Ek6f3r'2Xq3!,Ni#%E#e)MB@SJLqF2A[,GLjR-imTYEfPL%@3%
+i(T%5bSJ@ARq4#((G8@Ll@2&''Tb+Sf9X$NTqr*'(X@B'"bV&Xk95mcfdi%8Xh8T
+R!`@QPj3lURIQK$B-@H[HEV'05Z$lSh2AiGZ)Tp2H"4SKjGe1IE69CpGcNa,43Z@
+M!dHSQ2"([A$kG0c@VSY#Pq(Z#!QFf[F@&*Rl9m01kSI[b1P$T`Lcj4XjF-b89Lf
+5$mc0mVhr[%IG&E!)eKfr#h#F+m#UU&)Lq`1C$J&'8CdfL-8H5)d,j9f0*%%i(kJ
+q1)bm0Jk8jY@F+pC5SPX%mNZ$mF%+kJ#FGZ8eG#BD@DM-U!bJ68!R*ibqmcUa,HH
+f%I21)M-r")%Z"1dFKe-1#%$QY2Fqa15H$G&J!["FBNJPq$$,2CMI3i01XII0PcT
+Z4jRTq`0%)adhZ[P`!N954KYIj$d*6$8-VEpUL5lk5)RK+Ce+a!*&4r*+FkRK#QG
+BMM1STL@cd5Kp&1&,)Ze$dd"ep[*G,TS@`29Cqifcr*I04j561Aa1F)d'h54ejlG
+2AB#AN6@`V-$j3hRi2dJ,F9TVPclA!"FR5!#qQIlRPrm,G3IUPGYTcl-)`bTc)R@
+3!&1Yh2H1MIfm"k-j%*0U35B,r4c[#"lV2159K"lT1K8GRGe3cedfSMricXB45)V
+8q`Hi+SmDhhf"$XEID[`1,F!46aqcZF"qJ8N6*[M4ZHlQAI)KS68`XMkc9Jp-d!Q
+IfZ#Mq![C)I$KAC!$M%cJIa"LiaFAq&GJP63d(C2`+V60N!"aXpl$Y[),"I4TXNP
+06-jm4RirqJE8XLEj$+,C1$(jQJ,i(V)[TCj(qcE6[KhT3f+mNYCr#Z9lKTAXq$$
+A(cC#8dB$M2Y"Y2%GqBd!APq&ZX4rG(#Re&+fC"!%RIL`L%8U'b4#620[YIQZE6$
+R9Ri*HHXiN!"DrIDA1jB2EF0Q!Z`Vida2C`YeQHYYh'6cI#PJ(0jMZB5%a0PqFA`
+bFNk5I9El3+QQ%#UQZreh[MlZNeY!fF9CZKJdC%[*GUIR5Sj"T1&+C"3lLM6bK`+
+M%*0i1BQP@(+'pU&hR!h#l0!R[i)KEc#63Ziih&!3Ecd!6A1!T(NlE$ip-6*X&N1
+%5-#bIhE$0"9E(@3e-[p5ZReRV5P6F*bfBZk[Uiq$Z,bbT@lP@BHFc1KN,1#eIdH
+ZDdBABBKDLI#f4decqY53!'H&9YN&[j%Kl(YYX2#,kmaL9!TF`pqY%r6lCA`0(DA
+2#0#ULG3l$Y8b&R`V$p,#J3N[6X-h`A*"R(G8$`AbYR'cGl&i&aX`NSRKSjjFFMe
+X[I8Idi-QhGVbAEEH(d[d5ZMdL+p#1G`ej-J2K-cFadSE&`KIVNMK9i$Ba"h&R(U
+HA%kl%4A)eERr+EaTH+L!E(KYLa(iFJTPFJjEP!!V#@6H*M8klB[cFXd6IKelR96
+KYNcFJ+)3)R%hfBJD(MAl`#c'%jUSV-8SR1,6QX-Y#Y2Lm$5`'F4-TGfY8&@GQ#i
+@99p[JQLVEUiNdB+mSGD+NFJU#K9Y8%6MhKFS(-28a9V)+-&EUTE#-(R$fZcX&Uq
+3!+QC%f&[l`$UAe#1!G3jiTFiG*LK*D`(9Gd'NQ&q#a4*i&V!Bm0!U634lm'0[b,
+Id1C(ehIf0K*dT!!9l#")%VU2UGHG(-&BeUF2A"Bh&!UH)3I')X[QB"j[)-HiAMc
+Zl6l'1G!!)hmVpjp2*H6N`Y60h[2AAcHQbfcKNJA@[9HI+eHFTS#PN!3"!!!p!!#
+dSD%rYA@&Q`#3!mN!!$@q!*!$FJ!0c"8!!2Q-!!!@BJ#3"!m!6@&M9'0X)%e66#l
+2J!!!Pla069"b3eG*43%!N!q!!*!(3X(8U2d5FX-%RaJS2$#I![1[jq-`QFq6`ea
+SNFV9'KiZ3PRUH1$XZPlZXMY#AQadC2S%D'#b@LJMBJ&U@6,A4&`!D,e5(RJd,3V
+$f3FjLH40PAh(VGfVkZHc9e$Dj!K9DYAmXm21*-T6R!hYY6bqqF1('`C9peXG9QA
+%hU5f(m`&#ApChjcKc8epBR&U4)Vr3XBljUQFm`GEPU,G`ec,,2c6%!`IZ2QU@NN
+#XE3bC(K`@0TqUNl+Z*(rHR$ij&mrrBN2e(`*Z4b1`Tl5)5``p32"KXlR"5Khic'
+N1f&pKDLZGE)"-b2+RESe*+dHai-%MD("LMk3!'$"c*h,T+50PJ&jd9MreT5i-PL
+1FKUZiB"CEZ-B5E8P2aF&*pSGZ"SkPTjiMNjZ2TrjF452'D"!4'lm!-JYjedS0QP
+$NmC-ZMZ*BS8KRE@*dZVjSDTXJi,P*8SIl4$0&$G2X6JChUB@$efkrffSZG)9hIe
+*9L+f)hD)U&(LdqbhP*!!NemL'a+He[eH"aX09b%*#IfZ2HE'P+*cE+JE-#NrPH4
+2(q*@$V6a34DiJ`qHaXPSC-Ce%#%CK)3PIGT4'qSILH6Qfar11RENaFX89`0L-0)
+23'"qcP1iRR5MP'B+KJD*F"9mPMbaa$3K-#"0hIk`l'&P5J%S%*Gl@$qmX80jTjk
+Q#S,C(hcPieYSm(4!!RK0d[U5FDpI0ia&LQ)HeShKNVkL"3[Fp*-j1-iLe,K32PD
+9q-[Ce9caYE69#abKJ,5(BL#-GfU+q"5"-UE(+@K*mGr&(UT6(*16SH#@0qUL[c4
+5D`p+8IMP5E5K8e*bF22ADkNN@f[I`2hUd#k,#IZZ-Y"alb"V,4EKaT9bSDPVEUc
+Qe31GTSF!aKjcA9i,p3D@HH"Yik1%`8`Xbr)K%X3E)*hbbkLre@k$YjKD9%$p$M#
+!14V(A28@+4jT('Fd#ZJI6HV0ZJ$S15`+b!rLYImE1)V-1a@1@ae+3ih'ECI5rpI
+-U$2FCF2NGrP+H$cK`IcKJX()&ES2Kl@*1HICNU`8Y*LJ2fJ[cYRD[[%JIDjDKjd
+Y,Y6K`HUB-(+"-I0E@B%aJ"4$G'rH'NVJeZ[N'(dV1c1*b),ZPl&*2i3@XcG4%I9
+p%aYrIKR96apXh5jL$*JS%X)5ID"0c)EU*3D!"F'2*"RQc23"q*!!"kNK3Q*`Y(b
+5MamCkrC$8A8-J8j`AD0`UDEh@k5qr#6Q4[%U`FYCBJJ1MaQ#Ajj2RQ)%L2SEE$i
+i9$LD-MBd)HXHa`PF!iCRbA[5FLZjUbY8ZlXm13kb%Sf@M(l%L%G2#H"AISd1JQ$
+q6k3&l45(pAA@N!#XKaGS*(!1T[LXVY2RHAfk,HJGJ'D-NC[QaU`-TRmVV0frI-Q
+#2Xi+JpcrI0dl[,KS*iN2MAiLS%pZ5Dka1RhlIIS6G@keaVrDDr+$"0Y$a4'kPr(
+l2L)pRilVP!11H,[V!p@m(6JC3)m(*GpMU#V06HKl'Bl2LFjBJVFdm"#8mI@UaLR
+Ll-0-Q"+&4Y1R`KcNPU$Neb4dVqI8ZEL#Ef+C`-3HX#,G&-m['aQGqFNEdPHF[[Z
+iBmMPpI5Qp%!q"ZR$8"bUQR4`h(C@e3m,Y[86IRJM(p%bEdc+GT+lb!ZKLcC$cIR
+8dc0MGmbPVKrVm&bHM8keac2hdVT,lbjjaH8+*Eeqb&P)%-li+QaCUbSceH$[TKm
+)0TJSrS0E[31&KqGfVei9`bA8PXL%2-Iqm%qDBJf1,LHS5kAG31!P%+T3Qb#pZIr
+&G(E!m!KCVi0+be2iMG)9'3,b-J$9e9pqZccp(Hqjm[1SrUP"[jP"QKMYE-9VNRM
+arRGRPSeai+bL9K%EL-USiAl-iI9CS$c6XQHdT$ET""iK`$NAJVraGLFqRf02aDB
+ZF$0D6M!L@X9XD8",*&lm189*Zj%53$0e@H5F+$32ad-&S9S1-YL%dka0!V")Rfq
+p$3i0&9`SPIpjl*4PA1d0lYK@1eG%#[aJUlQdic$i%`Li-X`GpB+'brPUc#EKbDf
+8YfC1Hf"+BffchYJQ(H*#F+S(Fhr@Q9p&-B+pmk(SIm%eHe%L-4pplD62p*0([LZ
+[0+IT&`eeNL(C6&&"Xi2kcBqiAe0*Vi+5i8jY(drpHSAYAS-FTI8li[HaIHjhmll
+c+TBN0%+(I-9+9SL)0S"%-PE[l"LDB3N4He`*#(J[R%YY@Hh2mB8N'&,5V`0PmY4
+03k5kf*m,J(Q"R$l6k(0DEc'Cp,(&XqaZj,XL(3qUD'MGf'fA)&(b'+a+%E6H8T3
+U4(h@PF[8R!`*FGb@Km!c5+ReXb-GEfQL)$$"ZSqH*-G1+NM)(+DLd%%0Lc&L*)V
+BPk)GQYK-k(hqJ"0`pcjE5N"HV@)PK+*PMRDAaMZe2(MIR`2"dDJ8Ki3*+''VhV`
+r4[SN3kCXEIJLF[S"XTE4c#%Mb1c'dG2eIk3(XSjZqI6-RKY"TFD%N!$fa"%-MUk
+KEkN#+NcHIGX!VHRKQq-"(L#i$1G)(`5MCT'r6)@")LlT8R&VaJRD(C!!Lj)0(NA
+&c&85eURMjDfK0fZfdh@Nam)+MfQqXDNMkGX@'28ST,%dm-X&KQ2p)fGS&"Y%&6G
+L1EF8k822hVlqmN2i1U+T'kIl6bVeY4rd,m'P%,e',$jYU3kB*9VaK(alaEQ(6rm
+q)q(3A$hp[Q1BXMII,D#3!&bXG($ih`mV#JhQ#TVZ[qI*`55q,Cm@r`a*6%YlHEc
+-Ff`[`MJa#ZlX-pN(*jT+rH!0)2*jqrQ2rH[kfr`'*l$68kF'3'c$[jIB'-3!)EC
+bKm'aT"6dPSPCaBYJepLFBm&J+jE(Y'1N%Ck90YmpcMcbIIi4[1PS[2Pb`jjN"%F
+m!TAMBcjPp4-`,LH"G0FC`pApi9'ePFMU3h"@"A)Xr4"'q4p-"B*HqQ-UlikaH"!
+5R-Q6C3EGY`N4k"Ki%K3K2d%AT#XK02M1a"!&0,a11VCcm1V2mB'""TcV9)&*@k*
+Xb'af)Qf9N!#'lmKk5&je8eQhM%5lTGC#c')N)V$0JrTkT##,R)A`5S%3fCYr`XC
+Z"@N6B6CVEP1F@S(f"P%AI2d-CR!ZYXP`2PjDQ-ZKESYlq`q%5NhUYeEDUmRlr!k
+5j[04TpK3Ddl%RMBe`,aVUrNeT3GB'p-r@2[B[X,m5LTYqVqGS6#$cJZ)ZTRJd+U
+TSH-NK81E[DICTd,G&!KM3Nbj39eYP+')PlPRqMA8iZe+I-r@EL,fAkhQU""@mdd
+DL[FPTeQ62qa0Tb(+c2IB**ZbHXRiaCNdPlB4pcVXr&9fDUD9&'2S#!F`X8ljbPV
+3P-,AX8`jaN1$S)pdCmircAE4&FHqSDTcKr6Db#0djJNSJ`HJP9MiQrapJe%&m-m
+Xp"Z"3fkQS9Tj6'aVPQbkU,RAh`!Gjm[P[braGY4NkKq4+aQRR68cQ-Z#4f6pC+$
+2%)&(L%k$ZSCN4+dTf@4f#TSB24Yr)p4jK-B2$3#ahdc9Zlj$1E@"$[@T2X`#--A
++!H)MBlX6efJa0T'e!qbXf+[N8`8k%Ea,4+J"ESJb4hfRpjre@kE(ZLh+(G,crGp
+ba)l@X+%ZdjY9GDFB#haT304RN!$eK)Pb`SRIBk)rjkeJ(A'Pdl$ZX&0eP%,RS"Q
+QKlXMj&'LUXaZJ5`USTP4r'-2,bKKiYLbFiAqR4MZfZN,X*cX8Q$&-T!!b2SVc#l
+-jAR*Y@m6mV)9N!$320b*q5G1j,Na6m4YIkMBGjCBXk-[hc&0r+CjC0V2r@XhQB2
+&DTC)QKbClB+c!NTb4,JP1H(PUJDeQ%r2*&4%!BkphpkBR[[-TUfQ3kYLpiq%m"'
+p*c4@al%R3ba-d4Tlr(AY)!R3fXjBAk$%9K-TIdV*,Y`rAaUUpJD-Zq9b+4k8caY
+9@U5&0hAYBS(1k(`@m8M!RiEQrQFVrqc265`'!C'"@XmQA-J2e*F$Gp8`P"Ml5Hh
+pUB%1FkQ"AJX!k)KS+*l0(0'fQF`%020V%eAmjbZbVeU&ra%(0qMFp4C0iD![NPI
+0Z00PMY6@r*H#cqHLAX+Bbkq(m'e3h@2J4-C2'KNaNGVlp1YG*SjE2k1`**`hB)+
+i"243MAck6q&Ybr-YS91!YQ&S8Ze5f@rqZhir-Q[#$j'@5%&VC89N`e)p"'Xmi&'
+FNcQDG0HdRR3G,NKe[M'$QU%&+h1DP,LlC!$-10C6,)irG8!qIbj0H'`dl6'lc+Y
+NUTYM!LFLqdYJm2cG9fd(##I%a#CqRF4,QlHHB"ZQ&ND-183E*6rR,M%XV4F@'L8
+m*VhH@Z5ELA`0f&F@[+2*$&d,bCe)Hbk1@hdGUG9b($,E-q-rfma!QpYAq!Q+,0@
+I&p4ab!XiAe&X1q,i&N)rP$br3NUiQXP5%ASSK3EF,"Bq&c#K4e+0pX+k`[0Ke"4
+3eAR#"U1,(LY+B4MN'A8bDq*5kl5kMfAGM0I)RB"S*lX35XA3iR5R!mN,KZf#YeJ
+JP#b)(V-6DmKF3Q6qSeXiGqA%-@8)P,PNCVDb4Zc1cl1SdM,h!QSfHkp5YNU2r@c
+C@Q`!-&0D[@F&Aq5([2AcCGj%)qiB86))YJp*FJY4B3H0BZmhjQlD1%C2`B1Z4,M
+)l1(#PEd-[fNCRShPJ`rES*'+c2"XSSI(['0`q)dj8i@Ck*p`dGD0Y'b!K*AJM9#
++l`6)h+#m"rN*I)Vj6hT&kL,cr(KFBVZq2)C$ZFFID61bS!58*q[@UL%9cf'iCU@
+"[M"Fh'!@ST,3a4-Bqeej[8f$K,E0$Rh,3mZ+F2[#f)fDlTC)AZ["Y%VD5QK@J%d
+MR!#+bST&"fc3CXKj%A%@+9Q(mTfj4&@UJq#@@e"5"%cSFIJmXFL"B[R'M9IaZJ,
+-SB#ThPVC&20UCd1B3`r[cpfq(QJalXl5@e`QC5FD+9r33cTFq+k!edFp%AIIF@C
+1X*&0G1ap5ka(APR-KAVGa$24EAMU%#BA3,VXKT9k(8YQ-1TmZRMrL`M['N`'YPN
+r+PJ(`)bY0Sde!IRZc%*V8M(!d)G,6bq$TC@0irL"2EYTJpB*"98mrU4#"Y"l8C@
+@Vd@q(AIjPPc'1b'@)lb-B6)'aXK@G)ZB38pXII*+6rXUPC!!$3&+h8K#3c4'QZk
+&pb-i(jI`B%AlRYI!S)i1'Yp'DFrNrPCEfQdVkd+Nm+(2SaBX"0e2[QKB*K+@X)k
+T'D@QDAk%C`1rJc(,RUkM98,12L*eQRGYGKl%+d@-aFCYNX5Xi@)ClPe,&Vm(Um8
+*eiVccHQ-SVPeU#Fa4TRDmK3MAFcVcmchdI-5`K'KCUA8plGJYN[UBR%"c#XP!Xp
+4&eU@A*rrfFK&qaVpGk5+EPFqlG[UiaKcNDVDf*!!`4FRiifd8",cm'@3!-1XB0e
+I$U-2[)6RJM3`C!kk8GEd1SajaLlS-LM[k'!QkCdTE&!r5[)&b@[!hLqC8aVNKPr
+B8LqV1Ja[q8,-S49#dbFB)hh94NYfk,Y"[k`@C%2Q-G*U)#,%R@+i$Ek#AjaC`!*
+rkiTelMHTk#QK$JN&[aj@[f#BY6H%i3K@ebcN3640f4'@+pKffeEf(#G[2+%Z3dk
++B)RAQ0,XIe6%"X'Qi2HUVhFG+F%bBI2k5ai`!k5maXAX9NA1kXV*qR2,85[E8Nb
+Z,dH&E)f+lfb4H@cM#,RXecJ4)j5cA%CRI8ac4V0)JKL!G4$(khX@[B#*DlH,UH)
+Bk&!amJ'VV'A)J404UV4)YFNLfYXPl++MfQl'#lL-SEcEmZ9p#I1'qB#N%'6f#pJ
+`h,&-De+MYdiK#&K2jkYN@cUC*G4P9U,9S#@8iZZ`Qm9J896I`IB,hh)eDD,9V`C
+)a6Naa9!9f`92jFEAC%ShkHChbEjeKk"qkESXqASNcVQIXl-HA0TSSf'ILMpPm4C
+3+VMUcJZ,4`9@$6(fqAmC6@#EQ0MN%dF-&FL"hjB@dA1i*J&pPdA&bK1ZQXlJmEB
+%F@CFL8%eBC4DaD1Dqk"-08Db&AC$lLIL!Ir@!#Q3!#dRafRGhQc61Kb'p9Cm4`F
+'LaQ'fG%*"[FH$L,#pDP86(G#HV0!aLG(M$#4T'cL1LQK5*%RaKV,0bG#J['a(3N
+XL0-f5Y$4iH+UADXHkBMj14q1mK)d9GP*G`)l0XQFQ$Lr0m(Xe!5(6,V+#P,B,Y3
+e(1dlk3q!0NC&3PFIDPPL3i%16GLT'$ZCpK82((94Dp'[JiMakm-``PVPB1XYb!)
+im[X2)Thr@P#4DpKk'@FS+*(Jd5B,`qSNZ6lFXUiLMh"FRm@X)9L*TfTc%@!Z*eX
+*,4BeBZpY6&hZLB2ZAkL#5Y!54iG8rdE1Zj8kB+VK5QI`bGCYTRc"Smd'QXK4-pX
+&@I%#H,m%+@9RDUc%i4UImAUj"CT!%FM`%T)p*`cPIZRG$4K&qG0d)rj"P#FUkdi
+0e5P-N6S#SG'S)AJ[-I$-0L[2)QPHqhc9clGdh0HrQci2+adaU`FpEH2IrE#d(,-
+mC&&p!)+j"3R&lUFXk6ZhE9)k@HPaEq@P9X(mUHJ)E&XdhAR``If2FdNRhSekS@m
+dP)bK6A&kHQDNDkYM')p"Z1CbXcG`JJT648)I!lSGQlfBS)2fXK1GiHQK#ES'QB8
+X656Ua&+fA-JZ3,+hlH'KD816PD&Y)2c,m9PGC"D6JaErpa)JU@)+k+B6N!#C!FZ
+CA1KbM21i1bmIH&N6,Ra%T4DiX9NcMKHV,aB$#)0AUkApHcQDQB)$1EDYB-)C9e`
+mZ'5#p2HMB+"'5TbRA5hlaaQZ%+qI840LIp-L9,Rb"*FP,@Ypp1f8"(ACYEk6MSA
+%PAMahXY`D`mEJGER[FI,SpLQ)QNq'bASej8ZFId%0&+Z4cbE$$r315&!Yl9eGfd
+Ra[NhZCc#Xrl2Q#TARiL2q5RCTif&"(@eAT0ai[kkPJJTT@%6BLC0m+&)JmY+QaN
+pdqDARFDL,A)!iKk'Z[ZQ9Qk@%e`IA[hYjJLidLQ)-9S-4HGC-pYFX,6DkSdURAp
+I4q(2@%"GjY%F+cE4VQM',M6Rjm6qIf3[CZ,84E5cKTPZq19G8EpbAr5ZE@l`L`l
+(@dkEr"5-b8DrmU2V4b1Dk(Mk''D[9H*KF%aRBbermpC`k+GLTa$%+8[KFGj9qrR
+$kI[02#5+SG,ap8&lUDbqVk3KBm[,A!'NVH#&S4I&rImF[*cM,J-N[Cec`49e5Xk
+RQ)UqUp*Nab*adj-+PU%ZVPEJqdIJ(h!$GXV3+R[U#-d*a5mB,40%r-X0S'4kL#X
+UG0-DlFEHhZQ5T#C0JqImjTHlBB*JCrJ+(CBK#V9If1QLm@#UR$K)@rX[BKhb8YL
+1+MbmHRF&2i-Qhm9C@IkfC1[,Jl"5C)`B`mNcUlHd*jDLC2U@,Dd&`p+1UaY`GFS
+pr`GchQ1K-G12YY2IMF&al5-8U8**X!SlaLHZZAarTLE,(hj[(HAP*+S5*ScLHBI
+P5pX%a@YDNL&e&2*a1Sfq[5LJdr([lViJ5N8L4P*fc"m3(a6q,cG@!U!3SU5(KGC
+C*hE$e5Qp@Jk!ZZaqiKCUATkpT-DJ@08R1V%,@#EQ*qP4R,3bF@X*e"F+ARJqb!F
+a#mR(&YDiK(J0(-I*86hlGb@$%#I0q3[8b!r"8p#P!"GdMjmdM'E-$[966E4&#K'
+*eB*mZC!!5TfD5d,cJNbXHJ6Ki"Ni6j@)`#6jlQ!BT+h#h5TPT(FZU`D05f)S*j*
+%F3YDJl6XVJ#PN!3"!!""!!#dSDNkYA@&L!!!([X!!%k-!*!$FJ!4UCN!!@3N!!!
+BD3#3"!m!9'0XBA"`E'9cBh*TF(3Zci!!!*Hm68e3FN0A588"!*!2J!#3"d,"e+p
+l1d1Njj!!@,!Ie3q,(Cc0pVijaaUp,Sa8D%lRR8"5#X"PVHC*dC)N*,kVP0feT3#
+,Z&M&)cpiKKaI'U)LURRTV0ZS[j+!Q,*q#[&*HED'b0`f)CqhAJ,Q#jd&mCRaSGB
+5J*b0T5V&@MlM)D1,!YF,R2(BNrkE6JTI"kd&G1Y,(Q-E3#0NjUe-[R(!4`lC#Ud
+FHjFTBIjXCCH([[5IG@B90L*G"FdkbT@N[%-)CRCP5jP6%SR9M@F,"ra+Z)q-Mq6
+!*2F5I``dIIPY6C4edJXU,3aD5IX(IU'F+5#'83hblS83DZ96e%*2d$Li4SUDT3#
+AmmqA"Ee&4c+8PLhA`a`i+@`6[1#+2)9HB$+1q(i,K&9%kLj0P)+E'GPkNYFbi)i
+EN@(5hK1E*hP-6,ZmR9`+JCfGl2V9#PK+%h)J%iZVQi5@P#**p%-PQD4UrbC2MZT
++$D)*0SVj6%Ca5m)T!R-er@1Ir,-B+659h,a@@(X$K*G(lGD*,KZDS8AYNk9#2jR
+il1PNIhdqRh$S@K%G2b3mLAj#cqKBZE!Yh'ElA'NhErkj&pcS3LpKjX&1c3qDRSC
+-)PP0Bl5QEdlJ+G90Vr[lM4@(9"@l$dJ1Bbk"f'KJIeFkl+a$'-2$3%)R8VKEB2,
+8qd*d6&f23E6q1f!3-CMH%JV%1"$B+5E*JGA*['UqlKM-eI`Gd$P8-ZY(rlq5MV%
+MDQUSqS29prHVD(R'Y,Dm,6kb8dE+f+'&-[2P"U@%Im-8qLdlf%Mm9NZ$qq9q4r`
+#2rId4`J'YRTRa-$)1qN+a-%FJ$#+",BK2dZ22m36,9pZ1[9p`VRYm@RqdV!c"4U
+XrNYU@pUK12R3Ic*(QDEHE98iB1MPGP,ql&8``9Mk38ml-%D"`0qJK59%'f%*GYp
+Pm8LbK'8*"bFFq"GR#j&cdr-`q%3TmGjeI&IB%GV693MLiJ'H@P%)Vj`Q9PjU1N[
+LeFHM-T(`C*!!9p"AmVY$ihH6,'*K2S)#L&kJ@#-PT(+a&"keL15'(IM-a#C'%3b
+PHf$l"'$,F[CT1!ST()N26"j%TrGR(E*89Fp$-*18cE+QJS'8#h5,*LZ9Ir@)A[U
+ND)h(bPFJ+*UNfAe9$&ReXS[+mANX%V@RGSrcdqqLB3ilC,QQq'+DdYAPR*ALRAY
+mL&mXp&+mVcDG3EX6m2&FAHqP$HXpJ[9Zqdjc9H5hZZUY421J5`aL)!$kr)'S*r9
+TXp(N"HhARC58CI+j`iZmNq6*#4R*cNc%IEpRpqeeYY()iZ4@j!(RIPRA3SFRM%Z
+""%l'R)JVF%L4fdHYQ[,@UeRbFR@ch&&YTN@i2(hZ,'I!f$bGUUI!8XUa4VBZj&*
+RCR)R4,3@Bh$*Hrq18$bkQf[r%3i3"YEa@h`@T6-`cZQ)2`9BB&QC0KQLR[&[&4F
+%GBh`c&pR(N8REM4R#$%TPrX,&-JkJSc[68'fX[GATJGFN!!LpiI$q@i)88J%&CA
+SK5A-Lb$%1c-UR$QaV3-E&PR5E4dcd%(h8HGiJT`Ne3,S3cl,QFr#!+#C#pm[H[p
+bF-BXXbZqZ@qHNcBfhcS$r#&TL3jbIqrQVQ`F)@',Rd@0Fb&mDjZX&()`39Q@'j3
+GPLcVPK5acLmH)(ZhK6dm9F-(RIfB6LXcTDFLrDjN&@V`H$&Gec$+Ch8YBmiSX@h
+S#)Kqk#-#arK$)*XmJ[4lERMqZA@5CQ0S'3i-9,@TNGYE,EK2r(E3C8(`Mq&A*#)
+9BPB+%C8D*8Md66lCrX56!8'EqV0L'#i1h,3DH%M'I6XDlaI1E21dIiGPD8pMlL[
+NhNjZZGXNM%[iap0R,"*Y#5m*Qk*cTYaM[R)4*pr*NDDA,"acCfpAhr%9cq0e4$m
+T(*MH,('2*f+Z#B3Q&Bl&`4ii,'dBE2V1c6"rGRe-qFkC8NSVc(DZ@ADSjGBlqp@
+$+AAhCe9jfPrKV23)PeI4G2P&YaYGQYPL@D#8VVU3!,+afN)Jm3ej59K!q8U-Chh
+ZD9J2L4#kG1Y'&k6rHZ$ea,6P1XM`q&pYfM4i40c2@9L6ejf'b(3BV6Z49E2#SdS
+EUdKa15`HQ%LR`hVD5p`2"%CH8NqZMT1),km1kX39aJX9EP8T!@YjAD,"$YNZ0)T
+UTNfI2XVqhAJMVY2h`l6+-NTH$U$Z,LVdpNNA6`1$m*0'(XecB-HVBPb+r-4RLBd
+4L)9bh%*`$NIZX+B-M!,pI!0895)dd8#9pdjfJLJJ5b*)BS)KBQXQ45$rR!)M46Q
+YqqTcMqMkHeZCYdjV35aqYXY5$U23k[H6S,GJTYMLk9j'VC+@i5U($8j!Eqfb"0p
+*V9EpPHRDYLYSKR8L%QmhGkUrk49aiUF2TcBT(mV'"UqlFlP&a-+ZZ"N[e)#h-Sc
+`B`3!mUE+N!""aN41,ddb3I"KCi-`PBm*#bj%q2Qeec*,X+FLZ59V+[NP*ZNL$3'
+RPFFhb0N-*Di8r5I1FQ(h)QlHDYhdHqFX$aQ%,!2+&E+f'Nd(BJ,Fi$05ji3cdCR
+hS1SA@,jbHZ2f"VMi9,Mj[iUa,eME(H2kP')Er9@T$SpKflh0aYCm'M)"m2hJ@9k
+p0EC-FiE)"qeU'K`lqZ3PjiTYJ[jh2)$NhDk(R4$MVNV1*hBHlQ'3!0+*#T&NcDq
+#LPCF&@pfYka6qAhc984Bj#ieIqr2qZVS&GL-%D(*jj+,jUdra)p$HmT22$6IN!#
+Nf(N,%G)LGP3j4,lZQIFPL(KR&hT-Ip(qF+*kk$a&FdkI@MbBJrX%T4DkAIAb6Zr
+X(pLbbZ32&JX#PQ(DSkb6NFSK+%i-0[)"JHK$GkrD0CblH,F$jEA3D0X$cqKdH,X
+G3LhVVN,I#mXY0#++Hc-iARq"h(4ci)52aDS`)K[""Aa4RjJUJ6HM&phfcII'C65
+F'G9&(2G[E'aPEm!fF#`GX0V,aSE4pmiN*D6Nk-mr4ceXl+KG*6PPfmiAR)VNAF@
+Yl)Jid,CHDd@f-M8`&jTIqdP6Ulef9N`"S5&dcj[HB'Yek$kkFMNk'3cPUB2`UL0
+53$dPbq$-Z([4Vpl+qBldbq6"'ih85r#YacaR"fU&VP#f6qm#[BlpJ&iBIT%8NZ8
+p0SMHD6LfH2VUp(,I"L5Y*NqE#q`KXBJP[ZR[m%KMG3iAR"TXaX-QKEG@'-ljk30
+a#Z'!ilESMD"-CrdY@K8X2"GKGkAV5Ej%`TJZebNIZXR$fQE[CP2m3658QY#3!%S
+c'29rL40NY3DCi3NFYKRb-B4Se`J4,J+r&kM[2V6$L'(#5#[HIZRmE-Z&BklHK8Z
+0(rAJ9AjSeb6deMef6QC'fG33Ii-J$'8$HP248,@*)rBi5$6)!`2HS#H5&9qpCef
+*$i0+,DqSM[%9$k*3HReS`p*-(Cqr*#-qrk5+(ZH"E1Ie6h+bc0AfH4BRr4,`$D'
+%2951`X1ETITVB0E-26FrL6B62M3NSG42KD%H3f2Z9-+1F##r[EBpTmU0F2)Z`rM
+pall$jNcA0rH5eA++SepARQBMfB!VQ"rI'XHYbM+L0*5T*@&JEjK*j38KV#9fFC1
+JXa'83L@CU-IP-"VNJ[5,[ZLCI-jq9cjLjH4#H`&$(!P`l@dH3hG21U"X1NBJHdm
+#q&Nr#RQ[&bec40fSQ("prEh8KXm2J$B%i*Rq`2r%cSKNLZb8p(5kM3qKH#hEi#L
+UB%V$kplJV1Kp5RIFH-eN-FSpAPC#)&Ym["1[F3LKP95UZV!"dr&D9+F'cQffEk6
+LC-PXSTPce9)@[[IfmXarT5&ihU'pK"mAF9H@QfbAJZe"cj!!hRrMJm9(#QeN"kB
+Hh&)*@Y%qU'#4,#lKV*X3$M[`+TX2%fL"cYi*YKR1kpY(V)PUX0"5cPf6GJF%h`L
+Eh,Bc9Pk2l*br2f,G)[5Prq8kDL'&fDRpKZh$B+AlrXXTc&jkJI*Jb$aEir%JI2H
+H9QMap)8FK5%k93*-2EkcbIVKNGSCU(kV0ImQ1fU9S!-ha098mZZZr0b8MG3hF)e
+PGhBa@R4@`H&EMB0Ki9Rec*qc6N`L'BkZ,+kBK)1pm-NT9TY)ZFaa@+Z(5TY0UhZ
+#fM$T'J1kV9NbRM8*G*[C,Y)q"A#+`iKf''j3dhL@Z)mSlMCH'B9%U%VV8&Z'`Ic
+bm(`N,,NR[@0d-bdAE+3U82P9FPIapUGjkT2*m6fVM,8cd!"-B*lKKX(m3UNBbKH
+mKe5c1j6TJG@e*304R!Llq%VEY#P*2,[4ilKJ'G5qU5fHaV%f+ci-XlTQe@f5pZF
+'G$4$EP56XpGdj)a+1Y2EpNh@8`jq9kDkfYE[Y0UIj25mjp0eGq@FPFZ&*&lpP8d
+J%l1&`I"Yd4F5aC5X3'Ui2c51LIr"!M[cBYc5-p*-#RHcAVa&(MY!UrdCIB*LaG,
+e$rH5(HE3TQC`+ec6*+blSk!NCZlpeC(4cY-MI9N(Y!h$(,N6G15RF[MG@'ZjPB[
+-f"l9Z$EpPRkXr4c"10"k!8qYEF#QMJ1N,)T#,i@M'&C[mGe#4`!5Kj+rF*&jEP1
+a*q6c+IQEciPQCUp2EpeTNdN`Ujfq'-RX5XpJP(leX%)l8+q&[G&fmkkKhlZ6&AE
+3K#(Mp!"0Z#Z`lQEc3IHZD&Lk8[6`m*!!4'Q`qLrDQ+AX#`[H(9+!BV5XU8[ZdcI
+SC4P`jk2B4XG+2ql598h892j1U)RY4ZclMh'Nm94%8iHlPCQPeKA('UcmFKK429h
+c)',3J`)VGAaM!+kS65,SUIFh8I+ikmiNAI10)$Xj3MF[GLkKX%*NJF9+CNY2!r*
+cLVS%YP,$&S3F$5UIk#M2G#,3HJjB6(ia*!5AUVcMr"&Q*fB401pC$dbk[l%m*-"
+c#A1[BFPLI"LK@+qDMRF%P*l"d-3(92D`[DcYRjI!I@eTe6@50'6b[lpP8r4plf(
+@U&*k3IBP#9jjTD3E#H0NF[Uf%E&5qT%p*Dq3!*CXXFNi&@i-rA-GcC[c6&414SB
+AHk!h!'(06C(e2R+QchReU944dJjJ!e5kcCEdB!XKGl-i$&Ad1R0bBj1aj%94hmm
+kCiKI$H+L,Hcc4)bMcG3jaD9I(TTAe!P)qTr1a#)TPZESQXp*N!$E*+Q[DB38F$2
+h3q[h,X*K1HDa[hP&8GDbX+rL-*0AV+0-fLIm*$FM[#BKGKdU1S!D+$k)E2[*`MY
+A4,4pM"bjeZr&Jfk'i#cmfEbmDE0Q&Q*[MX+0j`eZk"1TXKIp$fSQ0a#1,6kkdQ2
+d&iDiVHJdF5*i3-3hiVQ0b2SmAmAVN3fj2plZh*!!!GSTYZ&mVBIQ3hQTmIFqZ2N
+&kPH`@!KqF'0Gd9@RS%9e,bUcZ0*JYNZBSipIjH`'lcaIM1q+3GmiN[THVpQiH$q
+&$'"9+,HDbT!!1&S`)jRf0&#412J5lSiZ@jIBrEBE6!NCNRb`ki@[DiYBiYeq$Be
+a@r62ap&FIZXFjH0-%GFC+YhP@lTVqmddRHiP4HV`8106(IB*+IAXDh9PqN%`ePZ
+G91"&AEkmT2a)Y@IaFk3SQqa6%BU8"[F([*%L%h#Pf9!iB8k43IM2XB3p@ph8E!M
+b'-A4bC1+&)EU)Nb[59@S5C6(keG8M&,5+e5jDP@lJlHdEdM,JUPNUASZkSZ1Ia-
+PF"T2FEVY!fIa[e0@2'hiLF#qBTPI9q)Z4efHHR6E(6jLQ,[Ve2l[fABm$+[0T1[
+D0X,qpM[r2!'T'Z!3@pXapCG$b5*5EM*l@cbeT9m[RY1P#6Q14JF[S`&4(U-9DKI
+'i'a3[`a+ES-V"F#TI6I%NMPY,jacA$EqB2JA(Ddj8r*04Y)IBlH2#!XQp9a&L*2
+b2(@1LQq)FAk%EK(8V6iBiG-Sa$DmVGlKeaIqHaA!"4Smbc2MeP%ILFIK*#0Z$'f
+CaIA,J1brBhA,V9K4XA5(dh"fjF[MlBc(+l1@'')qZjMbV`R1@jjep0S2h*95"e*
+RF!kfZ&6A$qDIYA059bpb)9,AqK1r3Z63A#EC-`[Y(J(-e+CD[CUEf25BBEBYl02
+MMV6FbPbB!ZTI[4LG%bhZf9cqU@mke96AEih*kY(Cp)-`RJX$ap[EHaQA!mbN%3R
+r$MPLZBpN@Sbl-Z0RBdm5aK3U3aI8[h"XHN`l#kIZXp%r5HTZcYekrNe,8MX1MN4
+j`GGDBZeD4QcpfT('aGHB!QH3!0@4XUpaLNjaBZaVYL*[aBmDIk"D`aEXmLEpSB'
++GrE01'Mdqf4QiJGQjpX2"DM(h-!G3(9BP*Ke#FP6bQ-DcL"+Ka3AYHkE2Ze@T`'
+c'I&YHrTr-4ci@X`U,)5hIhKKH,#,21YR-"Q549T&SHK)X%p-"#XYhrD%,f%m2('
+r",iLeXPG,jJKp!(A@H'BDIbVR%GMV3e&Kk[H5Q+#N!$J1KAmS$,9ZD9HV&,lEB1
+p)+c*HF4+&FUM3U$LSkT$r)5cTa,B(l@+@4iV[8(mKI'(8N,lNJ4T*pfk8,XhP*Z
+[(dp6mLIf`+kU[GV-llLQT+G(,IbAB-9("+X+`H4Ir6bFF!Tr1ZXU*A1GE(EAYSj
+Ybr)r'%"&5iKLD"2SD#R8X+B$5)Q@qQk&h`HacSbe,XVi,BlXrJlaM8C"i,BX#1K
+,[Nm@l4VJ&YiQkYCCk5a[1*,UXI%ZHJ@TNN-fU"lXFFr0Y@lj0*&l'1TF1$FHf[M
+cEp"K!F'H+%D*jffL&S9ej1ZD!%6S2b9KKJYpM@AGG`2CI`a$j*5S$4b6$kkp#ED
+$[GIRiF@5(*plia@FG`-FAm1SeGMPDp@pe19'ZXM(*,,EF[cqS'!Dl9%&)NmV(iD
+`*X"2Zid2GF!%*!(#L)Y4e#HC1!L13fcT,J(p-Fp0N!$2L-LN0fb!iQcDU$cldr[
+p"Jk+'8rLmDMk(8ce$Aa'M,AL#TYLI+8Y4qBl&I0ImaJh5Sm5rT+,5p04316C5[5
+$8ZZ8d+S,)PbBD9p'e(L*6l*fZYZcA1cDL,N-1VeJB&T`TDZ8QFB6*"4Zq@9MRPd
+EEAPY*m&h@N$H!*!!ILE@a*Ep3epF,,*Ae,VpMU9RYIa,Q`L@aJhM*aTq*)"`dpP
+0Y$1qTrADXb(#*IT$G[(cc2ac"J6plrE6bKVcKdL*Df9fDa!3-`bEYa)[&m+Ib5#
+%N!#*,5M&-C!!%!-5he1TBYm&RG[m[YTcTGY*P(MqiN-'0J9Bb(XVbPQq&pYMl4b
+LXB0[b8P-VVE(Y6BjbDARB9H-dkkq2MNAJQSNG1JjCm@amcX4#-0V0l$F#9I9%d#
+pph&-l&'(m-9%T@V,Q(kM6FjU8U)-jlX*C!HLPc1KS)T-*&V5PV)-REN@J"S3Pk%
+`P)mSq!lhbC!!YefK64qmU+#!1c"[TaNDQN3bU9D&SD!qJ3`Fd-!h(MJXBQ-Q+9"
+D5f&DDUBTEpb4%CYmSapmHER*Xl5H%E'2'8!U&N@4A`m-S-+`D@%-)hqm%hbYILm
+2bL`L",XY1T2@E+AL3`l'SFaY%Em$G'Pa%(H)CjQ%4pQqKm-V0MPPUkEIL#fRRSI
+!Zc%(pLl4V@pI!-AlL8PfQ99)kF(hT2R&QkU@Ci06qq,([RbM+1Irk`(#!9Xif#V
+h3$LP@rBq,K'JK%M#&Ffd`0EH#EH*D,&316S9N8Sm%YEIic()EkbeKpqNPhrI5Y'
+%Fl`RUlRNI2NNP")33'44ed'$4k@qfEA)[2ZR4fcUTR`@-*`Ue'JccJZJR*%0N!$
+2qqk5Gbhqd%3,-C6MX!('cXa%Y-,KCCEXdmP1#2T#3e-r`q+M&J*D$%B`p*C+a!5
+8LQ&kJSN5D6-&#Dq[qL%Ae@!)2cDX2VGCBlA9PSY)GF%'b$(#8+Qa`8iZr"@XQ5S
+jpE+L0&F@c`bXI9+aCNm6QQS4V!DEdSUVLN*Em0A!2k*@Fc#!Jad+$LVHIaK!U",
+'1E[YC65-1XC0-J2MR%#L6'06DeJMh)#[369H['3mRD-$DZJ#GdKEdl3NQ$"FDqe
+P!Im55*M5)JKB$6SSm(,BrMf$8Pb19EAkHBq3!#+"&r&[3lbR3aLG3ib%(@T-&aQ
+3!-FTS&E3eZUKNR$GI4jL5RSZGU$eIe%d8r%GUUR-E1+`E%)GEdMTV2cMA4-lL6k
+-2r$"LjC-)bqMELfb(Gce%!ifq*!!Pi6T1IHQIpCDcmeld-#hPl(fAlA8S$3XkL#
+SV'XD$0r-U$3qP8YQi%&F4IK-cXcm$d8)bSJ-@jISrj-jL%))ML%TF@6&b4Lrr+F
+ZecAk-&U8cMqGETeH5%,B6$Q"R[R2GX(`)BD5MiQ!JJD-a4BAd@Ll1Z2(X4MYPCD
+k0dE$!'CPl99C)qpBQ%*+#%AJT8*V2T!!aFd[CZmbl1(-2SfLbQPSN!"0+4Q!G6(
+6%Hl+P5ZmBGpZT!YQZq0U`iZJa!jN+ANj)q)Li`RaY!Db[Nk`k9RV,1DNTeJc4G'
+HYR5b5(%,hd[F,$3G1P#NkYm%ZlZhThVF2rj)5[r&!+@3"!%!!$m!!,5KSlDeGB@
+E!!!e[J!!Jm8!N!0b!!p(MJ!$HBm!!$6@!*!%$`"8Bfa-D@*bBA*TCA-Zci!!!*H
+m68e3FN0A588"!*!2J!#3"d,"e4`CE$lla)K&BDBbZk2[FITLL&CcR+epC%hYGe(
+hM`#1qe$mAR92H%jj-)qQiLIZ)RdVR5FcjBB94`6["IYD40CSqi'-h*8TfI'HlaR
+pUL!hZ)+ra6*F"9RYDZ+8cl)`f'AGBlJCh#'Gjim)HZXJ-!11lemC[$UPq)bD$S%
+%#Q@DUb'-XSN"%cXL)Tp[$I[%ZaJAK+lJAKb0h&UC)Xk$DqB2K0LNK$YMAR41ej!
+!XbK8bPMT$,0)0I'd#A@PQARB0`-mbG2qj@ZL"G+FF6e5X`q,p%Ih5V!VEP3Vl@-
+@cZc'Yb@l%'R&!XijkKqkaYM,J`#'`*q,c#hYqBX["26MpjmpIX`,G%1L3*L+kVq
+S&(0UY%)G#-ip"B[5f2hpl1TfXUVe-2KPL[2T89YMK4dQEp+K8,F-D02(45Z8RNi
+11A6r'rBLE$224#BR,Hkl1I-1e"33pF6F6!ejb-!CfRJ5P"(mfe3UBlk,a6%+rmF
+FF(IM&HEe%S5LLEL#[Ua)U++c-qHh(iD*KE`d*1lIMLCqXDlD0G@MF`VT[&$iPXQ
+T-"i)"ja4F9X$UdK0SNpVaLZ9`LNCh`C*H4PPC3&La2%2,#6-,mEPRcff624GpSb
+"42eFc"eI,p[BlVjQl6SJFipb%N1dZZ2MkZ[5VmDj5qjp#8A8BK!GrZ`(i3aYS5+
+mreIq0L%[cKTmJRFj+@h1+!!8h--5bX@LVAj`3XL(im16T6UTk-!EY(ec1lhjG!K
+$U4`A2`[lc6+JL0Krdi4H03RIi@"SLDMF,6j',U#pNEX1#GUHAEQeiAC"DY)[j0c
+3J6,H$[DF&@SDJhVMk@GE@GREYXBq+eDYp%h*VlPVGe9+*q,GAMRk44VQp%ZI(V6
+0`VIU'TK)aVcfmCZ05dV50HN2E!b$@e!kaY9"&f5jC[5qI2DLIXep[X["eDr9P+U
+3!)@BiC90lM1ILGKBbA+)Sl85@m,IrdJZ1V$lYG&MFN[3PRT0pD(e$H&&6DAie&V
+N`5RHMMZ9b2RCq3[9M)R&Pa3q#@IHYFAa5h@[$$`0eFXD*T(HDCHLbLkTHdR2q6"
+Gr#24,9N&6LHdA1Va*$k@R5j!phS&HYfJ@aaf+R&KUc%YjhH)(!jF9C!!-)FN1C)
+,rMjG6qKRfhCVF%i4LP@3!"'Q!h#BM,dHCEY0lXDa9,9EJ!2VHereGqHH2)X#TI1
+,'$ZR(P2p$EFH+ZmmN!!jY'Nke-Spla*p@9kFX3LEA'U$1cIH3R(*hjq(c4H`paX
+TQ"-SR6i*Xa8)e6-U'`HXBh!iSjQ$em@$dhV66lS19epVVl`cpl4XeGLAlZpi23)
+!N8,+M9e,je3HjpPpkT0aMcGH0qDDBQ1&U"302Ea-QK![@"#"B+D9VA#c*),AJ!`
+R4c'jVjlKhj&p,D[jI$B*b!,CZpe,Y0la-iCCLP@JjeaVDL1-3b*!(F"mmL,316,
+1D1$(lB0BQBSceT0*FUDkRPAljK&Up@Cq'PJ2lZQYeHijKp-24qJfMKaT--#Za0b
+LXkB*6+Y+6fLG0Pk@e!SIFAl98@JkkH5iL2FkmZpm&MREA+8UC$d#84r,`qJT+Z3
+rGe+Y4VFDI!j'@18Re9(QR"IGp64c&`cMDK-HjXV)QS4j#hli84'0m,CZ"VE*j(M
+(URjAMqGD93er8qf[q!`UYrBCF`,hjjVZC`JYEH6,lCL+jQC`hfq#,V[LqrG,dq@
+AHJ9a,kQ0m)hh*jU9m+1EMqBD+MiTif['m#`I[`R1h#NUBDD9B$2d`e*h6pFNiB*
+a)p1K+'rTD)bB1eIdq2#0k%2MR2@I[lAXf*TiRHHriV+lb`5)jd'h'B"YXickcL6
+pB`LfKTqEA"UR,b1j2LG5JFNQL)(RBakd3L$!k6M6aCL6EfZ93@d$#-8a1$Ya*mS
+iC0AIEjpF!YK%VS8rQb9KpSU2PX-DZD%3)[T&cA%Vb)5Y5H+XY9*9,+'MRhqlG"$
+4@CB)0bc*@KMN0JHa2iG4SQIbZZ+lUbI-mU"2k*KMi'%EG+a1&!kPF$hV`5a*Ef1
+4dlb-a%!rFc'TKKSeEFZ3!&%*BB8i%34D+N,BiQKPQHVZVqcpF!`PNPBB3fpF"0f
+4T(bSPVd',e`QG+2j'$h3Eq[%e`T0F,4`YSm6J4cV*f,9dliX4mmM&,q-A!Y`Qhm
+er,NRFpF`)3FFe@TMcB)SfGSkIp9Xie,9)q+JMQ"eY[qBT!$C[F3`$aT"5#I*T5&
+Y#T!!q6'2Y&i'`J#0q6HleI@Yr(1MYL-1NeJaLLYIDB&Z,8T%a5PD([[b+QQV(Jh
+3b`5THQ%QB(HUT-j0Y2p8cX[-9'P6rckHf4m&Hm6rU(Y6m%3DaT%%!IUF5`p'53T
+M$SeF&p!ddGepCiBejJSQ[cKirTSVGV'%"66jNi(iKq#8RHaklp!@8PhQ!paqd"Z
+S0pX'RJPYX"KZKK#mY`CL0G+U(93l'#[2)NTlYJ5ZdZ3C34pN#iX4Lr-D'aGb)YU
+2N!#)*[Emq%cY&lTrX+Gk`'aQJDl3dHb83l1``0Z+f"rZpJi@%!ZaK!`6hGNhHFE
+3Z"`6JG9,)iSC1*NJC$(l%QRRE!'#FCTiD51,KI`1KCNmTJ0`bYLSkI+PZ3h4aSP
+V8lH*+dT4'p"@1)3((Car*"iS5M,1C5emXPiYp$lT'-riXi(qcS9Zb5'6hFRhJ52
+Z-4qFNhqS3dFdaeE+Q+ZJ4"jCUcDKGbK9L5edl'H$RL4MkKlqjBAC(H)GD&frNM1
+Xm1A0U['99hak@mAIam!mA[@YmqGkT)+2F1`S"+q5@46--8ed@e8Dm4Ld,*hf5$m
+IKeXN)IJ9p2M[SI(f*@T`li$G2Sa9PclVjq3,i(CVIqf'REpii8)Ye[k#F5"YN!#
+(F-,B!L&69rM4XA1$mfDCd@VE(0El2l(YkYMKYRjKmj,U-43SUb'$"+h@ke@qc!'
+(p6H536YB-GC9b2Rh"pp9`'K4!j+Y,%kMk(S*r1miNcNT2#-Ulp%keFk@l+GhP$M
+c%@VT%AYQEb6AIp(T!396MM&akL!Iefe'TGaZ!lfHr,i"l32mqeI1U6@eecKceXC
+-*eXGT9AIlj6A1G``p%F&Q82*T3qS2F4Y@%a#+h!ldN2PX'58+brlLM*DDK)%(DK
+!%3VfkL6Z9cI#Bp6#FB,GeQ9aja-qiCKmHTc,d(5UYU%B,B@M%SPJ)4pL'XRJ5@p
+90KkrqH-bf9e!BQf"Dp+TGPA-3(Y*8d$52YG$35%%@m&r`KAK$H2GYKKlJTBee%b
+-brj1!Bi2Pq)-GHr@JESNpV,Ah`PV`-UV`*JqJhbXbq()54@&T@%$BP""DkVkjSk
+3!$fl[NT+5)-AkJ0)fh`l#f0pF52K62lM6++0CmKX)BbQDf6@M24"mh0-e&Xc8Y8
+PRJUAK"di)MHEJ`LEQ*Q!,%+$[jpcE6$9Ik!Skfh9HkbY0'NY@BBAid3i$lbY*V4
+)5UHl&k0J*`UX-GhiU2plGq)ZJa5rh%3i18EYMXGLeQ32)U)4GR'5'NCJe5"2LH`
+GDhE@a1fJD*L1!T!!2i[qXL3BAVPrP*5&)+`%a1aCZ1"Vl0$dEUlG+$pL`M@!bcj
+ST`f[pD4#2"QX3UZjAH[&DI&qc3!3Ir'F0ZY%+LFB-i&QH,@42Ub'F4`ABeU3!&9
+(2eGGA8m-PDNkGk[I*D1+cZ(NRQ+KiGB&p396p1U+ZqITYbLNb*AmP%J3CYBcl&'
+TcT6MqJGMbX9VESHSE`6G'Z5H2a3YIk*ViJU+j0L1$(aK"N#15`,GZi[lJ+pR)`[
+hV,d&YiUQACV5[Xq#LRD6ilV`Y5EC!'qJ2,e-i3jT5,m3+BNX$TAj$ck0`l3B2bS
+LY@HCXQmVLXl!(KVCITFCEGl@0DfY#RNZiBc$'S,`lAr'NG[E(,d2Le9@$d2E1`V
+ZrR1DS[3N,d,6m'SkCDN'!Ma$l@eBTFiRqY1cRU!-`r3jeHKbhl3elT3+YX@Y*U8
+,i,VC$SGmYX9Q%mp-[b[T0Ue[f3$'A$VA&$T8$k[XLkU!+AY"M%(iI4!T3S)H&c6
+`h!)MabF1G6S#`,MUL"U)3)1#[JPEG8HS`&kl`hFRL-%*-lP%K,)!Q-D02bd!XC!
+!p1pFfaUeN!$(PSekqI"GeBC4%!',"Fh[Gdm%L+j@AE-TA!@Xj-I+VZc1Rjlc5XU
+Nm+($Ak6BPk0NjGbMm#i4UE1X`X4!ca1&CF+@%0T5I'JjcD["MCZ#GT!!3(0!&(2
+J'!SeCk*BI5[cQZ@4$98q)0QdL5T#VE&Z5i4mfh(0q$*$hKBPU+c[-Y-&dXL'e1B
+(pN*5JQBS#'(H+,lPA*@!PpcE0D(kXHj3[0H-*hKqcQ3X,ArU@VQ4eD-SK889h(M
+N!ZC!m62)Um5QM#2kC*X$NqU0KJaH@4-L4ck0CAfIm3"rp"K8PQJ)L!*Hbjp*K!I
+LGPiHT+N$a9DD(qD'j4[-I-jYj`Ri2)B#Iaa+q,25D5$@*mckkG20M-`Uc%q`c*P
+#XCCHBP"+3lq#XqC@PQlGL&[iRdeeFSS,08Cc&M`jFf5$EClRX5XbrA[fbc59Hk2
+5"2KTpTq8,(N(V$)jHK@BA[fi5%V2`"!ea'U*(&XF'#)C8lL!p%e%MU5dq%9lNaP
+,F+YpCZifCiDCfD)G-9A8l#80SjCl-h)K`hlMaJBUbmcC9kK8-BelTShDQ'3*H[U
+Pl,A`l0C$[GmG*q6c@[Mb,8Gh'C`rDmaC8CT0HKF#c,Y`GkS$X&fN#NlFN!!P2"B
+`E$cimC[ppT%C)T[*m4h,ENl'FJ6ZKTA[NbVD9+8#*aeGJfVU9XDFL[*l-)&&(lp
+9B(i[`hjG#-8#De#+)Rbh-()'NMB$fiSfEP,%8KA9Zr$R#Vd&A#hlC0ajL,(ZY9D
+l'pdQ'RZd1Z2$Zei!lY&ka0-2G`J[B1XE%X9$H8fj$QL!(bNV9F-D3#aBjVlA9CZ
+9e0bkDL%1Rj)2655I+6Li*'Ma*99ZJ,Gj1DjDVG-@X*Hm`H66,T!!iFR+NXP"QGq
+pea`T61T3pXdlFeaN*Tmd&lN"%(06"%pKci3rC#+rbp2IeQ&VBEV9`6'E[2rUTf@
+Ze4Kp)ejTpM&)ek5k6l"cUPq6BL'#9&ZNTkRLV8LT[-j*Zc8RB(pNZqbZ4eKkf2m
+3GZkK[B$Ch+'#T*%&VZ$ACdk#9'i"[ZBZb-DP5p-3Be-YjLccA"42fJAXH@h6XAG
+&jL,GGBCh(["ij"5K&R,1QfRSJKMeLYa,klfU'`P9P*XBR3DLciG)'#L'KrC(p(I
+VTmVm5K+HB,PaiFTr3J"#TY+Y0E)Em-4i!G!#h1mCbILT#Ndkej-jrKC(kFa`6Lf
+h`L%(Ek8kai0VfHC8N!"S3R-kim`6$b+U!llDa@+SkCSM4hY,SNHh`[,'hd$$KZ2
+R[UElHam[fHd)fE3H(11&Y9,)0d1!+G0M+!*SK1eX5IBqERGS@e5%b1eMX(rY2AD
+kR8Lrb3GlYqpXc0Xr'ZbicBE)mm9%NG+5DB4c+J'$8I8Z9'5'@l0-K$GK`MV(XP[
+QJ%V"$8Gq6HPUm4$3)1j,'B!G5$)%frYFJcGbr64'Z01bQBa+*,+eRdcKk93mDa[
+JSd1FKhTUL2i,r**D*Rqqam+3!+6JdX'iQ5dj6&[UVa#%466miQMQIf2La*TE6(T
+XrdY-!aZf6)4@)4@qGeGJpHVU`NIp3MKZAVeE6Qd+d3!`'lQ6@YJD8G$0[MqISPl
+HYR-pa-j@Yk@2(C&[pZ2QYCUTQ0-kYE([F"R2JcaF!Tp*0hcVjj0pGjBSbEL)f+b
+@h#QKcp2(-QmbU&"FaYB#H-QfMNDQBkPHJ*28FSc&B&akQ+i3!l*ppS9FCGTl&K-
+!q'qd#8raHMce*LIe$*ej5Fq@pGcb,"bQ4M(MZ),1M4NB5MUNq4S`MqJUU4BZ#Cb
+9-'C+l2fF&AZ8lhPLY5JZkH+q1p4!f1(aZ3m#4mrmQP*P1d$f"ppI(c1lqMB6"Z1
+*F@KV3p6(Th4BbRP[Q,Qbm3$"FqfC)rM6i)C4(l8VK)NAeDS0JMd`Fahk$lKU%@E
+j@h-@)f!qjEDUM4pTJUKiXJ)28E95KL6HS&MfQhIfk0)!f%RFq4M&YKQTkNJH&Jp
+`N!"RZb!H2hc8L-k8bB"%K9X2$VebHV(FN!$TeS0LicR!Fj(D"I5,i(GiJ))%+4'
+bM9Rr!'G'FXQ6H51LM-Q9,cm#cJZrpFHbqTS!j9P+pNlhTI+"I-i'5k+4&k$dP1b
+GpSZje#AfI)Vl[E20a+lJ`A`bAdB,N3`p9ArAbY0-fX+Kc@MaL%qJM%20,$@3!&C
+)9aGL!IEVUAB0KR#mI[`X%2Um5@@'CAGHUM"KFmD!pPbc,ZU*YPSiKhF)HCK3TBr
+4d%ec*!PRQ2(J!SUTL@A,M"IClQK*rlQ4c@0@!MJiR"q,3&"mIA$9c%qcC!h,b`G
+!XPV%19&XKYeX,(ZY&0Q%IcYF!hmmdX8,5Lq9KG153hf-LJ19+NcJ2PIGRj,%LIr
+ee`ad3"b,1XUP,*(p6RC%jm-S[-dKdiVGrYN9@c)qd2Q$,Hd$LN1J@Qm#CNCQ4)S
+&r(ZADd%*X*dYYP+9K&l)$j,!eVicJ)rB"QThNIVda'ah$&28-HUE1jNZ1[DS(c1
+V@[T8lJb4"$VT3CDB&*DN"rbF"3,P!p2@9pi#e%C@P9S+GC93K"FFD(4G5YeRqbC
+h[2H3!'A!G!Fq+USID,pjGi(p"$S8STY8)0K!CU@p&`9cIKkE`@8[&@&eUD0X%)d
+6ES9+e!HjF@8lDrY&#Lh&FM@Q,@XMdiQE1N,YRZ!5[0`,2&)#N!!HJ-YN5(DHifj
+[Y@PUcc)h%NDUaMr&Iccd5NdD5`fpTP%Q1Sd,6G9BU%em)5SI[)S@0T0c,)cFTZj
+MQp[!M#HPZ#bJaRHY61"(iTqI"qER2LQbDl!#TpP6P0jNd,+VTTY+*fGLY`5h5i!
+fR01qYCQB1[&q,Ji%6kd[384#l$QkCqj9HH3dPNa8bIlV6-0236G&!KH(GDQUl[@
+6I1&*Hr4&eNTl-PBGYc8V32Q054aj3`L,8!4'KqY,RrGKCe89dkf2,UUJTD8p'fH
+EjBr`kkVLIlTZZ5+bLI,V%'mPp2Zl&+R@YaAV,[JTL9`jk5$cE**X1$lGr)J2p0p
+4QR0#@(ik%Z'Qj,Ee2+S-00IK6EDNAa+cFC3"49P+M5`haNH)F-L"YkddCA[mPRH
+R6P)Il@1)AaIF3r-heJiRCP'E@PmM)-l2j6h[aVeQ32BU)Nd2LQhhNS[l[9S'UE0
+[&hG,`$dLjFYrbK6,QTr)Pi@c8$RIM40a'ClTbHeTRm(YCmNq!0`"BB`mF3"QkS[
+1G$#2V1BqI-K`GF65Ea@)*JdV(c[+%(&&3BkpX$A0p9p`ql@2bkrMclKF0KVD*X(
+*J"!rUhm,cSe2MBe+2Q4#QhK'X-$NM2%DKfGEGT32Pk8AYS0rA!d[mdm%q@LBFU%
+Q,Z@Q2$3)Pler@rKR-9JQ!HX@3bGE##2iGhGVZ%KJQ#61MeD`J[ac2J40UH8ZXX[
+(DZfH5kGJ1dm9Tf@Y(UREB$rkYUCQHpm-Pap(bF8G-GjXhTql4A+@%i*D,mlmB5E
+96[`C$($F5)lA)h1G!!L(m5%GdSRbD1X"$`j2K,VHa,8#&K9`NR1NrjM&00e%AD'
+'eMm-'b91P-FZ+#M6GPT(39TX!J"p21pqmdpILD`GEE%BBGEb`pDQjrbAFX59QlF
+!mj%c#dJq6i+E-#I)J"[1kYQViQqcF'fVM0BJD@G2+U&Z!SiKd6re!ZpReHfTmGS
++hc90T$6-8qH6pLcUYJDTYM9DCbLbl-UI+Hj&D&IATU+9ShCZKU$'i*HU"ppKPYI
+%pcCB%R15kC3UP)))RjAC&VFr2Y1i`[BQU$95#q%$[r-jG)[,3"9AVN2XM2Kicd9
+RkKqN15kJ)"RN&N!TDFSJAaH*U2-IqiAJLSlJ`Yqd6kHf(JIrmPQP"MHm1rG4+UD
+kHmN2PNd$cEVe&U-1b&m*rYP@S3k2+4)PcL,0`T90r*X[rLl6hm0$*CEDA$fJ$NN
+)lS"'%13r2iLGT,Qf!Q,*!+HM@(ac&SGX3pECUkU*!rBX48-CaleRd2VrjImP**m
+'bDVV)E%1NAEH2JhReU)qJjJR@K#"HkM1,UBQ,A[![b[9XP1SQDkhid6JcallFmF
+SHbA35EGl9e)LfbKUU,IP#I"a36hI14RLF9Hd6l1SK2$XShB#&aq#"ikDMr500de
+e'c0fqG9F(85(rFd63$&[GB(U&0+Z&6@CmVZ,%LBU8c-BDbYr`k#SrqrK%#4bFAV
+[NC+3!)JN!H#S&3,I!8H"ZYGf2EYY2dpU3$XE)JGi()CHdm#ke$l2``)%D-TJV5'
+'qLBKE)dm+lV3`$NHBF&l&SX!h-5L&X4a,m"IkA-SdR"02qMDpp`!)I[%3IV(iJc
+eV3h2lF0$b)4-XY@Y(b"(&J)KQ3X1S"EXXKI*BYPM`*YAA)BVJ$!HXB#1ITcV#&1
+9!mG%#!dXrkV@(ZGhpbFcES!$$P4[Y9BNVB"!jK#HGl'X,RHrrFrNp`qqp-T-VN9
+N*4F1)ELfQ0'TL604'GC&AZ*k)aQ((j!!cp[Qc%2)b&(cdXRZJSG,TCTLI,*52*J
+DqY('RmpaLcK8Fh@'b2*KG(@1D62e,@X"S)YTrZ,QT!"$kbKq+6(`j6`q)XB#Kl+
+6Tlr%FUY-`ad#cBQB"V``*Tjq!+d+i*p[R%2",bNcEep9,"i%9F$kDej`Y-,`6Ll
+"5%RBfhT(,2c&r&5r+X8q!iZE#+"fC*f!,HN@c1$YmAU,4Yi&`i3&"-ZaU-6%'kU
+6kTXGp%9G-)&IA,%fckp+c*cfA6%)frXqVUJQbi"P0i0Lb"lDjV`(kqLCiCFVi`C
+Z$!!MBVBPeifECPRUR2hU6BZ9lhGqJF03F+PG`*V%Y,Qf'$BV6SkXMM!0A00hCj2
+`,fV2R["6%98F68Z#k2$q[3IXSEQPh)h$5'5@Ak'ZS,ZN3rZmJBL"Gk)S"TEC!b&
+(-)KH*&ri0ADkDi30kkR8flX8L'5#ek#aCSf-D[jV%lckrVA0b%#T9$-e!LJ0pfT
+"EK&-Z`G'QBcV4DJ$hqRNT%chK!bp6YRYGVC5!c[j"2m-,"bMN43&B*BqVMQFeNl
+6e!BTMjk,LRe&E[,8qe,eKj*Zd&0mjl+J$,"VqD3Mp"4YYrFLdb&IDr$bH&EBQ$a
+%N!"%T#-S@P*aJQFdY+*,$m+GLG8e-Q#bV%"VTljhFkhJcBZ#E`kQk5@j`q4bFJb
+h@Z[$APY0b)ZRV%c+La$,1dK-pDHQc%&iUCJlVfJVh&@8!)c+rhCpdA%mA(M'0YG
+Kj81f[c3f3YbN#ICc'@X+TkI6#lbj+aKRHHT'fTS9*4S*IPkR(0FN'QTC9J0$+qa
+3!KNVMV,6IQTD`)6U'rV2ENB$aD@0pl@KN!#1!hbeRZ,U9mV5Dc@"9M3rUFLB$qm
+aRfM-rVRr(NC,B6jf4CCrBY5%PTil8cI&HKE(Cq*VR$m%1QPY#m6d@i*!S@*8ljL
+fIQ5RFZ"GaV(eDm&EN!"hAM5@-YMcl2bj*2G1c-eMc!QAIfj2el#50XUXXVbC4Pp
+YLbH'9hLGb6adVb1JH`kD1"`DZ`GUD3iIl5VH`c+(90-i93'09AX%)"Lk!LP-Apb
+a"dRM-jHQY,@B`aA4R%$Q,XNCmY2Rm+Pd@LDV!bmMQPTDAJm0bU,GUA#c+f'Aa(-
+AL,SS&c8Nf1+kP%cBZ&eAb8hPEUKBeZb#YND,XK8pkTCJ4R*a#lBjri8)mTY!l6e
+Zmi)2+Cb9)PeZ`4I@cqCkDkIFJM'@Nk-p5288C3",DJI0l!N3Lb(`kD&hN!$ca#5
+-#lEA(f5J,pVbe)`1rSm'$CNZ'1[C3*a`Pm+YpKH5N45GBUmAS-!ZiUYPGU(kV%K
+Y$Gbl5H30Vq&k[jcM-&DjqielAqiZ0LNLX$%,5D"JKN*La*YpSfLL%4`ea+4Q1YV
+m*FLd4&aS%R-D"X`HreLVTfj!!'&mjeJ%9818d0,!d*!!%AjCh2c54QaDYq4I8Zj
+'qeR(T,UbV8aV#a20%R,Sra[Yf%-N#J2M8M49&[IJ%IbDc6NV8,S'p%`KiMIir[9
+DC`c8c2XTf4)e#eD'0*J51Je`XZ@+eYdbh0GELaFJ5#U-[8kiCPl$l0`r'r4JbZH
+$3FlH)f$E6[Dm!`hdce'PNC'LGGPERZlXJBJ-lBI2)D+m`(HblURl2NUQ@8&R)K(
+3BQB8"9)H154kR(e2*EdUTL)eC&41JmR"mSl3"&mFXJ90PZC36i-`a+$PJ#@!K2*
+cSRSkKkm33NGUTdXPq[L8`2AP%ZVUpB+j+D`VM(m`N!#3!'UJqKQ"D3G&@3mh,C@
+Ah2BjKTBD0&2`UY*j!Lq19m(q2&h,ep9kNXPdeNr!@GKI3fkc,map'1-E2j8Pq0k
+SfX+&MDKT&i4VRL@drQl(iMU'0$R&BQUIDRC*1DLbj(%mTH85J42G-ZMd08NeS'!
+RAR%rDlPJEq&I#BBqd1eF53BKTjE*UaaSCp[X!T4'iJ,-!(#df*3q'MC!G&bUkiC
+UbjEk(!,c5LfZjFHdb5Yl'Z2rf`V1ah+P9E,X@C8%f0,G-2U&3LSR@'$-VJ$2kQ)
+(pCX-@N#*H14R46APl2QrV)NDSm'q#UX$$M!KALSk%!$bJZPHZq2X+0-Hl[J*YY3
+V[Ib5li5,IkXIpajH28V!MqbE`rjdp8XS1mRX-T@R'*UY!-Z"j"6kbq4(E'AF@mC
+RQD'G-HcB`ZbH@6L!1*)cjqDqqlYbKAJCmfhdp64C0JM"NjSf!8%$h4$)(MVfV0&
+V!lP[`SfaATe0pX)`8EM9pKHD%f3l#*eHT2505h1FUB`9VRHYfa)$lCTmb,A5N!"
+cVflG9Z'f2PpYUakAe'KmK08"'3YE2hpm(`*l1N`CCqL')kieeZ("Dq$`GfDaN5R
+jX'"c!*SR$S,E4F#!#Xbj$0qPP&G&b#AL,2BP1k3#eNLXU&kIDA#9"ThGMIAS+TH
+)r,A(ATF4jFN2`EqR#+Ec[83j0TQPb%Y8+8a-K#TQQ5,(3qBMp0)Va6#$C6D,%Rf
+LA&T$6GVMJ58NMM2PPSL,*BIUi!dCbSmSdkCQKG',h@*@(cKjm-9$5I*DqFHHef'
+@h`!+8NMfmkAL9)-eLZV2M`h)HGNdL"QFMT5h6RQE#CB5X22a-@Qd-f,$Kbfb%X[
+-"*N1dpQ)1Z-J0VMiUDYJMh%c(#X,Y&$ma!D(AYB%VX"0IfAJaGS*%8(l#N6AMc"
+hI3Jb-&"+V5IK'#[`+TRJdA(#(UA%G(YL-())ZC26hljK(X00Tiq$#Sr-qNAI-Ak
+,eLTRUc8NHNAiJZY@E[E`[+UmVNCG%%A,@69CQ4qQDj&P!,qkkFch+99dk+1##6J
+4$BTE0*&AafLlR,BcSC!!I!h6Q,kbK4JQ'5E-(jBM$Lp98$K*8,@Q'N"h$&ir09e
+lGUh1eh"HN@KdffcSU,+!c"Cr8lE#8j1Jpkj*JplDX(M1LpJG,ScYGISIBhZ"YC3
+PGS08X',Le[qkpq[f`!l@Z5#+dbBURQ1PJZ')lDdF&%HpdCGE('[!MkIXCY1e$5p
+LK9[KX0jFj6qGZ4m6)KHl)+TpMK2YMGDTj@kY5[k"emBr%$'0Q@K,!bEA$cQ`"Ta
+YMD(JNpk3!"!V81ZI[DVI*h)kkKKI'fr2b0)L0ak!IE*L*PXp(J3qb[4FTk"`NJj
+PlI2`jMphA(-U[Ecc2"4Ci8bM&8&H2rXpdm"(q@(F[hU"Ah3K%4NfkS2iQMDZ(di
+)'UM1Y+9kQmVrr%-[IUTm4`*`QR$)D@5U*Me[PeV66c(IQ4S#$SHm$F`5d@rTkr"
+)f%NpK6Za'!h,M$iB*-D0@mR9l)8)4IrF6mU6XdMR#m3%Mr4&JTqT+2VGFN**D*!
+!`M@)cU[q-EYF13-QBiYI&Ll+Rl9Ql@jDmdaRIL5Te-TcpG(,KMFadB1iIDDpP(,
+Ypl"69CEeTdlK$83m0$blJIL)8eA@Qd+25FX#pS6!@6RViT("Z1qJYBDiI@,pS$D
+A)Qe*%SJ,RQJ5iqGR`e66m%QhF+LZckZlFQP9fh+P&2f!0bP%D#d!#HjCTj9+8d@
+*19SlEb[V#i8(ArXeTaIVZ!YX`TU#4cME5)VQp9,NPcaGQ-T6q&*&BX5LRRDXil%
+[2qmDf0rLbCT#meKmi&*2,i@IDhp&bf$4r#S(-c"CHXXE4!9i0#e9+*5S"me)6IA
+4+96IqNMrX%"[X0T&DDV2F13M)@[eekIT"PSLMA"EcKBeq@[EadaddGP'c'cJTK+
+pr(bk0AL68*1)'RQCB@L8(TF-R2-,kK&6"XZH3Hjh!(A@Mp!P&PPKh@(YAJqY2+D
+L4QilAH12$CD2EJm*JmcV&JPh[Hf*4U,PkR(5P`dKN4,Hh'6iY($QQP,!$NTr*`c
+)RJ%jE$c3l5VHGkC(Nc%Qhj1hE&pZ@2k5pkQb2ZAiFpN&#3mp0A,f"qUY8'['+p!
+ci863l,qqpk0q90GYpehkN!$(61Q`MPm,$PZ$l!P*ZheUl""!$a%I#5pRT,8eE0e
+85Y'FT"Q`K+T0jiYT&#08dSJe(ej'P1*(1SaC(@Xl"")#a'`ScX[B2Y9ZFZl"JZ[
+Xk&[68J0$NbNL3erd'P[j(fmVS4)+,1VNh(3UpqmPqM)mH24&4m!5(9X@I*c+aKL
+(D(pXH(df1`EIBT3U!H84!m#SU"f"pHejeAXGib"KqPY2%l$NFdCPjEYlhmk@TDH
+K5f*T"5iEc31,@IGU-j)aYZ5eTa'!GeKYFla&lhFJ``K-BFhkh5!%G"(0Y-rMJ)C
+Dal,L9$5lmb6Pa*PcHHMaq`5)@6E%mJ4Db)A-R!5hi%hJrZ0UL&)Dj@f86ZF"1LK
+T!Fb)!''0fiB$lmaRS2"pB4DHbHrj!KaG@G#2I9L&h0R)+SYa#SIMa!(bdACF%h#
+*9i60eQ-LB0UQJLFbip!#Jm+[2C9%cDK8r*))e1#(ARLIiqT8j@Bb-c+P,`e"m$H
+[,64*30Qe1Q@4Ja,Kjd!6QI`ba,!(D[EC*AMX)kQ8,LhmqkG'fRi9Bp$9S8F&bL`
+%-2PBT&E9ZIFVHfA&4MTp)E38"CqU3@"jmr1b8kL8Hf&'PbMYUYVGjl@m1rpETee
+l#ki+[-e!5kb`YIiKN!#e0"f+FDd[dI1eRLXHR$,b*Gf-%X86Bpai,K,9+4946Pj
+fTS3K$B[F4*iP-05BDZ1piL9pLTLmh5E9Gbp,5fQT%l&4[4IhK4jD$+fqh&cXV!"
+bXlCIR3d3a'YX*LicY($6!d0Qd$FAVHf!$rM024[VeAa%MLeTTG0Uh6q58V*#MSr
+r$eP0U`Gl8LmGqcbQeJj16eBK#FQ&95,KIK2ZbT[r008,!)"Y#"q[3""NB[5`Nke
+K3m+1YbjBG#aQkA0bXY!Z*l!Prp2-DAb+`El6*Xc5m$r$S2rrE&6p0l3CMFK#AKm
+,alDV"(jp8Ql0m'YkQSd6j&qLLFq0+8p99kK#)eN4L4A[$Q*5+RCSc"!&8QAZa!#
+P`"#Pl4'IM,MI,JQ'ZAA5lKq0j63NNG%Yhl31cj4JqT0e&LRcEH'bR0!KlNbr10$
+M$AjU&NkjffaH"%2f(I*0H6J',I8kq$j!TD!SibLGB[[Xb`Rq,8$8f+ZU8"6LkkH
+$pfJY#LP*UrD`35fMH,Xl#8(2mDqN8BqpATNSS--q&UZ#J2)r(*UF5#3QIKc3dEc
+J&qGd3fCYl,#i,IH3!!a8HYXk8a*cUCTb(BjpSl$Pr)h4'lE1f%6&R!h39BY0UY*
+fYh20JKNhARqIDIbIe5E*)e#2fE-%+aJ+6TN5S[bdj6+3!*MN+KY3bpLRYb5&@-R
+f%eY[*5X+biY6Q+cq1GX-@U!ZP3mMC590#a"bK9hUmCp*Sm[@)r8N2TMRD2Em9"+
+k"G0*0('-(F6@1JB#TCDjfiee3miZpB*L+RXQVMe5T!AYe5!"m[*f)iq+j$8Jp!p
+,j3@)C,ALS#bDQ2(ABFEN[lT3i'&Prl,(h3%V6*4`DYh)M"59M$-BM$3@&4`R1Nc
+(4de@@%AcmTee@Aq2!%Yh!`DeVBjX(4&5(,[AKGmiPG*pF1X23I@Dm,hq&-eZcF2
+h8K8dm59'CF`"B(N@',DRR(NSKT9bValF*RhJ0``C09m*#-,SE$2crCdU-9Fk$L$
+XREi+&['aI0PSY6pUi%M"+,Y'EUdDdlpdl9kq32b#eLM9QU"&C)6aDZURMp%VFi+
+U3D1!&l'hFBc8YeLkpNk0AdULA3NN&mUFIPV$d%`)eI8!R%1@prl4XN331ZQ$p[R
+`1D5Y)1+J`b$q`ZYIl@2il'8%#$p"m%`LFmlpI'IpCIJ%N!"j"`khR%Sq(YZ*h%q
+R(,JJS*3'M[VLl$"95**$&i[frXcdD'GAF5GT&FiV6`@*e[K%1K-E`kNVDpIDp-$
+HLJ%CFH-r")4ApD(24)`cCN[bT4dHSmM#i#p2MhKef8EG`UUIhGY0FI"Q&m!Pqhm
+K1q""Rk8%@DeNTM9"q$)+*rHEkhi0$&IEfq,5I@V8BUFaaNh'YAaKJQ4N2BaU@H+
+T!DDQbAiL`R#+Xe8XrU1B5XKQPe8*1h0HNNQ')lCkpPa,IKcUHl5k&$(H0Kc%F6j
+"I6Z8"jVYh8kA5T%Imm0#lAPY&bLeQ[`A$@9S91h$@EZ0VFNJ8[&`k1r&92VZ*0X
+rec'6T,Ylh3k!a8Vie3IJ3FF9[e5D%Xk@GT4B@9N9b%HZ8AErjKKemTN8(Ai2&c1
+JKK9$D6K`0J3@%$(80TESTGd!U*!!l-SU["qm,'F*IbK')A%)Cc*RC(RM@L!KNLi
+$q)hLRdR6@I%K*Qc"eDSf[94)ZkcI"PfEl!Db`R&4b*!!1cZ4F0-Ga%mL,SIQ41l
+60kS%6`c)a',5XjjXchiaJ$JR%+iAHD1kE#lS*8UcQ'#Re!V&%p9M"0(aq3PVi#6
+T9h0S(E+1VGE3fqAGFZ(RJ%[1SZrG#L"rPeE-9l-DL9j-kBBCIFr"3,*+l`+25!6
+q+e!CNd1bLb4HHFUe5$JAqTa1l*(9elQYj2APE`rH4aG5KU3KPIJDFF,'bT`lBm)
+!B`YHLQdJL)[edi+YqbrVeB3"B4PAZTGP9T!!8'%-4mD&Z#pc4QJ,)B+(j6,j#kR
+&22(ahMG,9$Nc$paf1M$42kXZ9VXQ)CS"Ih@fQ`f-piKGH"hAGlGMfFM-CEEfR9&
+QR9%kchMmKq'X435*!'MpZibG8hl5#Y,q3&XN`jQI2&JaE2)@Y,fF$ibhk0X`m9q
+SKXl5$dGh!XPlCbK%*Yr(546Ae&KE*@*q"ZQbJb",YDN6Xc5LfYqBBUmjLN,T$&8
+rDe`jia2[LMB2A$%,#&13!-q$H6DlmadrPqGrSj6!-#"NMA6LEQ9AQTNYQ$*E5!Z
+eS'EQG5rj$B%$B`AAi`H&DmTVl$mIZMfeD"XKN@N9jN@)hf@`MLpC`FImdf$PKpH
+D+%(S[Li6fM#A,C!!!Rb9!(8&FjllNkfC)+9KJ)#Ckj@"rXjjPSZ3!&e0FQV-%X`
+Jl-5d-h3#LZII85URY+&Fc!mLRU2qbJAEP1+DFPT%hE[SBf+JV9281b5YlSM"4Gf
+3!0A6XMhpPdV[6D$M6FQL8$BE@b$+Tdc%a"B3PmfMTq(c'RVKrX[)ai8E[J6hr#'
+k`4L#b6kqhqPRV!2@(B`dpam-Tb#!RArMLe9Z5!'$[1*b#3UXU*BT5ck86S2#1Y@
+LpUblFTh$fl+RNp*ak"m$r@&1BMY0Uf1$J`V5Q&Di!TM!kVdB1-8d8@I[GJMP66+
+Z`qVRcRjUXkF%SSKpYC(#@E6aB,19U0LARGp+"E[fIUmSPHBTpAE2DKaQrmRXj6M
+J+E,5c6-pF$G9@6$3b-h55qAi-Pb(j[T8!0Z0ZMq16@9*`5aEPJQi"9aEr!0"Ed6
+ch*!!Ra)ddFMJ1,Bf@FUP4,U#%KUN+)[-NQj6,!lC9f`i!Kkk@5EEl9I&a`)Z,Np
+1VQDRqr8p5ePe)5@CE%bfT[R8U$A9PIa(jM*9B$lB5CdfLZPaQNDL#8MYSQLUp6h
+c5TrrR0VEL3E0b1'lFlAfkR4ZrZ)2*(c%Y%T%N!"SdPXdMVI6&HEfi)FNPcQ8D,m
+KlE[2`L0DFYYCZH)Te,K6&f&f0p3qGD'8@ihZ2K$DYe2fq(8r@fS['"j(ALmJ(dk
+!kL6Z&jqaSUQMX[K1)Ic,4195T`TerF14-f%m3SL%4mM,kbihAd9SHc3!&@Ei+(V
+-5LUdZkq3!%UR0qm0+lEeU%4m)4HR$r@eU51$Yd2maVKNlM&'l90k-&8$NBUd'6%
+Yh'+4rL(p9L0h)Z91rYqI*1"IBm!j[")&AlL)0DY*4jp(CMTm)p3A"'PUD4ir1C4
+,l3)cHb25c6QYT#)AhaCS2KKIl9-Amh0XCfX*dVq8@AMae&If)j-FZ"R)MFG@ZY8
+ZMJ#%DZQ``U1+E6Q)M%H54U*LCY6!4`AFV!E$FR2h4,-E4#8M2S6r1[cF,HRZ")N
+505U98k1@`-qQrU$XpHme$6UdHr'6TSX$60,,((#d!&eH#aHfT!!X$kk*Nk*ZGA'
+``&&K!"N)8[!VR!e'f*rl%DVITRAdXlp5k0'N%K`kX9L6QkGYUX)AmS5EFZ&H#Hh
+cda"`ArZ[iMdJjIVKV4fT$V*mC[8I,'&j!C,KjZ@%'Gp@mXV5r0aTPijN*c-&c4U
+3!!mFC!d*Jh,YkZ,410q$lC*kHN'cJ'CPi!Y"6+UK%05H0BE#0qQpEBKGhN,MMf0
+epR!rX*e-a1q0S6d*FNYkN!$E9lDYVB4cr`lS!X$lciC#+RT+6!'T`(f*`!RT-X8
+ePIQF8VM8``bpkCRE0UKFHC8k2r(eYVLR!@IL0eaQ+13c&S,'eeBFP2CdB"FmRqS
+c,rlVfe9V3ZPJ-5rm42ZRC)MPRCPL$@XQFl2EYEHE1D@4kBXAcSK$LJfRYZLmQ)2
+48-1"+RH!@Qe"-"3a@Z@YS&GH!11Vf+9,PYR%kL3dpElRT55YpqcYKcki!#'9JQM
+CFVFEpY$kIq3rQ8Y4fc6IfjF1ca)K4R[e0cN*!aTe3S*mrr@)qdV,DeNe3NDma9[
+@BUdLmGfl3-VKcq!")LVIP9a6#B#ChAYFilrF&'8,5KNCQM*Y(*!!(Vi"YA`4fY(
+%&EYqH,4M8XipirCQmBTmh"*+N`96hlqC`QB2A`HaeN@H)#iKa"EB4-A)VE'hmIN
+aT*JTj9kD-r*6JjCAR3"JdbJTk2pZ$2QAPYK,Sl$EPZqNLk)NmE)F!QRZQ(DV6$5
+fbfIp5cH@3B&#HLTjQQ+P3P05@%2&kiIXU,!fa&VXb)J'b-5B84C,$HFe'+C@p-I
+PIUhmI,AZ!JG6S(([EfkSJV&8#!JIIA-T(T+YU-PSE#Y9j)L@!Bi#edjZf$ZlHj!
+!A,KcSj8)BqjMSJfF,"UkI09Q+&bVB9FjSl8kpNYhRb009CNqLp[S"0cR-%lK%@a
+$H+[Ar&$J"DLB-cepY!XIN`6SiU(f1E+DYb6,FpF!NM+$GGc+XZ[(NYE[PBC@Cb%
+VK+MQeU"#f5$5h0pJ$A1H``jSBpe,cDp9AKk4Ja5i(icj6Gb9pc3r0bVY&*60U1X
+4(!%',+lIAAp(0#FT@CkM#l+Z[ULcAq!6`cEerEQF-lPJ)q62*%rBDUTZCK&RERL
+GCd!0)e%6bYYm4fPC&6fa&&FIdU$j+D`(3Y5Fj#cV$P[1$D#(hFajb&mjeXrRp3d
+LUS+c"XUiGXTCd-ed&ATjd&fM6MX3q$1%fBTDG%M%D9ZAc90&plhGQR"l2XVZB*h
+5*@4R`UaLHlpYqSD&N9ralPE*JGZ89D"3P-#UpVjEPIcT)E-8p-(i)r28bqc4dGQ
+UCSFm1%eJ-0,a""LAp([kVfifk&q,bHMF[`hN&q,bA&im4Arme5eMX'aNfDPY"8$
+mh4K$IZ+!2KHa1`XDIk@c,hf(T[0I%FQ"R(68DPUU$Q[%"SHLUl[rQk9eMe01GX8
+Q#q[h2qXYA@K6"0AZdNpSLUl5LN+h-#S@C2FM[-'2'Se-lCHZQd'FT@NkGl2pZhf
+JDXbJ20JGPqeSP&#C)c4@22KI[eS-+)SI`bK8DY[+"`AFBhjB95mYjBZci!J"[*b
+,AGlehRpL%TB"Ap4*B3f,-PjPeq3Jr5ljl)Z8J9Nr)p2#H[NS$(F4Mb[eR9eZL+'
+j2%%DHCEK)4"Qje6)LaX#BDp0J'-"A[B96eIr4L%1LAL48rS4F(2PPq8b3,J2E!C
+EEf'df!(%DKehIQa&V`#PN!3"!!!m!!#dSF5TYA@&A`!!6S`!!+V+!*!$FJ!-q(d
+!!V*0!!!QT3#3"!m!9'0X8fKPE'ac,Xq!!!#(`de08(*$9dP&!3$rN!3!N!U!!*!
+(3X(8XS-3Ul8c6l2[hhpr1D-X0LT@X5M[fqqi+1$$(ap3lJaVD$,,D&S[M+MafqH
+q8+51NM(PIc8LBbY32kLpUI3'm2)5apJ,lN%i4SJ,#&6F@pI",iq)M4m9A(1rp6J
+YP[',HCqNqAm`peQA3+Y6BI`G4R-EC'Z#G64i(L3-Ip&'[")PC"&V8-&cie9q`bU
+QVq#)fP)i1",AYci(3FqNV581&!H"qR03M1L86,Fj(CL"PUj#%PJe)GB$,)e(LJQ
+4MP@VaEelAf@c4NM"ccNNdrRS5r"b-USr`5,r,G8K%dkFT'T!%h2Shf5G8XGiKNh
+C*q)r`&qeC[&Lir#3!0Y#akVAh'[XdB+RX9F&ZdFaCkqIKEVfm$F0CmbIH6!qXpr
+C'T1l&S+3!)+Irqi0&2Rp'LB!Q2(rSrVJBk*h'(*91QREq8eAHpU)*M@KKYl-2#6
+@(Pd0M9SbUBJiiX`a[[Q,$Ec012i!CLd0qcY[ETlm)[ikaFLQ5R&S5XC9(bKk2DZ
+NU*e+m(qIP*RIJAX*UNjC`fRDb#4L3I+"B-#4MKjjQP*b-r*YF9j)Ybma5%FmY'N
+YiYm@KT0k-2"CI,FHR*'%9m*pcE9-[%C"aMIG$dBI26$Gd+!SS10TGYY+MF8H&D2
+1FE*12VQSE5`AeJ(ULF'hRX+*[$!UHXM1lYN26-2@M[8YedMkf!eTi6R`@8Yc#[X
+ST-3CbmNQL6(&ij4b+UQZ@$RZY1hD$ReiEIKM"``(#Gl$5Sj6P)#(ecT+%*PHS6!
+3DfCDA)4@lB(ecda1GMAIIA3%3db`%%A[9"FBV-jiF@T0IM%eFDa-XIVd"3dpk0,
+Ch)rKRar8iJ)EpCbP0&0CFB0pliFi$&X2@Ql!UU0UcmAc-E,@cf-6ZUYdid3"S56
+BdXMH8JH5b)MSlI1A*I6q9MY(M09Ui&V+LU,U9pDf!EFEr0!qemcNfB,[0##MG@M
+rJfrjKi3TR*9GT@,Xq#%Yh6m4IKLpC[%,fV*fCPE+Hi(2Rpl6kJNB%HiIXRCA!4&
+YGH0,0i##4)'qQDHhhQ)j,)TGN!#HIAURGSH+0*q`6)5h'emdcUhU"EFlSUdlr%)
+bpI!1GSIqR[VMh!Sa+M6kkUpj6A4RI-Hkf&[h!D!kF,M25N!BTI[Tj)b%T+b+#6$
+5'13Si4dhfpRG0(JcXF&8Jim!AH9mMJ9&RKp5aZ+lb,8`)ip')&ra+PpD!`4&-Yd
+4p!Y2dPmE#2,EB-*jm"DQ6GAJVbk4U!BDDYe4*-UqCNAX8IJNU1`3`lhpYq(d,Mi
+#[B[6fTfB$NfLi-*TFkcIGM*GpVr6A[hZ,b!Db,jli6irXSf54mKVhGfqES5Ed%P
+["3%N@L'0lY(Z#NX@3)P5(PSfJ1$+0kAXmC4UZ22N0L%[VUbHrrdK-Im!"HLB'j6
+l,CJH$1SC@"8jX1CKUJq`N!!rDJMY(U8#DFGe99@-2j!!#bRBETSilA+hY&AM6Aa
+K9kj6j&+hp1PVf`5,6T'd'eC1[$&[9D33@b*h,Z1e%L+,'cm,8C&5AJl![-PFPJi
+L!06IA4G01Xf"ri!IV5BHElK#+,I)`XLH!(`a%#Ri#0Q@2Ff0JH3I&3m5@I`i*MU
+f"-X@EQMLK4TA41q-qmNFaadJS4*Y(4JP)ped"JL(B"U65$!Q(RUEZrPh9hS[ALL
+N'`r`+)4)N!$RN8pr)&rB9YXj$K&NYHV(b(Rfa8[YY`kJ5+&m1ZJbie`b6N)VKpQ
+fP0Z2[YCDHXmJ@PNH%0D2E8D@m(5X#-Z)R#5qeK@R0Ji[`5VfBdYR3+IlH3&m4fF
+BIBEQlk@CD2@XM0el0-YN[$%-8+THTH0$FMj#p@4"!G+Eq(N&e2#m3ZRNJ',Rfar
+aIkb(9#U$lfT[IEVd*$V!&BCUZjEef6(r@+ALDA[Y2qlX#XTDrkR)FCB)2YX,G5,
+E3flmh9q[3'[cTiliT3c8(@jPi66c*)rKBL`LCTfe$hl0!2`c1VZ@(4mdNre+2%V
+pl#[2e`bi%@qSIZ,$MZ+SU%2CMX$#@dU!dFbSfik23V9XDfc-q2G&Jja8p`dG908
+IB5(-1ar3hNi@X"GFmY!U05c,'`&ER62@em9pN!#6"lG0f5bdjQ'j5c)1b+4CXXb
+,0[(XqV"&[E3'Y2X15q`%$"lAfG)$&J+)4!mk(ARde[*68DrI)cbIJ,IP*C0P8I!
+#JSGjbpbH5d$bIZT96VLBb"9C*fGK11JTN!"0KE'HJI9lYc-6B[LG!c&,ihCpLHR
+B[T,AiJ*p9a691fpV8[EYYjYSrEcifDY5dD0+%QKcCk@mG%hf03j+Xj[#@U"9+Fc
+qY9)qP%2Fr*p2(Ra5NK`RkN#k+-B!Uf)FfY+`F,!bfcJ`PMNfMDRm#f6Mki@ZKM)
+T!JmTHH-BHKbVhlNB#J$ReKAK,%$HPQ+2"SB'VMDqF!)@SmhAdXc#NP`HZ3D0eI)
+iRNkpJq4*l-RKe2H&'K*b'Z8V4m#5caS24T5R0&6b[$'$,B`%!cUVTfSc`A@l)4i
+KT,X0b((-*BH"kSLFLjT#pDEMU[U5f0Dkj,b4Dd-rK!`5h$l*HXTrkc*$P0*DcI4
+qqeR#`KXN06P`Pq99#c+jKUdEPZ,,DE%8$m-PVi,kNBdSc()CE$ceafXTiHqEReQ
+MT!TB4Di0YZTjXEkK)*%AUqdd'aN&X5f`3UT58326Gb%(i))RAM-%S&,CUVGr+$K
+R!P-Xeb8-jRAS@N9alCmXKP,*6TM@+#8!RlBB6"@p$1eAce'+pI'r3"#hjm2LVLe
+J6Gh[dXV-V3J!MXTQqLG,EdE3!iRIQY+PZc5PNUZZVbZ"m@a+8M#'AB8ALE$4,,D
+-ScZ#IQacj%-6%1V%Mp5!%hKI8MlNaK"ajF#%e8`59S#D`T8KKbM'*fhYe"$ZSN%
+CjiCk*hlN"+%4#2TXB&9V+KRefD*)Kc%J$&,KH2&j#pNVk,M*i0Ep#ZdF9#ENplr
+G*mrdR-ajVSJZUm-1I,*X-@6bM!ZEE-#p4A9QG1NC#ffqmZ*I(,`03'0D04malXj
+m$I-l1`T1jaQTrHh[d&D4,!a"ahUeUl1@%dA-,jfC!ldNaU#LHRTU+q+-8#mX(X!
+H"mR2BHqFb"3Fh!`TGP9c9`VLj&@+++He+KR6!BK(I-$81aSMG*9RIF153bJ-Je3
+(9J2Y,Bde4mG!f)2bkplYMXqi&iIA-R'VYC!!"(VaHF0DA[$$QfHI!-2B+3hR%5[
+IFh9",qEXX[Vq4$PY#jkN2kDaTF8j6!8T[5#QMV8"A$21aU1DfTLZmX$-L'%TYiA
+G5U#D)4-K!5VLdNVLa,iPc6+dabV!"-F95D9ElKi(R9%Q#[b)Ek%epl)hGQ"r-5@
+rj-ebX'F-+$QXC4FCUjf[&VVE'Zrdf*fB41INKR1IcF!)"r%'@[4GjEFH%+Aa*F6
+f,i!P9'-j$`S$me`LlBR%`MFkK%aCa&KrSDqfm5iNpG)jGIIBb"!*USCf#$4Q2D3
+ZpZ1e@`*Dbp*C6pAar-h1H(P4C+V[V"TM,&#`X1`U@R@FH+KR`%!ZNES[Yi)laPa
+rpmUDG3%jbMc)cd3G'aF2)K2`eEJhUH[P+AX9REmI-@QC$lF&P%fQUK,-$Pji+#@
+AV,Pa(IRPb8,aUJ6EhLDKi!-,aV2Ur2HB"@[d&Mdla,Edd1*Hbj3bbUB0V22aHCF
+6SK0MENPpL9Nl&1lB'TJr3jC3&%pqU5&c[[@Zpm2I"(QD1'dEdJI@e63AG6#MZ&9
+iBRa+ceBHa5028rKUC+,Z4Bhq#X-[Ghb@KMa-2P@CY9iK#&*9rK+GK1jbrTiC,FP
+dJ-428V@qjZ4`*J(,hYHaj&Uj"cr9@d3pQ5)4QABNEG5)Rf`FI`(6j`%CLbV69L)
++HIEcLKmJMYEG#SJ0D`eV+dS8)i@FXpJ'TSZ*$3U3!!`%5q-bi[k"rU`RqAkHFZQ
+(IqQEepdR`+hPiI#@*aZf`((9QYeD+lN0k*D```06Kl1&QT,&VkC-XIb$phdLf&X
+'MabJ%l-B9jI,eMQh[+Ijj*XN)3!2CI+!QaQ3!'iFD$UAl[JC&RPlR6%!"Aq43fF
+NQZfZ(p*dP6Kp$0PETkS-Gh[%Y&9cKUH@b)+J,G@[[Zhi@B"Y`Nd!k$R'fV'T(R1
+&SQBA+0KRA`!cPrK5f$4%QQBFjBbY,'e1@LdpQ,@-eQLRcKZHGQcXf3Kc[+ASeC!
+!S``'Xl$m9DS9[2rADH3,hTYQ$4d5)1'M%#)XqZT'5#$&24+b2+`86GTq5%3U3,#
+-#KP+UiB%!6NdRjS)V8IEK'8hE94EMLfKa+e"RKS!IEk$5S+kHKJCE3TMYT!!SXm
+f$+Y&1FFXA%mpq!jElFS1@VX(V"@@`"R"A1lRMT99Z@U)X#FeRlPSA8!D-aXQ6JT
+ec`p'kmSBYXC`1[)@pJ5G(l5$bUc`$(X69GilRM"SPBJJiFh"U6k`5kj&F3Zi+PP
+TbA8pPXUbB*962kkMq(!(fe2,IM[A3eVlEcQf@Y,3P6lURC4LQ"h#jjj3(8C[9US
+GCAIq`TSEX'f&ZK46+HHI8-1dX@MI836)HicB9eFL$GeEJ[HEQ3GmV8J22Kip1V+
+ME+jKfhA9U8-`i15J0#!Tj9XYX#eIa4ha1*aKU09ALXC3$44@qJE&NL'jkTjfU82
+m4h3G!N!kLYfE5+k9MMFKk'a+1JJhHcMA"Q4KEJGB*QdBVDVpfV9Jd$6`U5UG--c
+["*@PekDqL$Dj5@3*4(GacL(e4VGmDY8P#F)rXPRf&0d`55dMlU2hK+b0lcX*%qa
+(2!h#5ATbiUAA@Em5pBI1Z0ZAA[l54cX3XFKDUQB[ZK&2XJh58DQVcBBFXT*m(J(
+5*SeE&HcjMIN!lf13!+K9%Rc2I"XNrGF8`Rm`Q[MF-djj9,EVqqH8'K!2,4me6!D
+@m2NJk+bi-rCp5keb%*i@bXl`cjb%4f%E(k@9IB8l&F'`ed-"$(q3!&Y@G(kkQ*k
+`fY5bU*1!X%k9X,kkApZVVk9,r9YhpkUmiBPDNT[`e+fMD6THEQF3P0T@N80FihE
+2iYTG%E0PkcdHSfmYNh*kXjeGR2ZRfBNR1[qkC99A[1F%k0UJXF4-+CFU'['LQSL
+(q"[i`Y`FZ4j5'6D-FeDE`SNA1mrjf1UiKHYI%Vbp'-9p)hN+CUK1BqQ('XNhCBQ
+2Uf'E'VVq6@H0fTN#Te%3VlJ0E"b(QUaQPMIdacrVp$VYb#h*5-Ned"13!!@R`HQ
+5rNpB#De458P8B,Kcdj,l&+VHTBLBK5NL6`(h%6NT,!di6GP[-#Cj*G@ClMiXI1i
+,2f)%SULEfaSRmDa2*$R@8$IFbB*+*Q$mXCG*dp)E0`R%jJiX-P-9DC,+lVLmLEM
+TPaN0bGjXjHJ`f8[Z"FFGq*UaV+-GpadfCl'0"J%Jm[&"l-a`eZ&mB3B'TImNUdK
+i3+0qdEjlS-M`2JBdq9([PaB@p3[T3&S%HL[+)10Cr-b!D9iYQGI[%e&lVcJifS(
+bN!!C`9q)HREHdePjK4+r0%9J[&eMjj0&M4E[HFD`lcaZJpUIKUZ"@X9JE@#rqF9
+Ih,`%@!i$kYerM)IK'Ebb1H+2-Dm!VCNBMNL0ddP[`(BD'83&dN0Ur0&HZG[Vaab
+M1+HFj+SifLR8+8V1iG"iYd(LfqR$k!ATE#XZ-Q"$#6@kfc!C(2DaHp+6Cmm[*qT
+Zie-6BB9mL`Gi(TKPZjI-rS'YM9`Q"%[KjKrb9),X)YZ+GBJ[SQ3@rbpLS@l0-6J
+jcYZfF2DTFCQKJS[BGjbRF#P4c%Y2VEZfbI!126PQ)Z-2`II5)ah58a!M'(*Uc"L
+0Z$`lLZU"kY9a`Tm,3I@Ze6J@p-dTYfhTK@!5!PEpGMX0!3d0Cb`*H4$Jh68q*rT
+%CbfSjR5T,DV"f"Qr"K+*XCEcX8EZLZ`&48r(e[54-5')bF6cac$Fqc)*aap3!C-
+6"$IA+lE#rBHq&RRblKp2*@03R-QH*V9j,pV(IR4Ja!pj2eEbfP-rFSd'epjk0CU
+LX4(X,'6LZpF0jbaQ,P)jDPLjYHV"5FjU6+Y%FlT!+@bAN5K-ApHjKq3RcdIC5aI
+D8h'qK2ID%"-[T4,-+Jir%eUSRIUZ&J%aTMAEJ02RTM&)DB1T1kMl[RZ&*fch!LF
+l!p3&eC8k@2iYHpbJ635rVZhqBafRZa[@0CBl6+GmC`[l+GTThh'mkck81e$6Ab`
+CTE@6%3ZScJ5kK+3S$1lmIcf8UL8DS1LVF6RGF9ZN$Kp$YqVaL(1!Ih-T5TkGUPZ
+44jRKaNU92(Fhp,4TVpq"1VdP"U92%)RX*2(TQ"D@%m*KA[`2H3MjD+)Cl*IQT-j
+!aUc!C!L&X23N#R&(-0A*BmSL@d1NT!+'pkq'XQ0H#NIRSc3DQ@"1mL,#1HDiRac
+"b'#qH81B*SG58"Q8hTT&-,@H@FmLd`3+2Tb[+2LjFQA)d(UXhaDr2@B`2LeSGb5
+p#6M!j3FekH&a3ZJ)V6fIDT!!bD6PqJI'alT*0mT*T[2N*F3K(TdYMK5(H,%(-Ef
+qiq6R$FAc,)M8JaEI3Xrh1#I@'48m$MR&$DURplIcrl+GM66HZb[C'2qQTl$iXUr
+bULmSR"rKi+$j[p#F5455`2P&pTSqpd&cm!K`Z@6DX4qb)J@QR[P"T(3jfmfUki3
+,V"MPKhqb1CDI4[e`9S4eZ-LkRPN(qq+pI0q$0KJb%cf`-N,Ahl$!r'`LeST0b3[
+ZX*b(+qD#)+eHp+QfDN,4CSi1dd$+3lUSLQ&XfLX8ECjrdh[X90Cm*5QX&8"2fQ)
+hYq,96ELP6FjlBE,,mVhL(XM`B"I2B8K&Kl[V!-e&mkZZ''6JCRCcV`BY6UY,0kN
+(I+U(JcRCZ!$iqEq$4Jf+m'cQ-`l-*e4*@bp-80kHJkQ[KKf@K0V$+a9(KcH$ad&
+e!QrkR1,ImXm*"mMUflpj9GFl!S&N,VCK!ZFb*ec1Q&+aRH3XpC!!f'J0i3'HLQH
+*beT(F+UC%#AC*52GE,kY6rIaKjSV'+-PVT1`PhG)j9Gc3#cIBBXk*A!SbI1Q*pP
+ch*X510bZ"D%G(%dG!q422G)d$l,GCBP$r6r`'hc'ihAmeI*`XPF&cPUBdBEY@lK
++TGHGLD@6Q,5k#9[X"QBrQ4DI$fSadI2eQ1QHk`NN9Y'[KK9T(FP1PeE-i'HNQq#
+XH*S&dlDVc4b8a65RQ2$1Lbfd9phe2)UeE&jVdG0JUR-5K61)i"DmfG(Mjq'aiK-
+@eEfEG'+4a6eJ8K%@i#p#(&Fkm2VEYQ#&iQJpbIcb[Skq8rld62QDN@ZdUq*'ZCe
+B#Zh60Ta#*PqKj)i1rQa&Z20'XH'%E5ejTBUlpT6F2)E[TGiqQ'U5`c#fEXHe2k+
+4PPbjccVk'lRH6!5U2jQhHQLD(2Lr1FPr@jXDUE$ZN!$(hM2dDT@IbB,3H,&j,*e
+QM$-$KT[H0rD[4hKYI)YK!9'Xm,UJIE2lJJ&$SpF"HUHp0eBmRi)[Qi)q%l(8JUh
+T0j-AP,*H-,-'I9G5d35!k,QTjrdj!XVB%CBqHcp2YB+66&(f`3),Uf'f)Tb"0V"
+T-IN)Y%ANT'EV-'JK*LQkdCm2ID6fDhm)[Q+L*48K,+L@I1iJLDrdZ*Q@%p`Z!8)
+@X24G2)bBmdPE[mS[C[`'$U*dT8,k+If$N!!Kj#CdUV6jBY'QP$R88Va1NND1aQU
+erX&R,a8jE54c+I(,D#pYrb!kFk02SEhaTqS$9m#REG&Z1G5,90RN2kJMaB+@lq+
+dE**+IbUf4JUpc20TM9r(KP)Gph1"XBGdQe'qFcC10EI56(&ZY-j5+#Z"@imq`9+
+@eU1kqe!8Jch,[Ej0FDaMekii`qqh$kX'hb,BLd8EaPkl0CU@fF)@+,V`NL#3!$M
+@fd+ZmJl,c$Ma4kfVK!Mh(CQC)cm,9KPU6!kLFdF20FUQ4Uf,2$12App914$cLDe
+['5GYmAD8"TF(M5(I9'he-Qli0PreG1B*DJCjT%kBCC-'M`%MhqB"XfUeD'1e9!C
+8M66kK,3"LYp[Y-Hr44qERHUkCJepVK!Zf3RjcFi3fS3!f'A43+PCkAi)%J'kYrN
+9HdcYb"+J'2L&k3*X[kZflB1jB1Y3FlkZhQ9(@b$Gq5!L,Ja3[e2j#DCrHMZr'E,
+Z@Jr0lHeplU9pB&52hT(fr0%c8'Kl@afc"-aQ!@)%bN4%lC-*-CKPKi,5mLBcI9m
+`5l(%IRq#1*(&`1cpRc-%NX6A5S6Fa*SkhEVdi2GrTZ&9F25p+FV1V!8"(I"AjPD
+iD&alTPYPZ,pf(P)-(4eC01q%rPcZ2qhPDecelTEj%'N3CM"b6EIbBh@*$QIZ-,U
+p85,e4#KJfApS3kAKp+#AIrfq[(VDI5X1rM1B4LI4*r3@)lGUFpING6Uk(X68+qr
+Y)a-Y9C(K[AlhIe&,eM%mBI)FGR8"@b8b0@9'QKD&2i`[&&1`VLb@LQ"$(k@CjH6
+9Y-XLf'e!lb&Fj,@8$ARmM+bV*+0*K!PEqrS3&NY"+80kcmKPS`B`E"9Ir8G#pV#
+)VImeUB&1TRPmP"9#MIAp-a"b"IB8M1hl"8S@AhCRR`S0TMr[GN!ZC1V[*krSaM0
+GX'U`@0'0BlP4@4%)LR4EQNej%)Z!QAHBMqiD%S@UhZVL59ib8&%ikYh+5eX%aT8
+ELqiVl)4pP&Bd%E%qR)F)NSTEPflS++Vrq*R03YE0R`l@%9&b1AC0bRpa(ar%+%Q
+*&-bqhFcpb'0N[mZ&V$h5Ym--RQle&AF*SQI!p49UL9+114L&*912bPcHic*)5G"
+LVbcE)A%GLU5!pKM`60U-J!p%%92Hd+X14,-Ma%CqhLG&P6mI,HHN(M$Q%BQGB(+
+1)&m'`Z`,JLA'2V10I-A'lCNp+G-KjhV9,33++l#)1*Ge$Ufd"bkBc`Ur[*8kT#2
+"QheJpYF%[4Jcp%JaUdIYPA,#2$8%FCb*NI-Gk&"#+9M+r[he4N46U4BfdYb8L#H
+4r%Sf6kjeG#+lA+DMVcmAkQK6a[#49@a8iE"N+&FMP`8qd((3aB(Y&`jqrFQ!18I
+HcAd`Z9-()'kila'URI+Ylc%,'F4T8Jq$+YG+Y'42)je[6)hr893Imc)CcHVA'3M
+QBP1XV#Ab[-G!rI*8&h2HPR2ZUFLcSRk2[bfb[RNYS[Yd828@T09,1+E(h-jk5qT
+CIDIme$hCq$[A'C!!N`rE$pc$UTVc#jXZPiH$HI*T%lJjQH(2irlC+"UNE@*NXSq
+UehqmYi1jRbehIGF"+CS5N[QjHU9c8PT[$LEY,ESrJqKDl&,K1d4KjLhLS@-MQ)-
+mL)mUTm6KRB25`XH4i5!e4j+Ml%%-AZm9FhCC,Kq)dP[KJ(!P6*kdeSSl-RX0dB0
+I[X*r$eJ+)jCiPR*YRMpXBDaa2e[jTN4'SP*U(K499GG"'FjCrS-9rl*)[4$8[@e
+bk!+SVS#*%%XiM,hZ8N&dU0f*0T-"GX(fhEZjP[99qbbPQR,M[[bcrkEMeE&'UpV
+3X@EF)I5jEbfH5e,3EUKqK((LJRhF1h@c,$ZdHN,IU1lLr(*f0L$M`1kHB%a3Jd+
+cb)Z0iCHV2iLDTU%VpL2415GMQbGMl(Nm&!3NYDNjP)MrQ9h-C'HG'6H'aUl2cLN
+T9(X@K,TN,K5(9N`ir-X[V8KFjIKL&`$L$*H5BAQjc1'f"`&R`2TdpS8K@6TERNQ
+lVDc)idY*4K-hPieA1mlll#C8jeTe9rjKUQK3j!3&56,N"X5ZU6aRiC4qk"QXAN0
+-KT4XA0[FUiA3-@2#dP[dfN53!#GGP,hTEp6'QF3Rl5'M'P5lbHJ'II!9ZNJ,Y@e
+I*U`@0B428YYmXhTJVm5!B6%NI%c"Gb8V9i@*#03bN!#1!jSPNA@Y2$`H"ZTD03C
+IN!#q!G5j'FfXK5YM2CYBYE'NF-4&-9'1'*ElJj5Ti#c5+lRJ6+fa$l3LeNiZ2mR
+I%r*dmQ[Vq(%-khApZlfmr)'H2,ZK0Y3brFAESj08(KB6[)eTecc$rZ#'m'`FiHa
+`H69Lm0mFka[GQlj(PRHU3-A%jDf24U1lA,2N#"ULZ"1QM@URaiQcl4CZNCAD`@m
+6(eL0qqllqS@[mdT0ASUYkB!q4"hrR5Zm%)a!56KpZCa1-(m`*VR1'JNUS6i3L(e
+qEaS4daiQ#IJJh!'6ScD8S$`*cM@`@RjDP`E,eLbB'pjdXUcRdKB31Xjdbb9BY0K
+CXZ)mk3pP6Ae,L*5QMR`hTH4)j46rT93H,"d[MkS41I+jed5ZVR2Zh9I$'BJ%$dk
+*Y[`APLPqG)GD-Hqk6+J!X[E&)*ZA3SLpUi"096I*"JCEGfk[[QfNN!$,C%JcCTl
+3B4[rX&ZXHU`@aNqRdXqalei,iePRB4KXa#`6[['(D0"A-I(21K@(JGiTT'5099@
+q3,pE4A,JZ*!!&UMFXV&U%-(5-`Id,6+2pCD&#$p1UkQ9+0+-bQR@38MVR`DBFPQ
+L#k1YQlqjqI1&9kMBGK9(Sb-iRU-aF'EH*F%mm#L$FJ,)ah5$Dl5,6kKa-9,3B!5
+XT&I+aN@L#!b!&Z,ebi`DSZ3*C"SYrU[qPr8R#h"LqE3T+H+mi!6"fIfL2Rqq$HU
+c,mr(pbYeGKS&0CJ!3c$N*a*G5ENTU3@YSBeR3D#1af'!6"i92S1JSKB2l0Y!J0"
+L1BD`%e2K"(jXXdGE'd[NfS"SD*cC3[(ErbA9U2#++3c+R*!!5hZ3!$b@4P`rCJG
+%JrCC#ZKBjCV--"-N5286'J9YB"Gb'Jc`DNL#8cEk")E(P8fqP-e-aSjSaZYJDZc
+%1RQk,Tal`94F"r2'K%df4ZN'(AQT1+)ap&*r$qkfcHLp(Qak!Zf$$S9!8r%1&Bc
+UPrhh#LADrQH%"2AQFE'HVM5dpclFJ*IAGD&GjHd6-8)f9r"Y"ci2FPL"VZD-,pf
+S%iiHA``L'94`G0-F'%!eMZRZJTqU'behrp`YA8UAGSRTqrhA+X1X-38S13dI%K`
+0)ErAm-0PPT,BaRQSFAZLqiXZe2%3P)a%[X"8haciA-qAAia(+B,,#qPC$HeBVHm
+R,+4I!YG5F3eFdEiA88Hf1V,CArKU+"%bADp3EXY*B*ed4cF(`kl1h(&D@e5qVrB
+G4ikkUi6dfUeSL6E'K$,YjE!K-0lX6FqJ0Va64fLXCA!ReaiN0[%a*'@[,la(KVT
+adiNM+q(KC*!!``*5E6,2aVrC[2SUG1$)eJB[pPPlBca42eL+arNTdahXTqY5#eL
+ie-k(C-iN*,ijZ4G#miah2lLjU*DSF`9QAAqX$r1ZjJ)KASYVah-Mc150)9%VVUa
+ZVk`$62AkZ!T3jfl`h%f$"VLhU6%D9mL*aG#k)rK5jr*mNhUrV)k0[p!CYBGC580
+5QV63S`p[Mjbl$MIS"V&aY!5aUV[r@cCq8Tc6(`*0Bl'0'FG*%bcJD+9M"LZbl3C
+,K3[Y"ppSNp,6M%@dSP[[V6'1$AqQ+fU9Pl(E-R9B&qjqS'9Q,@dbLD[-`T`jD$K
+l5kUJ4jihmUSPcSfZ3qDNq5Dqe5#Q5eV1#"LVDT3ZdYIBr5MrqCYd%CKF&T%!lA,
+fMN[IX53PmfGddI4QKj1JAmI,b6G0iCff&kTp-F@ir%f&qI6`!p$Q(qmLJcFQYLk
+Vc-d')dePeJ#HjCNEC,Br4pI5de5K5EeHB,ADYK@6L$!pmHjILZ",0e[S(D+E4'c
+`#k`"Hh&9leL$I([2XJQK%r-TQJUlSIPFiLqTIaPRNC8HTHR3jM2)4c*&V!EZRUl
+D@-)jXP@LMB6L[)Rd3k[A82PQkKhkXb"Ce,dA9lHc9[6Sk4SbqRIE5Bj$!la"-dl
+$#IqfAirqhZeaahj$ah[PE8%bSrmLNlbb55-d`IaLHU*h&ecaVkKY*l"*-H%Z6Bk
+[VZ-&!a'"#+UQIljG8DaCYEL6`md%CF0%,cDIeQ[+#D%-BA@iLVF0&KN)*TX#6mq
+,"4UpIVG@dIHiHAcHQBF(CrZG[NdHj&51Ca3PCEiSR&'(iiHKpI#ZcJLEp3SD@S1
+3!"Q9FHY(aI"#k"TCf1ED$ll`"C8-iZ0E%p&8lFCp68e5A#imi68-daa,l8j,fPS
+V6F&C5"d*)2P+F3AlFb'c35Ejc`D#22&,$TJ6p&m+l6Deh@ChA,ZfEU'pbJaMh,k
+Hp,Fa)20af[q0%0k0)YBI$k-Hb49I%,JLb4A-Nb-E&SaT,r***+hP4+a`B+[4i+l
+"kqZqkQhEpkHI1@M-J@SlfG5L4d[F`P4F4XXRLLN6H'dTfrfUI5VBN!#5`PYhY4C
+e9ia,6IDUQFk1BrX12iJ%EV`LlU%%6hH19qh6HbEAPBQ(B*a),SGkZ0RI&VQBb%S
+H$GeBfcPMj+Ud2@k3!2ja@dAeYAMp`TYR*+G`5ZCiqpK+E8XNA"LSEbQ&-MXPAlX
+V6mlfhq8C2AA%E3KCRLmVHiN@eEU`%q*3HRh(RVTDARe$FmQFIRASZS#C[(I(Ulm
+5KA1FM&e$Khp%GSe%RXmBERH8+P)[C'@f[pTXC322lKKE8eRL,q4,m2Rk-ZN0+c3
+LIGQA6#[AI3BCL*`iYmSFJ@D`(V8K8IS(iCAK)%QS01lepcMk(X#$BKN#-I3A9KB
+dI6SV"[E*Qc*qCb[Dl9p5pkAd+CrejMJ4cM0@l-BX0HdV&FT4#r,2*hIYc$YkaH`
+LC2Hk8DIl+!c5UXK-Apf9HQ5KB,$KSF24iG1j)%cP5V30`BQdq*NUDS(A,9!#G3T
+*&jlNrd-F#el1D`5''M(,ilFV@%dRLH$INr)H*d*k+XZkQBa)8qeG4#UA#!h&&jp
+EB*aRfhJMUJ!5qI%`80G6AeDBj(Z`R-1A"UkF&fYlZeH6,lL5ZAbJ+Mf@*0)faQ%
+c*35T@TlraBNUERpe8U4Mrbbi(c&eV'8`UmcT)jV'8f-(T,2N6l`pE&Nk+BP9SkU
+rpd0S,[FE!2CR`aciSSMQLTVq%Q[r4*RHCX8TeVNfk`+Fem6l6$I1Z5ThA%59bCk
+6f8F&LQ344d6f9#i99)YJprqB@*YBC#bFmTM5P6q[68LpK"'k1#V2[KcVj5-5mHL
+)4F2bSK`Q"Q)e0A3-Qi4#U'`4HAAbMGJhja%pZCZKd#d$8YDp%k)dK65)A*!!1@(
+'+ffNUKQP"MpJaqJlVf4AP`GCTcTeS30KQTrTDPV0eN*GpCTQ%Gr9q)%J)Vha(%Y
+kSIeQG6%@N!!Pf3irph4B(rL-HE2U`I#@UEI4jcG#4Xe,@P4+6KE"#,3qejI@-if
+qVjVRi$1Af6IUE3#PF9pMpj56LJAQShSPTQ)riA0I*,9%AZfRh1#&&%X[414Ud*B
+-jfq4Ab-mmdP5qe)j*FJ3R3'`X"$N"+APQi2(bHG@FHVNP)e,8(DG'`#PN!3"!!!
+`!%!!N!U$a3#3"h)!!(*Srj!%!*!+3b%!!!%!!!'3!,F!!Bqh!!!%@!#3mh`!!3#
+3"@N!B`"p!*m%!Np,!*!(23"J!21)A&4SCA*P)'Pc)'j[G#"PEQpeCfJJFQp[E5"
+[EL$5AM$6)(4[)'0[ER4TER9P)&9Z8h4eCQCTEQFZ)#""EL"KC'4TG'P[EQ&X)&i
+a)'*jG'9c)'&bC5"ZC@9NC@3Z!*!$8J!"!*!&E3"Q!)%!SJ3#6dX!N!8%!%J!C`%
+$L$*6Eh*bH5`JBR9d)'%JC'PcDb"bC@aKG'9N)'9bFQpb)#KH-#NJD'&c)'pMBh9
+bFQ9N,J#3!d`!!J#3"6%!C`"&!+d%"&&eDA3!N!8+!&!!(!%3L"T9EP0dG@CQD@j
+R)(GKFb"cG@0MCA0cCR9X)3#3"3J!$J!S!#kJ!J!"!*!$I8&%3e)$!!"q$9-+Ni3
+"Sfd!l!Yb!l5b-LXVieY0hP[[D[HQELEAJ$%!3!-!N!1kY3b!!!PT+[lJ!985,2Y
++b&X1iq9cZS94MV)rcirrVL!j0k`Dq"(+KM9jKQ+MCf[`V&ir"HlX#m#`U3BL1%a
+A2VhVbkfM'32&(&P,'cJ,!*!$@J!"!*!&A3"`!(%!V!3#6dX!N!G+!&8"%iJk8fp
+bFRNZ)#"*ER0dB@aXBA4TEfiJBf&Z)'pZE(NJBQ8JF'9bCQpbE@9N)'pZ)%K'8b"
+fEfaeE@9c,J#3!fi!!3#3"@J!HJ"m!,B%!Np,!*!(5!"H!5@)6P0[E@8JDA4PEA-
+JGf9bC5"cDfP`F'9N)'*PBf&eFf8JG'KPH5"KFQ8JEQpd)(0eF("[FR4PC#"LH5"
+dD'Pc)(0PE'BYCAKdFQ&MG'pb,J#3!eS!!3#3"9d!F!"a!+`%!Np,!*!(5J"9!41
+)1P4SC5"QD@aP)0*H-0-JE@&j)'*P)'4KE@&RC@3Z)#"3E'9KFf8JGA0P)'Pd)(G
+TG'JJBf&eG'P[ELi!N!-S!!%!N!A-!)i!i!$5"!K$EfjdD@jeC3#3"33!"!$$!@,
+!!J2S!*!$e%&%3e)$!!%5$9-+Qb3!1iU)LKA2&Y"cV%4X%28X2hmrl0HG[qIZcJb
+R@0KK*5TBK999BZ@rm35aUJ8,XQ8l6L$jN!!I!93NQ2Se[)@RhFACh8h5b(U5[Ad
+I,N2FaCI(T3X@qBdi9dq9p3XN2%U1NN'qk(5em(4U&CSL2JAQ6XFXGBZPFi&Plh`
+8(,JebXbQG8"2"b%-6&H8@CbY`EYPFb)Ah(i-H"r`2%#L6q-DV)Mdc!mhH5K3fic
+)FDZRR-9M@e'jc-h@kB'VP$IIbIX-kIp8rmPY!*!%1J!"!*!&8!"C!'3!N`3#6dX
+!N!8$!%3!5!$SL"P8D'Pc)'&bBfKTGQ8JDA-JC'&YB@GPC#iJ!*!%5!!"!*!&4`"
+D!&X!P!3#6dX!N!8#!%8!-3$SL#GCEh8JD'&fC5"PER4PFQ9N)'&Z)'PZBfpbFQ9
+MG#"`BA0cGfpbC#i!N!3-!#J!+!#f!4`%!999!*!$$!!J!!J!SJ%F!)*993#3!``
+!BJ#5!2!"Q!#&998!N!--!#J!+!"e!6`!Ke99!*!$$!"'!+B!ZJ(@!)C993#3!``
+!)!!)!+)"(!#!998!N!--!#J!+!#Z!8i!Y999!*!$$J!S!#J!`J'N!)K995J+!*!
+$$!!S!#J!P!%5!J"993#3!``!+!!S!)d"&`)"998!N!--#e9Z8h4eCQBJBA-k!*!
+$#!FJCQpXC'9b!!!%-d&%3e)$!!Ch$9803b)5%HCHEK"N,4P%D[*%*!X3@DZQ*LH
+h2BZ-i(ERb%Qh-e2bQAph[qrELM`EhmbhY8#5eFlXbH4*f,ilNa'5j9ENLDc)laq
+42j1IbEcCeRB454B6XMFYb5)S31)(rdjCKT&84$LS#cYiiLGf)5c5J1e3aD%@GK*
+H(mq1D3bR6lpC+R)6)mRY[@4[%r6@hmf'R%[)+8FIZEr5&V,ejRAjaL3*5bPTf0k
+N&a@6NPGC,a$mi-RK`KFHI%V$*QM4BN6+hFfqTX2b,*5j55k)jb(*(2h&i)XDJqi
+m&Fee*9$cG*JIMZ6*i#SGjViNe#Xq)@+3!*h[`af,NK")heX@$ED[(5XhPA-`LA1
+fRcbNbSE0RBqrZ,m'l)YVm[NQUD!A@)"Ck2@aqNDT+'b%UlJKdF4%D4j'8D8QKLJ
+RXm5(8JQR40@4X8N6+L,JmB-'82KL!,85ECR3J#8d%@TbLdfC`eLTT"qR$+aeU)[
+Di0J#T6DMFe4B`aLflrdNJ-)Z!m3jBTLiESAmcl%RFHbLl9fAJNh,JDRU`pD$+ZF
+dM(GdeX@!G"Z$#pDfYBXaSNc2)HBbh"2bA1lEQ20L2d(0f,[Q&#I)A'ZQ2(KBb@@
+qIDUNT-rSkShVZbh3b(2j4EE#Hi"%aD`5%YXK48JPi!JpjfESS#*')G-lpU&Zma9
+#N6ZP%AF+hP-PhjBJ16hDlDNc*qDmR%1jlK@TB-cEfPh+FK[jplG1#3aZ,GrmP`r
+LNbG@J3Mpl)N"@`NmD#E1Ye,'NV,SJ&0-'N"4lGDH(L15jV)kGQArf*KLjXEBBNT
++ilSFVqIQ2L6S6,2!-qdr5A,SM5rZ8%e+qrrFIEa)TAK+(ePf3"KU9mH96KeiJM&
+J8-CCH2(UplHlTpQ8&pIV!mfS&!eYS22Y"H59K,,GX(5'$iDUN!!D1!1%4[Dm+R'
+d+EK+q$Ll6eBP[SHY1Jm&+*f0f9@c1LPl$U`!LB0EA#,N"l-#h9`&eEjM4RfXIVf
+`GZf$Y!rlJeGII3NEUUX[JA!5-Xp,Z*!!K9k#PFalib#6LH[)jR!53fYB8Y@+#cA
+4e!fZkRA5eL(bC5reTB0Nq+`1N!#ULm1*SfpKL@KA(V8&MK(J'6fDpK)ZJ-$X$'l
+TUd'pQXb1L-Hl60lqhlJ2YkIbbBfVNkBAI5lbXT26-1CCQI@i%dADZX@J'V("P$4
+5$f-VG@mlh@!+D@pipZKGMr,CUC9ZcXXMqF'dI'XXGU%XA8IkajQ+#fPh$2Aj@FV
+RjqVrINKT#[0r9hl1a'Bar[EhjGLF9@FZ6fPZ&[UQ90aX9RVbi))fT0[hNY60m9P
+ip++5qIc2PqqBK`c8pE9GaLXRlhFHm(""&mY9YB2CTqfiUkZ$G385RX(1bd[ERX3
+qk'4JZaVPpDGj!R%'T["3[!PH+Gc$PhJ`"hHqIVA3@F0Eeq31!*!$'!!d!!!"(!&
+S!!%"!!%!N!8$k!#3!j3!N!-m!!8%)'pQ)!FJDA4PEA-Z"&0dEh!E5A4PEA-JFQ9
+YB@PZD@jR)(4[)&9Z8h4eCQBk#e9Z8h4eCQCTEQFk!!!)`N&%3e)$!!q!$Pd,V")
+NGQeRhjerH,HaE(HH0fCLf0QFadb@D1p6'b-S1Qp(X5GD$AH6&!QPSb`MVD*U#kY
++Rfr$#'qGN!$YZF%SSpR5d3DU+Y$UI81Y&!rS'1d#*De)Ubk0bCE3P2H9"J6XIAM
+Ilflff5+TQPE9q`-0rN!M)f"L-b*%)83elYAdTa[%MpAh@,9!I4Sl`c1T[b#Q4mm
+rAcEf`62IrVq+cHQa!)kNeiF[b+S+V)bKrJkX2pHRJ(SG0[k*S(rkL&0!`X"V3'U
+4`(3'#R9!A+9%!ma[5(BC"SN9L"U%U3lK&+4jQVl"pUk-hT(C(`CfpBqprI$G,Y,
+P$Si2"&DZrR+i4U3Ff1hjAr(%8GjLkR6`qH9jHBkb"SGYb*[,SRMR(Bp-q+[%BPU
+fmEmZre[!9Rhm@lD*,+U2j@dZZpc-1k#8cm&c+KGaD#QV6FdSjA$ff+-lA1jYPV(
+P),qJ,V3%Bq'!IkeAf93MkQX4T42`bjrB$d)r9I0'[R+MIJEYK@S$KP&#Z&&ZqQL
+[$[-qfUPN0U*Ub0%X+l$f9j,CQkLIKBN1PGYkE#adrmUe0G,b0qkG2MLb098LjPe
+,R$H91mlE,I10[0Nq&,RVAFb*qH8Mh8qPFNI[Ghed3B8mNJ,[BPCeAlN$r[bFi,(
+2X1QmmZHP00qhA-k[2ji,Vfr`V'MX-V0B,f`p(Y&2'NIr"4Uf2T(XRHRq4Ep3cDK
+["+HZ5kjGiMSKVP0d[BqZe4,UHY+%qMTiVIBcBLGVJYJ464)l$6@aNrB6X41q+iX
+GXefPh3ZdLqUIq1R4$&-69IK((L2fmZ!l"B,BNcU6cC59h[2-qIDX2lEG$LPTSr,
+5aff#f)B1)L1f3SALcr4@BfV@)8V,Xik(@BH!`fDjK#J(0hcePL!fIfE%KPGmD,L
+@&EhF,+l*ZLp#*$lE%`lk#8BeZ#Qq#1d6bY0p%Dq5*U,Vmc*FL@cA@k[KPTP&C&5
+#p1YJG&!4iPAJ4#8%@c[UNNb9KmPT`&*'YB,li-@NC8FSQK#ZApmmdV[PkV99rII
+'a`BL65ZdFkXf(jYd2J$*F3[(#fdPeM50JY@(GkhmMEb!aH20TD+He0UKJ-Zmb2`
+6T#G2Q*N4mUaLDCr[AJ(TjJ-QKFEhFTTN@QBA3fG!JJ,#`#iK)*C1@(dhE3kHMaJ
+dQFpT3bDIH6(N!LNL3V0GL)LPhF1q)Q&,YlYPIXAN4'ik@TLVjZB[0k6DA#"*BAC
+b$G0#D4EeCq(3PD)R`E"2SUU#U,b"ibG3Vd'0Z1cJ+jl+XL5Sm1%LAP!%#R`Re`*
+hRh)9*#E$E$Y`-!DHEH!8R8T$B)P+,&9rI2fPPkDhlIYkm&AhffH[(aXimSGVHMj
+9V0@AMlRP([JGK*bQU+#1q(bHaG!PrJ&[IcNe&&S-c9UBI#TH3q"FfDHFS+VU%,$
+r-YJcUBRTa9$#%MT$K@aLGAj!pQ99THJ-8d$45-V@S+"p900Xi1bUUP9Xqr!pGYT
+Ci!TmkKj1[6Sj'l*j3LkUEfZlq*DC)SQbRC4&pC3KmJ+iQDNpE0`*ihVYBFlG4m9
+F9Ie2'KkX`q!Be!M*dX+DX1bHE%0e#U+-(qQd89dD`VJ9qd+NIFXP,TBSYN(!*))
+U*5%M+Lf9I'Apj8-DGiQ6!GSY&lRAYC&V[4[(pK@+SD[FmV)hG94Ef(RZdjXr@HQ
+963mF3RHHak-h@l)TRcG&fTN3"d*TmpEr(5KAi$1H`HCjN5UQP#`ajCa-T*!!Pm`
+pF0KF%C0(-NSj+2AKC-RbkYb5Ik%T,(IX@GT+rP[bV0$6FX'cX[Q#iV-l#)'L3P+
+mTYD#NX+64Si1QT!!TF%B*',Je5Ki8clj!p)Cd66pU%Epp+[T3Y!4%X9SG+SE"MG
+CM8h"qlfG$X*p%$UI5QCHS2ZQ'F4a)k-UQ3m*C++Ye[hDZ(q`pm6kjkli39(9NmP
+NV08kVPdI(([hBH(l2jY+*S-dfG4kFEaq-,bllH%[Rp-h)&BU+HULkSZYf[LJqcm
+pTF'(cR5UJkBk+R[VR8eIZp`a-192Cfl3DP1peRkYepRE-a$mirF()IFpC415NY[
+ifQZpcVeY26X("Tb`L3iP+9%6J%UX4rA!rLSK!3Y%IiG4Q,3lCMAdqIFB95q0MPU
+0Q2)qbUG[r6cCaIT'Ik8RZqCEEp(135p8fCDiMKUMqKP35#['jR"XkFShR@FaGR5
+ZfNPIq`l!CS@i6N#$3,-6!LL+#q2PVamkJdFI8k!%KHa#UQ2Al9elqLb$pLpG$Rj
+ecVNdmhVC#53+i`J#dr9Se-(rb',ZY*Mk8[b$fk2#dXa[bZKrLfkUpkFaHhcd3+6
+BmP2Ah+Dqm`R(k9(rdN+aQ6N-5`KFX@A*0DGVC6E!m)Mr6E$(%Jkqf'*fj8cD[d&
+e4S9LiCD#eIZMQj)EQdTdY*EYfY1G'pB1$36jZIERl`q`ZSMCP@pITJk&MdAEN!!
+FFm1B"Q25KX2IBMU$fem42@Q%ClK!N!"rqb,A!Rh48DK9,PrV)ABbFG4J,%TJ*[@
+N%4qX5[KN*lGTT@kT[Y%GcZ3%bVhb"1bPFb6mb)ra#8P06'RQ"!IJireh@6irIbN
+bZ#2r8AYKY2'URXD$XpaZ#H-*54BN69A`iAJlaFXjmqc`lL%2-GXCLP-2XJQZE"0
+1ET2)!@PR6-'jH*bepM@U@bEYI2`l6B60a*%@*`P*LfIM-QF'h#&Rid(!k9B%$A"
+6&GkHX$C6I(Dil,ipHbZGLA$F$eX40("(UH)1MVY,F9[q"c[bipZD&KS9[)pqTY,
+6i'S)*$USQeccCX000CNf+98LYeaTh&%!eY!!89GeTNhL-#+l&CZc6!)BK'dp*U3
+YSP`h6$415aN'#GG[ENJm[P9M-`eLd#5A*pU$NC%M[M*j1&jNbE4(&4eQ4(2XPI'
+[@iV+C#lZ-fHD)k0ddKS-,3fd*p-D9A3UdaLF5'FESiVqJT4KLc!T5L@iJeel-Qe
+K0raECha,LL'kdQ0U[E1bbJbI4q43lT8V!*!%'J93J!#3!`-e,M828h4eCQC*G#"
+648%J05ie!*!$$J93J!#3!`-e,M8$05ie!*!$&3"8!'3!L`''!!%"!*!("%X!N!3
+B!$`!3!#`!CJ!!3%!N!F""`#3"J%L384$8J-!!iS08`UE*!"rKN@`h6Nj%l$&$Pe
+,6NmGf`%9!pZaqYJ-9[A12LLS@(eX`@kXkXE!2f0r925rrfq2mhC@'FEU!!ZC03e
+F9Shd`Bj'pkj6'Z`%Xr-S&0c&iM*#YY5j)-Pc#j!!hfq#GS,Td84dcbPjXa2G[-R
+Z+i@%-ma,@ZUD8SSG#ciIQp0r"2"krMRUbY2UD[qIAfl(Ujrp3rrlNCBP!VJcDU1
+#E9E"5#Dm4DYXM&@eAPXqBTZhKHeK&AhF&mE5@NbNP,3#F4p-ISc$ekiEjSHQ'HT
+6frC0h3qk%'KDJ#F%b!#F!%bpqLd!rZS*!a&r!2#LFZ%#%"b#J!'#BQ!Y1)Z43Bc
+I$%,N%MVLkQ15c,dSF4p-hh6j4F3VE-XB!*!$Gd&%3e)$!!#!$9-,@b!$!kCJ`kT
+UXc#`!5*LB$G,XGYCPD!JBX-HkYR!Q&8a#f-UZ[HR8k`+#iPMb,ELGpB!8LMpiEh
+!JNUia8#RBdJbMUrCpbBL$VrTa[llf*mk9dmSTT%&(C'kJKQiSm8DVUKU*k42-JV
+[4Fi&!*!$6!!#!*!&#!!d!"S"'iJE8'aPBA0P)'PZFf9bG#"NDA0V)&i`)(GTG'J
+k!*!'#`!,!#X!+k!#"%X!N!8G!$3!,3%BL!*H-3#3!cS!!3#3"6B!K`"+!-%%!Np
+,!*!&!J"&!#m"2iJCAM!JBA"`C@&bFb"dEb"LC5"NB@eKCf9N,NX!N!1U384$8J-
+!!,B0@`Y6-!0hFbeQ"Z`CdmT9aMFdilke99E'2fp2lp9kYqiprq)E'J!!m!d!!1J
+f$3!!#l)Y'i'Pq!GfCr[jjDdYFp0@cGpCf*-4E6ZY!bFUCeRCbDlbH0Gh4)AJ8X4
+rJKJ8[N3-RI0#5DL'!59#J#kS$Yl9"F#6K4bJ',6dJeNIl`L5Cd'q)0q+c@'mi[e
+VN`@PK4)VLVPbh1Hj`Y*8H1AaB3%!N!--!#J!+!"r!A!%Ve99!!!"!*!$J!!Ird!
+!)!)J!#)%N!!!*JR)!#)6j!!L)!)!)N!"!##(i)!K$r"!)K``)#3Cra!S'SS)-M+
++*#BbmM*10!Bj*QAd-K*P&#3)Cr`)"($!%!)ri#!"!B"!!)E!J!"!!3!!)!)!!"2
+N!!!*b!!!"*!!!!!#)!!!!8!!N!1!!*!(J!!Irm!!2rrJ!$rrm!!rrrJ!2rrm!$r
+rrJ!rrrm!2rrrJ$rrrm!rrrrJ2rrrm$rrrrJrrrrm2rrrrRrrN!-rrrrq(rrrr!r
+rrrJ(rrr`!rrri!(rrm!!rrq!!(rr!!!rrJ!!(r`!!!ri!!!(m!!!!q!!!!(!!*!
+$J!#3"`%!"rrq!!J!J`!*J3+!#N)#3!L%!L!*#!)3#p!$q!JJ!!J)3!!)#)!!#!N
+!!!J+!!!)$!!!#!J!!!J)!IJ)#!2m#!J($!J)"Rr)#!DJL!J-S)J)$!')#!d"L!J
+CI3J)'8F)#"Rr#!JF-!J)$rJ)#!"J#!J"X!J)!!!)#!!!#!rrrrJ(rri!$rrr!!r
+rri!2rrr!$rrri!rrrr!2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!r
+rrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!r
+rrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!!!!3!(rri!#!#$!!Z"!S!)3J*!#B3#)!K
+)!K!,N!!$q!JJ!!J)3!!)#)!!#!N!!!J+!!!)$!!!#!J!!!J)!IJ)#!2m#!J($!J
+)"Rr)#!DJL!J-S)J)$!')#!d"L!JCI3J)'8F)#"Rr#!JF-!J)$rJ)#!"J#!J"X!J
+)!!!)#!!!#!rrrrJ(rri!$rrr!!rrri!2rrr!$rrri!rrrr!2rrri$rrrq!rrrrJ
+2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ
+2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!!!!3!
+(rri!#!#$!!Z"!S!+3J*!#N3#)!T)!K!+8!2i##!!#!K!!!J)J!!)#3!!#!S!!!J
+-!!!)#!!!#!J"q!J)!r`)#!F-#!J'ImJ)"U#)#!bJL!J-!BJ)$3')#"Pp#!JC4`J
+)'Im)#"``#!J2q!J)!'!)#!'`#!J!!!J)!!!)$rrrq!IrrJ!2rrm!$rrrJ!rrrm!
+2rrrJ$rrrm!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ
+2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ
+2rrri$rrrq!rrrrJ2rrri!!!"!*!$J!!!!8!!!!)J!!!%N!!!!!R)!!!6j!!!)!)
+!!%!"!!#(i)!"$r"!!K``)!3Cra!)'SS)%M++*#BbmM*10!Bj*QAd-K*P&#3)Cr`
+)"($!%!)ri#!"!B"!!)E!J!"!!3!!)!)!!"2N!!!*b!!!"*!!!!!#)!!!!8!!N!1
+!!*!(J!!!!F!!!!2J!!!(m!!!$rJ!!"rm!!!rrJ!!Irm!!2rrJ!(rrm!$rrrJ"rr
+rm!rrrrJIrrrm2rrrrRrrN!-rrrrq(rrrr!rrrrJ(rrr`!rrri!(rrm!!rrq!!(r
+r!!!rrJ!!(r`!!!ri!!!(m!!!!q!!!!(!!*!$J!#3#!G"8&"-!*!'"e0PCc)!!3#
+3"!G6C@Fc!!*r!*!$"e0PCdi!!rm!N!-(39"36!#3"KaKGA0d!*!$!8P$6L-!N!@
+%4P*&4J#3"B3!N!-d399c-J#3!`&*3diM!!-!N!1!!!%!J3!#!))!!`#$4P*&4J!
+$!*!$J!!"!)%!!J##!!-!J`#3!b!IU5!a16N`,6Ni)%&XB@4ND@iJ8hPcG'9YFb`
+J5@jM,J#3"eG"4%05!`!"!3e6!Yc@"T2hdNE0440Y!,6j0bkmfddECX*X[UX,hi6
+GX0[NhAE9eA9K!!NiTBMrG!Ak'M5Q0Klla*eVf8k#LE$6%2V!XqJ!D*!!aElq",i
+'!!!%!*!4J3#3(S%!r`#3()%!9#[r!*!DJ3"8re3Vr`#3')%!92q3!e3Vr`#3&S%
+!92q3"93Vr`#3&)%!pID3!e6fN!3Vr`#3%S%!pID3"2MfN!8Vr`#3%)%!pIEfJC!
+'9[IfpL[r!*!1J3$ep[Eprj!'r&EfN!-Vr`#3$)%!pIEf9[prpj!%JIrhpT!%+rm
+!N!U"!2AfN!2mrIG@Ij!&Uj!$IrEf+rm!N!L"!&6fN!6rIrCr+Rm!N!089(p@+rC
+8+rm!N!D"!&6rpT!$9[riphmUI`#3!e48UrFVp[p8+rm!N!5"!&6rrrD3!rcppeC
+8+P53"AqVprEfrrp8+rm!!)%!92q3!e6ip[prpRmUN!989(prprK8rj!$92Mr!!$
+r+e6rrrEf9[rhphmUJC!%V&5V9[D3!rrr92Mr!*!%rbY8rrEfr2hf9UXUJID3!i&
+rrrIfN!2r92Mr!*!'rbY8p[EprIG@Uk[rN!CrprD3!e6ir`#3#2mVp[C@rRrhN!6
+rJIH3"2D3!rIir`#3#[mVp[C@rIq3"S(fN!Ahq2m!N!cr+rD3"[q"pj!$pT!$prM
+r!*!1rb[fN!2rrrMrrrMfN!2hq2m!N"$r+rD3!rIhq2H3!rEhq2m!N",r+rD3"&6
+fN!2hq2m!N"6r+e6rN!98q2m!N"Er+e6rN!08q2m!N"Mr+e6r92Mr!*!DrbY8q2m
+!N"crq2m!N"lr!*!a3Ej"4%05!`#)P""9$@99%3!K9Hj'RckIP9+A1THPQ3[p@HH
+XJkd919ilR0"ecjZZ,P[Y"Nk#VV#Y"GcclQX-A$KHA-'"#b!1j!a($*R6`fd),X3
+[m6M2QjaRL1F40-C6ipFJAjmh-ES33mJFfrVqqr`qEAmG!b'AerIr14e@0K)4!J'
+3""%"N!-43Ji!A32IQ[Ej"hUL-`Km2d5"rJbZdI4iYUQE[`3Tm6XAhiZ&e28rqjH
+mNSQ(K@lSkfQ#6r`iVi51%R'3!"ppNiMDBVVe&PPM2LpJ(+*"mm&3LHU40Ie0Ta2
+I!E(6NmKV1Sd&"12cP@QJ+GX')Y9EJeDr$H6H,`GrpKGRmP13!#bEXSf"1qIEaTU
+h[$@iaYbd'mYIm@8%bjemf8Q[*dT#jjHGTGF6*F&@[Y`*SR$2XV1Gr`B3[)iqlT-
+J)#BF!mrN18-Q*db"*XqIq-$d9ZHrJBj8$b*c9I013I3G00mrlfl2%H2BSK"2V[a
+Qr(XLJ*m3IS+Y18,qdhm2IfTqeKB%XFVLV!J0LIqCqZ[NN!"M++XipJ#IGMNVq'*
+Ia'@Zre0pE#iIbXiNQ114SC&2Ba+$fJQ#RIM'!GA82c-"bfc"+$+J6QE-GGQH%Vl
+1l5")aN45M)YY`T4rCDT3TH)rIjhk+cA-f04IfF3j$*[aXfAd#Ne&V[$T8Iedj)V
+%bPk-l4X6hfMqFD3[fLH#H8,PN@r2lqBNJi0@pqIGL4`4AIQImFqaqFqaqFp&X11
+(k5,@e[)$GB"[2AT(3"d`@mceeeYLZT9(L*@rFMQMYKmqBGlUiUmUp-GEIrM%PDe
+(j4`8,PBaG9H$6N`HFKc+EC!!qr1l1q*%0'hYYpjL69*@L-TL(@Jkc3ET@%K,bNj
+T*8+Ta0chAIBL3ZcDBCmeU4edkBrm4iR3f818(5LU1JkJXC(AY0Z",GUp@%D3!-Q
+BE2[,'f+d'b4Jr)GXZ4,jimk$3im+-C9HAbM8cpIjYh3HK-S#%2[#D,IjrSdE6ld
+Y2$!)Mcc3&(-QCGFq%-%lDdBrd"3Rlp8(*jUN!'8I"PX@-MqJFJ0Vl#C(elVC6Ur
+XUXk3!0qXrNM1PM@b[rS8b2jq'c(081e*Q1rD,,#CSSebGZ)lIp`X[#!lKa,q@25
+H[Ce!m)r0)U6jkFYc9-mi%*3SNq61qEJX3iP5fer+bKaGJ3&RU&R&Yd(&F5QbFT,
+BJ$pkMJ6C$d4"`"Hq[*5,FpMPSG@fiFhr)"DKJN',eRi%H8ePa*Uh#2'5&M&XV3-
+&8hmBJZH9#,CQpr`'&F("MV5eAJUqL*41(T!!Ye"%5B'E)JT"'T%IQeS6D6,Z'e1
+TV-L!N!#4!G&CFk+l0Dr*+#IY6e*dQqqhLI43jrD%L#AE!S,)fp(1Jkh#E(VrXrD
+!HHLpqZZ(c#D6UIkcZ8HPPf&(*V4(!LD6f@3IRi@QRYRPp&Nqf`3KYL!Yj*!!a,5
+*[c5EfJ-ThlMqk&f@KQFc[6A24N)[raKECdbGMkT8*4iL`eQ$P+dBX#'Uae4&&M'
+aa5qU"kT6cAR0KjYbQiUXL"b9LM)SQPZDEFeh)j2M[jSdeE1UCmPMaT5F9'6)&0k
+j1&%h5pM(UB+HY$Kpq!R&r'5FcA0L845jkTK2'QUc$1CEJf[bQMjX["HIDBdR1aG
+rZaJN[+MT,6$@)C0`ciPZBf!#i(Cec9-!YKY2I*UVqRVMT$aQ2b2,qNXG,V[I'+S
+('8qILIHTUc%#TYb-P&8b[5b2R8R2X)Fa"5Sar9hRiZ+06qeG+aV(q'IT8hY9UXE
+$TVc'[UIfLQLMUA2aVXe!r$Pc@NKJ-3F(c-JDbPY5KjqUcKNrZ-B@0beZRR[iZG#
+8,GlRHXV9I,dTVrNQ)SRJCbj8r%AR$2-e!hXRqU$NqDC&UNI`8if+HE2U4E"8dmq
+q-9Y&mkm03lqkqGGJDac)Dbj9,F*N)reSfGL3!0MB%#3*[d%%$Eemq!*q[Y#bIS'
+Ipl5XmpR3hrcV8r9pBPMB"TUIT!`9LiA!&@GSIq"8Yh*ML+VVejLE(cG1VA%eEm@
+f2h3%l5d6$cGrBE69aU$JBFFLeH010CN"-ZkRc'NLp-CIJXK+ACF#a4QbNRCC+4X
+*3"G3++%XAh0HifMcaeDH05Q5c8p6&U*))ZTf96q9X0!,9202'l*F$-6r,MK*c)m
+X4C!!RSH#a!'5QR2%pUUjITZ`V4&HFhh0XEDpILTGIA12a6E4UalpUpF5BZ02k9r
+T6qq`E$eL`f5Vf(L&rT9HZGkb&5$R(DrC!V2S3-KFVh0KiF2"bp[%aU[dVr6UcCD
+YafcZbJFI1AVcj8fSUZIfr6fUeEmI&#'EEfi["Vj`JMePK!+)DHXq#fAiQkYEN6f
+()YP4r9&lT!Y)cTpFLL[Rh5C#B`00(jVIfc(30-hmfI*MBelcHmZ2E3YSd6Lbp9K
++mZBMK`HDlMCr(fac`IEDBEIjqmYIk`PXr)$qPAl`q*'YVmdk"P6kj-J03!bIXd#
+YE'i[Rr"aC2T(fq6)2TeSDDiHb1ECpiA9$XS1Skbli4S!GJ10NdkG,N,CeL)*iY9
+!I8PmQdMZfbD3!$d0%M)b5#R#'QqAXf1kpKE''#4'H3JjIdQ)$f0Yr[rPl(BcYYd
+Khfj3%,)NNi654&YNY,*kb-$-+&LX,848PKd`eb3+B1e"Dj!!MU!UQG&UTL@Kd(a
+X9T`ZX3AEiq8bAe8`[hBGc#F9c)G@CeBp3`EHG%CKjXr`c14F9A(car5aMUN+9B9
+0c5KiJb,Bp%eT8UL&ZUN"L`$!d'rUK9('+*'-@mRF35i'10l5,Tkf109'rh5,A8D
+e@8'C0mlKRpmR3RBHr2CjLG#YfUrTMZ8EJp04A"[GB'k$Se*)bM*Y&bQh)%[&4kr
+YQkcVpRNCQS@%D[2(&2@b*US$0Ia@*jVS3QfVNX3@ZSb"%pdaRRdEp5M93eQAD#K
+AQ2p"$NET'[G*QqfTN!!%8(D++2lTk'G0T2(m'P5JM9Pb8Q14A@XdMFBe!0XEdf2
+Ym4ia!X80Bc&P68*p&A,HiQ%dCR4L&-fjaF8k4,ID-E$N8AY#$MSpRdY9N6T@J8,
+%L*rcB*)eh36+0cV$)K"439&#6-5-+XYR+&,8j%E%La6D"Pb#TKki0$Q80mc"`(A
+@+-6'0&FQKqMkV2YJU(l$iA'C-Uj"dNrLF!81Z0%mAIcSq9Q#60-q5ch3I(1+'P'
+NYJidPe,60H#I*D$%m92G8+UEXQaq8@@,+iBMXq+f)$+P&0RMFClj$NHPj*l!hX"
+6JmdhVHPV,ReU#!Ac`dY+8$$2j8Aa@Pi8#c&2HqhT$P`,T#MEIVV$FU,EZ9FDLP*
+8BL9mX2K4)l+$[$3"0ipLMSaKiV)YcT9Ilk!YUCe()i0ld%*3l3eMQeRTf1kPF@5
+Qj1pcdp%p)M)ifSe$CPZCZ4i!5V&#JAaVT-!d`4#Yi)LD'++$P4!GD%b`5cVCTGU
+T9cIDiPe#3TH3!,9j`jd-aX95TNDUYNPPY922,@iZYEI-b'Yqh"iP!)"8f[a&p5q
+XAN,qd65+,+H(,X+959YFqF+q@AQ"P8c!r`T-#0R4MA!dJN'*6E,$q%TY6''+kb4
+'Q*ZDf16EUcpkC9,)+2!3`#U+AmN@VEm!)Q*!%[$+AZ2aJeQL#i)5*+Kp09'mQ*e
+#F2%daGZcjAA1VR)%9h2"ZH*(@X'%+"-,jJiiThbT&%qQhDV2V1VKJCXUp3!82YB
+re2QmPCQVDMp9p64p)69VNhBkKZNJQql56MX`lC@QcaK%E-+dQddE4+c%Y)p0'd4
+3"QD9)A!3H,[rCUNa$l*P)CBI[$8)%Q-KJ(ebij!!Df1ca,iK-F8"N!"d!1kl#ak
+JkPFCE'A(8'N"XTl9,4&,EFpH!I!VLTm@%2L'*dS,(S"Sf6J&!NNV`#""!-mXiI6
+CJM&!(A*2`@BU9YA#$QF"6(AK5#'1m1-JMYP-ZDTaIR#YiQ!,J%"CC3&"Ta9A%@L
+i!!GUHA9l'4YYIbHlS-54@e!#0p'Ya-,%,S#iC5$'e82NCH1lY6&Fm3NQUP$dp+L
+UT1-&+HDd!"TFqkEM5"djQNQ&#hc2!NdMlf3A&G+bqCZ1h+*#bPJ#-6-0lQ4MTXk
+qYUCE`&$d$VP[(3"j29"8P#F#VXrCDf4,(B#M@MB%lq@ZK-1S,2DL'BP2UfBJSUU
++0T*j#,rGSh0S,YZf%EMe4&e+mSl,GeL3!&@q-qD4(CSk)XbMmDCr@AH(46H"V4A
+Em#2lRkL$`*hF[E!%"*'[k2V"51mJTNX)K'K#d5iRRHRYNBjAiG+QfJqRQbjF&4Z
+KCQ6$EF*VMh)(00AK6C[m-ArqPFM3p,kFV3i`1pY*(#'jVi`*QYTA"[8Be"FLTFa
+BT,)i@q#UjmU+iZ+kK1Ej3aNSb2)AU8SLK#C3"+'aZ!'99ij3hFX9d3%aHjZr"!0
+PB"pSb#dUbK&&j14CClKJHmQqRU,#jRRF841LUjqhp458K)%r343iU2lfX@UVFdE
+dLePaK4Rl*8FPU`5)4%h[aMQC),P&cF$XNLH*U'4D9!LRJE5!j*B)-NmJ6iJV"(M
+[mcCpJd"mS&9#6SRmCBbl)jEX#cC9Y'CENf!X-ZF@f[#cUENTZSM!-9@*[4eQmCU
+U+-q2a5998BikQZXHa%3&&ML5kq11L&i!4Sl)N!$KLZQZR1T)Ri6+FbkSl)!*&6N
+f1V#NcMU`T-UFYPC0fk!U(f3m&cCpNk(U'HefmZ$PEM!YAR+9Q'j!-dbBhN"$626
+K`#JBeI6#e#3b!&`1,,PU(9JmM'Qr`m8V,[q"J$&MM@[*eA*H4qh#hF'Q2&b-,[!
+5`)j6('##Fk46*T!!&DpG$[%Q'NbIZTBm5S$)#6eL(SFE4-M,TlVT1)c8CFllGc3
+4NkJBM4NA&rple4T-,,Nbi#Vd'TJ)A)2B'894j9EY`VY!)5LhN!!UeH@G-pDqASN
+Yl5Qm@,),Ri@0D9'%db8,R49SU'TL`R[#U&VM!JU,(kfC+&kV(J+BJ!+ZDkfDLMK
+clRB["cmY3(%D$F(Ba5[D-H(Pdmra+RAaSfSflHE6Y@cDRbED[B4Lp$`!eY0FK3Q
+JGKlS8P3BL4'$df#f(!J3!`*bd`("Ab#Uk89d3(LAP'Lk8`H"fX#5NMFY"-`3H@+
+SY2$[MGlU(J4LEq%QU,+1M"""-qN3QQjl#kDZ5P1&a66Pp(i1!45`*dFMmVka8)#
+D$-5#CJ+Z`J8pKCY5iXXYdP804c6G18PM[!E6L%T#GC1dY@+0TPXK52#Q4f6SiFB
+$2&Y!e2E!FCj8dS*$T*`pq$Q+J`dF2"UfFc,bNNG4a0qd"UqA($$R)M##Q4#C+#h
+F4-!DSZbSRP43k-G29#)9G1f0jTRkQSXJDXSjc%NP82[AG**3!)dLC$'U'Q"1@@C
+#XcI01%N1fkhC01`mQ$G)`hBUe04b4+HqCP&KG,+U,GIP,B5,)+V%bAf%#-b()Up
+G*hE(pLUMc3&6ccQ(+UeflU+L&qE5F8YEVK#&d@Z3!-e4X!c6cee,bp-)'#ke!+$
+[!KP[LJP)bqmQ!k8,i-V@8h#&JSp,f*1FL-PI++r+rFVa,+U3!%A2SCK+A5TlDl"
+Skk(VV%)#k-T+p9&MHJYNU8ZN%Lm+ZQH'$5S*j$Tkl6&5-B,e(K3R4`RmjX%kD8q
+%[CLaXj1QPB%SB10&d&&LdNFTJYU*m+!@5*+DH!&3E!8J@V`&PmLpTB@M*kkJQ5A
+%HijHTmmdm2BV-@iB!&83hB6NfkpSZM(`*+#q1k!q9(5"e43iSN56U@JZ98+a&@e
+-&lkaVqd2hjM6cma3BqdTD,$f&-dXjiSjC,"@,fd+SQe`!+H'9BXqLR5#4a*DLhc
+,a+6,afD+0aX+*j!!mBTXF5TN81biZ!#*`2GDji`Y(i,!*`cZJ0aCPS18aN"l4m"
+Arkc6(qd3UZ!KZm2Sae$Yk3MP4EfS[*ILilC[`ZZb8*CcQp'QCDkbVc4kLAQi)r#
+pD"$-&ILilI5k,($DMZb@Ya--L51G-rj3HU*E8J@2M)6Ne!c`N6GGj6M-+54h@dA
+e*ClC(1fFkdJ,AEdYB4X609m1*XaB!,$mj4bRQV+j!2b[VDlC"r)*$ZH!q!bc6TK
+M[Z#Vkj!!hJ9$p9EAT-Z8$`*diBj24!J*HKEGXeG9"2GPDNU[GCSF!&jbjAX)[!r
+aUfch8-)L$0BPcV9L%"+Kf,MT!Mm5!M1U,8al-Hh$)LK#H1Q0GSP3`*UE9(F&V"(
+AUbj4aS99q,Z%Geh#kAZ9K2UMDIY8SDXRTH&DG9GS*E)B[VF$"Ab$r1D2NDNkFFq
+%5$Uk3KG[ml4d"ECM$pq)J[KJ6`,aQemp,mV%,IHNKG5L`T%@h*AAKkXVF(c-j!5
+CZ9$Z[L%YQ5mm4RpYc0jk`hRih3hAPYP(hMJ[6J[E'hYl)rfhLh&M!+pppj`(IE%
+##MiJpbIJP(hiNrZU1ZmLNk"#9FU'SfAeBTi49`%AbbL)YM#94&fX(GPUXfaMpld
+-9m[Sl2P1Rf1qXb@fDkK%b(qFLma&BV0`Y`%eZ3aS2ZLF#rC)V(4rCXSC90ka[11
+Tjl()122l-rZaU#150KE,lFD$F!i3#rkI$*N@QfmlQB&&B14iHYCY@*MbmSJKN!#
+4FMb2&R9C@0&#X2pJ6%F6L'+M0hT"(%35X*ESKG"q!,lHL#[Q8hG&IhQ#-Y0M)0P
+d"8jMZCXUB)Sb$"b)4'r!kZaLNEC*lRi'KHAAhVApX-FFGF8pcZ'SDjr(UFDRbeQ
+"U5ki6)KB"Dj0'Q%1aL#C-N3*+D*cak9'8#YAjC,J@i05KI9#RGf()b,Qiqk$P&%
+q66)'-C``YhLFSZL1fF+qkq+2C6pHcZE'l#[cZ[eVi6,-c@-ic$cmC"i!MFV!AL@
+CBKk4D,UL2i[L4QF8Rf#HGp)P)9J88b*'M61j+q"rS3j*R6j!)"eZqN#1JfhTljD
+0M'!B4DBK9+2fQ&hU(cLX5%KAJBr2kAea,+DZ(SY&TH'b-4`C5`,&1%a&(pc4J*`
+QGlq"*U"SZB'Da3$ma!Kq2J8B1@iFUBj&ADTTpP#e)%2Ed53m-,3@jTU5e![!86q
+5`m!T!T0i13SMI2Qc@%McQIB#[j!!Ek!'Y`H#SQqm,&T0jm8fA0,M#0LpeD&BU$T
+)SZPeSJR14IFQT#X36&6eA%55SqJA`p@r!'X&XCciJ$-dF)B@cU#@YP$YY`rML[(
+UU,eLD$1FDdS46"D*D28Yle#L-8Pm"6mq,9`m2lkfdKA5*U2Bj+hdLJFk++KF&Sq
+#T@FePJVKiBcEZ&*kU[ZNJ*ZJJ%[4k89'V4rNrP)%C56HJ&R%Hp!-3f)cS9E([1V
+0)S$LYF5NCZbDjXGJ!0j%(BTP2mr33l(#!,MRb4@NZCU8DVT9MMX6P)PSmm"phHm
+FRZdk#8H-b3QR6qfjUckf5kf1Z+Tlp%8)%,lE'S4ENeVe1"VDGpG1c4)J*d6K[,q
+9*`C"4T+0SS`hb"6QG$F19DJHI`I-UUdBq&@&A-![9M1F+QX3E-1UH@"V8Eh!$hk
+&aZb#(p(Khh#RM@SFVM+1%0Q!VXAeMr"V2GTVe4XQV$CjAD*35BYhb+PZ(T&"39K
+iJDZ"Lq-L8',CGG`*84+*-X$Z'D#,Q[L'Ak4$r08Y5(cJa58M)**jf$8Y#S5R1-*
+UIN98p4AIV%qr@DMi"BlLX"C&+4PEe6YdD"irp!+rdS$FfYA9[!VfL3eL0kh'I[F
+la,+9)YJBUSeTJhqhhS$i*VGbC6h!)i%ENl'-E9*Y)dGe5MK%L45N6@mZGp-2)D%
+UC3-N3BLV!!Qc4Cr`,ZVbLEaC9-6H15JPpfSDN4*HPA`K*IILT%Xhb'IViT3Y-@+
+,NpNL!G#F[5VP+dUUL!E@#l2LpLJ4(fLi26%V$QFNIh4)p4-3PDqFNT,&PC*V**T
+H0i-jR61AkM-iT+`L93L[6K-lA3$@cCJ!)[+kkP0@*)@M#j[I(`2aY[RY@I(S)Y5
+Q)9@aIBSIJ6L@+'&f9ca@SCr%PRCe!4elD"B)L$Im*4Qcq@JV!$$6`S,J3d6ii!N
+iT%3RkM"PGB3Tke0*@BmZCmU+5JTTqK3JIEeH2DCh*H88cPFUTm3(e)G8Il+hD"R
+ISUCmi5HN02Z"F'9YEm"KHhR++VJ@VpS-bYS1!ACN1M6rE0AUfEi`A$f2AK1Z(JR
+`0TJV,aBj+DRNG6J#m!b-BmBGU@I58i58r*!!#Qdb4mR4,$,a`Udm5Gf),6!j!FF
+ap5rpI#)T6GLh'!-+8V%K%GcN8R@NGjBl1L3#@A4JE,p`p1CX5K1YNhpkIr3+-Jf
+*M&[$QqdmDdPZ&$iXTV"!SQBN%P0IB`'jVMG['S(UiiVQ3p4$f648S"m3)e0GlNe
+H4ep1*,T*p-M#2UKfei3LSX@5&QK[ZhCQj&+XeGEAkRpeL8T9*dCZ30k6@ac2M1*
+ci+62H`15iiR)T8JI+TCEGhM0Rmffj-c&pEj*8qiLZYKMdermHEFjlh@3!%!QqdF
+cNF93MkV%CeVmHNPX%e3km(S*A,X3m92hbR&lLc3P%H0q-4HJM9UD`X%518l(H,0
+paqM[ZH1DPYMZ`#YNCc(Q(hVNZ2EJ6$P1%3I(0BQ`9dY*$PPfP4V0UDRpd[&@kBL
+9CcQ@E)@B&PhFAY'qU'4ckk+5Kl!jN!#Rj#L)9#"$PY35)`K266`Lf[3'b9r4L`k
+@f40Y4q(8ZNK9[$m3FfMCm[jp)@Ic-MDEJUfe-P["ii`YD@"6"`d*'C(5%4XNm0i
+SSNIhi6pl0(U%,bJ4kXVSdG(Hr&'Dc-JjFja2*Ke(l6l(%53L$HLc!8a1kjJp*bY
+$#PCIHp'4r@Bp*C2hpj!!Fm[ZcqS$I3**3lRKAq`I1Q@Hf0dlf0rC0pMGeYFEi5k
+rA-MaV!YRQ*!!f+U%[-5%6,6e6daqCk*ciUaH$!8LJ&&HYR#cKBm[cNZ"c#M3U85
+5[DTJVcVCK)DbaSNdM+Jm,b)`!TZ8(5qL%j[&FM4pfSeZq8CUCYSZ8XA#QMkSH1V
+kKb+6Sa1485&'2%-TQFI6-qA8R&cl"HI"P12Tm(#@MjpC5QJ@@FZ`A9iJq,BKLDY
+hcl4Bb(5@XZFJ-0U$#SM!UGHi`'i0hpT9UU6JPP'5Z'C($9aU5e$C3e@U,b3!iad
+dDe@0))rPJM@E-MX1@bKa1JQ8a&hH$AAeN!0(*M@p3lcB89faPN&X4CMB@Llf%lV
+Z"'88,1$J9"-AI9N[qR$FILm$C@TTm3B+@K&#9(P9ME[V%b$`6aKR`qPmpfF@0"M
+f"')fFX8Y'X&Qfk@Y8c#&b%[iZ@+-0Mer1,klhY+MZJ4h`S!cY#I`cPR4dX-ViXF
+,U4$pk@$h+4K-IeX[4aeCmf8F+03M,dZ&NrT%hG"[4F6i$5Q+10SPHQ8MDc2lcHr
+hPDR,l$el!h5%6%0LfZH6Q)VZ)l9e)+["''Jij,c*FBL1r1JX9ACL)d-)P4hbSbF
+kpIE,Lh"Z1"@d-ISaC"kS%`2C%[!LE38")%,'2p6G1GKr9VZPqmch"kJ3pj1U#Pq
+(UPCDaiMqEB8E@+DGK&UMjLb"KKfT+kB$@4K*ekQDkja41JG4-QabSMSUP0M`iVl
+1'EYf(Bj$PG'f[kJYK!*)5(1[dZdDj1FSd&FY3kBF[ji5Lqi421K4`ZX@%%dd&2J
+3+G-FVr%A+aep6hq'TY18Sfrh6%I)@G%HII-IhJmH$99QHj-1$L0TUMU*aQYp!00
+qq!"9%*YT8-rih1#pR0(dPXhh@5(FI0,*@E'JSLG1bB8GV`(iqF)dD(+$XEl&,BP
+bfRLNYKL1B-2,F1b"NEJd5DjY3h$[P@qdAB5JQ@Sh06paB4G38$Yhm'Kr"K&qM#+
+m4pKP554ca5"KmdELA%`Th2SJ4K,"0j!!3&"j#"Q"8,kULG3%TYG42-$`%YH3!1%
+G#+MGGPm2("B,lX8@e0`i@L6"&A8pFDlDebJVieB3Y!E18SF4kQ*Q*!!ljm0)c[C
+fpNBQfLVE#NAA,KL,4erTla'1E8)MUGiqpXkNDYI!E35dF""S&i#9ph[LpK'j691
+A3&F*qU,V"d5BFTZf#Cq%b!mN405SI#hk!QdK&8!S,IS(2kq%JZ$0""5'0U1hr-*
+`13lhp3j1R'SET@1G%pr"dH'TrYcdc*6Fc(4C!k216-R-6Fdm``@U#3bf6-,P%Mr
+*Q*Ub3*&S)2S1%Gk5-DmTe`$JApEd4VicfMdi53X&3Q5XF$5F4S8HL$6#82KG'M,
+h$YhHhcRChbF&0lL!"F@i90$l6@6U&CrJq*[e+D(CY2JX2I##lmfC-d1m!"1aEF6
+#,aKR!4hZXVGNmDMd5bT%!KXTbM1Kb"B8&r@'3(pTX$Xbe'Y!30U`8c)-J'39,k+
+3!+KJ5&IS1dri10,EeMXa'AE35NPAr46PZqYjK4KeC)P1*cQ"G6E2-f'!50ASX[8
+EEqZ'J-&Z6@mRhhLaqIj[N!$C*%H!J'3kZqXGlMHTS*C-b+p'9UipY1H[21LK5Z(
+ZCA!c3l&5JHD$'i&'BiX6k2l-Nf0aJ&*[5d()q+F'+#,PaYQ[FA'jDVFf3[faQ)R
+F9Nk(Ll2bLN,kG-liPHL++em$#'JSlrU#1pMeGZAe3$IkGi1Lm`HpU-+h#EHYc1Y
+5IHMdIFm&9eNTBSiMBY!jKAU,AX&8BCYkcrCh5X'UK%F(LZb#"UVbpG9'dC8ICDZ
+f8l@S0kGM10MEfFH2&9&5*4iB66e&aGYH4DFG&J+XM5SCf9dk&aIUNDUlSYp#H&9
+2r-ek5YMP!0$"LdJ*26X[%"H*+9lF8Q)EC1`8&40`ER)4JF4FEa9bR%KeY6fF'4H
+qqCRMf0-cF5bk1k`)4Y5p#1@JQ8*A)E1JXhQq39PiI3b)3I%4$9h5*1Zb$DrPU&f
+,%LU9Y`L-r2A'MVM4fh!S4hU9J9H(CIIR&QafP+VG4!e(SYla%NFrmFP,@Al1HM)
+@f[DU2*9[X8T1B$lp&[CjQqF$)2C5Kba-56fNS-)RSIaLA1$Y3IBqSQ`F4C+qD*a
+#aFZ,aP'U`)3q+,1+%de!1AjRSUG1paZ6%mkc-Y[Z-,pJLLG3)L5QN!#9DZq*4eq
+M6GURV&0d%!639JNiP#el"#lfk#Y0A!cb6)hKB[-%A$&B88b!#,pq$bN1bZIJf%i
+H"FZNLaQSmc88a5MkB9C4A(CKT@8m$VD4F15NMQq3!!9fE`qpAXQC1hJbjCd5NXU
+YJ8AQ,"p9hL)6iqQ*@k0aRjU1RQ2Sp("8pR63"D%HYdc4pKU20VL8kPA"&,$4S!!
+pf+,8!)'b62fNZ&'eZ[i6FR#-@!i,+k(M*j!!eQ#f0,aVS9ka9%em205Yq4c8`[l
+1XpfR4V8UT3!e"IFJYHQX[)l!",[1m4)9+hECFHKT@RLX"($"YHUhJ`PdQ2AdNGR
+m"6IrXrD)V[I'2c+'pQea8L"3p"P3i9%p$1H4d'i5[c*KTQjZCVpm,`QRkL#k3fh
+ql*-MA+Mhm*MU,-5L1bj*&#G'kXJa19bN0$Rh-NcJ'3j))1X&"3JjT$mM05J#02'
+KB5*%%c--%d'DD$4-H'PL(KH1ETk3!'cXQH@ADij`FTAP(4j*(N8NA6V9UCNBZVf
+hFc6bZ9kChb"PUSNF8iibUm+9HAm*8fC9Q$,lp-UmrkB15CRq5XVdVe+CIP,QM("
+P$NU#H#0LG9@bb@hLjXY@(kN4jM9S-#m$mcXF-2GX-3$QP`FR*NF48TN@p*8pUB&
+AR5Bb+jIk9G0%bp4X9fkDIP!c-3DJIdm!%e-0Cr-L)#bie2I%i-i)pa`"iS83&9M
+m&j))qVb!0`jE1-XQibTBE2''E+TqN!"XlfaXQ56kDDRD*N#VAKm-V[C2ST(GLfU
+qZh2h"!2*898(rDbELLJ9,ccbfKd,HH5Y4-&2Lf%HH5LL(cK-N6Il@,DK+[G3B@2
+P$4XL#k"`VC8+$KDmk`fQFe8UhVicS6%SVNK[2Vbc$&4[KG3`5+cMKBA(ZJj94b'
+T,laUBSLf-%56U+B+&H"&PQR`J1#)Z9PPHpU4EGr0`6!A-VD'2h%p6Ff#,TVbSb%
+[IX%V54f4,ZP+HX%#9RX,YSbA%K!h1)lM1MFh(`5@QbbaqDb*8H%B$+pSl91X`15
+Gh8R0m*kiT"DY-8%YI`Ze-*hdpdiDi&K%cdidi8Q)'SN-4r9%4@6)l`H`,8Z[8'J
+A@lA03$H+G*T#mISmVTV50QkMN[TaNH%'IpPhMKZ0&h+GG"8c""5a1JX459+0ZHP
+5!Epe$-UMcBa4X5`"8XBhQMTd[h%XY+-#YJK,)+B$!bq-ZA-4XK@E1RV3"4G%64R
+p64eN%YX%#CI!Ih@pJT`aa-JCHS18'VNN#NdK5C3%*KP%m@V&0m!ER33#-d,'N!#
+@N!#KVl#MK$MN,%HP[A+e5VX(9G'SeFp!X"+JA+(I#*Ul(USH8@&03Cea"I,DLJ9
+A-Yb9))*M)5@!)J"!CHZ*aj*5d#Ne8M9*SJDd6@8'jNPBkaXB&HK!%T&,5kYDhm$
+(*Rbm8Gj"cIbB"'`SA!Irm%"imaq!4$P01Rj"#bl3m3YDV'U3!1RTTd*a89+XC"F
+0aeC+6FV+E($mf%3-KUENGrZ(9Y#5C0G'FHdi[cCU9@X0*FLZ8XGD*)+B*2jA965
+T9c2)F1@d$eFTH0d+"#p5#JD`X9VENBP0DX8QZC,mR!cLCQ)VQ0KNR)[pQTSQpH!
+qM)*"qdbB4kY`$dI4!%"*JYA#a`52-i9l+V2KNL*L-!#S2b@&-rL8A65&LeVj492
+m)Z8P8G(+,[(%+J'$dJ9IIi4HKJ'LPH'`pEYSC08AlC`HIY%(fSdB`$h@c+jaH[J
+eIPa$48'5LBl'+[40U'GQdi38N!!1p3raeK)6S0B')l99L5)bmCQJ+4D-&1L9A+8
+AKL,cirkKX"*c[93`[QS92&S4VS+&r*,95[reZfaUeCF9bq'AIFc9EDKr@E)6'lV
+!S%3a&G6!h#r5a!(K1*YM(hmekK2rFp+2K0e$NDTB"-1j'He`k!J4Q,DfI3S*11a
+45[Jp@M8kG%!9Xd@Z4+T',id1aBJYb0N%CkZ3!"+)lklD6BaqBYapDII3p,0j"(D
+fb&8f0c+c&!P'9YV'&%JG%2Z&c4hTE4M-%[i&(M4re9i[GpVPLC!!rZHNm+ITNb'
+"FPF4'!pd",S#Ji(4`-Q!-E!RF$N`,p!8Q"ji2h"(B'1J0&!B5SBmSIE3TT!!+D3
+*h4[+#Kd)eB@q#VdBQKfU$pd4fKJU$48'Nm(aB%H`+cJB(!hDJqR"Sm'&`GTJ3h"
+QF'j`Dh#R0q49Ha2H6Gj"lkMAlNhh([A@H"GiArI1m-laAZ[Gl0hPpVY(h$Vh,,I
+C[GZGi8ja@paAhBqi&lRVhAHiRh6[m[Pp`ckGEjD[clIEGpjh`(ICYm$Ai*[TQq[
+EkYYCjLZE+NZ8fFS1Pl@9R5ilAlDrV+TXH9PefHbbqV*TC6HAh9Hfbarb9rK(r1h
+q(Il$ISGrYrrN9+(i"ra8M6iE%f9f0Mc%KrPXq"SI1YM`Th`iaSBAqE#($ErL3jN
+0(q($&MDmN`qpE&K03pmZ0UcP`meXq#)IhX5'Ar,Kh@ciVhci"4ZqaBF0E0M-Kl9
+Xf-5(#pQ`N3q2XH%52NaM`m9mH)i0AqI$%fbiL!mlfI"Y2R5aiFriF!FErT)2@pP
+`0Km1Xq%,I1KR`qNdG*H`iIrQ`iIBF!BI2Xk'rmD(FpR`2rK`*KYq`SF[B,N92aC
+5kQkD)J838`0R@-L'A-AZBfc)PHT1Bd1Z4[FjKDKD,LUI-8J)k`hJ0h`iaPjb"EP
+lf*!!4i&ECU+UY+)U'!0AK&Z`)BmLlc1-rDIk,AJhXUZ1FBBlf(!q(ll2f1[`Xi#
+ccfELH(4iAe5)Hj%c,&G-r5ZIXV!Mh*Lm+@c))m+ESEMJ+'H2++BZmLQABZS$2N8
++q!NTM`Z4&3a,1)0H!G`-[AS&m-J1NJ+QkC8AI**YGaNIAXZ'cr(K((E`(rP`"K[
+bJ"9mR3fjq3BA+&#B4bJ%,f2j(Rk@FiBp#UA8FBBXaC&MI1Sd%mN$5l#0$EN4"Jm
+VM'8CCpr''(M!$UjNL(1&"09Xq#`IKYM`EfNBfSRP2qX4#ch!KLrai6@+DekLDd,
+[+DB@mLPP!(L%6p8UTVl&TfS88r2je"l&e(rbU5b'eXrjeIFbKZrLj`TRD'--A2Q
+K``a4(M%K'f-r3NE2f8N"Ib$ceaYe++UimYpS+P#LQ*V"TcDcBa5C4rM8YBSTESk
+"paA(lZ46qJ$!83qmU'$J84pBVTML35CJ88`em+PFYVfMA%L-$Dr`BB30Mr"K(aY
+HiX0CE&M(KcSfr*J24pM`+Kp'fI!$'SSL0Vc-Ke[BN!"(1dH0KJ[jm(UQJLp*qB5
+Xd"H!h'6%#f`iM`qAXH%hqA!q'riR(k+,'[%q+bMfB[&2V)JaXJ&99aP-Q963jl-
+A92#dX3'*FV%"AEQ*(5"$d,%Ahm*JR!d)%68E8$AURASrmQcNNJ5Fj)P[fcNimb`
+Pl#@ATE#%dj58+N5*N!#mGNU%b!'BQ4b!ZH@Nm,CTNe'2`h0L0(JqZ-"VN[i&Cr2
+&L,F("cY%J"qYjNIMk"6['Zh4k@+"-!Z0Q)BH1kH*h5*GR"HA4D0i%F16BLD5)4c
+!FTV)&FI%#6&(I),"FY(!*kH*qF0MiNj5,"De@"c&iX[B!AaHM+AMXbb@Ldp6l$`
+qcE'6q#b*RF$RpGKZI(i@dq$c3Xb"crq1pH(c(l($q(`5km+R2VB$RmpLfr#C'@[
+(jrXa'CmjX4&m2Sa0i9-BUm#R11E(jl%B[+c95%,T0LXf,B&lqdk+N!"1#qiY#m`
+&@2FkYP`(YqfD`-eLIZ$$`,@"RB'YJFf"dY"+84hb"8T##&LL+E3b8!2!,aTU%3f
+KP4KD4,ei$UUi4X`9'`2ca@C4,,B!K23(21Kc5!lS`'3,Z!"-QJ2j!8hJZ8"ei(`
+J"U!bM3[i!XM#!6``$iXM&$La1)S&+C'##5Qa#JY5ib%X8V!iKX8j,&l$JY4BKm9
+T,(j+J41,+eL3!"S[B@(#!Pd-"TCLm6%@T-DV@(4Jm3%@#5aU+("LF4',&Lb@Bj(
+%iL8X3PJX4'5@B2'h@$b$a9GBh)I&GbP`BM%ILjZ`3*HEiJiXjQ(a)4EIT-#*a50
+Bc-$L@eM-aQ)"&SeBr!D,@LcH`S)8X!J,8X$Ec)LqB%EdMpb)rSNEdGhFL2k&'p'
+eh)LZi8Ed"$HL"lJ4hFq0D$-hSYpb)lU2'p'[Z4%pa)hSB@j%TGb)rX#0k&IFL*l
+K4[3eEN3lp8B8p#,Kb-rJeZj6MiQ[5blVS5d+`eVZV+!1"[MJ&5HDpcJqMB[k#4G
+eSej8D!C%,@HLhQHLPLP%(A-Q)-V-"lIb35Yqf[(6JamNY(,+-4Y%lZ,Eq$EIaU0
+m'b9m'p[j0JVij8AmFTAfmX1i[*PGrZrXmJj-@YMN[l(*BIj"JNeNDD1i#AQ(@j!
+!I'BV%MK9SkYUS2VB*Bjb#)QmJS5Uj58Nd1UBT)H2G(a1ReQ6KXrS+ITi*JdI-df
+*'Mk`d8GFTQ0LkmX@cYccXS@rp%XIVS`2UGXh@JCA1M2iBL-jUI'$,dS(4"@1TqN
+(H0AfXZ9l&QF+&r"rRI[j`Z2X`DZPB$T-%lFm!@Bbm(USUTSCkVmb3feNKVUB'@S
+$-p6Cc&"rb3ae1M28Rh0$IBiEkJaZU2r!$I@IZD'qa`heapa3jh*$[BXEkKhF82r
+)$I9kEUKriSEkhcb+Eq*4I$12i[r,ShJMMq+Y2)Vr&irL*eN8Rd!drF'ZU4a*d@H
+&H2fSFaYI(('ZT-@ArqK-dU+f'TRH(JMC`XAqPBYpR)[p#a2ViadK#8AA*8K-car
+")T%+3#B3+hNh&P&lP,Nh8I)%'h9h)KdT1%E1Rkh-%B3bHJE1`39prM[Ri)lq#"*
+demU1fV*CP1&lEI5FU3mGYIQ-dkJB3GFpIHLiai6N-4hLX-l#&chY&NVUMXl0(d&
+LH$KH&ab$!pJbkQJk*&502&(kE"Tk"AFb2eBGJ[#dD+jj69()RR,GKh&06j'hVFF
+[#ZECFJYU%rl4)qPVRfMQ5G1e)TeH*0&[4`,'BqCkUPM-DjcHrG0L,DrN&L`50Yf
+LJZRYL`TQNaUT1YHlU&*@T%HQa`P9)bF!b4QI48,0HEN*U2&DC!+3!(-SUEF)"*!
+!(c@Kql&BK4cmed3V%T!!bF%lXC!!(IU%D3`dN!"FaTV`+SN%b'V6ZjbiJfj[H')
+U2#DM9G&C3p6[3E3K%pc[[$I"ZQf)H9[HT`l[d&P--,&fTX@q"3kZKekYbKI'H2d
+KqdkmfS%Z*,ebk,'k+SXF-VY-,LckGIdhrV-ZqX[h-kENQH(rIRChjN-J80X-"L1
+2j5Lkkd*d*+Q,-(SJMEkM,@h(6jZPlLU3!$LeG3+G[lhUDUh$`-m(4e[Vd(e60!F
+GVP$RL0qZbqq@(HM@"4ePmBRcqGfa)QR$hmV1cNM2cRjjachSi1Z'HdiHcmM16%[
+00**riq"qUI0@l9@H$48rAbRqlm)N#dQBP1#%NTp`pY49XUGe([c2"mmI,iGTL,J
+idil1J`Z86*8fa6R&kJTXkIcG&"Lq4EVVH&C@6LUl4N+UTBpB`e(AXJj*DYChH!)
+N9Nimr*2@eMTNa5$KkhB0SA+L1mG23`N9C8G+G)J6)SRC,"hPRC(id6&%Gf9@5Ib
+d"9VaYJd3Vj11AUIidGpCr1KeLrqAKr6L#m4kL-HV`Q,T'1qS"4dTj+p)p(iQHNC
+"G,e%cbJi,"d,&dS&"K,lI53DRCl%4f+C(+KT&VA26iKDZ4p1K5ZI0iX&Ub(3!9'
+LYBiqB'V&JpQQT'f@A,0LC1"iV#G",bkC5iHPC*jk-66%G9155bm81m+c9TY%,9X
+XSm@Yj*VA5%Y#MaeD`!p4eh%@L4fCY,LQm$b5ha44`FXQDr&`U`9iI09)*cSdJlY
+UNB,Cb+Xjmr0JNkjLD0qREkJj1U#NT+04e0Up*Jcia"5kJe`3D43,IU44U5BEH40
+T2TK'l0a35MEQ8a,a'L-p6'@RqC`@V8*pKe[i88%)8*T&+"8b*U0ML*ccNFcN4ZH
+Jj%iVPZAMmA&)[1N`DhL'lq)5**AIAXHFlKq#@9SdB%'QF!6+jae@5Sb2&U25@%N
+2DQ&GJ,&U(dlL'A*Q5NT1LR`K9qj05aqmN!#9fCpV2*JqQBkAH8ZA%S[Z)b(H3#Q
+`G+QfA(VMM9l$ZVpE-G*Qe$$e)8Q1fUE[XUqGh"q3!"#JA&AZS+lIfcY%lA5`C2'
+1i%QjLGZT8N(@2Mjh3G'dZ#JTHKPAG!ZkQ&[(PEfCG6@a(0dG),%[G6!JMT)JKH*
+,p"d2@YFTe&kb!V8r4*Qe61epA1fl&'VIaGfI$@V29kKpPelYX[3302m'+$cer2'
+8MQhbQ3X(-V262pSJjDX++9Q3!*4"*P0hb$9`j4l(`qjQ5JNEYTIQ5mK59b&'RR!
++L+efaDNcQ5P+b5a,5-d69fNcNpCKmkjf$L3k4eT[id8$3"d1V%5Y3CiS#KRXFP#
+[!!P3BQ,SH&Hl-+UQ8aFV(6mD8UQBN!#9*)3#"R8jT4Fc61El,*P[Q%#!)@'C@`D
+8d,N$)F&8iGHVSZ3j548P6c*9Y1K9)623GRh8`5lfKfeL"cT`iLL[GQNIZp6i0lR
+8%!88N!#BXUBqlqE1q3U9YmGKqQU1S"4*-EV+S$3)5L1R3%PPmTX*6H)#XJ%[+V[
+,Sm*E2m%l[Z9*KJcGjQQVJRCd,1JPTbKdM4XeRq-GF)p6*8#AVU"+UR5"SBS5J`k
+4hffA"X2jh5K3ND3H`%cSiTc`lKKjN8+2A[A+P"JqJ%FlqT9Gr['XiLEK*cIPmUV
+2Re6VUdmaFYh9*`lei0$*eMT5KZaJ(Bfh5L+qI[Nk0U`A-X*958@9Ile"M4QL48+
+h%T!!)@A2Ca&D8MA+A!2p$,QNS4"Q+TmK6NGJTPEUc,D'$*&9aBU-BG&",bSIecI
+rC,rk4MXHdUKm)@Z83b2Fia`HHiPbdUU'`%e--"VrqJB"KP1a+!G5&dXJU[kBi3&
+l*##r,Rc6US8V8&5&DAQiNK69d'D&DQ"Bj9r-,QJ2QeMmlIQ'aeF+E9*(rM#Tq@5
+Z6RpN#44aHf`3lV0TP%`'R6`qd'SQJaMSTSS'"N[UYr(UD59RiP1&#bR!8XFbhcB
+bK0+S)6JZ`KU#84b"%J2(U$')kLR+#ccDFY+`AIk!6fhAZ+d[@9m&`eId`,2q8Ti
+SjcB#*TN+1U8!Ji++"9i@F0X"b%AP&KkFef#6(GaX$["Z9R9KL%P"f,)LNbAhLYD
+D&88(SMKB[iJRqr2[2V,F)JF86&%bjjBD*AM+NdPMdbPb`j&-Efe2$&e%1T1*Y5h
+A6&VX*BN*Z6r-*-p,P4S[T0GT8B-+9FG))@G,q3X+,N`KUX2P+d3ec"9#fapAGSj
+)#'N(%26E1KkSp+CGSVq@NSDU@JbA%ZL"4&%E+6$S,bqD@IlP4I2SFR2H6li[482
+49M*[UA2jpZ`rIc%FMVCSU)bfQ+j%@m4@B%+E'0V[-q0T+3pYI66[U&'UFDj&UFB
+rUe&a*YrE5+,i%0!XfER0-2Mk[BE"eeC@,[,RUX1+I)"d8T(rKhRAU9ab[TY')U6
+L@9%!QDqVU'D&XD',fM595Z'ZYVK%T`@Qd,5"mp494A(H&4BBG&j[dS)0KK@TdX9
+PkXV&G1%AUdfp[YV822f8e)Qc%[3U-CGAeFj0eeHek#CY[DZp4mHPSkY(1"jBS$B
+8b4)"XTfk+@fCAT84D[HL`kSCfapT&hL-ZRIkSIcZM!J9`qhRb196$KU-GAZASVK
+E*aRXpU[DJ,41B[ZfjT8Ki586MQRdKA4XF2UK9*0Z0C%P$bK%XZ*cqjK@*!ZBZiV
+d)T8*h282Q99@0P*h@3d!JM*p!),3M'49$#r1YKpY9e3b8L@arD61,%G45E6`LJ-
+A8N96XSXB#CKbd'2'"kPc4`Vm*6BC(3+LmF+,$5Vb`AbjI6Q[U'4qe6VTXUrI9dj
+9GEZb5T!!*@3"FSdU3#jPmBdQA,r5c)%%J3BY"**)"U6D'#B1REj80VqLDa@ZB,`
+l-A*2KaYB)%diMZ@-@j--R29dAU31c*bK+mpHqfbNkVPMH8r+F#AcTPAZYS"AG'Y
+`B%DJ4#Gd!+TEfcUQfYdcUM6G*p&ek,A,TeHP&ZZ#mjGc9R4a,,',p[EN9kMiRhb
+@QTm')&S13RfHm+i,T-HJpJ"Fl5KVki&,Eh5E@pH"VUDKp[R(5$N05(L988&Jr9G
+)b04@CJ2ap+Y$FXXTG*rif1*YlZR(6UkmpPP%NjGG&HfmQ2$L-6hS8)k-2(8VM#U
++4jZV$3mc03$+h)M819%*p!$b#8hhrX"lMB,qH)(SeMS8j@3HDMQX)h0pKff8H!2
+'9a9qIEX!dF-[0AcXJe*LeLdqeP3qcj[+KBUQ-LGe+*V+'BUQFU'fU4b8b"-6$pm
+iLQiSE1Jh#@TkV2PCS+S"JXrK"eh5THP*j4HSj5cEdBD@-h-ccXJ(Fc26M*QTkCN
+C@ErI8*)&+l+J%1Vb%-TdmD'kl4b'ILZ[SLDTLJS$ZhM9j8Id460mY%6(TceDm-0
+!XKhQK(XG&ArjBF9I1#"U%,Y2DY)45D)kV)KB*&8GIr-VT+-mbk#&AkF21[l1LbF
+U&lPrYQX9'hYZa9G3pfSdV+p40Yr+Qjaiq(UASB)0UqBI,YQS''a@$+k4M[jT,2b
+SSH)ZILKFe(DK'2J9!ip#E$%*L'ZVld"22RpXIQ!@,F+VG#6Ii#Vm"C&iGi#)e@V
+R#IG4B1r!NEi6hAKUqMhiS@%&Ef3N%'M1)@JPH0"#iJY4cB*5Kjk8)+Rj3XkCl*2
+(cf6+pZ-AXN"`)N*6DPEQmC69!`5Id"pBZT5G#!m3(!bk[M5miIZVE9+&rX$#p3'
+$(TK$)XTVT2l+AVQCL53i1l346SQ8m4!i*1$h(l@S!q@pQ+Pi`36FS`Aqq4BS5Z)
+`8p8L20Da%!mD$b0q-c,bMR#8$D!ADe#dVJEB1%!m$2'QE3SR@@cE0bB,l@3Rl`T
+e"MTiFe(Q(FLE5)U%!M5%)V!DA@hQVNKPP%A*(hc(0fF,fa`5T@QlT@(G2&"$i9S
+b-'+)Nr*Q&+($&8-3d3G@8`[)V!'HT4!LJ%',kM2F[$6DL6YNIhih*fT,%c0j`jf
+MVChm3QVf6RdLU&ZCqB5)rQ9K)AA++UV#*MGMdULF+QU4!NI4$UimRMaCqr+F4#S
+S1Ra#HfA"9Vj*2FZ8G,aJ*dHN`J#DN!!T'KV5P3SaG&)C4Kb#ZYj8&#AUmJTZ,F&
+QHp2US1Z+#MN1V#!21*aN4Jp*eT)SHAFKQR,*%%T5a4qb9N5U-*!!5"3N[(%$#Fm
+S9LpbYiF9ZC%QhNQ0IcA6RN,41-)b&-Xe8MSfLH0fkY6'6k5j969HU%*mSNj2%,f
+VAX'X*0V@Vc))DJ(MbN3R42fl,0((BPADUK$C%16#,f&NSB`9NldF0ACrC2(2MmV
+dSej0TCi0)M31'jMc9m5XIiJ%-Lf3!094B@hK'5#5Dd!dM%"3LG5U*8`V!I52K"G
+UZ"#Q!UkDm!Bj2k`Z2k+)R2I3i*0e+b#Xk6GA8EjC86@k[CLUd8+rBU"@$)55F*!
+!U#RAG$GFdBX,G#Y@Y,jj,@CTQpH'$4G*64J`,#l`Dl60l`*Aj5TY4@LUdPH98EU
+H9kZ[qfUH#(4+bL,N$DlG'ZU8[jLjqY"4)NbUf84d"B'Q-N'i[)KJMb2!jQl@%LA
+eei$BUqNfA++UV8b3!+KmHAPJS3%Ke3(&&KAAU"D&AA2hDNFA&mLV,",d@h[jPh-
+9e@JK5m4F5*8l1p5L80R5X!$eFS)+erj9&QND6GhUL"5p@2kf`T9AC+p8e6#e&he
+BcRDl9U$!UA+feX&HGLQf0PbT'(5Y,UbJG!@4F@mBfUlV3NqTI'A9[&Tf%BM[#BA
+6QIcb'fh#UlZBZ24Z[r#fCqX-i&581T6(G@%&@9KNM2e2*H+BV&ke-C3Ab9*#Dri
+J,dNPZY8$fBUL2c`59ad!bJpii8&)pIi+#+JH1YjDm`TB+5YJ4@68$51ldKpmScb
+JQNeGr,e#RG98ZX5kVPfIM66jaJ@1"$lb5mT($T@*(UQ"J%iS@hN(eKf"QijZ2E6
+0r89$PXMd*Yba8+YE$Y8F!H(r56NJGBPQL*C@1Rj"S+YY'r`*(k0+68H%"*diUL!
+)Fa9+V,TE&iPA296GU6F5qqiE,#0K*#diRC4AU'l@9m%Sd2G222br2L4AQ0pZ3iA
+Fq[-j)(TZ&KSXKQN5JfS-Q'Y@`@B8p%RR$K`b%A%6VmGPhJ4RcDYaBY[H"*!!ZC,
+leZS1A[U+h[,r+RfklS'VeTN,UGP%&MPjd*lpS0k[E"0j&@5RTabrN!"q"Y2C"XH
+bX-eXIAqp0e1Xhmc@rd1E55eh-kRDc4K!)b#fHq,KadT"N!$edN*6PeqAL#6UfL2
+dq+',rr5Z@5`P02"!E%`!E3rBVY+IPi3reFE"(B*SLh01G'mSXMPRZ#I(G5Sq$0R
+6Z(irA8q,F'6cPHJQT#N&`P''F24h4IM#li)`P,YaTU6FM62A4lNEcrmjPEY"KJ$
+PEY4)bYfS@9rPFS6rE-TG$i6ek#ESFTCK`UpPB'+PDrQPpi4Gq[IXdT`c'hMKBeI
+rTKHZ4b'M[p$djbNZ1%*rTd4Sd`d53T,1ekHi#%IVce%JV`pDUeD@fNVG%(BHI#3
+M*r["#aQCZAT*ADRT[cGQJR&S-&ASRB%mA@`$IFL-#V@2$Um41cc"&2HF)`k[ACk
+eKTceLD3Z#qV#QC'KZ$NA2CGIMMRVZq@e('DEZ'H$LVCCCc*cde0q(qD'V5IhM8X
+AEFHI8P&CP4``NC3hjXa-Kirala#T3rpIAV[#,I0VShLD'@A4)I,3853qDq(5M3M
+-23j([`I,LF%(+3VT)@qcV1LbD5J!d!C*$Y6m$d2!3l"+X`ihq)AYKrK6YZ+5U25
+FV*`(-e2+Nl9+89[+%AA3D&bK+&idH2QMELXii%TrU)"a@#+j4Y1%*cM(S[B5-(`
+#)RAFFFeLJp`,CmS4+CR2$6CTLSM-Qr+1RlRY`8T&N!!mmI!6ipbChDFJ2C86Y,k
+V$&RDLbJ+b"dI3AHTV(lCFYIE)"M!LIh!U(,kFqf,rbUArEmDbQIIHk)bX[FAVJq
+bPRH9f1ki*rYXCQjQ#U`U05FM-h9r1M"(f9P1J8aAY2jCVNJ0[i,!D[bK(A$L!J!
+m61Dr3RFD)K63&DqXb)T6%EfDS96mRkT*CFA@+SbHq&06bd0NDVd3HAi&TD%"$id
+8T)")P2im"'41@T!!!%9&38%GR(Mi[LaU"Z$b`+U$9#SVAPFXkYIPL#S[51P&SB[
+bJaBGq2+1Tf9RCHBkdmpR'dU6X+M5&f(&",`-d%-iLRY,9E`$6LK-6Bmhj3ijH$`
+!$jK0XTSD@!`!kF%Peh9"C1L#T+p6@3be06Kf21["ilmrNjfEJkl#pkm51qP31`k
+KhpbF$232YNTqBa$X!f!rQ([Qr!9lqLS`Zk""(%Ci0#)J6XP[`d$`CdpJiH&LGP!
+KNlY+#AaR%@i-6&DjSZk"U*b$k4XS5e41r($r94j)eHXEA"H%*9[D9%iJA5p6HG#
+JhTHlHpi'X))r"Z)L(KH)2bI#+rq`S5l,1r(I-Hr%(c#%H9b(B6aBVQ')p61-"cI
+--"lF%-0iX"c$U"`&QmpTSk$`Ea!&LS)B!!!`!d&%3e)$!&D`$e8,,#N!+Qec[jG
+h@9G%A&BL)U)9%G(8M((-'%IIppepbI2,b%c06%(1,4J"`S*QTXqlZ`)LRXh8'M1
+RF4c(DFbDaM'RS(%FTm`m[aV(2$HH1b8cN!-MT19qRJ9F2(I6I2r[ZVl[ZmlcAGF
+&'ab""%%3"%'3!%L+C%3VeYA9r@Ep8rTj4l$i&@M"-f#1`jb'k3V$B8*K,X0dJZP
+lX-ec+UE*63K"8H6*hDGbXi0(@j,U0%2kK5(Mmp@lkQ3M%$f1re)YTPmRYG-mdLb
+M0RSCIdmp3"mRcG'+T$ck)1P6EE6d@f0-Y*R29'FB*G'2m6qSMp"h5BZdE#QGPL3
+Yd"kAPKU24QIaa@ST68pk3hYDqV2a9(3CIdfGBRLM$r+TDJ&05jUYQD6"aZRS&qV
+i2HUrkHkNJ9UPG)D'*0f[h5NpB2`cqL`IT"kPQU5l003$id6d-@j93icbk$raSHT
+YG%G5X(CFDU#8T)He2G*$a[24qrK`GB4a+[SjIUpkNKj-'URYPqBD1G&lq6IUEKU
+@0%UVPh*TIY*#lC!!0-mi('hKN@SR)c`kUSirSbE6[j)kDcZNCZU6p(GYXr4()bJ
+kJGqZCP#rT,pUldKr-r+M-rP2DRpMBr6Vr(GU%rdPUDr@+1fLRNNrehk8AMAHMVl
+!HkZI'cHMEr![e@rT0dRGYB[5*iBl1TEr9pe#rdKkAdZ6)UK(dSGDM25$X5QkPIG
+58qPbdUelY-qN!FCAd5[j1E@EX5*k&Ap#rCkH61UL,CGH0VC&Im6rSqkNCj-kD0Z
+PVG3qk4AY6DQMm9EdDYj9$6@14'rJep@eG#8T6&XMVD1V5CHd,k4VaYI4khQEkL*
+RdRP0Pa+0qk,MH,aU0j4S"lGC9-QQ*A(0)YR3p$#8rJE*0)i1d10dJQj3R9%Reif
+V1e$hH0f*1M*lDJ[c!NA'Q1*PmZKa"e4lmBc4ZVEDV'X56,3jML2Z'UGVc`GdVE4
+BefTKXQ!HJ4N0T!NG#cV(`93#-f1-bcjk4Uh,E[!mPch!4l[XXV!(1*!!ii6eF#`
+KF)AX9$!I%(DFX'2BhKQeZZD"C+03Ya6UfMKCef52VTQ,*52k$Vl-mXI%P8%a34&
+T33Q@2dVfVpbaPZEi$@j,3r+H&bbhfHmmLH!mEP%cSL`*jjSb,9rp'1-1HLGQ[f9
+$C[+TrCC'LeYV,EFmGhL,l958B'TVbScj-HB8XVcRQ,#`$HlRPZ9Pdl,l-S)XQI%
+@06E'hC5Tr+p!RGV*qBdE0bd'pqMF8#f'a@-a*,Z(d&0%G'JHXKM-@MbUc51ZqJS
+Hc@2Sh+0D22%'#Da(e3`2j!Y1b-%3M+Laj-%!aXQiG#"aRGM$$8I&FJVhX"eL-B8
+E,VB8dd#a3CUKBKAZFGJp6#"R#U*RKl5UC6MMUMlQH$'Y9NXrchSH&k3QHMKbF8j
+Fi9aeSNmQeh8,0j&!@VJU"P`BX0KK9@jb*6)'-R%e[S,4`EQV3J!h+6D"9VR&TCQ
+iNPLahH63J!TP,'+hHTkYB&,Y1&GXJN89+cK#fC)3Ee'iKH&F6LB%DkYFU%69kL@
+b!CKGGVq'Z,BIaV6hbe"iSF9X+A6CcB9N-8YFZ"V@86@"8I&[0e-KmP*,S3dp)(Q
+K3qc5a8EX9bf&NQBZ9*d3B5Dfh9iSHLS1a4kc)PJj*)&$%C)Nj-aLT0S+Ui4,BTQ
+iUR8Va)!&qhLeHPAm6!UL*YCK&L*9SCTr498Sb!X9aQ8afrbDJ95Lm#fD-%SE)a!
+q8@N`!JmS!MNe4P)`F-d9,mijJc!8&NJVk'H`8RCJJhVH,d#FqrZL609i*KFLVQK
+8)B('5cf#&C6VIRDffbQ1aq[Pp'rQ@X@UGU(GGBY4TDh39,9C+JUc3KZrI*5fJG3
+,SpS983P!CS-N44-Bb5``kV9#k)-"JB-8Xf)c#aB3#cQG+R+l@a)lmCY#0X"Z-Pa
+F8Ca-[-)9KqBA*pC4l!cTAkG0UC!!cpC401b1&lZ!mc-+P"fb9E'bSTaRbl"m9SA
+Fke9EQIS-(FVf#`HLf[(+i)!b&SXNqUJpV%Z5DVI!9Ja!MH[Si)d"&P9--VRLr82
+8$X%QfF4!#B8-BXCPNCJXa5kKCNJ5Yc#V#,'1mibR#Lq@J!iQS3d@FrSAB4JQ3f1
+Xm*!!5S93PdhX9e!cE@!9H-ldU0,*8E'D)l3#Ji3QHLa8k#&cS6l!6+)$i#rd@$#
+`L)(`S+,%#Mf+6E#+UJFfp3SlCP[K@1hBSYUa4@L*J30e)C6*%I)Ff1k`#CN!CE-
+JfL@a%M1-(f9ehLp11(6')U3*'4AU++L9(K5[Kid9b,R2b8BZ*d-jl%)2Qa#+#U[
+'3jL*6"*c8Kji3Sp*BTl3"$J")H$U*C0($4-(j!(H!hIRB4X%a6dUSb%1&#IM8+q
+c(F+B&$3,lR1bNCm*'BIJ8[`4KH84CH"`XKe#e(Qa2-(PBJX6lprZJ'T-*dHSAa'
+UBNJ%QYK4I)@+b+$Bb[$aINj&V)2-46jmUN#l(qmNprG9IM)1IimQQViV1DM9M@m
+)KqQ`cd$IjBjVbJMDN!$C'Z[qbKd4&2@1HX9R4!ADV+X1Qq"4dHrXZ$3"Zq"SVr"
+5a,i1BeB[G+*pF-DXk8"I3(ma6,#ZIIp*J9E6!)1AU*VMUVBU"CdM-+Q#`FY(UYU
+10KJh$$+V&IeMh!Q@mY#J+T@KaRY((GGD*!P+[,IHBEbh(*dG-*PBjk`kB19m*5V
+jpFd4qE'C#HZEd2$-$)T3%kZli'c[Z+3Q0lTM-cGASB@Xfb'V(cVGaF"iEbE'mHM
+2KTQVDmXAUApjDl8VbKd&8VL$)Rb*-5P+d-*Kc2%@D(0ba-#BFaVbDM$'Lq5FpC!
+!Ge(9hJT@%prUN4U4[cNLb"*cDq*Lf0BjMGKQKqQ'VHQUYM9DI@,VNI(DI"(VpLR
+)&N2XqX"aDb*m1*N"dC(S$")$if2#Z%H"pV%C*N[A[ST@Y6HKjjYR#ja$)eQ"a'I
+NEfj+hKPNLG$b'5P"riq2JRmGc&CGfpC(G@l2C,b*'8'CQpf0JYQHc`Lmh[Ki+rJ
+M`1Z%k3Vq#&AERURD$V-YcKe4#6ZM,"Rfr16$qN53!+Tp8U$iH*(MZLp!I$`F5`a
+%"l5H$6HqSk[U6%kEU2+#GlDP`$QlNTfhjFHkGqBhlib)bY`Fa%3CXiq"*3k59X0
+Nk&VbBM9aHfC9J3h3di)bh8GM-f1D0QIL25JM2h2c-3LHl64QGcC#,)k*TH'U'K%
+6P0Q8A29eca)6#ZSi+JDhmL1B9&G66'Z81lQ4!HEX5'0f#$5C9D"0+i3T-N+J8-J
+ZQ(#B4L1NG@*,D3VHSei*LJK+m!@TPZ!eECYMSQ!hVG&K6'Y&abi'aV5V'+1b6ZX
+'dpm)`EH2N!$,"HG$ZSjYh8YLhCF%bQNMaJ+8dfSFaK42J6DP4!b-+6PB'ppITZb
+(NBb3!,jBZbG-G-%c)EdHl'Qc61LA@UCNLV[DL8d*0DC`jTkQ)$e6%Y""HUBJ260
+mA41%qlLQ+IfCDpS)30fi&DDji&C)T*!!q&+Tie0G9DY1,61Q&V&9TfCKe4(S`"p
+-2@k%",GFY8BUd)D@q&HGHYbrkNbBAM$GB@l(1HVP8&2"Xd-RiQpD*RYUHf0U(iF
+a&38ep5HBhXC3V$2dH-'!SG+,F"K6KaY6Jl(rY3*Y1X40Vc@'3UfKJ,UKi3AAKND
+fA'hkIQ2kF@0SSc'dpHU',mCAaNNVkr6`PT9eHU[$Q!iiRQiA!f-kbQ8kI2PdP-[
+drXE3d1UUQpL8(l0c4e4-%'TaFe464Qb%)#lErbikLf"'kGVV(94RIJREF6iM2cN
++A`l+RFe4b8&Z`@deh[$Uer+[6T!!f$IUM6I1'N0R'd-""N-M&6j#i5X8(Uc`AbM
+m2`Tr9Z%r+Abr`[qUm2F8RX1`II$kTr!5KIpFiFmSh+l`@)8rc,Lr9hLc`MFU2&l
+KQa5q@1&1*V%E#mq`m5k&rd2KPBa29[K#d3EQ"8`SfLXZKGY8mEVTB'GC#Kr-a)(
+lGB8IB(Y1-Y46#RmEE3Z&$m(l)C0lJDda6q(h+Vb0(53UI+h#rkl`q3VIS[!3KIG
+N,I`4E"c0dV0(%DpcZjR'AS9(XT@Q+IbL`[-8IPhKhc*"lCL+53Tr3H&r8rKaTNU
+M`Kp4H*V#Ie6i#B9rTr"I-Y3CTKa@6DjDVjB0VM"&XIN*KEqLm$mVr*,#PbTmS-,
+raA4UBk5rMHRd)91S31&&,,8+5bF+Sjh#cbRm,BA2C%Y+6)-%KAr##L"Ei4d8EPA
+i6S8(&(j8i5UMb(5&peGi9jCJP1AMM1jp@GUQ+,b6`JH`ihZCVU$qJi`klbVm)CD
+'KpNDKeLDda@q9q'V&,j%i@MbI+c`'`Vr4Z'pf@,$fImCTNS$)`d5Xje"c$T'eUX
++Ame+#i[GBRTJl9HV3'3$Sq#2,*&h-pB[&,j5i5mceLf-q[XBiF!k@q%G&Iie9'I
+&%`jC$(TL@6R0B8`@*RS9+im(&&k[m1F9(UE`,eN#)-+Qm,-+(k68289FLVCd#Sm
+dA8kGIETAkf"ck*'C$AdE8dUkVTja[1HZB)r6e5lRpS5jT9f@6crlLAY3EG[k@I[
+lCBc-HRREiU2G,pB8fT9hFc[[Q1mpYh*+CBq)JAPKDclBehrMm1cf@aH9pli3%SL
+2QecIThP8@EF9Vjej2fe)dG9eFdlpP$NL[F2f*FFq[ePR063ekI!c8I-+ERdflB8
+I0Ydcj[U'hqlj5p2$Mh9mk`qhrIc(1iV2klrHqmHJEjjqm[Xhr[RIf!H@AI[k[C0
+rIHI"4rrcdG,IrqEEZf5EiaH(rT@mm1#!VkEqqm1BZdGI@I[TmlplrD&(ARRcZcq
+pq[E3FBRhrA,hhcF2HqU*9AqqmapElMp`kBZ2RrYErVf22lYc`BN[EjLZ+8hZPfJ
+8,dUBH)kj#-jS%AcCSM!a-"Ce`aLqE&%(Q"l'd-'UYRN(A,IN@1RiGk@[$k)*(0+
+Lb,&NM)Y'31D3!),%lr+B%#ckAEUaD!4H"C!!,haA9Y&"GVPS$MV),VmlBRb(E'a
+SX+T&e--8`@3,*iGF"YYVc!ARDd`9qG4h&ih[l%D0CG*-#6RKjCV859SYAI-M3+Q
+[ma1#-QKV8%6q&a%*34&X,-4pi*LdR41I2jjKNF2iEMik0@*J,$CMM(aUX3NQakM
+"eC8D0,TV4,iFU@V00pA,cFI',[$D*!SXEMB@TcQ-aH[4[`N6CY4FRN6SqHCM%fQ
+q6%4D1f2aG+0QCV@%Dj!!i(pjB'de`62)@&TSe!aqBX+A#TphMUAeaP)dj*H@S3r
+D,R8CGp&DhjH5T3R'dNcMVY5*YHA1953r,LV'r5Zd(*IfQdK"q"[M5bG$'8$+d[P
+LB#`&G#hYJ[k3!!*Y5Cja9d8$mbl@`%5R%DfpeTI3l+Z-r#frJQC,YSe9Xb8SZ58
+SY5ARa-"BdJ&M&rTpB(SEGqfUd)aAD"CDF#QNpHZSC*q@am4H%jB-E0Rd@&$S-"E
+N&9aE81VEC"%(aJ),cP!,&TbY'"X,MN!*%'S"@N%,-SblaVp5K&Be6-4HTl(JR((
+A6)Grr@l!ifd$"5`Um0(NaUL)r4CfG%N-GVSMSTVF-Hc!FUa+CepjLbXNRDZ3!*3
+Iml1NB"GHD4EJl5I5)JE)b0"(IPPV,1L2,P)8H86A,Qi6(5mZ9QMfFi*$GhjEkkY
+drSY6fVq'fEq'fBKdSiYLLZbYDfrh%Kd[$eDGpSY-3XH@p0ML&eJKrTb[q)UcDUS
+m1Ci!,fUER`ccm1Bp,kkD$20@#M*%SU8iEbX-2K5m6D,M*d1#i!!C@ZLDrk[S@Nd
+-XC,CQ0FHh5N`D*CH@#ikIQ+XBd+kqPI`,l!MY[PR8hTq`*KIVQ[IMLc3V2$T9N#
+L&5l0'UTUq5K1+qUV&9A#L[TU4E@`iYA0ZJX[lEembl8C[[l&,9IZ-1DM$Xj(-Fl
+[VQXriMh#'Pfa,TbJ&Fl35MlV$SE"5j-edVqZG3D6rXU%kAaaT13,*@-K8RX6E`9
+@N!$8LQc"#P@XH2@ciJh*#Z#fiJZA&CA8LTc+#RGUlBTP*GrLUdVYLbbqK8Mc3U4
+jiIX`lq*b+li"@B2&kPjZpL)I['Y`eG*HhZ$P&LmAZR6eGM"9[jY8[*PBF,8c15-
+S+S)16q#),)IYBhZGX4a@*ZEiR`AeQM)h@j,cm8dP)MECR4p4EXQd(,1m%l9VCdc
+6KD#U6bH6VY,LDdIedZ1rb6"d44fEp(9TEXm+ph-VfIeMDe!9XBljhqV#',E+9Fe
+0-HB'-qLI1mYKc*eHS(d$p$HPZUCC98hVjZ9iRj@mr!K'kldm&E(3beHVfSd5,`r
+(9BpCAYjiRfdI1@LhFDM`0#k(R63hR0jVcZP8bA2-1H'98UkC'cGZf#HbqUJ%apJ
+5-HUL`hF,!h"4f+2F60Y4Pah'+!$1+2qAaNilla-j-@L@M*`r1FeG89(mS5R6AH@
+3!0SU'+T9''%-Sr%L*aGS`c!BKZpRYYShrAZkMNdQ&I"K$[pHBaJq%!a$NfAB4TK
+iAB[(Uhpm!NbfUTfI#r-qM"fQ4(8k8jMJfbG4ZKVH*lS)9J#!$d-p(6C)eqcp+r4
+Vra,E99m9"cQ-&(bq5)&M6GQKDk'9AYl9bcZT@Q)0c"bBpM!+$0c[U-q01UjUcJj
+H$MrPA1lPPe8YmkUUfBE!c&(2fc,rCm"l2Le)e!K,HCIUqL'%q2NXIVlla,YF+AY
+[GcQd22kCdAZrZ!4ES2AHri94Pq,PJq'DMBF[1M3[6PqY1(feaHNX"bk9IQCdVcM
+YlRXk21Y'DTe4+(Z+!q2-Br*'ebiV1Q!Um"iXIEVXUC,(XKr*HM6pFF[Kh%-jHqY
+h0qcCprcqNkHH1re#jEr2r[2-RFG[+rr6dGmI1b&&l8K1#'VHh0LdmI@-Gc,c@cG
+&a,KMdlEXq[(#QpXqfVicI1`-EermpZD0X&PYekjfDrpXBZMeX#[SAlTmkpb!,Np
+fHk*VarD[[2bI$XpfHUEc[flrBjqrpre,rpreqq[RArEkSFH(RrchrArdr(R[9l[
+rj[-[Sj2Hr8@lAdrqjFcIIK"kj4A,aiQcTdfC1[f0erjXQ9'hk,[&5jFXL*`hIq(
+FkjF6EedkeqA*!8pd(0cej3lrH@$)rF&hK!bYZFYD4rp6'UL+`kA(hAGN`jUeklp
+HpdAUCbZr@[lpLP@VhlTlUjm)BqABbSM!0E[0H6jqf+IIm&RS2c`UCIL$$iedMVM
+Rh[2[$4adGha,'[cdYjBdq1P[2M6iG0ClPMRMDI!(AaTm-fTBbX2$(aVji)Kl"pm
+cm1j",@J`bDq`qQHmL*qiGME4Re6RljfHb+mPEbHI(hq42em"i6irbHGA*p(BIe@
+lM3NN5lrbVf9UI"%J`B6+QLIKPmCb0&kM56IaX3LBN!"-RDZS06'k9IaFGD,-CC4
+N-38`hFY-BbL24P-Y,D-L62ib83(ZpML)ZmQHTM*kLNVS-FUQ4bL,(U9d6!fcd'(
++T8183hZTRRC6!qfKII3mlDH6Z,[L146h#jLAqfrF4r42h*Yf*afRfkLFrS5ja,q
+RBjKBKS++SKf86!N84-fdQ4UTL6E5kj4"le!QjH0'Zdd836(NTPK+SbfdLhkN#r3
+QED12D$[Y4+Rr[`KiQbl5Yh36mpV#U+k0VY&9kNEYk9P+T&#k$Z`9mU-[d@@k4HG
+S!(@K*m(d"(@PMQ"pK9kQre!(E1P%ce"RqKIG6RqN2[4hkNYrSIld1qT(IkA2k8[
+U46p3$rU3!$kKrp,lp!rU56qRh[3UGDII-)CSc,kLGqNAe)jq6C2TPc56INXI3)m
+V@19Mr'E60*T#8fNk[8'[dCpT"Rk,k$YD6%YT#5fJ5*T(mfNKcBAQPj'#@p$k(00
+h!26Y5)1Kmm[3p6rd!!fKqbQBlU!3'NSeG"GCU8lj[`m#+QCA1-K&1XA4IA5%0Y!
+D@N[Vk@YD4ep3+Re'+qNV@NlId`TD4D[T,GVD!J6qA`5-"`(FG+@4R@cNT2-86m2
+S8rS'f&RN4cp-SbL&KY1$p"#0"0-)ZSIZ"HYl0*!!"Y(Gf2*5)2!6rHdP38!`4&2
+Ga%$J8qM`(Xh"Ed)3q!0q%`H"Ek$Y-1Ml-$3@qMi)IHm&#0`$EHq'[K-&!6,@m6Y
+8flMJG3MQ'K(bPV2!44LG`m)()Y4QX0"1"&-F#aG%1*JY`Q1$4FKfLT!!EN+`T'Y
+X8-N#fj!!(Xr#C"BL@CJV`Z0(@'$(MrGRB4B,)d5`P,+JX,#D"DX)KpH`d)@&%"&
+b%eL)CQ'*#(Xc4DM[)m,Z2"E1L0"J&Z&%*a'NXb+NcKEK+lEjUd%L,%pRB58,&eR
+SaF)L%Ei[BS&YrVk4K9!@2Q'"L9Le@)3hfl2!%[EQjb*XBkTX+fGK1`X4)Rc%52N
+4)mTf4[VYM(cE@H+hGfDKK`MKM#MKp5b`!JYRL3r[c3)MF6K60-V&`Q84GR4PJDQ
+9c!k5`ePiQB@I@'!N5'C-#5B@@#)6f)BJPZ`J4TUJ15``GB-Bk$6[&k&a[JK0TeP
+JfjTB!63aj6BbdQr-BS%aE@4-'fqb`)Tcih34-SkcN!$+!P-dJi&A"Q2+B)4qTeQ
+%r+-X-#$,pk-BD1EhC'%+#`aS@XYBB)4VCD$3bTC[hFS#+kV@[Lb`cDf-P+d-@$F
+a%QpbXm"8fF3)YiQ"a5C@Y*Z'La$"LLf#JA8%+lB)"XSa,0Na$&aL'$PL'2RF!4B
+B@Gd-V0fXXVPC*A5c",[lXF")idjKJ9AD@%E3@!X,$&"L@@*L'8M&XNS9biSfPUN
+BqaS,E(-D+q#d"KBBZG0fX,#,KA-XX%U5aXL4aUTPfK!4YM#PYl#NEQ&*hF)+D8X
+h&KMKYV"Nla,,m&d@i@NXZjKAf#@NDVYkb94E+&0rQ(D&XP&D+"FZKh%Ab[*0Q!r
+351pE+"F(B#S,j6&(#q8m$*DY+C5,qK6+*4d+j82E#ZAG10MG!fC%SGa`$!B#'VS
+8bR[+BF#`"m+I6i!"m[REBAV#c)5C!C05+1mR,"U3!1A#5&N1R*,PNM4ChKdYbmr
+hPqApdfAj4*JXUd@bV'6)XYjCPZq,Jh(,mK'6,'m!``CXA1Z&k5(,kl0J9X)XPZ@
+[JIbkQbar!8'THE,mfAiB#([VXLb(Mj!!jDKd'!L+kLl,1bl+FR+U,!H9`4b"!5+
+S6CDE&9RH$%&01'K&Cj09PL1JC%3cc%qb(0-H"XTZk3S$j5jdJ*NXbeRR22,TH)r
+m*jG(rRfj4ck"cSPq(YQeh52VPchb+S,"!G8@bj4G,-YZQ(E&XUFrc)KL19!+d`r
+QY@,C["AQ!Nb2BRR-l'+jGP5aA03"CNLaA&"B,"qF85`rA9mXPi3AbpPGLZ9(MX0
+!B&CHXCbZ`-b%'9iX2ei#FlPB2R`'jL)-0ZB@`C6$""I,Kl$3S4d`@1a3CjMHaA*
+1*FaUQ$DB2M!3PJ-&pqE#5$$BX"H(HaFAbrA,BAE"32(k16$cLqAG8'Jh&QT)+CE
+h4"6,*j'`NpK`mRdB,(U+B"B9bmp"NHFJr(3C$!5IKS)[R),T@5aAGLq@cd,aIiB
+@bfI#LZ8lSH$a"TK2LZAEc$")f'hlBD"%Z3N''mS(&mY(Qi[P%p(&XZ5#Z3N68L`
+V5+4b&3E%GZb$@3H$MDi!$)MSJR"A2-bjBMQZY9Lq,keB2J,PMX`YPMId,CEAG#Z
+@eqE!J-"VSF"k&0JA8$B9KCJ+iCqP&X[,)Ial,2jpHaJ3B3819m&3@8#Q5N!k`I3
+-b)'iJ$`Z,5#E!IhQ9TLDJ$aQ)mcmJ*bh$bB$TJG-5%!H$FE4R`INfJ$-6CM*!AP
+C,Fa+Q0N"Z3M#$`"a!%*-%'BD%C!!#qB'C1pV!IRJQS$m9'T!cZSIN!!IE3[)k9-
+#XJ9#$Zf!53R)$GN"qIP5Q#%"qH64J(`+R4F'"q4+-0eT#XJU&(8FJjNCN!"Gkf%
+J3#q(k3`c-L$(V3kJ-X*J`j()J,`"'cEd#mKVHJINp8K3+K#Ir33c25"[KH*EV3(
+jc48"1H&-3'l1JpN1dbH!*`#J!5ZX&,U`G"d9eG1ir5iq$R0EF2%'Xd"j,6kLU0V
++VCLd@AK86-IRim4X6DdedK8DQA@@mR*SA"NB#lcf&'k+ifZmL5Pdf*a$biT8@bQ
+C6bND0r!9"Pqkqr)m6)$1+iLr2j6#McH3!-8VAFmV!bGC625S)Q4%-QE9PYQH$VV
+iD9q-1*r*J8l`*Xj%)fiE&CGMGV0ICLKN6S#c#Cb&akqRTqV*9+R'Vk1F0A5i6)h
+I5Xql+Eh--E&dqT25AGMT(&qejkl("k9+Re'KepZK1d8YGp&6Q1fC6DZD+6H2(Ld
+6-h22P0!H%q%k2b6MXZR3[K$(0,Eh)d0FaK$TU'AdZfPhmB-1cFMefY[ji,$ZBPm
+@&`pTL5V`hF#dEHY(GEbr9NBPARSk@h9UjC4HJPBTT4p4E9Q8hU`kbbLGprBRE69
+E0Phd$+&Pfah"H(S4Ek-b[21i9#IrJ)T1UFiX+X,N&Fh2C,XM@1cY*26TiJhV4(8
+P1C4RSR((UJSH*rZmB5PdEdNF1dRh19R[E8XK5dNfQB[`aP@06aFESP+cUDb)$TV
+8@hP8j+8X%ceI5RY0H-&U8I#pr&[mRDd#,+UJiDES&(Jl42l2bq6ENC18LF$jP!P
+MD9%Q&4cM0rL8#3qT,T-59LBPV%bb@CQ8SN`kq*C*BA@CA"&PX[eQGC&-CN@5,BV
+%dE*)1JYeiVeKRImh,*)f&)QjN@UcD9`ZlPiG[p[-*P$9JPSAP6Cm0H+G9p$[q5J
+U,e)((+Ikj94C4)Ij9FTZS)-jG$L9ZD2"STkk4$@YUDLQ%$K%YGh!T(MFrYE9Djm
+p(PAJ1a5+p45Hk30[@mqIU91Yd#R+R2Dc&+rpQ9be)Pi[+CZ!bYPHRM*4I*JS%pa
+lA%6M[$k&9IQ5*q%P#C1F0)lpj$*1cKkKV'`U-"(ZfcY8kUUZ'!bdl9lE,",qFl6
+`Ri*XhEcfZD$ST2L`Z65XC$APPG#i)Tp9QVhA8kM1QB9,4B&M`S0!q-L#@c@$DAH
+p3Yib1T!!+cBG3'RkJ[*Fi9qAB,CGUMGd,X$ChJe2V2-Amq!AZAfTA@b(AT%0fbP
+[6AAL)iA#REfKN@6*UUF!GeE)9Dp(i$'Y@EQq1#eLK')[mFRQ)NDiVPVU+mPVHUQ
+e&rG3H,R3h&+NAD"!598plBLUE-((RcZckA3flFQQA(a)bUC5h$'TX"8`9q@bBZp
+,i`GY2S0@Rm&bRm&aRd&@Y5$G@544F8Q9e`l&iSG,0e*aGP81l%GGR""PDUa'e45
+F&bJYem)PV5KEYEPS6,Dr&('K954CG'X+VM-fEbB&XKeD"9+l)eJj[ipUc95X9LN
+9MPY!+JBiaJedZ'&'%0I[,6F0ekqAi*0XV@p0U"AYKbKmXbV1Uml+Eb%V2jbH5mY
++bCY&HFGT@4CcZr1&dL(LYCK3aNHU-9V'*kKMTJP%PrUV([!QAh`*1VKKU%5+0fI
+j(Zcheccie63DYm1RKG-'3BUphLFP+lI'fE1U%8LiC8+%Uk0apKL9jG+M*F+plLQ
+PJlP89%)(c95QqJX$j#8'V[j03e0p!'dm$Y!fE6)Q(EEJr0@PRjj8qQQrp$-YTCp
+fK9P+d)aV3CX'I`Bb+IlR+66-'Gj!P@Bk@8,IiS&XCQV)SLB[0AMTd%ANJR5)pk8
+lDqR3$NV&U)3DDZPN,9A@1TLVQ-98&Ge2a(F8eZdT[U+`lY`#@`daaYN&YU'$'6+
+k`"CLqC@fG(r4LcLaTGVYr8U-[XHAF&aRFSQfp4JqLiTU'I%(#FAprZdDr0[%b)Q
+DF+KSUdqG&[@Z6N[I4iHmkQAiNE0dS*C+&AUXK%Tj9dC#kbLrB(6RLkp5j+qG9A9
+h[ZTXR1r6CRj113+``@epd%"Y1dfjkI4d,TP+k'PcPCTq2lHi'T!!aN-1i'8fjY*
+D[EJPqe,p"ASXTpT*iR'+eBc%h+3IS1iUF9AYkqD,PJU2mS(5qG&m#CQVmba`ISc
+Cp8Bl848M5ij5hQUI()dGBiDeS01`%S@+Mi01&GJ)88I2)fXfMIG'm%#iSlkUaZ,
+PTF4&HGi**-+4Va(,c5Z4+'rjT+HK,(20UK5jTmpT()qVpLi6FcV`FRQqq$cQ3dj
+9Cc5LG4-hJ8paa8H9mT6Uh'5)hqZ@m9l9Z'#4+Y`rPqEMDd*Q5)ADe[h5afi6jCY
+SiaP+A8%rPP&U%IhG4+RVDDfAi[*)VD@M*VV65j8PG,)Hp8p8bU1eiL#ZPYE@8ZS
+qHZ-B"9A5aPV+Vb@h(fVE!EVkLREcB[(9@26k!a8XHQN!qA$4Z`"8U1LG%eq64Dq
+$q*4-)1'XlAKr1L8FVKKPBP614VT@'#pk!N6I&9q6@EGrPFK-mIQC`@qI!QG0,jq
+kp[pAD1hr4k%f##eiNFca0EdUjK0TqFQ+jYf1QlT1UpTAh960LeYD[-d`p[[X,@B
+HJ4@c)F)F%dkM91#[6dq3!-@G%BU%@l)NTfLYPIM"GUlr&F%jGfcc1hb@XKc',I$
++pC+L#9UYAMpiPdk!,r&H5a'lafZP(8c9YFr3[[SUS'S(-9rQ)'B@(6aANDLf&Ya
+UU1r'FcVU!ZV$I'aS2fPbRI0)0#QZF5r,UeXQI*mrRjU8(VIJ6mjQ8lD*LXj333Q
+0,N(,c5%iCM%fmHdKXfSNURHkejNb0N+e9"qdUTMY0H'"DV+9jV+UkX@XR#kU9SV
+j3Z0#GHh8,PA,bX!8Ida$R2keYVVXDfe9Ae9lp#KQLkISfQC-hFR0!4#ZIS[4m1"
+XPG(Ni#ISI1+(&@pl!5mk+LAZ%mD9("'@Tl1`NS@,,24LBC%)haHaF*D&4J6Yqe!
+GB-UkQ'jT@U&U+rUViZj9EG9L(6H#BV"2GEkeQZ1Z@GYE2AL8`rP@-)mU9*aEMh!
+$Gp*ZM4E4pZCCR0RI[)MR#EcCAYMqh)9,3*!!E(mc"2eYH@+4EH8kV[q)jEIeB@'
+i#"pPLm12MQ'a8PAl+%29$PK9qdF3SAhdVQlrD$B%IM3AcdRBVQJ(!"2EXhAlpNT
+)aAdEf,NGmje`Sk*fB,*Uhhi1c0XlBq[f(N#&UlDG1@"blNcPN@L)lZb1E6YRL@d
+l"q[fm(T`KLrARH%*20bMD1'pJCb-TbD%,q,K!38AP-3$'U)X3%9G&LJY+N5hlkL
+&P"d@)@@(5mH9*YCGM2A+9AYb'64)hSFYb5iZlQY2$YIYb@N#'bEXbm,q*'`da#3
+[&J4)-!N4#@Ge,F%&-EQU&P5NDd(T+ZiSdS,Qk2BJT0iH9!0YQl0dHr0qE'dqaTp
+cf*T[BJUBV6Q&Rh$B0ZrJKad-F*E03#2JUK$D1&RA'N'bCGe9He-@"$5GeV8QV&+
+l!ffDQi+RU3p3[B'+!mmJm'`dkrD0A86[G[5Q)bNEDlLP9V'phN&XH"hb4MHJY@h
+5R4RK()rFd$+FZMe$E-QiA8HcA,#p8kVEhcN+h$[`Bk04rc-hkPSQ!$C[Z'V2R)'
+66%"e(ZDPjD-KNSI#bMqUfr2MF*+r$EeQdEZJfr*C1[*l!MG&i%DKC`8e@N&RVE9
+HYlHka(#VX*N#C`HZVqMee(%Y5j!!Ga-$qNhP20aKhj5!XdeZhElTCG(VKGlRSJG
+&mZ,%*5faA%54MJYDBPG%QJ#HL-kL**d4Rl-#MCL2ia(L)#D,(F3FC`Fafh4R6#-
+QRbMf'!'!-3#Q')#Z-fDZU$afG`"BGlTZG`0dRHieIQ`'`0TY%8GGG+HlRm"UlZR
+J5K()B0dHD`ClV)@ailiKPce@*$Bf3U$Mr@J"6V'I#maVIN``0UHCG(YDJqJG4fm
+(H0*fLD&6GkE0%QTUD80dqaDKe4CSYH8)J'T,Z%MrPM!G9lCBYlIZh$+CijCqEFX
+)-I%@VJ[3q52Q$)l$%c8Z,!G0E@m6#le%Z,K0K'pV"I'q&Gi(RmC8,6"II,9%jed
+aVe3AAfF@1V3EZ0A$Jb-1Re-B,+DDkMDY'jFG0NaFaPEl1YeQlbp%fB4!Zdf8V`f
+e`6B%25GUlIN5(JlGcYYe@la`FTMDU0Y#+d8hY-[AcXI1m$U3!$2lFphfL"RH5FY
+DSpZb1[-kKrCS$ee,amh6T4Y9Cqi-2JpmKlE"Z8,ER"*GbeQ13Ar9ZGI$&cBSfZk
+MZQdhUbblHk!l3Y5c"RLVJf@U[F%0E4VJelei!@fBM-llURe21HLpCjZ`0iAY"+B
+plGCac"BeCDJff3db1H9f2!V2#I"dd'fHrX"S(Y`[G1"f95X'43i)HTAUYN!r!@Q
+"erK#m*T6GDIj!XI$9CcQ([a3VD+03Dj3"-p6LlRXbp"m+EUUfSTB05h#4-iLj#8
+&H($+-U6Vi!add,4i'RFEeGj8YC*`2)i+b0(`&GPG"*QcTr"$$YXMamAJ%6II$B,
+Pi9&@d'6d4NaH%+k@TeXiZ1cT-`%YkFah2ei#M2Bi2N2J`5V*+!j,AedlI!DlPQ1
+QJS!"jq%Ch#K8l,P&)%-Z*SrRSVD22SCC#m&#dd0EGIXK!Cq(,JJVUXkKhVSY4j5
+M,@He+2UF0KcPp-'L16-C@P3rqpjFS2G+31rG)G"lfrKQKlChX@kVAbi3pEZ%r2T
+qZV0q$UZKpB#f[$6-LZJLA-&ZiB4f)c21JbYXb16c(,D'&!#QE8m%#YLfCcK3fMj
+8kRe1ATHPD2X(klD6E8,bbIFj@Q%RJhAE+3DITd6@UMd(PreF215G9Qh2#6hYTq'
+ME+I4KR*STbrUfZP"UL92YEe`5QakJ@Rh3Np9'i0XYa)eD`amd&R-`Kd$Ara2e,!
+aI96Y6"Jkje6YcJ[SS0510qLfimbr(TqKfiq24"*Z-qZffjJHYiQm4#XhkEEb8)%
+Slmi3JhAY6ihBM`TlY&QJMZ*6URQNDMXfA!$bL@cGGZ+8+-36AA@E*$)m6@T%9`#
+m6HSXMU5"ZUDL5@VZVGU8VB*&ZDVE(#c[FJ9BU"GS&pSRCN#`#ilEG8k8[@X+FiJ
+ZNAATH!5''91-pFr4fD8kieTjH+RL[#q0Kq24(8H+4051S%6-+e6RKVim('@fBC!
+!EPXM()bf"ZfFY5)VYkeGai*E,,N@V5%c@NRVd@Baiakk,blUYLpB1bL9Y5P5SG)
+i9*!!cc#aI4aUjr*fD1dFCDfICKED#iIerAbKl)TXIJJUV-THab["hNF4hjc(+DV
+051'4$Ll(fH5HF#1f3*cB1NjN$6CcS3!@FbXEe!L#MYQ)QSZb'c0IGqD&L)D50MS
+06i9$&KJ)%h92GbjEbD2JFCE0aUHl-Mi-EDJ$YA`K8!GUG+GT"%-9c'8SlfZkGK!
+[``&-a5q&K`QJCT9KUR-!RjUI3U++RDU@MH@+YkV14clJ#e%"Xd!,$qEf2iVRGAM
+JFG1RS0-C6`F#!(QJh5'dPJkK@HI*!GaR#lrBJ'DRh+SkpjeP%Tj('db'H4iZT"!
+ZiL6F5#%JpC4!B0,i#`#TbT[Ll8Leh@N5%ZlXJ0IeH09jfck@)GlQpXI*V0U9)hm
+hFJ&plk*qfRkI)Ic[-EJ!!q9eSNB4hqh81!!BEJRq#FmR`-h"BDV0F8a84FG-%9c
+V4AEKQU,Ep*'L'lGDYaeKl[K)*)##Y@[Aj`V%HV3a[XB0Y)fUE9ffJ*TeZ)9k*F$
+L&'le9EA81!HZH"BfZr[@p-2[mS`CdXS+Xhc'M"XGDfTU"PP$V0D"6ZG8Uh@)X1L
+r)IV"mf$[(ALM&8`e9QX`3`krF6l8DMd(4(b`04M)N!$je[&r)6@I6R$mMIqNKTe
+'KJJKLd*B$,''Y'1pTG@)EaEAe$a3`e3B!K3dZhqZdaRLG!kXi"JiTH8B'qkZ%D,
+[UDQjafkh$kPC+)*!,I$h'11pLqhXEh$0r8jVc4$r%S1'3X*`Ch!&dphIER4#`0d
+e)l"pF%d&q[k4cZ#DJ8kVN`Ppf#PS&9)c,HbFe6NA%Thf%B`XGl`@HRQi'&FK8[a
+lr'SZB2[mbh`RYJd88U$m``*p$a3%i[l[a1JKG"qShVP3p,kT'-kYk!ak@$"&9Le
+A3Dc"GbbaAPKqde&9&#Mep"lRHi8pfI'16P,M!1Q#X1HNeekqjiG,mCFZa8Ykr+A
+ZGl#rpm2#`JB-[4b@q%ITR5Zhhp2aqX""Rl-JZ6[1NAD1l(M2b'($T+dX**r[fL8
+XV223i-X$VPdIf1&@fp9ZYhTh[A,pNl!`UAR+$e1Q5-N`S3p23IJGJR3Kc1Um+Ze
+%H$)86iVGpRE%AIp(rlfp9i"c66!$pprqZB,FRpl`eJMXM98hZLIpGXKVm4m-LVr
+4+IipK+XhRl"qE,eae@QpmF1hTdCDjpjB"H#imD(6H[-pqbclC2Xm+iSib@TGB,A
+1XIlDrZRPP(01P&pHHHa$9b6P!FR9mm-KG`qj@rV`0a@G[bFqmdV`S2k*9r&629H
+Z5j0l$T*5T4U8ceT45(mG)MdV"8PEZjbAVSNbq&CBQehDBRr@6[krfb5Z&UNjK0Q
+mmD'KciD'GR[Lh-[SGPhje`'*eb@(X1Y#TG43IrJ`Y&GScm6VV`,p9ZJRLCmN5Np
+m+Dhi33e)dk3Nb"XRCGV#L066E9IDK(`!!"`4384$8J-!,[%293eP44%!-@AZ3lp
+YEjBjAm,,$2Q'N!#6[)3jadbbiC%d4b8Z@4,R-T+a4!RFI-R8C"2*NMA'019kF$%
+aK'JKKKBXPd-$TDIaq3`X8+XHJ3'@`a8[0r*mV29i15)8T)MPYPb[f04prRl[Zf3
+*PR,[kAhq!4ZQ*q9"%!4!%!#L!4IRm4'G$LmqA-KF8)PNK!'qrQI6#bh1aZi@2YR
+Y$6j1PIakU[aLI1'41jh[rIf,p4#*3eUE'RPf1QaCD(,k902TFL3G1!DH1-f%9(b
+Z(jeRSipam@1B@&8)ca,l@K4#KqjM"FhS[%2lm&%YIL6%$lq[$HiadFdM1B##IR)
+i1IK19aFh(#8A*#XScD"+5+5F10cV-!jCIK@ZH*QhAMX5qZq#8!%jU8C[qH#CpDP
+@ERNR%&Ul0d5Z3pehHhXG'GH2l`fdq9BkPBelDLhcZErlar5hm8,hMmr[jp[lR(p
+fD)06rH5H+b($6`24R%"6fC39Ie99C-IPPpbp(M6hSfECJHp"9V$K`0h9cJVVU0'
+UF$Q,AT1KX&pTNN("C"PHVI&U['*&IV`q1a$+jEhEii)Tk$QM")IDp)RY9STGB@d
+6`m1-M$)#4rd11'bKN[8l`ME9AlpML+ZQihYmX8"-hG#NK0YpCP0qh0[iN4cK#8p
+#&[KR(U%T%Y@`LPKC1Im-4D(XhDC)lel2DR@$NUBQ'V++&4MAaR4SlZB4)5@9#Dh
+mXj'`48dJD@A9"T'mLkNQ`eBbP`3MNjTJ)"91(56-r0SESjcIEAS$)J@QmVT9'Cm
+hqXcK(RMVJmN+DMJ'TlaFUj[PJ$)R)'keH$9aHIQAIE&*DIMrH1'8RRA&NediCr@
+9qklNPUdZJ*YFU!r[k"qE&9,(fq,YKZ31ZYGbYI0C(cV#mRJU+I3jrk6e@U4P2If
+HD8cI#ZIh!Qce1E80DD`H*,%kker`QG80kK@6hC2`pSE0fX6Tc9a!d8X*51Y@(K[
+4A(C-bfSl%RdDDphP[G9+P)TIpXP)h,@VHe-4II$"CF5F-`5+2$4*2)+[)ZT&XLm
+XAKUZ"$krq0*)F9TpU6ijP0m'*kJ+CX,%@c*6`Dbfqkc)DPU2PCqa8USbUD61PU%
+a3("NT%HG2I*0$KaA5)dKYGVVL)p&2DD#!dX$S68&[AYArAUi3Ndp,iFF40!jKdG
+3+k)@0A9e5G@N-&)4&F)9eZhI&K4GLJB`f&Fmq0b+ja8fU1cFLUZ98S[AD(AQreA
+@kPe[3[pkm6&X6mA'RhVEI&C[Tqr`I4G88rh$Xr+4SUP)4V54PT&N"4))'9a'-G3
+bJP6!&kQf&f%f'U%%p3'&0U,NiQJ#9Y$&FcQZVG#e!pq%+`!mB53e(&1$J6C[+I4
+P+3*6rA12I!Jb%S3N[VC#14"ji0G$&DVI6)PU$R%PdF!5+K$*%q5QNe*JDQAcAP*
+%eApICR1D!6P6ECjUVe8effp(hM[be,$2T#k)YiCl`hX[Yh1N8pAeeB)%9+[M-LP
+8CfP%QQD*!5RC3-J$SYlfYNRT#%2&80ZX,%q-Z6"ie%mI!JqJ)j35$SCd``5AZlL
+B8U"da)Up4Q%Fb35@3"#)88"Lr$X$BerEmR`bb%JQ&"V!4*d*J5Q2GpFKQHH%N4J
+`mClqH*1k[pImR"B*T[*RR51C*T[((`C`mS*YGYiN'[`F,T4QB[SDkIe'5NeD#L2
+hpY@C-'3Rfdah[a,4lbE%33N-5F5E6!"+h*!!4N'+"F2rfPIRlLmHSL[Id3pa"BN
+pRX"209e+06SEBI4Y-!T)*-EKISCaf8E9Ai%Fh[d5*Z"GfNRDA!chFL3lHE$la`$
+'9QaNkijq@N`(M'6MPMSFV3@VXZ)M9+e*YB(e9'T`bfp@',F@)UddZ+9ZKA(,aC8
+ZA+I(e[K"'Jlfi@$bZ21$0$TSF'kTD8#([G#fj49em)1ddkM3"SX44*Q3!""Nq"a
+5JcYp-pkEH5KX"VTVYLhK&L5N!V`['JYEB6L189US0UD2m#`0D1lI3+$D@"p'%UY
+qNK61CjeBb)A&[5F@F[qMB*NDE,PNFHdIE,R4mXR6MT4JF6hY-"qCliFkq,@*-ik
+a`CBpP[pB2pM5E(QRlSfa#XYre,da(&cl"2dGHq,1JP9[M'HPr-eGU[8VK'2JY3&
+-+jXl@)@IN6'lakaD!3E0a[V"'CEH,Umh8ES)U5hRRa3)2S0EHq0HVjA5ZYK816R
+SfY8fa"2RKpJf9e-#%B*KqGC1G5EUp@R%K4&DU0U4'8Z!IDQP'rp9RI&Cb'b89MZ
+6dGND9e1$cPCX@fDmXGZjXIN8+MGH2hV,a[IUrcpl9BZ!A%[*Za05S!0$YD4`[U,
+2HGYmNieeCl8PPF[rZ-6%QC'1B8%Qd,F(L+b*Qr1#Tq`EebcXfRMX9!FQ1DCEZp#
+bXCQQdFjj+JT9#LL$'mrN+Ui###e`fiVXDUZ`me[Yd@hkU6rGfj3NB%"m'ilSlYD
+f)pa8%5Hh'&ANeI+"IJaZU)U@91b'STJ'Ypb'3*Uj9U!aQ$4E#ZFS'1#3!)dmZ,A
+3hCpZ5H%S'F2K*pJNFK32kciTR&jX'a05P8LGF`dFE9mLiIN[A4KZI2mCBY2Rh1H
+Q)BB#,U&dRk8L6BcdH"G)k8EciNPf39QkB*3(pd[,)#kF-2'TIT!!&X"e&*0IZP,
+h@6J"0ddC,J-@`@CQQQTT!kRke(cHAAS6Sp0d5'S1J+`iC5Yph00[)&35%Lf&1Kd
+*LN)RPVmAYL36,5F4'&"!fi#Vc%+5AdC&rNIS+,EF&Xf"%GQ[dj'cJaLd4*(Z*%F
+m'Lmc$Xq0AL6@9F&LXlL`a5PUGT82Mh-b9"+`HBM5`ApmKS'K1Pj0V!N8Tqc1eQJ
+63dTlPH[!Y3q3!'J!%R*c[Xd-qI*GEdrekb9K,P+A5ilb4R5j"X2KR9(hHp)c*Q'
+q,iVQ'i&%VUpe&`hK(8dm-!66dS(1-pX%da*IfKC*,Q"N`X5!q)[kf`9d0*Q%q"K
+!J12NrXQLNcHcl6Z)ReeDh[)#$+T+,%$S,VKM$i,&Ye9B5'DVMTNY%D82CT(*krj
+D9cGkl'!@K,h&$q)UZUHlXh923A'bRUT%-ia)(N2S`DILp@*kCM%-XqMh0$8'G(q
+%-"b,qr'bH+3%UQ(+-rU'%NB@D+rI6"#qJ*UmA+T4!9"DY,)S0(2rbS3EG$@IHNf
+qMS%Vbhie'9Bd&NGMQ5Ar)GY%a059A8D#C`S!AS'3!)Y*2bdU1[2kKCpI1K#JT8f
+(,@Q,EH-35)fYTLk2NPSS,He&9cREPHfRT8Xh,IY`-ZBVmclZbimqq[0,(Q'J*YV
+Mdi44SAB1C)jd22kT1QH9BfdQr5h+E(lYESIDHIc55'a9`GVAk'r4DpGNhPh`T50
+$`EC3UQXXh$P3iqk29LFV,$HMkekZ'`SXJ,1ZirJPVI!,ee+Z5qN,@bN5,R(GATX
+aeVfiHh'[,D2%T*lI(q2*3HGk-0R8Yha1MKk)+"$J6UKRk"HhE$lSSFf(5N#i4TA
+9k83(VbMMA$*&I"F*,[13!(J9YpN2)3G#d`NHX[0+K%CpFRkr3K1G!00XFG*a&*C
+f'jhKEUFcB1TL+0DReE`cemG(Eh&HR8c&3&j`9"SfTe@UR"#S%N5FX-bhJF3j)6U
+B5%h)1)bG&b6'X89J0adG-(A%`m9-r-YTi!Kql2ID1)PM0[l8-"U9UYkLKdT2i-m
+L`V5*C[YjN@KrcP6r3S$6U3+P%RT'rAEUZ'NS0EkK![Zm+14a'18QCcM$PX*9Q@2
+f,8&+EUQl@K`!b8+E-q$'))Q"d48BG!DS#IfjcNX*I`%Tdh9bD-`[Eq"bGLfU+LE
+@b6c9VQ)KN!#RRKMm1aK%Ak@UA&QU%SaFGSCTqESF'@,pICPKSh2i1PGd#'B&dmC
+*-"%3+"0!eXeeAbD)'clY3Y-56&BjL%8[%@A9kH)h6QMNVL#I(&BMeR`Xp(f6&Z0
+b2YVi1U-Q'B(K(AM%k93(qSdmp&iH*h$!'I9R#@9#QlhCZReJ-$DC1#(i1h34+',
+pp`TBa0JcE3"C4-G!N!!S!8%#B"R')TY(PJJGk)rb8+YK`#&T`1FP!cjhK[dGI24
+l4Gi36C6&YT)#,33-'hqH6kINd)-EG!G,0Y3rNF+'EY$Id0r4KPkpdJheBb2(eqG
+L8qImjcB9SNKA[("-k0d!FXU2"0GAhTAp[ETkDS-hCVrPrDG5Ap9`LiZ)Zf)M-ZD
+9A#rPYi,K-&q4RkkSP3hj&KFPGh@kaBjS3MVd4KBl8K8@e`JlU(--"@F9C!MEXSa
+MUQ!PdG`h!S3FX4aH%H00"S485L(N-03bM4f%#RP[KqH6+#pr&8$cAIHZ$kprc%e
+eE-SXqbmFlF+469m%2384i[hkpB2[emZMP8,'G'T8M4&!ZlA9!Rj#Ajh6kDUjGC5
+1MD[dh868h08bBjbN$UNDkFeAMr"#RXGITJ#SDZR3Ci0K0jp*QpBSPE0G&16eT52
+HfPKTbCq)b&dkR8FS4,"CbUj9'c),JrGX0YR6@p'93b4*qQ'3!-)$r@![ih-@'Dk
+"'JTM3C2bJR&c+5H5(`imG)SjRmmY',hPI9FCiZYQ[ch[0HhRVJ)&KRHfDbKdlbY
+R(2T9!Iqp[ej6ULTFF@r0pD8AK6lq)LA99,*!$3AD$#ifh5k!+f8)G%+U5qC+GZ$
+P)!*`P,Z-HCbkQZB,ARir`NjNIXIAr"YcD&1(E&Hi%5jDIU1kJ*VARqYm(%liAGi
+&8*A0fYZEiDCmd-B#E5,bHYiQKq+e616EjE2GFBiUaV'T9Z2lpIIRRq24K(3i[Pk
+QMh)N--V4YAQJ8'PaAmSHL+%E'4llkK8K$S%kUU6%`B3+AcQZ&XCjG#KP(f,,([c
+*+b(G340H8%3)9&@ACiI'qDSVaG0i(Q8(Z0iia"ejRhkcX*!!!deVmaLU3"9X2K[
+%lc5SP`,eh#qUCrN29-pbK!ij5e36Jiec53dP`!ec,&pr!XB(A8cU51LUA3UKP%"
+"L'db[5U3!)LFPcS9m[Ip%hi1"0(b9X3h6I*kDaH"qiidQCVcer6U&qHb!T5&&EH
+*KNT14Daf5K$GN9E,$FY,QbNXchbjmK+@pqbPS`IBdBZ-V0i1E&+C2K1TdV1SC'V
+6bqGTF'jL63%0Am5'rlq21ea@+U`Faj%l(,@F%K90kmhFNQDeda)S'6qBPmGp*Um
+FMAhIcN-$&m5M0100bF4j8RdQL2lc'$9-5LNNQX0jl-VhCAEFmRlcGDlc%39'fq+
+!f+'4",6b"p`e9VYXjjG*YB[Ze(I#L!'Ce9k'(Q%cL#249ViIC*4pPq)`"(EQ@NS
+c,Q,*)J-TNb)T,,`b+A[6i9"0)LN&TjbDcZ84XkNJlYHXlLh`l&,0F-RYcTUC1C!
+!V[dYpMdTM'!jNM(AUL%@NZU)Tl3ferCiUrEmA!G3l9T[k*iVQH`c,0a6NqD)#SD
+MNG!pVfehK)-dLETGRHeYkp[p5%IKq%6Rc)DLR(k2jf44cXa-ZrZ!HdF'5db@'d`
+S"&QjZ`'*%VK,bGRHF4[RC6P3!p9RK312"mZ@I9L%4dc8cY2[,[Yd+3m+TUeF4YS
+bTTU2IqL0q3*FIZ##qPNcA-Fqfa%HL1cBUdCf1)V@qIbEpUkk-"a4+qr,R29GM"H
+eUYJ1-(*j,E0DH'a5m*QMbP$%QK89!R$2RpYlB-mM(f*5[fN,&c`#820*eAVk"L4
+'j"I``-ELap@&&$a,X)&ERN6p6+MLCmeB6YG3(@6JI,dp&kJ)pjF!jrFbcT[f)%B
+IhB+EZ9JJm)Z9j)*cpmFEeq"MHGV5DS6CYGl6#A#fCYQLeb0peXK5E!l'h(hD*4)
+#00!UelP`FF($$jiaS*dM*F'lrERXbBl#!dAD('5#V8J,jdj+N!$rk[l(AL`jQCh
+Y55FdaBE&`[1jr#d56Kj*d0G3)$'&9$Zm%N[llYcFSZbFd3-dNTMC[eSRP@ER&18
+Hc8R2034q+j+CAd+"[(&jr,$N'(9`*!+AF-9()%P)3,Pfh!3RSLH'4ePd!26eY1#
+bQbZdZI(h8$@,'AD#p@'BSbHEEDP6A$*)Lf'58RK030UhF$FIJ-@C$eecSj,q#M(
+MBTk&a!+B4E1eeHc$)eCFVG@`MjhL4jqiS&fX'0-fXSpaFF#`Z-!RINa2dDX*j+&
+Tq,I-A,QjJ"hif985Z)LF8JL%-2@XBHX)5f$X+bV8Jq&93BLY%&**(R195aIpXf,
+KIE[aFY"V0L[-CJ86+jKBSC-91P(iJc62BqPj46hTlHj#YZXR$9XMTBX)3C%BQXm
+Re0ja"FQKTm2Q2pc++C`eJMBa`"eC'rG1),!qcqrEX1&@hK4J!UeVEpcrHXeC+eG
+I[p"VAf@'d3TP2+"YFfA&`hP+B59EA-X@4l"BH,h'9iHPADXki3L2C-a6@5*`2im
+(*[DV2+qbK+hbCXhV04"eQ&,8QUEk4IC#aThUKTGk3+MCR6Qb!@LrAmhJ3JQbIeq
+kV6YGfjYcp-$0lEP(M88-VZYljZHQrmLHRTd$H+m-jaQDqY+"MNNNq)#Jb!G`Q5Q
+eCfFSRa+DfXTYMZb%'[NE-aE4DMAbTN-UM-lMDYL#E@UbZ(BiiKVmY-+X4b`1LiY
+Yq1i8R!9U6#US'ZNMI$1IZ1lGNQ%+IKV*f9!bb&TeL'1Na(EZ2*UaHb9hbf"ELdG
+"a&"-+*lX*F@626k$NY8qjBAM$-+MU($Nr[1XSH,$cdH['5mELdJ+bR8'4BYX,PD
+d5$d8V3q[9lJV@"Dm-43,[4Uk&0SAI#K5crl')QDm-RdbZGj8q`LZLBF,3TDIa$J
+HUr(h08JUK1BiMla+bf$6lA!kqLAbrZ9,Nj4'DedTJd4I`e5rU(3mdLT0!bB#Ba)
+b-#%@5DlDUdiCQMH%T#'F840rQFG$!8`l#+DkFKqFdrLX4Q2HLm"SK$b3!2K%c)4
+VrZ)bjDGVIMqATX,M-"ep$Ehj8rhCad66`%1r'C)C#Hhk*(KY*C8P9r2aNXU%S6*
+3A&PG-TLV`NLNH(TFarZ@*'KmFRImUQ!!q'`!(J9A*[3fS0S!MZ#D(`E!(cLdRQe
+GD+9E0r3@a&6VXC3f8la%X)qfKQh()KTHDV$Y0-,@["DeAGbbDYhYf,*UI'Td0f(
+,k!'%QkJj@JTSLC8#66,NR0rTNcmHiT!!di#[d%294*8,Mr`J4J-'P*frl"L5[AP
+Lm989L(Kk%3p"A)QTA5B)(r%4eHje,lX9,Y(BfIP)L8%8%Dp!c')%-YE96$0@3c#
+B3k8l(%Q48j9L&m[,3phX`[rF9G9-lXMq%B3#CLNrMT&djh'$L+B`%Bfk$55-B4$
+$RA"#U%b-JGJPQCD($iV1C%S5+K"-mkA1FC[$Z+RB[HY)5X6-2MNlZeGEG1!jch-
+(MKTk3`JRid@&-bIe$b3LpY#MXH6UK2"30YJ[UHV$pGLSlFbK[BJU4PDE("#N40F
+a9ChG6b6"D3kjYUa(Ej'YiaM#jePhBref&+,QB9Xidf[#ePIM@R[Si)8T&!r5d$G
+[5XU-aA!a8`S5Cm8[T3d`2)ClC@CQGhC4)Dk3!&-dbDAZR-4TmcbqMm[QHBJaprD
+G0KKfFhTfh,6EU&h*IZ59#&2-X2[%%(XNi5)5dNdIB4h+)KMp,Gabq@EHa3@mc$b
+'Kd(,S(j!(h8)63dSRc3Nh!65bdUfiM'*#-[4l-Q-SKdP9(mXh2KK'l@D'L`Nr$A
+p'bCd('D"6'%(`(8'U')6Zk#[G@FJp)QS#e'[#ijQT"GdC`b25Y)I+KDj-pfC-!0
+Eq33pHNS$@YmE4`T06bLXIG&Qp-8E"4Y2'+G4N!$M6EffH"JrS@MeiENd[GM9+3B
+Q(m@)5A3j%TllI$hr3-F!`!Qmkh)[Yd"jc*FlZ6XUi00GPDM"*A`##[($L-N!!AP
+a$b-Q'i@TH!+%61,(bY4P08h*c%D!GqNVMFFD(C-Z2*!!kE-N&F-##9dp)mR$$)3
+-BF-p0+6+j649,XGe5mJ0Qj5,"diIJ8!qmBp&21(EbLeRPa$#i!@%JE$D*5Xm`%K
+T96X*l'I4`-#"K4iSd+h'Bmd8I)-+'1E9G#K0M`[G$56c@l4!-SQm*RHrSGPT%(N
+C-NPiPRY9p1,mQA,HBrNlRP6KPVrVk"(",`$15EirQFjlZ!f[!Gk&ea5hi"APjZ6
+R009PiBfCQ4cL*+P+-N')aibR"U3bdbNeT"mAfbp(F`l-*r6YBS)f"N!aJAimASC
+AM0*p6+@I(qM(jR1%)C8K2IrLX+f['@TGP!h91%!mZ'(#C)3HY[H%mJ3i)CG"J2`
+8VYIB3,qRe85J1!)h$6kmRk!jm&ZUk'Z)EP*0KZEpDc-cf6m#2-5'm$`@Q#%ehiP
+CXfL-jK8E)h(BC!C"8633dJ#3!(f-MQZ)k9'4+f0V@1!G@cR$'Q*i914)3qkQ9*3
+*kU[CamaNZEkCe25&-hd'-hPhD62CQj)-V@C6XCN-cdLKJ,mAYfTQkG(*QD-C'HN
+(CQEqlf61C,Yi$AEP@E6dq'61I!1UP&j#L#iYfEh5*DTaMl@[J5e"BmViA2E4R++
+V,0NT,DREV@I[$'XiFeSi@l3[!6'iJ*I!B`XY,9SbiRfl&mr-j"E&RcX*lM2aM25
+P4c0QdTFZ!4-ZT4h4N!#SKCY&$54j@1hSEN"iQd`TACD`faffbfAFl9P[[5!IjRC
+2L(hX&$rb2%fU[8P"d+!Ek9&%%K82""XmVN@0"1DBHbQ1IhL"d$&b5V6mFN%m*UC
+UGbZD&4pjeXQYr#A2lANmfU4'FK15F+4TY44BhVR'S@fqaZ%,iZQbPcbVe!iehc!
+&'l4,HTNdRK+@2V2e3V6&@L15R-"3)K`9M468D#pHbUk53191D3'@lL`qCX[G,1e
+Vp64Z1acI(&9-NH)V5Laam&I$N!!r'0#&kGX-"E3Ic5d5%4lSUGe*SE))kd)J"S8
+bKZB1p#0`GX`3rQ9!1cCJd$N'ThQ,IT!!T9LjYFULEkY8I&UPiT+KJX3,28C[P`5
+a1*eM,2K%`Bq-8-'548(UHMA4NN-@NPM-BKFGkkHhmE"Ia&@3!$[RVK,#Y4'ipH@
+F1AG[I0["PK38ZaM*m&Q@8,ViZK0h8-"FU"Z0dB(qdJ'rhp"4X&5`UjF(UiDlXJB
+N"!f%eT6"Y46'[fj4I4e!CEqh`iZ+@IN(3Yi)rU8&`Lk55!$cpeUT#e2L!X31&B%
+pNIfFKBLdHq5(d[iapl+GKp'KUUL-S9)`j@HI5rQV"'k@L*HB9J1MfQLL%-P`f0c
+a9a5XfH8Q+pca'S4$QUFbl6GS$kYrHI0601,-8aHfEH(K!i*[)3mRLD`&,%85D1@
+Q0%D@aP6K58$X9NHk+"6`,2j9KYVjC+Q!482)!"'!X!'PN!!hDN`"(S`["FS'ie-
+SK1+Y30P'J$@8T+N@iM'1j6F-h'(M%AFr&N3mK0iK6`V"YiN!MJG[jQ&HKQDRQUa
+!U%+C*3FGT#aYdJe2SMX0&`D*3%8S&6UCN!##)FPPL)A(J'B)#MJBkPl#'pQRKVf
+k94-*FY,f`LKmBplDiAZLEM6cR80elj52&MkalhHfdCUkTh%@Fhp`b221k,lMhGZ
+2fcj%cF4M(efdeB`QE#eCSlFqAc[kj*rZrA$9RrpfejQ,&bmHH[r1dEZA2AVXZdh
+22*krr2FfZfhMSESpYUX2,EFe(+UcG66822hG,cHh2(@miBfIAYN+!!"(DN&%3e)
+$!(VJ%&80C&B"%$%elNAr[fh1-9FC-ZaLV2ibPQ84RhHKLEA%i*JLbl"UTU@'FQ#
+PX&QLXN-mAJmIElU"2'q!jP$#5HQjZId5QT1U9#A2HbKI5h)-d)45$YHN0!&+%mS
+K+D@%FJNPKSTlrrjq[cf[K[6fHcr2rrIc!"ZYTbJRJL!)J%!dcjH+4h8k[-6P,8i
+'d"qrJ-a9XX3A%@"*9MiG6"K')#U9T-H5N[qrSrK8*6e3YQRQpCN2TE65rT*pdNP
+T[mcX84KCHP-9P$&ec,!jZ&eApN%NBIKkqY&j)8R6&E0+@UKSp"Qq3"`r)5Jc6$-
+[J!8QJm0L9JDdi!)3b[@Fq8X89QD2G%LHM*2)H)kDKJ+4R$UKaU,-SPH[2RP#K%a
+RSE6TPBT&A,)(r*&L)!R9#0!*0RqR51iBQmV$T%`M)V`kjNrX0bCq2ceJ0IN$$Ja
+SPkk)d2aL%ESH5Z`20Yp4T$dCl&MJ+pb#aM%6KJhBRdNhA"Aal-TRjdPG,LaK@Dm
+Xkl&F4-Yk&bk'5-JeK+Ck93AcXPk%-'&$l3RGiQI5(4d[&c&*Rpf4kJ*6eH2kXH[
+(5R0T8-GCBR4NGUGmf+$8&8MbF@$CR,)emB(cdG5jpU[a4G!KYIZ3!&#YFiAkNmN
+N-kGY,$5TAQKU+ehD`NUAb3a4jNeQ`',`UC%ZI(lb"&M*PBH`U9i%TLeA$*AC8K*
+J-H4-@N044,JU+l10p5-G6(!Pd6TG3cE51+rS6TUGk0*VU)m$55ceBG"H'V6CFP#
+CP5RDQXCc3b)jq"p5ea2QbJaD(*U`U$AP"S#5`)EcJj9J!Bj0RJaXDKMLL3Q4DVq
+,YeKEH3LLbeN6,K$30p9@mVCk5Y,j3PM-$KbB!(UprrI"`@+l16JS'aRp68bSNR4
+-chIK)XcJG3B"m"U*cDR'`HBd#h'UU%GBES@C[`KHHP`3a4`cLqh-IQdrS0@m&)T
+RI`eXE"2q1d5,5##I-LTFTVSIQ'+2MJLM"Y(pX6T%8iJ1a#4%@a(pBU`0d5&%Xf0
+f4*1)TXG#)d#3!*BAFi1+!dJ#$)kY)*3T8$GL649@QK,l`B$V!fUc5N2cAldH5TN
+1EI-XN!!ABeZC*CrkAi3QNZk"@PPY5)JIUVpQ'R3f$ATMa!VbQj3KSrpMQr$(($P
+A4A0-2kpB*'2qP-PSYcMJ!DNK%(FIdMU"SFeCIERa%3J4`SrAN!")IJmCIl#@pQI
+ZcG`,SDG0-bkf5qZIQkSVdk`2Aa&Y30hqXA'Kqp$-8Dd[XIml4BHfBD*m+EfV46P
+mN5AU#fkGI$55b@iU9[@"YUBk9Gpd4AdrZr,jF%TNTJIm6rDTHM3f8f2cLaUEd6K
+%M8-[DKb5kQ33F3Jl!8UX*9@RRJTBQcc1b4&jFSpkbRe&A4SQ%$0+k)&5dK"T4P%
+0&H6Uh$D"!R)S&MHK)C!!41'GCLJbaU9aR5lrHDF#!N$)a6ZcZV%j3i()iNKr4*L
+4H$0XNrbXmJ8,cQj-5LpV2h)j-NkE6N2Bp%4Ac[(&YNC#Zh)PIdBZ!PDcp(,*4kk
+EmQGXHG!cc5H&-*fDZ+[m'9XHFDT!dLa*#m"a'1SpRa,$lDcpLZJ5SFad-0HrBa5
+HLi`#15!qPJG1H#Hr""3H$L$mak$U2rK,%HVEaJL@Pl5q'Bh*+k*G*!**83b1LP$
+MED[Y(L%&((Jp"99[IVl(M[8$RCKJYNei+K$(kq%BG`0-UI%JL`LV8bUffT,dL2D
+BPCDZ#*8@ila)KdJmL![NjU3!BT8-pk(!b!QICH,2[dp%@@#4"rC0R$V-,,6`H@A
+LX(ZL'4-e9d5#96+VG)`D9Tk9Qb3d19CI-N0&fFB,`NF,4Lc%JfC[X4T2VXE&iX%
+NIi!NUM`j+0N@j-N1QXbN8[(TjmmRla-A96eHBfScAMI8)E`'e$Dm-Y8@1&E%eAB
+Jfhr%`P(e&&iPDMCH4PAlf(f3!'[1iG@MMZ-98irLG9deif95ac#T9ah&+k8fiP@
+RAX4J(5UVcRXSfDjH#S2TA+bkk2-qJpPPYRe@JqhXr#Ld44YrCr"H93hddF44Sa#
+PG$%qb%8(pDSAj3XSaie"4%JCc)DLamad`BKUaP+GXZ6#8ShDXjZhdJ[LDk"(e1d
+fUiFa9&E)D#S1'30QI"`2AHI0K3SFUd0#YfUh1940"l3(@SMd53a4'#SdaRIRL9#
+S%*m&SIZ#`IcF*mfKBCPS3!MC!B10G$(e&#H-2*ak6KQZ98NF([!qp5rbJ1TIm2N
+Vp4NH-,miG2e*XhVmb4l2*3`cl"R"+qUTCe@J$9%-+Q,j8*k!X[T2VLVGp-CD,UV
+P`&D'E+KSF6PH38$8hAY`K@lcc2!B)jbiaQ-8b9E6QCK9,YErA0c)4ASmZ"!0ISM
+#CESF"&[pKLV4$,(k(HUmCNc%4(X9a1TY!20GmV#eKh8VQ,NC&lVPVl!DH`Q,iEM
++aJM%EmN2iAhjr*1hp*,RCLl%Tq9j+Jrf53L(V0$0JE2$LXMqPlH+U,6ri(B4V8[
+qilj8adB8RIKTaK$,CjmmM!kCqc,hMDdH,M2ei3Sek$C(fQqrqGri&iL2!)fdKde
+A4%FJ16DH$lHBGMf"MKqLUa8r$[cBmF20caY&I#Z+jVD!#`Lb$F&8`m(81SmrJ6b
+UG)ZD")+i"U,m&4'rP*r[E4*"$6*SH[`d3h&!L0Lk#m%jqXTpb-V2Fpe(5%'b$9E
+0Rrm6Jme'Xi3-l$`HP+ljCebc9qi'0XULi6Jj#2c*1N[i!5)G3*EhLD3DabX1P)Q
+A#!(Jp"5BQp8@[)BSU,G48'p"8"r@[81!e#RmcN**&P[!mTdD'+m&F1PH#qVQca,
+4Q0k**)eKG(b0N!""LT!!34f"G+0k,[2)m52"jSfqf6lM964%U6P&c5MJGR0J+m'
+V9ReQ0hA!UdRpbpqZUL@ke`0K1E'$cIPl*A2I0Y@)j'V8[6kMN5DmLFmkYH45Flj
+hI4%e[CR[6CPaf$i6J$b@-X9M83dF[Ja&mh-,`jbK*[!--AKf3,d*N!##bP%$Y`G
+ffPQH$`E0G"1#4NPkS*QATD3d!!E1p"Q0r*NbV*qkFCmbH"5$G`Epmh`(*JhXRqF
+F'!(B3iKb6e#0fZG!G0jpA*8S'bcYIMqTiM0+Re(q0$UNJD`MMf9LLKb*PKal*PI
+UZ!N!32"1Q+kUd3"BeCSk9FS[9K0BM,b#4Gem@ScL3p*9)C1*#AIk8JFhHY(3U*Z
+2T8CGeCfqpHr1hSG*RET"kY#*)&BFlEK@TAXRGI"0hbd'TN8SC*ImIS@ZZ0U!,#1
+"(UEiD+$"QdaDE(rp&k5'"c%3N8%#'9T0ZF16L1"jc8N%"T!!)J!)6d"3AqiBHVN
+)!D`YJaf[CY0V'lp#0i`LY(HL%133X53ki9UKB@H4adPUc`A4,KjSQA5SfANS5'Q
+r@D9Em50d"[*BT&ZZ*)"G'ZMEUY0*rKQ0'8G5!bDV%`eir0M1e&J,&BY3f3BFFZ&
+bk5+jcb`haS-*MM#DQ8I"$+KVN6%qXKkAQcS+F30"1m6&2GJ6LcKS1kl0`bFAj-j
+J'TTCV`E6C-%"BN0Bf5b+p)$L&!+a+&3[G[HS0FL%lifDqRkU0V,$$[qRJ'#PaD2
+14EUd8,@fD`Ze&i%V%6,L&D(LU5C8`-%UG*@$9HJq,Y4#eAJp(#S-ei@ZSSX9BY2
+&[QfK5b`@cfK%4M[d3XNJYM2j#HKEQIK"2a2&R36U1j`%4Mde,1*'%(bEjfb3!!B
+@a5mim%dD@,)0,%dD1+B-,%dD@-,!fKF0'kGKEp#JcEC"QbF01U3-f[cL33RTKi%
+)&J9BX'kM4,9Rjc5rSl$'5Kq%Ha54Iic%J5M3!mMQZC5rP`Yh+YCETEV3X,0S0MC
+E6P'2-cU*X)-U3$T@!%fV'V-#PI@5i`f+(rjiZBL"!NMhmaD"BQ`k&pQ'UfSF)Z2
+dIL#eTJC%2iHJhmDCDJDk&DGi+&bb,@E0DG4p(QMHM5PU,aIY$SM1((#%lPDF&*`
+k-)LR3eaZjq#`Z`ICAKb!M(1MEMU'XX0Y$4RR@,+T26[RrV55G,N)9iVYB9f1%[4
+k0"i,eYpQCMT`0RDL'!&Q!aAa)0C`i"`,"*,Ti2E3*D$E&Bc#3i@"CJ8T$(dG'39
+M'k1+S)")G49*a!iMbrP$2Yj*@!6ajFaNX5AUH4$qH+$%HB"UG"kJrZ@&$P",h!H
+S*Fi$e10!X0V*"d`J3BmP!CbX#Cf,K5``ZXJaJef1S*!!YMBfL[#)$ZbDZUD1IRp
+62$YRfCD83@T!3L%6+@GBqqlNl'Td!fGA,d**$PDPm+"!%md[&kA-Z$K[32m04TF
+KS*)jF%BQB5Bd$kcb5`GPaF[PB"!AITZZH&EUb$q$cleS2#H$I1K)82ep85b2!3N
+rFqb0%%PZ"X+)D""a)2)8)NP%(YEGK)!Ac$r'))KK0[-(XeEaXa8,ldQpm`I&UGY
+q$23H#2kQJAmi`c1XZ`CRL!mYXcD)3%AEF"SE$MGe01RPKHA*-8(C(+XLjYUEp-a
+qATSc*SkR[bK3#h@c#aPVS+Ihr[L&Ekl$)-mJD#E!3'PRXN)Xl4`6#*,2%2Jc3k8
+9"Hmf@a'm!m@RK-L'VkIhqp%p+lYbHCUQ5bj1XD8M!2`Mc"a0'CK40GD9P4ic)dJ
+FZA@$Zi!eTH*5LI`cc2"EAMc@&BXU3aeT@SfP(@0GcSNBLSF["VZf,aDM)YS91%q
+&U-[bU-K21LUbeU1X,hJ8YSlYqC!!)*Ri'F#2!6mpB+0ST2h-f+h0d'@#5GQ!$R2
+"S$5!DGJQ$9"6PQi!6ADPUBF)fmJ4h3"q$2M*C$)hkEZBZ8!J[1*H!Z!)LY6p-qZ
+B!BR"kSMX9P,rlm1("2%0#LcT#!VN"TTk3CPk!D54%#4DJ9am("L!D29bm#"%&QE
+'K59UN9PPV&6!pDc-D'fU%pHGV!Yi3QB"*CST)h1C!%Z+fEQ*PeEdC+CE-Vk)iF"
+S#U`aCRB!4GM%IJ3aU$28b%J3VqL)KJIBHY3NQ)9*D$dTLjahq5)!8FP[#D3"!bq
+SF21-M4&+RiM'GAaYlLlLr3+XaABN+G`lp6X-4AIjH-2'T0aX-AJ5`X'3!#cHbB*
+GLIG1heeH4BKLT(!82pRi-4S[6EV1J@$L,Kp[i*G[d`Dd9&30%-+pbL,cA6lMd8Q
+G'NY1'ZXQ,EB%*8be6PVf"j[[mNNH5lBXXiJZMUYMdXZ*Ki4$SfBF*,CD@)l'&Pe
+`#FG%KK,)EcIkY4pTpeVA"**K4m$rQMq`c1%`q)C#"ZmeXdD0Z0P8(Hj13+X1Z@2
+'XB!pM-j@G*iA#QbPcQZFRHZF,+BCl'3lS[YkHZFmrIP`&cc&i3J1e$L$+LA!cBL
+3!2Y'4"r!mTaJFSEaKJJNqcXH[NG[00EeX`#!!Ja*0Q2`L5lrQR[dja%),CB4025
+$,@0GFL1$VY-&9eINc(J6iT@chY1i1pKY`lTTM)L1XQ)!bdE4-Fr@9)5QdU0Je(G
+mBPRdN!"JALbid#VMc,3IQ@P@ANNHbMjAkBU3!)&Ze"AG2-R&'Lki2$[RlP,1f%3
+-FYBQCTHCm8HlF+!"KIPdh3UjN!!lbYQL-I[#M*HcRN+"F6-eF&QeIqA5`#rq8qM
+4e'V,@MBc%qj*bNa#b25c%N#Y`dmMILi#a)B8CC!!`pJ5E%29J#5pl%Bl1MQFRb4
+Q$5PCDcm(r)lcA#5`LN1IQ6S"4qq&iehXc-m**QH!daiG%h,bfIYd1Q66K,T6lL#
+GH1X,XG"P11YecfB(picEj3'ZFN%$9@KBiI%T%)d3-jeS-0*eUec+H+`!`Da9bRJ
+b%a8H#V#CF&!r$pNK,"8)[HJ-1ZEjUQmJ%pQU-1EM"fTXM2N%rMIMIaXbbmeJ4iC
+%Uj%M(BM%j3AAMi'DJ1Lf$i&&fASmh4KfA3@MjDVJ5"YqV2KTK@+K%dlXhhhKCN5
+L8%)akNKNjfbVEKVri[lErbC[N6H)BU31'd`jYbGeiF#SP!%4,m%S4%4R02)4SSj
+jMkkV+PFD'AGGqRqq-B&-#3`L#DiiTEU('J#JiCm9c,%)$i,Z+I`NL0#r+ZqE-!5
+Mmai-)9N1JDi*lXTG2L[rYqS*AGUi!*J`1F@664d"2j,c(r[MhE-KkR`j08$XRqX
+!&iHKm&dlJmcAlM@C[`(@4&KFGZ6j'Ab-VCS1lD'f(`S"*UkQN!"CZGqkTEL`6a9
+3%5Dj8JJ3dJCm)-q'SCJPBm9J"5CcCMS!rp'a+q)!-R3()PI%H63H`*(AqEM31r`
+CI&pQed#!AJ''qA8Xj)*CFjfB03LD6QC0D1Y4,SUL%&jf,N$(32)SC369,ED!T%9
+@,)1#8KB&TH1#@DmP##,A1BKmHm#`hHK-%%j@*5KHj1#)M'('*8H4&f`m)bUef,(
+Cmaamq!I%hSaU&''jS5KYBN2!(US6Ia8U-fq-RG*!jK&h!*(C%`Jd!b@mh"PXIV"
+Bf1N`#CR3FB9pN9!L+96MXjIiN!$YDD5L,!(KZK'I&qNc439EJJZf[cZ(B6CeSp)
+p!KF*L%-$ik-%JPNRll!m,(N("X224@+4CJ5B$Gc+J!qP9hchqjU%YNm'IUl+m+D
+[F1X0I'J2MA9SqU6NK'XhD`kPNV`S$`LPP2ekr#Lc4"+SeL3MUaC'9L4mq&RG)LH
+cbUkbECDCTahj*HNb'PH%Y'Q+N!!'GJT8YP#"Dmk!9I8RYhK6GXSThSaX)L%J#mL
+c&cqZEl"#I4c$)8JDKXY1FA%"NE!1Pi!J4!+3!#`)fG&mcP)3H[U5,!K092NCIQY
+RaaZUH0&hrl[9l$!lDT8k-Sj"3F2-4hm#1K9(1"Tkba[b8L@3!)GEK1&G+E6$*eF
++H4fZlh+(@2jSlX!p$Se&3DFj+PIkDiBkTq8ITZF*8fk-eGe#ABj0X-Mc(QrK4KH
+8,k`JI`p0-d#BS8"b(NMmFk(QTP#"C["rrEJA49D4C[b$bZrf`UfTL*80d[LYcb3
+*PCLQIe!Ch8X+lE0"4a'62NmD(bQFd(JdU&,6Q$4qk4H&PNd*Ce9!&*26Epk-qh3
+k!AaP2iEUPH*@21GNG5M9dH54(5@iS,c4*HQcS(Jc(3U%GTk8p0L5ZX"A[FQdKjQ
+LVA#PL*P5IQFAGU`)k*hUlSPG%*AF8q8T'&STN!"[S%!@#dha3$0PNUB"I$S(rjA
+F+4iL*[TKG`CFk&(mDm(!d-"pD2QmNpIpb*)Ul)dE8"df066*iXN+&*V*f8"B'')
+*)dM6SCJIb6*e`N'5FY#&IjKZG+!c!rJ3-Q1EUFSMXUPVR`iQ-$+!b&3MF49JIdm
+'GNd(9!p1YX"'Td-3XXEXmZAijVSrIZ'Sji($$r4G9V0clXN#m+(S0[80Yb,Vbq!
+J3LJiXh1qDSE)0a6G@j+1!N$r0khZ!FH3!-)LdBFEG3q%r1*RaTE*MJ0K-,*iNY@
+RD6F8!F`fj[ZiJNFMR0([rPG0(lXVSR!CSUTSC9h)2(leA!X(&VfT!mT5IibVG6C
+`"N+h1$YRdpb8S55G&jb*#U"p@l,(p-`DfI6P#$IE*c3E-9!E"LpYDN"P!$J@2-e
+94j&jTFUJ%0EBKDNTcUL%,V%,cXSF1,E,RH"%-"-C-DJHG&[Kd)),L5heF2l3HH%
+HC!!ClVNX)#lZS-il))BZ)9E328"'GQB&X3["2-T5a+6,DMd)HbX-"m`G8Up$BaE
+cKjMBfMhDRRPpKAc)$N*F1l#C-*Jq(B&B[8MX4q@p*HLS-3h&%KU`caQ"A[0*kX&
+Y3S9)%CV4D#d64IMaDIZbHL#-Bm!&2F2jP(cR0Af4*$28[q56%a"CJN`+'$h5rUL
+*'8jJcc&+CA'q$5T&1GP6YSk'54he8Ur5%8i-b%3QQ4hhT3*1'(bJD2l5F6KIj(a
+ee`4f&$QLJ4AMH&YmFpfBripIS))h$8%"&HBf2F#98#'3!+HCHSCEkjf!PmQ!Yh'
+U"H!GC@6CiR"d++"R4e5)Rh'@cYJj'IKiQDGa*cL-)LRUQ)'b9HUiQbSC)D1H&Q$
+J@1Ek-5VZ)31im3&d5Q2`Bb$6p$!"0KV@!R3,0$d5CAqLqfFdML#46$fhc*`i05,
+$a`P8TllTUdiKkeN8Nq`NjXA#5$"@LDY5r1Da$#M%A5dC2GSq5V#qHAh$43bkFJ@
+@p9[@!XSZU2f8J,$q09ElmB,&K'JE0[(bP-#BIEJG&B)#M36#pRj')'!S2(hp"JH
+XjPJE#+dMSXc9q9l*imP`'L4bJ"&`-YBkZD2*6"e4*FbB583cb9@FQ8"0$4C"Tef
+ThL`((R4qGRCG9k!9JrC5FMZ2pGU1IAZ8JCZ6q`!kPfERE0Ji#Ga-82UBf2N3!(H
+8!&92J(U6UR"beiLQ*d@JZZ(,NcVE+BP-NSH"&@#&bN@-+$E-CH,+J,YK[KY`0hc
+#J2ZP'ShI8Kb!baa91VXX8)3@UqmVKHJ3#4mSh"m`M4,c$-TC2p$+NY49pAf!5c1
+5[80NACHAGf'TMUH,R6`)-RiYF#**2QP3hjH6F,4,'5$RXTUR`LQ&R8`d+@B@&+6
+UK0&i3#BdL4LHb3,',iG'C8C,,`XQQ(#9"R$)9iYTZ!-%e#``B$i'Uk"aU9&@*%,
+%4JBelChmUU9IZFYRkSR&&a5$PEJ383P((9FZ%SB!I0c8!G%e6*[BK-$BM'*),q'
+JQ4FJhVl24,0EZ,YeMXU13C`G6#MC4a409i5VkBVSD@TJmCBckCaeK%"afTCaR-i
+&HBXYkrKbqX%#"'[IB"F08c%+!5$@D1r4Q314$eSL"VFTJ4HB2M$c#@c(LS,6JDV
+Mel#"bZG((c&`)PKQDYc1HVU&cL5hc2cHk#,"c`@bp)$j0Lim&YGIJ#*J*YcT2hh
+PUR$TLS(8jYGH&6fkD4!#&JCAcM#kXm@R+)2%fe-UaPYF1R8#B-+&,E%q8I6E'TY
+ULjCdcb*3YD*"6TC)+bFJ-Z[GPA)f(*QS1'r)b0[kjX4,@9a)2m2Bhm&EYNp`6b5
+'(LG[[XQ-`-0UX0j8lC6U51f8i"AYP1SV8*0-#FUL"4"$MVKS-Km(5&cT3f22P#"
+-E441UBDbl8B`K+be(JejD2#aii10+EqXbF0$+&-GF[8$&YhAa-$m@!CA69CAP6N
+(@l@#83RrB%S2@#Z,&`"a!+KEkB+G*J6`30Z9`LRP8h,aUTqbp`U'Q9+1`q[GeEV
+"X1++D+`q(XMmb''G(kCUe2'hrR4lF9#0R(#c0CN)lJZZ#L)V!*)iTNZe8mVIZSC
+Ar9[&3QEhSQ&9*V%eL4b16rPD0VEQ0KU-K63f,E#Cf6$%D&59T6)j%TU2b$Ej`l-
+-bE10#`Ji9U'+El"M4Q-rh-18,PrQ!1iqJ+[#-ZX0`FbU6#PJTh!jqd%,Xj9$"L`
+119+2bUL(F"#'Dc%k(%2cIkJ4R'QIbQ*)(fA*89$12hClPmAK8BIrH,UlbU[XIKG
+'"JaJi'09[f!A,$m8hDUNIY$*JRH!&9e$8C1Xb14Ahh*b[V6,(@Bd'ZVp("LCjCa
+N&6pFjr5-KTrSBD4eCApP&X6DVJQ1cieFD8b`1bP3@DZ0J3RP@&DJQC+&QTlS2-k
+1TPN6%aD-J`)q-,'ASd#P3pQ9%-5d6q8&$Pd!TjLMIrf[@4p"b%CdGXkQ0'60%(9
+Fc"S49Pc+iFkkb8",e@D5%ipK!Cf(IRi[!fG*qUdNS4b),j,*PRc%KQ53!)3kbMi
+1FJ6l8eQ4eIFHQFVUrALGq1hHkhiYR%DNMYrZPE)H[#Qc53,edQ(Y'BeIfa20@Re
+6K1dp`K`lIPR8#lMD&#@b1-ZBiLcMaG%@GYC#SP`FID)mI(IhD4mY2rkl[6i[9qk
+!5rh&F$MAPcTGXNplU+3(KM`FYppK4UH8"6B+-dcXp8![#RYQVi8J0pqCJC!!Y,@
+CZK9iJ4%""9krT+eah2[a1PpYVfiq+Lb0kYkXYQ[L-0XabX+U88mIpIb"bK*F'I!
+e",-M(*!!dPB!C5l+%`J!#j!!)5KP!5bPC9,3GRjSfmi2,EEc3pYfiYM1$hNlB!+
+95UG,UR5PU+UbU+3AefM@,EVp'MDf30,+'e-ICA8BLjfCk4%Y+B,58N*ke*k8Xp6
+NS&(fZ#pF%KQ5HL60H(,(AXZQ'R@0,ra-hC!!G)JEA@D$@@jHibXiecJN(HCPYp%
+',2m&PdNV`B'iMPqAGRZ2"6(KMVmUc!8P""Gl1Hb@4-$UA$hI8')30d,D3iCImfG
+*5BNB$fAe'YlMci+5!R%dG1U`iA2qV#q"le+S"+jb-"Z#KDNP8l&`cNaCV6+B"K+
+VjbG,`PJm,Lq@@LkHPaFAZaFcAABS"JU&EX6eX!6%(9kQA(8ZNMh-ef53!'pdT'!
+QSLk#6#4-U%LHAPr4fDKRcV(6[YVRG&[[r&(FHmI96qSIm%VYpBp[(ibdrrA)AYq
+'Nj)I%ip&rA01BZ+[3)c51lZ&2qlGr[R[6fhb5[&,eTf$dALjR4-iGI#1D9)$1Tb
+-0Xc*T3j*h64d5-Dp#5RiTBeHU50[eGE"QSlb0AGA(I&YfLI&-6dAdmr5G,XZ(p2
+YFHqlEfaHFCGAmPc@EaZXmj5hh9fjalF4#YPHAl5Kb"[Y8$SiG*[3`4(hrMP[9F8
+'Vq3IHIcH`C6rVr[1qZik0Q',-*DPfil*eVMhm*RhkZji9fTiflTLX,%"9krif2I
+!5DQG0YUZE$5-DNIG)Kch$QTk9p0'9p&'ebJErGbfd628S99AK!kYFHr5hRp3DD0
+kfQLEa8E2f$BUkGCKZK6hrXShH`0[P%MZ)C+ICC,60[h+p)4Z!kBRiYjp2FpAF!)
+4dGYPSU1#IpPkaC!!!'dB%BAi%GdZG)c%[6VGApkL,DqL,DqK,A1RGL*rqaam8*F
+Dh6*dUBPl2cTqacZmE8U!Z*)!CcJ"LYJ33iHbEBeZ,MTSiYllEUk*VM8"cYJ5i&(
+G9%aq&#5DrFq[rPfj-Qd&%ANcNB2VTdMfAP5b39,BPD3Be@e"ap'ipp0rkrZBYVq
++YZp-LR@F&)f#%b0KRh1D1ShVGU$6H0clmQ[*TpD5(!hBYTh*LiT%TA([SXiR$e!
+b2-(*m%Xj'H+8B,NdDA(F@f4qhEcqAFPqk6FihPkqNSq2([cl0!@%9bV$,BYl8qI
+228IN(L*b0a1j2k*NKD1he&k8kr1b%d$Fpp-&RaG[mS(-GL+c95(c5L,F5LBFKY`
+Hppl9j2Kh)Zm660jIbZ59!GE$5B&TZq,H8)meiqr[5L[TLL[P+a**1`K8lFU!1q,
+H$4rFkb95$K%TQjA0V1-NBbF[D@A45EVNTVM[YhrrfY502T!!d%iNY")*2q*NSZh
+BLml5e!eahe1rqkpl@D%jJB`V#5KA+S6F%[G1q9llAC-*5BM$!K9JDRlFZrJl2cM
+$'b*#VP3)Z8m1(KD%A"Ih(6TR[AmYK'a3!TfmmDPaErFrrE6Mri+3!02LhV+rIVH
+8%j!!VYKJ5fSR)Cd*8a6h"Qk&eM-KmiC!(#DN6"b23Tbi3XDjFGrhk`Ef-"RVl5!
+1Nr%VFP"r!e2ImXV*V&[b,4FK[9C'HMrp2MB"emAriB['DFUkZ2I-2brb8K,[TL4
+Z8)MhDkRK$lkSRkB"!![rrep%1I"b-GFB0aaf(5E#Y8FEA[G&1fJD%Q,ThD0f)XC
++*NEjEqkH"A+FN6cr![,5*!5-6plCeX2"Tlk9Vre6T8$i[5rD6P-faEhl(rMrZSP
+BZiPB$ECJX4)App!d%'V4(rBEQ9"mTCTf3kqVP`J9MkjmhAPa!2!lrc)h5!4B58M
+r0dkNEb-5NM$brllp(PflPDrp8`A4r-&*T+eallB2(PP#B,1E`+E"LGjrlp`m3'[
+,AcA(R#5+aJd(A3ITfTp,+rr&H@d%HIrH[h83mPK*S2mE*ARPDmXNf"$hVYq5rbe
+#(N`Ncdq26%VBZA([[9rkjYd8h(C6F'Y`&j@fa%@Jl*U49mSATf4E15RCC#)"1+G
+pjG4Y3X`V#G4ri`Cehc(P8L$#iSHL285Q&LE6r6C!pje8L)"%kD[6rC'5VSf56Qq
+*,U,fd`M)Ve1eq,K[eX),2hi!!Hl5'YV!UJRSBL@QfQRUpVL[l0@Chb*Nd8!Nfqe
+'&VkcES,FrXXc8iKN,8bbqff)`THVN!!$5I5[pRAA#%fd%CV3@k+*D!-1pG1KZk"
+kq1[Lrq2[48M`0C6JUpaS`RI'$FV(F[rp35*F!a&ZpeS)K`"fDr$Yp*p)1#48@Xf
+p1bB6cSNHL"`bi4E(IGp9qka-Z,`eK"j@ZG'$M4`!kHcNQJmSN!!e%'VBVD!'5i)
+JS$fImICT#K`Y($MZPj&$R+j[#rK[h&Mq')235"ZZ[a*AQd8Em&YX!#"8GmHGIf"
+5%-(L#X&1m[9"-)m6V(pjpZmrBP*38[U9T$ccTCYI(46qH`C&mSj"BBHJ@6V*35-
+j)S+V)2)2EII1!HY@fiI-3G&6AVp`Y&aD9H4pb[HSd2ECqb#XEUJAPe&r"1+ebJj
+Xc)5pY1UDldl[h4mGZRr+ZZqmDp3c`jFqLU69ZrCH@[@Shc!R&FSmIHld0#m2R0$
+8L,[hj2S5Th&S`jdRjrKUe+LQ9Hck+1%jIRUD6jRJrGfHBpHLRP1i8U-bS9brjD4
+lJX(PF['86%b*((31SE8B)KMqAI'aI`cfAeT9[K*G[G(92rhSp2`D-FHAm&jDPI"
+Ni8T43r6KDZ&Xq0e(*kpKHM00Khe@C`-M'fj+H(JEdBIAfCT`52I*DeR(N!#ekd%
+@%H*mfLk,6!Ha8q3-V'L4@5YUA'%Ei%2XYA3K8M,XMbYC)&3(NRcZ"DS3G01pJ#T
+"&TrHfHk2Ek[M'UAMcFPAN!$@Z,08ML*TM6[EaCr1$"Sq(RF[IeXGP#-G2MGMSiY
+C+P$(6PQA@TfR4MhPAEZkjjbYm@`kHm3,&`6rC6AUap+a1[r'BhZmEd2pZRd[JPX
+V"cITmEGbJre&Z3I[Rck3!0,B4E!rkYrad4cI`IZR$TbGhbULIYG"`d&HH%pC+!p
+M-#a-Si9)4r6aeh0jJ#pJ`A+!2ddDi(0P3HlqDlPl[+DMc[rlBpV$pX18LBY*(6[
+h4M[+Z`MT[5[&m4QR$qr!28Qh-jpG8VBFH4NZ(ElSKYIAh9jL`4DE0%&DEcP"9im
++Um6-B$0e!+*k-%DQeqDT&`i&G+@eH4r0qUqr%N12`+ZX%kB65RmcV(Y@U(JY%5'
+m[LBmH*8*2ej,43GHD5+1PdkdMl!$YGiB5Hb(%i(GB@9PceXYVPB+r-PU[mNDf`D
+'+"Zm5Sf!BB'&,A"Rc&FZ%Ld"fkT9BG(S&V%C3kl55&8E&9BIe(hk*Mm8T@G0T"i
+*k,[B#2*&X2MK`+!C5JQSrC0FC4fUb)Y`R`M*3!-Q4TVG,"UK*US6cEbS#KM!8bE
+Sf$922!EPlqKF%F*")6TNQ!BI"AX8lV"fGL4,LcP-YE1@J)Nm2`-40!bLi3Nd*&h
+b!S`$`9X198B4JEYNl*cl`%"f8(`36E&ck4*ff@NDccT8NSA0,qPH+X(&3EI%lB+
+8kV+IP"h18l,$H8EIrE1qaUU4*rTQ,@&h8'-0MZM5TGe+f'Z&EYD5kfeDA!%"%kq
+$pmpDXUD+e@R'1*1YHfS6Xd(p"YQeH*'KX$LVqr[dLVLdVLb&L(jANlLS'(-X"j[
+d90SL`h"Df@!jXr%'2i-LLUX*LINiiRUR&P'U0X5-),&QV[K[B@Zq[G2Tj)%"PZ$
+(iXM"$rM9K'Y"TG#YU5dqC5M+m[@MXReaLD(S'iJ1[ST,LX&F0RQ*b"%SqXd2&Q*
+L2C6k"fL3!"RiH'S35LKFlc1kEK`JXa9%C5EZXX&b9(&1T%i`ST39-Ghl1)%-pHa
++#V0Bl5"bHF,3K'h"G9SQ$60jYl*KJHl[bi[pV'kZIH-k,E*a1E!bhbKJ)RErL!X
+`*CP$51ClQH5%!,P+NS#lQ,ll*&MpADai'ra-RXE+K*H,%LG55Q"-@qaNj,I99[a
+F*MAm`!XVZETeK"aCh+lVTk&1rC!!'dd4pG@!#a1qVLK9aq3Z--%k`P&8GDR[@j'
+f'#cEiE6&['3S8"GQjrafUNbZS*V*UPNY0lQ(LE9#8@0RiS6BGIVbmA4P1T4RS45
+j-B#B-BGNJMZ)F'l6#$-"hlYQU&r*UJ%fE**RmN(*B69jf26!pc,GJkJlPF9a9Zd
+`b"#c'3$$9BfTHqA6[FlVbX0p68Y1D5Pj@qT#2KVZTBd!a15NU4'B3R*[p4e@LF5
+QIRZ%ZAFqZDijH'N0!S,kDMdEc+JMBUJb-E$3BL0qf),iGLG4M@aIr0XQUGMbNdJ
+kCRD6G'QG*8NI5l-Bj+DbZ1f&51S'*6BkmpX@HG1LALC+%jXk9Z8ZE'cjYqF)TEB
+&1QN`6%CeUBA"1%b9@j,'BGZ@DVNYa`3M%aC''k4*4KXm-+U"J"l32#1lZ3iC8iT
+D*SN"V`%ifmB`aER)KRerqaUaQ#f-rX))dVKpSqD`P2bJ%fBbcV&LX@Nmml2EjDa
+qkjkCkNS0)#Me*6*(e)c$K5"@F"@c@%'b*$Z!ErFCrBk@PiZBU98$pDA$`dU90S&
+U6j%ARMTEY%ec6M@1f6[%UTmdIB2Pp+5Mii6JTBc$e8*AIQ@J-LJ0!+J2i[VP(!f
+G4V6qT6c48*PhKBe9kbVITSCVD$M08FrI%6h,d3iVSRX`q3H9(r2N"PhP6@T)S'%
+K4q1h%Ch0dIC2%AdINjXVCr,NeEV+'G5`!!fIFM6j2+,&(0@2)PT&PhK6ZF4Ve'"
+!`cb10Rb%k&b1fUFM@N56TbQ6hl1XFL!jfH5UX9R,&3)GDpi#,!JY9caIFc(%,S@
+hlV98D%C)b%eZ"i)h`)QUYM+9AEQSe&6Eh5HVkef&9DH-@6#%N6,PhKT)qEQ!e#N
+&T%jha939Zp*AG49ANUSZ[94B1EhU[+Zb5JXe9@ePh&"Be3ZecM)HLJ2$bKk6J00
+[r$Y6CTmFIUfrYZS8&M@m''"c+0-R'%b"Xfa8-DDF8&4iNNYb4+h)S+pjbj[bXK(
+QD)e!eM6kN!"!YZb4Je!&V8QXrJpI!L,S@kHMB*c$THjd3,pcMcM0f-%BfVN(,[h
+qe)R)LFQQ*"4K[h'YbUTQ9P1Y68R&4'`2mb@KT(*F&Z@#"H1XI6b-Dp!IadrSNSM
+ZMhSP9HZl!)-2NTV&ND5NRZ+)A9*,11+3!04c(,&+kR'1K#8B$%@NYHqR3XVdfVf
+-U!VRjI&JDj!!Q)q@L(c[&PrS0)XTdGGVa#2H'U%pPR1'(FT,2Y+HYCqP,RI+cL3
+#CRE#1pbAAX@%*9$KLbGUr+&)M6m1"pDpaNEYDARB1Q6(0K`,83@m'Xf!H1SBIXl
+@3*M22mY'0$RVp[VM8R[''6K@6Rr)j3mpe112`lebQI-JJ%+4'`84+Lm3jmJ!rcN
+iiU'C2V*0(0AcK#X&`PK9a)R49)[11H)'&a0341Z-N45@H$Y0%E@C*b2##RlTLVQ
+U+*-VpqXi+RRF+)YG9&1b)A'ldB(*"SL4cm*JK!k)r%1q`KZjJIL#bPPlURGqRBS
+b0L*#kPbUDR9AjDb2P@PF`4rSj8IiJ&+8PE#eP9$XVQXKYam(AG(P(N4@IV0T%Na
+bjCr-6#Fc9Rj8hj)(Y$ETPB+"TdJmF'Ek4"-m6M&P4-#9iC6PPYQS#JRN1ES@Q8!
+`H($GA3%YiM6()V&*PiPGb8M*M,[-9-MRS(SP9eAM!4*`E4lM3Y3XBL&YhiZlST!
+!f$2CT0'BA'N`b5iHX6T6BGA8J!-"HbSIdhMk*A29HmI6X6`03DLfq&ZSQXNLA[[
+J)kE+#Q[!#QF4N!!5(Gk6#LZXf6IKS"A5H2Va`!+&%#4J#X'19-,Hr4ZTbqllV2a
+kM-dpp5X"&pXT4dHr"J[S1N6Gp(4"L+@TB6NM3mIhdPA-R'&jcKFEj5`#98&'*31
+HJ%68`q@q(D*`C2+5+i"V6ZYq'qK`'Ll[#,!61JkJ`P,HJ%2H3&"dQGR&)AA#+Fj
+$pBk,"P)34r9`%1ZNDh!P%KL0%AVh`'cDUU,"f3d9B@3(DqXcr'J(pqE2Q@SV'J,
+MMYUUE9c-'AaM`S8P)Ldl6La4K1VP%+LjUNpKeEEZmkLFUEGpRZ#(466C#*LfaG'
+&5cG54U644RU(E2kHYmMGA)pBZ0UhQ@UVTJGS!$41arEYf6H0c8j%+Lr3-%PX4DY
+N+C-)M(CkN!$$32TK)R#5$IYX[bdEq&RfLhl4260aJMI3l8KTB4iL"$G1')NJ4di
+X3i!D-K3p'N(eQcN,I3ZpF2(HbrpAl-dr[G1(c1B-GK0V+'D6A4!3Y1j2lSj("cJ
+-lk+l&Gfp#hd4VFD+!e#%m!'6K`068BXKClk%kS"9dr#+9Nfp![1I&9Dm)K81UMM
+Si1eMbkJX%hN!!F6[!Q%i14$CPTe6Ck4Y3LaPTm[Z%`S*je`j8@&(TXCRX6K9FBl
+R"lKmdMqqr6D5DbBQPH-R$i!L%+PQ!9#dGfpVUUf`@hD@HQ")[PMUJe'qVa"J`E8
++9aU!N!$j#DlPSX'8!c"3%"01pBm[q`8qkM'N"d0kQMMMG6`ljj(TbK"'$+((%+I
+B,GIpU!'JGFlD"4!!@mQP2facklF9SfPfQp-*)9aNMTr&Xi&b)#Z,!%bb!%6`!!`
+#q-Ij0HYCRM+KfQ5p1Q#DT`i%HUJb4*`B$(&L-+5`B&@bpLhmZ#@&lGE)Mab4Xph
+)'$6r4kQD'BJRY"#Fjdj%V,)j1MbDSl+LjABGVP@$)28F9qH4'bl9jRZ[Q#YDM-h
+1TH-qAR!qYU6*Bc&%jqd#)+2aVrd,1h3bD3D0E9fa835"'hJXbQ8T%iiI)E"i#N3
+F!!`h6KK#5DX1Fi9m4-ZUQq%H(pGYVd8(hEB4&5)YCkAaS*XI`(e``J8k,4beC!0
+X-R&K(XcS!MZ(Lp)Ef6N2A3BbpXAm$Sqa4Y2AK-!lD`Q+(Me(E*Pb"U4MR*&3b1m
+jRZiF2Qd(Zb8k$I@Rj)S43e34Xf95!FHZ6H3k$aFcVQJDIY'%&RN#3'NZ'@!DNee
+)Ki)`F9GEN@#"D[PmVZU*+VJ`[X*9j$P6Y#D,hCMpD93T*%)6MV)"-XX#L60S6L-
+86jJV%Xk-BQcL8(SD#NDcGjq&fB'0,0M'U0)b3"kX)+ifL#c-,bk9JdJ464HC#Id
+bLD36"R,-SB'UL4"#T1%+F*-fe(-QmrQT2#bb[Th1J4%`3dK'L0*24j9"mIJKUXC
+DrC+jZ2I+eG$eL[0i'5[10HPG!@UkVer)KJANL1HN%MQQ0&3MmS8L',TUiU,0`aA
+)2EZ#CPj#%1d-a+pFpEaGFBl"!Jl3$3M1+CMRFU%!jNhEUI)RVV4m)kSke"DEjPm
+0&34UD(V+kCkXJ-CT621"H)Zi+j`Aic+B0(A`CYRjGr8"5R#KYY%!H(5C6"!kDQe
+ND*A*X,4(*S0k6LD$UQ8bU0P-"JBCDRa'hV$k&i8!Tj9)VY*`$Sm%)e%(6erjRTX
+BS3fS@'0*M-X9j`"UmkKDXpkC9("RR8#Jhd54PHk`5-5e%!S'lAiLS4bE*a)+alU
+)&#)d5S'd4EPNjI,CR+9Q8T6Gb',f4KN(J8A,6%*fji@CrdpK(+%B&@5QXAZXdc'
+@6%-dJQ'aN!#c!dj6+L'J%YeF)+m,Z2LML$`CD)5cEKe9FANR%%AKme`JQQ`%GT`
+ED!N0TqQJ$KaqD`I8NIakaaLA&a'd,Z+R%3PehX6QXb4%"b)'*0imr,b'kl1$H`Q
+pQ$PNa6'GLPQb0VVF8H9b@Fl,e9j9fh5Em'V4lH!XHShi1L0`cebBSq-(HQAR*0J
+ic5Dj'NFLM)mGQHQmFDIc,4d`&ML+E@3'kRLEXF3V2@NlD[[5GS+9G#mMNUHZSLL
+-i"1$228q#q)33Tc%rN5Z(K0S`e$Y-+M3l!4-E1046CGLCU%HE1%)1HC(')@`ZC1
+EJh!H&l+!rkH`,1$(-X%SMJ4-Q(i85H3L*QN0M[Nb+S-LdkL,N!"CJ[fkSr`"Plm
+"F[k2+!B+-V'eipKD66!b`dM6,mJ)%5bQfR9IP0dbXh2XMb,BlFe#%,XVFk*Ce#i
+*U(J)9G9DBDLb%kLCX`C4b81&hl*!%J*+Z0J-!D5`f1`UV%LjDSX$3A[4bCLG*S%
+(J1$kk%Z(+dZF#kJfG"L,#CPpTViU#j2MJLXJ1Bf+)G'5L'3bJph8Jm)'CJ6!DN&
+Pr$DZdQaM"hCjd*b8$CK!Q#0$+BE-IQBSe9DFGaB+)-B4"KqMDI*J2+8V!VCLJIS
+2rh1$8F"-iV%R3!%rk*@CA&6PZH2!Q+h+-l,Cq0r)2bmGUNJK@2Ib`kf!3&BKfqM
+i8@A&HFdK+FN4ia"0FAib@k,%iS%`'jd9"YN`-*+JHB5I10,eFcqFNEZiDK-A@Ce
+E+"V[4b@+PL)#S#&8#rN3lUFEYIYXdkUdI94!ie%MA%!65h"MIHGXm`frTJ2U@6'
+%`2%QLVPErVrK`5mdB3H!D!HBrSf`S06SA06kH,P[@9,Ji@-dc)a'HjrRYr6BVKT
+HH,#4(JMS[&30A8U2ajZ8%q-H`DG6#L,SZb[!,68i9F`X"M5b5r'N!MKPcZ1-4i)
+GQ-(J,A#b8Q'+T5ZYJ-eISM),SR)4d3%63'N&-"daJS3U8j!!,3bN4)!S'%dX06L
+4h0+YPJKZk@)RLS33N!"Ne,Cd8FcfF+qP[f5d&d19U+@r("%@8jZ9c$!J24!D8Ir
+@Yr49L&C$6Q5eG+(c%,j@8cZC%)m5)eBId-YS(-@pPP"'1dm#QB*)TXDaVS2B,0a
+[C84pH#+LCY5qb%K-,Z'h(X4Q*L0Y%kiDL01eie5Gp"dX[4VJb3YIK%32@e4&i+(
+MmY#H(!9j`5c1dM*'AN[,eSDmTKeAN!"APJN6!pQZUV3KS0!f4PjT3N&H&b9dCq3
+PEbaYL"GU-p-N4Q",bf3%PTDS2CbQ`43K)c"dZF!XiMqA+eH+!"3H[S(#H6+V)L9
+)c(q5`B!UUUFCl8j'$$kA6@$#h$Z"#92`!NbB!TN*dqKaXf&b&[*'Q8L,GmTA#Rf
+iGQC-cS,m-cqC'C1c8'E'6'D!T!M!RKF6*KI3B$Ra6db(L04Xj06-TJAGc*K'*c1
+Q-H-3YP91CTYc@VK+!a4mZL"!M%h!I(`%JBN$&#X$)"TXYTp4M!J9Q2B&f$aXh#R
+UXY,,"S)!60fd9r+!c#D!iG-EC8+S(c1!SKTT+B-6M0K[UKeHDT!!#q@88LJ[X"A
++V6IGKA*VVP`SVa@-NGb"Z"L')Bqj,`c!,`Cf5h"qHP5qSYL+kMc49hU@IP*lH1Q
+R$)B)S-9"-eGpB)E'dNmJTZ9"D9eC%3Q-Fi%2mPP[#&5l2B5+!q(aMZGkiCLI[+A
+2l&[3@lM%#1E9JN1&5q5TMpHld*("Nif$9G3%fR$8!)l+aS3D$$q!53H3!%QqRR&
+S![K9bq!ReFlk'#EjUMRCj16#ihG+h3NChJj!33@`d2$%"&dqcb*")b3'LU9@#`F
+62&+L9@([-81+c3Q+c8L3!"(mA-+R&K(T"+XJMcb(5Tm!L5*Qfq"aM8m-YQQk4PM
+e95A"30YEpeIF3%,2`)CZ$(lQC'V*5Npqk+*G2k+5X1QcQ&iZ6`ISlU'KVNGB*8q
+XAME`aTAqlAl4#%@VAcb"$Mf+1VZfJS*6plrcJchKlV"#YhMQ5e%I0lJ#hImZSdi
+D%L`k9!+MUMhG06HkZ%L,S0*R$&@IZD(l&6C($k&UXD+UJENVCY,)&a4EQ&N&K4[
+-pX8Z)X%rV5dFR-lCj-(0p*Lb-QA`lGe2ZJVI'-"2YJ'4`5!QDieC33mk`X4jbc!
+UG1PPCjl"IkD(U*BUjQq@G9GVZZ#DS'G6995j'Bd3l3Z8CEZmCDG)rhJCYMA1C*,
+S-C%C#0"3,Z3')Ucb4T8e[RLV6&Bd`15k1`RdHcN*('aib&Be5-NJ*a@QLF2#Y8,
+*e))PCl8a!p1)f6VZfHjNRr9lq-'mJBZ+DYeMS9L[IF-S+mYC'3j'VN@(iqQacCD
+X%'3qDb[k%6"Z)1Y3@@(')kZ4P0eI4k!amfDkVBMHN!#hL1T+5@6Ip95*$Jb[aiF
+X"ZS!`f2X+B#c@)M(Nbj-4-6lVhPMc9'$p*!!Q!QcDl-"hYGHJr%,RZJD&*p`*'U
+i8#!@L[IaQLeQ`J$6l0I39&KJ'K3,Ecf+LK-,*94JeLf$m0S@$Hh`$Sb(fD$'Vk@
+1(Ei"FeJe$N9$cX@"3eL!US89*H,AYq,4FCU+Baiq++DcmQ8J!XY8#`IbNY3"Mr(
+qT+jV,4ZBrErM"RJL'1$*"`[%cE8XAV2B+#p99KL3!0b'@d!j2%fUV6!m1#K[r8e
+%U[eiX2PXfZ,r0X3!S"VUZLC92'X'@f#Hfh`A+b8jJ2*3Bq0UeiF&iQ-8j0Abp0@
+Gh'#2`(Kl0BZ[8,dMLZaRHS#0fAQiQDHl!NhMTj1k(B2r`C@4i6USiV'q!a#U#YG
+P$aiClH*L4*l+,M6cBC!!i--H)a%V)b+U*cF2hmXGRB[C16[(-m'+Xc!KCVXb*Jc
+)9aeLak!N$a!(UL,#Q-A(NlU`HJp0A'a$D'Z8'IQ61TNXJ38DRYNf96p3-4l'$+D
+N+5+'Bif%$(B$D*!!0F0($bVP%V+$S`eH%1GGcJIZGJR,*LjLN!!%1D&,F*q%QCN
+3-i&2@D#D3KR41ihF%5U5k*%!k)kY'S#-rFFTDkTFHKe%,MiJLJ3q4G%,,bB@e)c
+V!X035Rq[1!X[II%T[&c&*AJp@(`1489@X99fLP*)ZePHF,T(8H#"Le4qJCL13kH
+#AA9+FB!UI10FXI8PZ%89Rf-e[,2"D(VKibBlAp(5GpGbL$cCpJ!$0KS&JX@GMRP
+3SGC@$-"N8j,0[pUBd$#8FMXQId+a-##6!BH2dR81&TI`85m9L+R&Ti)0I"`I05B
+@B#R3q(#IQ#SCL'$XPVLNq(&jLr*9E-5-8k29cB,'d(qcf'kYlCL2P@em&pYp#1j
+VVcU"Gc"hBN)KD'9JB%S-pcDG3pZ'8iCr+8ppb$NdN5k#`&Yd5Cr[lHI#p#(E3G@
+6$m)!+bfZ'VCGe@4a9D[&95AR%1`+fEU@kmT$fSC4KX89`jCA()f)Di@2M[Q"CQl
+Hm*J1&8D8l2iLcZiVQc"CE-*+$RL,"R-Y$2%YN9d3+"296`MAiBU)!Ia8idGk')+
+r-0$V'P!aA)N"5MF048#*#fPj1L0Sr-c%crX2Xj%h%ldqaUY"6!@l+@%[e1RH')K
+P!KL08)I9&PpRG4KABNZl3e*Y+M([6Yp,jMHbh5Se6$d2G9TYm3&@TehUhZ)Gb)Z
+%f0MF&Yp,VMF'D'!Y@,%3c0l)I!N[*!-%0B$K0r*"*S"K#3H!Z&PpL%'5!cp%[f)
+@0`$)286bLr6`G8`RpF8MpX*f8Abmd"rXB*@K%(Sm6*p%)$b+[IJ3ZYd`DVlp,Yf
+VZBZ-l14NPP',M&CNe%4%MiM"Kr-q(a@EkC92T,f6Ji5-TRi`im9S5N&'HV"6Me-
+``L#a8B$+$`NB$a0kf-6!SrkYq0`cK03)5C!!J%82EF+V1`YA0"XCkF+!4IF*"83
+(1BYK(dDfTG8jZ&0dFekB46JBV$X$`,)2lV&9U5kch#l8dK$T#,LHBp9PaA1-mR'
+!ScXb%6%lf9kF34SRpY[c'r#6$hDM!3kHceiTV"bU$2(V+fPJ-Ni(ff`61`kj#VZ
+cm,2C9GPGMCpl,9P[!5MKrm*'e'ZqcLqi%SIH6S(&Cbm8rXS50RXV'd1TmdJG(h4
+bpAH!arXlMm(SPIKCDI8f21kRZ@kF2pK3#c)3[NK(cXPESBM(80Mp$Y5CC*E9Xrc
+3rGh[C1l*h%0rqN$1,Q(5$TIf`e$8VRQ8!69qQ)[(-C83Zc`3D!fLQPY!V`%,&Bp
+ff'Z%Z0p%CUShc-e-ChHQr[BQ-[[S4aEjReiM"kFFIa@cq%`RCC&r#!6jaVXpkX[
+[`Q!k(Xm08c!`IU%@`AQBcFr-B`HURj8@*ZA,'d0e(Q@B!VTi"bjH@iQVHNBr2#C
+2jZ%,Na'P!fq`FKdkM+*$$ffdYK)!i8PqQ)Y,5DCMh!(#AC&ckpKb@ApYpfBd6e-
+bhCr3TK1dk8jXqTLbk3lDG!HaN!"`L6[HXffl3lR@GP-ZNr+@%F2h@!`2GXJra@M
+ihNQ$[jLJG1%lV[,JPHZ)T2)@MR"'Q6*")QfM6"D29YkZa`4`[`c!23I!+i%bEKJ
+JIJU#'9LDKX*RMIL"@F4R-r&6!S-kbmCB!)&lfCqAmd36f)f"FB#ISGF-C'1!@l`
+[9Q1TJ$Ebi`6e%p3lCpd+8[cT!*A2ld#aEbJf@4J*+f8$$mj(c`1"R4mQeb)94e@
+N$%Aj@'*Q0-$96L3!H)-)K)Kq9XV9c"2lS&!S8pK3-DRfM9`8jkA9afX,hmM9P8e
+d55)(G4K5$PLKi&d2P3%BF,pE(04ajPj-Rq6FP-19IF'i+(h`'KX&iJ0Za@RBdJR
+$PV)4KZ8l4TfXX#42C`CBBKp(q5(`,l!C(("c,dbU)C)5Id5cY2r"+A!SFd6h`T`
+J'fB['ak#!CVe-%N,TXR[@!'UJbD,JF01@AJ%`Zr%)-jK)dpIcmjj(Sq*i)S)EN-
+@Z#JB&Pp*JkQP`Up!*+`F!M$Jd84TCiQaD5HR+cY2deC@mL19('jA959K&2Ae!NS
+F[UE4l1,AME@5@#m6)hDjLIimKH@ER@3&XcVf)ED%am'@Z9Q@Eq31cb-`Y`,-6mE
+mNXHB*1*im[HQK'Z@X(q2(r89KPR1'[c"'p)MI5)"0""5K[$r%5mB4YV)*&Kq!!a
+Hqd3#N!$c'KadlKNJjdb2l+aViCcT4h@2+0a4NYd2A1RVhXP1Q0hES!TbG0r&b!6
+Ahci'SM+Sh$-p+ph#JB$%#QI`94kH"@(cRNr`Cf#FX(c%'KX"TZ0YcX+6,R!aCH+
+(ejJbKX['kS3$TMlajhJJ)bdpbCY2`+#X*'SHimHFKBQ"ZPfj%"5JPSpK3f%8MV8
+3H&L*U-f+5`Q%`lr$aDf*KfJKKXL3!)diE2jGjBj3$dehGdLEaJA6#,(cQrU%l$K
+"(EN5[,!M!h`Uk!")DqA((GS%kE,EB4PYr*pc'@dS)V8@4YUQGaA1HPCKb#59S-q
+QQrL26E"c)"jE$C2NT8a@ed)jb&@F[f@%@mGjADQaa!PZrD[GJ)DJR1c[%aS%efX
+b`#dll`Bi01ETeU1jR%&dE&#Ba`#QcQ$0bUR[&$fid-BB9e"(iBHF9D@!V9pl`+B
+J1339@c-(bkqqeYmM,J+&0-X6+XirZ"",'X[++%)!a*UlmepL30Z#$hhh#K6U'`q
+LH'&fXc-*AccY*3K+,jlBj#'$L8PbS4XIrXrUDM,BaApbaRMbbF'fX5k0aa*8&51
+M-&P*ACJ&kZGT-6)kT+YL%*pS-06CbA3YPJcb3cApcZbTK8(e0q9!J-5ELjqLi$L
+!B4UL8cNjMH@Ni*fV')qm-IL[8*8Bl5L4HV5k,E&6pUS[(Zc,d'f)$C!!DpmS6Am
+68lp(8b2bJM,%(p$`#M8i)!cm!HE&V`9$-"AQ0qS61"k2)#S5I-%fq9"-(qAT8-r
+PDFDA$Ni-N!$XAXb%#aEmiZG`4hK%-pj45q4S5@5!4&CESjiD9CQJPN'Yb30RjL6
+F%2RaM@&E"blqZ)[J,NEPXBX+XI,*&$NEF+6+1JKLSfc)$K%09p*""%Ti9L#N59f
+b%q)@I,a2D,U0rY3GHHPkQ*9c3p)2kZTAqZP22XP(%UEBp#bZmGN`CrfhX(XBrDN
+X#MM%HVNj0Rcp%Plr'H4U39[Ck*,m4jPSaKZX0%f5VlCd(3-%1iM+3-8",KJD[$$
+'$cD!)@dZQ#"FcQCQmmb(H1KI92rU-rjXFY$LNe4"BjIYq"JPbq+Qm9VmNj[L$QS
+DN!#*X23F(AP8RXL%B'5*C(6)c&RAMcAM2rL0R%JbQCC'U)YG*Yl5&[kN`q[iBE"
+!"[Q-)Y1bT)jh[`rh(EjbR#CFN!!(+0XZGbhE)9qKE)1mqE*mMBI98*Cr5SR6'*4
+Xq"G+-N,L6pr3f*bNCE1r6E*4V'ECqIPTXmB@")0LJRN`UZBB(A!UHC6r0qe@dAA
+,(iBD2$,K%D)c,eJmD*-HB!!`M6-#J"VhBk1,R9[PLRGeRS'mc!jN)([VHf(f!+B
+cCbCNShp!PHbJh"EX(HK!bD*pX+J[Rak#d)Y(A%eJUj1MF(+#!I"HYm,&,Dc95ki
+-cQ$+4JV&Qf0c#@ca"mJ`#adUXm9XDSR*2"L8rc`A2$4kXDk8rc`BrZ0Ji,kh1"r
+'VH%J@SE(0m2809GdI#Dpq+(%#@c`2!&$+4P6LR,L$"E$DADFd4F!i`I&0IKX9$j
+AdDH%aa%AL$BT%fKHiLCAJ"YL)9I'JTlUd+L(#99mKBH2c5!MJSUBX(360T*0lY9
+I$(!5hi5,CFKi(LVH69bG#B!%BiG,0c(c5Ef#T'hM6fl1c[Q[I$JIJT9*"RUh)AK
+[a3r-Uk9YiJIPik18Jcb8GTYQRQIJFB(44jp1*)Sr&N0)*K&VBaG)F[CDe[h2$VM
+l`I&'",BTdeB319B%G8h-j[J@)cFH2"MLiPFQ&8r!cr019!QRKHIGaTpD"8bi*A(
+dBSM1GV&VjR2mm)$35Ilc@b)HHXJ$2j!!+Lj1XKh6MDKF2b%)S$LJLP%&iRd3f*(
+94dU8Pl-'qYQTI#BPf4!TBcK"m+MNj3[iMqHC@+L3!0&8IrIrJ%"`(GPN+-cjeH3
+BI)kb%6ph6Kc-4%DD2SA&2`!!-BP"4%05!`"B)Jp9$@C'%4!KiqjKrffrPUVdjZq
+k[VQHj['jVUYkUVCk3I0%GP)h"Zc+!VeZ*V1cb*r(e[+3!)lVQlQ&%-)9lHHA(A$
++M)K1McJA$K0VN[%mkf3HYa"Hcm*kK("k!b1%j9Q(dB#"*YdNlh`c(Z[[hprrph8
+G),ql*1mP,cm!&AGH*2-J-L)5)I%!%5)'AhPG*Q-ar-LqCJ'NQ"c!*L')CV-(JC2
+-S[20R!1c&,&8JZr0qr1q#52iqmk#M2G`pECDKMbLd51Y3amCHVZK48lF$KFUBV(
+IrB)9$i+jGMADr*`4l'rh@haI,j*'%1&V@$'3!$VG3"D&JAKK))8c#+3,I1N**R'
+qR0U+J,#d[d@@iSMNQ$KF4Yka2ZGiShr!2`#`r@&r($qAeDh0F5L,bQK3@RaM-0(
++iVm'I"EQ!l&N"+cJFTK`k@35*Qc#G2I$E""9ifAHl#RqDeZ%Lf9SP9)$-MJpFG4
+(,I%a,MkL'[&(2c,M3"SY[YDM,QA4,b@h!L#Z%jG$)#S[5Y8d3Vr[c#R(PeXFh5Q
+'2B1c&p9G9m3$fZml-mS$RIS$fR6*8CIT%CIaF6+LbT-UD*qdb*i0(EjQGF,3E#f
+b'F&d-d$N%%((G3LakR`CBrj4Qm0[*)ZeU58Cp6rXD9CVUILMYU@lYJ%jEKQh`A#
+VM&"r&`##-#p$%1HMj5%5b%2'aX&Z,k$'M)!D@DbS3(m(PYUc23a'$(r+"[qKa90
+L"&8#+92@`D@PLaQ&*2"5K(&fK("@jrR#mUhGNd&1A5$mrLahGlrP#DHa(%U`eCP
+AHiaN@cY!iqA+)aH94k*B'YKlIc6Bhf@%("E!ZZGZKp5GMhkNDJAYqIZ65@@"Ab`
+iZmY)#PLI$,5'$C6$b%*1DM"$ZkfpXGehK8d@#85Y+,,VLqj)JfA"Cq5NfAD#LLN
+Rl@dR#[RK(!F6fFLNa$59Q#E&G(+j#d$#C!#AjV$$bU$*'!cfcqq6UVYPj#X)%Ph
+-b2#+dp1Ke1PBc*FdU,!",Cj!+UX($1R$aXEGV*TU[$PThAQLX14G[Y0L,"'`a[#
+@YY-#k+6ZSVbX!9+bmX8rDe&65br&k[aCP`6jk9l@[9$VeTUk@9K)h@MH1)SSE)K
+ZjX8Q8XjV-J`$#MLkHD'CP5J(a36hXrM53F25SiX,ZFVd!K-&a"[%e%V6ZQf`IPD
+*Na&-cF4d3N`RT9jBkej8#UXUKf,k,+Y2*X0G*(Mab-1+i+@m6SANB`(jl+1Kh9r
+-aU(ZjI!m&m2V&R8E95,U8dG$[-%XNKld`+IL!EIjqc9)K*!!`,E0meDDcQfhB01
+Y,&iBAVH4cjNH,eq'J2'EFcNC&U$JP#CPf`RHQ(rH*`Vc)G@Ib8R$Nc45E4dXEM8
+Ni%)Zq%PF[!q9j1+H00'P@A@'HBT8%J6h$!`(B"+JPFd(8%&[QSP@!CBmZY$[FT8
+b+2+p*a)&A[8R+QCdKXSVA-a+SI+(-9'S(VdU&a19GSmZ[p%#SmIPTUkj!P)E,!4
+[B#U#BYLN#,N5e@r&%DKq)DpLF5(r5kZq2+hLP0EibNkPkS[T%,@H''#Bja9@&#J
++L*+KjpS-EAIQ6TqINkC3[6[R!Z-Il@kRi)HCSAXC*"b8`+I+@%)+512ZiZr`D(i
+NfX3"@2Lk9f2QbENd&pm@j1,bRr2B,dAHHpL6Z46&6m@P)(jFkV@V+*KR0Nk'5+e
+!A,'[BG2fM&4lMhe9I9TjYI,B9j8VP&I'XDqqkPCHK@KVMcVZT$TiLlj`!`+TIj%
+aVk%09F1N["J+Xh0K#i2)jQ6TZ+faBlUdS1fqEd`"k,*Yl5cFbldEUaTl0eETld,
+eEk8TQ`mJ0*Mb+r1,%1(`4KBZ+h-#M(-%(Jq`@[@-U%9A@@MDC)$)%SXcKDVHj@d
+AT2VD`9k[Hd9jR6rBkkpZ8PjlMhN0#(EcJ[)b41c'SmaBT&IH&)Nq4m&9'*9Q9iZ
+dcc`,!U)F6N)SCh)jb)j`NSi)R`'f!da-%2U"M`pKNQ9@1@9EBT!!hK1@lG"UH)N
+*k,d4e&0iJqi5P-jb&9c'ZqJ!p`&6S@-B8hhMNq&*1mMeZl,e9-2A(aFE5$K,V!$
+K0'(5GQ&k@+`94G'GFc$CCFBmZY'+l,Z5`hmE+K(QbL#%"R`PV3SK-625h`&J--S
+GbV#S5+M3Y"drjUr[389SEb%p2r@hBDX5r0NTF9h$56ERf8(#Zl3jZTi$qkA0N3m
+aUIV$!55eB!k4-hmii,26X9BkYY9SGdZmm+'6e3"3V6A1piiM`,B[b%K@U$L4CK+
+Gc'U1GiJ8"5H!(11r2A"EQ0Tra5&HmDSi!(-U,GE)`0Ld9T+CMC2*hBAaqG5cJKN
+kSU3HAQE'Z[,rhNHaXD,Sl[8L"$(-(q0cUN9bVV*b)66h8UaD(FF(NcrF$Xe9aYD
+TLhT4c"Dd&MBBFAKaFQpp+,pGcYR!S&C(mm&B+&q1@e8RZQ"PQKKHjb+f'-ZE10c
+JJVB3X59@+G)UraIr,r)rq#pkc(p"j6m0r`A`Rhj3eS)8NL@icl"XK[29`rK$d%+
+0`SSN@&!BY-D'r!q(&%1ZqBG$"cAN(CcDC82q,b`k'ENah+SNkHT51(blR+lJb3p
+M#p[qi4!HZ$L-BqBLUABTbq@d`C1rM5eB3jCB,#1,NmrAYl@(X-$*AD'ZGiU04PS
+!F@NA)kU,Em15EU2U6%UB#Gm'`Ci!0&GZ0E@3!'V4T()E8+fTPVq'TFAU&V5,)69
+j-FTTJYLk@&e&!#a-L!,DqmD!k)Cb1j[G)cCf([%iUA1YT-lPSXlPSmjeQ6UAP"G
+!lKV"f2mEEa1klIreRcI18rKG9d1TdIrI,j9d-bZ2['PDm+Ki*0&G[1+44cMerX,
+GKYJPP,@dlDQYUL4AN!$*j6#-C230p&K1V)DjXa0Kif+CS!)aUA$LDV0m!r'B9#G
+i%Q(&MdP8&Mk6&["`%YDdYmL2fB%MHLmN'B+`JQa`JT*[K[R&8N6L@$im5BG(eDJ
+M,Pl4NNMaah[Aqj*f!QELH1dP"@kH3rV81TMb*6)44M#AZT6kfF0PIrQp*8lU8J@
+1fISA,XGL-USLmIL&2#BKGi3RFqr+k#)+F-1!akZNi`%qI"GK,C,jH-P-cTCcR+,
+qEPk'`1kC2Jll+SpJbVH#J0"fhQFfiia%3"Q-[FpN,m[TS$qmaD$a#K5+hBJ6l,%
+-,T`J2M&Ei5Dl8RK5R*4MYdjm2)$$rq#6d@SiX2`"j-aJmJD5CJH"5[*aUScZ"DR
+E-4PmrMk!'CYalaQ&4IJR*Z)6Ba+ZR4X"rMmFaa&F&)!mpf`M*RFU%TEfXGJMA+"
+YjiSLT-6,1-$#NAr!RrHcpP3Hi48cY15d`Xi`fi)rQf'"1#aAj6-K*E41$BHL5iY
+#8-[hVLH(`I98i+08i0I)H1$S4ae-bVh8h@5NP6SI!!J!$HkX[IL2'TG!(ReCHfq
+qZ0Uf"),H0S1$'3+m'(heFm5JhMIZI4IKq,#G`6N!H@&M"Kqd43BbFMKNJJlaCZf
+1I((%FV"$USBF8MAd%&QLEd5qQ,k4iXL3!%2UKKa5Gm`KDr50b"[T'bQ1$MQNGXJ
+KY8-18BIYJk39,r*`[G,i%"D*CfE4`XRQh@Yhh!H-Q5($K0[,H`K&h&(m4&8$KUI
+"3+a$6DIb1Ged@'3f)E+*[HXpeTQPJYc5[[@qmpl65l(UB6Yq+[[cLjE8'"X`3ZV
+hB$SPF#+p#G-SChG2r0Q(2kX"#qlMp"FcNE&pB0m1FCJ%X'81kQSIM'Sl6(NIEVE
+rQ*0NF+p%Z&X2pQ%C`ZE9"VTVE-AZ0h[206%FD&16U9ZX`(cj-a*`h`Sea`UNPd1
+92FbXpBf$A*8a#HZGiXlHGakIlHi8ZB1@B$-V0Z$SD9QjApRk034r4R(HGXlh'Lk
+qST&IpqVGJ3q(+ep8la$8$F#!V84akpe!J4ZLU3'P-b5(JrZ@8(3DG3)%eepYjNk
+!)Qkp5JR6c3dM$`Bl(,Uq*4d'%UPiVJ)!Vj1AC@'UllacbZ9AHh'jebG$KG$cpmR
+8V`pfjiN*lXiC#G$J*T6#IbFi$Kd!4IMCli+d!VDeim9*Aj)!V*0[R8DDpM354&h
+'I'2A`MIi*6VD'"DG3"%diFD,`MVKD-mJ13`JE"[IASbmqU8l1$)lR*@[EKSHcX[
+'*@3N#(Thq9I''HChRFr1El2-GF2-p`"X1&'BFTh(cB(&#KNE"@bL0KF#cprRMFe
+PXh,$`+bf'"`$40+!bbj-k#rplUcdE69#+2"kF8R3e`&fEmTXh,d*K,U%#68"q18
+-'[-$Z(PaG+0D83KFL4cqNNK))%N(pm4#J$l8m3FSjM#$(lM-$Ha!FS+"LXPLb[l
+ZKUi&Qe,!0Gcpi"$&&kLK4eTL,dVTk&U'V8l,@(C3C0AEG6L@PIAhmY9P4I+YHp8
+PSm'ai'8j-eCG4H69,!lDB-69YIK6``'@FIk4%XN+IF!lIZ5`0''L,K)3a!f$,QF
+bd+HEYQl%CAcMBM-[JASIJ1LQ2,-J,SB("KmVAhUTZY*Y'Mrmihe`9iE*FC!!Jr!
+[LFlR%N&FV"bJ!-1UV6RT+I!#GN9hrDREp'lRC8B)")%A@i@EC&9Uj!&-FBU&`q4
+KDj0)ID,DCk[h6!DHNC-%SLkrcNB)V'5XHLqE0UTC,N**``A!`'SIUbjMBM)9b@X
+!K,3YRHMm!iScfrMhcXE1ar*JlFIK3JQMpYJ*CSVi1#4-ZH2'Fl`j*!6(P8"DK$8
+1)L!M4$Km4%EF4$`Z%ZQi8Vb4#-S0K*rR2-A&(q1RU$K*(lZ+Pr0(eFe&APd&9[#
+R8PEAUBmR2N6T`dMLJdBITK)I`[5K)[%K3KpbB`%e!j0ZU5j4ME'!1mSL9jXaMG!
+dP@-'l(GL'DVYVbjcG*X`%Pm48VaP"3H)r10'B%XRM-lekrY5+XTd"aGq`A6RbC3
+Y&1l1IpJa'@5QVkeM8U*T!94`fdQ!T2&6$8r0XTV059qc%HIdYT1C`adrCPHDl8I
+HJ"VY)MADI&RUc!EFDm+m%BpFYiNf*'8Y40(+bY'6T'hr$ETbZ3M4K9!Kl$)@pT6
+-DflV#iNe6@`$*,Ca%YY8'M[G5f,V)l(G*E%9Np!F*,5l*$5940DV1K,#1T83dd"
+#3#X6SXNQK&+!8,b+8(S53M%63JN*S6LTQceUJ`0lTK$SEpp`#ijphCj@JiV)Zh(
+,Aajr+GClr*ZQE(VM5$f+BGjTmAIj*P+hf"Pf@Kcc0rJNj9TMSm2#h4i0G,3V8R4
+PYC5KFe,H&lJ6#3J0US(CaE#MBm@Yfbp5S"1T,VNpS8!ZJ#Lq8Z0kJ#1X!2dd*R,
+#T4X11A"EBjAcI#F$d0ML@(A0kA1fFjD@kPUR*@U*eFCLZ+Pc@N"ZmMUji5fT9P)
+CmB0erk(!0,N3Nd-B+c8+$Za`JUpM*hM[GQDA&-8A4RGMiBk4F--NeKRe-KcPN9S
+JKh9b@Z!+[A3UFe@"i%D-m`cZ*"j)#8C%GLU3!&h&83m!`T)ha@[P%1[",[,bI[d
+LR[Khm*Q+c[lVXl%U9"r%%+!U&l'G!DfA,Di("!!*J2#h"!HQT9C-)XIFjIa)5AL
+'[mhL5,Pdq"A-!!N,%02N[0J`B#[qD$9k6c89VUV4SSF)CKX%c$L)3P-M0$%T*HM
+-Y$%mpLA*F@dT"4dAkA@4(Lc&4K6BeS!b9Y2K+Ib-b8ba"5a-d565`a[AiY,E6M9
+mIX6e!!T!DVZJ8Zjb9kBIUmFe&P6R#KZhh0FCjS+*p'0f&JNN6ZJ#$"j`YPq-I0,
+0,LKbQq(bCb*VI0(q#ijED*!!j&c92[dc%IJM`BB2D1lc%-#a46KA26ccYVMiBhd
+`69l-DQ!%651Zb99'dM1""b$!aeDkf%9rBHCYU,`4Q(8a2KESifdm-KTT`BGQqM#
+,iKRPK*U2652$bkYYh"eL)hIfbiHS3Fp$I3riTF'(C@6TUBCAcr,PBb0XkVajcaL
+1cFLH8`f,0[(+Hdhf'2q%"j!!DX*2mYGRC8ifibFV%Icam6rJQq32q!8H3JI62pZ
+P$cpKHGB2SrG0*$DBF2'2IH[1rXJDN!"YG[3EF5H*E+qQQ`QkfCIKQqE[L`ILp2&
+!J@p+(k'25b9b&6kfd32&p!#Vra%LqpYj5QaZ16hJS`IfL)@4&X%Li)9AX,ad8k#
+E'Z@K$a9RSa(h6G&)LQl1dJhJrQLBa&SUQ*E'pJ8l'CXT)))q'!K5bNiXX[P0c`!
+BLYA-"U0ipKRaiRcE15C!"S$cf)'f#lLaRfVB[edK4M+bcl!c('[B35EHcc"4H[r
+(&m!@Ii[%Zjb2`jmf((Q0(3d4,Uc&iKjDl)ET,m1&Yq2#cX*mY*h""3D1!!lBH4+
+9RT3!*J63J)I,+4QdKiiZ1p9`Z*6"A[6L,P)Ga9ae0*l`XY+k2F[`,iU-(CIf'Di
+X1`I9C#dJa0IJJ,6$(9G8T+Kk+cHU-ZcS0#[J"2&q8mH4*JiJP)SGGHQ508-Z28#
+'Jc5pCq@9b&@0&aLQY)"b544DBU&`JGjFK-A01IQpJGJb1Z#h2Jdh+P)1!"PLbcb
+pbUBQ5#(B!H+X10,%5FMBDLGA+IlM*UT8r%UNT2j`2EE+$mCj%YZ$4qU84kV%4iK
+E6%a&0CLiP&bhAe`F8eidiKp&edSK16$+AH[TY528YC5ZRS*3&lKl2Repj!&ZEJp
+fpDH[d+GCdG'I[JRfmPQK0TjqEH3"%e485[@%LCcq9Qe@@"@UR,r**mMX6P*S59*
+%-&GX2m4++-dj+bZDeic[ELBhIb5k*SU-CHfc`d`b'lYmSk2ajlSDfUHM0pS,J5h
+h1Cb#!SL$Q!@Hlq3JllXS#0RTq%##('MAdKScQ)UEp!3h@10N!eLR#VI4B*QGbma
+[lbib9Z$BepZCf&-3NC'Gl,6ZXiTQCm3NXFX+8Y6Nk'%4$G(#D3f16+1)NVr1pKr
+FS`f%del5"U#+8hrr*DNpmSBaAf3diT*rr`B1#3qQ0kh@c+#$5*`53"22D%KF+Ha
+$E*JCGM5XBp8ekcrT'dDhUk+%bq-JAbBl-[hd$$p8N!#q`XcmMp!B38E`!f!-2qY
+N819dSmCGA(+U-eQ3!2jfRh9brYK,9A0LG)**S09kM)0!Z'+-NrbFCRAf)Z&N,rM
+GVBrBcL!je'rK"2eSF1pI8F%pKH+Z"32D@3MX[Xp!4$EHH(V"cNR,aY26+AUS&Jm
+pTFiL"!`HrK)9[YPiqRDTXI&`24FjhbkB4N!j@MjhDqpIJ4312TlK`fEC$DP'@8+
+ITLI!20j#8iFD@U,aC5#dTh`bGJQ6@XqX%GLY#jA"ZVUSK9YrHC*4"A"@lfC$R#6
+h"RDR0@"jhH,XK8YR(CN%6+jJ-NQ1YY0LN`2iU)82S+BepVF!5IkZ2&C&a9@(#UG
+LAcHi)BK)jeHP-@i%iqIBN4pX(X6[4&&RLJ$RC'"X-SZ1-bCcP%k[B4FICJYC@#!
+!PA!iDhC($ZA[rQ3J-0iprK-81C0ldi%NMA$G)RHb5VeC%%'!V@#6*rlM-U$dfS,
+SYXQ#RJ3q3CIm'KXAXfLLBBI-kHcDUBEGebPY,RdU-lPJ[RZ-HHlBAV2a(*b&Q2b
+dJZ`!NZkr`"8pFT+f$fJEA6kR'SDpep,BXF!%+YIE)R-)fQYl6kUk-eA5m3D$(!M
+C9r*@I!A96"aT2Yr*abSA6JeHH,DF'$EG@@!2QqXB#K-&QEZ-JX5$'8-8*UIQEk%
+Spp"RTm%165K1DR$-l(*iU85c-jQ&bQpQPCrZ'J43dUXA,c8(+,0+"Vkh+-Pf00k
+ja`iJ0bj3)bf#qQ"Nf$JRe!Vjl,b!B1(X&',&0BS'm6iR16(C55#l%,,XZKK9P'N
+KTiZP)8l03%afRc[U@&3K8iK6pECa-f'P%F8H0#GPjALIhA"10@cCUC!!pFHj`ab
+jJ)*!)L'69je82'CEGq1Yfd+0rd)GjimrE&+ea4rqTKZEV&)+[C8+c8`)2*836M[
+%MCH1*[&)BiY-6F[U(8-#P$T&M44QlLdb-cbDECm*BM*QYRm2B6*3aV#H4Q!(,Sm
+$P@hQK!J$C-2#F6E5eXj"Uq`Tj%f'm+0`I"1TeGmKL9rPadH2q2!S2T6JS5!%9CH
+GT`YDp"3)1C@@NXS`f9R,hdi0e1&NaZj9&CrkQKI4c&jkMI[qAXmP4A#2U`jf"MZ
+(VSVL6Tf4T9*e1FrhRPrjU4R(CIjGQ!-E`bHhf!3f@(b&a@lPS$ZHR$M)Nc*(CB3
+UEP'Y-i"PeEL5!,S2)d%$EVJIe[YlI38BS8PXKpdGAE633G5!6(4Da8dP1X3jU9i
+aIQl)Q)%bb9k@C&SVb1"c"UN2N!$p9T!!r9D$Qjr"PElB22)A-2Tk)`q'Ni'Y6@U
+5!XKkr0QNZ!eCS8!DXI8H928pE+f((!JdGaCE82(a(e%Sfe$il+VQa-([X`+MlU8
+djbI&e5-8&aKA(mM2M'k`bX!$jH5d-"EEK$reHY)Il-FrSJP,)iH%k(VfUkEL#$Z
+DJmX%3)ZDf(X!,lI$4A92V"`1ZVYLCHbQ'b["bjGM0@#(NJSM*L09KYeKDE`e1i$
+MAmDIrILcLiFmq#@A,KPbk8@q0#UiR8M,bmhS6YDaf(XE00q%2`Jc1V!"Rc&C2A2
+(VhQX'c52I6MJZ#1D,S!pAIEGCA"@NM#P'Xm`rc4LZ5F$J$X5Uf%h+U!6Ed&"m'4
+X'jB+*eTD#YJ6S&[ChR&ZE+Xb8e[H#p!cDalm3EL)Pm'BYY2&[-V&A[CB$lDK'3'
+F,Z03KCZ1mL8J[P`KVMG"Ll1!&`F$ppMlNmY*#C86%`bJm[GRpG""-RYG"c@cA#J
+TGB$-cd6$KM,4)"-U`TP31#UreLm%CYJFV0UFl6HLL9qCEcmfe!SeC#8bBb48N!!
+"&@3)&45V!N(K-+S5cAYU(#F,pJfhTZ@k$iFSS[@k5jAaK'c0X2-+KcRVL95[SHk
+bU8KdPhC5MZh$l`UR3Ma3,aJP&02laT65A9BFT$XXSqiJJpq!8XNUAD*4PF%2UG&
+0bf9*,0"U"YlC[%ccLV4+a@8%3BQZpP#-p8,Pa9B8mR'S0b8"fL-DXK*m8b"SET4
+!Z9I82MVk%`KdYATh*JM9qJRqV&EpZTS-RP*8IKHk!NMCG+RZQK,FGX`V0[(9iN!
+eS9D$c2*riU%ZiHL#D&Tqc`ECmTGRBbh#lC!!#dT4[6r"`k["HVA1(!F4Dp'*'%*
+J-&")A&`hi-!1TMH2elp3QJ2XJq1FqBJ0k9X0$4EfE4KBD)9$8+KaB0Sq#YJ'M34
+U$lA%eR0LS-%bf&JrGXJ[ICUrhrFcX-P`beR*a49Tb(Y#lQK$h[FD*hPJI%&+64f
+JMf#YBJHHjm6Y!CK"LVI#D5[aq8J,J3+fV%PU'bR%-p'X)$T,-2%frc83'bRhRG'
+BlH*Nmj8J8XeKE[c168he)jd-UHiM"dY85EKBEV%mDQ1S&daI(SY#rc%5Dr1&AfQ
+&@iC0C6Ce'C`!IS*+lH3'Kh$A+eHh1DGkTeDf%URjH4UT%8N2*MEK9`*d`$D&R*c
+)-%6I"MA3"RIp8R89E6q!lFGjFfJqe()QLNl2-)60IpaAi+B#(MXqEH*2Ck,%a2i
+fYNC0dI3K6'8NTDL&M3QP-+1$hP!$M9#F@9),0P),YP-0[qY6h&RA`,%G#T*!l3Z
+LBh!k8@E9diTkf*LQ(-4&Im%APDq6JYJSe!-,"FV"aL'rc)+*c'BY[cQ1#Za5&)5
+KQh'rjB88KFcmMJmUJEVi3"fPT)ASeRZS-`pPr-S`,)G9"fMiD1SFXT*6SQZ'0Tf
+h@NPeQ+3k8JVBpeQ!I6i#qciR3ZHIZKR#"$PUi(5QCi$#i`'#qel*"&9R392J2Yk
+`$[Jj&DE5#[D[hG("i"j#ead("rFL2RD5,BVBfMhK*)(8dMi)c[&3-Eb4Mc%!%!0
+r5'ip!AECC3Kh4bZT&6r"qaG&FPpZBP9ep9hjUH+5Pe)!EcX65Jabi54)#+`q'm!
+NNTcIc$#Kc("6J*Brbm+k[,+`k%qqM"RFIp1`F!`,ArQc,Ia+VE*3F6FP'$S0`-J
+F(-$3")"KYDB$')$#P+CH02M)++Q60Lj##0[1$TVM,mP`E!m)`q@-R`I@Z#`jC-i
+%qc[8-35mafp2C!,p(D2DFef1EJ5[28L'hPF5Sp('il20ZB#MLer[r5[peE+1k8q
+-`1&1GYI1cMFHAj!!`H[Fd4Z26mZJTF!+%iN!0*!!Q'#&#68KJcGCRG,J5kHJi-X
+94B@KBY3i+IYbGFcr")B4bl!DTN0VP50,P!2VP!2VF1!1p4!89MNU&GH2B[D),N+
+U-[Ukk,UkHrPZ#e6VGV#!&NUID&"pB"MQq+(J(XY+'Ef$0V["k!"DM`@8*N-i9!3
+pbND6rRk2M+lP$@*,e+"-f9)9YV5Ah8FE"aDH`b3*XV(cQ)dT+MbU%&bSjI$3V89
+fdGD#Y$8E05B#!dc#U`4TX8'dCY[e3[kLc!Ah[M0%I+(qMTa@hZhSf[X1a"FkI$m
+"98"mR&,Reh[Id9me3(b&d"@0)3d#55$!b#'#55$!L+h2Em4[KX%qlm#fA)12-Lb
+Q9'Q(8Vaa8BQT#[)B6+%U[+L9UK+PUU`H@XJ9`HKT'I2ImE&K*p%(l1SB9hB1eGY
+`"aZC`8ELMAH`N88K#N%qaD!Q@'$ehf+h(eldk2qq+$2q[LR9QQD-TaI#C$LRCm1
+1EL2Hf,f`PhrJ'&$#30c0*+GI'#jA,r'(4)9#kHBbT%,#X6##kUa-E28i0pQPVD,
+)j$ZL1-4@pF@mBEGG321+5pfMkZ0`NQKc"cCB`#"S-"YZ`,XGkE8iTmV8#KiJ,"Y
+R-'l1JV!RqL-iP'%5a#5)53!6$C-`*J&-2[i4Zj!!S5%&*KXC+-43,H*5j80$0(*
+BYbSTUK5D#fKJDV5FI@aqf5h2"&3ch,#-94MkkCE2ZD+E2J(D-cEaB&#qH)%"2aJ
+XYTedacCB"SGZXUE"5@Jmd$$4`)#4NFqih1EhE9IJ'Q!bf&8&jV&Jj0GrKjPPT`X
+*DRqX8SFri&jh@53C#RjeN4e&j3k#)KQ!21hLBEeDPD3aZ3HrfXQ$E,Mh(,%CB6a
+FldipBJ0T![RDbSrFi`(k8Kd33@"k"4a"Qr@%BI9Q2XaRCa8)dd!)Ka3e!&B-Ge@
+HIMXp$M&8&4c(Aj8A`0LpiSl--9KIkad[5[hm)hF@!r)K(2'1pb%KbMG`&X4V)bK
+H'0dcHF1"C1d&ESL")Ep`f2T4)jA@Z++1#fZPD)JeF88D+5j3$2Ph"`eVeTjUq+0
+G$0l0"AKBU-2R8'8AX`Nl1`Y,B1q6[XHK*T1qVj(5V()q!B)2+0f)$eKqE(&B`+C
+9Q3cY-#K6q3bR'b(SbAN-3[HHF2r*"XCYKbfd94H(i'fGKIbcH&LQ%2lKZ29qKKN
+miZBl5(K11(""Jcp"S5&YS3e@463&B+I-*eCLif212!r"KH-GqY'm@Br@MarDYTf
+U-!(@*L9Jhq6Q[JGT64BVGHJDA6J1KSJCE(Bc3DS!JE"%K3!N9km53,+[K`NY[4U
+MbMEMj9VaNU'jF&T$b-&"VKK85MmH0pDEF93`!rH85LjZ`maBe*j*[QLVFM55aGA
+MbQ8[+TI9Ab+a8Ce6AVif5GY*[%4$K'T6H6Q$6J9"I+m[Fc8"G&CFFKHlZDYYC2F
+[%iqe8YSja!*#Gi&S-6KJRG4q`%RT-!'1#9G9N5"1VdbLL(ap$p)+TDr[35*&I0!
+LTS9FbE(%3Uk@NEMPLX4jqkdh#PH9E@-BYBf(A!m'#aTT+3D0`fJ5bJaK5QdQf-F
+eNhmk,kdc!(%if)8)2X2X5pm$[A'%Z@J)Nq2&JTNd`8cf`M`HChALCcA*5Qf9mQU
+PfrPhhX+iXGbAqXf$9eC%MEQViamKJFkT"5QI02U0CFcf)U%,9U[R58ScKihlQAj
+12I-J3Md[8Z+i8L6Tf4AQdc8Bd"%-U'm'J8LYm4crrf9f$IRdMj8K(cre'eFRT6i
+!j+GhqAEQE4a@*3Bpj)9[MD2DfNb1@%'`PCY,qM"%SC(d#D$j4EAA5!T9`afNUA2
+U-LIcT2%GGXh`HkIJBT'#'J%,KdpS8L-D%%fLFBZlP5HF,#2h5k4Ef+%"BVRHakN
+aVZKT*-E!H#14VaRRehqH4DG80iHd@j!!#dqi&aLIF6h3%er#')VNXrFL(q,2$EG
+m0KrjmjPh)fYrL@#h#F&5bVZ8a!Y("0`8dH"0p@$[r8K22m3GI-[G[JF(%AXCLje
+*%EClV1$hR'S)Aq*'h8F*rK0Uf2l*hhNcidEUB-+2G"Lp*2be*2)6*(!-`'PpL34
+H*EVJPeFS`TiecZY$0AUh'lhr")&(eT!!`&&XArjD3Z"mkp-&rZ8`#E`'S(Q01rp
+hAQr[jmIK+"!qHN0`%@Gcl*f"H`'!d&ii%I5`U+TfdZ#LCGcJ@M%-+3pa'1c-Se0
+Gd98qQUSN6)5A4lk"#X'XV!Bj+*4jHqmGMVa(*S0E%+m80T12V$*-RXK$F,@Q&"*
+prQ$Q@@F[Nefi4+bD6)*N9@*jbq6(iXCGr(-EEL#bc@fF5#j)Q"8ZpU0D0L[I+"*
+[0b-Yk&TJf0)$eIm$Tk4[2a$0#J&6lZJ64JL5CNb4%9B*%IbSrZ"'5!T*`',,2A&
+R2a%cKf&b-j!!MCrcD%82UGP6$D&C%0)8f!!(*mpHl64k"B(KKN3mq1IQ*f&drHX
+rciNUEJ62"UGIU#rY3X`!iD"iSCHGj&%GFD'eG+&A-*KX*AGAA!J9MA`$&h)FFb%
+E1R3r*E9$aNhCJk'%HrQbQ4Hi,)1TNJCT)AFi5P#!f$qN3Z8%QQ!!JPPEaFcDi!#
+MVBNKYTL"#Ud@3pRk3X3Dl4*$d[)2ZU!9)UdM4SVKacTh6MKaC2VGelj[8iF(3hS
+mF!mEk-B!!a63-j0QQ)F&+e@VX&,A%fa8c9!fkNT%6@&SiQk2b@bGSi--3@hXQ0f
+[6kIc2+JV-8e0B*VQ&+DTC*!!68*('l`T-33$eU%`5dd*CURfB-`5&dB4#N2,-'Z
+%EX$$h2B)*Bl2'jM&9$jVp(QG#-9MG9#4Q`"l`(c51Y[192HPXprk&`$dh8c+2'%
+eKHDA+IUC8%0&R2aU`6!%mUB9!M3"VJPia8*(2),A69P0BD1U"YNS02j-dU!+8m6
+XR#B@VISJ,&Uemcbl%)*4UrBd8i2&-0a[SCSL%d+jkk`BZTk6f#rH4T)C-,%4JiC
+D0R,#B3e$CVGlV+PfC)%I3NSij8RK11%L0qTkS"!#&)AG58i9+*aB&@kEZ8ZQ&68
+$5@$KSkYC$38AD$$ET+HBLK++IGfX+%L2bZ3kC9'+d+)8SCq+81-Lp!mm86'R+D`
+JP%YE8b(23I-ac+!e8@"T$+(Fc`aKkj!!)3Xi(1+ZM3&T6eCFa4EI36I&YT4!kh6
+EK8cH0BA"K&2XM1cqS`mF+kqkB`"DSC,Ir-ALeA%'[$ZI#EcjZ[l"0d*J&!qeB[*
+Jd38,GmD-%'mqmGJFP)TrF[l0#r`*3iP(hicKd`m+8UKkHLL1*JX3h8qV'&b$fQ-
+e&&Z@pfM2K0jm[H%d*S%hEk3GS!fQM(8A2rmE''3hM+@Mq21R#9E0j)%Hq)&[BcM
+Af$TFj-A#94!jGZGC"dDRqMFBTYBL*bZQVe`k1r-X(VU)2jIGX[lc'0b@h%JSZA!
+#DDQ,X3m"ZYbBi3%E2`YRqC93'4H3!,UkM!6AFXqFG4i$YTchqJ'&Sd(#qM&q$!b
+0C@d+L4`dL2[9YFFABZ[Ka0SbIICf8@b0Mb&k'KVCJkl1JeQTcX4MCZ+a%$m'T`5
+k%)BB5KcUf8Q,3@$-#qj("90"fpa'$mqabffX&Bp[JcSc8#d3P`K-Bdk1Iq3"Zfb
+1k1T@$*1VUeZmQK&$#@2"#9,Q)5BRV'!63`Ac5hIL*4,EcXmN&[A4Ll!J0%FY@kQ
+rrM8lpfPT#ifdKH'M&ND(,%blS#a*@jJkGU%m0'4KbTPS%NH[0`ejEDBGHb(Y@2Y
+4aeiDXY!qH#`2hEjm[I%CIK'P,UKr-M,iN!!BI)6*@3%TD2KmcKGK80aX2*@2`-R
+"jAHdEqLBVYh3-DXCbI6"4hKJD,#'la%cc1""-l'+M3K-mX3#[LZ+QiD#9Z#%m1+
+9Q$*XX4JqPD$jf'-mJ'aNkfm%d`%@ae3krH,9Cc64aAP!F5B8!"e#9f*i["jNS)5
+'$m&3m-2,)PP",#Df#a*#!r(HP1B)'Mq#'DVbrR(IR`Sh&Zi-LJ+&bT`SJmU%dJP
+HHhX)#mSAj1f,Lk+,,M,VY1iNA%iaLC36ZbGH0EZca!M1mN&*mff['-EYKBk5Z`6
+lZHj-Rm+)"Um0(LGAZ9e%@&eJpe,%("Y[$`Q-MMV`K"K!&1`5+ZcY4m"aHZdBKTA
+[4e01+#pfKZ@$0,'efKIFfT`)JpB4HdrJL-YVFHGT+aS#PHAN`S2U4fXiX)9SEXc
+Ne4`(*Xa%9ql5+b3[L'+5Vq'Sf!T@R(LBKbH'SM66JeCKGQi66@%Ub3@fXQ#U284
+8dJM)jJrk([5h%lPTpqe0$f,B#)R4l(GLN!"iU'Sr$`-[0[69%S)Kj#pjq21*Kjp
+-IjJCP0*&FQR'j90G)YJXZ(MSprqFrYAX-aA5S[ac"!$""%PDHC9GTL*R"IY!JhK
+c+M8j+L"#r1-'&(C8RIVLNmYb9ih3fk@CF5%'AZV4"e`DSr!'KTNbK5(cJ9k6"pR
+!F"Y64LMGH&1CN3H&%dA1lhpNT1jDVP6D1M*jZ)jVlMiH9[ZZaGEKc'F!qlDGH$B
+[QLM4P2jT%*UD(*E5e%j!0%qYQ0TTfSUTPDB'TUddG@*Ud$5$UC1Q18`c0-eLQU2
+T0Nbc0&h%G"Y0+c"GT'NHd`UD$Q#DTqNiTJ-dRF*dR+BZ6+GSfSZTLkCpQ2E5G!6
+1Cpj-J*S,bAr9-S'"MQF(T)NrG[baiNmVrKK'B!Kj6T)BIF@r%Q*dINCKj+qc8H!
+I+lLJUaYGL9CI5JaTa-e%Z,XFQ&bZQdH3!*0-U3,B"$$PqJXB[eDErN)RkkX[69m
+KXVi@IpB`@HI3dP1-fcEHN!!lJZ(K[[M0CYi%[d,hlY)ArmZhE[rUk-@q@Gj506I
+iDd2hMS,NVSf&b$8J432L'QMU8H[qH+h+K0BhKim'%U(E$VE-(6[i-LMc)%,e$U5
+iLTajiFVrXCX-P#'50UqMf2Rc[iJc#$kSB'[TXDi4JJUU,Ab*kZYS%[F1-aI968X
+d$'Ce&eqZQT2"cIpaY[TkE)3ZraUr4KLrJ%2VaD&Va`5Vb-2J`fNp35")`5"TVK-
++TGKZR*(1AU8"GGeS(!-D,IDamfHPcQ#k,%3mTYBl"d0mN!!M#)Z9&CM,#e$U$+&
+Uf-a))6"9NHA468j[2HQp*e3X&+,#NNFUa(!r[UMMP[+CeH4,Jjq4hNJD[3k%4(b
+*3@Cba@P2R#kB5L0b"d5K1-jb-99I)ZC+9ZpP9i+K+H+VeM%aC(0F$"Z#4'lciIX
+CqpD1`Me@PmC!MSF$DdBUKCf9-830TE21FZ$Kk1C('VUQbaUkCYNGZFIS9Re',`r
+`Xkc$YcLUZBhR,*`DG*XBXQl+#1T&T@bcNNN'#ZQ1e#J&G9*FY!$QkpRM8[X#,S1
+'V0bJ*FN!&)8j28BA&i0"EXrTDBDVj,6+AI25YGRL0!A,3#%FD'%J(c*CA1mA8&X
+"$!4F*$UQY3dGYm8$ERTJ+#12I`CN8KPLA-XTLI,aa"%Q-3Q1V9r#b%([bYR'GMJ
+!qihJiFlLDfhRp1SU"mA"@Yf6XcVB'#SQmkr6e8"SJ6lm1am1JQEA#4T$DM"$&8(
+jp8bH!hJ+pPbMl*C8LF5AbB'R-3m)(L*Lb($QhQ2hC"KrN!#8H3c&"QH3!,!R3fj
+5E&JQ"RHUi$#0Nc[V0M1XNj'2BH"qQ&U(la3YQX#Lj&','0lP4CqN,CV!STiLmj'
+23%*)$6VU84JEqfmaBa'lH98-')N+"eC4Q2R[SVU"aK%Lp@pq,Rhi*$%iU5l)ra`
+Ub"*GN!$4'``9N!!J5a4"KY)&'Ee%$a`Mb1KV*%L!6Y&C)FMS91))Hd+3!*c35ZQ
+#I,@cf$a@N!$4CK*N5JF4Y3q'#P+lN4"NL3,&L*4@68+Bi9H&--fMK'Q('6Bjf35
+Q#Xrarf4U'3*q8dMFpN!ijN`H2h%5P(d1"Z!C(5USrlcdVlpL39@@TJR+$N(K(qU
+LCFem,*E'$l+8c1+VC@P,QfQT4NZYbP,l88Y"$QRT"fP,VEa8(U+P2FV5jS-X[8e
+,h@P,HfKT%beY9CCDMc9),"AER8YEfSUPGfPKk3X[r*pdbFh9D3Y,XE!8F(U,q#G
+'%XBFeSfj@MGQ0U%Rdidj@NE'A$,8Q-8!*3@#kiaJBTK(!HeY93eK$S"dHVCE[Yd
+1Y[6Vf!)(35(ab0$"4kiZ-ZMhC#G",D2-'MpjA3Q6@X(X4Mh0!)4i!+U`Z3bDM+"
+e%0`mIjT"Q2cN+3+l@Yf'#&)m,*JJ"4dD(@IYSb"'RL3@[j,r-5eC$hMAlcSr&Vr
+-iGbm%XkG4c2f@p1ebfljAS-MJVEKPXme'ZcYKS)2&!9helXX3cT-NE2h"e$`2'3
+L1bQicZFfU['CHh2YAlM(lS2-E0+4hG2lm9#RH'J1`CMM!U8I06&i#QeZ$F+BX-I
+N&006F33'!ra"$d8)d!R65k5V-*aF"4-*cbKh,F-&*f0lJQAA2jRTRr!c*9MjTe)
+S$%f"EDYd))%('F2,%)A*!!+C1ANUT!K"bMmR-8Mj)B!XFXb$!9r2`('&#YYbUU%
+f3d[Y[2#E!j`-%CHV(FAa$IqmNekRp-rrA%kI1d436SXXp1Q9Y%mc1+Ch509kKe4
+VLN&S,Q)DlN`N"j2L(f)#9#2KE1pIrpmi4+$K8hR4GbMP&MELBLJcKQ25i)8J`GE
+@CMc%Jld##"l$[bV"+6SFZRjdF%!fIV$iTlCca6h2er1!1G&cl,pbbGcbTJA$)NZ
+62k"j-9`INCB8,NZT3@#Frr%MEVL#MmG!jP&,-#CPXFRrh-R"AV19&2FFr4TG8I)
+rKmI0rQ)a0T+A[mkK2J1K'@8aQLC*VjDf0BKI@SmjKSG*6BQZ#fJ!#6*b-c(45!3
+0J!QZQ)!jYb2Ga)dI5`BE!kF2``8!!#-E384$8J-!9q)293eQ4!)3)H,Z91r"58k
+mfLZjQ#[$k#Fj,aH#(%fYie+UJ-DF*cfZB#RMZ[%8lNk-r2i@N!"5amfF!5eMhDi
+D0q0f-PNhQdN6'`aLaY"EkeVMC"a$l@QXieLEB4cUd&3003FPS[$hrhl[ppeh`1'
+Cp0PRRhPq!"eQ2L34%#m3!"!3!""4,j@*[fKU`KraSeFSN!$5B481A*FXl*'maYH
+8V$&P0li@53akdN3GL+E--E2PNq8[P9Pl!Cbc)d@IcCmB%HfQ69D%%KXA4a*(HX!
+#39VJCaFkE"jBfEKVS%`%Tq`3CDrTE`C@0LfQJGZQaXh)P-kiD1Zq2BBLBUrZ*)9
+pq,3#dkC$#)GD4FIA)a3XkM6PI[BDN!!*)0m!`QikdABZ8[6&*"jS[eejIY+Pkm+
+2-@i+&Ef6CMDEkX4jG(!C6CSpF`b"@a3l3XpQMMehpCddeUP$kD4A1RNLL8JT1[@
+JNf&JAP[3j2j'%hYkSqcTG[ATh(I51Pi4RD3-kqehdL+*I@pc%HM#d(ZB-S-VkMh
+m6-HbaGS2a``&ADIMjd3Nm@#Hp8emBZ+I"HN$2e$LSRCF!U+dF6-'pQ$L88aXia2
+hi'Gh*0'qJclS%RT@qe%h3X(G1F)6@5Tek&c*TbDQ9V-VNqTmqrZEQKJka"CdH4T
+ES*Y@aKBid-PTE)&MHJqb"@hL9EDJl9%4p)(iCE"iV,(JC,p`a50mXB38V*Y`UU9
+MqLJqD0JpTJ[ZKaUX0p4Mfb0,6iee!$PH9(NqDDJBImaGD62LE@Qdh6)SZbkdcc`
+ce)`#MB3@F`,mLCQb*bEFBp,41!2PX`@fpIY9l-M%VMpJ#,$dYbrXhqGEJLeiQ4K
+"NKHP*'Idp8AVdU0*bDL,&Lhk9NSdp42R@SM15pPTC`rQC'JCmNT,5dNqQaaG*2C
+q!3reAV(f5N&Qh8RV-)keap"L(0HZJ!QpK-43!-cTX`lcaABF-KK#&CKPTi%[YQ5
+1D5($'H-CCbM1-D'%iSMpX0NYNB6Bj!DldT5B"qaI&1Xb#RlK[)dZA1P)l`CVVi3
+6jCM*6B&fS'*ZcZ!LSM!i!XB9r-U8)rcBF%4dDb'JKK&LXY-"8T*6Fl*e@RT@0Mi
+2T#GRTICTfGSa,IGXhCQ8R"0489-TI1"JPLiRr8`d068V94Q+CZZ5,bTMNUSSk+Z
+%H@9U'cA#qD"Gd38RRcFl5)@aB5YFYD3FpeJ9UQT9,M%X3@@`@&J)m-#0dj&%3EC
+@+0h#(APer$)#3(Cma)fQZ9H&K435pdV2GAbGrLFe+5aUma!)&`F(RN5iI(HPF)"
+-RJjh"Q8UC8LrS39EFbbY0&)Sb%2(X!i$l3$b*%$@&BL*`cT%S*4Rh34e`i#(2cm
+U(5aQd-De@P2Z,aBU`kDN)`+I@iPKiL0b&UTji2K-J+EFGcl&"+m"DS-3U+S'iU)
+TGdiT2Jj%LZDXCBSS$YeqKeHMCV$11bG-Z6%62QlLLSM5jBrJF*)kSI-Xh[%"X0N
+'pP5(6FGCe"'2[Y680-p0$j1VH'"jB(&hbiY3R,$JM`-CINPP!B8"JY60d&)cUjd
+Li9@$dhS#b+6'@rR)8Q,lf0YJqd,1pK9!0%YXlqY9f&lUIUfC!T@A9T)l&-k))*K
+re-LZNN6)I)S*K6dNN!"P%HY68(CC5%#3!$[dippp`GbPKH*#0+0Li8+Z(pFmA-J
+pp3ZjYCHZN!!b*"lkKiI0R9C,apFjbp3Y)+!j4-q*fHLm1MlDm6iE@)m21YC"BJ%
+6&r*BUX)Ne&N,+5k,bfG6)(D5d2EeR8e+LQCRD%PC+9V@J@3YbkbPRXh@4Id@@F`
+kNf8q`fFT)T[N8l+,K,HEA$*I+lk@dB@P"kB,UN!h08VC598G-U)4!9#($'$*Q*-
+$()HDZ6&N,JpSNm'!"0#8M1AJl&S0F&DJCL`*bUH83HEJ!Q+,AVLjDI"$3`X2qG$
+L!AlG9QPK&"ZE-mFbZME8EQb1cS1LD4J&890Zi,Y1X60aXB-i0R0`ITmH3cLl(T9
+,3%lM@Kc4Y2%SB#6"6a[p2`'3!!QL3((,M($@$h+&JQ'GV0pfKkYSRC2efd+ULRM
+hDl8%$N'SYBlBL8!"B%SdMS`k&(96KPcZP*CF6(DcLIG310rY9M1MEC3rYF1C'@h
+peCkk&fLH%NV'3)KQFX6,fqM!`KH8!dfM53@@9a4J#G,0JfQVV9hm%N&X6q+QJN`
+9B()488&RU*Nkk0V""Pi``48E!%T%3Dpd`1kK&IHZh59#9,TUf8I8,90)8k3Pchi
+$@1*ejd8A18XBEbV9qqhaTP)L0A6Yh+5LA[%hr"6!iSGmq%TBX(e`,`FEVRD`9kT
+YGEMQ9R(dI#ILSX,-0a&Z#5N&$&Xf6SdQ(6bE(Ud*1Cidk+Mr!EQi2$&#!Z$NC9D
+Pr5CXPEE,cbTYP9p9QJ[LZ!EJ$3Bq*lF-,&qfQUUh&dh#5d"`%F,f$T5iC)X,bQ*
+3L"!Y8,$3f%FRqiL`Mh(fB@!IHTMkM$@9Q1SXb,i[AQ02698EQ+"U"Dbd"XbeQ`i
+1F(Q)LbL-!XVcXIecY*!!#JDam`amRL)'C#3dG4`N%SQ62!bB-aE)MHCQTIj%bmR
+@"P*6SYNjkFkS$SM#[RT'DfCT69*CUI)l5)8`221#d$2Jq@Rid,12+IBa34mG1US
+8Ijp2a!&9I[85#*YKG+C@)LG%d[&m9fjANMIIPA8"fp[P9*!!ckJS+$C0TU"e6JA
+j1Qd9&02`l&BB%'UkmD6MfrM&fk5,0mNZY[#,5c"KN!"GA)+I5TRL'f8ASq0R1qM
+Lr-9#ba,LCR8eK!$+Xl,6I&rq"KLK`MT%f3je'G42rHM3QRZ-!6E,''!MUbi6RbN
+-%11&41G"0XN13Kd(*3B"!pa!*9G(+XeKCD,Xk)qeb`HcdMr3`T!!rMBCV%b,eZ@
+N*&-Y+*YEp96r@#iR1bGCl*A*'Zr,R-dHJ0qRLI3h5#%"Mr8jFC)BD[5BH`c'FmF
+`F!c&arY3d+DM[ZlRK2CA5c#SiDF2"9ShLV1GND8M!PRF"a-UNE5rHqdhGk#3!2%
+0%H%NSpj8ep4%KNf01b&-([UJd-5G1kaJ5X1VdE@pB`Bp&NNmPjNjKSTKplBCPm&
+%M9YN6,5@-Um462I9f9,Q0B)j'f-bjPcMc$cHN5U$VG,&YlGb3Y8S,DG+MF)ldL4
+#Y4M-di,M-l32K2jVcABa@@ZZL"pLh4*'!E*!Y%mF%GiEDVGlGQQLia-JIrC4F(&
+6dq3Y6#cmbd003TSk1Kf(PKifm)G&d`3l'#NcSEejDN`eaI+e$9PZG,eT2pjlaI1
+PQ9p`I'hiUH!cUardrU(pMcVrFZX#E9(hLiDja[Ie$idq0h9la$VaUdGqIZIh*rr
+Xb(rUqfhrYirY(acSf(ISN`[[QLk&V[Cm*c,QrZEij,P[jIdSmmr2rlp6rrIC-r'
+cPp-cSQEGaCc$(ac-cFj+qZqT+FN(dRjFpj-6Ih(d[lhpakklVpBfhl[jrCBrZIA
+6krrPKrrMfY,TcmriR`rmml6rqS0rrI$[h[[rmrr2TrrlihpmlHZ[[,Ai'fm8,AQ
+RH'("V*IrBH2VqGp0r)GYhp[mRcIpCYG(ZrrqXErCmGIE(klmhDTI"*DYH'(GccE
+mlGTr@r2,2Epqr*p+rqAqAl9qEZHrPhhjkDqXAllbdBU[E[NX9PliaC+AjMA-RY2
+B*-P"9KTUX!2C@XB"AX#f#6IXRDfGjMQM8Q$9%4S9Gm$30cMS5,5rl4j,%q5SpJP
+H$%TB%`TVNTK[5G8I&SDT'k&la,BS[UjYYp3*EqINc38JPaLV)p`d[KL9dDJBlcQ
+-Qbk%lTiD-hZid`C#-e(J(KX"8RZ6Sd1KZfE(lAFjS)Y4Kem0ZXF3)Vf4$`220&m
+mHl`@aNqZA2-*dBk(Y"Z6pf"XNRFD$hDiaicdi*!!l-&pcJFR!L"Tq,AQa@NLG0-
+XQUDFJ1fVmpN#bKMC,C(`5TLkB6j-HiiiLbX0J8ML$`JmVBK,iCD'9ULd$m!MU)3
+F1E&(4ITfkNiL2NV&0Jm##5H4"5FaR!r'AdX,#(NlZRE+*MZ3!&9!d84$PhX-drS
+`d)GT,f0D*EVEDF!*FVbLjQ!l$9TX"e12"qiDBBENX+31&0mPeijj0@9#DJSCe#B
+GhmJVV)fm`QVi9!CX&K1`DDL-**CINi"03b9qhT!!!C[&6Q$$1hSjX%%493hd15*
+,hehCd2VZ9bafr9984TQb`hNM5bGG2pTd5$`c+1j`%f6Ra'"N+8*AC#SM(mB823@
+&,,*"E"(2'Q`[$U%`SCY"l!h%1)kh+C*iG$Tp%&Z-*0LKDIK$#J'[[NrCbLl!ie#
+MCUY'Sq#CAK3cmd$!L)l809p@V@lMkYS@5Dbrc05e$6mIbkV9(6*eSH0ARZEUiZc
+`d#Q'S-aqM#f)A9D`"GM01j-Y`)S2"LQ-$REP*PrC@FRD@E9+e"5`%Fe!M$)eHMC
+hEm"MhrJq,IeL02f$P!1j@Qj15ZlCj25,[b8k2`R9EXECj,0D6SV'+Qmr5$J3bQX
+BkIh[B8R[-Mp*ljKIT2Gm!-"+kj!!NBVi2*!!6N6iP3XJ)3Z)&1jZiD6f2Z&Jj,-
+p91XH-a1*YUS'DB4UmqRh6,N0,BcdJh(rPlDb6&aR5rSpED4-"!%@NmJZ4RD$N!$
+JC&HPl2,G#[RhG)H-r![)''52,IRhjHf8Z%!KZh(S)!q[Q&km#%YK$bdN)q%6dG3
+X,5X9T*MZE(*1@P5lI-"XMUCbUSSST3kqMQCFbNCf6R+1N!$(EU[-d%YMmYbY3B6
+9FhGIAcfMTd2fkbR6$#d3$-VU&SQi2riT)qjlkb2ZZ6N`*qj486MZYk"+#'jdA4l
+Z2SbK`e$@d+FMF`q6f[4!8DGVc9B"P*d(ca"'CS,Z)%&2DZ)LlY&CrRDa##T"(HF
+K3aJf$h1$[jZd)2GB8P-m1)N&2BF+bq0`5#E5mL0fDLa)ikJ6XNXkC*GN)!&5-&'
+EBG5'VYfc8MM0`i[i0NI8L`F`KBl)3femJkPDmGfSjG14q%a8S,hGaiIA6VV-mlS
+(X!A22k2lfPTkV('$CXN%d@9aQRrR&JY*9)Zr&%j8LfIk*kV&lAk*kSlk40Aqb-$
+b&DBR)kSlBlDLHMbCLG-'@e(GHG4[8Ae-%G@Gdm+)DUQYU1l8j+)U&e&X*(MkSMV
+')@mpX[Vj%&Ejl8jTP3qITVLZ-&8AekjErSNVa0("KE9CTpFXefUYa1Tf@hD(i$U
+3!05)Lkmmb-U2`CQRD3QT'%PR,-i+["k4YA0aHa9(8B38$L%5fTS()qE8mi1PDha
+D$hI-H'b24N4Er!Lj+(NR"'6LSpf(HFEl)C,bM8"iM%`-Iaj@$1ri+BD$ISPK"F5
+`K"*r'&RJf&KE*`aA1f#f(@V@RGFXX$!&4Be!EdQ5$b(H%L*i)%K&X9CHQ1XPJj(
+l,DqliPh5*cP1Z$J8a4lRA5b[5bEJ*IGGcQ[-#53DQbdXQEI'Qch0p%6ZG8kQJHb
+&fIG9FNTj[(*h`L+Sdf*4-j5l%`akLd9V+ff"kE[RdQrdEE1DfjS*h1SRHL`,QaF
+GXPMd#p3T50DQCfi*FJXCTL`@E,&EkmPXFIcKdUEZYS9hfql5G,UbHk*6c()Ca'5
+cqIj$(A54rSb-h4LiqN)a(F0dNBMrf0-3!8CNd#I-(!`-Z($4lp",iEmD$Ud,e0f
+J6N,!*SJ#QeI('AAikF`a*&d+m8F53dXN`IT#+K1XqPeJMGBK#L8M'jUNJcle)DS
+cRe+GSB,TT33$8Y9N9&88JL$S1[((JD#k$9KqLT[k8()N'D[f-&Epml#XHYj29MA
+l`kS0QUhbCpk4+EpLB2N,JiVbAaMd@rNpe0fJ6P+92j-A,"J3N@G"Ejk8"9qUU#S
+,K&042#084Dk@-a%&mhNBAeS8FPF&lcLm8YC4PK($'f3CN!$+-Z#2`fD!bmm-Z1j
+A"Y3j9FFG%@$i&hBC@ZCbGkd@bKacEPp9m&DTNk3d`C9fDUaqP98$hKiCm'C+U0E
+&84fmmf1"&GB&phiXkL3GbpjFeE%@e(ci54a0FPZ['`c[YZD%)3I#Q1!CjF3KTNd
+KkEFH!BYlU)"NS4!pL&0b9HTkRfNq)XCV0pk,PZU(0)Xck3pRN@Q-4Iia,)ZmjLH
+,&2M&)MYNQF%FY,(cf(J"1A,GiE+LJ'9&8HcFhKL%%lT,&q8)Ll#Jf'r4MZ[DaTF
+UB!m'+if5S2J84r0pZ(Q(*1B!1*`A+5ShmQ5a$H6d+QrR!4H2,LP0J#!XP!DPlC8
+r-Ji&QbmJ10A"hHq%$$,N6(8)C#-5@4D9Yi8%N6QkQ8kh(9f04qpc%kBKR8HC&*Y
+pLKNVm30T@ZM8Q('"6$P9Q,U8(r((e%A3NDDFM1AJM'A+I4e"KI+E4Zl!,'F',Z8
+R0VVFBaPHbBbJ2*N0CaZ3!"!Cj2Ba!,#CXU!iIl$m)VVemJQAqB5%k+jj!C&&j%6
+df'9(19,28I,S#&'Be@K$ibkV01KQ,PaDK!`Q-Tk!UeFMpflj)6+5`@''Z5QC)KE
+FN!"-!UAPa``YQEC',6!*SFTI3fEc5r,d!Q)&phlk56+YiFr`,HXd[X8U(KNRFi$
+YP)9D$bS&")h@M0+5Ah0G9Lei@0Ed1*1-%ZY,$'PN!P*qLV[RpH4SP`DkKkC6jR$
+(GrPlQC*C4%*Xi'6QP(05KQE6TDKm'VP`q`A[2T-1)@FV8VkHJ4F+#F2!"1!a(Z(
+(IQrT`jVp[UZdKIjIha*SDA8CLA4EMH0ke%H)000c`mHV5lGARl$d$3+hFU9E19J
+Na`V%eV'`%X6[YFb@c$pC@'NZe#lTce3h!YBc`)IM"3(fK#r'Ye9X&!Ni'#lh8P'
+i''CE'Fc!`,H(&mpDR3B'[Teb!i2baG6daiTl5"`iZ`!+Zj`R+@aTCEfEe4!1X(b
+ZKB)"bcETlGSK8p)TN!#C&"6d28DAFM$FUhpq[$Ec1J"Zi5paQ,M`4@jM5P--`@i
+lQ3E$f9ma0Dce))P$6'qrheakRIjIIheY5fYc#+E"jVDM[QdJL$1kpYcFH22b2*M
+iG2'$I8`0Dc#(IC!!LMrDZkDN(Q&p%mAe![8!5'DKhILQ5cqBC%qiX,bT@3+eG1K
+&chX%#9#JfENmCl2-XePQfLc2fba2f5bIP5hGY4Z[4kr(CmUIjGA25K6I,2Qe'3B
+05L3bAe)N+C%fdLp-5ABBJmmTipA+pd&J$9[Ij"ZIcN2M[$"JZ+Q%hG1Lh*J3EMb
+B8#EEfJ)m%9-!UiH$!5G6GVfSJ5(R14Q59jbE@FAjF0L+Xp,2LR1YAa9R@A95i@I
+p9C-+AT98S+)-*R@M+,193&UkGm%MC+iTFjX!B*dDLjE*#e5bcEDbcAiel'Dhq,R
+C4Vmf@k)Bqb'CVLF9lSM3UqRYf2+j3('R''G&X0jI#CpG&,mDh9Q0a*2!CU)mE@$
+jQJ3)KmAFP01"(hYi%S0hjF4HH8C9*)BTGf'[T)k&$iC6ad+[IqTBD2"((E1p-M)
+5&@P&XN*1QLjD-&"Z'&Mq5lG8P,%iD1&ZB8Yl[3@D)p4TVYSCRhDTm%,Aa@C,K&E
+jaUS,,dkLeq*a-Y)#Y4K5i9)IPX*h3lE(MZd-eA*!0Xc#*G+dSe+P*&2h"&2hYm1
+UqjLIkJljTHj-HKLUZH8--+)+"d%9LcZh3!'XmQh5SF@jHY9mKbiaY(!L)-5R*0i
+dUdXNM9RKV9V&dP9)m(#B6hilFfbr`!+9lCD5L38U`X`3-(IEdMLK9ZH0+a8b!NJ
+krLdNX49XJ@)NM!r3#!D+q1,6%954D2S%VRB3Qe[@R9a`ENb(-'IM5PQBmlaL5V!
+-C2kFDIZ(Q$%"R+%[HVNj()8kcpQD%bbMC$eEpimdcT-1fl@G"lr)j,4A)6c5cfD
+64bS,KUDD1HFJ$feH`!G-`$"f'N(-lja0Y`eU3JQ2Rki5S)!YD+U(,kcpqr'Ip!H
+)p5FAF,@8bY55VkJPm+'0@T!!K,ql69A,4PZe",J"%#9NB@S[P061Vhqma[8)'3H
+1UGHAF)1)a++2eHYIPPf2cVrBaC4H+#Rp"T%dL6R&p5Jp(I(Ej'JeY8ZM6d6aiE2
+dL9p1KJZb6-8',5Gj!$&C%3K,(JN%9,VQj!)fT!rYbq3X6FEFURTl&+I!UP*&[6`
+SLB34fJ99[4&Eam#U$&)[Udime49k-#Z&YNYqd'Sl*p36h2KkCH0)aZP!X(48H+l
+K)%C"cAXFj-Pa36c1cNT69$(8`d%$ZFTjN@G,+CM-lGRAp'pF'HYPbR!V6ScIV91
+93@k-PC(%JMj9'BGX(4Qrbb4P8%"h'3j#(iT#N!$2'4)PjY3"$Akq9-#$N!!`QqG
+Kb+153T4YYq99frC15E4X0MbZE,LbYIU'YiE#EEMbSRc$h0@JXX#28h-J5Y+HT3h
+cS5Hfi5eUCC2`ZEP4qJA1S28BCeCfbKaE-&CCq5&c2KfcCH#(2qDEN!!D5[,)6I0
+X1AE[jRR9MmXVkca@@DH(VD`cr+bXNrbUV1Z8S)qf4+UDDe6$-m16b"T[2UVi@Kk
+-5Q3%4`ZUp'&L)PDpVjC23,0HEFV!"*RkE1,2Zf3A($APcSk6Qd+kV1PC0cXq"Ui
+6%LC8Z3[4G&h6)4RU3fND!X'j#emK"j%-q3C$YQ'"aLHD2!S5UTKJUQKaETYI8qH
+MX(+E3Jb,632,pdbaT","qNPJkX##X)rYK36HaM,kVm0Qp(Br-hU$AaNpcBDmpr*
+N6caj"SL+!)iqR39c[EC*3DTYF,Ub`6HEpl,"qfb$MiEGB)@I'jcYe`CI83p,"UC
+f-X['"i*mc'RC*KYZJpY"!JbG+2DAm54T%XULSSi!Y8U'XUZSFd#p,%-j9&358$r
+JE#DK0"9e(5LA$$@SSX#UM@D*i6M+TD+3!)LdXBH,Q!m0XjBbph`VFl58d3F8-,q
+HV%*V05UC60IdU8YkENTGdV'fUNXk[N0GdMEEe#A8-5HQ,U'f16Yj-)i)Scf-#*q
+SedQfKEQ%4d@CfB)U[e9eqAM*jH-KjeM[CH%c6[bfV5[5J#5i'PScb"5Aa9(aJ#J
+@P@)R8[1Z6QT#JjDP#!3GQNY0-D,49AkPm0hKLF1fN`'[6mq4E5V5bj&,10+6j'0
+AY+'Dkh3HiTb,%0`!Z!bS)l,M19'VJ$VR4,QGU*H"5R+L8Kf"ZbTb'T!!ef9)688
+H"HS9'@T349d'DVF6e88+8TkVARNG8bU[[ir,$1GPaXR#E9YjlDE!d&BTFj4U+q8
+RZCHc$SDam2l1Z3[IbFU)(ZcVddAp-24f"Pij%03iBHP"d+U9XPiE3Z+d89%U$jJ
+5'iI!eXr+Ua"Q&X!c[6A0p``e59`'!i&5lX,fQE[Je'q01rLbc@cAKJ)Z%"5Y'lM
+4cCcVcUjiISI86EHT!d`"-i4@@`-M4Ji"BDDUE,%S9CTAY!RVjKEB*B"@m%`iJ&D
+`fMq!9Y$Y&d$E9#0TVTm9-LTbab,ZPMZGUDT"er#N+pAh,fr0(C!!3Mi`B"l@,*2
+0-+VSP*PM)&!4U0hJNP!JUeVR`S")VPUCkNDBkRiE9RApIUV1j*IUbRLL),jT9&P
+l&#FPrJ5T)9dbEk'%2'MHc[1j&UYJL6F8`k3e0BKF#-iZ%5EK6Ya@`(l6SL6F8F%
+F919dMpB`%MS2#k@ae)aS+K-cfi(6-3cD+Qf@'3C0Skc1V-,&4iempZJ"A"bSA$a
+`mYQlbE(UQlb,V2CdPk%i`KIQQ00K4Z%Fl5(K#E`P(#pLQJCA$DPaS!)"l)H%BpN
+e3KHr*B,T)ae[JE4(Kqk(e'[EYDI3('D,dF8[q9GqKI6)6UG,MBHk2+(DA&i0ERa
+&@(*9JC3ae6R'9'I$-Y9P2jNUfaqQQQ153PUrlR@'Y1Tc2IqkYkU!XZSq6h603qF
+H)LE$1Fi*cBbl@UXLY6Kj8e5qMK%0j%ED)6pHZ)A6qDP@kc4j&k[@LmTA9@Rk8N,
+'&P5SB`IBkDC'R%YBSC''eUMCTCKP&*8hUNd%F%+0KU@3!%*K(f[DQaBMlM'fK2P
+6SCi+RK++RQ&,3PQi-pLV-h'R-`ee)J-G6X(M#5h+'0+aPiXkcIPUiJ4Xrj5D-FT
+a&4@cBciV1h+QcC((C8q9f$`e@12)298FqF*H,V)pmLlCNGH6FeYaAI#N'q6JAFm
+[UC!!M-E+U4(epB3S[+0H(Q1)%QP4f-X1,-4L0Y5YZ4HZ!-!r`4+ac@C6k&LVfG6
+CkY5JESS0+"-l`hEfQ0Iaa!G5iqJaFS1f25Bl6)Cd'20@0V#kaN%p5'abAYjNKk+
+'d20%%V0V&8A%C)USN!!TSN+f,GXMHRA8E0TXG3XmdE6T!`U&&KkZfGfmSZ0j`pA
+-@h0$F,RGUZpJr0QMNf5Z*ahK935L+Ta*Zd9QM@6fFFAe+LADCXqR`@`!eGYF0i%
+AAZ4"+,X`DIaj[L$"TJBH0H83"j%@m22Yp+2QC)AUB$EPrMSZ0F"3Q'mk5#jVb3&
+3@'!-CIldI66dBI`T9DANpLjmJbYqMj3KKDm4Dj2C-*NAm`lcHBHe6,f[)9(,9VE
+iJH+8,jc"KRl)c%'8c'LK"1rQ3*`A"HDXYdRX,4N3Kf6r6%+MNMAB`#PHm+GXbAF
+fRb"i8%'lbVDcfCR"fP8T,'!m8bqiCFBQe-3&6qV2'CSD)+%KPNQPf&UF-Y,UB&Q
+i@cC"BLZ(MPb5$MBS-H%9+4aIH(KbHSd*AR2!pJRj%9(pR@!9kII$9U3YIPDN-rb
+U5*0B4CUfPiSdcEq+G&IE`2,(KbR*-SM9[$$9kDM5#F44RM2jmNGG94P00ke4%K$
+`*M!XI-U889$LB#3$2UTF4XBY@GNRI&mZiN6P$4P*Q8I,$Djk#-Z3!%*B[[j+'-)
+bdjD`I(e#)5cTRh4!iMZ@T#"F)Yd,Ce15Rda#ADNa30Tf'LAAQ1SSlPFq,1c$cMi
+ml-2"2S,X`mXq1YfeRPTZF,`aMCZm`SbLNXM&ElTimqhfiLA8p,)S`!3pA%K)lNT
+6aiXp3Khbe4KUUc%d9'2)8Q2S4SfKVKT$EbT$-,j!mfp4dA3a(Uaj1,MjFI$S6Ja
+-G&a,me(6`++ND6e-b#DSNrEcrYQ"i[lClk2TEldbH+GIB&!mj1UhS($+"lX2DEr
+UY`4)XBF@ZIVYS`VL%b$X!9,d*d"iTK6%"5!m!9,m"5!F)`VLA5!F!FU)Gi%)`Na
+Q!Ui03S&eJ!`'+(-Z!HRPb"+',!(5'k!-)f3RhrEkA$4('pr+1mCBaaJkmLhaMP!
+!bpBe,&ZRR%V5NjSQB*+IechK%5r@G[+"mH)H4@hV-*!!Tj(a%6UF3&0hr!Sh$#S
+T-@N(%T0f5iP$Bp19"+IP+ja*4Q0Na$*-$fShaZrK)F06a8H3!%k"VM91i($0qI4
+--5@D9j+9FM!hRi'jSV"JESQIB#lK&jLlCJZQ[RF+)'LA(f"U9dd`Y6PqZQ"Ummf
+pJkQ!5`kQ!UkU`G5X0[r!9-'Yd`06N`HcI[aN`&4$krmD-0A3qKmhQ'TS26d`e9$
+fT`&-0C5G(TK#FZJ+8S44BT1*pj2`lm&Bf+HG*eLN6`p2fNHI$Z&JRd'H`*!!2Vh
+#bcil4HHlAi&i+8pmc"MR%FS'DV5"NRVVdB4$3i89B)ih(eD%IhF(!dj35-!LZSS
+hQQEK(3*'N!#$V(0JP!`Lf86pN!$a"X#DJmK,mq-dj5JPM)Cja+2CdY-`Dc@aj2J
+%3LRTr(S#""A6F#8bJ$faR9r,(`#JlKUrL3-EU&N*p8M"+#Y3mZZ0@THcZ3J'5"p
+MJ25&X)"dRCq!Y03[3*TIdb4Y@GI!mRp+0V6mAQUf,U`a'R@53'LJT-S!#L20CFf
+@V6D1Fb0b0"6('jZ509a@Z%GUq'hC5Z'a*DDPDp"F($YS`EB&5T)5H90a5fcGKl`
+4258*R%Gh3QNk%QDdlDcTVeTH21308ZfeH&KRfr#AAY"'b)M8bXf9#r3,*$-bGL6
+@I"9[RT-+3TE`cGF"3KmiQ%aTdMA@'+@XpFNReQK8`AV'9Lq&CDYjrV(9V+kUf5T
+dHpD$CJFk8PEH*m5X"c2(',-&!#)Ih(GSAmiRha[ifF"(!pmDh$6`YAdI$UB0IRr
+`pAdE"Zm0CJdQG9`Fr,Z"dAdIGk4dI$a`8V$r!*!$+aY"4%05!`"TZa"9#f5C!&P
+YNqr@ET4DPQB-deZ'[)aDkTcEN!$&')l!fdfPeV'9EXK#5&UhYGedep1cke-)Ke9
+h23b[Mmej$"J1-BD)'03&G8iLdSJh%I%(`aJ3BN!%3BKkHh*c2$YLl22prqrEkpZ
+QQd$1ZArh04e@0L32%4!3!"!3!"!3)HlIe5Y4M`Gr&088FU5%&GQP)Yq%Lpa5T@c
+DaeaN%2ice%ZZ'4-CTXf5B#)f+F5%8G(bk(!3cX'Ep2@(&'GpE2"1-5'Pc6d+"-3
+dmh3eF-)FFrHTG,GFmRMUE5NV2*klTV'EraLQ3Bi@-QEjKr+N1-I#qKV&Pl*#86k
+M@krTeXPZh4!0K0Ud'-)ZcL3T6R3$-$`!rShGATCMYhpeqZVdR,*pT@RTp[`MkGU
+pf9bmV+qI@aqMSq`#%b8b@+0FlCkJf'3ReUf#F[T2chZ(i,!GTe5'mq#feZ&@2"M
+RDBdH9Xam19F`+TU6iP3#3S@YdFb9*q[*a8D(DS03hHT'Tk@*%+RUKI9QpK++26X
+3aiqjhRV-A6X9d4'ME36qmE!E5fRbEU8YVp0BeSNI-hjXq2(LTamr2[`d4Ha"1ah
+ejG+-dJU1'X"CCFHQb9dMKRlb0pA01L"*Y!&P*c401MMFP8B*(38-[$*#)Xfl$LK
+1a8P)&HHUKN,0(-"F)9`Vl2BMkDCe'q`KVDBR,6FM4eX@b%Q9[Mrd*lZp1+h`5,(
+@ATSCYMmNMlrkY$fK0%1&led0Y1m0p6aH[#A!e-IU,Hk$8jr9T)3YKi5Tjm+0q(-
+jH($UZ4"8ZGF&aca(G#4kb$heT1KZQ(l0q-(T8lX[,TRD(FeFlSXqTbK(MNR+Ph8
+h%$D94)dA6*GVh*cTH-jd(*L1$ih@@i`B6K$GhZRA2!Q'Nm"`%KK'L1%[9[XaA%i
+-JlG(#0(r"YpR!d1SYm&pF1ecQXTSjYTLQ[EFF$6c-ATmJC4-0bf!65iVQlA286A
+"P,rb+9qDTMb2abd96[NVQe*b+ddT-CZQV-IMfBUQP0`U65RN8il6P-1V'&NPC66
+PcfmC6#Q8TRc$TcaVQJ+b5[396[Q'69Pj0deCf@+D!V*@0P8dCHAGI$2Zi2+'d26
+P$@iAYR`l,bjCANHJiQSISfR[EX((T`JBeSpR+bmZ@41MirTrA,lCm+-DNcXcPpI
+G%9AUf-1D'$f)Z&(2aTC#G$X*F3YLG898JZikPc4P-`h$-J%#NC9Prf*m(%0!X(i
+m-rlLNV9"1UEracAc$$qU-4NN""Jjp,!fb-KC'qb+($jP(Jd$Z!,NE)F6d8b9r%f
+l[C!!4-[9IU+PEJF%cYjX8c8bG3Q,%`"QK%+cS-j2FB%b*3S`b,I,0l0E%[piV"1
+rl5aAc*fP%+JGdXHRq%HRmFFeXD)IPfmfrSK"BqMih`FSe`EPfcAcf+h%*P"dZ69
+MLV*H'kb!K(R'(`'N+(8prYd1Vk)%X,+U!3a#2U*aGQaaE(IA+#1UX`b"0A9Z*5Q
+1[cL&6QN%iTKh)Bj(h0JJ90',2)MqL,bJDepKF9UkeL6lrS$e5J[YQY*LEAkZaVj
+IPS&eKH9(8ZdjU8G+Fp,afFkk35B##H'4FL@b"ZiP93XMj%Jq@c$XBCY3dR*r6Rm
+ZSh#X9Z[Uk0I,4lplJpr4Vhq&4bqXN!#D`XIRk*0GM3FcpE4&K1@Lj8U6RaPJC1c
+`KD+PQIQjTQ292F4@5Xp*e4l*R$b8jHjb1q[X8,h6d*ARZUj0eqE3e,(J'GKIV($
+c,pIe"f-!e)C*YXcLq[6bY2fC4c+H'eXq5"la%+2FM$*YUUBiEIpB-J*#&P)A5Sl
+JqVQSfJ&8E&e+"`+PK6E"ii%DjQh(BSjBj)"LM[mT0RAD'bbb5(6GR2X+&TF2%Fi
+r8RK!Fk5dH'`Bl6FaZMBYHqaKXIr99XkZkm&B+fIA2!1&aE94VFR@dA"9&@XLBS8
+fh)SU&Y[bSUdk%R$C(SH0&#X%aF,f9,YBGG@U`L'US&KGXbQ9$m'#2,kPIP6aG6b
+#6C)SY[(-@A!5&1HTPhUf1TcUTGMfpDC9)M6Slp`TMSM19$&VYpBjUGV4JSh#@1H
+,l3X5A*V&RHSE%E,FZ2NP6%D)j8hEHlB*E2YrmSML+fZRfa!'"+2H8B$MAFIC&j3
+cP[V%qTJ%`(dT(8%P%"IfP,K8YJ3`#284Qi`[4DFFk,QZ2j`HcXh*'#XekL%pBXI
+f'4rEKQ1E*hYXFqF)dR#k2[CQ(0aX1VB!TQBFfPE@3T0aD$-rX0Gde%SkDK)lDRY
+`*(6Kl+M4JIAm`$ce`(AYiA59GL`2c+X0UKr5+j!!JML09d1B+0S$iE6dXH()A[a
+C3r0,$3fII@PKE8CQ@TQfk+)(D0%dc9M9r@+$GIj-c-T+8bHcI&H+,CVR$G1rTF1
+p`l0F9&8V3(H%P"a*F6CXAd*!UU$X[DkJmMBTpJH%BKk@%*S(YeZ9fdZhm9bj'dD
+h[q[S[pPbLjpLEeFqMl2eH$aqLVfk0SSpQDklCrpN&,[+acEMf(2*0@!ppShkQb6
+&0KhlHT0bffJ5$QhHEU$Dfk(Dr,"3lIJ,fie9He0Y9(YLaNUY9EYVMSqIDRHpk0L
+TGLYh#!$"UNlUb!2$5F18H0Xj6)J2R%XkaaaekLAcb[QI!,e'Z'HQ"p2`VcU(Z8(
+-2h9X3+,[cI5"MX9H`&#3!)aNC5Y-m6UB#+hX3mB#HZ$"hF["+2)V49-(f*65F9E
+KB43IJX&MEZe4pK&,fP``GAlP8U6TCf#A-U"06U$9@Rc8$Q6hAHCrXUdJZbrle35
+CS[bKaJ"N[,ViJqa2Y3ECC#T+VGA5!'5R'-L-!@DJB*XNF$RTS5*`@B(eIk&@DBq
+A@[f50M4dT!*)6i-`A43DeTN([A3E2`aRm3@iMpH,#8%[8Y*dbQP0qF&bTFlc&2p
+c`SfY1P8l0JbH3P)#*5Y`j`9F#`Q9AR%[Ra$M+Ef,()TbeF'pRJRLhR[,PG1H(i5
+48YCHlIR"(YHpDXmE520m!``Q%)1M@cq2`r!XE"f0%h[im%R5m%Pmq'8-[icKiib
+'la%6a!"F4DHVcIF'2&IZcI"Fm6b*G*XR+FRCV@M1LKrMaBr#MCc4MrDi$RlXbI$
+Z&K-1"V#P'q$,A-#d#jjRi!DIJ`pAHkCK1k6Dm`bI-Qf6#aX4hX&Rk"m2-F,8P3#
+9"FcpMHfG98UM'!r!4$`[m$r$!-m`dZCr#G$q0m"i2`$eJQF0T@CB93)G@4mhY2Y
+JD-GcB2fhBd5-Tm28Q-@,)(Zm42CiN!"pdC-+XZ-jJFY"hR*+`8-+GN@Np8U1H5`
+20pH#52bp4h(-+4+l+AYFYkU9dpbaFBDrHTQrH(Q25h66mM!NIqRGM9GAHplL!hl
+-!I)@(rCM$K!!(SU56bDRHXQlHl!C[,86P@RG8RC,'`T*`l5"(Xfm2ir3pI2H%"`
+9NSZk$EFm2CdH&hYT%([%`%e*h#@+fh%!feE2'(+E(RJ,!q"N[&md(E6TB))RQk0
+aYS6'Pd$N5kQ*qYe)i4R&i8Fe05"NpVAP5S2RG@ca[6l%RBMBe'SAMf%VM9*TXNf
++1b*[8,RfDBTcdmZlUSF6#pDV*(SN3Eh8+RVZ@rV+4FqV,Cl6(NIac0+JXaYY&U8
+4,YLq(8XpV8NAS&5YT&3)15YCi3iL2(T!dCR-Xrk8$Kr5*+'5&KbK(f&-Hi*,eB+
+I[!5Hm)NYXHdA`3M*kc!3bcUaY4IaRSQkSRT52lMS6S4Ff1ULVE-@T(pXe9j&4+M
+k+$9H-ZaZcXe),br9j)bPZmk648T!+#GR4I5SJD-LbqUSX#)aHCi*L6P!HU89DE6
+TL+1fmmRcV*0K[&EkGc&*E)%YeN(SCQia)AQ[Rd1NkSFUiJjK@kZR1!Ta6"ZP*ET
+rUN48hV#2K)6L#cD5Q0$B`Tk)LlB%)DM(ki"8&(jJ"2Y51R3b`8D1Ql"A2`UKeZN
+q"&GVNlZ[f-H#'-RG'M-a2)k85)JqK0k(Q11ec1YfNIK6@3HG$TXjZe2L6YT+Z"-
+9cA4V0YhD"V&B"+EpVVf+Na@#!E$X"UCieF&9C80F6KSa!U2A%%M"#S"8Bq(!0VZ
+l99lhD)BaN!$[Ye@MF%LraSQA%3l%8ql4iM0q3$5HX)B%Zp+2LK1MRkpG+Y(4H4K
+&-JihiXAC9$2[BXk)"a#)r9%a[cRXD$Nmj,##1"AXKej3kTeLBLFAmmk0pFTN8$*
+Sa,B+D*&CjDqT9L*2%iZN1*1B,M8)A+U1SV%,@bE*k4pmSr[kJdI4d@r@j-(aVJ`
+p44fjBY2d5cFNA*a)r,EKC6kf$@j4kG$CE#Ca`%331[m&[20I`%@4ac5m$S`V2C3
+3mT&9$6"mSk3)Ni`U5b-BE+4%[RXcP1pij[1T'c")MjqVm20hr+b5EZC$$"%4'b5
+fYT31G*2[iHFQhVRI40f"T!JN5-dSI)'M0Ei1dfLqjqqd[8%Tc%A%+!G!ie1-r-E
+X3EJ0XGbAJhFLlF"#)T`'hqcM*0l&MCa(SD6i3qQT)(i"42jG)6)9CT(4%#aAE*d
+lrpCEq5,50+J,@&5I9cqA$J6LCq(Q,Rk3!%5rBrbA$ij9Vj11J1lJ%XL2PilKFa4
+,JT3R1[aEDpM$MFD2B%MH"4)Ej9IIRFE61Di(%BXk2UNf$pjCrkP-rU90r'8R%BM
+dAeH)A"#r`a!U41BhL"d0+H(Eb6A"#dpLJ!k(FP4c%2BA!@"r"34@KbM0EcBChM!
+RE8L(JQ(kYpi9lfQqp"p1B2rF@LAqeG#pA[8k!9mUhf++T#'eU4j13"L(UTMN+((
+Q`f(!YjCb%mD4m`!Z[cakk4fP"eCB8V5`)Dj,4CbkYD)$9HfiA09SBieAY$DQD*D
+0*YG01lNNk4'SehRSC3Q[D1KSj($%6QP-(r&UpP'5T+U@0M"dHMC,VL8RN!"d!6m
+hK&X`l)+Q%S$Ic!hACf&mE[D8!23Pq2KX1)CL`8Mk6l83kd3R@0r!MH@'A56!h'm
+[pGb!aiF`GCL+(+1)kE"L3q9jfr-HNIRl$-pl(Jq[DZq"M"L[V"-Sm2'VjPG*e6c
+*50aAHkj#94p!+X#3!,c*b)qfJ4pYJhbdS4)XprmpXcMVF@!5PSVj2S#I(1PQPL3
+'aNR,HRN&HJNr2q2%rDaL-6$d'CM2mMc!JDFh!PiIIUlM`1[M`00ci%d#m25Hm3$
+HH(bF*!([1L2JA@F![1XNi,NNi,Qimir!pS!%YJFJAYEK#-GPp9qmM`[!U`*aaAZ
+YJ!NUT*)!bYQ++RlMbGXYIY8q+f%Jh2JPG91aM#qjH&V'+r%bL+D0*Y%dalU!$JX
+8G,h!k5ERlARq5mKL6EH6"0["(ClIF43YNJT"c1&#M4HmmIbZhLBKD*%IJ[lV&!Q
+i6d&QcGHbB009+0LHjF93fG*6%%$H&BKM"i*3ZX64YmS)IFrMCb0(hr-FIDXiqXB
+!IDZ3!%*0DFG)cTA3Yp%)I4X0d,G43YpK#Af(6HLl5d,IACKf`P"iH8iB#DppZ@-
+RZE,PP$&QF*2)B"[f8&bqlE'5a!8+jARIG66jEei`99%j5DJCE@YG+V+a9P[cr`Q
+C(2@5@B1GEL3TGj%8a`(C4!&2VG2aRV#+##bcQ3@C&0EGaK-%*FHHMYrSN!$9613
+!DA,!DI$"E2#"`LiNT#TQ8fKb$`Y0T!&bH(+23AJbhdS@XB6L9abLE2BIq(Z%+FC
+T2+kHLX,4LF0I#NIrC0qlBq5Lm[p%U$NaGm0BK*UZikC3mjeA0G4m[iUKCLf53Vi
+RSHD)FDJTT63pAU(Q5+e$c9GKbqGa#$9rCa"UMKL(QK)3M5GX+K*U9MXD%'TZp`X
+eGA+SkErPpkEVHaTiMVbL`229hLkEiKGiMR#$H*2'6#Ne--e1fM)m(S5FCk3EXiJ
+A%$e8$*f&P'%BaZqVUY'&E')ICH&%KKJh)UqM3)icG%U6,R%MC6dQVIFc8(XP*CP
+L%)Ef3V#fA3[9mYc!Tfl"S09'BHLA2!4&J9R*`0RL&m$p&6rrj)E#2`d-8#6BXi-
+fMS-*qSr*"+)53"VhX#-d[L#&SJ@'S5JRFh%&SHJ0k")@aeFp&&dmd9$dHKcKZ(5
+8-ii-I`1)#1C'@qrM()c@&3P''lS)4Xp@5',Ai@L"`B4DKU166r@5`p(Y4F24'*(
+'`Xf[B9EaMASHN!!fM0+$U4*3i`&9$dXR5ip"@$SLKD@5fMNE6)'T0ei+6"YdRS9
+iGCCA2`K![l"d2Dpikj0-LQYCbXhc6E*jAL6Pi3*h'E%`G6X3JSe+)$8,a[SQcaU
+S6``,C2'L[j6m3%@-&KLCl!Yi@VR9E-IVAQcf[+fAYRZ-JPB8IIV)m`iGiD%-ccZ
+HKGJiH3F%T[#+r35@H-*2*-b[-'5G,i@X%Eq3!(8,2rB@kl'(@P'Y2r(FajP2-`T
+DCdP"+phF*`Q0DAj"d@r`Xi),M49&K%Dla(i-AYmAG5&4FKB(lqSZ`GZ(Rh95)%[
+JAFh"1`AJAHejA3,[&#VFD3,[1L2`VLX#hR9qi$8)DaqLB*S!1`Z#DP%&3Hem",A
+4#S*DAm8LT2(CbB5e"3CKV9A-946@GV9%B+`#fm@e$Qc21+Ul%*-I'BHfALp(kf+
+Mm,D1SrM,,P(m2(9I8V",+2k5SrKPS2K,cjX5LPr'cjXQ&2FDSELh#)Tlr9"X%2S
+#aBXp#kqP2bF-K@3Y`Yk*TX-EKEdM21aPhAL0+I"e0KL%[GX9%T%8pT,SE+K0f$Z
+a8-3Sl(hJHa,f2V"K)Q([b#X*HhQBa-,HGakhX2IpUSHp%pf%03jl&m+S@#JIjGT
+LcViK&m820%F+Y6Pb%EM#R1I#@Z*KYp1(#X-[2eEA2mX+&aLb!P'`9`ZcFa#')kQ
+RDij&@0kbG@)XpdqFT8X1EY!dS`eT&mI##dYF+*9p'F,Z(NT#S"3&+YL[A[*K2M8
+qb"-8PR&heaceN[Yr'ID%A'kICM'UqXXKPd'5`Kb@T-"Z+8%"dhK$'MfB+TUp0fU
+3!!,ai45q!"DXiBA22NqY6d5kJXZ8VZ#$N!$aXZ*d9&JqL%)i5!bCM53'Pbi"k5)
+ZeHQ`46rDD6Qqqk4VQeT"FfVE"+KSTH,N4Pi"Eqj$CY#f$HV+Nfh3m"i2VDMaU3[
+ee%62KASH%T9Y4f,-+*UdK*!!IRIkr6[h+56%)-aMeHr@ImS+!KQRMN""el'd%BM
+E"ph6Tij6YB6`4ih#IMSc'DV@)d5LR2aHASLU")dIC%93,"!(`*r1Je-Rd5(3b"%
++i%dG,lU4U-m,`0UAF4-$4pY&4kZ4MMD01RI6dISJ5QeL1hrejX(-U423$81SHel
+RM5iJp)$`IE1V*'Cqa!J)@X0-S3S1ZBSG8KF,pTR%F+&aHG3rrF'8bi"5Q9elQk6
+[Tim8NblQT+9b&p6AaB@bM[Ur-a9YCFeZm5EB3N'[cR)l&BC,C%@c&JXP!p4YPh8
+'3d'%`MGpJ+4V)&G-E1Y$J'YKiA8C,k)Z0j[PLN0E"+8[D&qe!jK)4A)BUUPlqXS
+X65`dIH@H3jNVpkc-#KjFQ58H#`BL1d9,&N3mNZ)Y-iF4Z*XMB6-DUU%QC+e&ML1
+Xb,&A[H5ICb+m5e![QGN8'4D2eAL$&h8A$GRAJ(ePSTLBp92&U6eER4Kk'Xb8qNq
+PiVjkhK(RX3AIePHEN5MeX5k!SX("K#F8TmBTMML'1VB%SlUG+2lEcJS+5k)B4H%
+qMm1f%4Uk&FpaSSq*!5TL&rNA%1ifUF0HZlffSP)'*J4iH4T+HD@Le'i4-"BB(E3
+!B#bB#"LcLS$4"MF8Gq'0G+*j%5X)r9J$K!Arab"m[bJ)UpK&9!a*3e#Z-MV`+S"
+beGL$FZF0IU$dB`e3V[UI$-VpB`R+fKFMRjPN,8DqmZJV,dBqmaI@BZ3VXkY3M$b
+,'PqQ*K"3Q2SCc9(CJ6hieX8P+kI*VQdb)S0ZhJNB1,#a$%mMc"K$)T5@kF,TEH6
+3jX@aRe&M!91c"BA&4p**YYVp3#dAQQ`P`"ThN[kUPU*(8HqB62Vl363Ge-T5YfI
+Qb`C)%%)qQMNcAjTbKVS+iq-9)EY6,[$jljP($QMYA9-S0ce+95JS05B(NkNrdP0
+bS8ah5hXplk,h*SRZMJmkcI0HShp,ApXi2'[hpedq*IlFf[@IafNAm#4*YR'a[5`
+0fGYf3`RC3d8jk(rQe(bSJEhKTBScMk3I-#+&0I$3MN1fV0a3'$QXq%!B5,%a8Xj
+5F'M4plP4l%56"a)qdFlL982D1!%"kB9(-LUQSS[P'A&M4i5U+"(r+K14NCC6HbT
+i%lCIam(*G5DBTTaDqdPCF&rlGUIY@+1LG6CB(,cBHbq+ZbmV[Ml,V$4m[ml&5EK
+"h"NIaaZXcA9eJS5FY0a`'"@m!Pb`PDUkd0+*,B6SF(),3Ec"BDG,8lbGD5K8Y,i
+Xj[9&ADIe2eQ[A551k-J0G`FBl5mYdfC8U$Q&p2pqa9pGDF1#e"@'8$q3!(9flIS
+bhqf@@ml!qFq%D4e#,2hDpB%il@`M"Gf&T6+1T+CD!pSL5PSB+14SZ&f"Nl(*eY1
+SP2A,`*K6h0"J9QM,J)T9`m`dKa'S+@K'[X+"&RRJFIdaaDG81#M2H&#6FNEajRf
+,@h,$YMZMZk0rUFC@&M9ecaEb*Y+V5N@2CMc$3p*(Tca&hih2cXQ3!#5D52qX`J&
+HSk-e6)D4B$63)C&a5CP5a5Q#dF#crJ0j8m`ZD@J-6&eX-'rQ'6G[-QQQHDi#"*+
+53-QFC&Cf$Yq4TV63`qb6r-'XQ0q&)U+`ej1+'3f[,jPC4X(qi$CdecZJ'UH0`fb
+*Db%93HZL`ZCrA@c3F-4T@L`b$0HZ6@@$'idC&bmM))ZTmTLTfe@$#rk0r*K@cjD
+F1DJiU+3q9&,GfIESD23$+F(+3pA8De%[q@-aYMdEN!$'hYM[#P%eA5$Zj!k%b3Q
+$3Y*jUPe9AHD4L5e6N5M`@qE6"LbK`e*e%!U4$VKSrEX9I'l!jdSbQb+0cbZVGjF
+jRfq-*!DR+Q*NUP+CUVMhJ&0hcG"A!f(c'PFK8[hMQcY$SC2Yde$BiR&i#1aqGN!
+laY&Lr$'dqpNpfUAH2"aq(Jjr03kIPQ[#Rk%TeV-h9-T%5iMq3Vk%*"(cU4IJL%"
+P'h"`%3G[kM6MYK+hZKVc[#[dEqQ9'iCR$93R'S#MUA1UST2!-FB%$N8j*bD%QXN
+4+Ri9hi&Qd"lh4`kJF`k[rfF1SMN%)M1"k$5C"4Q6Ka$T5)L,qJ!JYGqiFP%5Ja6
+LM%%P1iT!d4f)BeARamEeeT!!p9lr5QV%D*jkbD1AUm#Sd-U)#[X$@@EapePYaAP
+8A",TZE`"J1C-R+l8DR+AiRm$8@5QKdHT#!`*'jhaDUH[YRqXcG#Q`N+VJ2`+f%5
+Ub+E3'!M86"eV2JZT"Z4iGF*9Xa@AI`L&UA(Zqf'L1[Nfbf'Ti5aANY`%N8-Aa@8
+ZR-b0%Q60E-ePc@`CZ&&Q5d@IV)eVlIF6UkpqieU",Yl*33f#!h)"dPBS'[@Ebp`
+TBN+%YR(G)K8QaSZZ(%IL6YjiQ'6SZlkLRNH9mHUi9+$UK"RZqT5k%2GJQq`FKlR
+rZ99GikS"A)3V-ae5!aFme&bX5-9eI&,M,U+I$KZ#4&D%1E+*Uf20&ATYIEFJPS,
+`'+kDBh6f)QYJ)PSQlKK&b12Z`64rTbJ5T1k4A+*SRQVfDUY,&!hV9HVkYKe$'1b
+F1@`01lHjBCBl)m8)pP%d6Q@10#HG5aM9Y*U-Zhh'$VZVkl+eK36Y3%qf#69@(0"
+RJNQS"lI@!"ME5GKmN!"#X5JHZU22mFEpT$!8J5CYQ[CVmRJJZ!!IET3HEX6$$G,
+$$AMiKr6`$cc-PalQiq([dX2ImA#9p(!9(Uk4(Ul"`ccTB4iHlT-HlX2$,1PK&Ki
+HN!!H(UKGd2kBcbKSelrbS2faZif#p[86#GTcDE13!-#V[84X9pi[IrKUA5!Z*AI
+J5(jDDSkL`19b[fDlHhV"l,3c#IJM(LbB24-&ieE1&Z'm381-q*Ma)%r`QH#H[Q)
+CNJ!b9ba,D4[%3hdpFbZ(JNPJfDFpA!U1B,PL$M&E-8FmZ')1-5ZB)c0E-5F$MZd
+9ph!fph!fpcaj6dTZYpdZ6CI-)bp5i2[$&YFS(0@fAGLqfYFDG!I1"mk6%+b2K@I
+hMX)Gbjfam@&k*)GfZ&92'eh2QVH5-++A#4P86*%C6Qm-3L-23'4R3)cN&ZE3BUI
+f)9J5+qZ9##BrSGJL1HDY36GF9ZD1,6`p,$Hb-l[eRHBDLbkaT,XX%S%M("p1ePJ
++F-%BR@AY*aSEUSpTH%QhGVjSDHY1$8$-fC!!VX,*L&q&jNMi!YY!)-L,XI!f2ND
+G)TYkQC'ART[2laJSEJCj2KJZ684%q,YrD4Ch[[e"*"UqkbpYZp$JXN6db$re[cT
+AkAE281d63hH@NrP0$V(EGLUf1d2Nj-DY1A)HblE6XPr(4iC0$`q5bU$CS[0hBK"
+qE1&@-D4[#bTC6bMQ3ZHf(YSFqacJ1mF),#l0B-3TCq3`-l9e8dGiD(G(f,Rl*dL
+qi83&4fl5rqTmjFlPefQF`5F9fr+rDFb$cB0JLXD$NDTc@bNR%hp`Db0AHK+DjER
+!&XR0N!#@i@C!24$Ek*U+5EMJQVME29AaSUNYjqifh2DVE&Lk$BpC2L5Eh,EEYc8
+Ppf5#"%4MA(2R*CQ!eI@+lS9@hEXEqX*$qMijQ!XUcc[A0dGfr[1[iB9k1"Yaf5+
+,r&+R30Abd*6(Tl,#SBN,01f",B'RmBUK1-`E,0@TcU,a5aYV0Z-f#0&G"&BhE9a
+cKf,ZC40akH&L5H&EcJ#-69"#-Hc8GfMbDlBK*6B4j0%Ph(B!01'8h1#1hf`+IrU
+AjR!VJA[MRNfZd@B-DGE%$VGZk9L`jmkqk&CaEfAJLrIJp)64B3@b$VFL"2PY)h5
+a'mC1CYYX)LG6QkV5fY'NFMC$,N$P"B,lJFlQL),d!RhP$L`i3a0L"$"Lp,Yh-c+
+FG`,dr0B-j9cZSq3hjflF"10AJL6G6k%#kc4$JbHk4ViK-4RD`cR-*)2!D%A+B1D
++eXifmD[EGLM11r!!CF!ImE9$1eDd1Q,dTr1e1hD3!)RB*kN20Ei5*(F)QL2Y(&R
+aL@DSqEf95eDdDT`dA(a4CHjXCJ`(JI,"CR&(d%iZNQk6!P)h"8&NbaY9&1rhKdB
+pRQ@+E43TJ%TC(Llad%JAB5,dDeDKiie48JfFc6cC#4Y&A$&#CHcQH+V)hD,Xp@9
+D!%IFEmqh9[B'+[3$"(pRiqJQ9l!a(#KaP3eP"rMamqL`MKKEl[LbT,KJ&-lfZ8a
+-NA!VJ5'6lc-YfiZQ!qB'i$!lj-E%"SJYjeSkqJ+CKC9JaX"i+Yca1`2$l-9[T'i
+F$[$8Y%al0UbYF&TDF6SRQ5T8reIR@CA"K40-3TH*DYe1U-3**"1d-m&-&iq$qM3
+rkj+Ec+9dEJP!%pL0CL-AL&MkT6,YC"Br4BZ,#-iLGb,)K6,8+jA8e6c@p,Bq%Vd
+c!21P2@P8Cm',ZNiR5b+T9'S8+$95AN8NZX!)Fchr(r-(a-3%&bk8XlZ`(),d!pe
+jQ$j1RI[9Z3hd&A4VTcPDM&Q(qQM*!TIf%Gej)M[9aT*Re8Y@E(dEKAGJI!8!cUP
++!qXB6ZiY29b4122GV)2,,&ZjL%-lR%N`3JT1jVH+&Rq'`@M5X#lUEY-FMalqcK4
+kpHeRaXMr(+j&A',2rD[KbUJHbA6LF9`bbqcJADQRp5XAdT,ZkFA'*j+(E&#5Gf9
+AHY*`m"`hKq0e-+1TB6,4R66-',lNMcK0k@&YQ49eR($4N!"`G2P0[cTR5,i1j&G
+'G`%JPHH`S@2@L-&i8Ra92c8Z,*&LSdmid*c"%i-c'!Qr0P3H2b*iT6CVmULbi[M
+(5Pcj0PBaIR81f`j50I[f-e3c$1M1j,`NCc%jEZ"LZTi",FL!PZ!2Y+#LXh#f,I8
+5NCm0"SLa4(#5j0,Ydk4U+Af#+Jl!8GP`U9'[am(Q4&A5B-FM)-+0kMZ#p1i@PG5
+Be'F,3HDCS3-,Ed%cb`FJKC`J+3CA@)Z+40N)c*Fe2*!!bMf2+)@hH)Nc-(('!@q
+mP0H[#FZKE!mY"aEcjF+%B-,DBZ"-5#"61"laLN-*He#"1pYrEfY8(YENYDp#8Q`
+-$c'0%`m2KejM3c4AFCFEY"HjU$N-(a"p%)(Dp#iCaMM$KcR$KcR$Q$($rl3bc%N
+cBNF'`feSNP#*i)q)*#5GiY02Jj-(#8Rij)1M1[H+RIUjX"d*24TYUT("#G3bB(b
+14MUbi2DKBRflMK)M1"LM2(fZ4QQUT`ES,UA!4!S2P9##(jU$4aLTJeSkJlKaMkV
+NSNbj5,$3SFN[(bi@De%509kC#9mQ"+03B31[82aiT-b)+*r*4BMP)NLRDp+CJ`M
+'9+&G2BUZ3SC$f0`b*&3J3X@j4+B"H6iVHDCM+l*UATD4,P0%*)N%*MSU91eKMFf
+U41Md2EJB&bBL93+Zf%IQSJ)d&U#B6RLI(LNQ$jUTQ4401dqHIjKBb"2#PK*AjRB
+[66)R+(mdijU+miCUP0X9mfjmT0FF"3d!Vq9E&abLTmfr&a[CC$C3SF[`QPP3`)q
+a,XL6E$4j5-E6D@T`'6ZAaQCGfZ&P%rNRQc%a#B4%!"YE`K'iB,hXmcQl(Df,fFR
+0`!d#!-%F2Bb'k&Ph0GZ0T1e-FYY'#*c%"%VFBXa)V[JrAja%lUrF!3di&M+3!%)
+8HMQLkH)&qRF)R$Y0)(Dk4kfJ*@A6m+3Ll5N'-)5-3kRl0K'!Ak3#1+UEB6k1UNi
+Kc"Z5`@%UKX%[eqX(0K%Z1JRa5A%b#P39)5Q2N!!ibrbe`Jj'bSJdDe(6+5rcmh)
+#3d@6MB(UlC0CR9A!V-&Y8H@&B`@ZUM$L$dMU0b%&EGcj)F9@)9+UMC!!dQmLC+S
+b&mcUPEN101@#%*Ch1ID4J)3Hm#kd+Mb&JM)CILS[!93@RpJfTJTh,+80eldm5U*
+jm#5UU4-0cX6a$BSQ@A3$V8j8C+QaB-DQ@m2PY&(+24EQK2eL042$&98kpNUZC!N
++NF8q-S6DF%eAVFfiSV!AAbY-C*R3hX)'bG2jT65NKH#FNaUmb9r$LbF0C5Z63aK
+M`4K#92NBkYMREJfA+R6-4(,ZRXCa0T9LQ4eeMEBK&-V,JlJI3YAGTMb-`1k13m)
+AP@&2$6VKrQdJ&DJ3YbNqqS$J)G,a'"ccfj5kMF1BE0(L-RYRKViH1$NJ0Y+3!'k
+l*NG,2CBL1bRbSq5N'*!![TY%,)`S+eJ"a$`#085AY$`6L$+S0$U$`rZ-$ZmhK3X
+HA%T3!Pj8Tpc)Za5Ub+Sb'@RI+USNaYa(P5,2jP3XQVd`#he)Sr'9aA$aLlU#UBU
+[d-a!kQLJPfep8$8BZNM6)l(MDm-3ZYL%-DSGHHa4%KE(B$$Y3aG&65"%NH!!iaN
+1J'BZ(VaG(`0*cECGk)4N4,,2!#k9QP)N8mS'%(YK(0DcLfhNEf#"$J'EMDYRJfa
+bC5[l("deE`U5c#YY*KVdj9h-+6)(qTPCHlCHZ6XX`Nb'Uc4XUARaf-!'9f@Lb[E
+bJ,JMp*Th0'&!X`LGf9R4%K8'K8j,MQrQNfJkbh,IX'YhYk['qFJ9$+m6Gb5pKJ6
+-+[m"fr8[h,kKlhkD(M0pA"5fE('KdXDNaIXdLl""HTL,)Z3'&b0NcF34e*3QXq"
+3&1iakN,K"5e0Xm-'06QfpR'R&P3M-bqF9q*+ik+&JKe+2e)[qD,KE6dCPET!C#6
+FZ%+['KTX$MHZe@2KQ+D&Ua3A2(a+6"1Mc3"bjm%CE%NjbET[HMN!GcK*%c,hB-T
+-rb++jJND#59ZHUKQh3JZFN20@0RF3R`FE@m$m9&(1ahLZhSFiKjb'Ri4c@iN3a!
+Q5Q'j9ST"dLMRPiYGMR$Y""KP@)#U1&f)J3R%qRDJZjm[SBZi81MN*1q@T3X8mb$
+BENG$9@9@RPd`jDciCq88Bm@,mjSB[@'hldmYKD9[iN302,mKQlkQckJkcKqGiJC
+YqR2TGXQU*j0abZdFPI4C-XRTF`4"!KF0j9cJ1SPYZ!(HS-6CCPl3T3%r1NHPHdp
+Dbj!!6[P3583J+LU*$Upl6l(0p-QV*(B11I*53A#U4fbNDN(C&eE6&i6CHPeGESY
+JmqRTr9#``["cKT23+!"H$p2V6"6d8[Kr&i5Hm9F0#epGqFpcU`H%6fBYq0N#BFZ
+Mp*rDIGGG3UVk0RA+XHqV$kQcNLmN,aILm62QDI92PmkD)D3+*p91YH@aj+`VDVI
+`KR"0mM2khLmq&$+%[`XjFj,A#MeU44lBV[jdG[,8bqUI#e1%CFN[*hrci6FI#@(
+KMp*)BGR6`UcNbmN6K"2VNVqC*ka-[Lcm,hj@#qA6K0q1&j,(#b@FYSprm1$jTmH
+0HhT`bjA"Z)%Vh30#3#J62RlkeeHq%Akp),P$k&Z``b2J8R(+3qSI6"2HIr44iAm
+III6MHfB)Sc1%jfF)Nai6PTiBk"EHQ#'X9aIf,%Zq,6PrF,m`@hhdf-(Nlb4r0IL
+QfYBXR"YmF0Vb[42DK,p-+qQa#h(6"0Ud'Lmi!"*lYlU-X4AHIf[4SLr`)r`lAKb
+j8,$L3X&bGFTJQr"EGCl`dK9K3$hcUGI9Dki)*eHG%-je#"d&2e3I6ABN[b8F&[j
+Pk@"LEh*1F[0J@IFh`X[5L'pqU-j*rQAbQm*[KG5PJc8I*KFQ$kJhFXVb-Fla`bH
+&kF)5GD2`3q%DiIM6*eF)&iA"RY@[Ulm9[K5Q$Mrjc@@Kjm,2ZSAA&kPI[0)RI(c
+0K!Hq'G-Rr13(`XAahH1lCj`I*h3[RcC&+&`jir8C*i@,mi@2IrhM%bm*&em6[Rh
+Q0d*fKr$-VrYqG+jlc(N!N!-B!!!NL!!!9lJ!N!-)!*!$)!!!2c`!"kR`!*!$#PM
+!!%U!!!"+J!#3!aTZ!*!$!AB!6R&+JfBL3Hd!)#!m2c`!!#)mUI!!!8T"CJ4+3'F
++5%")35#!)8%!"%+R3IVrcY$m!3![##mm!!!CELm$B3!#V&52Cd"#1!TH3UF[2%4
+"9%%r2!69U"p`!4(!#Pj+RfFB6R%`2+P`TdC$qJ!U)SK"qJ!J-$bTF+C(5S0R"(!
+"6R91l3!L6R&+JfB#UI4`!%jeB!B!N!8"6R%I1[rf5KpQ%NMRi1""q[rU80"1ZJ@
+Z60m("bmkrpj1G@"b38a"4%4$69!!!`#30&"b3@e)jf$`G&#I`Lp)!#!J6b*8-@N
+!&!!B)8!!*$&m!!%!,0+4)8%!,U!#hm*-h`m'6R9+1!THC``J+J!)C``J3#!3C`B
+[1[q%6R9)jam'3IVrRR!-)LS!"-+i!aTKT'B!!6j)H[q16VS(EPK2X(Vr@QB!!3k
+K'Li)##S!3!!%C`BJH!+QS"XX+J!%+LS!#"JU!!5Ae*A8)$Vr9U%H2cJ#)'B!!1a
+86ba))$Vr4#)'`VJ$'PK"B3$r6#!krcc!Z!-D3IVr1##!5S9Q"+%LB!3J4D!RCJ!
+!Y#T))!j3J%(kr`JJJ#!kr`T4J%(kr`!JJ%*R5(S![#m95(Vr!LmkrZ)[1[lL,cV
+qbLmkrXS[1[l+B3!06M!ICb!r!%U&C`JJ6D!US#YJ"#"0S#-J6U!I)%HJ'c(I!L"
+JB#"1S"mJ4k!EFJ!5"1F*iaRN%3!"!#!#!3$J)%fJD3)!!"q!!5"0S'V9e0I83IV
+qGNU3!'F)F!'JQ(!$S*JJ659)!!K`!%cIB2K1G8cIB2KJ!2kq2`!J6U!I)%HJ'c(
+I!L$9e0I8-$J#)$(!#Q#4b#9)!!K-hf$i6R919J!!51F!1#KZ!!a(q[iU4IVq+L!
+8X**Y"#!5+)"+J'm5)&-LEJ!)SLiJ&0'6NC*`!'!%-$crf8cI(!"1ANje6PErb%M
+R(MJQ,J!)+#i!$#KZ!"""q[fk,8Mre%)ZrmLK'Le)rma96kJF-"mk!!a&!!"[A%K
+Zrq``"90&2`#S$e92,blrl+J0-"mm!!a'!!"[h%)RUCYC6bmZrq``"P0'2`#S$L!
+I,8$rm()"(`'TQb"Zrr"+N!"R%&92,`LTTM!I5-"b"-#"Cm3[,[r`UD0J["!Z!"4
+R#PP2,VJ#TL"IS"Xr2+$m6VS%KP42,8$rd%U!C`!"RLm!6VS$ePK25J"R#R!"(8!
+!&Nlk!KK)E[rN5'lri%KZrpK1ZJ9U6qm!$#!Zrq#K(Le)rp`J#'F!!@3J,[rNS4i
+Y52rS)!KR!!&8,blrj#m)6VS&Z&"2)!0Q!!#Q@8m[2%024%9#CkJI)"mY32r`5S"
+R!!#1)%!L8()Bdm%[#8kk",4B6h)$X%&QGL!0)%"`+0(!,8Mrp#*Zrr!N8A!BeF!
+Y5[ri,`T1ZJ5k@%mY32rm)'lrm+!T8%SQE[r8*dS!+&P2,blrm%kk&F`J(h,Sd)&
+4J#G!!#a96dKkrM)[,[rd5'lrr#m-,`3[,[rF,blri#mZrqK1ZJV'9%m[,[r`UD-
+NE[r8*@lrd!!-*@lrh!!3*@lri!!8*@lrk!!B2cbKQ%kk!eC86bC!2cbSRdkk!dT
+86b)!)!Z`J@B%F!"J!R!")!!P3!!F*83!)#9-!#4)H[[-2cbJr$mmS2a1ZJ,i9%m
+I!%kk&9)r2+'B6VS$$&425S"R"(!"S*JJI!!!!9S`%%M!i)"b"V#"CJa"qJ#Z)R`
+!!!-m)SJGI!!"rmJJE[r-S"Y96kJF-"mk!!a&!!"[G%KZrq``"90&2`#S$e92,bl
+rl+J0-"mm!!a'!!"[h%)RUCYC6bmZrq``"P0'2`#S$L!I,8$rm()"(`'TQe92,bl
+rm+QQ-"p)`()%`)&R##mZrr#TSQ$#*'lrm%U5Ca"96bm+UDB`(dM!FJ6!J@HU,`U
+TSf#N%#lrb"e!!"C-haai6PiJAdr[!!j1d%j@rra)j`!`3Llrr$mmS2a1ZJ)X9%m
+N3%U!Ce`[!%kk!B"B6dS!Ce!J#LC!)%![+!!-2cbJr$mmS2a1ZJ(H9%mI!%kk&$J
+J5b"S!"#J(b",)'J!'+!I)(`!!!&D-"")`1#!FJD`J@B+F!!JI!!!!c`JJ"em!!(
+rr"!Zrra-h``!6Pj1G8j@rqK)jami@8qTG5!I+J")E[rSU(3J$5"!)""bKY#",8$
+rr#"!A%K$l[rX)YJLf&P2,ca%394"2c`%eDQJ)"mS3#"!*&!b+J!)NQS!"$`"0#S
+!"T4U!!)q!MBZrr*)`cJZrqj)a*D%1!&)a*D%DJ*5Jq+$282rpMBZrr")`cJZrqa
+)a*D%1!*)a*D%DJ*5Jq+$282rp$BZrrE@36e$rrSb,[rddN)p3Iri@8p#TdKZrr4
+)HJ"QFJ%I!A)"2`&brbm"3LG#TkN6)"mQ3#m!U(-'K3#3!hJ[$#",F"$4`#m)U2C
+C6kPe)"q`K@3#B2496kPd%"pQ!Q$fF2mr!%*R)"qJ-Lm,U43[$+QM,blrk+Kc60m
+Fq%jH6R8!!J!!6PB!!%MR!$!NEJ!))!SQ3#"!)LJ!!Jb"38a"4'B@)LJ!"Jb"4%0
+08'B+-#J!#R)$X%&R"(!!B!*`!8cI$!"1ANje,`TC6cmmU'j`!4m!6VS5H#"I*%K
+C6cmmUQj`!4m!6VS5CL*I)%Uab@B'-$`#!'!%-$`%!#4I6R919J!!,`-f,J!)-!0
+)`!+!!!!)!%U!E`4`!@!#F!!Q(djH6R919[rm51FF!$BZ!!Jr!dkkrma86ae!rra
+b!E!"CK!#3`Ir6VVrJ,"$EJ4`!'!S@8mr2+LIF!%I!%kk%I!J(bS!@8mr!amZrra
+1ZK(J)"mS!,#&CJ*`!%cI!$K1ANje6PB!!%MR'$!i,J!)*'i!#L"+)"!Q3#"!-K!
+-38&%CLJb+!!#$%&$8QBH0J4brlC"CaSJ+!!%FKMLU!+!!*!$rc)$5-'`J@F%F!"
+J!R!"(8!!$NcI$"K1AL"IA%p1d%j@!!"96dKZ!!K`rcm!6VVrNK!ICa)JEJ!))#J
+!"()BiUJ#3!$rB!*`rdjH6R919J!!98p)EJ!)F2mr!%kkrf33(fF3)'i!##!S!!3
+#J!$rN!0J!R$r6Pj1G8j@!!")jaJi*Qi!##KZ!!`J5c#m!`&`!#4-*)!Q2!!!!56
+ANJD5!!!#5!D5!*!$)#Jm!*!$J0Q5fC)S2!!!"*!!fC,ANYQ5"T)!N!0m"T)!!)!
+!F!!NEJ!3*)!'NJ#3!b3'NJ#3!b!'NJ#3!dJ'NJ#3!cj#3%cI("K1ANje6PErj%M
+R(cJQEJ!)+Li!$#!,+%!Y32rSF#6C`#e-rqa`)0R!,8crm(")fF!Y62rdF$lC`#!
+-N!#,X)9M"R"P6[S!XN*!2J"#3$e!rq3f"h!NYN"N5(!%YN"N"(!!B!a`!$!$@B"
+U!PD!j)"i!$J$,86rq0LZrqJN4"5!)#lrq0#!d+lrm#"!-+lrj(!"&"*b!")#if$
+4E[rN8NGJX%*!2J"`!6`!0JG`(lC!C%4`!EC!C!4`!'!-F!!`!e1!DJ*5J1+!H!!
+i!be%rrcBV[rX*%38J#!Zrrc3J0#Zrr3J3$#'F!%8%R)!%J,MB0a!8NGJY%*!60m
+Fq%jH6R919[r`51FI1#4Z!!JQEJ!-1Li!%#KZ!"*#3$`!-J9`!$!"d)!d"R)!-J+
+`J@m83N!d"R)!-J,5JG+-)%%`J&*'B0T#3$`!F!)p32rb0JDf4@3!!,K#3$i!3N!
+p32r`F!!`!q@!d)SJ3#!3,8$rp$)'F!!`!G#,)%!B%(B!&J5f4f-!!))`,[rfFJ(
+!3G&Zrr"`!$!$8i!d"h)!-J+`J@mq1#lrm(B!0J3Y3rrmeS2@M#"$5P"Q%L!Zrrc
+3J0#-)%!`V[rb9'lrmM)Zrr"`!$!"d)$3M#"!-"!p32r`B"B`"G"!d%Bd,[r`FJ!
+b!Y+"dS`J36#!8NFJ,[rdiSJY32rdB!$rE&*'B!$r4%cI(2K1ANje6PErr%MR($!
+NEJ!)0Li!$#CZ!!ib!h!!-!(QJ$J!-!0b"m""1J"`!#e!rr`d"()!-J,5LL""%K"
+`!"!"0!9b!$)#iU"b!F#"dDlrr#)ZrrcMLG+,)%%b%(!!-!%Y32rm8N8`"A))X%&
+Q"N*!1J"54$)Z!"*`!$!"d)#`V[rmB`*JUK!Zrrm5,J!6dJ'3!!&-h``i6Pj1G8j
+@rra)jamJ*'i!#$JZ!!`k,J!1-J4`!$!"jS!m!$)%G!I#3Mi"GJ!f!0D+)%-3%(3
+!&!!Y3[rmF!!`!63&FJ!b!Y#"jS"b!V#"C`ab!E#"Cb"+J'FdB$)d"R)!-J*8JG+
++)%%5%(!!%!&b%11SJDlrr$3'FJ!b!P+"dSSJ34)3F!!3!H')JDlrr#!Zrr`d"h)
+!-J,LU#e!rra`rh)J0J9d!$3$NS,LU-"Zrrj-h`6i6Pj1G8j@rpK)jami*Qi!##K
+Z!!iJ2!!!!564VJ!5)$`!!!*)dDi!%L!Z!")Y32rXFL$6VJ!5)Li!%Le"rr!N2!#
+3!i$9VJ!5*#i!%Le#rr3N5aJ5GJ!@"#e$rrMQJhS(aN953ce$rp`Q,[riiS0k!mC
+&9%-p3rrQGJ%k,[rQkf-p3rrSIN$)"h`!(!3p4[rLH!(VC&0%286ri#SZrrKq!FU
+(C`Kk!$S%8i9J!RVr28ArhRJ)286rj%T'CdB[,J!5,`!r!e*+,`T1Z[mk6qm!$ZG
+!d@lrj#mZ!")[,[r`2`-[,[rX6VS,#%r[!!i[,[rd2`-[,[rX,blrm%kkr+a2l`!
+13N!p32rB-#lrf,"Z!!aN!!%k-#lriQFk*%!r,[rS,blrp$mZrq3[#dkkrBj2l`!
+-%J!J#R!!%!%p32rDG!!d!05Zrq`J3K!3FJ!5!00Zrq4J($mZrqBr,[rN,`Y1Z[h
+`8%mp32rD-#lrjY&Zrq3`,[rDX'lrhQB@-Llrf&*ZrpK`!$!"d)`J3%)3B!$rHM!
+ZrpU`E[rJCJ!!P$!Zrq*R1L4!2blrk#mZrr3r,[rN,`Y1Z[d'6qm!$")!)!T`!"!
+"28$rfR3!0!$8V[rX)%)3%()!%J$6E[rNB"`r,[rQ2blrj#m,6VVpD&"228$rfM!
+ZrqE4E[rN9QlrfM!ZrpT6E[rD5N"R!2m!1#lrf(B!0J3Y3rrm8i2@M#"$%"!L,[r
+mdS`J34#!8Qlrf'$1%#lrhG!ZrpXd,[rB8Qlrf()!-J,5M#""%)"J!2kq-Llrj(!
+!-!&HJ1D!60mFq%jH6R919[q-51FI1#CZ!!JU,J!-+'i!%#`Z!"3Y5rr)F#6A`#e
+,rq"`)0I!,8[rc(")em!Y5rrN,8crP#Bm!!!"*0HZrj3J2!!!!NM4V[q8F#$4V[q
+8+$`!N!1!fDlrP0QZrj3YE[q8rl3S2!!!"*!!fDlrP#eZrj6rZ0HZrj3YE[q8rlc
+CV[q8,@lrP2r8F(c4V[q8,@lrP2qN)$`!!)!!dDlrP#!Zrj53!)b`K@-+F'8p3!!
+S6[S'HR!!,J"#3$e!ri`NE[qNeI`!!)!!,8VrU#eZrk6rN!!YI!!!J!$rk%KZrqJ
+[,[qN)'i!*%k3!&"2)#lrk'B+F'Fp3!!S6[S'0#4Zrj!!8NUel[qSBfJJE[q3!&*
+)NHlrU#e)rr3JE[q3!*(Zrk3Y52r`)'lrU*(Zrj!!,8Mrl#!)C`iJE[q3!#*Zrk3
+J,[rXSLiNE[qNeHlrl#e+rj!!5'lrm#mZrk3JEJ!N6T!!8%mJ,[r`X+lrp'3+F'F
+p3!!S6[S&`#"Zrj!!8UlrN!!3%"e!rk"b!")!dN&636e"rp!`,[r3d%!p32r5)'i
+!(#!3d+i!)#e!rl!N3#m-,blrZ$mm!53[,[q3!%kkqr*2l`!1-J!J#R!!-!(4V[q
+3!#m-,blrY$mm!53[,[qi6VS(ZNr[!!i[,[qm2c`"*#mZrlJ[,[qd6VVjA%r[!!i
+N3#m-,blrZ$mZrp![,[q3!%kkqk"2l`!1-J!J#R!!-!(4V[q3!#m-,blrY$mZrp!
+[,[qi6VS(D%r[!!i[,[r82blrd#mZrlJ[,[qd6VVj#Nr[!!j`!#i!3N!p32q-,@i
+!)2qX)'lrV,(Zrl"N!!5S3N!p32qB$'i#52qBC!!!`M!ZriaQ!!#-*'lrN!"55VA
+ZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[qSNHlrN!!Y52rX)!K
+R$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,blrT#"Z!#41N!"36b!
+Zrr#`V[rdC!T`Cce!!#K1qJ4#)'lrN!"5V[q3!")3F!!3!5i!F!Jp32q--!Gb!F"
+"d@lrQ$)ZrjK`!$!"d)$3V[qm)%!`%$e!rjJJ"q+),J"6E[q-B!$r1!4Z!NMrQ!a
+Z!3$rQ'33)'lrV&+Zrk`3V[qCB!$r#!4Z!3$rQ$JZrjKf!$B%,82rq0D$eUlrc#"
+$-"!p32qD)Llrq0+ZrmJJ34)3F!!3!6e!rja+3'F!!-)-EJ!BriaL!!#B*'lrN!"
+55VAZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[qSNHlrN!!Y52r
+X)!KR$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,blrT#"Z!#41N!"
+36b!Zrr#`V[rdC!T`Cce!!#K1qJ-S)'lrN!"5V[q3!")3F!!3!63Zriab!$)#ikL
+1J&"ZriaJ!2pLF2pb)$JZrjaf!$B%NS2LU-"(d@lrQL!(jUJZ!*PZria#3$e!rjJ
+`,[qBX'lrdQ3!!-)`,[q-CJ!!M#4Zrj!!8NUel[qSBfJJE[q3!&*)NHlrU#e)rr3
+JE[q3!*(Zrk3Y52r`)'lrU*(Zrj!!,8Mrl#!)C`iJE[q3!#*Zrk3J,[rXSLiNE[q
+NeHlrl#e+rj!!5'lrm#mZrk3JEJ!N6T!!8%mJ,[r`X+lrp'3+F'Fp3!!S6[S#@#"
+Zrj!!8UlrN!!5%(!!%!%Z!(!)28$rM$!(FJ(!3G&ZrjJb,[qBF!!`!G#!d+lre#"
+!-"!p32qB)!ILL#i!8flrM'!!rcB`,[r5N@lrQ$JZrjKf!$B%,82rr0D$eUlrj#"
+$-"!p32qH)Llrr0+Zrq!J34)3F!!3!6e!rja+3'F!!-)-EJ!BriaL!!#B*'lrN!"
+55VAZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[qSNHlrN!!Y52r
+X)!KR$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,blrT#"Z!#41N!"
+36b!Zrr#`V[rdC!T`Cce!!#K1qJ&D)'lrN!"5V[q3!")3F!!3!63Zriab!$)#ikL
+1J&"ZriaJ!2pLF2pb)$JZrjaf!$B%NS2LU-"(d@lrRL!(jUJZ!*PZri`JE[qX-Ll
+rRR!!-!'4`#e)rj5alJ!JC@!JE[q88UlrP"!3)'lrV&+Zrk`3J#"Zrj45V[q8%"!
+JE[qX8UlrV"#!)'lrP&+Zrj33%#"Zrka5V[qX%)!`,[qD8flrQNT!C`$lhL"Zrj4
+5V[q8%"!JE[qX8UlrV"#!B0a@E[qD)'i!'0('-LlrRR!!-!%LE[qXNqi!)*!!LC(
+!,8MrP$!ZrjTR*L"Z!"M4aV(Zrj4M'L"Zrj45V[q8%"!JE[qX8UlrV"#!8flrQQ$
+8,@i!)2q8-#lrQP0ZrjT+3'F!qfBJE[q88UlrP"!3)'lrV&+Zrk`3J'$F)'lrV,(
+Zrl"R#("R28!!+'!8)'lrV*(Z!#!LEJ!F)SK#3$e!!#K-haci6PiJAdr[!#"1d!"
+`2!!q)!!!H#!q-#!Q*L"i)$`p-c)!!$T$Efe`FQ9cFfP[EMT%C@0[EA"bCA0cD@p
+Z-$-`-5jM!!!m!$iJ!!"i)$i`)#BQ)(JJ2$dc-J!!1N0[EA"bCA0cD@pZ1N4PBfp
+YF(*PFh0TEfi`-c!a,Q-!!%j@rqK)jami2Li!##KZ!!`f,J!+F!!`!cJ(FJ!b"*!
+!JA)"X)&[!!'d286rk$e$rqT5E[rS-#lrk,"Z!!TN(()!-J$5M#""%"!d"h)!-J,
+5M#""%K#`!@3#B0C6E[rU-#lrkV"(Baab!$)!dS`J34!30!Gb!$)#dS`J34)3X!&
+M!Q$B-#lrk,"ZrqTP!Q"b1#lrk(B!0J3Y3rr`eS`N3a)5F!!3!6e!rq`k,[rUH!!
+i"5e%rr6BM#C%%"-8J"DZrqdJ,[r`d)$3VJ!3)%!`%$e!rq`L,[rddS(5VJ!3)%%
+b%#3Zrr$8JY5Z!"!J3M#")Llrp0+"dUi!%#""-)"J!2mb-#lrkV"(CJC54f!!r`3
+i"hB!0J3Y3rrieS`N3a)5F!!3!6e!rq`m,[rUHJ!k"Le&rrcDM#C&%"-8J"DZrqd
+J,[rid)$3VJ!3)%!`%$e!rq`L,[rmdS(5VJ!3)%%b%#3ZrrM8JY5Z!"!J3M#")Ll
+rr0+"dUi!%#""-)!J,[rm)Llrq*!!J63Z!!Tb!$)#*#lrr&+#NS+`J@`H,bi!%#m
+-2`Br"%kkrPa2l`!--#lrkP*!2J"J!2jF,bi!%#m-2bi!#M!ZrqT53$m!6VVq0Nr
+[!!`pE[rU!!TJ!2ii60mFq%jH6R919[rN51FI1#4Z!!Jk,J!-*Qi!$LKZ!")Y62r
+`)$`!!!%NfF!Y62rd3N!m!$B'YN9N,(J!1!-Y42rif)SJ4"!3)Llrq0+Zrr!J34#
+!)#lrq0#!d+lrp#"!-)054Q$1,blrp#mZrr!r"8*R6VVpXNr[!!a#3$`!0JDf4@3
+5F!!`!p#Zrr!J3%S3CJ454Q$SF!!Y32rN0JDf4@3!!+K+3fFb)#lrj(J!1!-Y42r
+mf+lrm#"%&""b!")#*Llrr&1$eUlrm#"$&K"d!"3$NS,MU#e!rq3d"R)!-J,5V[r
+`)%%5%(!!%!%q!#eZrq6rl(!!,8$rk$!(8dG+3'FJ)#lrk11))Llrl(3"`S+!J5e
+!rqJJ,[rXiSJY32rXB0Jd"R)!-J,5JG+Zrr3J36)3F!!`!H@!d)XJ3##ZrqK54P+
+Zrq4J!2p860mFq%jH6R8LAb"IS#8ZJ'S#3TG1d5*I%Km`(dS"C`5R4Q!#SdBZL%l
+4)Pm5(c!I)&p+!@F%TNGJ!U*(6Y%!N!-+!$LJ!3!&!*!'!3!!!C!!Y`!"MlF!!!4
+B"Y-he!0D!*!$(!1q!"0%594-!!d!SN&-8P3!#J&+8e45)!!"!Fj3Ff9d!!!"jN4
+-6dF!!J(b8e45)`!!!KC35808!!!#)RCPFR-!!3)ZBfPMEJ!!!NC*3dp1!!!#8NP
+$6L-!"!*H4P*&4J!%!TT#6N4-!!%#eN&9Fc)!!!,ZBA9cG!!"![TTBf`i!!!$%N0
+24%8!"`-H4%&833!!!hj659T&!!!$LNCPBA3!!!1@"!(rrb!!N!L&rrmN!!#!"Y-
+h"!#(rrm!N!2@!*!&K[rr*!!"*JE60``!J2rr!!!"T`#3"EArrb!!!J8!N!@#rrm
+!!!*h!*!%!qMrrb!!!Y8!N!@)rrm!!!-"!*!%!J$rr`!!!pN!N!3#!Irr!!!%&`#
+3"!4,!#J%!"5!"Y-h*!5[rrm!!"63!*!%!3F!0#!!&3i!N!3%!Irr)!!%B`#3"B,
+rrb!!"(-!N!@&rrmN!!5$"Y-h#!#(rrmJ!!56!*!&K[rr*!!%S`E60bJ!J2rr)!!
+%X`#3"B(rrb!!"--!N!@)rrmJ!!66!*!%!J$rrb!!"18!N!3#!Irr)!!%p3#3"!5
+[rrm!!"@m!*!%!J#3!b!!"38!N!3#!3!()!!&&3#3"B$rr`!!"5%!N!3$k2rr)!!
+*@!#3"!4,!"!%!"+U"Y-h&!%(!"`J!",$!*!&J2rr!!!*G!#3"!2Srrm!!!Qd!*!
+&![rr)!!5HJ#3"3(rrb!!%TJ!N!3%5rrr"!!5h`E60aJ%5rrr"!!8"3E60a`!J2r
+r!!!9c!#3"B(rr`!!&Y!!N!@#rrm!!"I8!*!&Jrrr!!!Bf!#3"B6rr`!!'G`!N!@
+!rrm!!"VJ!*!&JIrr!!!Dk`#3"B,rr`!!'[B!N!@$rrm!!"X"!*!&K2rr!!!E$!#
+3"!%!rrm!!"XA!*!&J2rr!!!E0`#3"d!!!"Y[!*!&K2rr!!!EN`#3"dm!!"ZA!*!
+&K2rr!!!EmJ#3"3%!AK`!(rB'dcFJ!!)!D"`!NEm'dcG!!!-!FK`!VG3'dcFX!!3
+!I"`!p8)'dcF`!!8!KK`"*Xm'dcFd!!B!N!!F!8RZ"Y-h2!!!rrmS!A80!*!&"rr
+r!!&e0`#3"[rr+!"KZ!#3"2q3"!!"G5N!N!Err`!"MkN!N!3'F(*[EA"d#-3JFh9
+QCQPi#dPZFf9bG#"%DA0V#d9iDA0dD@jR)&"A#dPZFf9bG#"%DA0V#d9iDA0dD@j
+R)&"A$NphEQ9b)(*PFfpeFQ0P$NphEQ9b)(*PFfpeFQ0P#90PCfePER3J-3P6C@G
+YC@jd)$)*8f9RE@9ZG#!c#90PCfePER3J03P6C@GYC@jd)$B*8f9RE@9ZG#!f[f3:
diff --git a/tcl/mac/tclMacResource.c b/tcl/mac/tclMacResource.c
index 1695ca6ca1d..a28c03088ca 100644
--- a/tcl/mac/tclMacResource.c
+++ b/tcl/mac/tclMacResource.c
@@ -134,8 +134,6 @@ Tcl_ResourceObjCmd(
int index, result;
long fileRef, rsrcId;
FSSpec fileSpec;
- Tcl_DString buffer;
- char *nativeName;
char *stringPtr;
char errbuf[16];
OpenResourceFork *resourceRef;
@@ -396,9 +394,9 @@ resourceRef? resourceType");
Handle pathHandle;
short pathLength;
Str255 fileName;
+ Tcl_DString dstr;
- if (strcmp(Tcl_GetStringFromObj(objv[2], NULL), "ROM Map")
- == 0) {
+ if (strcmp(Tcl_GetString(objv[2]), "ROM Map") == 0) {
Tcl_SetStringObj(resultPtr,"no file path for ROM Map", -1);
return TCL_ERROR;
}
@@ -429,9 +427,12 @@ resourceRef? resourceType");
}
HLock(pathHandle);
- Tcl_SetStringObj(resultPtr,*pathHandle,pathLength);
+ Tcl_ExternalToUtfDString(NULL, *pathHandle, pathLength, &dstr);
+
+ Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
HUnlock(pathHandle);
DisposeHandle(pathHandle);
+ Tcl_DStringFree(&dstr);
}
return TCL_OK;
case RESOURCE_LIST:
@@ -471,6 +472,7 @@ resourceRef? resourceType");
if (resource != NULL) {
GetResInfo(resource, &id, (ResType *) &rezType, theName);
if (theName[0] != 0) {
+
objPtr = Tcl_NewStringObj((char *) theName + 1,
theName[0]);
} else {
@@ -492,22 +494,27 @@ resourceRef? resourceType");
}
return TCL_OK;
- case RESOURCE_OPEN:
+ case RESOURCE_OPEN: {
+ Tcl_DString ds, buffer;
+ char *str, *native;
+ int length;
+
if (!((objc == 3) || (objc == 4))) {
Tcl_WrongNumArgs(interp, 2, objv, "fileName ?permissions?");
return TCL_ERROR;
}
- stringPtr = Tcl_GetStringFromObj(objv[2], &length);
- nativeName = Tcl_TranslateFileName(interp, stringPtr, &buffer);
- if (nativeName == NULL) {
- return TCL_ERROR;
+ str = Tcl_GetStringFromObj(objv[2], &length);
+ if (Tcl_TranslateFileName(interp, str, &buffer) == NULL) {
+ return TCL_ERROR;
}
- err = FSpLocationFromPath(strlen(nativeName), nativeName,
- &fileSpec) ;
+ native = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer), &ds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &fileSpec);
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&buffer);
+
if (!((err == noErr) || (err == fnfErr))) {
- Tcl_AppendStringsToObj(resultPtr,
- "invalid path", (char *) NULL);
+ Tcl_AppendStringsToObj(resultPtr, "invalid path", (char *) NULL);
return TCL_ERROR;
}
@@ -600,8 +607,8 @@ resourceRef? resourceType");
CloseResFile(fileRef);
return TCL_ERROR;
}
-
return TCL_OK;
+ }
case RESOURCE_READ:
if (!((objc == 4) || (objc == 5))) {
Tcl_WrongNumArgs(interp, 2, objv,
@@ -629,7 +636,7 @@ resourceRef? resourceType");
if (resource != NULL) {
size = GetResourceSizeOnDisk(resource);
- Tcl_SetStringObj(resultPtr, *resource, size);
+ Tcl_SetByteArrayObj(resultPtr, (unsigned char *) *resource, size);
/*
* Don't release the resource unless WE loaded it...
@@ -740,7 +747,7 @@ resourceRef? resourceType");
if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
return TCL_ERROR;
}
- stringPtr = Tcl_GetStringFromObj(objv[i+1], &length);
+ stringPtr = (char *) Tcl_GetByteArrayFromObj(objv[i+1], &length);
if (gotInt == false) {
rsrcId = UniqueID(rezType);
@@ -902,7 +909,7 @@ resourceRef? resourceType");
return result;
default:
- panic("Tcl_GetIndexFromObject returned unrecognized option");
+ panic("Tcl_GetIndexFromObj returned unrecognized option");
return TCL_ERROR; /* Should never be reached. */
}
}
@@ -947,7 +954,7 @@ Tcl_MacSourceObjCmd(
}
if (objc == 2) {
- string = TclGetStringFromObj(objv[1], &length);
+ string = Tcl_GetStringFromObj(objv[1], &length);
return Tcl_EvalFile(interp, string);
}
@@ -955,9 +962,9 @@ Tcl_MacSourceObjCmd(
* The following code supports a few older forms of this command
* for backward compatability.
*/
- string = TclGetStringFromObj(objv[1], &length);
+ string = Tcl_GetStringFromObj(objv[1], &length);
if (!strcmp(string, "-rsrc") || !strcmp(string, "-rsrcname")) {
- rsrcName = TclGetStringFromObj(objv[2], &length);
+ rsrcName = Tcl_GetStringFromObj(objv[2], &length);
} else if (!strcmp(string, "-rsrcid")) {
if (Tcl_GetLongFromObj(interp, objv[2], &rsrcID) != TCL_OK) {
return TCL_ERROR;
@@ -968,18 +975,16 @@ Tcl_MacSourceObjCmd(
}
if (objc == 4) {
- fileName = TclGetStringFromObj(objv[3], &length);
+ fileName = Tcl_GetStringFromObj(objv[3], &length);
}
return Tcl_MacEvalResource(interp, rsrcName, rsrcID, fileName);
sourceFmtErr:
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), errStr, "should be \"",
- Tcl_GetStringFromObj(objv[0], (int *) NULL),
- " fileName\" or \"",
- Tcl_GetStringFromObj(objv[0], (int *) NULL),
- " -rsrc name ?fileName?\" or \"",
- Tcl_GetStringFromObj(objv[0], (int *) NULL),
- " -rsrcid id ?fileName?\"", (char *) NULL);
+ Tcl_GetString(objv[0]), " fileName\" or \"",
+ Tcl_GetString(objv[0]), " -rsrc name ?fileName?\" or \"",
+ Tcl_GetString(objv[0]), " -rsrcid id ?fileName?\"",
+ (char *) NULL);
return TCL_ERROR;
}
@@ -1102,8 +1107,7 @@ Tcl_BeepObjCmd(
} else {
Tcl_AppendStringsToObj(resultPtr, " \"", sndArg,
"\" is not a valid sound. (Try ",
- Tcl_GetStringFromObj(objv[0], (int *) NULL),
- " -list)", NULL);
+ Tcl_GetString(objv[0]), " -list)", NULL);
return TCL_ERROR;
}
}
@@ -1585,13 +1589,14 @@ Tcl_SetOSTypeObj(
Tcl_RegisterObjType(&osType);
}
- Tcl_InvalidateStringRep(objPtr);
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
oldTypePtr->freeIntRepProc(objPtr);
}
objPtr->internalRep.longValue = newOSType;
objPtr->typePtr = &osType;
+
+ Tcl_InvalidateStringRep(objPtr);
}
/*
@@ -1700,7 +1705,7 @@ SetOSTypeFromAny(
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
if (length != 4) {
if (interp != NULL) {
@@ -1913,15 +1918,16 @@ TclMacRegisterResourceFork(
* to fix it here, OR because it is the ROM MAP, which has a
* fileRef, but can't be gotten to by PBGetFCBInfo.
*/
-
if ((err == noErr)
&& (newFileRec.ioFCBVRefNum == oldFileRec.ioFCBVRefNum)
&& (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm)) {
- /* In MacOS 8.1 it seems like we get different file refs even though
- * we pass the same file & permissions. This is not what Inside Mac
- * says should happen, but it does, so if it does, then close the new res
- * file and return the original one...
- */
+ /*
+ * In MacOS 8.1 it seems like we get different file refs even
+ * though we pass the same file & permissions. This is not
+ * what Inside Mac says should happen, but it does, so if it
+ * does, then close the new res file and return the original
+ * one...
+ */
if (filePermissionFlag == ((oldFileRec.ioFCBFlags >> 12) & 0x1)) {
CloseResFile(fileRef);
@@ -1929,8 +1935,7 @@ TclMacRegisterResourceFork(
break;
} else {
if (tokenPtr != NULL) {
- Tcl_SetStringObj(tokenPtr,
- "Resource already open with different permissions.", -1);
+ Tcl_SetStringObj(tokenPtr, "Resource already open with different permissions.", -1);
}
return TCL_ERROR;
}
diff --git a/tcl/mac/tclMacResource.r b/tcl/mac/tclMacResource.r
index 4bde129b4e9..8a58c84c5ca 100644
--- a/tcl/mac/tclMacResource.r
+++ b/tcl/mac/tclMacResource.r
@@ -44,14 +44,14 @@ resource 'vers' (1) {
TCL_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TCL_PATCH_LEVEL,
- TCL_PATCH_LEVEL ", by Ray Johnson © Sun Microsystems"
+ TCL_PATCH_LEVEL ", by Ray Johnson & Jim Ingham © Scriptics Inc."
};
resource 'vers' (2) {
TCL_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TCL_PATCH_LEVEL,
- "Simple Tcl Shell " TCL_PATCH_LEVEL " © 1996"
+ "Simple Tcl Shell " TCL_PATCH_LEVEL " © 1996 - 1999"
};
@@ -67,9 +67,7 @@ resource 'vers' (2) {
* will load the TEXT resource named "Init".
*/
-read 'TEXT' (0, "Init", purgeable, preload) "::library:init.tcl";
-read 'TEXT' (1, "History", purgeable,preload) "::library:history.tcl";
-read 'TEXT' (2, "Word", purgeable,preload) "::library:word.tcl";
+#include "tclMacTclCode.r"
/*
* The following resource is used when creating the 'env' variable in
diff --git a/tcl/mac/tclMacShLib.exp b/tcl/mac/tclMacShLib.exp
index 89361149844..020380fca00 100644
--- a/tcl/mac/tclMacShLib.exp
+++ b/tcl/mac/tclMacShLib.exp
@@ -197,6 +197,7 @@ SetIsStationery
SetNameLocked
Share
StrToAddr
+TclAccess
TclAllocateFreeObjects
TclChdir
TclCleanupByteCode
@@ -250,7 +251,6 @@ TclEmitForwardJump
TclExecuteByteCode
TclExpandCodeArray
TclExpandJumpFixupArray
-TclExpandParseValue
TclExprFloatError
TclFileAttrsCmd
TclFileCopyCmd
@@ -303,7 +303,7 @@ TclIsProc
TclLoadFile
TclLooksLikeInt
TclLookupVar
-TclMacAccess
+TclpAccess
TclMacCreateEnv
TclMacExitHandler
TclMacFOpenHack
@@ -313,7 +313,7 @@ TclMacOSErrorToPosixError
TclMacReadlink
TclMacRemoveTimer
TclMacStartTimer
-TclMacStat
+TclpStat
TclMacTimerExpired
TclMatchFiles
TclNeedSpace
@@ -321,9 +321,6 @@ TclObjIndexForString
TclObjInterpProc
TclObjInvoke
TclObjInvokeGlobal
-TclParseBraces
-TclParseNestedCmd
-TclParseQuotes
TclPlatformExit
TclPlatformInit
TclPreventAliasLoop
@@ -341,6 +338,7 @@ TclSetEnv
TclSetIndexedScalar
TclSetupEnv
TclSockGetPort
+TclStat
TclTeardownNamespace
TclTestChannelCmd
TclTestChannelEventCmd
@@ -528,7 +526,6 @@ Tcl_GlobalEvalObj
Tcl_GlobalObjCmd
Tcl_HashStats
Tcl_HideCommand
-Tcl_HistoryCmd
Tcl_IfCmd
Tcl_Import
Tcl_IncrCmd
diff --git a/tcl/mac/tclMacSock.c b/tcl/mac/tclMacSock.c
index 690bee29699..b8904ebfd6b 100644
--- a/tcl/mac/tclMacSock.c
+++ b/tcl/mac/tclMacSock.c
@@ -82,6 +82,9 @@ typedef struct TcpState {
rdsEntry rdsarray[5+1]; /* Array used when cleaning out recieve
* buffers on a closing socket. */
Tcl_Channel channel; /* Channel associated with this socket. */
+ int writeBufferSize; /* Size of buffer to hold data for
+ * asynchronous writes. */
+ void *writeBuffer; /* Buffer for async write data. */
struct TcpState *nextPtr; /* The next socket on the global socket
* list. */
} TcpState;
@@ -179,6 +182,13 @@ static void TcpWatch _ANSI_ARGS_((ClientData instanceData,
static int WaitForSocketEvent _ANSI_ARGS_((TcpState *infoPtr,
int mask, int *errorCodePtr));
+pascal void NotifyRoutine (
+ StreamPtr tcpStream,
+ unsigned short eventCode,
+ Ptr userDataPtr,
+ unsigned short terminReason,
+ struct ICMPReport *icmpMsg);
+
/*
* This structure describes the channel type structure for TCP socket
* based IO:
@@ -206,6 +216,7 @@ static Tcl_ChannelType tcpChannelType = {
ResultUPP resultUPP = NULL;
TCPIOCompletionUPP completeUPP = NULL;
TCPIOCompletionUPP closeUPP = NULL;
+TCPNotifyUPP notifyUPP = NULL;
/*
* Built-in commands, and the procedures associated with them:
@@ -240,11 +251,15 @@ static PortInfo portServices[] = {
{NULL, 0},
};
-/*
- * Every open socket has an entry on the following list.
- */
+typedef struct ThreadSpecificData {
+ /*
+ * Every open socket has an entry on the following list.
+ */
+
+ TcpState *socketList;
+} ThreadSpecificData;
-static TcpState *socketList = NULL;
+static Tcl_ThreadDataKey dataKey;
/*
* Globals for holding information about OS support for sockets.
@@ -284,64 +299,78 @@ InitSockets()
ParamBlockRec pb;
OSErr err;
long response;
+ ThreadSpecificData *tsdPtr;
+
+ if (! initialized) {
+ /*
+ * Do process wide initialization.
+ */
- initialized = 1;
- Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
-
- if (Gestalt(gestaltMacTCPVersion, &response) == noErr) {
- hasSockets = true;
- } else {
- hasSockets = false;
- }
-
- if (!hasSockets) {
- return;
- }
-
- /*
- * Load MacTcp driver and name server resolver.
- */
-
-
- pb.ioParam.ioCompletion = 0L;
- pb.ioParam.ioNamePtr = "\p.IPP";
- pb.ioParam.ioPermssn = fsCurPerm;
- err = PBOpenSync(&pb);
- if (err != noErr) {
- hasSockets = 0;
- return;
- }
- driverRefNum = pb.ioParam.ioRefNum;
-
- socketBufferSize = GetBufferSize();
- err = OpenResolver(NULL);
- if (err != noErr) {
- hasSockets = 0;
- return;
+ initialized = 1;
+
+ if (Gestalt(gestaltMacTCPVersion, &response) == noErr) {
+ hasSockets = true;
+ } else {
+ hasSockets = false;
+ }
+
+ if (!hasSockets) {
+ return;
+ }
+
+ /*
+ * Load MacTcp driver and name server resolver.
+ */
+
+
+ pb.ioParam.ioCompletion = 0L;
+ pb.ioParam.ioNamePtr = "\p.IPP";
+ pb.ioParam.ioPermssn = fsCurPerm;
+ err = PBOpenSync(&pb);
+ if (err != noErr) {
+ hasSockets = 0;
+ return;
+ }
+ driverRefNum = pb.ioParam.ioRefNum;
+
+ socketBufferSize = GetBufferSize();
+ err = OpenResolver(NULL);
+ if (err != noErr) {
+ hasSockets = 0;
+ return;
+ }
+
+ GetCurrentProcess(&applicationPSN);
+ /*
+ * Create UPP's for various callback routines.
+ */
+
+ resultUPP = NewResultProc(DNRCompletionRoutine);
+ completeUPP = NewTCPIOCompletionProc(IOCompletionRoutine);
+ closeUPP = NewTCPIOCompletionProc(CloseCompletionRoutine);
+ notifyUPP = NewTCPNotifyProc(NotifyRoutine);
+
+ /*
+ * Install an ExitToShell patch. We use this patch instead
+ * of the Tcl exit mechanism because we need to ensure that
+ * these routines are cleaned up even if we crash or are forced
+ * to quit. There are some circumstances when the Tcl exit
+ * handlers may not fire.
+ */
+
+ TclMacInstallExitToShellPatch(CleanUpExitProc);
}
- GetCurrentProcess(&applicationPSN);
/*
- * Create UPP's for various callback routines.
+ * Do per-thread initialization.
*/
- resultUPP = NewResultProc(DNRCompletionRoutine);
- completeUPP = NewTCPIOCompletionProc(IOCompletionRoutine);
- closeUPP = NewTCPIOCompletionProc(CloseCompletionRoutine);
-
- /*
- * Install an ExitToShell patch. We use this patch instead
- * of the Tcl exit mechanism because we need to ensure that
- * these routines are cleaned up even if we crash or are forced
- * to quit. There are some circumstances when the Tcl exit
- * handlers may not fire.
- */
-
- TclMacInstallExitToShellPatch(CleanUpExitProc);
-
- Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
-
- initialized = 1;
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr->socketList = NULL;
+ Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(SocketExitHandler, (ClientData) NULL);
+ }
}
/*
@@ -370,13 +399,12 @@ SocketExitHandler(
/* CleanUpExitProc();
TclMacDeleteExitToShellPatch(CleanUpExitProc); */
}
- initialized = 0;
}
/*
*----------------------------------------------------------------------
*
- * TclHasSockets --
+ * TclpHasSockets --
*
* This function determines whether sockets are available on the
* current system and returns an error in interp if they are not.
@@ -393,12 +421,10 @@ SocketExitHandler(
*/
int
-TclHasSockets(
+TclpHasSockets(
Tcl_Interp *interp) /* Interp for error messages. */
{
- if (!initialized) {
- InitSockets();
- }
+ InitSockets();
if (hasSockets) {
return TCL_OK;
@@ -434,6 +460,7 @@ SocketSetupProc(
{
TcpState *statePtr;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -443,7 +470,7 @@ SocketSetupProc(
* Check to see if there is a ready socket. If so, poll.
*/
- for (statePtr = socketList; statePtr != NULL;
+ for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
if (statePtr->flags & TCP_RELEASE) {
continue;
@@ -480,6 +507,7 @@ SocketCheckProc(
TcpState *statePtr;
SocketEvent *evPtr;
TcpState dummyState;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -491,7 +519,7 @@ SocketCheckProc(
* events).
*/
- for (statePtr = socketList; statePtr != NULL;
+ for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
/*
* Check to see if this socket is dead and needs to be cleaned
@@ -702,10 +730,14 @@ TcpClose(
InitMacTCPParamBlock(&closePB, TCPClose);
closePB.tcpStream = tcpStream;
closePB.ioCompletion = NULL;
+ closePB.csParam.close.ulpTimeoutValue = 60 /* seconds */;
+ closePB.csParam.close.ulpTimeoutAction = 1 /* 1:abort 0:report */;
+ closePB.csParam.close.validityFlags = timeoutValue | timeoutAction;
err = PBControlSync((ParmBlkPtr) &closePB);
if (err != noErr) {
Debugger();
- panic("error closing server socket");
+ goto afterRelease;
+ /* panic("error closing server socket"); */
}
statePtr->flags |= TCP_RELEASE;
@@ -725,8 +757,17 @@ TcpClose(
* Free the buffer space used by the socket and the
* actual socket state data structure.
*/
-
- ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
+ afterRelease:
+
+ /*
+ * Have to check whether the pointer is NULL, since we could get here
+ * on a failed socket open, and then the rcvBuff would never have been
+ * allocated.
+ */
+
+ if (err == noErr) {
+ ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
+ }
FreeSocketInfo(statePtr);
return 0;
}
@@ -741,26 +782,32 @@ TcpClose(
closePB.tcpStream = tcpStream;
closePB.ioCompletion = NULL;
err = PBControlSync((ParmBlkPtr) &closePB);
- if (err != noErr) {
- panic("error closing async connect socket");
- }
- statePtr->flags |= TCP_RELEASE;
+ if (err == noErr) {
+ statePtr->flags |= TCP_RELEASE;
- InitMacTCPParamBlock(&statePtr->pb, TCPRelease);
- statePtr->pb.tcpStream = statePtr->tcpStream;
- err = PBControlSync((ParmBlkPtr) &statePtr->pb);
- if (err != noErr) {
- panic("error releasing async connect socket");
+ InitMacTCPParamBlock(&closePB, TCPRelease);
+ closePB.tcpStream = tcpStream;
+ closePB.ioCompletion = NULL;
+
+ err = PBControlSync((ParmBlkPtr) &closePB);
}
/*
* Free the buffer space used by the socket and the
- * actual socket state data structure.
+ * actual socket state data structure. However, if the
+ * RELEASE returns an error, then the rcvBuff is usually
+ * bad, so we can't release it. I think this means we will
+ * leak the buffer, so in the future, we may want to track the
+ * buffers separately, and nuke them on our own (or just not
+ * use MacTCP!).
*/
- ckfree((char *) statePtr->pb.csParam.create.rcvBuff);
+ if (err == noErr) {
+ ckfree((char *) closePB.csParam.create.rcvBuff);
+ }
+
FreeSocketInfo(statePtr);
- return 0;
+ return err;
}
/*
@@ -1109,7 +1156,7 @@ TcpInput(
*
* TcpGetHandle --
*
- * Called from Tcl_GetChannelFile to retrieve handles from inside
+ * Called from Tcl_GetChannelHandle to retrieve handles from inside
* a file based channel.
*
* Results:
@@ -1210,8 +1257,26 @@ TcpOutput(
if (toWrite < amount) {
amount = toWrite;
}
+
+ /* We need to copy the data, otherwise the caller may overwrite
+ * the buffer in the middle of our asynchronous call
+ */
+
+ if (amount > statePtr->writeBufferSize) {
+ /*
+ * need to grow write buffer
+ */
+
+ if (statePtr->writeBuffer != (void *) NULL) {
+ ckfree(statePtr->writeBuffer);
+ }
+ statePtr->writeBuffer = (void *) ckalloc(amount);
+ statePtr->writeBufferSize = amount;
+ }
+ memcpy(statePtr->writeBuffer, buf, amount);
+ statePtr->dataSegment[0].ptr = statePtr->writeBuffer;
+
statePtr->dataSegment[0].length = amount;
- statePtr->dataSegment[0].ptr = buf;
statePtr->dataSegment[1].length = 0;
InitMacTCPParamBlock(&statePtr->pb, TCPSend);
statePtr->pb.ioCompletion = completeUPP;
@@ -1470,6 +1535,7 @@ NewSocketInfo(
StreamPtr tcpStream)
{
TcpState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
statePtr->tcpStream = tcpStream;
@@ -1479,8 +1545,10 @@ NewSocketInfo(
statePtr->watchMask = 0;
statePtr->acceptProc = (Tcl_TcpAcceptProc *) NULL;
statePtr->acceptProcData = (ClientData) NULL;
- statePtr->nextPtr = socketList;
- socketList = statePtr;
+ statePtr->writeBuffer = (void *) NULL;
+ statePtr->writeBufferSize = 0;
+ statePtr->nextPtr = tsdPtr->socketList;
+ tsdPtr->socketList = statePtr;
return statePtr;
}
@@ -1505,17 +1573,24 @@ static void
FreeSocketInfo(
TcpState *statePtr) /* The state pointer to free. */
{
- if (statePtr == socketList) {
- socketList = statePtr->nextPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (statePtr == tsdPtr->socketList) {
+ tsdPtr->socketList = statePtr->nextPtr;
} else {
TcpState *p;
- for (p = socketList; p != NULL; p = p->nextPtr) {
+ for (p = tsdPtr->socketList; p != NULL; p = p->nextPtr) {
if (p->nextPtr == statePtr) {
p->nextPtr = statePtr->nextPtr;
break;
}
}
}
+
+ if (statePtr->writeBuffer != (void *) NULL) {
+ ckfree(statePtr->writeBuffer);
+ }
+
ckfree((char *) statePtr);
}
@@ -1542,7 +1617,7 @@ Tcl_MakeTcpClientChannel(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(NULL) != TCL_OK) {
+ if (TclpHasSockets(NULL) != TCL_OK) {
return NULL;
}
@@ -1621,6 +1696,7 @@ CreateSocket(
InitMacTCPParamBlock(&pb, TCPCreate);
pb.csParam.create.rcvBuff = buffer;
pb.csParam.create.rcvBuffLen = socketBufferSize;
+ pb.csParam.create.notifyProc = nil /* notifyUPP */;
err = PBControlSync((ParmBlkPtr) &pb);
if (err != noErr) {
Tcl_SetErrno(0); /* TODO: set to ENOSR - maybe?*/
@@ -1645,6 +1721,10 @@ CreateSocket(
statePtr->pb.csParam.open.localPort = statePtr->port;
statePtr->pb.ioCompletion = completeUPP;
statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
+ statePtr->pb.csParam.open.ulpTimeoutValue = 100;
+ statePtr->pb.csParam.open.ulpTimeoutAction = 1 /* 1:abort 0:report */;
+ statePtr->pb.csParam.open.commandTimeoutValue = 0 /* infinity */;
+
statePtr->flags |= TCP_LISTENING;
err = PBControlAsync((ParmBlkPtr) &(statePtr->pb));
@@ -1674,12 +1754,18 @@ CreateSocket(
*/
InitMacTCPParamBlock(&statePtr->pb, TCPActiveOpen);
+
statePtr->pb.tcpStream = tcpStream;
statePtr->pb.csParam.open.remoteHost = macAddr;
statePtr->pb.csParam.open.remotePort = port;
statePtr->pb.csParam.open.localHost = 0;
statePtr->pb.csParam.open.localPort = myport;
- statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
+ statePtr->pb.csParam.open.userDataPtr = (Ptr) statePtr;
+ statePtr->pb.csParam.open.validityFlags = timeoutValue | timeoutAction;
+ statePtr->pb.csParam.open.ulpTimeoutValue = 60 /* seconds */;
+ statePtr->pb.csParam.open.ulpTimeoutAction = 1 /* 1:abort 0:report */;
+ statePtr->pb.csParam.open.commandTimeoutValue = 0;
+
statePtr->pb.ioCompletion = completeUPP;
if (async) {
statePtr->flags |= TCP_ASYNC_CONNECT;
@@ -1769,7 +1855,7 @@ Tcl_OpenTcpClient(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
@@ -1820,7 +1906,7 @@ Tcl_OpenTcpServer(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
@@ -1875,6 +1961,7 @@ SocketEventProc(
TcpState *statePtr;
SocketEvent *eventPtr = (SocketEvent *) evPtr;
int mask = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -1884,7 +1971,7 @@ SocketEventProc(
* Find the specified socket on the socket list.
*/
- for (statePtr = socketList; statePtr != NULL;
+ for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
if ((statePtr == eventPtr->statePtr) &&
(statePtr->tcpStream == eventPtr->tcpStream)) {
@@ -1966,23 +2053,48 @@ WaitForSocketEvent(
statusPB.csCode = TCPStatus;
err = PBControlSync((ParmBlkPtr) &statusPB);
if (err != noErr) {
- statePtr->checkMask |= (TCL_READABLE | TCL_WRITABLE);
- return 1;
+ /*
+ * I am not sure why it is right to return 1 - indicating success
+ * for synchronous sockets when an attempt to get status on the
+ * driver yeilds an error. But it is CERTAINLY wrong for async
+ * sockect which have not yet connected.
+ */
+
+ if (statePtr->flags & TCP_ASYNC_CONNECT) {
+ *errorCodePtr = EWOULDBLOCK;
+ return 0;
+ } else {
+ statePtr->checkMask |= (TCL_READABLE | TCL_WRITABLE);
+ return 1;
+ }
}
statePtr->checkMask = 0;
- if (statusPB.csParam.status.amtUnreadData > 0) {
- statePtr->checkMask |= TCL_READABLE;
- }
- if (!(statePtr->flags & TCP_WRITING)
- && (statusPB.csParam.status.sendWindow -
- statusPB.csParam.status.amtUnackedData) > 0) {
- statePtr->flags &= ~(TCP_ASYNC_CONNECT);
- statePtr->checkMask |= TCL_WRITABLE;
- }
- if (mask & statePtr->checkMask) {
- return 1;
- }
-
+
+ /*
+ * The "6" below is the "connection being established" flag. I couldn't
+ * find a define for this in MacTCP.h, but that's what the programmer's
+ * guide says.
+ */
+
+ if ((statusPB.csParam.status.connectionState != 0)
+ && (statusPB.csParam.status.connectionState != 4)
+ && (statusPB.csParam.status.connectionState != 6)) {
+ if (statusPB.csParam.status.amtUnreadData > 0) {
+ statePtr->checkMask |= TCL_READABLE;
+ }
+ if (!(statePtr->flags & TCP_WRITING)
+ && (statusPB.csParam.status.sendWindow -
+ statusPB.csParam.status.amtUnackedData) > 0) {
+ statePtr->flags &= ~(TCP_ASYNC_CONNECT);
+ statePtr->checkMask |= TCL_WRITABLE;
+ }
+ if (mask & statePtr->checkMask) {
+ return 1;
+ }
+ } else {
+ break;
+ }
+
/*
* Call the system to let other applications run while we
* are waiting for this event to occur.
@@ -2126,7 +2238,7 @@ Tcl_GetHostName()
return hostname;
}
- if (TclHasSockets(NULL) == TCL_OK) {
+ if (TclpHasSockets(NULL) == TCL_OK) {
err = GetLocalAddress(&ourAddress);
if (err == noErr) {
/*
@@ -2266,10 +2378,11 @@ CleanUpExitProc()
{
TCPiopb exitPB;
TcpState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- while (socketList != NULL) {
- statePtr = socketList;
- socketList = statePtr->nextPtr;
+ while (tsdPtr->socketList != NULL) {
+ statePtr = tsdPtr->socketList;
+ tsdPtr->socketList = statePtr->nextPtr;
/*
* Close and Release the connection.
@@ -2321,7 +2434,7 @@ GetHostFromString(
EventRecord dummy;
DNRState dnrState;
- if (TclHasSockets(NULL) != TCL_OK) {
+ if (TclpHasSockets(NULL) != TCL_OK) {
return 0;
}
@@ -2536,7 +2649,7 @@ GetBufferSize()
* Results:
* A standard Tcl result. On success, the port number is
* returned in portPtr. On failure, an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -2604,8 +2717,9 @@ static void
ClearZombieSockets()
{
TcpState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- for (statePtr = socketList; statePtr != NULL;
+ for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
if (statePtr->flags & TCP_RELEASE) {
SocketFreeProc(statePtr);
@@ -2613,3 +2727,40 @@ ClearZombieSockets()
}
}
}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifyRoutine --
+ *
+ * This routine does nothing currently, and is not being used. But
+ * it is useful if you want to experiment with what MacTCP thinks that
+ * it is doing...
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+pascal void NotifyRoutine (
+ StreamPtr tcpStream,
+ unsigned short eventCode,
+ Ptr userDataPtr,
+ unsigned short terminReason,
+ struct ICMPReport *icmpMsg)
+{
+ StreamPtr localTcpStream;
+ unsigned short localEventCode;
+ unsigned short localTerminReason;
+ struct ICMPReport localIcmpMsg;
+
+ localTcpStream = tcpStream;
+ localEventCode = eventCode;
+ localTerminReason = terminReason;
+ localIcmpMsg = *icmpMsg;
+
+}
diff --git a/tcl/mac/tclMacTclCode.r b/tcl/mac/tclMacTclCode.r
new file mode 100644
index 00000000000..c3a0c2280d2
--- /dev/null
+++ b/tcl/mac/tclMacTclCode.r
@@ -0,0 +1,37 @@
+/*
+ * tclMacTclCode.r --
+ *
+ * This file creates resources from the Tcl code that is
+ * usually stored in the TCL_LiBRARY
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMacTclCode.r 1.1 98/01/21 22:22:38
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+#define TCL_LIBRARY_RESOURCES 2000
+
+/*
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application. The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl". This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * require some predetermined file structure - all needed Tcl "files"
+ * are located within the application. To source a file for the
+ * resource fork the source command has been modified to support
+ * sourcing from resources. In the below case "source -rsrc {Init}"
+ * will load the TEXT resource named "Init".
+ */
+
+read 'TEXT' (TCL_LIBRARY_RESOURCES, "Init", purgeable) "::library:init.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 1, "Auto", purgeable) "::library:auto.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 2, "Package", purgeable,preload) "::library:package.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 3, "History", purgeable) "::library:history.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 4, "Word", purgeable,preload) "::library:word.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 5, "Parray", purgeable,preload) "::library:parray.tcl";
diff --git a/tcl/mac/tclMacTest.c b/tcl/mac/tclMacTest.c
index 06a66ba62c0..a376e329bdd 100644
--- a/tcl/mac/tclMacTest.c
+++ b/tcl/mac/tclMacTest.c
@@ -211,32 +211,3 @@ WriteTextResource(
(char *) NULL);
return TCL_ERROR;
}
-
-int
-TclMacChmod(
- char *path,
- int mode)
-{
- HParamBlockRec hpb;
- OSErr err;
-
- c2pstr(path);
- hpb.fileParam.ioNamePtr = (unsigned char *) path;
- hpb.fileParam.ioVRefNum = 0;
- hpb.fileParam.ioDirID = 0;
-
- if (mode & 0200) {
- err = PBHRstFLockSync(&hpb);
- } else {
- err = PBHSetFLockSync(&hpb);
- }
- p2cstr((unsigned char *) path);
-
- if (err != noErr) {
- errno = TclMacOSErrorToPosixError(err);
- return -1;
- }
-
- return 0;
-}
-
diff --git a/tcl/mac/tclMacThrd.c b/tcl/mac/tclMacThrd.c
new file mode 100644
index 00000000000..eb5886524ea
--- /dev/null
+++ b/tcl/mac/tclMacThrd.c
@@ -0,0 +1,829 @@
+/*
+ * tclMacThrd.c --
+ *
+ * This file implements the Mac-specific thread support.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMacThrd.c 1.2 98/02/23 16:48:07
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMacInt.h"
+#include <Threads.h>
+#include <Gestalt.h>
+
+#define TCL_MAC_THRD_DEFAULT_STACK (256*1024)
+
+
+typedef struct TclMacThrdData {
+ ThreadID threadID;
+ VOID *data;
+ struct TclMacThrdData *next;
+} TclMacThrdData;
+
+/*
+ * This is an array of the Thread Data Keys. It is a process-wide table.
+ * Its size is originally set to 32, but it can grow if needed.
+ */
+
+static TclMacThrdData **tclMacDataKeyArray;
+#define TCL_MAC_INITIAL_KEYSIZE 32
+
+/*
+ * These two bits of data store the current maximum number of keys
+ * and the keyCounter (which is the number of occupied slots in the
+ * KeyData array.
+ *
+ */
+
+static int maxNumKeys = 0;
+static int keyCounter = 0;
+
+/*
+ * Prototypes for functions used only in this file
+ */
+
+TclMacThrdData *GetThreadDataStruct(Tcl_ThreadDataKey keyVal);
+TclMacThrdData *RemoveThreadDataStruct(Tcl_ThreadDataKey keyVal);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacHaveThreads --
+ *
+ * Do we have the Thread Manager?
+ *
+ * Results:
+ * 1 if the ThreadManager is present, 0 otherwise.
+ *
+ * Side effects:
+ * If this is the first time this is called, the return is cached.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacHaveThreads(void)
+{
+ static initialized = false;
+ static int tclMacHaveThreads = false;
+ long response = 0;
+ OSErr err = noErr;
+
+ if (!initialized) {
+ err = Gestalt(gestaltThreadMgrAttr, &response);
+ if (err == noErr) {
+ tclMacHaveThreads = response | (1 << gestaltThreadMgrPresent);
+ }
+ }
+
+ return tclMacHaveThreads;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateThread --
+ *
+ * This procedure creates a new thread.
+ *
+ * Results:
+ * TCL_OK if the thread could be created. The thread ID is
+ * returned in a parameter.
+ *
+ * Side effects:
+ * A new thread is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
+ Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc proc; /* Main() function of the thread */
+ ClientData clientData; /* The one argument to Main() */
+ int stackSize; /* Size of stack for the new thread */
+ int flags; /* Flags controlling behaviour of
+ * the new thread */
+{
+
+ if (!TclMacHaveThreads()) {
+ return TCL_ERROR;
+ }
+
+ if (stackSize == TCL_THREAD_STACK_DEFAULT) {
+ stackSize = TCL_MAC_THRD_DEFAULT_STACK;
+ }
+
+#if TARGET_CPU_68K && TARGET_RT_MAC_CFM
+ {
+ ThreadEntryProcPtr entryProc;
+ entryProc = NewThreadEntryProc(proc);
+
+ NewThread(kCooperativeThread, entryProc, (void *) clientData,
+ stackSize, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
+ }
+#else
+ NewThread(kCooperativeThread, proc, (void *) clientData,
+ stackSize, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
+#endif
+ if ((ThreadID) *idPtr == kNoThreadID) {
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadExit --
+ *
+ * This procedure terminates the current thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This procedure terminates the current thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadExit(status)
+ int status;
+{
+ ThreadID curThread;
+
+ if (!TclMacHaveThreads()) {
+ return;
+ }
+
+ GetCurrentThread(&curThread);
+ DisposeThread(curThread, NULL, false);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCurrentThread --
+ *
+ * This procedure returns the ID of the currently running thread.
+ *
+ * Results:
+ * A thread ID.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ThreadId
+Tcl_GetCurrentThread()
+{
+#ifdef TCL_THREADS
+ ThreadID curThread;
+
+ if (!TclMacHaveThreads()) {
+ return (Tcl_ThreadId) 0;
+ } else {
+ GetCurrentThread(&curThread);
+ return (Tcl_ThreadId) curThread;
+ }
+#else
+ return (Tcl_ThreadId) 0;
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitLock
+ *
+ * This procedure is used to grab a lock that serializes initialization
+ * and finalization of Tcl. On some platforms this may also initialize
+ * the mutex used to serialize creation of more mutexes and thread
+ * local storage keys.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitLock()
+{
+#ifdef TCL_THREADS
+ /* There is nothing to do on the Mac. */;
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitUnlock
+ *
+ * This procedure is used to release a lock that serializes initialization
+ * and finalization of Tcl.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitUnlock()
+{
+#ifdef TCL_THREADS
+ /* There is nothing to do on the Mac */;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterLock
+ *
+ * This procedure is used to grab a lock that serializes creation
+ * and finalization of serialization objects. This interface is
+ * only needed in finalization; it is hidden during
+ * creation of the objects.
+ *
+ * This lock must be different than the initLock because the
+ * initLock is held during creation of syncronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterLock()
+{
+#ifdef TCL_THREADS
+ /* There is nothing to do on the Mac */;
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterUnlock
+ *
+ * This procedure is used to release a lock that serializes creation
+ * and finalization of synchronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterUnlock()
+{
+#ifdef TCL_THREADS
+ /* There is nothing to do on the Mac */
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetAllocMutex
+ *
+ * This procedure returns a pointer to a statically initialized
+ * mutex for use by the memory allocator. The alloctor must
+ * use this lock, because all other locks are allocated...
+ *
+ * Results:
+ * A pointer to a mutex that is suitable for passing to
+ * Tcl_MutexLock and Tcl_MutexUnlock.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Mutex *
+Tcl_GetAllocMutex()
+{
+ /* There is nothing to do on the Mac */
+ return NULL;
+}
+
+#ifdef TCL_THREADS
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexLock --
+ *
+ * This procedure is invoked to lock a mutex. This procedure
+ * handles initializing the mutex, if necessary. The caller
+ * can rely on the fact that Tcl_Mutex is an opaque pointer.
+ * This routine will change that pointer from NULL after first use.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May block the current thread. The mutex is aquired when
+ * this returns. Will allocate memory for a pthread_mutex_t
+ * and initialize this the first time this Tcl_Mutex is used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexLock(mutexPtr)
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+{
+/* There is nothing to do on the Mac */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMutexUnlock --
+ *
+ * This procedure is invoked to unlock a mutex. The mutex must
+ * have been locked by Tcl_MutexLock.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex is released when this returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexUnlock(mutexPtr)
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+{
+/* There is nothing to do on the Mac */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeMutex --
+ *
+ * This procedure is invoked to clean up one mutex. This is only
+ * safe to call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex list is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeMutex(mutexPtr)
+ Tcl_Mutex *mutexPtr;
+{
+/* There is nothing to do on the Mac */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyInit --
+ *
+ * This procedure initializes a thread specific data block key.
+ * Each thread has table of pointers to thread specific data.
+ * all threads agree on which table entry is used by each module.
+ * this is remembered in a "data key", that is just an index into
+ * this table. To allow self initialization, the interface
+ * passes a pointer to this key and the first thread to use
+ * the key fills in the pointer to the key. The key should be
+ * a process-wide static.
+ *
+ * There is no system-wide support for thread specific data on the
+ * Mac. So we implement this as an array of pointers. The keys are
+ * allocated sequentially, and each key maps to a slot in the table.
+ * The table element points to a linked list of the instances of
+ * the data for each thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Will bump the key counter if this is the first time this key
+ * has been initialized. May grow the DataKeyArray if that is
+ * necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeyInit(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+{
+
+ if (*keyPtr == NULL) {
+ keyCounter += 1;
+ *keyPtr = (Tcl_ThreadDataKey) keyCounter;
+ if (keyCounter > maxNumKeys) {
+ TclMacThrdData **newArray;
+ int i, oldMax = maxNumKeys;
+
+ maxNumKeys = maxNumKeys + TCL_MAC_INITIAL_KEYSIZE;
+
+ newArray = (TclMacThrdData **)
+ ckalloc(maxNumKeys * sizeof(TclMacThrdData *));
+
+ for (i = 0; i < oldMax; i++) {
+ newArray[i] = tclMacDataKeyArray[i];
+ }
+ for (i = oldMax; i < maxNumKeys; i++) {
+ newArray[i] = NULL;
+ }
+
+ if (tclMacDataKeyArray != NULL) {
+ ckfree((char *) tclMacDataKeyArray);
+ }
+ tclMacDataKeyArray = newArray;
+
+ }
+ /* TclRememberDataKey(keyPtr); */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyGet --
+ *
+ * This procedure returns a pointer to a block of thread local storage.
+ *
+ * Results:
+ * A thread-specific pointer to the data structure, or NULL
+ * if the memory has not been assigned to this key for this thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID *
+TclpThreadDataKeyGet(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+{
+ TclMacThrdData *dataPtr;
+
+ dataPtr = GetThreadDataStruct(*keyPtr);
+
+ if (dataPtr == NULL) {
+ return NULL;
+ } else {
+ return dataPtr->data;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeySet --
+ *
+ * This procedure sets the pointer to a block of thread local storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up the thread so future calls to TclpThreadDataKeyGet with
+ * this key will return the data pointer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeySet(keyPtr, data)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+ VOID *data; /* Thread local storage */
+{
+ TclMacThrdData *dataPtr;
+ ThreadID curThread;
+
+ dataPtr = GetThreadDataStruct(*keyPtr);
+
+ /*
+ * Is it legal to reset the thread data like this?
+ * And if so, who owns the memory?
+ */
+
+ if (dataPtr != NULL) {
+ dataPtr->data = data;
+ } else {
+ dataPtr = (TclMacThrdData *) ckalloc(sizeof(TclMacThrdData));
+ GetCurrentThread(&curThread);
+ dataPtr->threadID = curThread;
+ dataPtr->data = data;
+ dataPtr->next = tclMacDataKeyArray[(int) *keyPtr - 1];
+ tclMacDataKeyArray[(int) *keyPtr - 1] = dataPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadData --
+ *
+ * This procedure cleans up the thread-local storage. This is
+ * called once for each thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up all thread local storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadData(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ TclMacThrdData *dataPtr;
+
+ if (*keyPtr != NULL) {
+ dataPtr = RemoveThreadDataStruct(*keyPtr);
+
+ if ((dataPtr != NULL) && (dataPtr->data != NULL)) {
+ ckfree((char *) dataPtr->data);
+ ckfree((char *) dataPtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadDataKey --
+ *
+ * This procedure is invoked to clean up one key. This is a
+ * process-wide storage identifier. The thread finalization code
+ * cleans up the thread local storage itself.
+ *
+ * On the Mac, there is really nothing to do here, since the key
+ * is just an array index. But we set the key to 0 just in case
+ * someone else is relying on that.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The keyPtr value is set to 0.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadDataKey(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ ckfree((char *) tclMacDataKeyArray[(int) *keyPtr - 1]);
+ tclMacDataKeyArray[(int) *keyPtr - 1] = NULL;
+ *keyPtr = NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetThreadDataStruct --
+ *
+ * This procedure gets the data structure corresponding to
+ * keyVal for the current process.
+ *
+ * Results:
+ * The requested key data.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclMacThrdData *
+GetThreadDataStruct(keyVal)
+ Tcl_ThreadDataKey keyVal;
+{
+ ThreadID curThread;
+ TclMacThrdData *dataPtr;
+
+ /*
+ * The keyPtr will only be greater than keyCounter is someone
+ * has passed us a key without getting the value from
+ * TclpInitDataKey.
+ */
+
+ if ((int) keyVal <= 0) {
+ return NULL;
+ } else if ((int) keyVal > keyCounter) {
+ panic("illegal data key value");
+ }
+
+ GetCurrentThread(&curThread);
+
+ for (dataPtr = tclMacDataKeyArray[(int) keyVal - 1]; dataPtr != NULL;
+ dataPtr = dataPtr->next) {
+ if (dataPtr->threadID == curThread) {
+ break;
+ }
+ }
+
+ return dataPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RemoveThreadDataStruct --
+ *
+ * This procedure removes the data structure corresponding to
+ * keyVal for the current process from the list kept for keyVal.
+ *
+ * Results:
+ * The requested key data is removed from the list, and a pointer
+ * to it is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclMacThrdData *
+RemoveThreadDataStruct(keyVal)
+ Tcl_ThreadDataKey keyVal;
+{
+ ThreadID curThread;
+ TclMacThrdData *dataPtr, *prevPtr;
+
+
+ if ((int) keyVal <= 0) {
+ return NULL;
+ } else if ((int) keyVal > keyCounter) {
+ panic("illegal data key value");
+ }
+
+ GetCurrentThread(&curThread);
+
+ for (dataPtr = tclMacDataKeyArray[(int) keyVal - 1], prevPtr = NULL;
+ dataPtr != NULL;
+ prevPtr = dataPtr, dataPtr = dataPtr->next) {
+ if (dataPtr->threadID == curThread) {
+ break;
+ }
+ }
+
+ if (dataPtr == NULL) {
+ /* No body */
+ } else if ( prevPtr == NULL) {
+ tclMacDataKeyArray[(int) keyVal - 1] = dataPtr->next;
+ } else {
+ prevPtr->next = dataPtr->next;
+ }
+
+ return dataPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionWait --
+ *
+ * This procedure is invoked to wait on a condition variable.
+ * On the Mac, mutexes are no-ops, and we just yield. After
+ * all, it is the application's job to loop till the condition
+ * variable is changed...
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Will block the current thread till someone else yields.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+ Tcl_Condition *condPtr; /* Really (pthread_cond_t **) */
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+ Tcl_Time *timePtr; /* Timeout on waiting period */
+{
+ if (TclMacHaveThreads()) {
+ YieldToAnyThread();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionNotify --
+ *
+ * This procedure is invoked to signal a condition variable.
+ *
+ * The mutex must be held during this call to avoid races,
+ * but this interface does not enforce that.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May unblock another thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionNotify(condPtr)
+ Tcl_Condition *condPtr;
+{
+ if (TclMacHaveThreads()) {
+ YieldToAnyThread();
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeCondition --
+ *
+ * This procedure is invoked to clean up a condition variable.
+ * This is only safe to call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The condition variable is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeCondition(condPtr)
+ Tcl_Condition *condPtr;
+{
+ /* Nothing to do on the Mac */
+}
+
+
+
+#endif /* TCL_THREADS */
+
diff --git a/tcl/mac/tclMacThrd.h b/tcl/mac/tclMacThrd.h
new file mode 100644
index 00000000000..22f2c836450
--- /dev/null
+++ b/tcl/mac/tclMacThrd.h
@@ -0,0 +1,20 @@
+/*
+ * tclUnixThrd.h --
+ *
+ * This header file defines things for thread support.
+ *
+ * Copyright (c) 1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#)
+ */
+
+#ifndef _TCLMACTHRD
+#define _TCLMACTHRD
+
+#ifdef TCL_THREADS
+
+#endif /* TCL_THREADS */
+#endif /* _TCLMACTHRD */
diff --git a/tcl/mac/tclMacTime.c b/tcl/mac/tclMacTime.c
index f27a0425568..f4d236def00 100644
--- a/tcl/mac/tclMacTime.c
+++ b/tcl/mac/tclMacTime.c
@@ -241,9 +241,10 @@ TclpGetTime(
struct tm *
TclpGetDate(
- const time_t *tp, /* Time struct to fill. */
+ TclpTime_t time, /* Time struct to fill. */
int useGMT) /* True if date should reflect GNT time. */
{
+ const time_t *tp = (const time_t *)time;
DateTimeRec dtr;
MachineLocation loc;
long int offset;
diff --git a/tcl/mac/tclMacUnix.c b/tcl/mac/tclMacUnix.c
index 9f5f42aa94c..3d51b7d9b9a 100644
--- a/tcl/mac/tclMacUnix.c
+++ b/tcl/mac/tclMacUnix.c
@@ -7,7 +7,7 @@
* Unix Tcl normally hands off to the Unix OS.
*
* Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -51,60 +51,6 @@
#define noSourceErr 501
#define isDirErr 502
-/*
- * Static functions in this file.
- */
-
-static int GlobArgs _ANSI_ARGS_((Tcl_Interp *interp,
- int *argc, char ***argv));
-
-/*
- *----------------------------------------------------------------------
- *
- * GlobArgs --
- *
- * The following function was taken from Peter Keleher's Alpha
- * Editor. *argc should only count the end arguments that should
- * be globed. argv should be incremented to point to the first
- * arg to be globed.
- *
- * Results:
- * Returns 'true' if it worked & memory was allocated, else 'false'.
- *
- * Side effects:
- * argv will be alloced, the call will need to release the memory
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GlobArgs(
- Tcl_Interp *interp, /* Tcl interpreter. */
- int *argc, /* Number of arguments. */
- char ***argv) /* Argument strings. */
-{
- int res, len;
- char *list;
-
- /*
- * Places the globbed args all into 'interp->result' as a list.
- */
- res = Tcl_GlobCmd(NULL, interp, *argc + 1, *argv - 1);
- if (res != TCL_OK) {
- return false;
- }
- len = strlen(interp->result);
- list = (char *) ckalloc(len + 1);
- strcpy(list, interp->result);
- Tcl_ResetResult(interp);
-
- res = Tcl_SplitList(interp, list, argc, argv);
- ckfree((char *) list);
- if (res != TCL_OK) {
- return false;
- }
- return true;
-}
/*
*----------------------------------------------------------------------
@@ -138,24 +84,24 @@ Tcl_EchoCmd(
return TCL_ERROR;
}
for (i = 1; i < argc; i++) {
- result = Tcl_Write(chan, argv[i], -1);
+ result = Tcl_WriteChars(chan, argv[i], -1);
if (result < 0) {
Tcl_AppendResult(interp, "echo: ", Tcl_GetChannelName(chan),
": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
if (i < (argc - 1)) {
- Tcl_Write(chan, " ", -1);
+ Tcl_WriteChars(chan, " ", -1);
}
}
- Tcl_Write(chan, "\n", -1);
+ Tcl_WriteChars(chan, "\n", -1);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_LsCmd --
+ * Tcl_LsObjCmd --
*
* This procedure is invoked to process the "ls" Tcl command.
* See the user documentation for details on what it does.
@@ -169,17 +115,16 @@ Tcl_EchoCmd(
*----------------------------------------------------------------------
*/
int
-Tcl_LsCmd(
+Tcl_LsObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument strings. */
{
#define STRING_LENGTH 80
#define CR '\n'
int i, j;
int fieldLength, len = 0, maxLen = 0, perLine;
- char **origArgv = argv;
OSErr err;
CInfoPBRec paramBlock;
HFileInfo *hpb = (HFileInfo *)&paramBlock;
@@ -188,24 +133,27 @@ Tcl_LsCmd(
char theLine[STRING_LENGTH + 2];
int fFlag = false, pFlag = false, aFlag = false, lFlag = false,
cFlag = false, hFlag = false;
+ char *argv;
+ Tcl_Obj *newObjv[2], *resultObjPtr;
/*
* Process command flags. End if argument doesn't start
* with a dash or is a dash by itself. The remaining arguments
* should be files.
*/
- for (i = 1; i < argc; i++) {
- if (argv[i][0] != '-') {
+ for (i = 1; i < objc; i++) {
+ argv = Tcl_GetString(objv[i]);
+ if (argv[0] != '-') {
break;
}
- if (!strcmp(argv[i], "-")) {
+ if (!strcmp(argv, "-")) {
i++;
break;
}
- for (j = 1 ; argv[i][j] ; ++j) {
- switch(argv[i][j]) {
+ for (j = 1 ; argv[j] ; ++j) {
+ switch(argv[j]) {
case 'a':
case 'A':
aFlag = true;
@@ -237,24 +185,34 @@ Tcl_LsCmd(
}
}
- argv += i;
- argc -= i;
+ objv += i;
+ objc -= i;
/*
* No file specifications means we search for all files.
* Glob will be doing most of the work.
*/
- if (!argc) {
- argc = 1;
- argv = origArgv;
- strcpy(argv[0], "*");
+ if (!objc) {
+ objc = 1;
+ newObjv[0] = Tcl_NewStringObj("*", -1);
+ newObjv[1] = NULL;
+ objv = newObjv;
+ }
+
+ if (Tcl_GlobObjCmd(NULL, interp, objc + 1, objv - 1) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ return TCL_ERROR;
}
- if (!GlobArgs(interp, &argc, &argv)) {
- Tcl_ResetResult(interp);
- return TCL_ERROR;
+ resultObjPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObjPtr);
+ if (Tcl_ListObjGetElements(interp, resultObjPtr, &objc, &objv) != TCL_OK) {
+ Tcl_DecrRefCount(resultObjPtr);
+ return TCL_ERROR;
}
+ Tcl_ResetResult(interp);
+
/*
* There are two major methods for listing files: the long
* method and the normal method.
@@ -264,6 +222,9 @@ Tcl_LsCmd(
char lineTag;
long size;
unsigned short flags;
+ Tcl_Obj *objPtr;
+ char *string;
+ int length;
/*
* Print the header for long listing.
@@ -278,8 +239,8 @@ Tcl_LsCmd(
NULL);
}
- for (i = 0; i < argc; i++) {
- strcpy(theFile, argv[i]);
+ for (i = 0; i < objc; i++) {
+ strcpy(theFile, Tcl_GetString(objv[i]));
c2pstr(theFile);
hpb->ioCompletion = NULL;
@@ -347,11 +308,10 @@ Tcl_LsCmd(
}
- if ((interp->result != NULL) && (*(interp->result) != '\0')) {
- int slen = strlen(interp->result);
- if (interp->result[slen - 1] == '\n') {
- interp->result[slen - 1] = '\0';
- }
+ objPtr = Tcl_GetObjResult(interp);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ if ((length > 0) && (string[length - 1] == '\n')) {
+ Tcl_SetObjLength(objPtr, length - 1);
}
} else {
/*
@@ -369,8 +329,9 @@ Tcl_LsCmd(
perLine = 1;
fieldLength = STRING_LENGTH;
} else {
- for (i = 0; i < argc; i++) {
- len = strlen(argv[i]);
+ for (i = 0; i < objc; i++) {
+ argv = Tcl_GetString(objv[i]);
+ len = strlen(argv);
if (len > maxLen) {
maxLen = len;
}
@@ -382,8 +343,8 @@ Tcl_LsCmd(
argCount = 0;
linePos = 0;
memset(theLine, ' ', STRING_LENGTH);
- while (argCount < argc) {
- strcpy(theFile, argv[argCount]);
+ while (argCount < objc) {
+ strcpy(theFile, Tcl_GetString(objv[argCount]));
c2pstr(theFile);
hpb->ioCompletion = NULL;
@@ -457,8 +418,8 @@ Tcl_LsCmd(
}
}
}
-
- ckfree((char *) argv);
-
+
+ Tcl_DecrRefCount(resultObjPtr);
+
return TCL_OK;
}
diff --git a/tcl/mac/tclMacUtil.c b/tcl/mac/tclMacUtil.c
index 7d7867abe40..ae45a2f3751 100644
--- a/tcl/mac/tclMacUtil.c
+++ b/tcl/mac/tclMacUtil.c
@@ -351,13 +351,17 @@ FSpPathFromLocation(
* If the file doesn't currently exist we start over. If the
* directory exists everything will work just fine. Otherwise we
* will just fail later. If the object is a directory, append a
- * colon so full pathname ends with colon.
+ * colon so full pathname ends with colon, but only if the name is
+ * not empty. NavServices returns FSSpec's with the parent ID set,
+ * but the name empty...
*/
if (err == fnfErr) {
BlockMoveData(spec, &tempSpec, sizeof(FSSpec));
} else if ( (pb.hFileInfo.ioFlAttrib & ioDirMask) != 0 ) {
- tempSpec.name[0] += 1;
- tempSpec.name[tempSpec.name[0]] = ':';
+ if (tempSpec.name[0] > 0) {
+ tempSpec.name[0] += 1;
+ tempSpec.name[tempSpec.name[0]] = ':';
+ }
}
/*
@@ -439,3 +443,4 @@ GetGlobalMouse(
OSEventAvail(0, &event);
*mouse = event.where;
}
+
diff --git a/tcl/tests/README b/tcl/tests/README
index ef48e10fd81..a357195a8fe 100644
--- a/tcl/tests/README
+++ b/tcl/tests/README
@@ -1,96 +1,147 @@
-Tcl Test Suite
---------------
+README -- Tcl test suite design document.
RCS: @(#) $Id$
-This directory contains a set of validation tests for the Tcl
-commands. Each of the files whose name ends in ".test" is
-intended to fully exercise one or a few Tcl commands. The
-commands tested by a given file are listed in the first line
-of the file.
+Contents:
+---------
+
+ 1. Introduction
+ 2. Incompatibilities with prior Tcl versions
+
+1. Introduction:
+----------------
+
+This directory contains a set of validation tests for the Tcl commands
+and C Library procedures for Tcl. Each of the files whose name ends
+in ".test" is intended to fully exercise the functions in the C source
+file that corresponds to the file prefix. The C functions and/or Tcl
+commands tested by a given file are listed in the first line of the
+file.
+
+You can run the tests in three ways:
-You can run the tests in two ways:
(a) type "make test" in ../unix; this will run all of the tests.
- (b) start up tcltest in this directory, then "source" the test
+
+ (b) type "tcltest <testFile> ?<option> <value>?
+ Command line options include:
+
+ -help display usage information
+
+ -verbose <level> set the level of verbosity to a substring
+ of "bps". See the "Test output" section
+ of the tcltest man page for an
+ explanation of this option.
+
+ -match <matchList> only run tests that match one or more of
+ the glob patterns in <matchList>
+
+ -skip <skipList> do not run tests that match one or more
+ of the glob patterns in <skipList>
+
+ -file <globPatternList>
+ only source test files that match one or
+ more of the glob patterns in
+ <globPatternList> (relative to the
+ "tests" directory). This option only
+ applies when you run the test suite with
+ the "all.tcl" file.
+
+ -notfile <globPatternList>
+ do not source test files that match one
+ or more of the patterns in
+ <globPatternList> (relative to the
+ "tests" directory). This option only
+ applies when you run the test suite with
+ the "all.tcl" file.
+
+ -constraints <list> tests with any constraints in <list> will
+ not be skipped. Not that elements of
+ <list> must exactly match the existing
+ constraints.
+
+ -limitconstraints <bool>
+ If 1, limit test runs to those tests that
+ match the constraints listed using the
+ -constraints flag. Use of this flag
+ requires use of the -constraints flag.
+ The default value is 0.
+
+ -tmpdir <dirname> put temporary files created by
+ ::tcltest::makeFile and
+ ::tcltest::makeDirectory in the named
+ directory. The default location is
+ ::tcltest::workingDirectory.
+
+ -preservecore <level>
+ check for core files. If level is 0,
+ check for core files only when
+ cleanupTests is called from an all.tcl
+ file. If 1, also check at the end of
+ every test command. If 2, also save core
+ files in ::tcltest::temporaryDirectory.
+ The default level is 0.
+
+ (c) start up tcltest in this directory, then "source" the test
file (for example, type "source parse.test"). To run all
- of the tests, type "source all".
-In either case no output will be generated if all goes well, except
-for a listing of the tests.. If there are errors then additional
-messages will appear in the format described below. Note: don't
-run the tests as superuser, since this will cause several of the tests
-to fail.
-
-The rest of this file provides additional information on the
-features of the testing environment.
-
-This approach to testing was designed and initially implemented
-by Mary Ann May-Pumphrey of Sun Microsystems. Many thanks to
-her for donating her work back to the public Tcl release.
-
-Definitions file:
------------------
-
-The file "defs" defines a collection of procedures and variables
-used to run the tests. It is read in automatically by each of the
-.test files if needed, but once it has been read once it will not
-be read again by the .test files. If you change defs while running
-tests you'll have to "source" it by hand to load its new contents.
-
-Test output:
-------------
-
-Normally, output only appears when there are errors. However, if
-the variable VERBOSE is set to 1 then tests will be run in "verbose"
-mode and output will be generated for each test regardless of
-whether it succeeded or failed. Test output consists of the
-following information:
-
- - the test identifier (which can be used to locate the test code
- in the .test file)
- - a brief description of the test
- - the contents of the test code
- - the actual results produced by the tests
- - a "PASSED" or "FAILED" message
- - the expected results (if the test failed)
-
-You can set VERBOSE either interactively (after the defs file has been
-read in), or you can change the default value in "defs".
-
-Selecting tests for execution:
-------------------------------
-
-Normally, all the tests in a file are run whenever the file is
-"source"d. However, you can select a specific set of tests using
-the global variable TESTS. This variable contains a pattern; any
-test whose identifier matches TESTS will be run. For example,
-the following interactive command causes all of the "for" tests in
-groups 2 and 4 to be executed:
-
- set TESTS {for-[24]*}
-
-TESTS defaults to *, but you can change the default in "defs" if
-you wish.
-
-Saving keystrokes:
-------------------
-
-A convenience procedure named "dotests" is included in file
-"defs". It takes two arguments--the name of the test file (such
-as "parse.test"), and a pattern selecting the tests you want to
-execute. It sets TESTS to the second argument, calls "source" on
-the file specified in the first argument, and restores TESTS to
-its pre-call value at the end.
-
-Batch vs. interactive execution:
---------------------------------
-
-The tests can be run in either batch or interactive mode. Batch
-mode refers to using I/O redirection from a UNIX shell. For example,
-the following command causes the tests in the file named "parse.test"
-to be executed:
-
- tclTest < parse.test > parse.test.results
-
-Users who want to execute the tests in this fashion need to first
-ensure that the file "defs" has proper values for the global
-variables that control the testing environment (VERBOSE and TESTS).
+ of the tests, type "source all.tcl". To use the options in
+ interactive mode, you can set their corresponding tcltest
+ namespace variables after loading the tcltest package.
+ For example, some of the tcltest variables are:
+ ::tcltest::match
+ ::tcltest::skip
+ ::tcltest::testConstraints(nonPortable)
+ ::tcltest::testConstraints(knownBug)
+ ::tcltest::testConstraints(userInteractive)
+
+Please see the tcltest man page for more information regarding how to
+write and run tests.
+
+Please note that the all.tcl file will source your new test file if
+the filename matches the tests/*.test pattern (as it should). The
+names of test files that contain regression (or glass-box) tests
+should correspond to the Tcl or C code file that they are testing.
+For example, the test file for the C file "tclCmdAH.c" is
+"cmdAH.test". Test files that contain black-box tests may not
+correspond to any Tcl or C code file so they should match the pattern
+"*_bb.test".
+
+Be sure your new test file can be run from any working directory.
+
+Be sure no temporary files are left behind by your test file.
+
+Be sure your tests can run cross-platform in both a build environment
+as well as an installation environment. If your test file contains
+tests that should not be run in one or more of those cases, please use
+the constraints mechanism to skip those tests.
+
+2. Incompatibilities with prior Tcl versions:
+---------------------------------------------
+
+1) Global variables such as VERBOSE, TESTS, and testConfig are now
+ renamed to use the new "tcltest" namespace.
+
+ old name new name
+ -------- --------
+ VERBOSE ::tcltest::verbose
+ TESTS ::tcltest::match
+ testConfig ::tcltest::testConstraints
+
+2) VERBOSE values are no longer numeric.
+
+3) When you run "make test", the working dir for the test suite is now
+ the one from which you called "make test", rather than the "tests"
+ directory. This change allows for both unix and windows test
+ suites to be run simultaneously without interference with each
+ other or with existing files. All tests must now run independently
+ of their working directory.
+
+4) The "all" and "visual" files are now called "all.tcl" and
+ "visual_bb.test".
+
+5) The "defs" file no longer exists.
+
+6) Instead of creating a doAllTests file in the tests directory, to
+ run all nonPortable tests, just use the "-constraints nonPortable"
+ command line flag. If you are running interactively, you can set
+ the ::tcltest::testConstraints(nonPortable) variable to 1 (after
+ loading the tcltest package).
diff --git a/tcl/tests/all.tcl b/tcl/tests/all.tcl
new file mode 100644
index 00000000000..9a2b73bdfbe
--- /dev/null
+++ b/tcl/tests/all.tcl
@@ -0,0 +1,56 @@
+# all.tcl --
+#
+# This file contains a top-level script to run all of the Tcl
+# tests. Execute it by invoking "source all.test" when running tcltest
+# in this directory.
+#
+# Copyright (c) 1998-2000 Ajuba Solutions.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+set ::tcltest::testSingleFile false
+set ::tcltest::testsDirectory [file dir [info script]]
+
+# We need to ensure that the testsDirectory is absolute
+::tcltest::normalizePath ::tcltest::testsDirectory
+
+puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]"
+puts stdout "Tests running in working dir: $::tcltest::testsDirectory"
+if {[llength $::tcltest::skip] > 0} {
+ puts stdout "Skipping tests that match: $::tcltest::skip"
+}
+if {[llength $::tcltest::match] > 0} {
+ puts stdout "Only running tests that match: $::tcltest::match"
+}
+
+if {[llength $::tcltest::skipFiles] > 0} {
+ puts stdout "Skipping test files that match: $::tcltest::skipFiles"
+}
+if {[llength $::tcltest::matchFiles] > 0} {
+ puts stdout "Only sourcing test files that match: $::tcltest::matchFiles"
+}
+
+set timeCmd {clock format [clock seconds]}
+puts stdout "Tests began at [eval $timeCmd]"
+
+# source each of the specified tests
+foreach file [lsort [::tcltest::getMatchingFiles]] {
+ set tail [file tail $file]
+ puts stdout $tail
+ if {[catch {source $file} msg]} {
+ puts stdout $msg
+ }
+}
+
+# cleanup
+puts stdout "\nTests ended at [eval $timeCmd]"
+::tcltest::cleanupTests 1
+return
+
+
diff --git a/tcl/tests/append.test b/tcl/tests/append.test
index ba058f53f5e..584ac09fcf8 100644
--- a/tcl/tests/append.test
+++ b/tcl/tests/append.test
@@ -6,15 +6,19 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {unset x}
+
test append-1.1 {append command} {
catch {unset x}
list [append x 1 2 abc "long string"] $x
@@ -170,5 +174,23 @@ test append-7.1 {lappend-created var and error in trace on that var} {
list [info exists x] [catch {set x} msg] $msg
} {0 1 {can't read "x": no such variable}}
-catch {unset x}
+catch {unset i x result y}
catch {rename foo ""}
+catch {rename check ""}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/assocd.test b/tcl/tests/assocd.test
index c5d06dc523d..8f8ed242bbf 100644
--- a/tcl/tests/assocd.test
+++ b/tcl/tests/assocd.test
@@ -6,17 +6,22 @@
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
if {[string compare testsetassocdata [info commands testsetassocdata]] != 0} {
puts "This application hasn't been compiled with the tests for assocData,"
puts "therefore I am skipping all of these tests."
+ ::tcltest::cleanupTests
return
}
@@ -55,3 +60,20 @@ test assocd-3.2 {testing deleting assoc data} {
test assocd-3.3 {testing deleting assoc data} {
list [catch {testdelassocdata nonexistent} msg] $msg
} {0 {}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/async.test b/tcl/tests/async.test
index 70dea8700bb..81d60d141e5 100644
--- a/tcl/tests/async.test
+++ b/tcl/tests/async.test
@@ -6,20 +6,25 @@
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testasync] == {}} {
puts "This application hasn't been compiled with the \"testasync\""
puts "command, so I can't test Tcl_AsyncCreate et al."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
proc async1 {result code} {
global aresult acode
set aresult $result
@@ -128,4 +133,20 @@ test async-3.1 {deleting handlers} {
list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}
+# cleanup
testasync delete
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/autoMkindex.tcl b/tcl/tests/autoMkindex.tcl
index 7a72fbe824e..2756358d8cb 100644
--- a/tcl/tests/autoMkindex.tcl
+++ b/tcl/tests/autoMkindex.tcl
@@ -50,3 +50,24 @@ namespace eval buried {
proc ::buried::explicit {args} {return "explicit: $args"}
}
}
+
+# With proper hooks, we should be able to support other commands
+# that create procedures
+
+proc buried::myproc {name body args} {
+ ::proc $name $body $args
+}
+namespace eval ::buried {
+ proc mycmd1 args {return "mycmd"}
+ myproc mycmd2 args {return "mycmd"}
+}
+::buried::myproc mycmd3 args {return "another"}
+
+proc {buried::my proc} {name body args} {
+ ::proc $name $body $args
+}
+namespace eval ::buried {
+ proc mycmd4 args {return "mycmd"}
+ {my proc} mycmd5 args {return "mycmd"}
+}
+{::buried::my proc} mycmd6 args {return "another"}
diff --git a/tcl/tests/autoMkindex.test b/tcl/tests/autoMkindex.test
index 9428f84d903..5aba965fe0c 100644
--- a/tcl/tests/autoMkindex.test
+++ b/tcl/tests/autoMkindex.test
@@ -4,13 +4,45 @@
# the autoloading index.
#
# Copyright (c) 1998 Lucent Technologies, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# temporarily copy the autoMkindex.tcl file from testsDirectory to
+# temporaryDirectory
+set origMkindexFile [file join $::tcltest::testsDirectory autoMkindex.tcl]
+set newMkindexFile [file join $::tcltest::temporaryDirectory autoMkindex.tcl]
+if {![catch {file copy $origMkindexFile $newMkindexFile}]} {
+ set removeAutoMkindex 1
+}
+
+# Save initial state of auto_mkindex_parser
+
+auto_load auto_mkindex
+if {[info exist auto_mkindex_parser::initCommands]} {
+ set saveCommands $auto_mkindex_parser::initCommands
+}
+proc AutoMkindexTestReset {} {
+ global saveCommands
+ if {[info exist saveCommands]} {
+ set auto_mkindex_parser::initCommands $saveCommands
+ } elseif {[info exist auto_mkindex_parser::initCommands]} {
+ unset auto_mkindex_parser::initCommands
+ }
+}
+
+set result ""
+
+set origDir [pwd]
+cd $::tcltest::testsDirectory
test autoMkindex-1.1 {remove any existing tclIndex file} {
file delete tclIndex
@@ -25,21 +57,25 @@ test autoMkindex-1.2 {build tclIndex based on a test file} {
set element "{source [file join . autoMkindex.tcl]}"
test autoMkindex-1.3 {examine tclIndex} {
+ file delete tclIndex
+ auto_mkindex . autoMkindex.tcl
namespace eval tcl_autoMkindex_tmp {
set dir "."
variable auto_index
source tclIndex
- set result ""
+ set ::result ""
foreach elem [lsort [array names auto_index]] {
- lappend result [list $elem $auto_index($elem)]
+ lappend ::result [list $elem $auto_index($elem)]
}
- set result
}
-} "{::buried::explicit $element} {::buried::inside $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}"
+ namespace delete tcl_autoMkindex_tmp
+ set ::result
+} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}"
-namespace delete tcl_autoMkindex_tmp
test autoMkindex-2.1 {commands on the autoload path can be imported} {
+ file delete tclIndex
+ auto_mkindex . autoMkindex.tcl
set interp [interp create]
set final [$interp eval {
namespace eval blt {}
@@ -54,8 +90,144 @@ test autoMkindex-2.1 {commands on the autoload path can be imported} {
set final
} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
-#
+# Test auto_mkindex hooks
+
+# Slave hook executes interesting code in the interp used to watch code.
+
+test autoMkindex-3.1 {slaveHook} {
+ auto_mkindex_parser::slavehook {
+ _%@namespace eval ::blt {
+ proc foo {} {}
+ _%@namespace export foo
+ }
+ }
+ auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
+ file delete tclIndex
+ auto_mkindex . autoMkindex.tcl
+
+ # Reset initCommands to avoid trashing other tests
+
+ AutoMkindexTestReset
+ file exists tclIndex
+} 1
+
+# The auto_mkindex_parser::command is used to register commands
+# that create new commands.
+
+test autoMkindex-3.2 {auto_mkindex_parser::command} {
+ auto_mkindex_parser::command buried::myproc {name args} {
+ variable index
+ variable scriptFile
+ append index [list set auto_index([fullname $name])] \
+ " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+ }
+ file delete tclIndex
+ auto_mkindex . autoMkindex.tcl
+ namespace eval tcl_autoMkindex_tmp {
+ set dir "."
+ variable auto_index
+ source tclIndex
+ set ::result ""
+ foreach elem [lsort [array names auto_index]] {
+ lappend ::result [list $elem $auto_index($elem)]
+ }
+ }
+ namespace delete tcl_autoMkindex_tmp
+
+ # Reset initCommands to avoid trashing other tests
+
+ AutoMkindexTestReset
+ set ::result
+} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
+
+
+test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
+ auto_mkindex_parser::command {buried::my proc} {name args} {
+ variable index
+ variable scriptFile
+ puts "my proc $name"
+ append index [list set auto_index([fullname $name])] \
+ " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+ }
+ file delete tclIndex
+ auto_mkindex . autoMkindex.tcl
+ namespace eval tcl_autoMkindex_tmp {
+ set dir "."
+ variable auto_index
+ source tclIndex
+ set ::result ""
+ foreach elem [lsort [array names auto_index]] {
+ lappend ::result [list $elem $auto_index($elem)]
+ }
+ }
+ namespace delete tcl_autoMkindex_tmp
+
+ # Reset initCommands to avoid trashing other tests
+
+ AutoMkindexTestReset
+ proc lvalue {list pattern} {
+ set ix [lsearch $list $pattern]
+ if {$ix >= 0} {
+ return [lindex $list $ix]
+ } else {
+ return {}
+ }
+ }
+ list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
+} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
+
+test autoMkindex-4.1 {platform indenpendant source commands} {
+ file delete tclIndex
+ auto_mkindex . pkg/samename.tcl
+ set f [open tclIndex r]
+ set dat [split [string trim [read $f]] "\n"]
+ set len [llength $dat]
+ set result [lsort [lrange $dat [expr {$len-2}] [expr {$len-1}]]]
+ close $f
+ set result
+} {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}
+
+test autoMkindex-5.1 {escape magic tcl chars in general code} {
+ file delete tclIndex
+ set result {}
+ if { ![catch {auto_mkindex . pkg/magicchar.tcl}] } {
+ set f [open tclIndex r]
+ set dat [split [string trim [read $f]] "\n"]
+ set result [lindex $dat end]
+ close $f
+ }
+ set result
+} {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
+test autoMkindex-5.2 {correctly locate auto loaded procs with []} {
+ file delete tclIndex
+ set res {}
+ if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } {
+ # Make a slave interp to test the autoloading
+ set c [interp create]
+ $c eval {lappend auto_path [pwd]}
+ set res [$c eval {catch {{[magic mojo proc]}}}]
+ interp delete $c
+ }
+ set res
+} 0
+
# Clean up.
-#
-catch {file delete tclIndex}
+unset result
+AutoMkindexTestReset
+if {[info exist saveCommands]} {
+ unset saveCommands
+}
+rename AutoMkindexTestReset ""
+
+if {[info exists removeAutoMkindex]} {
+ catch {file delete $newMkindexFile}
+}
+if {[file exists tclIndex]} {
+ file delete -force tclIndex
+}
+
+cd $origDir
+
+::tcltest::cleanupTests
+
diff --git a/tcl/tests/basic.test b/tcl/tests/basic.test
index e3b8cf6162e..cd2b030ae9c 100644
--- a/tcl/tests/basic.test
+++ b/tcl/tests/basic.test
@@ -10,6 +10,7 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,7 +18,10 @@
# RCS: @(#) $Id$
#
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {namespace delete test_ns_basic}
catch {interp delete test_interp}
@@ -40,7 +44,31 @@ test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} {
[interp delete test_interp]
} {::test_ns_basic {}}
-test basic-2.1 {DeleteInterpProc, destroys interp's global namespace} {
+test basic-2.1 {TclHideUnsafeCommands} {emptyTest} {
+} {}
+
+test basic-3.1 {Tcl_CallWhenDeleted: see dcall.test} {emptyTest} {
+} {}
+
+test basic-4.1 {Tcl_DontCallWhenDeleted: see dcall.test} {emptyTest} {
+} {}
+
+test basic-5.1 {Tcl_SetAssocData: see assoc.test} {emptyTest} {
+} {}
+
+test basic-6.1 {Tcl_DeleteAssocData: see assoc.test} {emptyTest} {
+} {}
+
+test basic-7.1 {Tcl_GetAssocData: see assoc.test} {emptyTest} {
+} {}
+
+test basic-8.1 {Tcl_InterpDeleted} {emptyTest} {
+} {}
+
+test basic-9.1 {Tcl_DeleteInterp: see interp.test} {emptyTest} {
+} {}
+
+test basic-10.1 {DeleteInterpProc, destroys interp's global namespace} {
catch {interp delete test_interp}
interp create test_interp
interp eval test_interp {
@@ -65,7 +93,7 @@ test basic-2.1 {DeleteInterpProc, destroys interp's global namespace} {
[interp delete test_interp]
} {{::test_ns_basic 27} {} 1 {invalid command name "set"} {}}
-test basic-3.1 {HiddenCmdsDeleteProc, invalidate cached refs to deleted hidden cmd} {
+test basic-11.1 {HiddenCmdsDeleteProc, invalidate cached refs to deleted hidden cmd} {
catch {interp delete test_interp}
interp create test_interp
interp eval test_interp {
@@ -84,7 +112,7 @@ test basic-3.1 {HiddenCmdsDeleteProc, invalidate cached refs to deleted hidden c
# NB: More tests about hide/expose are found in interp.test
-test basic-4.1 {Tcl_HideCommand, names of hidden cmds can't have namespace qualifiers} {
+test basic-12.1 {Tcl_HideCommand, names of hidden cmds can't have namespace qualifiers} {
catch {interp delete test_interp}
interp create test_interp
interp eval test_interp {
@@ -99,7 +127,7 @@ test basic-4.1 {Tcl_HideCommand, names of hidden cmds can't have namespace quali
[interp delete test_interp]
} {1 {can only hide global namespace commands (use rename then hide)} 1 {cannot use namespace qualifiers as hidden commandtoken (rename)} {}}
-test basic-4.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespace} {
+test basic-12.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespace} {
catch {namespace delete test_ns_basic}
catch {rename cmd ""}
proc cmd {} { ;# note that this is global
@@ -124,7 +152,7 @@ test basic-4.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespace
[namespace delete test_ns_basic]
} {:: {} 1 {invalid command name "cmd"} {} :: {}}
-test basic-5.1 {Tcl_ExposeCommand, a command stays in the global namespace and can not go to another namespace} {
+test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and can not go to another namespace} {
catch {namespace delete test_ns_basic}
catch {rename cmd ""}
proc cmd {} { ;# note that this is global
@@ -152,7 +180,7 @@ test basic-5.1 {Tcl_ExposeCommand, a command stays in the global namespace and c
[test_ns_basic::newCmd] \
[namespace delete test_ns_basic]
} {:: {} 1 {can not expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}}
-test basic-5.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being exposed} {
+test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being exposed} {
catch {rename p ""}
catch {rename cmd ""}
proc p {} {
@@ -170,22 +198,26 @@ test basic-5.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being expos
[p]
} {42 {} {} Hello {} {} 42}
-if {[info commands testcreatecommand] != {}} {
- test basic-6.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {
- catch {eval namespace delete [namespace children :: test_ns_*]}
- list [testcreatecommand create] \
- [test_ns_basic::createdcommand] \
- [testcreatecommand delete]
- } {{} {CreatedCommandProc in ::test_ns_basic} {}}
- test basic-6.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {
- catch {eval namespace delete [namespace children :: test_ns_*]}
- catch {rename value:at: ""}
- list [testcreatecommand create2] \
- [value:at:] \
- [testcreatecommand delete2]
- } {{} {CreatedCommandProc2 in ::} {}}
+if {[info commands testcreatecommand] == ""} {
+ puts "This application hasn't been compiled with the testcreatecommand"
+ puts "command. Skipping affected tests."
+} else {
+test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {
+ catch {eval namespace delete [namespace children :: test_ns_*]}
+ list [testcreatecommand create] \
+ [test_ns_basic::createdcommand] \
+ [testcreatecommand delete]
+} {{} {CreatedCommandProc in ::test_ns_basic} {}}
+test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {
+ catch {eval namespace delete [namespace children :: test_ns_*]}
+ catch {rename value:at: ""}
+ list [testcreatecommand create2] \
+ [value:at:] \
+ [testcreatecommand delete2]
+} {{} {CreatedCommandProc2 in ::} {}}
}
-test basic-6.3 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} {
+
+test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} {
catch {eval namespace delete [namespace children :: test_ns_*]}
namespace eval test_ns_basic {}
proc test_ns_basic::cmd {} { ;# proc requires that ns already exist
@@ -195,7 +227,13 @@ test basic-6.3 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in
[namespace delete test_ns_basic]
} {::test_ns_basic {}}
-test basic-7.1 {TclRenameCommand, name of existing cmd can have namespace qualifiers} {
+test basic-16.1 {TclInvokeStringCommand} {emptyTest} {
+} {}
+
+test basic-17.1 {TclInvokeObjCommand} {emptyTest} {
+} {}
+
+test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace qualifiers} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename cmd ""}
namespace eval test_ns_basic {
@@ -207,11 +245,11 @@ test basic-7.1 {TclRenameCommand, name of existing cmd can have namespace qualif
[rename test_ns_basic::p test_ns_basic::q] \
[test_ns_basic::q]
} {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
-test basic-7.2 {TclRenameCommand, existing cmd must be found} {
+test basic-18.2 {TclRenameCommand, existing cmd must be found} {
catch {eval namespace delete [namespace children :: test_ns_*]}
list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg
} {1 {can't rename "test_ns_basic::p": command doesn't exist}}
-test basic-7.3 {TclRenameCommand, delete cmd if new name is empty} {
+test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
catch {eval namespace delete [namespace children :: test_ns_*]}
namespace eval test_ns_basic {
proc p {} {
@@ -222,7 +260,7 @@ test basic-7.3 {TclRenameCommand, delete cmd if new name is empty} {
[rename test_ns_basic::p ""] \
[info commands test_ns_basic::*]
} {::test_ns_basic::p {} {}}
-test basic-7.4 {TclRenameCommand, bad new name} {
+test basic-18.4 {TclRenameCommand, bad new name} {
catch {eval namespace delete [namespace children :: test_ns_*]}
namespace eval test_ns_basic {
proc p {} {
@@ -231,7 +269,7 @@ test basic-7.4 {TclRenameCommand, bad new name} {
}
rename test_ns_basic::p :::george::martha
} {}
-test basic-7.5 {TclRenameCommand, new name must not already exist} {
+test basic-18.5 {TclRenameCommand, new name must not already exist} {
namespace eval test_ns_basic {
proc q {} {
return 42
@@ -239,7 +277,7 @@ test basic-7.5 {TclRenameCommand, new name must not already exist} {
}
list [catch {rename test_ns_basic::q :::george::martha} msg] $msg
} {1 {can't rename to ":::george::martha": command already exists}}
-test basic-7.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} {
+test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename q ""}
@@ -259,8 +297,14 @@ test basic-7.6 {TclRenameCommand, check for command shadowing by newly renamed c
[test_ns_basic::callP]
} {{p in ::} {} {q in ::test_ns_basic}}
-if {[info command testcmdtoken] != {}} {
-test basic-8.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {
+test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} {
+} {}
+
+if {[info commands testcmdtoken] == {}} {
+ puts "This application hasn't been compiled with the \"testcmdtoken\""
+ puts "command, so I can't test Tcl_GetCommandInfo."
+} else {
+test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename q ""}
@@ -273,7 +317,7 @@ test basic-8.1 {Tcl_GetCommandInfo, names for commands created inside namespaces
[rename ::p q] \
[testcmdtoken name $x]
} {{p ::p} {} {q ::q}}
-test basic-8.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {
+test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {
catch {rename q ""}
set x [testcmdtoken create test_ns_basic::test_ns_basic2::p]
list [testcmdtoken name $x] \
@@ -282,7 +326,10 @@ test basic-8.2 {Tcl_GetCommandInfo, names for commands created outside namespace
} {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}}
}
-test basic-9.1 {Tcl_GetCommandFullName} {
+test basic-21.1 {Tcl_GetCommandName} {emptyTest} {
+} {}
+
+test basic-22.1 {Tcl_GetCommandFullName} {
catch {eval namespace delete [namespace children :: test_ns_*]}
namespace eval test_ns_basic1 {
namespace export cmd*
@@ -305,7 +352,10 @@ test basic-9.1 {Tcl_GetCommandFullName} {
}
} {::foreach ::test_ns_basic3::q ::test_ns_basic3::p ::test_ns_basic3::cmd1 ::test_ns_basic2::cmd2}
-test basic-10.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} {
+test basic-23.1 {Tcl_DeleteCommand} {emptyTest} {
+} {}
+
+test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} {
catch {interp delete test_interp}
catch {unset x}
interp create test_interp
@@ -325,7 +375,7 @@ test basic-10.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd
[interp eval test_interp {useSet}] \
[interp delete test_interp]
} {123 {set called with a 123} {}}
-test basic-10.2 {Tcl_DeleteCommandFromToken, deleting commands changes command epoch} {
+test basic-24.2 {Tcl_DeleteCommandFromToken, deleting commands changes command epoch} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename p ""}
proc p {} {
@@ -343,7 +393,7 @@ test basic-10.2 {Tcl_DeleteCommandFromToken, deleting commands changes command e
[rename test_ns_basic::p ""] \
[test_ns_basic::callP]
} {{namespace p} {} {global p}}
-test basic-10.3 {Tcl_DeleteCommandFromToken, delete imported cmds that refer to a deleted cmd} {
+test basic-24.3 {Tcl_DeleteCommandFromToken, delete imported cmds that refer to a deleted cmd} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename p ""}
namespace eval test_ns_basic {
@@ -363,7 +413,54 @@ test basic-10.3 {Tcl_DeleteCommandFromToken, delete imported cmds that refer to
[info commands test_ns_basic2::*]
} {42 {::test_ns_basic2::callP ::test_ns_basic2::p} {} 1 {invalid command name "p"} ::test_ns_basic2::callP}
-test basic-11.1 {TclObjInvoke, lookup of "unknown" command} {
+test basic-25.1 {TclCleanupCommand} {emptyTest} {
+} {}
+
+test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} {
+ # If object isn't preserved, errorInfo would be set to
+ # "foo\n while executing\n\"garbage bytes\"" because the object's
+ # string would have been freed, leaving garbage bytes for the error
+ # message.
+
+ proc bgerror {args} {set ::x $::errorInfo}
+ set f [open test1 w]
+ fileevent $f writable "fileevent $f writable {}; error foo"
+ set x {}
+ vwait x
+ close $f
+ file delete test1
+ rename bgerror {}
+ set x
+} "foo\n while executing\n\"error foo\""
+
+test basic-27.1 {Tcl_ExprLong} {emptyTest} {
+} {}
+
+test basic-28.1 {Tcl_ExprDouble} {emptyTest} {
+} {}
+
+test basic-29.1 {Tcl_ExprBoolean} {emptyTest} {
+} {}
+
+test basic-30.1 {Tcl_ExprLongObj} {emptyTest} {
+} {}
+
+test basic-31.1 {Tcl_ExprDoubleObj} {emptyTest} {
+} {}
+
+test basic-32.1 {Tcl_ExprBooleanObj} {emptyTest} {
+} {}
+
+test basic-33.1 {TclInvoke} {emptyTest} {
+} {}
+
+test basic-34.1 {TclGlobalInvoke} {emptyTest} {
+} {}
+
+test basic-35.1 {TclObjInvokeGlobal} {emptyTest} {
+} {}
+
+test basic-36.1 {TclObjInvoke, lookup of "unknown" command} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {interp delete test_interp}
interp create test_interp
@@ -382,15 +479,49 @@ test basic-11.1 {TclObjInvoke, lookup of "unknown" command} {
[interp delete test_interp]
} {newAlias 0 {global unknown} {}}
-if {[info command testcmdtrace] != {}} {
-test basic-12.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+test basic-37.1 {Tcl_ExprString: see expr.test} {emptyTest} {
+} {}
+
+test basic-38.1 {Tcl_ExprObj} {emptyTest} {
+} {}
+
+if {[info commands testcmdtrace] == {}} {
+ puts "This application hasn't been compiled with the \"testcmdtrace\""
+ puts "command, so I can't test Tcl_CreateTrace."
+} else {
+test basic-39.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+ testcmdtrace tracetest {set stuff [expr 14 + 16]}
+} {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
+test basic-39.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
testcmdtrace tracetest {set stuff [info tclversion]}
-} {{info tclversion} {info tclversion} {set stuff [info tclversion]} {set stuff 8.0}}
-test basic-12.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+} [list {info tclversion} {info tclversion} {set stuff [info tclversion]} "set stuff $::tcltest::version"]
+test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
testcmdtrace deletetest {set stuff [info tclversion]}
-} 8.0
+} $::tcltest::version
}
+test basic-40.1 {Tcl_DeleteTrace} {emptyTest} {
+} {}
+
+test basic-41.1 {Tcl_AddErrorInfo} {emptyTest} {
+} {}
+
+test basic-42.1 {Tcl_AddObjErrorInfo} {emptyTest} {
+} {}
+
+test basic-43.1 {Tcl_VarEval} {emptyTest} {
+} {}
+
+test basic-44.1 {Tcl_GlobalEval} {emptyTest} {
+} {}
+
+test basic-45.1 {Tcl_SetRecursionLimit: see interp.test} {emptyTest} {
+} {}
+
+test basic-46.1 {Tcl_AllowExceptions} {emptyTest} {
+} {}
+
+# cleanup
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {namespace delete george}
catch {interp delete test_interp}
@@ -399,5 +530,18 @@ catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
catch {unset x}
-set x 0
-unset x
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/binary.test b/tcl/tests/binary.test
index becc2d070fb..cf048c9df6b 100644
--- a/tcl/tests/binary.test
+++ b/tcl/tests/binary.test
@@ -5,20 +5,34 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+test binary-2.1 {DupByteArrayInternalRep} {
+ set hdr [binary format cc 0 0316]
+ set buf hellomatt
+
+ set data $hdr
+ append data $buf
+
+ string length $data
+} 11
test binary-1.1 {Tcl_BinaryObjCmd: bad args} {
list [catch {binary} msg] $msg
} {1 {wrong # args: should be "binary option ?arg arg ...?"}}
test binary-1.2 {Tcl_BinaryObjCmd: bad args} {
list [catch {binary foo} msg] $msg
-} {1 {bad option "foo": must be format, or scan}}
+} {1 {bad option "foo": must be format or scan}}
test binary-1.3 {Tcl_BinaryObjCmd: format error} {
list [catch {binary f} msg] $msg
@@ -1441,3 +1455,25 @@ test binary-41.8 {ScanNumber: word alignment} {nonPortable pcOnly} {
catch {unset arg1; unset arg2}
list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}
+
+test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} {
+ catch {binary ""} result
+ set result
+} {bad option "": must be format or scan}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/case.test b/tcl/tests/case.test
index bb0117fa486..4c8089a55fa 100644
--- a/tcl/tests/case.test
+++ b/tcl/tests/case.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test case-1.1 {simple pattern} {
case a in a {format 1} b {format 2} c {format 3} default {format 4}
@@ -81,3 +85,20 @@ test case-3.2 {single-argument form for pattern/command pairs} {
test case-3.3 {single-argument form for pattern/command pairs} {
list [catch {case z in {a 2 b}} msg] $msg
} {1 {extra case pattern with no body}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/clock.test b/tcl/tests/clock.test
index 9515bad2265..5ce3bdd612a 100644
--- a/tcl/tests/clock.test
+++ b/tcl/tests/clock.test
@@ -4,14 +4,18 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1995-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test clock-1.1 {clock tests} {
list [catch {clock} msg] $msg
@@ -26,14 +30,25 @@ test clock-2.1 {clock clicks tests} {
concat {}
} {}
test clock-2.2 {clock clicks tests} {
- list [catch {clock clicks foo} msg] $msg
-} {1 {wrong # args: should be "clock clicks"}}
-test clock-2.3 {clock clicks tests} {
set start [clock clicks]
after 10
set end [clock clicks]
expr "$end > $start"
} {1}
+test clock-2.3 {clock clicks tests} {
+ list [catch {clock clicks foo} msg] $msg
+} {1 {bad switch "foo": must be -milliseconds}}
+test clock-2.3 {clock clicks tests} {
+ expr [clock clicks -milliseconds]+1
+ concat {}
+} {}
+test clock-2.2 {clock clicks tests, millisecond timing test} {
+ set start [clock clicks -milli]
+ after 10
+ set end [clock clicks -milli]
+ # assume, even with slow interp'ing, the diff is less than 60 msecs
+ expr {($end > $start) && (($end - $start) < 60)}
+} {1}
# clock format
test clock-3.1 {clock format tests} {unixOnly} {
@@ -41,29 +56,60 @@ test clock-3.1 {clock format tests} {unixOnly} {
clock format $clockval -format {%a %b %d %I:%M:%S %p %Y} -gmt true
} {Sun Nov 04 03:02:46 AM 1990}
test clock-3.2 {clock format tests} {
+ # TCL_USE_TIMEZONE_VAR
+
+ catch {set oldtz $env(TZ)}
+ set env(TZ) PST
+ set x {}
+ append x [clock format 863800000 -format %Z -gmt 1]
+ append x [set env(TZ)]
+ catch {unset env(TZ); set env(TZ) $oldtz}
+ set x
+} {GMTPST}
+test clock-3.3 {clock format tests} {
+ # tzset() under Borland doesn't seem to set up tzname[] for local
+ # timezone, which caused "clock format" to think that %Z was an invalid
+ # string. Don't care about answer, just that test runs w/o error.
+
+ clock format 863800000 -format %Z
+ set x {}
+} {}
+test clock-3.4 {clock format tests} {
+ # tzset() under Borland doesn't seem to set up tzname[] for gmt timezone.
+ # tzset() under MSVC has the following weird observed behavior:
+ # First time we call "clock format [clock seconds] -format %Z -gmt 1"
+ # we get "GMT", but on all subsequent calls we get the current time
+ # zone string, even though env(TZ) is GMT and the variable _timezone
+ # is 0.
+
+ set x {}
+ append x [clock format 863800000 -format %Z -gmt 1]
+ append x [clock format 863800000 -format %Z -gmt 1]
+} {GMTGMT}
+test clock-3.5 {clock format tests} {
list [catch {clock format} msg] $msg
} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean?"}}
-test clock-3.3 {clock format tests} {
+test clock-3.6 {clock format tests} {
list [catch {clock format foo} msg] $msg
} {1 {expected integer but got "foo"}}
-test clock-3.4 {clock format tests} {unixOrPc} {
+test clock-3.7 {clock format tests} {unixOrPc} {
set clockval 657687766
clock format $clockval -format "%a %b %d %I:%M:%S %p %Y" -gmt true
} "Sun Nov 04 03:02:46 AM 1990"
-test clock-3.5 {clock format tests} {
+test clock-3.8 {clock format tests} {
list [catch {clock format a b c d e g} msg] $msg
} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean?"}}
-test clock-3.6 {clock format tests} {unixOrPc nonPortable} {
+test clock-3.9 {clock format tests} {unixOrPc nonPortable} {
set clockval -1
clock format $clockval -format "%a %b %d %I:%M:%S %p %Y" -gmt true
} "Wed Dec 31 11:59:59 PM 1969"
-test clock-3.7 {clock format tests} {
+test clock-3.10 {clock format tests} {
list [catch {clock format 123 -bad arg} msg] $msg
-} {1 {bad switch "-bad": must be -format, or -gmt}}
-test clock-3.8 {clock format tests} {
+} {1 {bad switch "-bad": must be -format or -gmt}}
+test clock-3.11 {clock format tests} {
clock format 123 -format "x"
} x
-test clock-3.9 {clock format tests} {
+test clock-3.12 {clock format tests} {
clock format 123 -format ""
} ""
@@ -101,7 +147,7 @@ test clock-4.8 {clock scan tests} {
} {Oct 23,1992 15:00 GMT}
test clock-4.9 {clock scan tests} {
list [catch {clock scan "Jan 12" -bad arg} msg] $msg
-} {1 {bad switch "-bad": must be -base, or -gmt}}
+} {1 {bad switch "-bad": must be -base or -gmt}}
# The following two two tests test the two year date policy
test clock-4.10 {clock scan tests} {
set time [clock scan "1/1/71" -gmt true]
@@ -112,6 +158,191 @@ test clock-4.11 {clock scan tests} {
clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Jan 01,2037 00:00 GMT}
+test clock-4.12 {clock scan, relative times} {
+ set time [clock scan "Oct 23, 1992 -1 day"]
+ clock format $time -format {%b %d, %Y}
+} "Oct 22, 1992"
+test clock-4.13 {clock scan, ISO 8601 base date format} {
+ set time [clock scan "19921023"]
+ clock format $time -format {%b %d, %Y}
+} "Oct 23, 1992"
+test clock-4.14 {clock scan, ISO 8601 expanded date format} {
+ set time [clock scan "1992-10-23"]
+ clock format $time -format {%b %d, %Y}
+} "Oct 23, 1992"
+test clock-4.15 {clock scan, DD-Mon-YYYY format} {
+ set time [clock scan "23-Oct-1992"]
+ clock format $time -format {%b %d, %Y}
+} "Oct 23, 1992"
+test clock-4.16 {clock scan, ISO 8601 point in time format} {
+ set time [clock scan "19921023T235959"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} "Oct 23, 1992 23:59:59"
+test clock-4.17 {clock scan, ISO 8601 point in time format} {
+ set time [clock scan "19921023 235959"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} "Oct 23, 1992 23:59:59"
+test clock-4.18 {clock scan, ISO 8601 point in time format} {
+ set time [clock scan "19921023T000000"]
+ clock format $time -format {%b %d, %Y %H:%M:%S}
+} "Oct 23, 1992 00:00:00"
+
+# CLOCK SCAN REAL TESTS
+# We use 5am PST, 31-12-1999 as the base for these scans because irrespective
+# of your local timezone it should always give us times on December 31, 1999
+set 5amPST 946645200
+test clock-4.18 {clock scan, number meridian} {
+ set t1 [clock scan "5 am" -base $5amPST -gmt true]
+ set t2 [clock scan "5 pm" -base $5amPST -gmt true]
+ set t3 [clock scan "5 a.m." -base $5amPST -gmt true]
+ set t4 [clock scan "5 p.m." -base $5amPST -gmt true]
+ list \
+ [clock format $t1 -format {%b %d, %Y %H:%M:%S} -gmt true] \
+ [clock format $t2 -format {%b %d, %Y %H:%M:%S} -gmt true] \
+ [clock format $t3 -format {%b %d, %Y %H:%M:%S} -gmt true] \
+ [clock format $t4 -format {%b %d, %Y %H:%M:%S} -gmt true]
+} [list "Dec 31, 1999 05:00:00" "Dec 31, 1999 17:00:00" \
+ "Dec 31, 1999 05:00:00" "Dec 31, 1999 17:00:00"]
+test clock-4.19 {clock scan, number:number meridian} {
+ clock format [clock scan "5:30 pm" -base $5amPST -gmt true] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Dec 31, 1999 17:30:00"
+test clock-4.20 {clock scan, number:number-timezone} {
+ clock format [clock scan "00:00-0800" -gmt true -base $5amPST] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Dec 31, 1999 08:00:00"
+test clock-4.21 {clock scan, number:number:number o_merid} {
+ clock format [clock scan "8:00:00" -gmt true -base $5amPST] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Dec 31, 1999 08:00:00"
+test clock-4.22 {clock scan, number:number:number o_merid} {
+ clock format [clock scan "8:00:00 am" -gmt true -base $5amPST] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Dec 31, 1999 08:00:00"
+test clock-4.23 {clock scan, number:number:number o_merid} {
+ clock format [clock scan "8:00:00 pm" -gmt true -base $5amPST] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Dec 31, 1999 20:00:00"
+test clock-4.24 {clock scan, number:number:number-timezone} {
+ clock format [clock scan "00:00:30-0800" -gmt true -base $5amPST] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Dec 31, 1999 08:00:30"
+test clock-4.25 {clock scan, DST for days} {
+ clock scan "tomorrow" -base [clock scan "19991031 00:00:00"]
+} [clock scan "19991101 00:00:00"]
+test clock-4.26 {clock scan, DST for days} {
+ clock scan "yesterday" -base [clock scan "19991101 00:00:00"]
+} [clock scan "19991031 00:00:00"]
+test clock-4.27 {clock scan, day} knownBug {
+ clock format [clock scan "Monday" -gmt true -base 946627200] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Jan 03, 2000 00:00:00"
+test clock-4.28 {clock scan, number/number} {
+ clock format [clock scan "1/1" -gmt true -base 946627200] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Jan 01, 1999 00:00:00"
+test clock-4.28 {clock scan, number/number} {
+ clock format [clock scan "1/1/1999" -gmt true -base 946627200] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Jan 01, 1999 00:00:00"
+test clock-4.28 {clock scan, number/number} {
+ clock format [clock scan "19990101" -gmt true -base 946627200] \
+ -format {%b %d, %Y %H:%M:%S} -gmt true
+} "Jan 01, 1999 00:00:00"
+test clock-4.29 {clock scan, relative minutes} {
+ clock scan "now + 1 minute" -base 946627200
+} 946627260
+test clock-4.30 {clock scan, relative minutes} {
+ clock scan "now +1 minute" -base 946627200
+} 946627260
+test clock-4.31 {clock scan, relative minutes} {
+ clock scan "now 1 minute" -base 946627200
+} 946627260
+test clock-4.32 {clock scan, relative minutes} {
+ clock scan "now - 1 minute" -base 946627200
+} 946627140
+test clock-4.33 {clock scan, relative minutes} {
+ clock scan "now -1 minute" -base 946627200
+} 946627140
+test clock-4.34 {clock scan, day of week} {
+ clock format [clock scan "wednesday" -base [clock scan 20000112]] \
+ -format {%b %d, %Y}
+} "Jan 12, 2000"
+test clock-4.35 {clock scan, next day of week} {
+ clock format [clock scan "next wednesday" -base [clock scan 20000112]] \
+ -format {%b %d, %Y}
+} "Jan 19, 2000"
+test clock-4.36 {clock scan, day of week} {
+ clock format [clock scan "thursday" -base [clock scan 20000112]] \
+ -format {%b %d, %Y}
+} "Jan 13, 2000"
+test clock-4.37 {clock scan, next day of week} {
+ clock format [clock scan "next thursday" -base [clock scan 20000112]] \
+ -format {%b %d, %Y}
+} "Jan 20, 2000"
+
+# weekday specification and base.
+test clock-4.38 {2nd monday in november} {
+ set res {}
+ foreach i {91 92 93 94 95 96} {
+ set nov8th [clock scan 11/8/$i]
+ set monday [clock scan monday -base $nov8th]
+ lappend res [clock format $monday -format %Y-%m-%d]
+ }
+ set res
+} {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11}
+test clock-4.39 {2nd monday in november (2nd try)} {
+ set res {}
+ foreach i {91 92 93 94 95 96} {
+ set nov1th [clock scan 11/1/$i]
+ set monday [clock scan "2 monday" -base $nov1th]
+ lappend res [clock format $monday -format %Y-%m-%d]
+ }
+ set res
+} {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11}
+test clock-4.40 {last monday in november} {
+ set res {}
+ foreach i {91 92 93 94 95 96} {
+ set dec1th [clock scan 12/1/$i]
+ set monday [clock scan "monday 1 week ago" -base $dec1th]
+ lappend res [clock format $monday -format %Y-%m-%d]
+ }
+ set res
+} {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25}
+
+test clock-4.40 {2nd monday in november} knownBug {
+ set res {}
+ foreach i {91 92 93 94 95 96} {
+ set nov8th [clock scan 11/8/$i -gmt 1]
+ set monday [clock scan monday -base $nov8th -gmt 1]
+ lappend res [clock format $monday -format %Y-%m-%d -gmt 1]
+ }
+ set res
+} {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11}
+test clock-4.41 {2nd monday in november (2nd try)} knownBug {
+ set res {}
+ foreach i {91 92 93 94 95 96} {
+ set nov1th [clock scan 11/1/$i -gmt 1]
+ set monday [clock scan "2 monday" -base $nov1th -gmt 1]
+ lappend res [clock format $monday -format %Y-%m-%d -gmt 1]
+ }
+ set res
+} {1991-11-11 1992-11-09 1993-11-08 1994-11-14 1995-11-13 1996-11-11}
+test clock-4.40 {last monday in november} knownBug {
+ set res {}
+ foreach i {91 92 93 94 95 96} {
+ set dec1th [clock scan 12/1/$i -gmt 1]
+ set monday [clock scan "monday 1 week ago" -base $dec1th -gmt 1]
+ lappend res [clock format $monday -format %Y-%m-%d -gmt 1]
+ }
+ set res
+} {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25}
+test clock-4.41 {ago with multiple relative units} {
+ set base [clock scan "12/31/1999 00:00:00"]
+ set res [clock scan "2 days 2 hours ago" -base $base]
+ expr {$base - $res}
+} 180000
+
# clock seconds
test clock-5.1 {clock seconds tests} {
expr [clock seconds]+1
@@ -173,3 +404,22 @@ test clock-6.11 {clock roll over dates} {
set time [clock scan "March 1, 2001" -gmt true]
clock format $time -format %j -gmt true
} {060}
+
+test clock-7.1 {clock scan next monthname} {
+ clock format [clock scan "next june" -base [clock scan "june 1, 2000"]] \
+ -format %m.%Y
+} "06.2001"
+test clock-7.2 {clock scan next monthname} {
+ clock format [clock scan "next july" -base [clock scan "june 1, 2000"]] \
+ -format %m.%Y
+} "07.2000"
+test clock-7.3 {clock scan next monthname} {
+ clock format [clock scan "next may" -base [clock scan "june 1, 2000"]] \
+ -format %m.%Y
+} "05.2001"
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
diff --git a/tcl/tests/cmdAH.test b/tcl/tests/cmdAH.test
index 65a9451a0ad..d4dcfae40f8 100644
--- a/tcl/tests/cmdAH.test
+++ b/tcl/tests/cmdAH.test
@@ -4,35 +4,180 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
global env
+set cmdAHwd [pwd]
catch {set platform [testgetplatform]}
-test cmdAH-1.1 {Tcl_FileObjCmd} {
+test cmdAH-0.1 {Tcl_BreakObjCmd, errors} {
+ list [catch {break foo} msg] $msg
+} {1 {wrong # args: should be "break"}}
+test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
+ list [catch {break} msg] $msg
+} {3 {}}
+
+# Tcl_CaseObjCmd is tested in case.test
+
+test cmdAH-1.1 {Tcl_CatchObjCmd, errors} {
+ list [catch {catch} msg] $msg
+} {1 {wrong # args: should be "catch command ?varName?"}}
+test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
+ list [catch {catch foo bar baz} msg] $msg
+} {1 {wrong # args: should be "catch command ?varName?"}}
+
+test cmdAH-2.1 {Tcl_CdObjCmd} {
+ list [catch {cd foo bar} msg] $msg
+} {1 {wrong # args: should be "cd ?dirName?"}}
+test cmdAH-2.2 {Tcl_CdObjCmd} {
+ file delete -force foo
+ file mkdir foo
+ cd foo
+ set result [file tail [pwd]]
+ cd ..
+ file delete foo
+ set result
+} foo
+test cmdAH-2.3 {Tcl_CdObjCmd} {
+ global env
+ set oldpwd [pwd]
+ set temp $env(HOME)
+ set env(HOME) $oldpwd
+ file delete -force foo
+ file mkdir foo
+ cd foo
+ cd ~
+ set result [string match [pwd] $oldpwd]
+ file delete foo
+ set env(HOME) $temp
+ set result
+} 1
+test cmdAH-2.4 {Tcl_CdObjCmd} {
+ global env
+ set oldpwd [pwd]
+ set temp $env(HOME)
+ set env(HOME) $oldpwd
+ file delete -force foo
+ file mkdir foo
+ cd foo
+ cd
+ set result [string match [pwd] $oldpwd]
+ file delete foo
+ set env(HOME) $temp
+ set result
+} 1
+test cmdAH-2.5 {Tcl_CdObjCmd} {
+ list [catch {cd ~~} msg] $msg
+} {1 {user "~" doesn't exist}}
+test cmdAH-2.6 {Tcl_CdObjCmd} {
+ list [catch {cd _foobar} msg] $msg
+} {1 {couldn't change working directory to "_foobar": no such file or directory}}
+
+test cmdAH-2.7 {Tcl_ConcatObjCmd} {
+ concat
+} {}
+test cmdAH-2.8 {Tcl_ConcatObjCmd} {
+ concat a
+} a
+test cmdAH-2.9 {Tcl_ConcatObjCmd} {
+ concat a {b c}
+} {a b c}
+
+test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {
+ list [catch {continue foo} msg] $msg
+} {1 {wrong # args: should be "continue"}}
+test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
+ list [catch {continue} msg] $msg
+} {4 {}}
+
+test cmdAH-4.1 {Tcl_EncodingObjCmd} {
+ list [catch {encoding} msg] $msg
+} {1 {wrong # args: should be "encoding option ?arg ...?"}}
+test cmdAH-4.2 {Tcl_EncodingObjCmd} {
+ list [catch {encoding foo} msg] $msg
+} {1 {bad option "foo": must be convertfrom, convertto, names, or system}}
+test cmdAH-4.3 {Tcl_EncodingObjCmd} {
+ list [catch {encoding convertto} msg] $msg
+} {1 {wrong # args: should be "encoding convertto ?encoding? data"}}
+test cmdAH-4.4 {Tcl_EncodingObjCmd} {
+ list [catch {encoding convertto foo bar} msg] $msg
+} {1 {unknown encoding "foo"}}
+test cmdAH-4.5 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system jis0208
+ set x [encoding convertto \u4e4e]
+ encoding system $system
+ set x
+} 8C
+test cmdAH-4.6 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system identity
+ set x [encoding convertto jis0208 \u4e4e]
+ encoding system $system
+ set x
+} 8C
+test cmdAH-4.7 {Tcl_EncodingObjCmd} {
+ list [catch {encoding convertfrom} msg] $msg
+} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}
+test cmdAH-4.8 {Tcl_EncodingObjCmd} {
+ list [catch {encoding convertfrom foo bar} msg] $msg
+} {1 {unknown encoding "foo"}}
+test cmdAH-4.9 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system jis0208
+ set x [encoding convertfrom 8C]
+ encoding system $system
+ set x
+} \u4e4e
+test cmdAH-4.10 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system identity
+ set x [encoding convertfrom jis0208 8C]
+ encoding system $system
+ set x
+} \u4e4e
+test cmdAH-4.11 {Tcl_EncodingObjCmd} {
+ list [catch {encoding names foo} msg] $msg
+} {1 {wrong # args: should be "encoding names"}}
+test cmdAH-4.12 {Tcl_EncodingObjCmd} {
+ list [catch {encoding system foo bar} msg] $msg
+} {1 {wrong # args: should be "encoding system ?encoding?"}}
+test cmdAH-4.13 {Tcl_EncodingObjCmd} {
+ set system [encoding system]
+ encoding system identity
+ set x [encoding system]
+ encoding system $system
+ set x
+} identity
+
+test cmdAH-5.1 {Tcl_FileObjCmd} {
list [catch file msg] $msg
} {1 {wrong # args: should be "file option ?arg ...?"}}
-test cmdAH-1.2 {Tcl_FileObjCmd} {
+test cmdAH-5.2 {Tcl_FileObjCmd} {
list [catch {file x} msg] $msg
-} {1 {bad option "x": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
-test cmdAH-1.3 {Tcl_FileObjCmd} {
- list [catch {file atime} msg] $msg
-} {1 {wrong # args: should be "file atime name ?arg ...?"}}
+} {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-5.3 {Tcl_FileObjCmd} {
+ list [catch {file exists} msg] $msg
+} {1 {wrong # args: should be "file exists name"}}
#volume
-test cmdAH-2.1 {Tcl_FileObjCmd: volumes} {
+test cmdAH-6.1 {Tcl_FileObjCmd: volumes} {
list [catch {file volumes x} msg] $msg
} {1 {wrong # args: should be "file volumes"}}
-test cmdAH-2.2 {Tcl_FileObjCmd: volumes} {
+test cmdAH-6.2 {Tcl_FileObjCmd: volumes} {
set volumeList [file volumes]
if { [llength $volumeList] == 0 } {
set result 0
@@ -40,18 +185,18 @@ test cmdAH-2.2 {Tcl_FileObjCmd: volumes} {
set result 1
}
} {1}
-test cmdAH-2.3 {Tcl_FileObjCmd: volumes} {macOrUnix} {
+test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {macOrUnix} {
set volumeList [file volumes]
catch [list glob -nocomplain [lindex $volumeList 0]*]
} {0}
-test cmdAH-2.4 {Tcl_FileObjCmd: volumes} {pcOnly} {
- set volumeList [file volumes]
+test cmdAH-6.4 {Tcl_FileObjCmd: volumes} {pcOnly} {
+ set volumeList [string tolower [file volumes]]
list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
} {0 1 0}
# attributes
-test cmdAH-3.1 {Tcl_FileObjCmd - file attrs} {
+test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {
catch {file delete -force foo.file}
close [open foo.file w]
list [catch {file attributes foo.file}] [file delete -force foo.file]
@@ -63,175 +208,175 @@ if {[info commands testsetplatform] == {}} {
puts "This application hasn't been compiled with the \"testsetplatform\""
puts "command, so I can't test Tcl_FileObjCmd etc."
} else {
-test cmdAH-4.1 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.1 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname a b} msg] $msg
} {1 {wrong # args: should be "file dirname name"}}
-test cmdAH-4.2 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.2 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
file dirname /a/b
} /a
-test cmdAH-4.3 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.3 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
file dirname {}
} .
-test cmdAH-4.4 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.4 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
file dirname {}
} :
-test cmdAH-4.5 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.5 {Tcl_FileObjCmd: dirname} {
testsetplatform win
file dirname {}
} .
-test cmdAH-4.6 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.6 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
file dirname .def
} .
-test cmdAH-4.7 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.7 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
file dirname a
} :
-test cmdAH-4.8 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.8 {Tcl_FileObjCmd: dirname} {
testsetplatform win
file dirname a
} .
-test cmdAH-4.9 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.9 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
file dirname a/b/c.d
} a/b
-test cmdAH-4.10 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.10 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
file dirname a/b.c/d
} a/b.c
-test cmdAH-4.11 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.11 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
file dirname /.
} /
-test cmdAH-4.12 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.12 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname /} msg] $msg
} {0 /}
-test cmdAH-4.13 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.13 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname /foo} msg] $msg
} {0 /}
-test cmdAH-4.14 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.14 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname //foo} msg] $msg
} {0 /}
-test cmdAH-4.15 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.15 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname //foo/bar} msg] $msg
} {0 /foo}
-test cmdAH-4.16 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.16 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname {//foo\/bar/baz}} msg] $msg
} {0 {/foo\/bar}}
-test cmdAH-4.17 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.17 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg
} {0 {/foo\/bar/baz}}
-test cmdAH-4.18 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.18 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname /foo//} msg] $msg
} {0 /}
-test cmdAH-4.19 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.19 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname ./a} msg] $msg
} {0 .}
-test cmdAH-4.20 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.20 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname a/.a} msg] $msg
} {0 a}
-test cmdAH-4.21 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.21 {Tcl_FileObjCmd: dirname} {
testsetplatform windows
list [catch {file dirname c:foo} msg] $msg
} {0 c:}
-test cmdAH-4.22 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.22 {Tcl_FileObjCmd: dirname} {
testsetplatform windows
list [catch {file dirname c:} msg] $msg
} {0 c:}
-test cmdAH-4.23 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.23 {Tcl_FileObjCmd: dirname} {
testsetplatform windows
list [catch {file dirname c:/} msg] $msg
} {0 c:/}
-test cmdAH-4.24 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.24 {Tcl_FileObjCmd: dirname} {
testsetplatform windows
list [catch {file dirname {c:\foo}} msg] $msg
} {0 c:/}
-test cmdAH-4.25 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.25 {Tcl_FileObjCmd: dirname} {
testsetplatform windows
list [catch {file dirname {//foo/bar/baz}} msg] $msg
} {0 //foo/bar}
-test cmdAH-4.26 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.26 {Tcl_FileObjCmd: dirname} {
testsetplatform windows
list [catch {file dirname {//foo/bar}} msg] $msg
} {0 //foo/bar}
-test cmdAH-4.27 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.27 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname :} msg] $msg
} {0 :}
-test cmdAH-4.28 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.28 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname :Foo} msg] $msg
} {0 :}
-test cmdAH-4.29 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.29 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname Foo:} msg] $msg
} {0 Foo:}
-test cmdAH-4.30 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.30 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname Foo:bar} msg] $msg
} {0 Foo:}
-test cmdAH-4.31 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.31 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname :Foo:bar} msg] $msg
} {0 :Foo}
-test cmdAH-4.32 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.32 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname ::} msg] $msg
} {0 :}
-test cmdAH-4.33 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.33 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname :::} msg] $msg
} {0 ::}
-test cmdAH-4.34 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.34 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname /foo/bar/} msg] $msg
} {0 foo:}
-test cmdAH-4.35 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.35 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname /foo/bar} msg] $msg
} {0 foo:}
-test cmdAH-4.36 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.36 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname /foo} msg] $msg
} {0 foo:}
-test cmdAH-4.37 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.37 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname foo} msg] $msg
} {0 :}
-test cmdAH-4.38 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.38 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname ~/foo} msg] $msg
} {0 ~}
-test cmdAH-4.39 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.39 {Tcl_FileObjCmd: dirname} {
testsetplatform unix
list [catch {file dirname ~bar/foo} msg] $msg
} {0 ~bar}
-test cmdAH-4.40 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.40 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname ~bar/foo} msg] $msg
} {0 ~bar:}
-test cmdAH-4.41 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.41 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname ~/foo} msg] $msg
} {0 ~:}
-test cmdAH-4.42 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.42 {Tcl_FileObjCmd: dirname} {
testsetplatform mac
list [catch {file dirname ~:baz} msg] $msg
} {0 ~:}
-test cmdAH-4.43 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.43 {Tcl_FileObjCmd: dirname} {
global env
set temp $env(HOME)
set env(HOME) "/home/test"
@@ -240,7 +385,7 @@ test cmdAH-4.43 {Tcl_FileObjCmd: dirname} {
set env(HOME) $temp
set result
} {0 /home}
-test cmdAH-4.44 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.44 {Tcl_FileObjCmd: dirname} {
global env
set temp $env(HOME)
set env(HOME) "~"
@@ -249,7 +394,7 @@ test cmdAH-4.44 {Tcl_FileObjCmd: dirname} {
set env(HOME) $temp
set result
} {0 ~}
-test cmdAH-4.45 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.45 {Tcl_FileObjCmd: dirname} {
global env
set temp $env(HOME)
set env(HOME) "/home/test"
@@ -258,7 +403,7 @@ test cmdAH-4.45 {Tcl_FileObjCmd: dirname} {
set env(HOME) $temp
set result
} {0 /home}
-test cmdAH-4.46 {Tcl_FileObjCmd: dirname} {
+test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {
global env
set temp $env(HOME)
set env(HOME) "/home/test"
@@ -270,171 +415,171 @@ test cmdAH-4.46 {Tcl_FileObjCmd: dirname} {
# tail
-test cmdAH-5.1 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.1 {Tcl_FileObjCmd: tail} {
testsetplatform unix
list [catch {file tail a b} msg] $msg
} {1 {wrong # args: should be "file tail name"}}
-test cmdAH-5.2 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.2 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail /a/b
} b
-test cmdAH-5.3 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.3 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail {}
} {}
-test cmdAH-5.4 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.4 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail {}
} {}
-test cmdAH-5.5 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.5 {Tcl_FileObjCmd: tail} {
testsetplatform win
file tail {}
} {}
-test cmdAH-5.6 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.6 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail .def
} .def
-test cmdAH-5.7 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.7 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail a
} a
-test cmdAH-5.8 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.8 {Tcl_FileObjCmd: tail} {
testsetplatform win
file tail a
} a
-test cmdAH-5.9 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.9 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file ta a/b/c.d
} c.d
-test cmdAH-5.10 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.10 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail a/b.c/d
} d
-test cmdAH-5.11 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.11 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail /.
} .
-test cmdAH-5.12 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.12 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail /
} {}
-test cmdAH-5.13 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.13 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail /foo
} foo
-test cmdAH-5.14 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.14 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail //foo
} foo
-test cmdAH-5.15 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.15 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail //foo/bar
} bar
-test cmdAH-5.16 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.16 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail {//foo\/bar/baz}
} baz
-test cmdAH-5.17 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.17 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail {//foo\/bar/baz/blat}
} blat
-test cmdAH-5.18 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.18 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail /foo//
} foo
-test cmdAH-5.19 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.19 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail ./a
} a
-test cmdAH-5.20 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.20 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail a/.a
} .a
-test cmdAH-5.21 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.21 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail c:foo
} foo
-test cmdAH-5.22 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.22 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail c:
} {}
-test cmdAH-5.23 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.23 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail c:/
} {}
-test cmdAH-5.24 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.24 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail {c:\foo}
} foo
-test cmdAH-5.25 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.25 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail {//foo/bar/baz}
} baz
-test cmdAH-5.26 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.26 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail {//foo/bar}
} {}
-test cmdAH-5.27 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.27 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail :
} :
-test cmdAH-5.28 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.28 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail :Foo
} Foo
-test cmdAH-5.29 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.29 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail Foo:
} {}
-test cmdAH-5.30 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.30 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail Foo:bar
} bar
-test cmdAH-5.31 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.31 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail :Foo:bar
} bar
-test cmdAH-5.32 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.32 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail ::
} ::
-test cmdAH-5.33 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.33 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail :::
} ::
-test cmdAH-5.34 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.34 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail /foo/bar/
} bar
-test cmdAH-5.35 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.35 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail /foo/bar
} bar
-test cmdAH-5.36 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.36 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail /foo
} {}
-test cmdAH-5.37 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.37 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail foo
} foo
-test cmdAH-5.38 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.38 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail ~:foo
} foo
-test cmdAH-5.39 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.39 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail ~bar:foo
} foo
-test cmdAH-5.40 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.40 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail ~bar/foo
} foo
-test cmdAH-5.41 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.41 {Tcl_FileObjCmd: tail} {
testsetplatform mac
file tail ~/foo
} foo
-test cmdAH-5.42 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.42 {Tcl_FileObjCmd: tail} {
global env
set temp $env(HOME)
set env(HOME) "/home/test"
@@ -443,7 +588,7 @@ test cmdAH-5.42 {Tcl_FileObjCmd: tail} {
set env(HOME) $temp
set result
} test
-test cmdAH-5.43 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.43 {Tcl_FileObjCmd: tail} {
global env
set temp $env(HOME)
set env(HOME) "~"
@@ -452,7 +597,7 @@ test cmdAH-5.43 {Tcl_FileObjCmd: tail} {
set env(HOME) $temp
set result
} {}
-test cmdAH-5.44 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.44 {Tcl_FileObjCmd: tail} {
global env
set temp $env(HOME)
set env(HOME) "/home/test"
@@ -461,7 +606,7 @@ test cmdAH-5.44 {Tcl_FileObjCmd: tail} {
set env(HOME) $temp
set result
} test
-test cmdAH-5.45 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.45 {Tcl_FileObjCmd: tail} {
global env
set temp $env(HOME)
set env(HOME) "/home/test"
@@ -470,166 +615,166 @@ test cmdAH-5.45 {Tcl_FileObjCmd: tail} {
set env(HOME) $temp
set result
} test
-test cmdAH-5.46 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.46 {Tcl_FileObjCmd: tail} {
testsetplatform unix
file tail {f.oo\bar/baz.bat}
} baz.bat
-test cmdAH-5.47 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.47 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail c:foo
} foo
-test cmdAH-5.48 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.48 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail c:
} {}
-test cmdAH-5.49 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.49 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail c:/foo
} foo
-test cmdAH-5.50 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.50 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail {c:/foo\bar}
} bar
-test cmdAH-5.51 {Tcl_FileObjCmd: tail} {
+test cmdAH-9.51 {Tcl_FileObjCmd: tail} {
testsetplatform windows
file tail {foo\bar}
} bar
# rootname
-test cmdAH-6.1 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.1 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
list [catch {file rootname a b} msg] $msg
} {1 {wrong # args: should be "file rootname name"}}
-test cmdAH-6.2 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.2 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file rootname {}
} {}
-test cmdAH-6.3 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.3 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file ro foo
} foo
-test cmdAH-6.4 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.4 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file rootname foo.
} foo
-test cmdAH-6.5 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.5 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file rootname .foo
} {}
-test cmdAH-6.6 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.6 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file rootname abc.def
} abc
-test cmdAH-6.7 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.7 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file rootname abc.def.ghi
} abc.def
-test cmdAH-6.8 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.8 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file rootname a/b/c.d
} a/b/c
-test cmdAH-6.9 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.9 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file rootname a/b.c/d
} a/b.c/d
-test cmdAH-6.10 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.10 {Tcl_FileObjCmd: rootname} {
testsetplatform unix
file rootname a/b.c/
} a/b.c/
-test cmdAH-6.11 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.11 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file ro foo
} foo
-test cmdAH-6.12 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.12 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname {}
} {}
-test cmdAH-6.13 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.13 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname foo.
} foo
-test cmdAH-6.14 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.14 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname .foo
} {}
-test cmdAH-6.15 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.15 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname abc.def
} abc
-test cmdAH-6.16 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.16 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname abc.def.ghi
} abc.def
-test cmdAH-6.17 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.17 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname a:b:c.d
} a:b:c
-test cmdAH-6.18 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.18 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname a:b.c:d
} a:b.c:d
-test cmdAH-6.19 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.19 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname a/b/c.d
} a/b/c
-test cmdAH-6.20 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.20 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname a/b.c/d
} a/b.c/d
-test cmdAH-6.21 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.21 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname /a.b
} /a
-test cmdAH-6.22 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.22 {Tcl_FileObjCmd: rootname} {
testsetplatform mac
file rootname foo.c:
} foo.c:
-test cmdAH-6.23 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.23 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname {}
} {}
-test cmdAH-6.24 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.24 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file ro foo
} foo
-test cmdAH-6.25 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.25 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname foo.
} foo
-test cmdAH-6.26 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.26 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname .foo
} {}
-test cmdAH-6.27 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.27 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname abc.def
} abc
-test cmdAH-6.28 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.28 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname abc.def.ghi
} abc.def
-test cmdAH-6.29 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.29 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname a/b/c.d
} a/b/c
-test cmdAH-6.30 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.30 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname a/b.c/d
} a/b.c/d
-test cmdAH-6.31 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.31 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname a\\b.c\\
} a\\b.c\\
-test cmdAH-6.32 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.32 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname a\\b\\c.d
} a\\b\\c
-test cmdAH-6.33 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.33 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname a\\b.c\\d
} a\\b.c\\d
-test cmdAH-6.34 {Tcl_FileObjCmd: rootname} {
+test cmdAH-10.34 {Tcl_FileObjCmd: rootname} {
testsetplatform windows
file rootname a\\b.c\\
} a\\b.c\\
@@ -647,144 +792,144 @@ foreach outer { {} a .a a. a.a } {
# extension
-test cmdAH-7.1 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.1 {Tcl_FileObjCmd: extension} {
testsetplatform unix
list [catch {file extension a b} msg] $msg
} {1 {wrong # args: should be "file extension name"}}
-test cmdAH-7.2 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.2 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file extension {}
} {}
-test cmdAH-7.3 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.3 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file ext foo
} {}
-test cmdAH-7.4 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.4 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file extension foo.
} .
-test cmdAH-7.5 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.5 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file extension .foo
} .foo
-test cmdAH-7.6 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.6 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file extension abc.def
} .def
-test cmdAH-7.7 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.7 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file extension abc.def.ghi
} .ghi
-test cmdAH-7.8 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.8 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file extension a/b/c.d
} .d
-test cmdAH-7.9 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.9 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file extension a/b.c/d
} {}
-test cmdAH-7.10 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.10 {Tcl_FileObjCmd: extension} {
testsetplatform unix
file extension a/b.c/
} {}
-test cmdAH-7.11 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.11 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file ext foo
} {}
-test cmdAH-7.12 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.12 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension {}
} {}
-test cmdAH-7.13 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.13 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension foo.
} .
-test cmdAH-7.14 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.14 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension .foo
} .foo
-test cmdAH-7.15 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.15 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension abc.def
} .def
-test cmdAH-7.16 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.16 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension abc.def.ghi
} .ghi
-test cmdAH-7.17 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.17 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension a:b:c.d
} .d
-test cmdAH-7.18 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.18 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension a:b.c:d
} {}
-test cmdAH-7.19 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.19 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension a/b/c.d
} .d
-test cmdAH-7.20 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.20 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension a/b.c/d
} {}
-test cmdAH-7.21 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.21 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension /a.b
} .b
-test cmdAH-7.22 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.22 {Tcl_FileObjCmd: extension} {
testsetplatform mac
file extension foo.c:
} {}
-test cmdAH-7.23 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.23 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension {}
} {}
-test cmdAH-7.24 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.24 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file ext foo
} {}
-test cmdAH-7.25 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.25 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension foo.
} .
-test cmdAH-7.26 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.26 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension .foo
} .foo
-test cmdAH-7.27 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.27 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension abc.def
} .def
-test cmdAH-7.28 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.28 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension abc.def.ghi
} .ghi
-test cmdAH-7.29 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.29 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension a/b/c.d
} .d
-test cmdAH-7.30 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.30 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension a/b.c/d
} {}
-test cmdAH-7.31 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.31 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension a\\b.c\\
} {}
-test cmdAH-7.32 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.32 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension a\\b\\c.d
} .d
-test cmdAH-7.33 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.33 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension a\\b.c\\d
} {}
-test cmdAH-7.34 {Tcl_FileObjCmd: extension} {
+test cmdAH-11.34 {Tcl_FileObjCmd: extension} {
testsetplatform windows
file extension a\\b.c\\
} {}
set num 35
-foreach value {a..b a...b a.c..b ..b} result {..b ...b ..b ..b} {
+foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} {
foreach p {unix mac windows} {
; test cmdAH-7.$num {Tcl_FileObjCmd: extension} "
testsetplatform $p
@@ -796,56 +941,56 @@ foreach value {a..b a...b a.c..b ..b} result {..b ...b ..b ..b} {
# pathtype
-test cmdAH-8.1 {Tcl_FileObjCmd: pathtype} {
+test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} {
testsetplatform unix
list [catch {file pathtype a b} msg] $msg
} {1 {wrong # args: should be "file pathtype name"}}
-test cmdAH-8.2 {Tcl_FileObjCmd: pathtype} {
+test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} {
testsetplatform unix
file pathtype /a
} absolute
-test cmdAH-8.3 {Tcl_FileObjCmd: pathtype} {
+test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} {
testsetplatform unix
file p a
} relative
-test cmdAH-8.4 {Tcl_FileObjCmd: pathtype} {
+test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} {
testsetplatform windows
file pathtype c:a
} volumerelative
# split
-test cmdAH-9.1 {Tcl_FileObjCmd: split} {
+test cmdAH-13.1 {Tcl_FileObjCmd: split} {
testsetplatform unix
list [catch {file split a b} msg] $msg
} {1 {wrong # args: should be "file split name"}}
-test cmdAH-9.2 {Tcl_FileObjCmd: split} {
+test cmdAH-13.2 {Tcl_FileObjCmd: split} {
testsetplatform unix
file split a
} a
-test cmdAH-9.3 {Tcl_FileObjCmd: split} {
+test cmdAH-13.3 {Tcl_FileObjCmd: split} {
testsetplatform unix
file split a/b
} {a b}
# join
-test cmdAH-10.1 {Tcl_FileObjCmd: join} {
+test cmdAH-14.1 {Tcl_FileObjCmd: join} {
testsetplatform unix
file join a
} a
-test cmdAH-10.2 {Tcl_FileObjCmd: join} {
+test cmdAH-14.2 {Tcl_FileObjCmd: join} {
testsetplatform unix
file join a b
} a/b
-test cmdAH-10.3 {Tcl_FileObjCmd: join} {
+test cmdAH-14.3 {Tcl_FileObjCmd: join} {
testsetplatform unix
file join a b c d
} a/b/c/d
# error handling of Tcl_TranslateFileName
-test cmdAH-11.1 {Tcl_FileObjCmd} {
+test cmdAH-15.1 {Tcl_FileObjCmd} {
testsetplatform unix
list [catch {file atime ~_bad_user} msg] $msg
} {1 {user "_bad_user" doesn't exist}}
@@ -862,29 +1007,29 @@ if {[info commands testchmod] == {}} {
makeFile abcde gorp.file
makeDirectory dir.file
-test cmdAH-12.1 {Tcl_FileObjCmd: readable} {
+test cmdAH-16.1 {Tcl_FileObjCmd: readable} {
list [catch {file readable a b} msg] $msg
} {1 {wrong # args: should be "file readable name"}}
testchmod 444 gorp.file
-test cmdAH-12.2 {Tcl_FileObjCmd: readable} {
+test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
file readable gorp.file
} 1
testchmod 333 gorp.file
-test cmdAH-12.3 {Tcl_FileObjCmd: readable} {unixOnly && !root} {
+test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot} {
file reada gorp.file
} 0
# writable
-test cmdAH-13.1 {Tcl_FileObjCmd: writable} {
+test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
list [catch {file writable a b} msg] $msg
} {1 {wrong # args: should be "file writable name"}}
testchmod 555 gorp.file
-test cmdAH-13.2 {Tcl_FileObjCmd: writable} {!root} {
+test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot} {
file writable gorp.file
} 0
testchmod 222 gorp.file
-test cmdAH-13.3 {Tcl_FileObjCmd: writable} {
+test cmdAH-17.3 {Tcl_FileObjCmd: writable} {
file writable gorp.file
} 1
@@ -894,13 +1039,13 @@ file delete -force dir.file gorp.file
file mkdir dir.file
makeFile abcde gorp.file
-test cmdAH-14.1 {Tcl_FileObjCmd: executable} {
+test cmdAH-18.1 {Tcl_FileObjCmd: executable} {
list [catch {file executable a b} msg] $msg
} {1 {wrong # args: should be "file executable name"}}
-test cmdAH-14.2 {Tcl_FileObjCmd: executable} {
+test cmdAH-18.2 {Tcl_FileObjCmd: executable} {
file executable gorp.file
} 0
-test cmdAH-14.3 {Tcl_FileObjCmd: executable} {unix} {
+test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly} {
# Only on unix will setting the execute bit on a regular file
# cause that file to be executable.
@@ -908,14 +1053,14 @@ test cmdAH-14.3 {Tcl_FileObjCmd: executable} {unix} {
file exe gorp.file
} 1
-test cmdAH-14.4 {Tcl_FileObjCmd: executable} {mac} {
+test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly} {
# On mac, the only executable files are of type APPL.
set x [file exe gorp.file]
file attrib gorp.file -type APPL
lappend x [file exe gorp.file]
} {0 1}
-test cmdAH-14.5 {Tcl_FileObjCmd: executable} {pc} {
+test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly} {
# On pc, must be a .exe, .com, etc.
set x [file exe gorp.file]
@@ -924,7 +1069,7 @@ test cmdAH-14.5 {Tcl_FileObjCmd: executable} {pc} {
file delete gorp.exe
set x
} {0 1}
-test cmdAH-14.6 {Tcl_FileObjCmd: executable} {
+test cmdAH-18.6 {Tcl_FileObjCmd: executable} {
# Directories are always executable.
file exe dir.file
@@ -937,11 +1082,11 @@ file delete link.file
# exists
-test cmdAH-15.1 {Tcl_FileObjCmd: exists} {
+test cmdAH-19.1 {Tcl_FileObjCmd: exists} {
list [catch {file exists a b} msg] $msg
} {1 {wrong # args: should be "file exists name"}}
-test cmdAH-15.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0
-test cmdAH-15.3 {Tcl_FileObjCmd: exists} {
+test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0
+test cmdAH-19.3 {Tcl_FileObjCmd: exists} {
file exists [file join dir.file gorp.file]
} 0
catch {
@@ -949,10 +1094,10 @@ catch {
makeDirectory dir.file
makeFile 12345 [file join dir.file gorp.file]
}
-test cmdAH-15.4 {Tcl_FileObjCmd: exists} {
+test cmdAH-19.4 {Tcl_FileObjCmd: exists} {
file exists gorp.file
} 1
-test cmdAH-15.5 {Tcl_FileObjCmd: exists} {
+test cmdAH-19.5 {Tcl_FileObjCmd: exists} {
file exists [file join dir.file gorp.file]
} 1
@@ -961,24 +1106,24 @@ if {[info commands testsetplatform] == {}} {
puts "This application hasn't been compiled with the \"testsetplatform\""
puts "command, so I can't test Tcl_FileObjCmd etc."
} else {
-test cmdAH-15.6 {Tcl_FileObjCmd: nativename} {
+test cmdAH-19.6 {Tcl_FileObjCmd: nativename} {
testsetplatform unix
list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 a/b {}}
-test cmdAH-15.7 {Tcl_FileObjCmd: nativename} {
+test cmdAH-19.7 {Tcl_FileObjCmd: nativename} {
testsetplatform windows
list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 {a\b} {}}
-test cmdAH-15.8 {Tcl_FileObjCmd: nativename} {
+test cmdAH-19.8 {Tcl_FileObjCmd: nativename} {
testsetplatform mac
list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 :a:b {}}
}
-test cmdAH-15.9 {Tcl_FileObjCmd: ~ : exists} {
+test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {
file exists ~nOsUcHuSeR
} 0
-test cmdAH-15.10 {Tcl_FileObjCmd: ~ : nativename} {
+test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {
# should probably be 0 in fact...
catch {file nativename ~nOsUcHuSeR}
} 1
@@ -987,21 +1132,20 @@ test cmdAH-15.10 {Tcl_FileObjCmd: ~ : nativename} {
# directory in order to guarantee (?) a local file system: some
# NFS file systems won't do the stuff below correctly.
-if {$tcl_platform(platform) == "unix"} {
- file delete /tmp/tcl.foo.dir/file
+test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {
+ removeFile /tmp/tcl.foo.dir/file
removeDirectory /tmp/tcl.foo.dir
makeDirectory /tmp/tcl.foo.dir
makeFile 12345 /tmp/tcl.foo.dir/file
exec chmod 000 /tmp/tcl.foo.dir
- if {$user != "root"} {
- test cmdAH-15.9 {Tcl_FileObjCmd: exists} {
- file exists /tmp/tcl.foo.dir/file
- } 0
- }
+
+ set result [file exists /tmp/tcl.foo.dir/file]
+
exec chmod 775 /tmp/tcl.foo.dir
- file delete /tmp/tcl.foo.dir/file
+ removeFile /tmp/tcl.foo.dir/file
removeDirectory /tmp/tcl.foo.dir
-}
+ set result
+} 0
# Stat related commands
@@ -1012,65 +1156,87 @@ catch {exec chmod 765 gorp.file}
# atime
-test cmdAH-16.1 {Tcl_FileObjCmd: atime} {
- list [catch {file atime a b} msg] $msg
-} {1 {wrong # args: should be "file atime name"}}
-test cmdAH-16.2 {Tcl_FileObjCmd: atime} {
+set file [makeFile "data" touch.me]
+
+test cmdAH-20.1 {Tcl_FileObjCmd: atime} {
+ list [catch {file atime a b c} msg] $msg
+} {1 {wrong # args: should be "file atime name ?time?"}}
+test cmdAH-20.2 {Tcl_FileObjCmd: atime} {
catch {unset stat}
file stat gorp.file stat
list [expr {[file mtime gorp.file] == $stat(mtime)}] \
[expr {[file atime gorp.file] == $stat(atime)}]
} {1 1}
-test cmdAH-16.3 {Tcl_FileObjCmd: atime} {
+test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
string tolower [list [catch {file atime _bogus_} msg] \
$msg $errorCode]
-} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-20.4 {Tcl_FileObjCmd: atime} {
+ list [catch {file atime $file notint} msg] $msg
+} {1 {expected integer but got "notint"}}
+test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {
+ if {[string equal $tcl_platform(platform) "windows"]} {
+ set old [pwd]
+ cd $::tcltest::temporaryDirectory
+ if {![string equal "NTFS" [testvolumetype]]} {
+ # Windows FAT doesn't understand atime, but NTFS does
+ # May also fail for Windows on NFS mounted disks
+ cd $old
+ return 1
+ }
+ cd $old
+ }
+ set atime [file atime $file]
+ after 1100; # pause a sec to notice change in atime
+ set newatime [clock seconds]
+ expr {$newatime==[file atime $file $newatime]}
+} 1
# isdirectory
-test cmdAH-17.1 {Tcl_FileObjCmd: isdirectory} {
+test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {
list [catch {file isdirectory a b} msg] $msg
} {1 {wrong # args: should be "file isdirectory name"}}
-test cmdAH-17.2 {Tcl_FileObjCmd: isdirectory} {
+test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {
file isdirectory gorp.file
} 0
-test cmdAH-17.3 {Tcl_FileObjCmd: isdirectory} {
+test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
file isd dir.file
} 1
# isfile
-test cmdAH-18.1 {Tcl_FileObjCmd: isfile} {
+test cmdAH-22.1 {Tcl_FileObjCmd: isfile} {
list [catch {file isfile a b} msg] $msg
} {1 {wrong # args: should be "file isfile name"}}
-test cmdAH-18.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1
-test cmdAH-18.3 {Tcl_FileObjCmd: isfile} {file isfile dir.file} 0
+test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1
+test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile dir.file} 0
# lstat and readlink: don't run these tests everywhere, since not all
# sites will have symbolic links
catch {exec ln -s gorp.file link.file}
-test cmdAH-19.1 {Tcl_FileObjCmd: lstat} {
+test cmdAH-23.1 {Tcl_FileObjCmd: lstat} {
list [catch {file lstat a} msg] $msg
} {1 {wrong # args: should be "file lstat name varName"}}
-test cmdAH-19.2 {Tcl_FileObjCmd: lstat} {
+test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {
list [catch {file lstat a b c} msg] $msg
} {1 {wrong # args: should be "file lstat name varName"}}
-test cmdAH-19.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
+test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
catch {unset stat}
file lstat link.file stat
lsort [array names stat]
} {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdAH-19.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
+test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
catch {unset stat}
file lstat link.file stat
list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
} {1 511 link}
-test cmdAH-19.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
+test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
string tolower [list [catch {file lstat _bogus_ stat} msg] \
$msg $errorCode]
-} {1 {couldn't lstat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-19.6 {Tcl_FileObjCmd: lstat errors} {
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} {
catch {unset x}
set x 44
list [catch {file lstat gorp.file x} msg] $msg $errorCode
@@ -1079,10 +1245,12 @@ catch {unset stat}
# mtime
-test cmdAH-20.1 {Tcl_FileObjCmd: mtime} {
- list [catch {file mtime a b} msg] $msg
-} {1 {wrong # args: should be "file mtime name"}}
-test cmdAH-20.2 {Tcl_FileObjCmd: mtime} {
+set file [makeFile "data" touch.me]
+
+test cmdAH-24.1 {Tcl_FileObjCmd: mtime} {
+ list [catch {file mtime a b c} msg] $msg
+} {1 {wrong # args: should be "file mtime name ?time?"}}
+test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
set old [file mtime gorp.file]
after 2000
set f [open gorp.file w]
@@ -1091,29 +1259,28 @@ test cmdAH-20.2 {Tcl_FileObjCmd: mtime} {
set new [file mtime gorp.file]
expr {($new > $old) && ($new <= ($old+5))}
} {1}
-test cmdAH-20.3 {Tcl_FileObjCmd: mtime} {
+test cmdAH-24.3 {Tcl_FileObjCmd: mtime} {
catch {unset stat}
file stat gorp.file stat
list [expr {[file mtime gorp.file] == $stat(mtime)}] \
[expr {[file atime gorp.file] == $stat(atime)}]
} {1 1}
-test cmdAH-20.4 {Tcl_FileObjCmd: mtime} {
+test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {
string tolower [list [catch {file mtime _bogus_} msg] $msg \
$errorCode]
-} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-20.5 {Tcl_FileObjCmd: mtime} {
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
# Under Unix, use a file in /tmp to avoid clock skew due to NFS.
# On other platforms, just use a file in the local directory.
- if {$tcl_platform(platform) == "unix"} {
+ if {[string equal $tcl_platform(platform) "unix"]} {
set name /tmp/tcl.test
} else {
set name tf
}
- # Borland file times were off by timezone. Make sure that a new file's
- # time is correct. 10 seconds variance is allowed used due to slow
- # networks or clock skew on a network drive.
+ # Make sure that a new file's time is correct. 10 seconds variance
+ # is allowed used due to slow networks or clock skew on a network drive.
file delete -force $name
close [open $name w]
@@ -1121,47 +1288,56 @@ test cmdAH-20.5 {Tcl_FileObjCmd: mtime} {
file delete $name
set a
} {1}
+test cmdAH-24.7 {Tcl_FileObjCmd: mtime} {
+ list [catch {file mtime $file notint} msg] $msg
+} {1 {expected integer but got "notint"}}
+test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} {
+ set mtime [file mtime $file]
+ after 1100; # pause a sec to notice change in mtime
+ set newmtime [clock seconds]
+ expr {$newmtime==[file mtime $file $newmtime]}
+} 1
# owned
-test cmdAH-21.1 {Tcl_FileObjCmd: owned} {
+test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
list [catch {file owned a b} msg] $msg
} {1 {wrong # args: should be "file owned name"}}
-test cmdAH-21.2 {Tcl_FileObjCmd: owned} {
+test cmdAH-25.2 {Tcl_FileObjCmd: owned} {
file owned gorp.file
} 1
-test cmdAH-21.3 {Tcl_FileObjCmd: owned} {unixOnly && !root} {
+test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} {
file owned /
} 0
# readlink
-test cmdAH-22.1 {Tcl_FileObjCmd: readlink} {
+test cmdAH-26.1 {Tcl_FileObjCmd: readlink} {
list [catch {file readlink a b} msg] $msg
} {1 {wrong # args: should be "file readlink name"}}
-test cmdAH-22.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {
+test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {
file readlink link.file
} gorp.file
-test cmdAH-22.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {
+test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {
list [catch {file readlink _bogus_} msg] [string tolower $msg] \
[string tolower $errorCode]
-} {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-22.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} {
+} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-26.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} {
list [catch {file readlink _bogus_} msg] [string tolower $msg] \
[string tolower $errorCode]
-} {1 {couldn't readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-22.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} {
+} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} {
list [catch {file readlink _bogus_} msg] [string tolower $msg] \
[string tolower $errorCode]
-} {1 {couldn't readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}
+} {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}
# size
-test cmdAH-23.1 {Tcl_FileObjCmd: size} {
+test cmdAH-27.1 {Tcl_FileObjCmd: size} {
list [catch {file size a b} msg] $msg
} {1 {wrong # args: should be "file size name"}}
-test cmdAH-23.2 {Tcl_FileObjCmd: size} {
+test cmdAH-27.2 {Tcl_FileObjCmd: size} {
set oldsize [file size gorp.file]
set f [open gorp.file a]
fconfigure $f -translation lf -eofchar {}
@@ -1169,10 +1345,10 @@ test cmdAH-23.2 {Tcl_FileObjCmd: size} {
close $f
expr {[file size gorp.file] - $oldsize}
} {10}
-test cmdAH-23.3 {Tcl_FileObjCmd: size} {
+test cmdAH-27.3 {Tcl_FileObjCmd: size} {
string tolower [list [catch {file size _bogus_} msg] $msg \
$errorCode]
-} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
# stat
@@ -1180,94 +1356,185 @@ catch {testsetplatform $platform}
makeFile "Test string" gorp.file
catch {exec chmod 765 gorp.file}
-test cmdAH-24.1 {Tcl_FileObjCmd: stat} {
+test cmdAH-28.1 {Tcl_FileObjCmd: stat} {
list [catch {file stat _bogus_} msg] $msg $errorCode
} {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdAH-24.2 {Tcl_FileObjCmd: stat} {
+test cmdAH-28.2 {Tcl_FileObjCmd: stat} {
list [catch {file stat _bogus_ a b} msg] $msg $errorCode
} {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdAH-24.3 {Tcl_FileObjCmd: stat} {
+test cmdAH-28.3 {Tcl_FileObjCmd: stat} {
catch {unset stat}
file stat gorp.file stat
lsort [array names stat]
} {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdAH-24.4 {Tcl_FileObjCmd: stat} {
+test cmdAH-28.4 {Tcl_FileObjCmd: stat} {
catch {unset stat}
file stat gorp.file stat
list $stat(nlink) $stat(size) $stat(type)
} {1 12 file}
-test cmdAH-24.5 {Tcl_FileObjCmd: stat} {unix} {
+test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unixOnly} {
catch {unset stat}
file stat gorp.file stat
expr $stat(mode)&0777
} {501}
-test cmdAH-24.6 {Tcl_FileObjCmd: stat} {
+test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
string tolower [list [catch {file stat _bogus_ stat} msg] \
$msg $errorCode]
-} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-24.7 {Tcl_FileObjCmd: stat} {
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+test cmdAH-28.7 {Tcl_FileObjCmd: stat} {
catch {unset x}
set x 44
list [catch {file stat gorp.file x} msg] $msg $errorCode
} {1 {can't set "x(dev)": variable isn't array} NONE}
+test cmdAH-28.8 {Tcl_FileObjCmd: stat} {
+ # Sign extension of purported unsigned short to int.
+
+ close [open foo.test w]
+ file stat foo.test stat
+ set x [expr {$stat(mode) > 0}]
+ file delete foo.test
+ set x
+} 1
+test cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} {
+ # stat of root directory was failing.
+ # don't care about answer, just that test runs.
+
+ # relative paths that resolve to root
+ set old [pwd]
+ cd c:/
+ file stat c: stat
+ file stat c:. stat
+ file stat . stat
+ cd $old
+
+ file stat / stat
+ file stat c:/ stat
+ file stat c:/. stat
+} {}
+test cmdAH-28.10 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {
+ # stat of root directory was failing.
+ # don't care about answer, just that test runs.
+
+ file stat //pop/$env(USERNAME) stat
+ file stat //pop/$env(USERNAME)/ stat
+ file stat //pop/$env(USERNAME)/. stat
+} {}
+test cmdAH-28.11 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {
+ # stat of network directory was returning id of current local drive.
+
+ set old [pwd]
+ cd c:/
+
+ file stat //pop/$env(USERNAME) stat
+ cd $old
+ expr {$stat(dev) == 2}
+} 0
+test cmdAH-28.12 {Tcl_FileObjCmd: stat} {
+ # stat(mode) with S_IFREG flag was returned as a negative number
+ # if mode_t was a short instead of an unsigned short.
+
+ close [open foo.test w]
+ file stat foo.test stat
+ file delete foo.test
+ expr {$stat(mode) > 0}
+} 1
catch {unset stat}
# type
file delete link.file
-test cmdAH-25.1 {Tcl_FileObjCmd: type} {
+test cmdAH-29.1 {Tcl_FileObjCmd: type} {
list [catch {file size a b} msg] $msg
} {1 {wrong # args: should be "file size name"}}
-test cmdAH-25.2 {Tcl_FileObjCmd: type} {
+test cmdAH-29.2 {Tcl_FileObjCmd: type} {
file type dir.file
} directory
-test cmdAH-25.3 {Tcl_FileObjCmd: type} {
+test cmdAH-29.3 {Tcl_FileObjCmd: type} {
file type gorp.file
} file
-test cmdAH-25.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {
+test cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {
exec ln -s a/b/c link.file
set result [file type link.file]
file delete link.file
set result
} link
-test cmdAH-25.5 {Tcl_FileObjCmd: type} {
+test cmdAH-29.5 {Tcl_FileObjCmd: type} {
string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
-} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
# Error conditions
-test cmdAH-26.1 {error conditions} {
+test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
list [catch {file gorp x} msg] $msg
-} {1 {bad option "gorp": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
-test cmdAH-26.2 {error conditions} {
+} {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
list [catch {file ex x} msg] $msg
-} {1 {ambiguous option "ex": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
-test cmdAH-26.3 {error conditions} {
+} {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
list [catch {file is x} msg] $msg
-} {1 {ambiguous option "is": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
-test cmdAH-26.4 {error conditions} {
+} {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
list [catch {file z x} msg] $msg
-} {1 {bad option "z": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
-test cmdAH-26.5 {error conditions} {
+} {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
list [catch {file read x} msg] $msg
-} {1 {ambiguous option "read": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
-test cmdAH-26.6 {error conditions} {
+} {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
list [catch {file s x} msg] $msg
-} {1 {ambiguous option "s": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
-test cmdAH-26.7 {error conditions} {
+} {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
list [catch {file t x} msg] $msg
-} {1 {ambiguous option "t": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
-test cmdAH-26.8 {error conditions} {
+} {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
list [catch {file dirname ~woohgy} msg] $msg
} {1 {user "woohgy" doesn't exist}}
+# channels
+
+test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
+ list [catch {file channels a b} msg] $msg
+} {1 {wrong # args: should be "file channels ?pattern?"}}
+test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {
+ file chan
+} {stderr stdout stdin}
+test cmdAH-31.3 {Tcl_FileObjCmd: channels, too many args} {
+ string equal [file channels] [file channels *]
+} {1}
+test cmdAH-31.4 {Tcl_FileObjCmd: channels} {
+ set old [file channels gorp.file]
+ set f [open gorp.file w]
+ set new [file channels file*]
+ close $f
+ string equal $f $new
+} {1}
+
+# cleanup
catch {testsetplatform $platform}
catch {unset platform}
+# Tcl_ForObjCmd is tested in for.test
+
catch {exec chmod 777 dir.file}
file delete -force dir.file
file delete gorp.file
file delete link.file
-concat ""
+cd $cmdAHwd
+
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/cmdIL.test b/tcl/tests/cmdIL.test
index 115e0f65c92..0009885af88 100644
--- a/tcl/tests/cmdIL.test
+++ b/tcl/tests/cmdIL.test
@@ -3,21 +3,24 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
list [catch {lsort} msg] $msg
} {1 {wrong # args: should be "lsort ?options? list"}}
test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
list [catch {lsort -foo {1 3 2 5}} msg] $msg
-} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -integer, or -real}}
+} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -integer, -real, or -unique}}
test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
lsort {d e c b a \{ d35 d300}
} {a b c d d300 d35 e \{}
@@ -50,7 +53,7 @@ test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} {
} {1 {"-index" option must be followed by list index}}
test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} {
list [catch {lsort -index foo {1 3 2 5}} msg] $msg
-} {1 {bad index "foo": must be integer or "end"}}
+} {1 {bad index "foo": must be integer or end?-integer?}}
test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
} {1 {2 25} {3 16 42} {10 20 50 100}}
@@ -72,6 +75,13 @@ test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} {
test cmdIL-1.19 {Tcl_LsortObjCmd procedure, empty list} {
lsort {}
} {}
+test cmdIL-1.22 {Tcl_LsortObjCmd procedure, unique sort} {
+ lsort -integer -unique {3 1 2 3 1 4 3}
+} {1 2 3 4}
+test cmdIL-1.23 {Tcl_LsortObjCmd procedure, unique sort with index} {
+ # lsort -unique should return the last unique item
+ lsort -unique -index 0 {{a b} {c b} {a c} {d a}}
+} {{a c} {c b} {d a}}
# Can't think of any good tests for the MergeSort and MergeLists
# procedures, except a bunch of random lists to sort.
@@ -81,12 +91,12 @@ test cmdIL-2.1 {MergeSort and MergeLists procedures} {
set r 1435753299
proc rand {} {
global r
- set r [expr (16807 * $r) % (0x7fffffff)]
+ set r [expr {(16807 * $r) % (0x7fffffff)}]
}
for {set i 0} {$i < 150} {incr i} {
set x {}
for {set j 0} {$j < $i} {incr j} {
- lappend x [expr [rand] & 0xfff]
+ lappend x [expr {[rand] & 0xfff}]
}
set y [lsort -integer $x]
set old -1
@@ -178,7 +188,7 @@ test cmdIL-3.17 {SortCompare procedure, -command option, non-integer result} {
} {1 {-compare command returned non-numeric result}}
test cmdIL-3.18 {SortCompare procedure, -command option} {
proc cmp {a b} {
- expr $b - $a
+ expr {$b - $a}
}
lsort -command cmp {48 6 18 22 21 35 36}
} {48 36 35 22 21 18 6}
@@ -255,7 +265,19 @@ test cmdIL-4.22 {DictionaryCompare procedure, case} {
test cmdIL-4.23 {DictionaryCompare procedure, case} {
lsort -dictionary {ABcd AbCd}
} {ABcd AbCd}
-test cmdIL-4.24 {DefaultCompare procedure, signed characters} {
+test cmdIL-4.24 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
+ ::tcltest::set_iso8859_1_locale
+ set result [lsort -dictionary "a b c A B C \xe3 \xc4"]
+ ::tcltest::restore_locale
+ set result
+} "A a B b C c \xe3 \xc4"
+test cmdIL-4.25 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
+ ::tcltest::set_iso8859_1_locale
+ set result [lsort -dictionary "a23\xe3 a23\xc5 a23\xe4"]
+ ::tcltest::restore_locale
+ set result
+} "a23\xe3 a23\xe4 a23\xc5"
+test cmdIL-4.26 {DefaultCompare procedure, signed characters} {
set l [lsort [list "abc\200" "abc"]]
set viewlist {}
foreach s $l {
@@ -274,7 +296,7 @@ test cmdIL-4.24 {DefaultCompare procedure, signed characters} {
}
set viewlist
} [list "abc" "abc\\200"]
-test cmdIL-4.25 {DictionaryCompare procedure, signed characters} {
+test cmdIL-4.27 {DictionaryCompare procedure, signed characters} {
set l [lsort -dictionary [list "abc\200" "abc"]]
set viewlist {}
foreach s $l {
@@ -293,3 +315,26 @@ test cmdIL-4.25 {DictionaryCompare procedure, signed characters} {
}
set viewlist
} [list "abc" "abc\\200"]
+test cmdIL-4.28 {DictionaryCompare procedure, chars between Z and a in ASCII} {
+ lsort -dictionary [list AA ` c CC]
+} [list ` AA c CC]
+test cmdIL-4.29 {DictionaryCompare procedure, chars between Z and a in ASCII} {
+ lsort -dictionary [list AA ` c ^ \\ CC \[ \]]
+} [list \[ \\ \] ^ ` AA c CC]
+test cmdIL-4.30 {DictionaryCompare procedure, chars between Z and a in ASCII} {
+ lsort -dictionary [list AA ` c ^ _ \\ CC \[ dude \] funky]
+} [list \[ \\ \] ^ _ ` AA c CC dude funky]
+test cmdIL-4.31 {DictionaryCompare procedure, chars between Z and a in ASCII} {
+ lsort -dictionary [list AA c ` CC]
+} [list ` AA c CC]
+test cmdIL-4.32 {DictionaryCompare procedure, chars between Z and a in ASCII} {
+ lsort -dictionary [list AA c CC `]
+} [list ` AA c CC]
+test cmdIL-4.33 {DictionaryCompare procedure, chars between Z and a in ASCII} {
+ lsort -dictionary [list AA ! c CC `]
+} [list ! ` AA c CC]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/cmdInfo.test b/tcl/tests/cmdInfo.test
index d49da1ef341..2f3e0a20b89 100644
--- a/tcl/tests/cmdInfo.test
+++ b/tcl/tests/cmdInfo.test
@@ -8,20 +8,25 @@
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testcmdinfo] == {}} {
puts "This application hasn't been compiled with the \"testcmdinfo\""
puts "command, so I can't test Tcl_GetCommandInfo etc."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
test cmdinfo-1.1 {command procedure and clientData} {
testcmdinfo create x1
testcmdinfo get x1
@@ -93,6 +98,21 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} {
eval lappend y [testcmdtoken name $x]
} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
+# cleanup
catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
catch {rename x1 ""}
-concat {}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/cmdMZ.test b/tcl/tests/cmdMZ.test
index 142ab29fd3d..f1926b833fa 100644
--- a/tcl/tests/cmdMZ.test
+++ b/tcl/tests/cmdMZ.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# SCCS: @(#) cmdMZ.test 1.20 98/01/08 18:23:43
+# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Tcl_PwdObjCmd
@@ -149,411 +153,14 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN wq"
-# Tcl_StringObjCmd
-
-test cmdMZ-5.1 {Tcl_StringObjCmd: error conditions} {
- list [catch {string} msg] $msg
-} {1 {wrong # args: should be "string option arg ?arg ...?"}}
-test cmdMZ-5.2 {Tcl_StringObjCmd: error conditions} {
- list [catch {string gorp a b} msg] $msg
-} {1 {bad option "gorp": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-
-test cmdMZ-6.1 {Tcl_StringObjCmd: string compare} {
- list [catch {string compare a} msg] $msg
-} {1 {wrong # args: should be "string compare string1 string2"}}
-test cmdMZ-6.2 {Tcl_StringObjCmd: string compare} {
- list [catch {string compare a b c} msg] $msg
-} {1 {wrong # args: should be "string compare string1 string2"}}
-test cmdMZ-6.3 {Tcl_StringObjCmd: string compare} {
- string compare abcde abdef
-} -1
-test cmdMZ-6.4 {Tcl_StringObjCmd: string compare} {
- string c abcde ABCDE
-} 1
-test cmdMZ-6.5 {Tcl_StringObjCmd: string compare} {
- string compare abcde abcde
-} 0
-test cmdMZ-6.6 {Tcl_StringObjCmd: string compare} {
- string compare ab abcde
-} -1
-test cmdMZ-6.7 {Tcl_StringObjCmd: string compare} {
- string compare abcde ab
-} 1
-test cmdMZ-6.8 {Tcl_StringObjCmd: string compare} {
- string compare cde ab
-} 1
-test cmdMZ-6.9 {Tcl_StringObjCmd: string compare} {
- string compare ab cde
-} -1
-test cmdMZ-6.10 {Tcl_StringObjCmd: string compare, unicode} {
- string compare ab\u7266 ab\u7267
-} -1
-test cmdMZ-6.11 {Tcl_StringObjCmd: string compare, high bit} {
- # This test will fail if the underlying comparaison
- # is using signed chars instead of unsigned chars.
- # (like SunOS's default memcmp thus the compat/memcmp.c)
- string compare "\x80" "@"
- # Nb this tests works also in utf8 space because \x80 is
- # translated into a 2 or more bytes but whose first byte has
- # the high bit set.
-} 1
-
-test cmdMZ-7.1 {Tcl_StringObjCmd: string first} {
- list [catch {string first a} msg] $msg
-} {1 {wrong # args: should be "string first string1 string2"}}
-test cmdMZ-7.2 {Tcl_StringObjCmd: string first} {
- list [catch {string first a b c} msg] $msg
-} {1 {wrong # args: should be "string first string1 string2"}}
-test cmdMZ-7.3 {Tcl_StringObjCmd: string first} {
- string first bq abcdefgbcefgbqrs
-} 12
-test cmdMZ-7.4 {Tcl_StringObjCmd: string first} {
- string fir bcd abcdefgbcefgbqrs
-} 1
-test cmdMZ-7.5 {Tcl_StringObjCmd: string first} {
- string f b abcdefgbcefgbqrs
-} 1
-test cmdMZ-7.6 {Tcl_StringObjCmd: string first} {
- string first xxx x123xx345xxx789xxx012
-} 9
-test cmdMZ-7.7 {Tcl_StringObjCmd: string first} {
- string first "" x123xx345xxx789xxx012
-} -1
-test cmdMZ-7.8 {Tcl_StringObjCmd: string first, unicode} {
- string first x abc\u7266x
-} 4
-test cmdMZ-7.9 {Tcl_StringObjCmd: string first, unicode} {
- string first \u7266 abc\u7266x
-} 3
-
-test cmdMZ-8.1 {Tcl_StringObjCmd: string index} {
- list [catch {string index} msg] $msg
-} {1 {wrong # args: should be "string index string charIndex"}}
-test cmdMZ-8.2 {Tcl_StringObjCmd: string index} {
- list [catch {string index a b c} msg] $msg
-} {1 {wrong # args: should be "string index string charIndex"}}
-test cmdMZ-8.3 {Tcl_StringObjCmd: string index} {
- list [catch {string index a xyz} msg] $msg
-} {1 {expected integer but got "xyz"}}
-test cmdMZ-8.4 {Tcl_StringObjCmd: string index} {
- string index abcde 0
-} a
-test cmdMZ-8.5 {Tcl_StringObjCmd: string index} {
- string i abcde 4
-} e
-test cmdMZ-8.6 {Tcl_StringObjCmd: string index} {
- string index abcde 5
-} {}
-test cmdMZ-8.7 {Tcl_StringObjCmd: string index} {
- list [catch {string index abcde -10} msg] $msg
-} {0 {}}
-test cmdMZ-8.8 {Tcl_StringObjCmd: string index, unicode} {
- string index abc\u7266d 4
-} d
-test cmdMZ-8.9 {Tcl_StringObjCmd: string index, unicode} {
- string index abc\u7266d 3
-} \u7266
-
-test cmdMZ-9.1 {Tcl_StringObjCmd: string last} {
- list [catch {string last a} msg] $msg
-} {1 {wrong # args: should be "string last string1 string2"}}
-test cmdMZ-9.2 {Tcl_StringObjCmd: string last} {
- list [catch {string last a b c} msg] $msg
-} {1 {wrong # args: should be "string last string1 string2"}}
-test cmdMZ-9.3 {Tcl_StringObjCmd: string last} {
- string la xxx xxxx123xx345x678
-} 1
-test cmdMZ-9.4 {Tcl_StringObjCmd: string last} {
- string last xx xxxx123xx345x678
-} 7
-test cmdMZ-9.5 {Tcl_StringObjCmd: string last} {
- string las x xxxx123xx345x678
-} 12
-test cmdMZ-9.6 {Tcl_StringObjCmd: string last, unicode} {
- string las x xxxx12\u7266xx345x678
-} 12
-test cmdMZ-9.7 {Tcl_StringObjCmd: string last, unicode} {
- string las \u7266 xxxx12\u7266xx345x678
-} 6
-
-test cmdMZ-10.1 {Tcl_StringObjCmd: string length} {
- list [catch {string length} msg] $msg
-} {1 {wrong # args: should be "string length string"}}
-test cmdMZ-10.2 {Tcl_StringObjCmd: string length} {
- list [catch {string length a b} msg] $msg
-} {1 {wrong # args: should be "string length string"}}
-test cmdMZ-10.3 {Tcl_StringObjCmd: string length} {
- string length "a little string"
-} 15
-test cmdMZ-10.4 {Tcl_StringObjCmd: string length} {
- string le ""
-} 0
-test cmdMZ-10.5 {Tcl_StringObjCmd: string length, unicode} {
- string le "abcd\u7266"
-} 5
-
-test cmdMZ-11.1 {Tcl_StringObjCmd: string match} {
- list [catch {string match a} msg] $msg
-} {1 {wrong # args: should be "string match pattern string"}}
-test cmdMZ-11.2 {Tcl_StringObjCmd: string match} {
- list [catch {string match a b c} msg] $msg
-} {1 {wrong # args: should be "string match pattern string"}}
-test cmdMZ-11.3 {Tcl_StringObjCmd: string match} {
- string match abc abc
-} 1
-test cmdMZ-11.4 {Tcl_StringObjCmd: string match} {
- string m abc abd
-} 0
-
-test cmdMZ-12.1 {Tcl_StringObjCmd: string range} {
- list [catch {string range} msg] $msg
-} {1 {wrong # args: should be "string range string first last"}}
-test cmdMZ-12.2 {Tcl_StringObjCmd: string range} {
- list [catch {string range a 1} msg] $msg
-} {1 {wrong # args: should be "string range string first last"}}
-test cmdMZ-12.3 {Tcl_StringObjCmd: string range} {
- list [catch {string range a 1 2 3} msg] $msg
-} {1 {wrong # args: should be "string range string first last"}}
-test cmdMZ-12.4 {Tcl_StringObjCmd: string range} {
- list [catch {string range abc abc 1} msg] $msg
-} {1 {bad index "abc": must be integer or "end"}}
-test cmdMZ-12.5 {Tcl_StringObjCmd: string range} {
- list [catch {string range abc 1 eof} msg] $msg
-} {1 {bad index "eof": must be integer or "end"}}
-test cmdMZ-12.6 {Tcl_StringObjCmd: string range, first < 0} {
- string range abcdefghijklmnop -3 2
-} {abc}
-test cmdMZ-12.7 {Tcl_StringObjCmd: string range} {
- string range abcdefghijklmnop 2 14
-} {cdefghijklmno}
-test cmdMZ-12.8 {Tcl_StringObjCmd: string range, last > length} {
- string range abcdefghijklmnop 7 1000
-} {hijklmnop}
-test cmdMZ-12.9 {Tcl_StringObjCmd: string range} {
- string range abcdefghijklmnop 10 e
-} {klmnop}
-test cmdMZ-12.10 {Tcl_StringObjCmd: string range, last < first} {
- string range abcdefghijklmnop 10 9
-} {}
-test cmdMZ-12.11 {Tcl_StringObjCmd: string range} {
- string range abcdefghijklmnop -3 -2
-} {}
-test cmdMZ-12.12 {Tcl_StringObjCmd: string range} {
- string range abcdefghijklmnop 1000 1010
-} {}
-test cmdMZ-12.13 {Tcl_StringObjCmd: string range} {
- string range abcdefghijklmnop -100 end
-} {abcdefghijklmnop}
-test cmdMZ-12.14 {Tcl_StringObjCmd: string range} {
- string range abcdefghijklmnop end end
-} {p}
-test cmdMZ-12.15 {Tcl_StringObjCmd: string range} {
- string range abcdefghijklmnop e 1000
-} {p}
-test cmdMZ-12.16 {Tcl_StringObjCmd: string range, unicode} {
- string range ab\u7266cdefghijklmnop 5 5
-} e
-test cmdMZ-12.17 {Tcl_StringObjCmd: string range, unicode} {
- string range ab\u7266cdefghijklmnop 2 3
-} \u7266c
-
-test cmdMZ-13.1 {Tcl_StringObjCmd: string tolower} {
- list [catch {string tolower} msg] $msg
-} {1 {wrong # args: should be "string tolower string"}}
-test cmdMZ-13.2 {Tcl_StringObjCmd: string tolower} {
- list [catch {string tolower a b} msg] $msg
-} {1 {wrong # args: should be "string tolower string"}}
-test cmdMZ-13.3 {Tcl_StringObjCmd: string tolower} {
- string tolower ABCDeF
-} {abcdef}
-test cmdMZ-13.4 {Tcl_StringObjCmd: string tolower} {
- string tolower "ABC XyZ"
-} {abc xyz}
-test cmdMZ-13.5 {Tcl_StringObjCmd: string tolower} {
- string tolower {123#$&*()}
-} {123#$&*()}
-test cmdMZ-13.6 {Tcl_StringObjCmd: string tolower, unicode} {hasIsoLocale} {
- set_iso8859_1_locale
- set result [string tolower ABCabc\xc7\xe7]
- restore_locale
- set result
-} "abcabc\xe7\xe7"
-
-test cmdMZ-14.1 {Tcl_StringObjCmd: string toupper} {
- list [catch {string toupper} msg] $msg
-} {1 {wrong # args: should be "string toupper string"}}
-test cmdMZ-14.2 {Tcl_StringObjCmd: string toupper} {
- list [catch {string toupper a b} msg] $msg
-} {1 {wrong # args: should be "string toupper string"}}
-test cmdMZ-14.3 {Tcl_StringObjCmd: string toupper} {
- string toupper abCDEf
-} {ABCDEF}
-test cmdMZ-14.4 {Tcl_StringObjCmd: string toupper} {
- string toupper "abc xYz"
-} {ABC XYZ}
-test cmdMZ-14.5 {Tcl_StringObjCmd: string toupper} {
- string toupper {123#$&*()}
-} {123#$&*()}
-test cmdMZ-14.6 {Tcl_StringObjCmd: string toupper, unicode} {hasIsoLocale} {
- set_iso8859_1_locale
- set result [string toupper ABCabc\xc7\xe7]
- restore_locale
- set result
-} "ABCABC\xc7\xc7"
-
-test cmdMZ-15.1 {Tcl_StringObjCmd: string trim} {
- list [catch {string trim} msg] $msg
-} {1 {wrong # args: should be "string trim string ?chars?"}}
-test cmdMZ-15.2 {Tcl_StringObjCmd: string trim} {
- list [catch {string trim a b c} msg] $msg
-} {1 {wrong # args: should be "string trim string ?chars?"}}
-test cmdMZ-15.3 {Tcl_StringObjCmd: string trim} {
- string trim " XYZ "
-} {XYZ}
-test cmdMZ-15.4 {Tcl_StringObjCmd: string trim} {
- string trim "\t\nXYZ\t\n\r\n"
-} {XYZ}
-test cmdMZ-15.5 {Tcl_StringObjCmd: string trim} {
- string trim " A XYZ A "
-} {A XYZ A}
-test cmdMZ-15.6 {Tcl_StringObjCmd: string trim} {
- string trim "XXYYZZABC XXYYZZ" ZYX
-} {ABC }
-test cmdMZ-15.7 {Tcl_StringObjCmd: string trim} {
- string trim " \t\r "
-} {}
-test cmdMZ-15.8 {Tcl_StringObjCmd: string trim} {
- string trim {abcdefg} {}
-} {abcdefg}
-test cmdMZ-15.9 {Tcl_StringObjCmd: string trim} {
- string trim {}
-} {}
-test cmdMZ-15.10 {Tcl_StringObjCmd: string trim} {
- string trim ABC DEF
-} {ABC}
-test cmdMZ-15.11 {Tcl_StringObjCmd: string trim, unicode} {
- string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
-} " AB\xe7C "
-
-test cmdMZ-16.1 {Tcl_StringObjCmd: string trimleft} {
- string trimleft " XYZ "
-} {XYZ }
-test cmdMZ-16.2 {Tcl_StringObjCmd: string trimleft} {
- list [catch {string trimleft} msg] $msg
-} {1 {wrong # args: should be "string trimleft string ?chars?"}}
-test cmdMZ-16.3 {Tcl_StringObjCmd: string trimleft} {
- string length [string trimleft " "]
-} {0}
-
-test cmdMZ-17.1 {Tcl_StringObjCmd: string trimright} {
- string trimright " XYZ "
-} { XYZ}
-test cmdMZ-17.2 {Tcl_StringObjCmd: string trimright} {
- string trimright " "
-} {}
-test cmdMZ-17.3 {Tcl_StringObjCmd: string trimright} {
- string trimright ""
-} {}
-test cmdMZ-17.4 {Tcl_StringObjCmd: string trimright errors} {
- list [catch {string trimright} msg] $msg
-} {1 {wrong # args: should be "string trimright string ?chars?"}}
-test cmdMZ-17.5 {Tcl_StringObjCmd: string trimright errors} {
- list [catch {string trimg a} msg] $msg
-} {1 {bad option "trimg": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-
-test cmdMZ-18.1 {Tcl_StringObjCmd: string wordend} {
- list [catch {string wordend a} msg] $msg
-} {1 {wrong # args: should be "string wordend string index"}}
-test cmdMZ-18.2 {Tcl_StringObjCmd: string wordend} {
- list [catch {string wordend a b c} msg] $msg
-} {1 {wrong # args: should be "string wordend string index"}}
-test cmdMZ-18.3 {Tcl_StringObjCmd: string wordend} {
- list [catch {string wordend a gorp} msg] $msg
-} {1 {expected integer but got "gorp"}}
-test cmdMZ-18.4 {Tcl_StringObjCmd: string wordend} {
- string wordend abc. -1
-} 3
-test cmdMZ-18.5 {Tcl_StringObjCmd: string wordend} {
- string wordend abc. 100
-} 4
-test cmdMZ-18.6 {Tcl_StringObjCmd: string wordend} {
- string wordend "word_one two three" 2
-} 8
-test cmdMZ-18.7 {Tcl_StringObjCmd: string wordend} {
- string wordend "one .&# three" 5
-} 6
-test cmdMZ-18.8 {Tcl_StringObjCmd: string wordend} {
- string worde "x.y" 0
-} 1
-test cmdMZ-18.9 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} {
- set_iso8859_1_locale
- set result [string wordend "xyz\u00c7de fg" 0]
- restore_locale
- set result
-} 6
-test cmdMZ-18.10 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} {
- set_iso8859_1_locale
- set result [string wordend "xyz\uc700de fg" 0]
- restore_locale
- set result
-} 3
-test cmdMZ-18.11 {Tcl_StringObjCmd: string wordend, unicode} {hasIsoLocale} {
- set_iso8859_1_locale
- set result [string wordend "xyz\uc700de fg" 0]
- restore_locale
- set result
-} 3
-test cmdMZ-18.12 {Tcl_StringObjCmd: string wordend, unicode} {
- string wordend "\uc700\uc700 abc" 8
-} 6
-
-test cmdMZ-19.1 {Tcl_StringObjCmd: string wordstart} {
- list [catch {string word a} msg] $msg
-} {1 {ambiguous option "word": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test cmdMZ-19.2 {Tcl_StringObjCmd: string wordstart} {
- list [catch {string wordstart a} msg] $msg
-} {1 {wrong # args: should be "string wordstart string index"}}
-test cmdMZ-19.3 {Tcl_StringObjCmd: string wordstart} {
- list [catch {string wordstart a b c} msg] $msg
-} {1 {wrong # args: should be "string wordstart string index"}}
-test cmdMZ-19.4 {Tcl_StringObjCmd: string wordstart} {
- list [catch {string wordstart a gorp} msg] $msg
-} {1 {expected integer but got "gorp"}}
-test cmdMZ-19.5 {Tcl_StringObjCmd: string wordstart} {
- string wordstart "one two three_words" 400
-} 8
-test cmdMZ-19.6 {Tcl_StringObjCmd: string wordstart} {
- string wordstart "one two three_words" 2
-} 0
-test cmdMZ-19.7 {Tcl_StringObjCmd: string wordstart} {
- string wordstart "one two three_words" -2
-} 0
-test cmdMZ-19.8 {Tcl_StringObjCmd: string wordstart} {
- string wordstart "one .*&^ three" 6
-} 6
-test cmdMZ-19.9 {Tcl_StringObjCmd: string wordstart} {
- string wordstart "one two three" 4
-} 4
-test cmdMZ-19.10 {Tcl_StringObjCmd: string wordstart, unicode} {hasIsoLocale} {
- set_iso8859_1_locale
- set result [string wordstart "one tw\u00c7o three" 7]
- restore_locale
- set result
-} 4
-test cmdMZ-19.11 {Tcl_StringObjCmd: string wordstart, unicode} {hasIsoLocale} {
- set_iso8859_1_locale
- set result [string wordstart "ab\uc700\uc700 cdef ghi" 12]
- restore_locale
- set result
-} 10
-test cmdMZ-19.12 {Tcl_StringObjCmd: string wordstart, unicode} {
- string wordstart "\uc700\uc700 abc" 8
-} 3
-
+# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test
# There are no tests for Tcl_TimeObjCmd
# The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test
# The tests for Tcl_WhileObjCmd are in while.test
+# cleanup
+::tcltest::cleanupTests
return
+
diff --git a/tcl/tests/compExpr-old.test b/tcl/tests/compExpr-old.test
new file mode 100644
index 00000000000..0766f0409b5
--- /dev/null
+++ b/tcl/tests/compExpr-old.test
@@ -0,0 +1,691 @@
+# Commands covered: expr
+#
+# This file contains the original set of tests for the compilation (and
+# indirectly execution) of Tcl's expr command. A new set of tests covering
+# the new implementation are in the files "parseExpr.test and
+# "compExpr.test". Sourcing this file into Tcl runs the tests and generates
+# output for errors. No output means no errors were found.
+#
+# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+ set gotT1 0
+ puts "This application hasn't been compiled with the \"T1\" and"
+ puts "\"T2\" math functions, so I'll skip some of the expr tests."
+} else {
+ set gotT1 1
+}
+
+# procedures used below
+
+proc put_hello_char {c} {
+ global a
+ append a [format %c $c]
+ return $c
+}
+proc hello_world {} {
+ global a
+ set a ""
+ set L1 [set l0 [set h_1 [set q 0]]]
+ for {put_hello_char [expr [put_hello_char [expr [set h 7]*10+2]]+29]} {$l0?[put_hello_char $l0]
+ :!$h_1} {put_hello_char $ll;expr {$L1==2?[set ll [expr 32+0-0+[set bar 0]]]:0}} {expr {[incr L1]==[expr 1+([string length "abc"]-[string length "abc"])]
+ ?[set ll [set l0 [expr 54<<1]]]:$ll==108&&$L1<3?
+ [incr ll [expr 1|1<<1]; set ll $ll; set ll $ll; set ll $ll; set ll $ll; set l0 [expr ([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])]; set l0; set l0 $l0; set l0; set l0]:$L1==4&&$ll==32?[set ll [expr 19+$h1+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])+[set foo [expr ([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])+([string length "abc"]-[string length "abc"])]]]]
+ :[set q [expr $q-$h1+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])]]};expr {$L1==5?[incr ll -8; set ll $ll; set ll]:$q&&$h1&&1};expr {$L1==4+2
+ ?[incr ll 3]:[expr ([string length "abc"]-[string length "abc"])+1]};expr {$ll==($h<<4)+2+0&&$L1!=6?[incr ll -6]:[set h1 [expr 100+([string length "abc"]-[string length "abc"])-([string length "abc"]-[string length "abc"])]]}
+ expr {$L1!=1<<3?[incr q [expr ([string length "abc"]-[string length "abc"])-1]]:[set h_1 [set ll $h1]]}
+ }
+ set a
+}
+
+proc 12days {a b c} {
+ global xxx
+ expr {1<$a?[expr {$a<3?[12days -79 -13 [string range $c [12days -87 \
+ [expr 1-$b] [string range $c [12days -86 0 [string range $c 1 end]] \
+ end]] end]]:1};expr {$a<$b?[12days [expr $a+1] $b $c]:3};expr {[12days \
+ -94 [expr $a-27] $c]&&$a==2?$b<13?[12days 2 [expr $b+1] "%s %d %d\n"]:9
+ :16}]:$a<0?$a<-72?[12days $b $a "@n'+,#'/*\{\}w+/w#cdnr/+,\{\}r/*de\}+,/*\{*+,/w\{%+,/w#q#n+,/#\{l+,/n\{n+,/+#n+,/#;#q#n+,/+k#;*+,/'r :'d*'3,\}\{w+K w'K:'+\}e#';dq#'l q#'+d'K#!/+k#;q#'r\}eKK#\}w'r\}eKK\{nl\]'/#;#q#n')\{)#\}w')\{)\{nl\]'/+#n';d\}rw' i;# )\{nl\]!/n\{n#'; r\{#w'r nc\{nl\]'/#\{l,+'K \{rw' iK\{;\[\{nl\]'/w#q#n'wk nw' iwk\{KK\{nl\]!/w\{%'l##w#' i; :\{nl\]'/*\{q#'ld;r'\}\{nlwb!/*de\}'c ;;\{nl'-\{\}rw\]'/+,\}##'*\}#nc,',#nw\]'/+kd'+e\}+;#'rdq#w! nr'/ ') \}+\}\{rl#'\{n' ')# \}'+\}##(!!/"]
+ :$a<-50?[string compare [format %c $b] [string index $c 0]]==0?[append \
+ xxx [string index $c 31];scan [string index $c 31] %c x;set x]
+ :[12days -65 $b [string range $c 1 end]]:[12days [expr ([string compare \
+ [string index $c 0] "/"]==0)+$a] $b [string range $c 1 end]]:0<$a
+ ?[12days 2 2 "%s"]:[string compare [string index $c 0] "/"]==0||
+ [12days 0 [12days -61 [scan [string index $c 0] %c x; set x] \
+ "!ek;dc i@bK'(q)-\[w\]*%n+r3#l,\{\}:\nuwloca-O;m .vpbks,fxntdCeghiry"] \
+ [string range $c 1 end]]}
+}
+proc do_twelve_days {} {
+ global xxx
+ set xxx ""
+ 12days 1 1 1
+ string length $xxx
+}
+
+# start of tests
+
+catch {unset a b i x}
+
+test expr-1.1 {TclCompileExprCmd: no expression} {
+ list [catch {expr } msg] $msg
+} {1 {wrong # args: should be "expr arg ?arg ...?"}}
+test expr-1.2 {TclCompileExprCmd: one expression word} {
+ expr -25
+} -25
+test expr-1.3 {TclCompileExprCmd: two expression words} {
+ expr -8.2 -6
+} -14.2
+test expr-1.4 {TclCompileExprCmd: five expression words} {
+ expr 20 - 5 +10 -7
+} 18
+test expr-1.5 {TclCompileExprCmd: quoted expression word} {
+ expr "0005"
+} 5
+test expr-1.6 {TclCompileExprCmd: quoted expression word} {
+ catch {expr "0005"zxy} msg
+ set msg
+} {extra characters after close-quote}
+test expr-1.7 {TclCompileExprCmd: expression word in braces} {
+ expr {-0005}
+} -5
+test expr-1.8 {TclCompileExprCmd: expression word in braces} {
+ expr {{-0x1234}}
+} -4660
+test expr-1.9 {TclCompileExprCmd: expression word in braces} {
+ catch {expr {-0005}foo} msg
+ set msg
+} {extra characters after close-brace}
+test expr-1.10 {TclCompileExprCmd: other expression word in braces} {
+ expr 4*[llength "6 2"]
+} 8
+test expr-1.11 {TclCompileExprCmd: expression word terminated by ;} {
+ expr 4*[llength "6 2"];
+} 8
+test expr-1.12 {TclCompileExprCmd: inlined expr (in "catch") inside other catch} {
+ set a xxx
+ catch {
+ # Might not be a number
+ set a [expr 10*$a]
+ }
+} 1
+test expr-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} {
+ set a xxx
+ set x 27; set bool {$x}; if $bool {set a foo}
+ set a
+} foo
+test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
+ set a xxx
+ set x 2; set b {$x}; set a [expr $b == 2]
+ set a
+} 1
+
+test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
+ expr double(5*[llength "6 2"])
+} 10.0
+test expr-2.2 {TclCompileExpr: error in expr} {
+ catch {expr 2**3} msg
+ set msg
+} {syntax error in expression "2**3"}
+test expr-2.3 {TclCompileExpr: junk after legal expr} {
+ catch {expr 7*[llength "a b"]foo} msg
+ set msg
+} {syntax error in expression "7*2foo"}
+test expr-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} {
+ expr {0001}
+} 1
+
+test expr-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1
+test expr-3.2 {CompileCondExpr: error in lor expr} {
+ catch {expr x||3} msg
+ set msg
+} {syntax error in expression "x||3"}
+test expr-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44
+test expr-3.4 {CompileCondExpr: error compiling true arm} {
+ catch {expr 3>2?2**3:66} msg
+ set msg
+} {syntax error in expression "3>2?2**3:66"}
+test expr-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66
+test expr-3.6 {CompileCondExpr: error compiling false arm} {
+ catch {expr 2>3?44:2**3} msg
+ set msg
+} {syntax error in expression "2>3?44:2**3"}
+test expr-3.7 {CompileCondExpr: long arms & nested cond exprs} {nonPortable} {
+ puts "Note: doing test expr-3.7 which can take several minutes to run"
+ hello_world
+} {Hello world}
+catch {unset xxx}
+test expr-3.8 {CompileCondExpr: long arms & nested cond exprs} {nonPortable} {
+ puts "Note: doing test expr-3.8 which can take several minutes to run"
+ do_twelve_days
+} 2358
+catch {unset xxx}
+
+test expr-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1
+test expr-4.2 {CompileLorExpr: error in land expr} {
+ catch {expr x&&3} msg
+ set msg
+} {syntax error in expression "x&&3"}
+test expr-4.3 {CompileLorExpr: simple lor exprs} {expr 0||1.0} 1
+test expr-4.4 {CompileLorExpr: simple lor exprs} {expr 3.0||0.0} 1
+test expr-4.5 {CompileLorExpr: simple lor exprs} {expr 0||0||1} 1
+test expr-4.6 {CompileLorExpr: error compiling lor arm} {
+ catch {expr 2**3||4.0} msg
+ set msg
+} {syntax error in expression "2**3||4.0"}
+test expr-4.7 {CompileLorExpr: error compiling lor arm} {
+ catch {expr 1.3||2**3} msg
+ set msg
+} {syntax error in expression "1.3||2**3"}
+test expr-4.8 {CompileLorExpr: error compiling lor arms} {
+ list [catch {expr {"a"||"b"}} msg] $msg
+} {1 {expected boolean value but got "a"}}
+test expr-4.9 {CompileLorExpr: long lor arm} {
+ set a "abcdefghijkl"
+ set i 7
+ expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
+} 1
+
+test expr-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
+test expr-5.2 {CompileLandExpr: error in bitor expr} {
+ catch {expr x|3} msg
+ set msg
+} {syntax error in expression "x|3"}
+test expr-5.3 {CompileLandExpr: simple land exprs} {expr 0&&1.0} 0
+test expr-5.4 {CompileLandExpr: simple land exprs} {expr 0&&0} 0
+test expr-5.5 {CompileLandExpr: simple land exprs} {expr 3.0&&1.2} 1
+test expr-5.6 {CompileLandExpr: simple land exprs} {expr 1&&1&&2} 1
+test expr-5.7 {CompileLandExpr: error compiling land arm} {
+ catch {expr 2**3&&4.0} msg
+ set msg
+} {syntax error in expression "2**3&&4.0"}
+test expr-5.8 {CompileLandExpr: error compiling land arm} {
+ catch {expr 1.3&&2**3} msg
+ set msg
+} {syntax error in expression "1.3&&2**3"}
+test expr-5.9 {CompileLandExpr: error compiling land arm} {
+ list [catch {expr {"a"&&"b"}} msg] $msg
+} {1 {expected boolean value but got "a"}}
+test expr-5.10 {CompileLandExpr: long land arms} {
+ set a "abcdefghijkl"
+ set i 7
+ expr {[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]}
+} 1
+
+test expr-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
+test expr-6.2 {CompileBitXorExpr: error in bitand expr} {
+ catch {expr x|3} msg
+ set msg
+} {syntax error in expression "x|3"}
+test expr-6.3 {CompileBitXorExpr: simple bitxor exprs} {expr 7^0x13} 20
+test expr-6.4 {CompileBitXorExpr: simple bitxor exprs} {expr 3^0x10} 19
+test expr-6.5 {CompileBitXorExpr: simple bitxor exprs} {expr 0^7} 7
+test expr-6.6 {CompileBitXorExpr: simple bitxor exprs} {expr -1^7} -8
+test expr-6.7 {CompileBitXorExpr: error compiling bitxor arm} {
+ catch {expr 2**3|6} msg
+ set msg
+} {syntax error in expression "2**3|6"}
+test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} {
+ catch {expr 2^x} msg
+ set msg
+} {syntax error in expression "2^x"}
+test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
+ list [catch {expr {24.0^3}} msg] $msg
+} {1 {can't use floating-point value as operand of "^"}}
+test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
+ list [catch {expr {"a"^"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "^"}}
+
+test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
+test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
+test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
+test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
+test expr-7.5 {CompileBitAndExpr: error in equality expr} {
+ catch {expr x==3} msg
+ set msg
+} {syntax error in expression "x==3"}
+test expr-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
+test expr-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
+test expr-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
+test expr-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
+test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} {
+ catch {expr 2**3&6} msg
+ set msg
+} {syntax error in expression "2**3&6"}
+test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} {
+ catch {expr 2&x} msg
+ set msg
+} {syntax error in expression "2&x"}
+test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
+ list [catch {expr {24.0&3}} msg] $msg
+} {1 {can't use floating-point value as operand of "&"}}
+test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
+ list [catch {expr {"a"&"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "&"}}
+
+test expr-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
+test expr-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
+test expr-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
+test expr-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
+test expr-8.5 {CompileEqualityExpr: error in relational expr} {
+ catch {expr x>3} msg
+ set msg
+} {syntax error in expression "x>3"}
+test expr-8.6 {CompileEqualityExpr: simple equality exprs} {expr 7==0x13} 0
+test expr-8.7 {CompileEqualityExpr: simple equality exprs} {expr -0xf2!=0x53} 1
+test expr-8.8 {CompileEqualityExpr: simple equality exprs} {expr {"12398712938788234-1298379" != ""}} 1
+test expr-8.9 {CompileEqualityExpr: simple equality exprs} {expr -1!="abc"} 1
+test expr-8.10 {CompileEqualityExpr: error compiling equality arm} {
+ catch {expr 2**3==6} msg
+ set msg
+} {syntax error in expression "2**3==6"}
+test expr-8.11 {CompileEqualityExpr: error compiling equality arm} {
+ catch {expr 2!=x} msg
+ set msg
+} {syntax error in expression "2!=x"}
+
+
+test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
+test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
+test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
+test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
+
+# The following test is different for 32-bit versus 64-bit
+# architectures because LONG_MIN is different
+
+if {0x80000000 > 0} {
+ test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+ expr {1<<63}
+ } -9223372036854775808
+} else {
+ test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+ expr {1<<31}
+ } -2147483648
+}
+test expr-9.6 {CompileRelationalExpr: error in shift expr} {
+ catch {expr x>>3} msg
+ set msg
+} {syntax error in expression "x>>3"}
+test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
+test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
+test expr-9.9 {CompileRelationalExpr: error compiling relational arm} {
+ catch {expr 2**3>6} msg
+ set msg
+} {syntax error in expression "2**3>6"}
+test expr-9.10 {CompileRelationalExpr: error compiling relational arm} {
+ catch {expr 2<x} msg
+ set msg
+} {syntax error in expression "2<x"}
+
+test expr-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
+test expr-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
+test expr-10.3 {CompileShiftExpr: just add expr} {expr -1--2} 1
+test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
+test expr-10.5 {CompileShiftExpr: error in add expr} {
+ catch {expr x+3} msg
+ set msg
+} {syntax error in expression "x+3"}
+test expr-10.6 {CompileShiftExpr: simple shift exprs} {expr 0xff>>0x3} 31
+test expr-10.7 {CompileShiftExpr: simple shift exprs} {expr -0xf2<<0x3} -1936
+test expr-10.8 {CompileShiftExpr: error compiling shift arm} {
+ catch {expr 2**3>>6} msg
+ set msg
+} {syntax error in expression "2**3>>6"}
+test expr-10.9 {CompileShiftExpr: error compiling shift arm} {
+ catch {expr 2<<x} msg
+ set msg
+} {syntax error in expression "2<<x"}
+test expr-10.10 {CompileShiftExpr: runtime error} {
+ list [catch {expr {24.0>>43}} msg] $msg
+} {1 {can't use floating-point value as operand of ">>"}}
+test expr-10.11 {CompileShiftExpr: runtime error} {
+ list [catch {expr {"a"<<"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "<<"}}
+
+test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
+test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
+test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
+test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
+test expr-11.5 {CompileAddExpr: error in multiply expr} {
+ catch {expr x*3} msg
+ set msg
+} {syntax error in expression "x*3"}
+test expr-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
+test expr-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
+test expr-11.8 {CompileAddExpr: error compiling add arm} {
+ catch {expr 2**3+6} msg
+ set msg
+} {syntax error in expression "2**3+6"}
+test expr-11.9 {CompileAddExpr: error compiling add arm} {
+ catch {expr 2-x} msg
+ set msg
+} {syntax error in expression "2-x"}
+test expr-11.10 {CompileAddExpr: runtime error} {
+ list [catch {expr {24.0+"xx"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-11.11 {CompileAddExpr: runtime error} {
+ list [catch {expr {"a"-"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "-"}}
+test expr-11.12 {CompileAddExpr: runtime error} {
+ list [catch {expr {3/0}} msg] $msg
+} {1 {divide by zero}}
+test expr-11.13 {CompileAddExpr: runtime error} {
+ list [catch {expr {2.3/0.0}} msg] $msg
+} {1 {divide by zero}}
+
+test expr-12.1 {CompileMultiplyExpr: just unary expr} {expr ~4} -5
+test expr-12.2 {CompileMultiplyExpr: just unary expr} {expr --5} 5
+test expr-12.3 {CompileMultiplyExpr: just unary expr} {expr !27} 0
+test expr-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936
+test expr-12.5 {CompileMultiplyExpr: error in unary expr} {
+ catch {expr ~x} msg
+ set msg
+} {syntax error in expression "~x"}
+test expr-12.6 {CompileMultiplyExpr: simple multiply exprs} {expr 0xff*0x3} 765
+test expr-12.7 {CompileMultiplyExpr: simple multiply exprs} {expr -0xf2%-0x3} -2
+test expr-12.8 {CompileMultiplyExpr: error compiling multiply arm} {
+ catch {expr 2*3%%6} msg
+ set msg
+} {syntax error in expression "2*3%%6"}
+test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} {
+ catch {expr 2*x} msg
+ set msg
+} {syntax error in expression "2*x"}
+test expr-12.10 {CompileMultiplyExpr: runtime error} {
+ list [catch {expr {24.0*"xx"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "*"}}
+test expr-12.11 {CompileMultiplyExpr: runtime error} {
+ list [catch {expr {"a"/"b"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "/"}}
+
+test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
+test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 83
+test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
+test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
+test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
+test expr-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
+test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
+test expr-13.8 {CompileUnaryExpr: error compiling unary expr} {
+ catch {expr ~x} msg
+ set msg
+} {syntax error in expression "~x"}
+test expr-13.9 {CompileUnaryExpr: error compiling unary expr} {
+ catch {expr !1.x} msg
+ set msg
+} {syntax error in expression "!1.x"}
+test expr-13.10 {CompileUnaryExpr: runtime error} {
+ list [catch {expr {~"xx"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "~"}}
+test expr-13.11 {CompileUnaryExpr: runtime error} {
+ list [catch {expr ~4.0} msg] $msg
+} {1 {can't use floating-point value as operand of "~"}}
+test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
+test expr-13.13 {CompileUnaryExpr: just primary expr} {
+ set a 27
+ expr $a
+} 27
+test expr-13.14 {CompileUnaryExpr: just primary expr} {
+ expr double(27)
+} 27.0
+test expr-13.15 {CompileUnaryExpr: just primary expr} {expr "123"} 123
+test expr-13.16 {CompileUnaryExpr: error in primary expr} {
+ catch {expr [set]} msg
+ set msg
+} {wrong # args: should be "set varName ?newValue?"}
+test expr-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1
+test expr-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123
+test expr-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255
+test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 8
+test expr-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
+test expr-14.6 {CompilePrimaryExpr: literal primary} {
+ expr 3.1400000
+} 3.14
+test expr-14.7 {CompilePrimaryExpr: literal primary} {expr {{abcde}<{abcdef}}} 1
+test expr-14.8 {CompilePrimaryExpr: literal primary} {expr {{abc\
+def} < {abcdef}}} 1
+test expr-14.9 {CompilePrimaryExpr: literal primary} {expr {{abc\tde} > {abc\tdef}}} 0
+test expr-14.10 {CompilePrimaryExpr: literal primary} {expr {{123}}} 123
+test expr-14.11 {CompilePrimaryExpr: var reference primary} {
+ set i 789
+ list [expr {$i}] [expr $i]
+} {789 789}
+test expr-14.12 {CompilePrimaryExpr: var reference primary} {
+ set i {789} ;# test expr's aggressive conversion to numeric semantics
+ list [expr {$i}] [expr $i]
+} {789 789}
+test expr-14.13 {CompilePrimaryExpr: var reference primary} {
+ catch {unset a}
+ set a(foo) foo
+ set a(bar) bar
+ set a(123) 123
+ set result ""
+ lappend result [expr $a(123)] [expr {$a(bar)<$a(foo)}]
+ catch {unset a}
+ set result
+} {123 1}
+test expr-14.14 {CompilePrimaryExpr: var reference primary} {
+ set i 123 ;# test "$var.0" floating point conversion hack
+ list [expr $i] [expr $i.0] [expr $i.0/12.0]
+} {123 123.0 10.25}
+test expr-14.15 {CompilePrimaryExpr: var reference primary} {
+ set i 123
+ catch {expr $i.2} msg
+ set msg
+} 123.2
+test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} {
+ catch {expr {$a(foo}} msg
+ set errorInfo
+} {missing )
+ while compiling
+"expr {$a(foo}"}
+test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
+ expr $
+} $
+test expr-14.18 {CompilePrimaryExpr: quoted string primary} {
+ expr "21"
+} 21
+test expr-14.19 {CompilePrimaryExpr: quoted string primary} {
+ set i 123
+ set x 456
+ expr "$i+$x"
+} 579
+test expr-14.20 {CompilePrimaryExpr: quoted string primary} {
+ set i 3
+ set x 6
+ expr 2+"$i.$x"
+} 5.6
+test expr-14.21 {CompilePrimaryExpr: error in quoted string primary} {
+ catch {expr "[set]"} msg
+ set msg
+} {wrong # args: should be "set varName ?newValue?"}
+test expr-14.22 {CompilePrimaryExpr: subcommand primary} {
+ expr {[set i 123; set i]}
+} 123
+test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} {
+ catch {expr {[set]}} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ while compiling
+"expr {[set]}"}
+test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} {
+ catch {expr {[set i}} msg
+ set errorInfo
+} {missing close-bracket
+ while compiling
+"expr {[set i}"}
+test expr-14.25 {CompilePrimaryExpr: math function primary} {
+ format %.6g [expr exp(1.0)]
+} 2.71828
+test expr-14.26 {CompilePrimaryExpr: math function primary} {
+ format %.6g [expr pow(2.0+0.1,3.0+0.1)]
+} 9.97424
+test expr-14.27 {CompilePrimaryExpr: error in math function primary} {
+ catch {expr sinh::(2.0)} msg
+ set errorInfo
+} {syntax error in expression "sinh::(2.0)"
+ while compiling
+"expr sinh::(2.0)"}
+test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
+ expr 2+(3*4)
+} 14
+test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} {
+ catch {expr 2+(3*[set])} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ while compiling
+"expr 2+(3*[set])"}
+test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
+ catch {expr 2+(3*(4+5)} msg
+ set errorInfo
+} {syntax error in expression "2+(3*(4+5)"
+ while compiling
+"expr 2+(3*(4+5)"}
+test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
+ set i "5+10"
+ list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
+} {{15 == 15} {15 == 15} {15 == 15}}
+test expr-14.32 {CompilePrimaryExpr: unexpected token} {
+ catch {expr @} msg
+ set errorInfo
+} {syntax error in expression "@"
+ while compiling
+"expr @"}
+
+test expr-15.1 {CompileMathFuncCall: missing parenthesis} {
+ catch {expr sinh2.0)} msg
+ set errorInfo
+} {syntax error in expression "sinh2.0)"
+ while compiling
+"expr sinh2.0)"}
+test expr-15.2 {CompileMathFuncCall: unknown math function} {
+ catch {expr whazzathuh(1)} msg
+ set errorInfo
+} {unknown math function "whazzathuh"
+ while compiling
+"expr whazzathuh(1)"}
+test expr-15.3 {CompileMathFuncCall: too many arguments} {
+ catch {expr sin(1,2,3)} msg
+ set errorInfo
+} {too many arguments for math function
+ while compiling
+"expr sin(1,2,3)"}
+test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} {
+ catch {expr sin()} msg
+ set errorInfo
+} {too few arguments for math function
+ while compiling
+"expr sin()"}
+test expr-15.5 {CompileMathFuncCall: too few arguments} {
+ catch {expr pow(1)} msg
+ set errorInfo
+} {too few arguments for math function
+ while compiling
+"expr pow(1)"}
+test expr-15.6 {CompileMathFuncCall: missing ')'} {
+ catch {expr sin(1} msg
+ set errorInfo
+} {syntax error in expression "sin(1"
+ while compiling
+"expr sin(1"}
+if $gotT1 {
+ test expr-15.7 {CompileMathFuncCall: call registered math function} {
+ expr 2*T1()
+ } 246
+ test expr-15.8 {CompileMathFuncCall: call registered math function} {
+ expr T2()*3
+ } 1035
+
+ test expr-15.9 {CompileMathFuncCall: call registered math function} {
+ expr T3(21, 37)
+ } 37
+ test expr-15.10 {CompileMathFuncCall: call registered math function} {
+ expr T3(21.2, 37)
+ } 37.0
+ test expr-15.11 {CompileMathFuncCall: call registered math function} {
+ expr T3(-21.2, -17.5)
+ } -17.5
+}
+
+test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
+ catch {unset a}
+ set a(VALUE) ff15
+ set i 123
+ if {[expr 0x$a(VALUE)] & 16} {
+ set i {}
+ }
+ set i
+} {}
+test expr-16.2 {GetToken: check for string literal in braces} {
+ expr {{1}}
+} {1}
+
+# Check "expr" and computed command names.
+
+test expr-17.1 {expr and computed command names} {
+ set i 0
+ set z expr
+ $z 1+2
+} 3
+
+# Check correct conversion of operands to numbers: If the string looks like
+# an integer, convert to integer. Otherwise, if the string looks like a
+# double, convert to double.
+
+test expr-18.1 {expr and conversion of operands to numbers} {
+ set x [lindex 11 0]
+ catch {expr int($x)}
+ expr {$x}
+} 11
+
+# Check "expr" and interpreter result object resetting before appending
+# an error msg during evaluation of exprs not in {}s
+
+test expr-19.1 {expr and interpreter result object resetting} {
+ proc p {} {
+ set t 10.0
+ set x 2.0
+ set dx 0.2
+ set f {$dx-$x/10}
+ set g {-$x/5}
+ set center 1.0
+ set x [expr $x-$center]
+ set dx [expr $dx+$g]
+ set x [expr $x+$f+$center]
+ set x [expr $x+$f+$center]
+ set y [expr round($x)]
+ }
+ p
+} 3
+
+# cleanup
+if {[info exists a]} {
+ unset a
+}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/compExpr.test b/tcl/tests/compExpr.test
new file mode 100644
index 00000000000..679c56f9743
--- /dev/null
+++ b/tcl/tests/compExpr.test
@@ -0,0 +1,342 @@
+# This file contains a collection of tests for the procedures in the
+# file tclCompExpr.c. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+ set gotT1 0
+ puts "This application hasn't been compiled with the \"T1\" and"
+ puts "\"T2\" math functions, so I'll skip some of the expr tests."
+} else {
+ set gotT1 1
+}
+
+catch {unset a}
+
+test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
+ expr 1+2
+} 3
+test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} {
+ list [catch {expr 1+2+} msg] $msg
+} {1 {syntax error in expression "1+2+"}}
+test compExpr-1.3 {TclCompileExpr procedure, error compiling expr} {
+ list [catch {expr "foo(123)"} msg] $msg
+} {1 {unknown math function "foo"}}
+test compExpr-1.4 {TclCompileExpr procedure, expr has no operators} {
+ set a {000123}
+ expr {$a}
+} 83
+
+test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} {
+ catch {unset a}
+ set a 27
+ expr {"foo$a" < "bar"}
+} 0
+test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} {
+ list [catch {expr {"00[expr 1+]" + 17}} msg] $msg
+} {1 {syntax error in expression "1+"}}
+test compExpr-2.3 {CompileSubExpr procedure, TCL_TOKEN_TEXT parse token} {
+ expr {{12345}}
+} 12345
+test compExpr-2.4 {CompileSubExpr procedure, empty TCL_TOKEN_TEXT parse token} {
+ expr {{}}
+} {}
+test compExpr-2.5 {CompileSubExpr procedure, TCL_TOKEN_BS parse token} {
+ expr "\{ \\
+ +123 \}"
+} 123
+test compExpr-2.6 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} {
+ expr {[info tclversion] != ""}
+} 1
+test compExpr-2.7 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} {
+ expr {[]}
+} {}
+test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} {
+ list [catch {expr {[foo "bar"xxx] + 17}} msg] $msg
+} {1 {extra characters after close-quote}}
+test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
+ catch {unset a}
+ set a 123
+ expr {$a*2}
+} 246
+test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
+ catch {unset a}
+ catch {unset b}
+ set a(george) martha
+ set b geo
+ expr {$a(${b}rge)}
+} martha
+test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} {
+ catch {unset a}
+ list [catch {expr {$a + 17}} msg] $msg
+} {1 {can't read "a": no such variable}}
+test compExpr-2.12 {CompileSubExpr procedure, TCL_TOKEN_SUB_EXPR parse token} {
+ expr {27||3? 3<<(1+4) : 4&&9}
+} 96
+test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
+ catch {unset a}
+ set a 15
+ list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
+} {1 {syntax error in expression "1+"}}
+test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} {
+ expr {5*6}
+} 30
+test compExpr-2.15 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, math function found} {
+ format %.6g [expr {sin(2.0)}]
+} 0.909297
+test compExpr-2.16 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, math function not found} {
+ list [catch {expr {fred(2.0)}} msg] $msg
+} {1 {unknown math function "fred"}}
+test compExpr-2.17 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4*2}
+} 8
+test compExpr-2.18 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4/2}
+} 2
+test compExpr-2.19 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4%2}
+} 0
+test compExpr-2.20 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4<<2}
+} 16
+test compExpr-2.21 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4>>2}
+} 1
+test compExpr-2.22 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4<2}
+} 0
+test compExpr-2.23 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4>2}
+} 1
+test compExpr-2.24 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4<=2}
+} 0
+test compExpr-2.25 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4>=2}
+} 1
+test compExpr-2.26 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4==2}
+} 0
+test compExpr-2.27 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4!=2}
+} 1
+test compExpr-2.28 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4&2}
+} 0
+test compExpr-2.29 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4^2}
+} 6
+test compExpr-2.30 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} {
+ expr {4|2}
+} 6
+test compExpr-2.31 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} {
+ expr {!4}
+} 0
+test compExpr-2.32 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} {
+ expr {~4}
+} -5
+test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} {
+ catch {unset a}
+ set a 15
+ expr {$a==15} ;# compiled out-of-line to runtime call on Tcl_ExprObjCmd
+} 1
+test compExpr-2.34 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
+ expr {+2}
+} 2
+test compExpr-2.35 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
+ list [catch {expr {+[expr 1+]}} msg] $msg
+} {1 {syntax error in expression "1+"}}
+test compExpr-2.36 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
+ expr {4+2}
+} 6
+test compExpr-2.37 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
+ list [catch {expr {[expr 1+]+5}} msg] $msg
+} {1 {syntax error in expression "1+"}}
+test compExpr-2.38 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
+ list [catch {expr {5+[expr 1+]}} msg] $msg
+} {1 {syntax error in expression "1+"}}
+test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
+ expr {-2}
+} -2
+test compExpr-2.40 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
+ expr {4-2}
+} 2
+test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
+ catch {unset a}
+ set a true
+ expr {0||$a}
+} 1
+test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
+ catch {unset a}
+ set a 15
+ list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
+} {1 {syntax error in expression "1+"}}
+test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
+ catch {unset a}
+ set a false
+ expr {3&&$a}
+} 0
+test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
+ catch {unset a}
+ set a false
+ expr {$a||1? 1 : 0}
+} 1
+test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
+ catch {unset a}
+ set a 15
+ list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg
+} {1 {syntax error in expression "1+"}}
+
+test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} {
+ catch {unset a}
+ set a 2
+ expr {[set a]||0}
+} 1
+test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} {
+ catch {unset a}
+ set a no
+ expr {$a&&1}
+} 0
+test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} {
+ list [catch {expr {[expr *2]||0}} msg] $msg
+} {1 {syntax error in expression "*2"}}
+test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} {
+ catch {unset a}
+ catch {unset b}
+ set a no
+ set b true
+ expr {$a || $b}
+} 1
+test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} {
+ catch {unset a}
+ set a yes
+ expr {$a || [exit]}
+} 1
+test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} {
+ catch {unset a}
+ set a no
+ expr {$a && [exit]}
+} 0
+test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} {
+ catch {unset a}
+ set a 2
+ expr {0||[set a]}
+} 1
+test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} {
+ catch {unset a}
+ set a no
+ expr {1&&$a}
+} 0
+test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} {
+ list [catch {expr {0||[expr %2]}} msg] $msg
+} {1 {syntax error in expression "%2"}}
+test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} {
+ set a "abcdefghijkl"
+ set i 7
+ expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
+} 1
+
+test compExpr-4.1 {CompileCondExpr procedure, simple test} {
+ catch {unset a}
+ set a 2
+ expr {($a > 1)? "ok" : "nope"}
+} ok
+test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} {
+ catch {unset a}
+ set a no
+ expr {[set a]? 27 : -54}
+} -54
+test compExpr-4.3 {CompileCondExpr procedure, error in test} {
+ list [catch {expr {[expr *2]? +1 : -1}} msg] $msg
+} {1 {syntax error in expression "*2"}}
+test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} {
+ catch {unset a}
+ set a no
+ expr {1? (27-2) : -54}
+} 25
+test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} {
+ catch {unset a}
+ set a no
+ expr {1? $a : -54}
+} no
+test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} {
+ list [catch {expr {1? [expr *2] : -127}} msg] $msg
+} {1 {syntax error in expression "*2"}}
+test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} {
+ catch {unset a}
+ set a no
+ expr {(2-2)? -3.14159 : "nope"}
+} nope
+test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} {
+ catch {unset a}
+ set a 00123
+ expr {0? 42 : $a}
+} 83
+test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
+ list [catch {expr {1? 15 : [expr *2]}} msg] $msg
+} {1 {syntax error in expression "*2"}}
+
+test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
+ format %.6g [expr atan2(1.0, 2.0)]
+} 0.463648
+test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} {
+ list [catch {expr {do_it()}} msg] $msg
+} {1 {unknown math function "do_it"}}
+if $gotT1 {
+ test compExpr-5.3 {CompileMathFuncCall: call registered math function} {
+ expr 3*T1()-1
+ } 368
+ test compExpr-5.4 {CompileMathFuncCall: call registered math function} {
+ expr T2()*3
+ } 1035
+}
+test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} {
+ list [catch {expr {atan2(1.0)}} msg] $msg
+} {1 {too few arguments for math function}}
+test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
+ format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
+} 9.97424
+test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} {
+ list [catch {expr {sinh(2.*)}} msg] $msg
+} {1 {syntax error in expression "sinh(2.*)"}}
+test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} {
+ list [catch {expr {sinh(2.0, 3.0)}} msg] $msg
+} {1 {too many arguments for math function}}
+test compExpr-5.9 {CompileMathFuncCall procedure, too many arguments} {
+ list [catch {expr {0 <= rand(5.2)}} msg] $msg
+} {1 {too many arguments for math function}}
+
+test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
+ list [catch {expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3} msg] $msg
+} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}}
+
+# cleanup
+catch {unset a}
+catch {unset b}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/compile.test b/tcl/tests/compile.test
index a245084007c..efbca87fb9e 100644
--- a/tcl/tests/compile.test
+++ b/tcl/tests/compile.test
@@ -5,13 +5,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# The following tests are very incomplete, although the rest of the
# test suite covers this file fairly well.
@@ -69,6 +73,15 @@ test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} {
list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
} {1 1 1}
+test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} {
+ catch {unset a}
+ set a(1) xyzzyx
+ proc p {} {
+ global a
+ catch {set x 123} a(1)
+ }
+ list [p] $a(1)
+} {0 123}
test compile-3.2 {TclCompileCatchCmd: non-local variables} {
set ::foo 1
proc catch-test {} {
@@ -78,8 +91,7 @@ test compile-3.2 {TclCompileCatchCmd: non-local variables} {
set ::foo
} 3
-
-test compile-1.16 {TclCompileForCmd: command substituted test expression} {
+test compile-4.1 {TclCompileForCmd: command substituted test expression} {
set i 0
set j 0
# Should be "forever"
@@ -90,7 +102,7 @@ test compile-1.16 {TclCompileForCmd: command substituted test expression} {
set j
} {4}
-test compile-3.1 {TclCompileForeachCmd: exception stack} {
+test compile-5.1 {TclCompileForeachCmd: exception stack} {
proc foreach-exception-test {} {
foreach array(index) [list 1 2 3] break
foreach array(index) [list 1 2 3] break
@@ -98,7 +110,7 @@ test compile-3.1 {TclCompileForeachCmd: exception stack} {
}
list [catch foreach-exception-test result] $result
} {0 {}}
-test compile-3.2 {TclCompileForeachCmd: non-local variables} {
+test compile-5.2 {TclCompileForeachCmd: non-local variables} {
set ::foo 1
proc foreach-test {} {
foreach ::foo {1 2 3} {}
@@ -107,7 +119,7 @@ test compile-3.2 {TclCompileForeachCmd: non-local variables} {
set ::foo
} 3
-test compile-4.1 {TclCompileSetCmd: global scalar names with ::s} {
+test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} {
catch {unset x}
catch {unset y}
set x 123
@@ -118,7 +130,7 @@ test compile-4.1 {TclCompileSetCmd: global scalar names with ::s} {
list $::x [expr {[lsearch -exact [info globals] x] != 0}] \
[p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
} {123 1 789 789 1}
-test compile-4.2 {TclCompileSetCmd: global array names with ::s} {
+test compile-6.2 {TclCompileSetCmd: global array names with ::s} {
catch {unset a}
set ::a(1) 2
proc p {} {
@@ -127,7 +139,7 @@ test compile-4.2 {TclCompileSetCmd: global array names with ::s} {
}
list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
} {2 1 3 3 1}
-test compile-4.3 {TclCompileSetCmd: namespace var names with ::s} {
+test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} {
catch {namespace delete test_ns_compile}
catch {unset x}
namespace eval test_ns_compile {
@@ -139,7 +151,7 @@ test compile-4.3 {TclCompileSetCmd: namespace var names with ::s} {
list $::x $::test_ns_compile::arr(1)
} {hello 123}
-test compile-1.15 {TclCompileWhileCmd: command substituted test expression} {
+test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
set i 0
set j 0
# Should be "forever"
@@ -150,17 +162,17 @@ test compile-1.15 {TclCompileWhileCmd: command substituted test expression} {
set j
} {4}
-test compile-5.1 {CollectArgInfo: binary data} {
+test compile-8.1 {CollectArgInfo: binary data} {
list [catch "string length \000foo" msg] $msg
} {0 4}
-test compile-5.2 {CollectArgInfo: binary data} {
+test compile-8.2 {CollectArgInfo: binary data} {
list [catch "string length foo\000" msg] $msg
} {0 4}
-test compile-5.3 {CollectArgInfo: handle "]" at end of command properly} {
+test compile-8.3 {CollectArgInfo: handle "]" at end of command properly} {
set x ]
} {]}
-test compile-6.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} {
+test compile-9.1 {UpdateStringOfByteCode: called for duplicate of compiled empty object} {
proc p {} {
set x {}
eval $x
@@ -170,10 +182,35 @@ test compile-6.1 {UpdateStringOfByteCode: called for duplicate of compiled empty
p
} {}
+test compile-10.1 {BLACKBOX: exception stack overflow} {
+ set x {{0}}
+ set y 0
+ while {$y < 100} {
+ if !$x {incr y}
+ }
+} {}
+
+
+
+# cleanup
catch {rename p ""}
catch {namespace delete test_ns_compile}
catch {unset x}
catch {unset y}
catch {unset a}
-
+::tcltest::cleanupTests
return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/concat.test b/tcl/tests/concat.test
index 94ae3668682..80199c193e8 100644
--- a/tcl/tests/concat.test
+++ b/tcl/tests/concat.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test concat-1.1 {simple concatenation} {
concat a b c d e f g
@@ -44,3 +48,20 @@ test concat-4.2 {pruning off extra white space} {
test concat-4.3 {pruning off extra white space sets length correctly} {
llength [concat { {{a}} }]
} 1
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/dcall.test b/tcl/tests/dcall.test
index 050df35bbdc..5a5091cdefa 100644
--- a/tcl/tests/dcall.test
+++ b/tcl/tests/dcall.test
@@ -6,20 +6,25 @@
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testdcall] == {}} {
puts "This application hasn't been compiled with the \"testdcall\""
puts "command, so I can't test Tcl_CallWhenDeleted."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
test dcall-1.1 {deletion callbacks} {
lsort -increasing [testdcall 1 2 3]
} {1 2 3}
@@ -38,3 +43,20 @@ test dcall-1.5 {deletion callbacks} {
test dcall-1.6 {deletion callbacks} {
lsort -increasing [testdcall 20 21 22 -21 -22 -20]
} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/defs.tcl b/tcl/tests/defs.tcl
new file mode 100644
index 00000000000..a005496f0c5
--- /dev/null
+++ b/tcl/tests/defs.tcl
@@ -0,0 +1,1091 @@
+# defs.tcl --
+#
+# This file contains support code for the Tcl/Tk test suite.It is
+# It is normally sourced by the individual files in the test suite
+# before they run their tests. This improved approach to testing
+# was designed and initially implemented by Mary Ann May-Pumphrey
+# of Sun Microsystems.
+#
+# Copyright (c) 1990-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+# Initialize wish shell
+
+if {[info exists tk_version]} {
+ tk appname tktest
+ wm title . tktest
+} else {
+
+ # Ensure that we have a minimal auto_path so we don't pick up extra junk.
+
+ set auto_path [list [info library]]
+}
+
+# create the "tcltest" namespace for all testing variables and procedures
+
+namespace eval tcltest {
+ set procList [list test cleanupTests dotests saveState restoreState \
+ normalizeMsg makeFile removeFile makeDirectory removeDirectory \
+ viewFile bytestring set_iso8859_1_locale restore_locale \
+ safeFetch threadReap]
+ if {[info exists tk_version]} {
+ lappend procList setupbg dobg bgReady cleanupbg fixfocus
+ }
+ foreach proc $procList {
+ namespace export $proc
+ }
+
+ # ::tcltest::verbose defaults to "b"
+
+ variable verbose "b"
+
+ # match defaults to the empty list
+
+ variable match {}
+
+ # skip defaults to the empty list
+
+ variable skip {}
+
+ # Tests should not rely on the current working directory.
+ # Files that are part of the test suite should be accessed relative to
+ # ::tcltest::testsDir.
+
+ set originalDir [pwd]
+ set tDir [file join $originalDir [file dirname [info script]]]
+ cd $tDir
+ variable testsDir [pwd]
+ cd $originalDir
+
+ # Count the number of files tested (0 if all.tcl wasn't called).
+ # The all.tcl file will set testSingleFile to false, so stats will
+ # not be printed until all.tcl calls the cleanupTests proc.
+ # The currentFailure var stores the boolean value of whether the
+ # current test file has had any failures. The failFiles list
+ # stores the names of test files that had failures.
+
+ variable numTestFiles 0
+ variable testSingleFile true
+ variable currentFailure false
+ variable failFiles {}
+
+ # Tests should remove all files they create. The test suite will
+ # check the current working dir for files created by the tests.
+ # ::tcltest::filesMade keeps track of such files created using the
+ # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
+ # ::tcltest::filesExisted stores the names of pre-existing files.
+
+ variable filesMade {}
+ variable filesExisted {}
+
+ # ::tcltest::numTests will store test files as indices and the list
+ # of files (that should not have been) left behind by the test files.
+
+ array set ::tcltest::createdNewFiles {}
+
+ # initialize ::tcltest::numTests array to keep track fo the number of
+ # tests that pass, fial, and are skipped.
+
+ array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0]
+
+ # initialize ::tcltest::skippedBecause array to keep track of
+ # constraints that kept tests from running
+
+ array set ::tcltest::skippedBecause {}
+
+ # tests that use thread need to know which is the main thread
+
+ variable ::tcltest::mainThread 1
+ if {[info commands testthread] != {}} {
+ set ::tcltest::mainThread [testthread names]
+ }
+}
+
+# If there is no "memory" command (because memory debugging isn't
+# enabled), generate a dummy command that does nothing.
+
+if {[info commands memory] == ""} {
+ proc memory args {}
+}
+
+# ::tcltest::initConfig --
+#
+# Check configuration information that will determine which tests
+# to run. To do this, create an array ::tcltest::testConfig. Each
+# element has a 0 or 1 value. If the element is "true" then tests
+# with that constraint will be run, otherwise tests with that constraint
+# will be skipped. See the README file for the list of built-in
+# constraints defined in this procedure.
+#
+# Arguments:
+# none
+#
+# Results:
+# The ::tcltest::testConfig array is reset to have an index for
+# each built-in test constraint.
+
+proc ::tcltest::initConfig {} {
+
+ global tcl_platform tcl_interactive tk_version
+
+ catch {unset ::tcltest::testConfig}
+
+ # The following trace procedure makes it so that we can safely refer to
+ # non-existent members of the ::tcltest::testConfig array without causing an
+ # error. Instead, reading a non-existent member will return 0. This is
+ # necessary because tests are allowed to use constraint "X" without ensuring
+ # that ::tcltest::testConfig("X") is defined.
+
+ trace variable ::tcltest::testConfig r ::tcltest::safeFetch
+
+ proc ::tcltest::safeFetch {n1 n2 op} {
+ if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} {
+ set ::tcltest::testConfig($n2) 0
+ }
+ }
+
+ set ::tcltest::testConfig(unixOnly) \
+ [expr {$tcl_platform(platform) == "unix"}]
+ set ::tcltest::testConfig(macOnly) \
+ [expr {$tcl_platform(platform) == "macintosh"}]
+ set ::tcltest::testConfig(pcOnly) \
+ [expr {$tcl_platform(platform) == "windows"}]
+
+ set ::tcltest::testConfig(unix) $::tcltest::testConfig(unixOnly)
+ set ::tcltest::testConfig(mac) $::tcltest::testConfig(macOnly)
+ set ::tcltest::testConfig(pc) $::tcltest::testConfig(pcOnly)
+
+ set ::tcltest::testConfig(unixOrPc) \
+ [expr {$::tcltest::testConfig(unix) || $::tcltest::testConfig(pc)}]
+ set ::tcltest::testConfig(macOrPc) \
+ [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(pc)}]
+ set ::tcltest::testConfig(macOrUnix) \
+ [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(unix)}]
+
+ set ::tcltest::testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}]
+ set ::tcltest::testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}]
+
+ # The following config switches are used to mark tests that should work,
+ # but have been temporarily disabled on certain platforms because they don't
+ # and we haven't gotten around to fixing the underlying problem.
+
+ set ::tcltest::testConfig(tempNotPc) [expr {!$::tcltest::testConfig(pc)}]
+ set ::tcltest::testConfig(tempNotMac) [expr {!$::tcltest::testConfig(mac)}]
+ set ::tcltest::testConfig(tempNotUnix) [expr {!$::tcltest::testConfig(unix)}]
+
+ # The following config switches are used to mark tests that crash on
+ # certain platforms, so that they can be reactivated again when the
+ # underlying problem is fixed.
+
+ set ::tcltest::testConfig(pcCrash) [expr {!$::tcltest::testConfig(pc)}]
+ set ::tcltest::testConfig(macCrash) [expr {!$::tcltest::testConfig(mac)}]
+ set ::tcltest::testConfig(unixCrash) [expr {!$::tcltest::testConfig(unix)}]
+
+ # Set the "fonts" constraint for wish apps
+
+ if {[info exists tk_version]} {
+ set ::tcltest::testConfig(fonts) 1
+ catch {destroy .e}
+ entry .e -width 0 -font {Helvetica -12} -bd 1
+ .e insert end "a.bcd"
+ if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
+ set ::tcltest::testConfig(fonts) 0
+ }
+ destroy .e
+ catch {destroy .t}
+ text .t -width 80 -height 20 -font {Times -14} -bd 1
+ pack .t
+ .t insert end "This is\na dot."
+ update
+ set x [list [.t bbox 1.3] [.t bbox 2.5]]
+ destroy .t
+ if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} {
+ set ::tcltest::testConfig(fonts) 0
+ }
+ }
+
+ # Skip empty tests
+
+ set ::tcltest::testConfig(emptyTest) 0
+
+ # By default, tests that expost known bugs are skipped.
+
+ set ::tcltest::testConfig(knownBug) 0
+
+ # By default, non-portable tests are skipped.
+
+ set ::tcltest::testConfig(nonPortable) 0
+
+ # Some tests require user interaction.
+
+ set ::tcltest::testConfig(userInteraction) 0
+
+ # Some tests must be skipped if the interpreter is not in interactive mode
+
+ set ::tcltest::testConfig(interactive) $tcl_interactive
+
+ # Some tests must be skipped if you are running as root on Unix.
+ # Other tests can only be run if you are running as root on Unix.
+
+ set ::tcltest::testConfig(root) 0
+ set ::tcltest::testConfig(notRoot) 1
+ set user {}
+ if {$tcl_platform(platform) == "unix"} {
+ catch {set user [exec whoami]}
+ if {$user == ""} {
+ catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+ }
+ if {($user == "root") || ($user == "")} {
+ set ::tcltest::testConfig(root) 1
+ set ::tcltest::testConfig(notRoot) 0
+ }
+ }
+
+ # Set nonBlockFiles constraint: 1 means this platform supports
+ # setting files into nonblocking mode.
+
+ if {[catch {set f [open defs r]}]} {
+ set ::tcltest::testConfig(nonBlockFiles) 1
+ } else {
+ if {[catch {fconfigure $f -blocking off}] == 0} {
+ set ::tcltest::testConfig(nonBlockFiles) 1
+ } else {
+ set ::tcltest::testConfig(nonBlockFiles) 0
+ }
+ close $f
+ }
+
+ # Set asyncPipeClose constraint: 1 means this platform supports
+ # async flush and async close on a pipe.
+ #
+ # Test for SCO Unix - cannot run async flushing tests because a
+ # potential problem with select is apparently interfering.
+ # (Mark Diekhans).
+
+ if {$tcl_platform(platform) == "unix"} {
+ if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
+ set ::tcltest::testConfig(asyncPipeClose) 0
+ } else {
+ set ::tcltest::testConfig(asyncPipeClose) 1
+ }
+ } else {
+ set ::tcltest::testConfig(asyncPipeClose) 1
+ }
+
+ # Test to see if we have a broken version of sprintf with respect
+ # to the "e" format of floating-point numbers.
+
+ set ::tcltest::testConfig(eformat) 1
+ if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
+ set ::tcltest::testConfig(eformat) 0
+ }
+
+ # Test to see if execed commands such as cat, echo, rm and so forth are
+ # present on this machine.
+
+ set ::tcltest::testConfig(unixExecs) 1
+ if {$tcl_platform(platform) == "macintosh"} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ($tcl_platform(platform) == "windows")} {
+ if {[catch {exec cat defs}] == 1} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec echo hello}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec sh -c echo hello}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec wc defs}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {$::tcltest::testConfig(unixExecs) == 1} {
+ exec echo hello > removeMe
+ if {[catch {exec rm removeMe}] == 1} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec sleep 1}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec fgrep unixExecs defs}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec ps}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec echo abc > removeMe}] == 0) && \
+ ([catch {exec chmod 644 removeMe}] == 1) && \
+ ([catch {exec rm removeMe}] == 0)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ } else {
+ catch {exec rm -f removeMe}
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec mkdir removeMe}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ } else {
+ catch {exec rm -r removeMe}
+ }
+ }
+}
+
+::tcltest::initConfig
+
+
+# ::tcltest::processCmdLineArgs --
+#
+# Use command line args to set the verbose, skip, and
+# match variables. This procedure must be run after
+# constraints are initialized, because some constraints can be
+# overridden.
+#
+# Arguments:
+# none
+#
+# Results:
+# ::tcltest::verbose is set to <value>
+
+proc ::tcltest::processCmdLineArgs {} {
+ global argv
+
+ # The "argv" var doesn't exist in some cases, so use {}
+ # The "argv" var doesn't exist in some cases.
+
+ if {(![info exists argv]) || ([llength $argv] < 2)} {
+ set flagArray {}
+ } else {
+ set flagArray $argv
+ }
+
+ if {[catch {array set flag $flagArray}]} {
+ puts stderr "Error: odd number of command line args specified:"
+ puts stderr " $argv"
+ exit
+ }
+
+ # Allow for 1-char abbreviations, where applicable (e.g., -match == -m).
+ # Note that -verbose cannot be abbreviated to -v in wish because it
+ # conflicts with the wish option -visual.
+
+ foreach arg {-verbose -match -skip -constraints} {
+ set abbrev [string range $arg 0 1]
+ if {([info exists flag($abbrev)]) && \
+ ([lsearch -exact $flagArray $arg] < \
+ [lsearch -exact $flagArray $abbrev])} {
+ set flag($arg) $flag($abbrev)
+ }
+ }
+
+ # Set ::tcltest::workingDir to [pwd].
+ # Save the names of files that already exist in ::tcltest::workingDir.
+
+ set ::tcltest::workingDir [pwd]
+ foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
+ lappend ::tcltest::filesExisted [file tail $file]
+ }
+
+ # Set ::tcltest::verbose to the arg of the -verbose flag, if given
+
+ if {[info exists flag(-verbose)]} {
+ set ::tcltest::verbose $flag(-verbose)
+ }
+
+ # Set ::tcltest::match to the arg of the -match flag, if given
+
+ if {[info exists flag(-match)]} {
+ set ::tcltest::match $flag(-match)
+ }
+
+ # Set ::tcltest::skip to the arg of the -skip flag, if given
+
+ if {[info exists flag(-skip)]} {
+ set ::tcltest::skip $flag(-skip)
+ }
+
+ # Use the -constraints flag, if given, to turn on constraints that are
+ # turned off by default: userInteractive knownBug nonPortable. This
+ # code fragment must be run after constraints are initialized.
+
+ if {[info exists flag(-constraints)]} {
+ foreach elt $flag(-constraints) {
+ set ::tcltest::testConfig($elt) 1
+ }
+ }
+}
+
+::tcltest::processCmdLineArgs
+
+
+# ::tcltest::cleanupTests --
+#
+# Remove files and dirs created using the makeFile and makeDirectory
+# commands since the last time this proc was invoked.
+#
+# Print the names of the files created without the makeFile command
+# since the tests were invoked.
+#
+# Print the number tests (total, passed, failed, and skipped) since the
+# tests were invoked.
+#
+
+proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
+ set tail [file tail [info script]]
+
+ # Remove files and directories created by the :tcltest::makeFile and
+ # ::tcltest::makeDirectory procedures.
+ # Record the names of files in ::tcltest::workingDir that were not
+ # pre-existing, and associate them with the test file that created them.
+
+ if {!$calledFromAllFile} {
+
+ foreach file $::tcltest::filesMade {
+ if {[file exists $file]} {
+ catch {file delete -force $file}
+ }
+ }
+ set currentFiles {}
+ foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
+ lappend currentFiles [file tail $file]
+ }
+ set newFiles {}
+ foreach file $currentFiles {
+ if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
+ lappend newFiles $file
+ }
+ }
+ set ::tcltest::filesExisted $currentFiles
+ if {[llength $newFiles] > 0} {
+ set ::tcltest::createdNewFiles($tail) $newFiles
+ }
+ }
+
+ if {$calledFromAllFile || $::tcltest::testSingleFile} {
+
+ # print stats
+
+ puts -nonewline stdout "$tail:"
+ foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+ puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)"
+ }
+ puts stdout ""
+
+ # print number test files sourced
+ # print names of files that ran tests which failed
+
+ if {$calledFromAllFile} {
+ puts stdout "Sourced $::tcltest::numTestFiles Test Files."
+ set ::tcltest::numTestFiles 0
+ if {[llength $::tcltest::failFiles] > 0} {
+ puts stdout "Files with failing tests: $::tcltest::failFiles"
+ set ::tcltest::failFiles {}
+ }
+ }
+
+ # if any tests were skipped, print the constraints that kept them
+ # from running.
+
+ set constraintList [array names ::tcltest::skippedBecause]
+ if {[llength $constraintList] > 0} {
+ puts stdout "Number of tests skipped for each constraint:"
+ foreach constraint [lsort $constraintList] {
+ puts stdout \
+ "\t$::tcltest::skippedBecause($constraint)\t$constraint"
+ unset ::tcltest::skippedBecause($constraint)
+ }
+ }
+
+ # report the names of test files in ::tcltest::createdNewFiles, and
+ # reset the array to be empty.
+
+ set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]]
+ if {[llength $testFilesThatTurded] > 0} {
+ puts stdout "Warning: test files left files behind:"
+ foreach testFile $testFilesThatTurded {
+ puts "\t$testFile:\t$::tcltest::createdNewFiles($testFile)"
+ unset ::tcltest::createdNewFiles($testFile)
+ }
+ }
+
+ # reset filesMade, filesExisted, and numTests
+
+ set ::tcltest::filesMade {}
+ foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+ set ::tcltest::numTests($index) 0
+ }
+
+ # exit only if running Tk in non-interactive mode
+
+ global tk_version tcl_interactive
+ if {[info exists tk_version] && !$tcl_interactive} {
+ exit
+ }
+ } else {
+
+ # if we're deferring stat-reporting until all files are sourced,
+ # then add current file to failFile list if any tests in this file
+ # failed
+
+ incr ::tcltest::numTestFiles
+ if {($::tcltest::currentFailure) && \
+ ([lsearch -exact $::tcltest::failFiles $tail] == -1)} {
+ lappend ::tcltest::failFiles $tail
+ }
+ set ::tcltest::currentFailure false
+ }
+}
+
+
+# test --
+#
+# This procedure runs a test and prints an error message if the test fails.
+# If ::tcltest::verbose has been set, it also prints a message even if the
+# test succeeds. The test will be skipped if it doesn't match the
+# ::tcltest::match variable, if it matches an element in
+# ::tcltest::skip, or if one of the elements of "constraints" turns
+# out not to be true.
+#
+# Arguments:
+# name - Name of test, in the form foo-1.2.
+# description - Short textual description of the test, to
+# help humans understand what it does.
+# constraints - A list of one or more keywords, each of
+# which must be the name of an element in
+# the array "::tcltest::testConfig". If any of these
+# elements is zero, the test is skipped.
+# This argument may be omitted.
+# script - Script to run to carry out the test. It must
+# return a result that can be checked for
+# correctness.
+# expectedAnswer - Expected result from script.
+
+proc ::tcltest::test {name description script expectedAnswer args} {
+ incr ::tcltest::numTests(Total)
+
+ # skip the test if it's name matches an element of skip
+
+ foreach pattern $::tcltest::skip {
+ if {[string match $pattern $name]} {
+ incr ::tcltest::numTests(Skipped)
+ return
+ }
+ }
+ # skip the test if it's name doesn't match any element of match
+
+ if {[llength $::tcltest::match] > 0} {
+ set ok 0
+ foreach pattern $::tcltest::match {
+ if {[string match $pattern $name]} {
+ set ok 1
+ break
+ }
+ }
+ if {!$ok} {
+ incr ::tcltest::numTests(Skipped)
+ return
+ }
+ }
+ set i [llength $args]
+ if {$i == 0} {
+ set constraints {}
+ } elseif {$i == 1} {
+
+ # "constraints" argument exists; shuffle arguments down, then
+ # make sure that the constraints are satisfied.
+
+ set constraints $script
+ set script $expectedAnswer
+ set expectedAnswer [lindex $args 0]
+ set doTest 0
+ if {[string match {*[$\[]*} $constraints] != 0} {
+
+ # full expression, e.g. {$foo > [info tclversion]}
+
+ catch {set doTest [uplevel #0 expr $constraints]}
+
+ } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
+
+ # something like {a || b} should be turned into
+ # $::tcltest::testConfig(a) || $::tcltest::testConfig(b).
+
+ regsub -all {[.a-zA-Z0-9]+} $constraints \
+ {$::tcltest::testConfig(&)} c
+ catch {set doTest [eval expr $c]}
+ } else {
+
+ # just simple constraints such as {unixOnly fonts}.
+
+ set doTest 1
+ foreach constraint $constraints {
+ if {![info exists ::tcltest::testConfig($constraint)]
+ || !$::tcltest::testConfig($constraint)} {
+ set doTest 0
+
+ # store the constraint that kept the test from running
+
+ set constraints $constraint
+ break
+ }
+ }
+ }
+ if {$doTest == 0} {
+ incr ::tcltest::numTests(Skipped)
+ if {[string first s $::tcltest::verbose] != -1} {
+ puts stdout "++++ $name SKIPPED: $constraints"
+ }
+
+ # add the constraint to the list of constraints the kept tests
+ # from running
+
+ if {[info exists ::tcltest::skippedBecause($constraints)]} {
+ incr ::tcltest::skippedBecause($constraints)
+ } else {
+ set ::tcltest::skippedBecause($constraints) 1
+ }
+ return
+ }
+ } else {
+ error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\""
+ }
+ memory tag $name
+ set code [catch {uplevel $script} actualAnswer]
+ if {$code != 0 || [string compare $actualAnswer $expectedAnswer] != 0} {
+ incr ::tcltest::numTests(Failed)
+ set ::tcltest::currentFailure true
+ if {[string first b $::tcltest::verbose] == -1} {
+ set script ""
+ }
+ puts stdout "\n==== $name $description FAILED"
+ if {$script != ""} {
+ puts stdout "==== Contents of test case:"
+ puts stdout $script
+ }
+ if {$code != 0} {
+ if {$code == 1} {
+ puts stdout "==== Test generated error:"
+ puts stdout $actualAnswer
+ } elseif {$code == 2} {
+ puts stdout "==== Test generated return exception; result was:"
+ puts stdout $actualAnswer
+ } elseif {$code == 3} {
+ puts stdout "==== Test generated break exception"
+ } elseif {$code == 4} {
+ puts stdout "==== Test generated continue exception"
+ } else {
+ puts stdout "==== Test generated exception $code; message was:"
+ puts stdout $actualAnswer
+ }
+ } else {
+ puts stdout "---- Result was:\n$actualAnswer"
+ }
+ puts stdout "---- Result should have been:\n$expectedAnswer"
+ puts stdout "==== $name FAILED\n"
+ } else {
+ incr ::tcltest::numTests(Passed)
+ if {[string first p $::tcltest::verbose] != -1} {
+ puts stdout "++++ $name PASSED"
+ }
+ }
+}
+
+# ::tcltest::dotests --
+#
+# takes two arguments--the name of the test file (such
+# as "parse.test"), and a pattern selecting the tests you want to
+# execute. It sets ::tcltest::matching to the second argument, calls
+# "source" on the file specified in the first argument, and restores
+# ::tcltest::matching to its pre-call value at the end.
+#
+# Arguments:
+# file name of tests file to source
+# args pattern selecting the tests you want to execute
+#
+# Results:
+# none
+
+proc ::tcltest::dotests {file args} {
+ set savedTests $::tcltest::match
+ set ::tcltest::match $args
+ source $file
+ set ::tcltest::match $savedTests
+}
+
+proc ::tcltest::openfiles {} {
+ if {[catch {testchannel open} result]} {
+ return {}
+ }
+ return $result
+}
+
+proc ::tcltest::leakfiles {old} {
+ if {[catch {testchannel open} new]} {
+ return {}
+ }
+ set leak {}
+ foreach p $new {
+ if {[lsearch $old $p] < 0} {
+ lappend leak $p
+ }
+ }
+ return $leak
+}
+
+set ::tcltest::saveState {}
+
+proc ::tcltest::saveState {} {
+ uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]}
+}
+
+proc ::tcltest::restoreState {} {
+ foreach p [info procs] {
+ if {[lsearch [lindex $::tcltest::saveState 0] $p] < 0} {
+ rename $p {}
+ }
+ }
+ foreach p [uplevel #0 {info vars}] {
+ if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} {
+ uplevel #0 "unset $p"
+ }
+ }
+}
+
+proc ::tcltest::normalizeMsg {msg} {
+ regsub "\n$" [string tolower $msg] "" msg
+ regsub -all "\n\n" $msg "\n" msg
+ regsub -all "\n\}" $msg "\}" msg
+ return $msg
+}
+
+# makeFile --
+#
+# Create a new file with the name <name>, and write <contents> to it.
+#
+# If this file hasn't been created via makeFile since the last time
+# cleanupTests was called, add it to the $filesMade list, so it will
+# be removed by the next call to cleanupTests.
+#
+proc ::tcltest::makeFile {contents name} {
+ set fd [open $name w]
+ fconfigure $fd -translation lf
+ if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} {
+ puts -nonewline $fd $contents
+ } else {
+ puts $fd $contents
+ }
+ close $fd
+
+ set fullName [file join [pwd] $name]
+ if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
+ lappend ::tcltest::filesMade $fullName
+ }
+}
+
+proc ::tcltest::removeFile {name} {
+ file delete $name
+}
+
+# makeDirectory --
+#
+# Create a new dir with the name <name>.
+#
+# If this dir hasn't been created via makeDirectory since the last time
+# cleanupTests was called, add it to the $directoriesMade list, so it will
+# be removed by the next call to cleanupTests.
+#
+proc ::tcltest::makeDirectory {name} {
+ file mkdir $name
+
+ set fullName [file join [pwd] $name]
+ if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
+ lappend ::tcltest::filesMade $fullName
+ }
+}
+
+proc ::tcltest::removeDirectory {name} {
+ file delete -force $name
+}
+
+proc ::tcltest::viewFile {name} {
+ global tcl_platform
+ if {($tcl_platform(platform) == "macintosh") || \
+ ($::tcltest::testConfig(unixExecs) == 0)} {
+ set f [open $name]
+ set data [read -nonewline $f]
+ close $f
+ return $data
+ } else {
+ exec cat $name
+ }
+}
+
+#
+# Construct a string that consists of the requested sequence of bytes,
+# as opposed to a string of properly formed UTF-8 characters.
+# This allows the tester to
+# 1. Create denormalized or improperly formed strings to pass to C procedures
+# that are supposed to accept strings with embedded NULL bytes.
+# 2. Confirm that a string result has a certain pattern of bytes, for instance
+# to confirm that "\xe0\0" in a Tcl script is stored internally in
+# UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
+#
+# Generally, it's a bad idea to examine the bytes in a Tcl string or to
+# construct improperly formed strings in this manner, because it involves
+# exposing that Tcl uses UTF-8 internally.
+
+proc ::tcltest::bytestring {string} {
+ encoding convertfrom identity $string
+}
+
+# Locate tcltest executable
+
+if {![info exists tk_version]} {
+ set tcltest [info nameofexecutable]
+
+ if {$tcltest == "{}"} {
+ set tcltest {}
+ }
+}
+
+set ::tcltest::testConfig(stdio) 0
+catch {
+ catch {file delete -force tmp}
+ set f [open tmp w]
+ puts $f {
+ exit
+ }
+ close $f
+
+ set f [open "|[list $tcltest tmp]" r]
+ close $f
+
+ set ::tcltest::testConfig(stdio) 1
+}
+catch {file delete -force tmp}
+
+# Deliberately call the socket with the wrong number of arguments. The error
+# message you get will indicate whether sockets are available on this system.
+
+catch {socket} msg
+set ::tcltest::testConfig(socket) \
+ [expr {$msg != "sockets are not available on this system"}]
+
+#
+# Internationalization / ISO support procs -- dl
+#
+
+if {[info commands testlocale]==""} {
+
+ # No testlocale command, no tests...
+ # (it could be that we are a sub interp and we could just load
+ # the Tcltest package but that would interfere with tests
+ # that tests packages/loading in slaves...)
+
+ set ::tcltest::testConfig(hasIsoLocale) 0
+} else {
+ proc ::tcltest::set_iso8859_1_locale {} {
+ set ::tcltest::previousLocale [testlocale ctype]
+ testlocale ctype $::tcltest::isoLocale
+ }
+
+ proc ::tcltest::restore_locale {} {
+ testlocale ctype $::tcltest::previousLocale
+ }
+
+ if {![info exists ::tcltest::isoLocale]} {
+ set ::tcltest::isoLocale fr
+ switch $tcl_platform(platform) {
+ "unix" {
+
+ # Try some 'known' values for some platforms:
+
+ switch -exact -- $tcl_platform(os) {
+ "FreeBSD" {
+ set ::tcltest::isoLocale fr_FR.ISO_8859-1
+ }
+ HP-UX {
+ set ::tcltest::isoLocale fr_FR.iso88591
+ }
+ Linux -
+ IRIX {
+ set ::tcltest::isoLocale fr
+ }
+ default {
+
+ # Works on SunOS 4 and Solaris, and maybe others...
+ # define it to something else on your system
+ #if you want to test those.
+
+ set ::tcltest::isoLocale iso_8859_1
+ }
+ }
+ }
+ "windows" {
+ set ::tcltest::isoLocale French
+ }
+ }
+ }
+
+ set ::tcltest::testConfig(hasIsoLocale) \
+ [string length [::tcltest::set_iso8859_1_locale]]
+ ::tcltest::restore_locale
+}
+
+#
+# procedures that are Tk specific
+#
+
+if {[info exists tk_version]} {
+
+ # If the main window isn't already mapped (e.g. because the tests are
+ # being run automatically) , specify a precise size for it so that the
+ # user won't have to position it manually.
+
+ if {![winfo ismapped .]} {
+ wm geometry . +0+0
+ update
+ }
+
+ # The following code can be used to perform tests involving a second
+ # process running in the background.
+
+ # Locate the tktest executable
+
+ set ::tcltest::tktest [info nameofexecutable]
+ if {$::tcltest::tktest == "{}"} {
+ set ::tcltest::tktest {}
+ puts stdout \
+ "Unable to find tktest executable, skipping multiple process tests."
+ }
+
+ # Create background process
+
+ proc ::tcltest::setupbg args {
+ if {$::tcltest::tktest == ""} {
+ error "you're not running tktest so setupbg should not have been called"
+ }
+ if {[info exists ::tcltest::fd] && ($::tcltest::fd != "")} {
+ cleanupbg
+ }
+
+ # The following code segment cannot be run on Windows in Tk8.1b2
+ # This bug is logged as a pipe bug (bugID 1495).
+
+ global tcl_platform
+ if {$tcl_platform(platform) != "windows"} {
+ set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+]
+ puts $::tcltest::fd "puts foo; flush stdout"
+ flush $::tcltest::fd
+ if {[gets $::tcltest::fd data] < 0} {
+ error "unexpected EOF from \"$::tcltest::tktest\""
+ }
+ if {[string compare $data foo]} {
+ error "unexpected output from background process \"$data\""
+ }
+ fileevent $::tcltest::fd readable bgReady
+ }
+ }
+
+ # Send a command to the background process, catching errors and
+ # flushing I/O channels
+
+ proc ::tcltest::dobg {command} {
+ puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout"
+ flush $::tcltest::fd
+ set ::tcltest::bgDone 0
+ set ::tcltest::bgData {}
+ tkwait variable ::tcltest::bgDone
+ set ::tcltest::bgData
+ }
+
+ # Data arrived from background process. Check for special marker
+ # indicating end of data for this command, and make data available
+ # to dobg procedure.
+
+ proc ::tcltest::bgReady {} {
+ set x [gets $::tcltest::fd]
+ if {[eof $::tcltest::fd]} {
+ fileevent $::tcltest::fd readable {}
+ set ::tcltest::bgDone 1
+ } elseif {$x == "**DONE**"} {
+ set ::tcltest::bgDone 1
+ } else {
+ append ::tcltest::bgData $x
+ }
+ }
+
+ # Exit the background process, and close the pipes
+
+ proc ::tcltest::cleanupbg {} {
+ catch {
+ puts $::tcltest::fd "exit"
+ close $::tcltest::fd
+ }
+ set ::tcltest::fd ""
+ }
+
+ # Clean up focus after using generate event, which
+ # can leave the window manager with the wrong impression
+ # about who thinks they have the focus. (BW)
+
+ proc ::tcltest::fixfocus {} {
+ catch {destroy .focus}
+ toplevel .focus
+ wm geometry .focus +0+0
+ entry .focus.e
+ .focus.e insert 0 "fixfocus"
+ pack .focus.e
+ update
+ focus -force .focus.e
+ destroy .focus
+ }
+}
+
+# threadReap --
+#
+# Kill all threads except for the main thread.
+# Do nothing if testthread is not defined.
+#
+# Arguments:
+# none.
+#
+# Results:
+# Returns the number of existing threads.
+
+if {[info commands testthread] != {}} {
+ proc ::tcltest::threadReap {} {
+ testthread errorproc ThreadNullError
+ while {[llength [testthread names]] > 1} {
+ foreach tid [testthread names] {
+ if {$tid != $::tcltest::mainThread} {
+ catch {testthread send -async $tid {testthread exit}}
+ update
+ }
+ }
+ }
+ testthread errorproc ThreadError
+ return [llength [testthread names]]
+ }
+} else {
+ proc ::tcltest::threadReap {} {
+ return 1
+ }
+}
+
+# Need to catch the import because it fails if defs.tcl is sourced
+# more than once.
+
+catch {namespace import ::tcltest::*}
+return
diff --git a/tcl/tests/dstring.test b/tcl/tests/dstring.test
index 7a308049f88..9e52b8a8c11 100644
--- a/tcl/tests/dstring.test
+++ b/tcl/tests/dstring.test
@@ -6,20 +6,25 @@
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testdstring] == {}} {
puts "This application hasn't been compiled with the \"testdstring\""
puts "command, so I can't test Tcl_DStringAppend et al."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
test dstring-1.1 {appending and retrieving} {
testdstring free
testdstring append "abc" -1
@@ -245,4 +250,20 @@ test dstring-6.5 {Tcl_DStringGetResult} {
lappend result [testdstring get]
} {{} {This is a specially-allocated stringz}}
+# cleanup
testdstring free
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/encoding.test b/tcl/tests/encoding.test
new file mode 100644
index 00000000000..4cd5255176f
--- /dev/null
+++ b/tcl/tests/encoding.test
@@ -0,0 +1,318 @@
+# This file contains a collection of tests for tclEncoding.c
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+proc toutf {args} {
+ global x
+ lappend x "toutf $args"
+}
+proc fromutf {args} {
+ global x
+ lappend x "fromutf $args"
+}
+
+# Some tests require the testencoding command
+
+set ::tcltest::testConstraints(testencoding) \
+ [expr {[info commands testencoding] != {}}]
+
+
+# TclInitEncodingSubsystem is tested by the rest of this file
+# TclFinalizeEncodingSubsystem is not currently tested
+
+test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {
+ testencoding create foo toutf fromutf
+ set old [encoding system]
+ encoding system foo
+ set x {}
+ encoding convertto abcd
+ encoding system $old
+ testencoding delete foo
+ set x
+} {{fromutf }}
+test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
+ testencoding create foo toutf fromutf
+ set x {}
+ encoding convertto foo abcd
+ testencoding delete foo
+ set x
+} {{fromutf }}
+test encoding-1.3 {Tcl_GetEncoding: load encoding} {
+ list [encoding convertto jis0208 \u4e4e] \
+ [encoding convertfrom jis0208 8C]
+} "8C \u4e4e"
+
+test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
+ encoding convertto jis0208 \u4e4e
+} {8C}
+test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
+ set system [encoding system]
+ set path [testencoding path]
+ encoding system shiftjis ;# incr ref count
+ testencoding path [list [pwd]]
+ set x [encoding convertto shiftjis \u4e4e] ;# old one found
+ encoding system identity
+ lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
+ encoding system identity
+ testencoding path $path
+ encoding system $system
+ set x
+} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
+
+test encoding-3.1 {Tcl_GetEncodingName, NULL} {
+ set old [encoding system]
+ encoding system shiftjis
+ set x [encoding system]
+ encoding system $old
+ set x
+} {shiftjis}
+test encoding-3.2 {Tcl_GetEncodingName, non-null} {
+ set old [fconfigure stdout -encoding]
+ fconfigure stdout -encoding jis0208
+ set x [fconfigure stdout -encoding]
+ fconfigure stdout -encoding $old
+ set x
+} {jis0208}
+
+test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
+ file mkdir tmp/encoding
+ close [open tmp/encoding/junk.enc w]
+ close [open tmp/encoding/junk2.enc w]
+ cd tmp
+ set path [testencoding path]
+ testencoding path {}
+ catch {unset encodings}
+ catch {unset x}
+ foreach encoding [encoding names] {
+ set encodings($encoding) 1
+ }
+ testencoding path [list [pwd]]
+ foreach encoding [encoding names] {
+ if {![info exists encodings($encoding)]} {
+ lappend x $encoding
+ }
+ }
+ testencoding path $path
+ cd ..
+ file delete -force tmp
+ lsort $x
+} {junk junk2}
+
+test encoding-5.1 {Tcl_SetSystemEncoding} {
+ set old [encoding system]
+ encoding system jis0208
+ set x [encoding convertto \u4e4e]
+ encoding system identity
+ encoding system $old
+ set x
+} {8C}
+test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
+ set old [encoding system]
+ encoding system $old
+ string compare $old [encoding system]
+} {0}
+
+test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
+ testencoding create foo {toutf 1} {fromutf 2}
+ set x {}
+ encoding convertfrom foo abcd
+ encoding convertto foo abcd
+ testencoding delete foo
+ set x
+} {{toutf 1} {fromutf 2}}
+test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
+ testencoding create foo {toutf a} {fromutf b}
+ set x {}
+ encoding convertfrom foo abcd
+ encoding convertto foo abcd
+ testencoding delete foo
+ set x
+} {{toutf a} {fromutf b}}
+
+test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
+ encoding convertfrom jis0208 8c8c8c8c
+} "\u543e\u543e\u543e\u543e"
+test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
+ set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C
+ append a $a
+ append a $a
+ append a $a
+ append a $a
+ set x [encoding convertfrom jis0208 $a]
+ list [string length $x] [string index $x 0]
+} "512 \u4e4e"
+
+test encoding-8.1 {Tcl_ExternalToUtf} {
+ set f [open dummy w]
+ fconfigure $f -translation binary -encoding iso8859-1
+ puts -nonewline $f "ab\x8c\xc1g"
+ close $f
+ set f [open dummy r]
+ fconfigure $f -translation binary -encoding shiftjis
+ set x [read $f]
+ close $f
+ file delete dummy
+ set x
+} "ab\u4e4eg"
+
+test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
+ encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
+} {8c8c8c8c}
+test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
+ set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e
+ append a $a
+ append a $a
+ append a $a
+ append a $a
+ append a $a
+ append a $a
+ set x [encoding convertto jis0208 $a]
+ list [string length $x] [string range $x 0 1]
+} "1024 8C"
+
+test encoding-10.1 {Tcl_UtfToExternal} {
+ set f [open dummy w]
+ fconfigure $f -translation binary -encoding shiftjis
+ puts -nonewline $f "ab\u4e4eg"
+ close $f
+ set f [open dummy r]
+ fconfigure $f -translation binary -encoding iso8859-1
+ set x [read $f]
+ close $f
+ file delete dummy
+ set x
+} "ab\x8c\xc1g"
+
+test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
+ set system [encoding system]
+ set path [testencoding path]
+ encoding system iso8859-1
+ testencoding path {}
+ set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
+ testencoding path $path
+ encoding system $system
+ lappend x [encoding convertto jis0208 \u4e4e]
+} {1 {unknown encoding "jis0208"} 8C}
+test encoding-11.2 {LoadEncodingFile: single-byte} {
+ encoding convertfrom jis0201 \xa1
+} "\uff61"
+test encoding-11.3 {LoadEncodingFile: double-byte} {
+ encoding convertfrom jis0208 8C
+} "\u4e4e"
+test encoding-11.4 {LoadEncodingFile: multi-byte} {
+ encoding convertfrom shiftjis \x8c\xc1
+} "\u4e4e"
+test encoding-11.5 {LoadEncodingFile: escape file} {
+ encoding convertto iso2022 \u4e4e
+} "\x1b(B\x1b$@8C"
+test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
+ set system [encoding system]
+ set path [testencoding path]
+ encoding system identity
+ testencoding path tmp
+ file mkdir tmp/encoding
+ set f [open tmp/encoding/splat.enc w]
+ fconfigure $f -translation binary
+ puts $f "abcdefghijklmnop"
+ close $f
+ set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
+ file delete -force tmp
+ catch {file delete encoding}
+ testencoding path $path
+ encoding system $system
+ set x
+} {1 {invalid encoding file "splat"}}
+
+# OpenEncodingFile is fully tested by the rest of the tests in this file.
+
+test encoding-12.1 {LoadTableEncoding: normal encoding} {
+ set x [encoding convertto iso8859-3 \u120]
+ append x [encoding convertto iso8859-3 \ud5]
+ append x [encoding convertfrom iso8859-3 \xd5]
+} "\xd5?\u120"
+test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
+ set x [encoding convertto iso8859-3 ab\u0120g]
+ append x [encoding convertfrom iso8859-3 ab\xd5g]
+} "ab\xd5gab\u120g"
+test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
+ set x [encoding convertto shiftjis ab\u4e4eg]
+ append x [encoding convertfrom shiftjis ab\x8c\xc1g]
+} "ab\x8c\xc1gab\u4e4eg"
+test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
+ set x [encoding convertto jis0208 \u4e4e\u3b1]
+ append x [encoding convertfrom jis0208 8C&A]
+} "8C&A\u4e4e\u3b1"
+test encoding-12.5 {LoadTableEncoding: symbol encoding} {
+ set x [encoding convertto symbol \u3b3]
+ append x [encoding convertto symbol \u67]
+ append x [encoding convertfrom symbol \x67]
+} "\x67\x67\u3b3"
+
+test encoding-13.1 {LoadEscapeTable} {
+ set x [encoding convertto iso2022 ab\u4e4e\u68d9g]
+} "\x1b(Bab\x1b$@8C\x1b$\(DD%\x1b(Bg"
+
+test encoding-14.1 {BinaryProc} {
+ encoding convertto identity \x12\x34\x56\xff\x69
+} "\x12\x34\x56\xc3\xbf\x69"
+
+test encoding-15.1 {UtfToUtfProc} {
+ encoding convertto utf-8 \xa3
+} "\xc2\xa3"
+
+test encoding-16.1 {UnicodeToUtfProc} {
+ encoding convertfrom unicode NN
+} "\u4e4e"
+
+test encoding-17.1 {UtfToUnicodeProc} {
+} {}
+
+test encoding-18.1 {TableToUtfProc} {
+} {}
+
+test encoding-19.1 {TableFromUtfProc} {
+} {}
+
+test encoding-20.1 {TableFreefProc} {
+} {}
+
+test encoding-21.1 {EscapeToUtfProc} {
+} {}
+
+test encoding-22.1 {EscapeFromUtfProc} {
+} {}
+
+# EscapeFreeProc, GetTableEncoding, unilen
+# are fully tested by the rest of this file
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/env.test b/tcl/tests/env.test
index cecb2ba28e4..adadfc6f411 100644
--- a/tcl/tests/env.test
+++ b/tcl/tests/env.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
#
# These tests will run on any platform (and indeed crashed
@@ -38,17 +42,24 @@ test env-1.2 {lappend to env value} {
set env(test) aaaaaaaaaaaaaaaa
append env(test) bbbbbbbbbbbbbb
unset env(test)
-} {}
-if {[info commands exec] == ""} {
- puts "exec not implemented for this machine"
- return
-}
+} {}
+test env-1.3 {reflection of env by "array names"} {
+ catch {interp delete child}
+ catch {unset env(test)}
+ interp create child
+ child eval {set env(test) garbage}
+ set names [array names env]
+ interp delete child
+ set ix [lsearch $names test]
+ catch {unset env(test)}
+ expr {$ix >= 0}
+} {1}
+
+
+# Some tests require the "exec" command.
+# Skip them if exec is not defined.
+set ::tcltest::testConstraints(execCommandExists) [expr {[info commands exec] != ""}]
-if {$tcl_platform(os) == "Win32s"} {
- puts "Cannot run multiple copies of tcl at the same time under Win32s"
- return
-}
-
set f [open printenv w]
puts $f {
proc lrem {listname name} {
@@ -67,18 +78,19 @@ puts $f {
lrem names ComSpec
lrem names ""
}
- foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH SHLIB_PATH} {
+ foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH } {
lrem names $name
}
foreach p $names {
puts "$p=$env($p)"
}
+ exit
}
close $f
proc getenv {} {
global printenv tcltest
- catch {exec $tcltest printenv} out
+ catch {exec $::tcltest::tcltest printenv} out
if {$out == "child process exited abnormally"} {
set out {}
}
@@ -95,51 +107,133 @@ foreach name [array names env] {
# Added the following lines so that child tcltest can actually find its
# library if the initial tcltest is run from a non-standard place.
# ('saved' env vars)
-foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH SHLIB_PATH} {
+foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH} {
if {[info exists env2($name)]} {
set env($name) $env2($name);
}
}
-test env-2.1 {adding environment variables} {
+test env-2.1 {adding environment variables} {execCommandExists} {
getenv
} {}
set env(NAME1) "test string"
-test env-2.2 {adding environment variables} {
+test env-2.2 {adding environment variables} {execCommandExists} {
getenv
} {NAME1=test string}
set env(NAME2) "more"
-test env-2.3 {adding environment variables} {
+test env-2.3 {adding environment variables} {execCommandExists} {
getenv
} {NAME1=test string
NAME2=more}
set env(XYZZY) "garbage"
-test env-2.4 {adding environment variables} {
+test env-2.4 {adding environment variables} {execCommandExists} {
getenv
} {NAME1=test string
NAME2=more
XYZZY=garbage}
set env(NAME2) "new value"
-test env-3.1 {changing environment variables} {
- getenv
+test env-3.1 {changing environment variables} {execCommandExists} {
+ set result [getenv]
+ unset env(NAME2)
+ set result
} {NAME1=test string
NAME2=new value
XYZZY=garbage}
-unset env(NAME2)
-test env-4.1 {unsetting environment variables} {
- getenv
+test env-4.1 {unsetting environment variables} {execCommandExists} {
+ set result [getenv]
+ unset env(NAME1)
+ set result
} {NAME1=test string
XYZZY=garbage}
-unset env(NAME1)
-test env-4.2 {unsetting environment variables} {
- getenv
+
+test env-4.2 {unsetting environment variables} {execCommandExists} {
+ set result [getenv]
+ unset env(XYZZY)
+ set result
} {XYZZY=garbage}
+test env-4.3 {setting international environment variables} {execCommandExists} {
+ set env(\ua7) \ub6
+ getenv
+} "\ua7=\ub6"
+test env-4.4 {changing international environment variables} {execCommandExists} {
+ set env(\ua7) \ua7
+ getenv
+} "\ua7=\ua7"
+test env-4.5 {unsetting international environment variables} {execCommandExists} {
+ set env(\ub6) \ua7
+ unset env(\ua7)
+ set result [getenv]
+ unset env(\ub6)
+ set result
+} "\ub6=\ua7"
+
+test env-5.0 {corner cases - set a value, it should exist} {} {
+ set env(temp) a
+ set result [set env(temp)]
+ unset env(temp)
+ set result
+} {a}
+test env-5.1 {corner cases - remove one elem at a time} {} {
+ # When no environment variables exist, the env var will
+ # contain no entries. The "array names" call synchs up
+ # the C-level environ array with the Tcl level env array.
+ # Make sure an empty Tcl array is created.
+
+ set x [array get env]
+ foreach e [array names env] {
+ unset env($e)
+ }
+ set result [catch {array names env}]
+ array set env $x
+ set result
+} {0}
+test env-5.2 {corner cases - unset the env array} {} {
+ # Unsetting a variable in an interp detaches the C-level
+ # traces from the Tcl "env" variable.
+
+ interp create i
+ i eval { unset env }
+ i eval { set env(THIS_SHOULDNT_EXIST) a}
+ set result [info exist env(THIS_SHOULDNT_EXIST)]
+ interp delete i
+ set result
+} {0}
+test env-5.3 {corner cases - unset the env in master should unset child} {} {
+ # Variables deleted in a master interp should be deleted in
+ # child interp too.
+
+ interp create i
+ i eval { set env(THIS_SHOULD_EXIST) a}
+ set result [set env(THIS_SHOULD_EXIST)]
+ unset env(THIS_SHOULD_EXIST)
+ lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
+ interp delete i
+ set result
+} {a 1}
+test env-5.4 {corner cases - unset the env array} {} {
+ # The info exist command should be in synch with the env array.
+ # Know Bug: 1737
+
+ interp create i
+ i eval { set env(THIS_SHOULD_EXIST) a}
+ set result [info exists env(THIS_SHOULD_EXIST)]
+ lappend result [set env(THIS_SHOULD_EXIST)]
+ lappend result [info exists env(THIS_SHOULD_EXIST)]
+ interp delete i
+ set result
+} {1 a 1}
+test env-5.5 {corner cases - cannot have null entries on Windows} {pcOnly} {
+ set env() a
+ catch {set env()}
+} {1}
+
+
# Restore the environment variables at the end of the test.
foreach name [array names env] {
@@ -149,4 +243,20 @@ foreach name [array names env2] {
set env($name) $env2($name)
}
+# cleanup
file delete printenv
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/error.test b/tcl/tests/error.test
index df8bb608f0d..6b2e5e302f1 100644
--- a/tcl/tests/error.test
+++ b/tcl/tests/error.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
proc foo {} {
global errorInfo
@@ -29,20 +33,20 @@ proc foo2 {} {
# Catch errors occurring in commands and errors from "error" command
test error-1.1 {simple errors from commands} {
- catch {format [string compare]} b
+ catch {format [string index]} b
} 1
test error-1.2 {simple errors from commands} {
- catch {format [string compare]} b
+ catch {format [string index]} b
set b
-} {wrong # args: should be "string compare string1 string2"}
+} {wrong # args: should be "string index string charIndex"}
test error-1.3 {simple errors from commands} {
- catch {format [string compare]} b
+ catch {format [string index]} b
set errorInfo
-} {wrong # args: should be "string compare string1 string2"
+} {wrong # args: should be "string index string charIndex"
while executing
-"string compare"}
+"string index"}
test error-1.4 {simple errors from commands} {
catch {error glorp} b
@@ -171,5 +175,8 @@ test error-6.1 {catch must reset error state} {
list $errorCode $errorInfo
} {NONE 1}
+# cleanup
catch {rename p ""}
-return ""
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/eval.test b/tcl/tests/eval.test
index 74064e6fdb8..1b417831de0 100644
--- a/tcl/tests/eval.test
+++ b/tcl/tests/eval.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test eval-1.1 {single argument} {
eval {format 22}
@@ -53,3 +57,20 @@ test eval-2.5 {error in eval'ed command: setting errorInfo} {
set a 1
error \"test error\"
}\""
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/event.test b/tcl/tests/event.test
index 3beb69d05e7..95b2c418322 100644
--- a/tcl/tests/event.test
+++ b/tcl/tests/event.test
@@ -4,148 +4,159 @@
# output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-if {[catch {testfilehandler create 0 off off}] == 0 } {
- test event-1.1 {Tcl_CreateFileHandler, reading} {
- testfilehandler close
- testfilehandler create 0 readable off
- testfilehandler clear 0
- testfilehandler oneevent
- set result ""
- lappend result [testfilehandler counts 0]
- testfilehandler fillpartial 0
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler close
- set result
- } {{0 0} {1 0} {2 0}}
- test event-1.2 {Tcl_CreateFileHandler, writing} {nonPortable} {
- # This test is non-portable because on some systems (e.g.
- # SunOS 4.1.3) pipes seem to be writable always.
- testfilehandler close
- testfilehandler create 0 off writable
- testfilehandler clear 0
- testfilehandler oneevent
- set result ""
- lappend result [testfilehandler counts 0]
- testfilehandler fillpartial 0
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler fill 0
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler close
- set result
- } {{0 1} {0 2} {0 2}}
- test event-1.3 {Tcl_DeleteFileHandler} {nonPortable} {
- testfilehandler close
- testfilehandler create 2 disabled disabled
- testfilehandler create 1 readable writable
- testfilehandler create 0 disabled disabled
- testfilehandler fillpartial 1
- set result ""
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler create 1 off off
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler close
- set result
- } {{0 1} {1 1} {1 2} {0 0}}
-
- test event-2.1 {Tcl_DeleteFileHandler} {nonPortable} {
- testfilehandler close
- testfilehandler create 2 disabled disabled
- testfilehandler create 1 readable writable
- testfilehandler fillpartial 1
- set result ""
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler create 1 off off
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler close
- set result
- } {{0 1} {1 1} {1 2} {0 0}}
- test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} {nonPortable} {
- testfilehandler close
- testfilehandler create 0 readable writable
- testfilehandler fillpartial 0
- set result ""
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler close
- testfilehandler create 0 readable writable
- testfilehandler oneevent
- lappend result [testfilehandler counts 0]
- testfilehandler close
- set result
- } {{0 1} {0 0}}
-
- test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {
- testfilehandler close
- testfilehandler create 1 readable writable
- testfilehandler fillpartial 1
- testfilehandler windowevent
- set result [testfilehandler counts 1]
- testfilehandler close
- set result
- } {0 0}
-
- test event-4.1 {FileHandlerEventProc, race between event and disabling} {nonPortable} {
- update
- testfilehandler close
- testfilehandler create 2 disabled disabled
- testfilehandler create 1 readable writable
- testfilehandler fillpartial 1
- set result ""
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler create 1 disabled disabled
- testfilehandler oneevent
- lappend result [testfilehandler counts 1]
- testfilehandler close
- set result
- } {{0 1} {1 1} {1 2} {0 0}}
- test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} {nonPortable} {
- update
- testfilehandler close
- testfilehandler create 1 readable writable
- testfilehandler create 2 readable writable
- testfilehandler fillpartial 1
- testfilehandler fillpartial 2
- testfilehandler oneevent
- set result ""
- lappend result [testfilehandler counts 1] [testfilehandler counts 2]
- testfilehandler windowevent
- lappend result [testfilehandler counts 1] [testfilehandler counts 2]
- testfilehandler close
- set result
- } {{0 0} {0 1} {0 0} {0 1}}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+set ::tcltest::testConstraints(testfilehandler) \
+ [expr {[info commands testfilehandler] != {}}]
+set ::tcltest::testConstraints(testexithandler) \
+ [expr {[info commands testexithandler] != {}}]
+set ::tcltest::testConstraints(testfilewait) \
+ [expr {[info commands testfilewait] != {}}]
+
+test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
+ testfilehandler close
+ testfilehandler create 0 readable off
+ testfilehandler clear 0
+ testfilehandler oneevent
+ set result ""
+ lappend result [testfilehandler counts 0]
+ testfilehandler fillpartial 0
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 0]
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 0]
+ testfilehandler close
+ set result
+} {{0 0} {1 0} {2 0}}
+test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
+ # This test is non-portable because on some systems (e.g.
+ # SunOS 4.1.3) pipes seem to be writable always.
+ testfilehandler close
+ testfilehandler create 0 off writable
+ testfilehandler clear 0
+ testfilehandler oneevent
+ set result ""
+ lappend result [testfilehandler counts 0]
+ testfilehandler fillpartial 0
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 0]
+ testfilehandler fill 0
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 0]
+ testfilehandler close
+ set result
+} {{0 1} {0 2} {0 2}}
+test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
+ testfilehandler close
+ testfilehandler create 2 disabled disabled
+ testfilehandler create 1 readable writable
+ testfilehandler create 0 disabled disabled
+ testfilehandler fillpartial 1
+ set result ""
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler create 1 off off
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler close
+ set result
+} {{0 1} {1 1} {1 2} {0 0}}
+
+test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
+ testfilehandler close
+ testfilehandler create 2 disabled disabled
+ testfilehandler create 1 readable writable
+ testfilehandler fillpartial 1
+ set result ""
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler create 1 off off
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
testfilehandler close
+ set result
+} {{0 1} {1 1} {1 2} {0 0}}
+test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
+ {testfilehandler nonPortable} {
+ testfilehandler close
+ testfilehandler create 0 readable writable
+ testfilehandler fillpartial 0
+ set result ""
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 0]
+ testfilehandler close
+ testfilehandler create 0 readable writable
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 0]
+ testfilehandler close
+ set result
+} {{0 1} {0 0}}
+
+test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} {
+ testfilehandler close
+ testfilehandler create 1 readable writable
+ testfilehandler fillpartial 1
+ testfilehandler windowevent
+ set result [testfilehandler counts 1]
+ testfilehandler close
+ set result
+} {0 0}
+
+test event-4.1 {FileHandlerEventProc, race between event and disabling} \
+ {testfilehandler nonPortable} {
update
-}
+ testfilehandler close
+ testfilehandler create 2 disabled disabled
+ testfilehandler create 1 readable writable
+ testfilehandler fillpartial 1
+ set result ""
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler create 1 disabled disabled
+ testfilehandler oneevent
+ lappend result [testfilehandler counts 1]
+ testfilehandler close
+ set result
+} {{0 1} {1 1} {1 2} {0 0}}
+test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
+ {testfilehandler nonPortable} {
+ update
+ testfilehandler close
+ testfilehandler create 1 readable writable
+ testfilehandler create 2 readable writable
+ testfilehandler fillpartial 1
+ testfilehandler fillpartial 2
+ testfilehandler oneevent
+ set result ""
+ lappend result [testfilehandler counts 1] [testfilehandler counts 2]
+ testfilehandler windowevent
+ lappend result [testfilehandler counts 1] [testfilehandler counts 2]
+ testfilehandler close
+ set result
+} {{0 0} {0 1} {0 0} {0 1}}
+update
test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
catch {rename bgerror {}}
@@ -275,69 +286,67 @@ test event-7.4 {tkerror is nothing special anymore to tcl} {
catch {rename bgerror {}}
-if {[info commands testexithandler] != ""} {
- test event-8.1 {Tcl_CreateExitHandler procedure} {stdio} {
- set child [open |[list [info nameofexecutable]] r+]
- puts $child "testexithandler create 41; testexithandler create 4"
- puts $child "testexithandler create 6; exit"
- flush $child
- set result [read $child]
- close $child
- set result
- } {even 6
+test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
+ set child [open |[list [info nameofexecutable]] r+]
+ puts $child "testexithandler create 41; testexithandler create 4"
+ puts $child "testexithandler create 6; exit"
+ flush $child
+ set result [read $child]
+ close $child
+ set result
+} {even 6
even 4
odd 41
}
- test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio} {
- set child [open |[list [info nameofexecutable]] r+]
- puts $child "testexithandler create 41; testexithandler create 4"
- puts $child "testexithandler create 6; testexithandler delete 41"
- puts $child "testexithandler create 16; exit"
- flush $child
- set result [read $child]
- close $child
- set result
- } {even 16
+test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
+ set child [open |[list [info nameofexecutable]] r+]
+ puts $child "testexithandler create 41; testexithandler create 4"
+ puts $child "testexithandler create 6; testexithandler delete 41"
+ puts $child "testexithandler create 16; exit"
+ flush $child
+ set result [read $child]
+ close $child
+ set result
+} {even 16
even 6
even 4
}
- test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio} {
- set child [open |[list [info nameofexecutable]] r+]
- puts $child "testexithandler create 41; testexithandler create 4"
- puts $child "testexithandler create 6; testexithandler delete 4"
- puts $child "testexithandler create 16; exit"
- flush $child
- set result [read $child]
- close $child
- set result
+test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
+ set child [open |[list [info nameofexecutable]] r+]
+ puts $child "testexithandler create 41; testexithandler create 4"
+ puts $child "testexithandler create 6; testexithandler delete 4"
+ puts $child "testexithandler create 16; exit"
+ flush $child
+ set result [read $child]
+ close $child
+ set result
} {even 16
even 6
odd 41
}
- test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio} {
- set child [open |[list [info nameofexecutable]] r+]
- puts $child "testexithandler create 41; testexithandler create 4"
- puts $child "testexithandler create 6; testexithandler delete 6"
- puts $child "testexithandler create 16; exit"
- flush $child
- set result [read $child]
- close $child
- set result
- } {even 16
+test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
+ set child [open |[list [info nameofexecutable]] r+]
+ puts $child "testexithandler create 41; testexithandler create 4"
+ puts $child "testexithandler create 6; testexithandler delete 6"
+ puts $child "testexithandler create 16; exit"
+ flush $child
+ set result [read $child]
+ close $child
+ set result
+} {even 16
even 4
odd 41
}
- test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio} {
- set child [open |[list [info nameofexecutable]] r+]
- puts $child "testexithandler create 41; testexithandler delete 41"
- puts $child "testexithandler create 16; exit"
- flush $child
- set result [read $child]
- close $child
- set result
- } {even 16
-}
+test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
+ set child [open |[list [info nameofexecutable]] r+]
+ puts $child "testexithandler create 41; testexithandler delete 41"
+ puts $child "testexithandler create 16; exit"
+ flush $child
+ set result [read $child]
+ close $child
+ set result
+} {even 16
}
test event-10.1 {Tcl_Exit procedure} {stdio} {
@@ -358,7 +367,7 @@ test event-11.3 {Tcl_VwaitCmd procedure} {
set x 1
list [catch {vwait x(1)} msg] $msg
} {1 {can't trace "x(1)": variable isn't array}}
-test event-11.4 {Tcl_VwaitCmd procedure} {
+test event-11.4 {Tcl_VwaitCmd procedure} {} {
foreach i [after info] {
after cancel $i
}
@@ -384,8 +393,9 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc
puts $s foobar
close $s
}
- set s1 [socket -server accept 5001]
- set s2 [socket 127.0.0.1 5001]
+ catch {set s1 [socket -server accept 5001]}
+ after 1000
+ catch {set s2 [socket 127.0.0.1 5001]}
close $s1
set x 0
set y 0
@@ -453,115 +463,129 @@ test event-12.4 {Tcl_UpdateCmd procedure} {
list $x $y $z
} {x-done before z-done}
-if {[info commands testfilehandler] != ""} {
- test event-13.1 {Tcl_WaitForFile procedure, readable} unixOnly {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 readable 0]
- update
- testfilehandler close
- list $result $x
- } {{} {no timeout}}
- test event-13.2 {Tcl_WaitForFile procedure, readable} unixOnly {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 readable 100]
- update
- testfilehandler close
- list $result $x
- } {{} timeout}
- test event-13.3 {Tcl_WaitForFile procedure, readable} unixOnly {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fillpartial 1
- set x "no timeout"
- set result [testfilehandler wait 1 readable 100]
- update
- testfilehandler close
- list $result $x
- } {readable {no timeout}}
- test event-13.4 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fill 1
- set x "no timeout"
- set result [testfilehandler wait 1 writable 0]
- update
- testfilehandler close
- list $result $x
- } {{} {no timeout}}
- test event-13.5 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- testfilehandler fill 1
- set x "no timeout"
- set result [testfilehandler wait 1 writable 100]
- update
- testfilehandler close
- list $result $x
- } {{} timeout}
- test event-13.6 {Tcl_WaitForFile procedure, writable} unixOnly {
- foreach i [after info] {
- after cancel $i
- }
- after 100 set x timeout
- testfilehandler close
- testfilehandler create 1 off off
- set x "no timeout"
- set result [testfilehandler wait 1 writable 100]
- update
- testfilehandler close
- list $result $x
- } {writable {no timeout}}
- test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} unixOnly {
- foreach i [after info] {
- after cancel $i
- }
- after 100 lappend x timeout
- after idle lappend x idle
- testfilehandler close
- testfilehandler create 1 off off
- set x ""
- set result [list [testfilehandler wait 1 readable 200] $x]
- update
- testfilehandler close
- lappend result $x
- } {{} {} {timeout idle}}
-}
+test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 100 set x timeout
+ testfilehandler close
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 0]
+ update
+ testfilehandler close
+ list $result $x
+} {{} {no timeout}}
+test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 100 set x timeout
+ testfilehandler close
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 100]
+ update
+ testfilehandler close
+ list $result $x
+} {{} timeout}
+test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 100 set x timeout
+ testfilehandler close
+ testfilehandler create 1 off off
+ testfilehandler fillpartial 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 readable 100]
+ update
+ testfilehandler close
+ list $result $x
+} {readable {no timeout}}
+test event-13.4 {Tcl_WaitForFile procedure, writable} \
+ {testfilehandler nonPortable} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 100 set x timeout
+ testfilehandler close
+ testfilehandler create 1 off off
+ testfilehandler fill 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 0]
+ update
+ testfilehandler close
+ list $result $x
+} {{} {no timeout}}
+test event-13.5 {Tcl_WaitForFile procedure, writable} \
+ {testfilehandler nonPortable} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 100 set x timeout
+ testfilehandler close
+ testfilehandler create 1 off off
+ testfilehandler fill 1
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 100]
+ update
+ testfilehandler close
+ list $result $x
+} {{} timeout}
+test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 100 set x timeout
+ testfilehandler close
+ testfilehandler create 1 off off
+ set x "no timeout"
+ set result [testfilehandler wait 1 writable 100]
+ update
+ testfilehandler close
+ list $result $x
+} {writable {no timeout}}
+test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
+ foreach i [after info] {
+ after cancel $i
+ }
+ after 100 lappend x timeout
+ after idle lappend x idle
+ testfilehandler close
+ testfilehandler create 1 off off
+ set x ""
+ set result [list [testfilehandler wait 1 readable 200] $x]
+ update
+ testfilehandler close
+ lappend result $x
+} {{} {} {timeout idle}}
-if {[info commands testfilewait] != ""} {
- test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} unixOnly {
- set f [open "|sleep 2" r]
- set result ""
- lappend result [testfilewait $f readable 100]
- lappend result [testfilewait $f readable -1]
- close $f
- set result
- } {{} readable}
-}
+test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
+ set f [open "|sleep 2" r]
+ set result ""
+ lappend result [testfilewait $f readable 100]
+ lappend result [testfilewait $f readable -1]
+ close $f
+ set result
+} {{} readable}
+# cleanup
foreach i [after info] {
after cancel $i
}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/exec.test b/tcl/tests/exec.test
index c82b0de289d..f77710fe310 100644
--- a/tcl/tests/exec.test
+++ b/tcl/tests/exec.test
@@ -6,24 +6,22 @@
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-# If exec is not defined just return with no error
-# Some platforms like the Macintosh do not have the exec command
-if {[info commands exec] == ""} {
- puts "exec not implemented for this machine"
- return
-}
-if {$testConfig(stdio) == 0} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
+# All tests require the "exec" command.
+# Skip them if exec is not defined.
+set ::tcltest::testConstraints(execCommandExists) [expr {[info commands exec] != ""}]
+
set f [open echo w]
puts $f {
puts -nonewline [lindex $argv 0]
@@ -31,6 +29,7 @@ puts $f {
puts -nonewline " $str"
}
puts {}
+ exit
}
close $f
@@ -53,6 +52,7 @@ puts $f {
close $f
}
}
+ exit
}
close $f
@@ -63,6 +63,7 @@ puts $f {
set words [regsub -all "\[^ \t\n]+" $data {} dummy]
set chars [string length $data]
puts [format "%8.d%8.d%8.d" $lines $words $chars]
+ exit
}
close $f
@@ -87,12 +88,14 @@ puts $f {
}
lappend newcmd $arg
}
+ exit
}
close $f
set f [open sleep w]
puts $f {
after [expr $argv*1000]
+ exit
}
close $f
@@ -104,171 +107,178 @@ close $f
# Basic operations.
-test exec-1.1 {basic exec operation} {
- exec $tcltest echo a b c
+test exec-1.1 {basic exec operation} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo a b c
} "a b c"
-test exec-1.2 {pipelining} {
- exec $tcltest echo a b c d | $tcltest cat | $tcltest cat
+test exec-1.2 {pipelining} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo a b c d | $::tcltest::tcltest cat | $::tcltest::tcltest cat
} "a b c d"
-test exec-1.3 {pipelining} {
- set a [exec $tcltest echo a b c d | $tcltest cat | $tcltest wc]
+test exec-1.3 {pipelining} {execCommandExists stdio} {
+ set a [exec $::tcltest::tcltest echo a b c d | $::tcltest::tcltest cat | $::tcltest::tcltest wc]
list [scan $a "%d %d %d" b c d] $b $c
} {3 1 4}
set arg {12345678901234567890123456789012345678901234567890}
set arg "$arg$arg$arg$arg$arg$arg"
-test exec-1.4 {long command lines} {
- exec $tcltest echo $arg
+test exec-1.4 {long command lines} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo $arg
} $arg
set arg {}
# I/O redirection: input from Tcl command.
-test exec-2.1 {redirecting input from immediate source} {
- exec $tcltest cat << "Sample text"
+test exec-2.1 {redirecting input from immediate source} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat << "Sample text"
} {Sample text}
-test exec-2.2 {redirecting input from immediate source} {
- exec << "Sample text" $tcltest cat | $tcltest cat
+test exec-2.2 {redirecting input from immediate source} {execCommandExists stdio} {
+ exec << "Sample text" $::tcltest::tcltest cat | $::tcltest::tcltest cat
} {Sample text}
-test exec-2.3 {redirecting input from immediate source} {
- exec $tcltest cat << "Sample text" | $tcltest cat
+test exec-2.3 {redirecting input from immediate source} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat << "Sample text" | $::tcltest::tcltest cat
} {Sample text}
-test exec-2.4 {redirecting input from immediate source} {
- exec $tcltest cat | $tcltest cat << "Sample text"
+test exec-2.4 {redirecting input from immediate source} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat | $::tcltest::tcltest cat << "Sample text"
} {Sample text}
-test exec-2.5 {redirecting input from immediate source} {
- exec $tcltest cat "<<Joined to arrows"
+test exec-2.5 {redirecting input from immediate source} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat "<<Joined to arrows"
} {Joined to arrows}
+test exec-2.6 {redirecting input from immediate source, with UTF} {execCommandExists stdio} {
+ # If this fails, it may give back:
+ # "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
+ # If it does, this means that the UTF -> external conversion did not
+ # occur before writing out the temp file.
+ exec $::tcltest::tcltest cat << "\uE9\uE0\uFC\uF1"
+} "\uE9\uE0\uFC\uF1"
# I/O redirection: output to file.
file delete gorp.file
-test exec-3.1 {redirecting output to file} {
- exec $tcltest echo "Some simple words" > gorp.file
- exec $tcltest cat gorp.file
+test exec-3.1 {redirecting output to file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "Some simple words" > gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} "Some simple words"
-test exec-3.2 {redirecting output to file} {
- exec $tcltest echo "More simple words" | >gorp.file $tcltest cat | $tcltest cat
- exec $tcltest cat gorp.file
+test exec-3.2 {redirecting output to file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "More simple words" | >gorp.file $::tcltest::tcltest cat | $::tcltest::tcltest cat
+ exec $::tcltest::tcltest cat gorp.file
} "More simple words"
-test exec-3.3 {redirecting output to file} {
- exec > gorp.file $tcltest echo "Different simple words" | $tcltest cat | $tcltest cat
- exec $tcltest cat gorp.file
+test exec-3.3 {redirecting output to file} {execCommandExists stdio} {
+ exec > gorp.file $::tcltest::tcltest echo "Different simple words" | $::tcltest::tcltest cat | $::tcltest::tcltest cat
+ exec $::tcltest::tcltest cat gorp.file
} "Different simple words"
-test exec-3.4 {redirecting output to file} {
- exec $tcltest echo "Some simple words" >gorp.file
- exec $tcltest cat gorp.file
+test exec-3.4 {redirecting output to file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "Some simple words" >gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} "Some simple words"
-test exec-3.5 {redirecting output to file} {
- exec $tcltest echo "First line" >gorp.file
- exec $tcltest echo "Second line" >> gorp.file
- exec $tcltest cat gorp.file
+test exec-3.5 {redirecting output to file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "First line" >gorp.file
+ exec $::tcltest::tcltest echo "Second line" >> gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} "First line\nSecond line"
-test exec-3.6 {redirecting output to file} {
- exec $tcltest echo "First line" >gorp.file
- exec $tcltest echo "Second line" >>gorp.file
- exec $tcltest cat gorp.file
+test exec-3.6 {redirecting output to file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "First line" >gorp.file
+ exec $::tcltest::tcltest echo "Second line" >>gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} "First line\nSecond line"
-test exec-3.7 {redirecting output to file} {
+test exec-3.7 {redirecting output to file} {execCommandExists stdio} {
set f [open gorp.file w]
puts $f "Line 1"
flush $f
- exec $tcltest echo "More text" >@ $f
- exec $tcltest echo >@$f "Even more"
+ exec $::tcltest::tcltest echo "More text" >@ $f
+ exec $::tcltest::tcltest echo >@$f "Even more"
puts $f "Line 3"
close $f
- exec $tcltest cat gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} "Line 1\nMore text\nEven more\nLine 3"
# I/O redirection: output and stderr to file.
file delete gorp.file
-test exec-4.1 {redirecting output and stderr to file} {
- exec $tcltest echo "test output" >& gorp.file
- exec $tcltest cat gorp.file
+test exec-4.1 {redirecting output and stderr to file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "test output" >& gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} "test output"
-test exec-4.2 {redirecting output and stderr to file} {
- list [exec $tcltest sh -c "echo foo bar 1>&2" >&gorp.file] \
- [exec $tcltest cat gorp.file]
+test exec-4.2 {redirecting output and stderr to file} {execCommandExists stdio} {
+ list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" >&gorp.file] \
+ [exec $::tcltest::tcltest cat gorp.file]
} {{} {foo bar}}
-test exec-4.3 {redirecting output and stderr to file} {
- exec $tcltest echo "first line" > gorp.file
- list [exec $tcltest sh -c "echo foo bar 1>&2" >>&gorp.file] \
- [exec $tcltest cat gorp.file]
+test exec-4.3 {redirecting output and stderr to file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "first line" > gorp.file
+ list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" >>&gorp.file] \
+ [exec $::tcltest::tcltest cat gorp.file]
} "{} {first line\nfoo bar}"
-test exec-4.4 {redirecting output and stderr to file} {
+test exec-4.4 {redirecting output and stderr to file} {execCommandExists stdio} {
set f [open gorp.file w]
puts $f "Line 1"
flush $f
- exec $tcltest echo "More text" >&@ $f
- exec $tcltest echo >&@$f "Even more"
+ exec $::tcltest::tcltest echo "More text" >&@ $f
+ exec $::tcltest::tcltest echo >&@$f "Even more"
puts $f "Line 3"
close $f
- exec $tcltest cat gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} "Line 1\nMore text\nEven more\nLine 3"
-test exec-4.5 {redirecting output and stderr to file} {
+test exec-4.5 {redirecting output and stderr to file} {execCommandExists stdio} {
set f [open gorp.file w]
puts $f "Line 1"
flush $f
- exec >&@ $f $tcltest sh -c "echo foo bar 1>&2"
- exec >&@$f $tcltest sh -c "echo xyzzy 1>&2"
+ exec >&@ $f $::tcltest::tcltest sh -c "echo foo bar 1>&2"
+ exec >&@$f $::tcltest::tcltest sh -c "echo xyzzy 1>&2"
puts $f "Line 3"
close $f
- exec $tcltest cat gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} "Line 1\nfoo bar\nxyzzy\nLine 3"
# I/O redirection: input from file.
-exec $tcltest echo "Just a few thoughts" > gorp.file
-test exec-5.1 {redirecting input from file} {
- exec $tcltest cat < gorp.file
+exec $::tcltest::tcltest echo "Just a few thoughts" > gorp.file
+test exec-5.1 {redirecting input from file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat < gorp.file
} {Just a few thoughts}
-test exec-5.2 {redirecting input from file} {
- exec $tcltest cat | $tcltest cat < gorp.file
+test exec-5.2 {redirecting input from file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat | $::tcltest::tcltest cat < gorp.file
} {Just a few thoughts}
-test exec-5.3 {redirecting input from file} {
- exec $tcltest cat < gorp.file | $tcltest cat
+test exec-5.3 {redirecting input from file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat < gorp.file | $::tcltest::tcltest cat
} {Just a few thoughts}
-test exec-5.4 {redirecting input from file} {
- exec < gorp.file $tcltest cat | $tcltest cat
+test exec-5.4 {redirecting input from file} {execCommandExists stdio} {
+ exec < gorp.file $::tcltest::tcltest cat | $::tcltest::tcltest cat
} {Just a few thoughts}
-test exec-5.5 {redirecting input from file} {
- exec $tcltest cat <gorp.file
+test exec-5.5 {redirecting input from file} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat <gorp.file
} {Just a few thoughts}
-test exec-5.6 {redirecting input from file} {
+test exec-5.6 {redirecting input from file} {execCommandExists stdio} {
set f [open gorp.file r]
- set result [exec $tcltest cat <@ $f]
+ set result [exec $::tcltest::tcltest cat <@ $f]
close $f
set result
} {Just a few thoughts}
-test exec-5.7 {redirecting input from file} {
+test exec-5.7 {redirecting input from file} {execCommandExists stdio} {
set f [open gorp.file r]
- set result [exec <@$f $tcltest cat]
+ set result [exec <@$f $::tcltest::tcltest cat]
close $f
set result
} {Just a few thoughts}
# I/O redirection: standard error through a pipeline.
-test exec-6.1 {redirecting stderr through a pipeline} {
- exec $tcltest sh -c "echo foo bar" |& $tcltest cat
+test exec-6.1 {redirecting stderr through a pipeline} {execCommandExists stdio} {
+ exec $::tcltest::tcltest sh -c "echo foo bar" |& $::tcltest::tcltest cat
} "foo bar"
-test exec-6.2 {redirecting stderr through a pipeline} {
- exec $tcltest sh -c "echo foo bar 1>&2" |& $tcltest cat
+test exec-6.2 {redirecting stderr through a pipeline} {execCommandExists stdio} {
+ exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" |& $::tcltest::tcltest cat
} "foo bar"
-test exec-6.3 {redirecting stderr through a pipeline} {
- exec $tcltest sh -c "echo foo bar 1>&2" \
- |& $tcltest sh -c "echo second msg 1>&2 ; cat" |& $tcltest cat
+test exec-6.3 {redirecting stderr through a pipeline} {execCommandExists stdio} {
+ exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \
+ |& $::tcltest::tcltest sh -c "echo second msg 1>&2 ; cat" |& $::tcltest::tcltest cat
} "second msg\nfoo bar"
# I/O redirection: combinations.
-catch {exec rm -f gorp.file2}
-test exec-7.1 {multiple I/O redirections} {
- exec << "command input" > gorp.file2 $tcltest cat < gorp.file
- exec $tcltest cat gorp.file2
+file delete gorp.file2
+test exec-7.1 {multiple I/O redirections} {execCommandExists stdio} {
+ exec << "command input" > gorp.file2 $::tcltest::tcltest cat < gorp.file
+ exec $::tcltest::tcltest cat gorp.file2
} {Just a few thoughts}
-test exec-7.2 {multiple I/O redirections} {
- exec < gorp.file << "command input" $tcltest cat
+test exec-7.2 {multiple I/O redirections} {execCommandExists stdio} {
+ exec < gorp.file << "command input" $::tcltest::tcltest cat
} {command input}
# Long input to command and output from command.
@@ -278,136 +288,153 @@ set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
-test exec-8.1 {long input and output} {
- exec $tcltest cat << $a
+test exec-8.1 {long input and output} {execCommandExists stdio} {
+ exec $::tcltest::tcltest cat << $a
} $a
+# More than 20 arguments to exec.
+
+test exec-8.1 {long input and output} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
+} {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23}
+
# Commands that return errors.
-test exec-9.1 {commands returning errors} {
+test exec-9.1 {commands returning errors} {execCommandExists stdio} {
set x [catch {exec gorp456} msg]
list $x [string tolower $msg] [string tolower $errorCode]
} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.2 {commands returning errors} {
- string tolower [list [catch {exec $tcltest echo foo | foo123} msg] $msg $errorCode]
+test exec-9.2 {commands returning errors} {execCommandExists stdio} {
+ string tolower [list [catch {exec $::tcltest::tcltest echo foo | foo123} msg] $msg $errorCode]
} {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.3 {commands returning errors} {
- list [catch {exec $tcltest sleep 1 | $tcltest exit 43 | $tcltest sleep 1} msg] $msg
+test exec-9.3 {commands returning errors} {execCommandExists stdio} {
+ list [catch {exec $::tcltest::tcltest sleep 1 | $::tcltest::tcltest exit 43 | $::tcltest::tcltest sleep 1} msg] $msg
} {1 {child process exited abnormally}}
-test exec-9.4 {commands returning errors} {
- list [catch {exec $tcltest exit 43 | $tcltest echo "foo bar"} msg] $msg
+test exec-9.4 {commands returning errors} {execCommandExists stdio} {
+ list [catch {exec $::tcltest::tcltest exit 43 | $::tcltest::tcltest echo "foo bar"} msg] $msg
} {1 {foo bar
child process exited abnormally}}
-test exec-9.5 {commands returning errors} {
- list [catch {exec gorp456 | $tcltest echo a b c} msg] [string tolower $msg]
+test exec-9.5 {commands returning errors} {execCommandExists stdio} {
+ list [catch {exec gorp456 | $::tcltest::tcltest echo a b c} msg] [string tolower $msg]
} {1 {couldn't execute "gorp456": no such file or directory}}
-test exec-9.6 {commands returning errors} {
- list [catch {exec $tcltest sh -c "echo error msg 1>&2"} msg] $msg
+test exec-9.6 {commands returning errors} {execCommandExists stdio} {
+ list [catch {exec $::tcltest::tcltest sh -c "echo error msg 1>&2"} msg] $msg
} {1 {error msg}}
-test exec-9.7 {commands returning errors} {
- list [catch {exec $tcltest sh -c "echo error msg 1>&2" \
- | $tcltest sh -c "echo error msg 1>&2"} msg] $msg
+test exec-9.7 {commands returning errors} {execCommandExists stdio} {
+ list [catch {exec $::tcltest::tcltest sh -c "echo error msg 1>&2" \
+ | $::tcltest::tcltest sh -c "echo error msg 1>&2"} msg] $msg
} {1 {error msg
error msg}}
+test exec-9.8 {commands returning errors} {execCommandExists stdio} {
+ set f [open err w]
+ puts $f {
+ puts stdout out
+ puts stderr err
+ }
+ close $f
+ list [catch {exec $::tcltest::tcltest err} msg] $msg
+} {1 {out
+err}}
# Errors in executing the Tcl command, as opposed to errors in the
# processes that are invoked.
-test exec-10.1 {errors in exec invocation} {
+test exec-10.1 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec} msg] $msg
} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
-test exec-10.2 {errors in exec invocation} {
+test exec-10.2 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec | cat} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.3 {errors in exec invocation} {
+test exec-10.3 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat |} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.4 {errors in exec invocation} {
+test exec-10.4 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat | | cat} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.5 {errors in exec invocation} {
+test exec-10.5 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat | |& cat} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.6 {errors in exec invocation} {
+test exec-10.6 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat |&} msg] $msg
} {1 {illegal use of | or |& in command}}
-test exec-10.7 {errors in exec invocation} {
+test exec-10.7 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat <} msg] $msg
} {1 {can't specify "<" as last word in command}}
-test exec-10.8 {errors in exec invocation} {
+test exec-10.8 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat >} msg] $msg
} {1 {can't specify ">" as last word in command}}
-test exec-10.9 {errors in exec invocation} {
+test exec-10.9 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat <<} msg] $msg
} {1 {can't specify "<<" as last word in command}}
-test exec-10.10 {errors in exec invocation} {
+test exec-10.10 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat >>} msg] $msg
} {1 {can't specify ">>" as last word in command}}
-test exec-10.11 {errors in exec invocation} {
+test exec-10.11 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat >&} msg] $msg
} {1 {can't specify ">&" as last word in command}}
-test exec-10.12 {errors in exec invocation} {
+test exec-10.12 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat >>&} msg] $msg
} {1 {can't specify ">>&" as last word in command}}
-test exec-10.13 {errors in exec invocation} {
+test exec-10.13 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat >@} msg] $msg
} {1 {can't specify ">@" as last word in command}}
-test exec-10.14 {errors in exec invocation} {
+test exec-10.14 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat <@} msg] $msg
} {1 {can't specify "<@" as last word in command}}
-test exec-10.15 {errors in exec invocation} {
+test exec-10.15 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat < a/b/c} msg] [string tolower $msg]
} {1 {couldn't read file "a/b/c": no such file or directory}}
-test exec-10.16 {errors in exec invocation} {
+test exec-10.16 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
} {1 {couldn't write file "a/b/c": no such file or directory}}
-test exec-10.17 {errors in exec invocation} {
+test exec-10.17 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
} {1 {couldn't write file "a/b/c": no such file or directory}}
set f [open gorp.file w]
-test exec-10.18 {errors in exec invocation} {
+test exec-10.18 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat <@ $f} msg] $msg
} "1 {channel \"$f\" wasn't opened for reading}"
close $f
set f [open gorp.file r]
-test exec-10.19 {errors in exec invocation} {
+test exec-10.19 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec cat >@ $f} msg] $msg
} "1 {channel \"$f\" wasn't opened for writing}"
close $f
-test exec-10.20 {errors in exec invocation} {
+test exec-10.20 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec ~non_existent_user/foo/bar} msg] $msg
} {1 {user "non_existent_user" doesn't exist}}
-test exec-10.21 {errors in exec invocation} {
- list [catch {exec $tcltest true | ~xyzzy_bad_user/x | false} msg] $msg
+test exec-10.21 {errors in exec invocation} {execCommandExists stdio} {
+ list [catch {exec $::tcltest::tcltest true | ~xyzzy_bad_user/x | false} msg] $msg
} {1 {user "xyzzy_bad_user" doesn't exist}}
# Commands in background.
-test exec-11.1 {commands in background} {
- set x [lindex [time {exec $tcltest sleep 2 &}] 0]
+test exec-11.1 {commands in background} {execCommandExists stdio} {
+ set x [lindex [time {exec $::tcltest::tcltest sleep 2 &}] 0]
expr $x<1000000
} 1
-test exec-11.2 {commands in background} {
- list [catch {exec $tcltest echo a &b} msg] $msg
+test exec-11.2 {commands in background} {execCommandExists stdio} {
+ list [catch {exec $::tcltest::tcltest echo a &b} msg] $msg
} {0 {a &b}}
-test exec-11.3 {commands in background} {
- llength [exec $tcltest sleep 1 &]
+test exec-11.3 {commands in background} {execCommandExists stdio} {
+ llength [exec $::tcltest::tcltest sleep 1 &]
} 1
-test exec-11.4 {commands in background} {
- llength [exec $tcltest sleep 1 | $tcltest sleep 1 | $tcltest sleep 1 &]
+test exec-11.4 {commands in background} {execCommandExists stdio} {
+ llength [exec $::tcltest::tcltest sleep 1 | $::tcltest::tcltest sleep 1 | $::tcltest::tcltest sleep 1 &]
} 3
-test exec-11.5 {commands in background} {
+test exec-11.5 {commands in background} {execCommandExists stdio} {
set f [open gorp.file w]
puts $f { catch { exec [info nameofexecutable] echo foo & } }
close $f
- string compare "foo" [exec $tcltest gorp.file]
+ string compare "foo" [exec $::tcltest::tcltest gorp.file]
} 0
# Make sure that background commands are properly reaped when
# they eventually die.
-exec $tcltest sleep 3
-test exec-12.1 {reaping background processes} {unixOnly nonPortable} {
+exec $::tcltest::tcltest sleep 3
+test exec-12.1 {reaping background processes} \
+ {execCommandExists stdio unixOnly nonPortable} {
for {set i 0} {$i < 20} {incr i} {
exec echo foo > /dev/null &
}
@@ -415,7 +442,8 @@ test exec-12.1 {reaping background processes} {unixOnly nonPortable} {
catch {exec ps | fgrep "echo foo" | fgrep -v fgrep | wc} msg
lindex $msg 0
} 0
-test exec-12.2 {reaping background processes} {unixOnly nonPortable} {
+test exec-12.2 {reaping background processes} \
+ {execCommandExists stdio unixOnly nonPortable} {
exec sleep 2 | sleep 2 | sleep 2 &
catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
set x [lindex $msg 0]
@@ -423,7 +451,8 @@ test exec-12.2 {reaping background processes} {unixOnly nonPortable} {
catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
list $x [lindex $msg 0]
} {3 0}
-test exec-12.3 {reaping background processes} {unixOnly nonPortable} {
+test exec-12.3 {reaping background processes} \
+ {execCommandExists stdio unixOnly nonPortable} {
exec sleep 1000 &
exec sleep 1000 &
set x [exec ps | fgrep "sleep" | fgrep -v fgrep]
@@ -446,13 +475,13 @@ test exec-12.3 {reaping background processes} {unixOnly nonPortable} {
# Make sure "errorCode" is set correctly.
-test exec-13.1 {setting errorCode variable} {
- list [catch {exec $tcltest cat < a/b/c} msg] [string tolower $errorCode]
+test exec-13.1 {setting errorCode variable} {execCommandExists stdio} {
+ list [catch {exec $::tcltest::tcltest cat < a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
-test exec-13.2 {setting errorCode variable} {
- list [catch {exec $tcltest cat > a/b/c} msg] [string tolower $errorCode]
+test exec-13.2 {setting errorCode variable} {execCommandExists stdio} {
+ list [catch {exec $::tcltest::tcltest cat > a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
-test exec-13.3 {setting errorCode variable} {
+test exec-13.3 {setting errorCode variable} {execCommandExists stdio} {
set x [catch {exec _weird_cmd_} msg]
list $x [string tolower $msg] [lindex $errorCode 0] \
[string tolower [lrange $errorCode 2 end]]
@@ -460,83 +489,83 @@ test exec-13.3 {setting errorCode variable} {
# Switches before the first argument
-test exec-14.1 {-keepnewline switch} {
- exec -keepnewline $tcltest echo foo
+test exec-14.1 {-keepnewline switch} {execCommandExists stdio} {
+ exec -keepnewline $::tcltest::tcltest echo foo
} "foo\n"
-test exec-14.2 {-keepnewline switch} {
+test exec-14.2 {-keepnewline switch} {execCommandExists stdio} {
list [catch {exec -keepnewline} msg] $msg
} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
-test exec-14.3 {unknown switch} {
+test exec-14.3 {unknown switch} {execCommandExists stdio} {
list [catch {exec -gorp} msg] $msg
} {1 {bad switch "-gorp": must be -keepnewline or --}}
-test exec-14.4 {-- switch} {
+test exec-14.4 {-- switch} {execCommandExists stdio} {
list [catch {exec -- -gorp} msg] [string tolower $msg]
} {1 {couldn't execute "-gorp": no such file or directory}}
# Redirecting standard error separately from standard output
-test exec-15.1 {standard error redirection} {
- exec $tcltest echo "First line" > gorp.file
- list [exec $tcltest sh -c "echo foo bar 1>&2" 2> gorp.file] \
- [exec $tcltest cat gorp.file]
+test exec-15.1 {standard error redirection} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "First line" > gorp.file
+ list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" 2> gorp.file] \
+ [exec $::tcltest::tcltest cat gorp.file]
} {{} {foo bar}}
-test exec-15.2 {standard error redirection} {
- list [exec $tcltest sh -c "echo foo bar 1>&2" \
- | $tcltest echo biz baz >gorp.file 2> gorp.file2] \
- [exec $tcltest cat gorp.file] \
- [exec $tcltest cat gorp.file2]
+test exec-15.2 {standard error redirection} {execCommandExists stdio} {
+ list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \
+ | $::tcltest::tcltest echo biz baz >gorp.file 2> gorp.file2] \
+ [exec $::tcltest::tcltest cat gorp.file] \
+ [exec $::tcltest::tcltest cat gorp.file2]
} {{} {biz baz} {foo bar}}
-test exec-15.3 {standard error redirection} {
- list [exec $tcltest sh -c "echo foo bar 1>&2" \
- | $tcltest echo biz baz 2>gorp.file > gorp.file2] \
- [exec $tcltest cat gorp.file] \
- [exec $tcltest cat gorp.file2]
+test exec-15.3 {standard error redirection} {execCommandExists stdio} {
+ list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \
+ | $::tcltest::tcltest echo biz baz 2>gorp.file > gorp.file2] \
+ [exec $::tcltest::tcltest cat gorp.file] \
+ [exec $::tcltest::tcltest cat gorp.file2]
} {{} {foo bar} {biz baz}}
-test exec-15.4 {standard error redirection} {
+test exec-15.4 {standard error redirection} {execCommandExists stdio} {
set f [open gorp.file w]
puts $f "Line 1"
flush $f
- exec $tcltest sh -c "echo foo bar 1>&2" 2>@ $f
+ exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" 2>@ $f
puts $f "Line 3"
close $f
- exec $tcltest cat gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} {Line 1
foo bar
Line 3}
-test exec-15.5 {standard error redirection} {
- exec $tcltest echo "First line" > gorp.file
- exec $tcltest sh -c "echo foo bar 1>&2" 2>> gorp.file
- exec $tcltest cat gorp.file
+test exec-15.5 {standard error redirection} {execCommandExists stdio} {
+ exec $::tcltest::tcltest echo "First line" > gorp.file
+ exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" 2>> gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} {First line
foo bar}
-test exec-15.6 {standard error redirection} {
- exec $tcltest sh -c "echo foo bar 1>&2" > gorp.file2 2> gorp.file \
- >& gorp.file 2> gorp.file2 | $tcltest echo biz baz
- list [exec $tcltest cat gorp.file] [exec $tcltest cat gorp.file2]
+test exec-15.6 {standard error redirection} {execCommandExists stdio} {
+ exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" > gorp.file2 2> gorp.file \
+ >& gorp.file 2> gorp.file2 | $::tcltest::tcltest echo biz baz
+ list [exec $::tcltest::tcltest cat gorp.file] [exec $::tcltest::tcltest cat gorp.file2]
} {{biz baz} {foo bar}}
-test exec-16.1 {flush output before exec} {
+test exec-16.1 {flush output before exec} {execCommandExists stdio} {
set f [open gorp.file w]
puts $f "First line"
- exec $tcltest echo "Second line" >@ $f
+ exec $::tcltest::tcltest echo "Second line" >@ $f
puts $f "Third line"
close $f
- exec $tcltest cat gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} {First line
Second line
Third line}
-test exec-16.2 {flush output before exec} {} {
+test exec-16.2 {flush output before exec} {execCommandExists stdio} {
set f [open gorp.file w]
puts $f "First line"
- exec $tcltest << {puts stderr {Second line}} >&@ $f > gorp.file2
+ exec $::tcltest::tcltest << {puts stderr {Second line}} >&@ $f > gorp.file2
puts $f "Third line"
close $f
- exec $tcltest cat gorp.file
+ exec $::tcltest::tcltest cat gorp.file
} {First line
Second line
Third line}
-test exec-17.1 { inheriting standard I/O } {
+test exec-17.1 { inheriting standard I/O } {execCommandExists stdio} {
set f [open script w]
puts $f {close stdout
set f [open gorp.file w]
@@ -545,7 +574,7 @@ test exec-17.1 { inheriting standard I/O } {
close $f
}
close $f
- catch {exec $tcltest script} result
+ catch {exec $::tcltest::tcltest script} result
set f [open gorp.file r]
lappend result [read $f]
close $f
@@ -553,5 +582,22 @@ test exec-17.1 { inheriting standard I/O } {
} {{foobar
}}
+# cleanup
file delete script gorp.file gorp.file2
file delete echo cat wc sh sleep exit
+file delete err
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/execute.test b/tcl/tests/execute.test
index 1abee4080d7..8e9e9495654 100644
--- a/tcl/tests/execute.test
+++ b/tcl/tests/execute.test
@@ -9,13 +9,17 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
@@ -23,7 +27,483 @@ catch {unset x}
catch {unset y}
catch {unset msg}
-test execute-1.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
+set ::tcltest::testConstraints(testobj) \
+ [expr {[info commands testobj] != {} \
+ && [info commands testdoubleobj] != {} \
+ && [info commands teststringobj] != {} \
+ && [info commands testobj] != {}}]
+
+# Tests for the omnibus TclExecuteByteCode function:
+
+# INST_DONE not tested
+# INST_PUSH1 not tested
+# INST_PUSH4 not tested
+# INST_POP not tested
+# INST_DUP not tested
+# INST_CONCAT1 not tested
+# INST_INVOKE_STK4 not tested
+# INST_INVOKE_STK1 not tested
+# INST_EVAL_STK not tested
+# INST_EXPR_STK not tested
+
+# INST_LOAD_SCALAR1
+
+test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} {
+ proc foo {} {
+ set x 1
+ return $x
+ }
+ foo
+} 1
+test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} {
+ # Bug: 2243
+ set body {}
+ for {set i 0} {$i < 129} {incr i} {
+ append body "set x$i x\n"
+ }
+ append body {
+ set y 1
+ return $y
+ }
+
+ proc foo {} $body
+ foo
+} 1
+test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} {
+ proc foo {} {
+ set x 1
+ unset x
+ return $x
+ }
+ list [catch {foo} msg] $msg
+} {1 {can't read "x": no such variable}}
+
+
+# INST_LOAD_SCALAR4
+
+test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
+ set body {}
+ for {set i 0} {$i < 256} {incr i} {
+ append body "set x$i x\n"
+ }
+ append body {
+ set y 1
+ return $y
+ }
+
+ proc foo {} $body
+ foo
+} 1
+test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} {
+ set body {}
+ for {set i 0} {$i < 256} {incr i} {
+ append body "set x$i x\n"
+ }
+ append body {
+ set y 1
+ unset y
+ return $y
+ }
+
+ proc foo {} $body
+ list [catch {foo} msg] $msg
+} {1 {can't read "y": no such variable}}
+
+
+# INST_LOAD_SCALAR_STK not tested
+# INST_LOAD_ARRAY4 not tested
+# INST_LOAD_ARRAY1 not tested
+# INST_LOAD_ARRAY_STK not tested
+# INST_LOAD_STK not tested
+# INST_STORE_SCALAR4 not tested
+# INST_STORE_SCALAR1 not tested
+# INST_STORE_SCALAR_STK not tested
+# INST_STORE_ARRAY4 not tested
+# INST_STORE_ARRAY1 not tested
+# INST_STORE_ARRAY_STK not tested
+# INST_STORE_STK not tested
+# INST_INCR_SCALAR1 not tested
+# INST_INCR_SCALAR_STK not tested
+# INST_INCR_STK not tested
+# INST_INCR_ARRAY1 not tested
+# INST_INCR_ARRAY_STK not tested
+# INST_INCR_SCALAR1_IMM not tested
+# INST_INCR_SCALAR_STK_IMM not tested
+# INST_INCR_STK_IMM not tested
+# INST_INCR_ARRAY1_IMM not tested
+# INST_INCR_ARRAY_STK_IMM not tested
+# INST_JUMP1 not tested
+# INST_JUMP4 not tested
+# INST_JUMP_TRUE4 not tested
+# INST_JUMP_TRUE1 not tested
+# INST_JUMP_FALSE4 not tested
+# INST_JUMP_FALSE1 not tested
+# INST_LOR not tested
+# INST_LAND not tested
+# INST_EQ not tested
+# INST_NEQ not tested
+# INST_LT not tested
+# INST_GT not tested
+# INST_LE not tested
+# INST_GE not tested
+# INST_MOD not tested
+# INST_LSHIFT not tested
+# INST_RSHIFT not tested
+# INST_BITOR not tested
+# INST_BITXOR not tested
+# INST_BITAND not tested
+
+# INST_ADD is partially tested:
+test execute-3.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} {
+ set x [testintobj set 0 1]
+ expr {$x + 1}
+} 2
+test execute-3.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} {
+ set x [testdoubleobj set 0 1]
+ expr {$x + 1}
+} 2.0
+test execute-3.3 {TclExecuteByteCode, INST_ADD, op1 is double with string} {testobj} {
+ set x [testintobj set 0 1]
+ testobj convert 0 double
+ expr {$x + 1}
+} 2
+test execute-3.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} {
+ set x [teststringobj set 0 1]
+ expr {$x + 1}
+} 2
+test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
+ set x [teststringobj set 0 1.0]
+ expr {$x + 1}
+} 2.0
+test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
+ set x [teststringobj set 0 foo]
+ list [catch {expr {$x + 1}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
+ set x [testintobj set 0 1]
+ expr {1 + $x}
+} 2
+test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
+ set x [testdoubleobj set 0 1]
+ expr {1 + $x}
+} 2.0
+test execute-3.9 {TclExecuteByteCode, INST_ADD, op2 is double with string} {testobj} {
+ set x [testintobj set 0 1]
+ testobj convert 0 double
+ expr {1 + $x}
+} 2
+test execute-3.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} {
+ set x [teststringobj set 0 1]
+ expr {1 + $x}
+} 2
+test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
+ set x [teststringobj set 0 1.0]
+ expr {1 + $x}
+} 2.0
+test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
+ set x [teststringobj set 0 foo]
+ list [catch {expr {1 + $x}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+
+# INST_SUB is partially tested:
+test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
+ set x [testintobj set 0 1]
+ expr {$x - 1}
+} 0
+test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
+ set x [testdoubleobj set 0 1]
+ expr {$x - 1}
+} 0.0
+test execute-3.15 {TclExecuteByteCode, INST_SUB, op1 is double with string} {testobj} {
+ set x [testintobj set 0 1]
+ testobj convert 0 double
+ expr {$x - 1}
+} 0
+test execute-3.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} {
+ set x [teststringobj set 0 1]
+ expr {$x - 1}
+} 0
+test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
+ set x [teststringobj set 0 1.0]
+ expr {$x - 1}
+} 0.0
+test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
+ set x [teststringobj set 0 foo]
+ list [catch {expr {$x - 1}} msg] $msg
+} {1 {can't use non-numeric string as operand of "-"}}
+test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
+ set x [testintobj set 0 1]
+ expr {1 - $x}
+} 0
+test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
+ set x [testdoubleobj set 0 1]
+ expr {1 - $x}
+} 0.0
+test execute-3.21 {TclExecuteByteCode, INST_SUB, op2 is double with string} {testobj} {
+ set x [testintobj set 0 1]
+ testobj convert 0 double
+ expr {1 - $x}
+} 0
+test execute-3.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} {
+ set x [teststringobj set 0 1]
+ expr {1 - $x}
+} 0
+test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
+ set x [teststringobj set 0 1.0]
+ expr {1 - $x}
+} 0.0
+test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
+ set x [teststringobj set 0 foo]
+ list [catch {expr {1 - $x}} msg] $msg
+} {1 {can't use non-numeric string as operand of "-"}}
+
+# INST_MULT is partially tested:
+test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {$x * 1}
+} 1
+test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
+ set x [testdoubleobj set 1 2.0]
+ expr {$x * 1}
+} 2.0
+test execute-3.27 {TclExecuteByteCode, INST_MULT, op1 is double with string} {testobj} {
+ set x [testintobj set 1 2]
+ testobj convert 1 double
+ expr {$x * 1}
+} 2
+test execute-3.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {$x * 1}
+} 1
+test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {$x * 1}
+} 1.0
+test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
+ set x [teststringobj set 1 foo]
+ list [catch {expr {$x * 1}} msg] $msg
+} {1 {can't use non-numeric string as operand of "*"}}
+test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {1 * $x}
+} 1
+test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
+ set x [testdoubleobj set 1 2.0]
+ expr {1 * $x}
+} 2.0
+test execute-3.33 {TclExecuteByteCode, INST_MULT, op2 is double with string} {testobj} {
+ set x [testintobj set 1 2]
+ testobj convert 1 double
+ expr {1 * $x}
+} 2
+test execute-3.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {1 * $x}
+} 1
+test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {1 * $x}
+} 1.0
+test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
+ set x [teststringobj set 1 foo]
+ list [catch {expr {1 * $x}} msg] $msg
+} {1 {can't use non-numeric string as operand of "*"}}
+
+# INST_DIV is partially tested:
+test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {$x / 1}
+} 1
+test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
+ set x [testdoubleobj set 1 2.0]
+ expr {$x / 1}
+} 2.0
+test execute-3.39 {TclExecuteByteCode, INST_DIV, op1 is double with string} {testobj} {
+ set x [testintobj set 1 2]
+ testobj convert 1 double
+ expr {$x / 1}
+} 2
+test execute-3.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {$x / 1}
+} 1
+test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {$x / 1}
+} 1.0
+test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
+ set x [teststringobj set 1 foo]
+ list [catch {expr {$x / 1}} msg] $msg
+} {1 {can't use non-numeric string as operand of "/"}}
+test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {2 / $x}
+} 2
+test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {2 / $x}
+} 2.0
+test execute-3.45 {TclExecuteByteCode, INST_DIV, op2 is double with string} {testobj} {
+ set x [testintobj set 1 1]
+ testobj convert 1 double
+ expr {2 / $x}
+} 2
+test execute-3.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {2 / $x}
+} 2
+test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {2 / $x}
+} 2.0
+test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
+ set x [teststringobj set 1 foo]
+ list [catch {expr {1 / $x}} msg] $msg
+} {1 {can't use non-numeric string as operand of "/"}}
+
+# INST_UPLUS is partially tested:
+test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {+ $x}
+} 1
+test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {+ $x}
+} 1.0
+test execute-3.51 {TclExecuteByteCode, INST_UPLUS, op is double with string} {testobj} {
+ set x [testintobj set 1 1]
+ testobj convert 1 double
+ expr {+ $x}
+} 1
+test execute-3.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {+ $x}
+} 1
+test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {+ $x}
+} 1.0
+test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
+ set x [teststringobj set 1 foo]
+ list [catch {expr {+ $x}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+
+# INST_UMINUS is partially tested:
+test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {- $x}
+} -1
+test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {- $x}
+} -1.0
+test execute-3.57 {TclExecuteByteCode, INST_UMINUS, op is double with string} {testobj} {
+ set x [testintobj set 1 1]
+ testobj convert 1 double
+ expr {- $x}
+} -1
+test execute-3.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {- $x}
+} -1
+test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {- $x}
+} -1.0
+test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
+ set x [teststringobj set 1 foo]
+ list [catch {expr {- $x}} msg] $msg
+} {1 {can't use non-numeric string as operand of "-"}}
+
+# INST_LNOT is partially tested:
+test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
+ set x [testintobj set 1 2]
+ expr {! $x}
+} 0
+test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
+ set x [testintobj set 1 0]
+ expr {! $x}
+} 1
+test execute-3.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {! $x}
+} 0
+test execute-3.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
+ set x [testdoubleobj set 1 0.0]
+ expr {! $x}
+} 1
+test execute-3.65 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
+ set x [testintobj set 1 1]
+ testobj convert 1 double
+ expr {! $x}
+} 0
+test execute-3.66 {TclExecuteByteCode, INST_LNOT, op is double with string} {testobj} {
+ set x [testintobj set 1 0]
+ testobj convert 1 double
+ expr {! $x}
+} 1
+test execute-3.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {! $x}
+} 0
+test execute-3.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
+ set x [teststringobj set 1 0]
+ expr {! $x}
+} 1
+test execute-3.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {! $x}
+} 0
+test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
+ set x [teststringobj set 1 0.0]
+ expr {! $x}
+} 1
+test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
+ set x [teststringobj set 1 foo]
+ list [catch {expr {! $x}} msg] $msg
+} {1 {can't use non-numeric string as operand of "!"}}
+
+# INST_BITNOT not tested
+# INST_CALL_BUILTIN_FUNC1 not tested
+# INST_CALL_FUNC1 not tested
+
+# INST_TRY_CVT_TO_NUMERIC is partially tested:
+test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {$x}
+} 1
+test execute-3.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {$x}
+} 1.0
+test execute-3.74 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double with string} {testobj} {
+ set x [testintobj set 1 1]
+ testobj convert 1 double
+ expr {$x}
+} 1
+test execute-3.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {$x}
+} 1
+test execute-3.76 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {$x}
+} 1.0
+test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeric} {testobj} {
+ set x [teststringobj set 1 foo]
+ expr {$x}
+} foo
+
+# INST_BREAK not tested
+# INST_CONTINUE not tested
+# INST_FOREACH_START4 not tested
+# INST_FOREACH_STEP4 not tested
+# INST_BEGIN_CATCH4 not tested
+# INST_END_CATCH not tested
+# INST_PUSH_RESULT not tested
+# INST_PUSH_RETURN_CODE not tested
+
+test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {unset x}
catch {unset y}
@@ -41,7 +521,7 @@ test execute-1.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
[catch {namespace which -command ${x}${y}cmd2} msg] $msg \
[catch {namespace which -command ${x}${y}:cmd2} msg] $msg
} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
-test execute-1.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
+test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
catch {unset l}
@@ -63,7 +543,7 @@ test execute-1.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is inval
lappend l [test_ns_1::whichFoo]
set l
} {::foo ::test_ns_1::foo}
-test execute-1.3 {Tcl_GetCommandFromObj, command never found} {
+test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
namespace eval test_ns_1 {
@@ -81,7 +561,7 @@ test execute-1.3 {Tcl_GetCommandFromObj, command never found} {
[catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
} {::test_ns_1::foo {} 0 {}}
-test execute-2.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
+test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {unset l}
proc {} {} {return {}}
@@ -91,7 +571,7 @@ test execute-2.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL}
{}
} {}
-test execute-3.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
+test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
proc {} {} {}
proc { } {} {}
proc p {} {
@@ -103,6 +583,7 @@ test execute-3.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName o
p
} {}
+# cleanup
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
catch {rename p ""}
@@ -111,4 +592,25 @@ catch {rename { } ""}
catch {unset x}
catch {unset y}
catch {unset msg}
-concat {}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/expr-old.test b/tcl/tests/expr-old.test
index 981010a94cd..bbdd2b2a392 100644
--- a/tcl/tests/expr-old.test
+++ b/tcl/tests/expr-old.test
@@ -2,19 +2,23 @@
#
# This file contains the original set of tests for Tcl's expr command.
# Since the expr command is now compiled, a new set of tests covering
-# the new implementation is in the file "expr.test". Sourcing this file
-# into Tcl runs the tests and generates output for errors.
-# No output means no errors were found.
+# the new implementation are in the files "parseExpr.test and
+# "compExpr.test". Sourcing this file into Tcl runs the tests and generates
+# output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
set gotT1 0
@@ -456,13 +460,13 @@ test expr-old-26.15 {error conditions} {
} {1 {syntax error in expression "a@b"}}
test expr-old-26.16 {error conditions} {
list [catch {expr a[b} msg] $msg
-} {1 {missing close-bracket or close-brace}}
+} {1 {missing close-bracket}}
test expr-old-26.17 {error conditions} {
list [catch {expr a`b} msg] $msg
} {1 {syntax error in expression "a`b"}}
test expr-old-26.18 {error conditions} {
list [catch {expr \"a\"\{b} msg] $msg
-} {1 {missing close-brace}}
+} {1 syntax\ error\ in\ expression\ \"\"a\"\{b\"}
test expr-old-26.19 {error conditions} {
list [catch {expr a} msg] $msg
} {1 {syntax error in expression "a"}}
@@ -777,16 +781,16 @@ test expr-old-32.45 {math functions in expressions} {
} {1}
test expr-old-32.46 {math functions in expressions} {
list [catch {expr rand(24)} msg] $msg
-} {1 {syntax error in expression "rand(24)"}}
+} {1 {too many arguments for math function}}
test expr-old-32.47 {math functions in expressions} {
list [catch {expr srand()} msg] $msg
-} {1 {syntax error in expression "srand()"}}
+} {1 {too few arguments for math function}}
test expr-old-32.48 {math functions in expressions} {
list [catch {expr srand(3.79)} msg] $msg
} {1 {can't use floating-point value as argument to srand}}
test expr-old-32.49 {math functions in expressions} {
list [catch {expr srand("")} msg] $msg
-} {1 {can't use non-numeric string as argument to srand}}
+} {1 {argument to math function didn't have numeric value}}
test expr-old-32.50 {math functions in expressions} {
set result [expr round(srand(12345) * 1000)]
for {set i 0} {$i < 10} {incr i} {
@@ -796,7 +800,7 @@ test expr-old-32.50 {math functions in expressions} {
} {97 834 948 36 12 51 766 585 914 784 333}
test expr-old-32.51 {math functions in expressions} {
list [catch {expr {srand([lindex "6ty" 0])}} msg] $msg
-} {1 {can't use non-numeric string as argument to srand}}
+} {1 {argument to math function didn't have numeric value}}
test expr-old-33.1 {conversions and fancy args to math functions} {
expr hypot ( 3 , 4 )
@@ -862,16 +866,16 @@ test expr-old-34.16 {errors in math functions} {
if $gotT1 {
test expr-old-34.17 {errors in math functions} {
list [catch {expr T1(4)} msg] $msg
- } {1 {syntax error in expression "T1(4)"}}
+ } {1 {too many arguments for math function}}
}
test expr-old-36.1 {ExprLooksLikeInt procedure} {
list [catch {expr 0289} msg] $msg
-} {1 {syntax error in expression "0289"}}
+} {1 {"0289" is an invalid octal number}}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
set x 0289
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
list [catch {expr 0289.1} msg] $msg
} {0 289.1}
@@ -927,3 +931,20 @@ if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
puts "call Intel customer service immediately at 1-800-628-8686"
puts "to request a replacement processor."
}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/expr.test b/tcl/tests/expr.test
index f1edcaabc5e..56cef1971e3 100644
--- a/tcl/tests/expr.test
+++ b/tcl/tests/expr.test
@@ -5,13 +5,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
set gotT1 0
@@ -88,7 +92,7 @@ test expr-1.5 {TclCompileExprCmd: quoted expression word} {
test expr-1.6 {TclCompileExprCmd: quoted expression word} {
catch {expr "0005"zxy} msg
set msg
-} {quoted string doesn't terminate properly}
+} {extra characters after close-quote}
test expr-1.7 {TclCompileExprCmd: expression word in braces} {
expr {-0005}
} -5
@@ -98,7 +102,7 @@ test expr-1.8 {TclCompileExprCmd: expression word in braces} {
test expr-1.9 {TclCompileExprCmd: expression word in braces} {
catch {expr {-0005}foo} msg
set msg
-} {argument word in braces doesn't terminate properly}
+} {extra characters after close-brace}
test expr-1.10 {TclCompileExprCmd: other expression word in braces} {
expr 4*[llength "6 2"]
} 8
@@ -479,7 +483,6 @@ test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} {
catch {expr {$a(foo}} msg
set errorInfo
} {missing )
- (parsing index for array "a")
while compiling
"expr {$a(foo}"}
test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
@@ -516,9 +519,7 @@ test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} {
test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} {
catch {expr {[set i}} msg
set errorInfo
-} {missing close-bracket or close-brace
- while compiling
-"set i"
+} {missing close-bracket
while compiling
"expr {[set i}"}
test expr-14.25 {CompilePrimaryExpr: math function primary} {
@@ -531,7 +532,7 @@ test expr-14.27 {CompilePrimaryExpr: error in math function primary} {
catch {expr sinh::(2.0)} msg
set errorInfo
} {syntax error in expression "sinh::(2.0)"
- while executing
+ while compiling
"expr sinh::(2.0)"}
test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
expr 2+(3*4)
@@ -548,7 +549,7 @@ test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
catch {expr 2+(3*(4+5)} msg
set errorInfo
} {syntax error in expression "2+(3*(4+5)"
- while executing
+ while compiling
"expr 2+(3*(4+5)"}
test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
set i "5+10"
@@ -558,44 +559,44 @@ test expr-14.32 {CompilePrimaryExpr: unexpected token} {
catch {expr @} msg
set errorInfo
} {syntax error in expression "@"
- while executing
+ while compiling
"expr @"}
test expr-15.1 {CompileMathFuncCall: missing parenthesis} {
catch {expr sinh2.0)} msg
set errorInfo
} {syntax error in expression "sinh2.0)"
- while executing
+ while compiling
"expr sinh2.0)"}
test expr-15.2 {CompileMathFuncCall: unknown math function} {
catch {expr whazzathuh(1)} msg
set errorInfo
} {unknown math function "whazzathuh"
- while executing
+ while compiling
"expr whazzathuh(1)"}
test expr-15.3 {CompileMathFuncCall: too many arguments} {
catch {expr sin(1,2,3)} msg
set errorInfo
} {too many arguments for math function
- while executing
+ while compiling
"expr sin(1,2,3)"}
test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} {
catch {expr sin()} msg
set errorInfo
-} {syntax error in expression "sin()"
- while executing
+} {too few arguments for math function
+ while compiling
"expr sin()"}
test expr-15.5 {CompileMathFuncCall: too few arguments} {
catch {expr pow(1)} msg
set errorInfo
} {too few arguments for math function
- while executing
+ while compiling
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} {
catch {expr sin(1} msg
set errorInfo
} {syntax error in expression "sin(1"
- while executing
+ while compiling
"expr sin(1"}
if $gotT1 {
test expr-15.7 {CompileMathFuncCall: call registered math function} {
@@ -646,6 +647,9 @@ test expr-18.1 {expr and conversion of operands to numbers} {
catch {expr int($x)}
expr {$x}
} 11
+test expr-18.2 {whitespace strings should not be == 0 (buggy strtod)} {
+ expr {" "}
+} { }
# Check "expr" and interpreter result object resetting before appending
# an error msg during evaluation of exprs not in {}s
@@ -667,4 +671,60 @@ test expr-19.1 {expr and interpreter result object resetting} {
p
} 3
-unset a
+# Test for incorrect "double evaluation" semantics
+
+test expr-20.1 {wrong brace matching} {
+ catch {unset l}
+ catch {unset r}
+ catch {unset q}
+ catch {unset cmd}
+ catch {unset a}
+ set l "\{"; set r "\}"; set q "\""
+ set cmd "expr $l$q|$q == $q$r$q$r"
+ list [catch $cmd a] $a
+} {1 {extra characters after close-brace}}
+test expr-20.2 {double invocation of variable traces} {
+ set exprtracecounter 0
+ proc exprtraceproc {args} {
+ upvar #0 exprtracecounter counter
+ set argc [llength $args]
+ set extraargs [lrange $args 0 [expr {$argc - 4}]]
+ set name [lindex $args [expr {$argc - 3}]]
+ upvar 1 $name var
+ if {[incr counter] % 2 == 1} {
+ set var "$counter oops [concat $extraargs]"
+ } else {
+ set var "$counter + [concat $extraargs]"
+ }
+ }
+ trace variable exprtracevar r [list exprtraceproc 10]
+ list [catch {expr "$exprtracevar + 20"} a] $a \
+ [catch {expr "$exprtracevar + 20"} b] $b \
+ [unset exprtracevar exprtracecounter]
+} {1 {syntax error in expression "1 oops 10 + 20"} 0 32 {}}
+test expr-20.3 {broken substitution of integer digits} {
+ # fails with 8.0.x, but not 8.1b2
+ list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]
+} {4096 1000}
+test expr-20.4 {proper double evaluation compilation, error case} {
+ catch {unset a}; # make sure $a doesn't exist
+ list [catch {expr 1?{$a}:0} msg] $msg
+} {1 {can't read "a": no such variable}}
+test expr-20.5 {proper double evaluation compilation, working case} {
+ set a yellow
+ expr 1?{$a}:0
+} yellow
+test expr-20.6 {handling of compile error in trial compile} {
+ list [catch {expr + {[incr]}} msg] $msg
+} {1 {wrong # args: should be "incr varName ?increment?"}}
+test expr-20.7 {handling of compile error in runtime case} {
+ list [catch {expr + {[error foo]}} msg] $msg
+} {1 foo}
+
+# cleanup
+if {[info exists a]} {
+ unset a
+}
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/fCmd.test b/tcl/tests/fCmd.test
index 02862cdcc7d..c2a98304070 100644
--- a/tcl/tests/fCmd.test
+++ b/tcl/tests/fCmd.test
@@ -5,6 +5,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -12,22 +13,39 @@
# RCS: @(#) $Id$
#
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-set platform [testgetplatform]
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
-if {$user == "root"} {
- puts "Skipping fCmd tests. They depend on not being able to write to"
- puts "certain directories. It would be too dangerous to run them as root."
+if {[string compare testgetplatform [info commands testgetplatform]] != 0} {
+ puts "This application hasn't been compiled with the \"testgetplatform\""
+ puts "command, therefore I am skipping all of these tests."
+ ::tcltest::cleanupTests
return
}
+set platform [testgetplatform]
+
if {"[info commands testchmod]" != "testchmod"} {
puts "Skipping fCmd tests. This application does not seem to have the"
puts "testchmod command that is needed to run these tests."
+ ::tcltest::cleanupTests
return
}
+# Several tests require need to match results against the unix username
+set user {}
+if {$tcl_platform(platform) == "unix"} {
+ catch {set user [exec whoami]}
+ if {$user == ""} {
+ catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+ }
+ if {$user == ""} {
+ set user "root"
+ }
+}
+
proc createfile {file {string a}} {
set f [open $file w]
puts -nonewline $f $string
@@ -71,8 +89,8 @@ proc cleanup {args} {
}
foreach file $x {
if {[catch {file delete -force -- $file}]} {
- openup $file
- file delete -force -- $file
+ catch {openup $file}
+ catch {file delete -force -- $file}
}
}
}
@@ -85,35 +103,27 @@ proc contents {file} {
set r
}
-set testConfig(NT) 0
-set testConfig(95) 0
-
-switch $tcl_platform(os) {
- "Windows NT" {set testConfig(NT) 1}
- "Windows 95" {set testConfig(95) 1}
-}
-
-set testConfig(fileSharing) 0
-set testConfig(notFileSharing) 1
+set ::tcltest::testConstraints(fileSharing) 0
+set ::tcltest::testConstraints(notFileSharing) 1
if {$tcl_platform(platform) == "macintosh"} {
catch {file delete -force foo.dir}
file mkdir foo.dir
if {[catch {file attributes foo.dir -readonly 1}] == 0} {
- set testConfig(fileSharing) 1
- set testConfig(notFileSharing) 0
+ set ::tcltest::testConstraints(fileSharing) 1
+ set ::tcltest::testConstraints(notFileSharing) 0
}
file delete -force foo.dir
}
-set testConfig(xdev) 0
+set ::tcltest::testConstraints(xdev) 0
if {$tcl_platform(platform) == "unix"} {
if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
- set testConfig(xdev) 1
+ set ::tcltest::testConstraints(xdev) 1
}
}
}
@@ -131,77 +141,78 @@ append long $long
append long $long
append long $long
-test fCmd-1.1 {TclFileRenameCmd} {
+test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
cleanup
createfile tf1
file rename tf1 tf2
glob tf*
} {tf2}
-test fCmd-2.1 {TclFileCopyCmd} {
+test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
cleanup
createfile tf1
file copy tf1 tf2
lsort [glob tf*]
} {tf1 tf2}
-test fCmd-3.1 {FileCopyRename: FileForceOption fails} {
+test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} {
list [catch {file rename -xyz} msg] $msg
} {1 {bad option "-xyz": should be -force or --}}
-test fCmd-3.2 {FileCopyRename: not enough args} {
+test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} {
list [catch {file rename xyz} msg] $msg
} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
-test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {
- list [catch {file rename xyz ~nonexistantuser} msg] $msg
-} {1 {user "nonexistantuser" doesn't exist}}
-test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {
+test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {
+ list [catch {file rename xyz ~_totally_bogus_user} msg] $msg
+} {1 {user "_totally_bogus_user" doesn't exist}}
+test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} {
cleanup
list [catch {file copy tf1 ~} msg] $msg
} {1 {error copying "tf1": no such file or directory}}
-test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {
+test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} {
cleanup
list [catch {file rename tf1 tf2 tf3} msg] $msg
} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.6 {FileCopyRename: target tf3 is not a directory: !S_ISDIR(target)} {
+test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \
+ {notRoot} {
cleanup
createfile tf3
list [catch {file rename tf1 tf2 tf3} msg] $msg
} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.7 {FileCopyRename: target exists & is directory} {
+test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} {
cleanup
file mkdir td1
createfile tf1 tf1
file rename tf1 td1
contents [file join td1 tf1]
} {tf1}
-test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {
+test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
cleanup
list [catch {file rename tf1 tf2 tf3} msg] $msg
} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {
+test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
cleanup
list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
} {1 {error copying: target "tf3" is not a directory}}
-test fCmd-3.10 {FileCopyRename: just 2 arguments} {
+test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
cleanup
createfile tf1 tf1
file rename tf1 tf2
contents tf2
} {tf1}
-test fCmd-3.11 {FileCopyRename: just 2 arguments} {
+test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
cleanup
createfile tf1 tf1
file rename -force -force -- tf1 tf2
contents tf2
} {tf1}
-test fCmd-3.12 {FileCopyRename: move each source: 1 source} {
+test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
cleanup
createfile tf1 tf1
file mkdir td1
file rename tf1 td1
contents [file join td1 tf1]
} {tf1}
-test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {
+test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
cleanup
createfile tf1 tf1
createfile tf2 tf2
@@ -212,17 +223,17 @@ test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {
list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
[contents [file join td1 tf3]] [contents [file join td1 tf4]]
} {tf1 tf2 tf3 tf4}
-test fCmd-3.14 {FileCopyRename: FileBasename fails} {
+test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} {
cleanup
file mkdir td1
- list [catch {file rename ~nonexistantuser td1} msg] $msg
-} {1 {user "nonexistantuser" doesn't exist}}
-test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {unixOrPc} {
+ list [catch {file rename ~_totally_bogus_user td1} msg] $msg
+} {1 {user "_totally_bogus_user" doesn't exist}}
+test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} {
cleanup
file mkdir td1
list [catch {file rename / td1} msg] $msg
} {1 {error renaming "/" to "td1": file already exists}}
-test fCmd-3.16 {FileCopyRename: break on first error} {
+test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {
cleanup
createfile tf1
createfile tf2
@@ -233,60 +244,62 @@ test fCmd-3.16 {FileCopyRename: break on first error} {
list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]
-test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {
+test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
cleanup
file mkdir td1
glob td*
} {td1}
-test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {
+test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
cleanup
file mkdir td1 td2 td3
lsort [glob td*]
} {td1 td2 td3}
-test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {
+test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
cleanup
createfile tf1
catch {file mkdir td1 td2 tf1 td3 td4}
glob td1 td2 tf1 td3 td4
} {td1 td2 tf1}
-test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {
+test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} {
cleanup
- list [catch {file mkdir ~nonexistantuser} msg] $msg
-} {1 {user "nonexistantuser" doesn't exist}}
-test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} {
+ list [catch {file mkdir ~_totally_bogus_user} msg] $msg
+} {1 {user "_totally_bogus_user" doesn't exist}}
+test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \
+ {notRoot} {
cleanup
list [catch {file mkdir ""} msg] $msg
} {1 {can't create directory "": no such file or directory}}
-test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {
+test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {
cleanup
file mkdir td1
glob td1
} {td1}
-test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {
+test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
cleanup
file mkdir [file join td1 td2 td3 td4]
glob td1 [file join td1 td2]
} "td1 [file join td1 td2]"
-test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {
+test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
cleanup
file mkdir td1
set x [file exist td1]
file mkdir td1
list $x [file exist td1]
} {1 1}
-test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {
+test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} {
cleanup
createfile tf1
list [catch {file mkdir tf1} msg] $msg
} [subst {1 {can't create directory "[file join tf1]": file already exists}}]
-test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {
+test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
cleanup
file mkdir td1
set x [file exist td1]
file mkdir td1
list $x [file exist td1]
} {1 1}
-test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {unixOnly} {
+test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \
+ {unixOnly notRoot} {
cleanup
file mkdir td1/td2/td3
testchmod 000 td1/td2
@@ -298,13 +311,14 @@ test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {
cleanup
list [catch {file mkdir nonexistantvolume:} msg] $msg
} {1 {can't create directory "nonexistantvolume:": invalid argument}}
-test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {
+test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {
cleanup
set x [file exist td1]
file mkdir td1
list $x [file exist td1]
} {0 1}
-test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {unixOnly} {
+test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \
+ {unixOnly notRoot} {
cleanup
file delete -force foo
file mkdir foo
@@ -316,19 +330,19 @@ test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {unixOnly} {
test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {
list [catch {file mkdir ${root}:} msg] $msg
} [subst {1 {can't create directory "${root}:": no such file or directory}}]
-test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {
+test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
cleanup
file mkdir tf1
file exists tf1
} {1}
-test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {
+test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} {
list [catch {file delete -xyz} msg] $msg
} {1 {bad option "-xyz": should be -force or --}}
-test fCmd-5.2 {TclFileDeleteCmd: not enough args} {
+test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} {
list [catch {file delete -force -force} msg] $msg
} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
-test fCmd-5.3 {TclFileDeleteCmd: 1 file} {
+test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
cleanup
createfile tf1
createfile tf2
@@ -336,7 +350,7 @@ test fCmd-5.3 {TclFileDeleteCmd: 1 file} {
file delete tf2
glob tf* td*
} {tf1 td1}
-test fCmd-5.4 {TclFileDeleteCmd: multiple files} {
+test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
cleanup
createfile tf1
createfile tf2
@@ -345,7 +359,7 @@ test fCmd-5.4 {TclFileDeleteCmd: multiple files} {
file delete tf1 td1 tf2
lappend x [file exist tf1] [file exist tf2] [file exist tf3]
} {1 1 1 0 0 0}
-test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {unixOrPc} {
+test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
cleanup
createfile tf1
createfile tf2
@@ -353,55 +367,55 @@ test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {unixOrPc} {
catch {file delete tf1 td1 $root tf2}
list [file exist tf1] [file exist tf2] [file exist td1]
} {0 1 0}
-test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {
- list [catch {file delete ~nonexistantuser} msg] $msg
-} {1 {user "nonexistantuser" doesn't exist}}
-test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {
+test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {
+ list [catch {file delete ~_totally_bogus_user} msg] $msg
+} {1 {user "_totally_bogus_user" doesn't exist}}
+test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
catch {file delete ~/tf1}
createfile ~/tf1
file delete ~/tf1
} {}
-test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {
+test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
cleanup
set x [file exist tf1]
file delete tf1
list $x [file exist tf1]
} {0 0}
-test fCmd-5.9 {TclFileDeleteCmd: is directory} {
+test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
cleanup
file mkdir td1
file delete td1
file exist td1
} {0}
-test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {
+test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {
cleanup
file mkdir td1/td2
list [catch {file delete td1} msg] $msg
} {1 {error deleting "td1": directory not empty}}
-test fCmd-6.1 {CopyRenameOneFile: bad source} {
+test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {
# can't test this, because it's caught by FileCopyRename
} {}
-test fCmd-6.2 {CopyRenameOneFile: bad target} {
+test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} {
# can't test this, because it's caught by FileCopyRename
} {}
-test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {
+test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} {
cleanup
list [catch {file rename tf1 tf2} msg] $msg
} {1 {error renaming "tf1": no such file or directory}}
-test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {
+test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
cleanup
createfile tf1
file rename tf1 tf2
glob tf*
} {tf2}
-test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {
+test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
cleanup
createfile tf1
file rename tf1 tf2
glob tf*
} {tf2}
-test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly} {
+test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot} {
cleanup
file mkdir td1
testchmod 000 td1
@@ -420,45 +434,45 @@ test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} {
createfile tf1
list [catch {file rename tf1 $long} msg] $msg
} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
-test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly} {
+test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly notRoot} {
cleanup
createfile tf1
file rename tf1 tf2
glob tf*
} {tf2}
-test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {
+test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} {
cleanup
createfile tf1
createfile tf2
list [catch {file rename tf1 tf2} msg] $msg
} {1 {error renaming "tf1" to "tf2": file already exists}}
-test fCmd-6.11 {CopyRenameOneFile: force == 0} {
+test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} {
cleanup
createfile tf1
createfile tf2
list [catch {file rename tf1 tf2} msg] $msg
} {1 {error renaming "tf1" to "tf2": file already exists}}
-test fCmd-6.12 {CopyRenameOneFile: force != 0} {
+test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
cleanup
createfile tf1
createfile tf2
file rename -force tf1 tf2
glob tf*
} {tf2}
-test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {
+test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} {
cleanup
file mkdir td1
file mkdir td2
createfile [file join td2 td1]
list [catch {file rename -force td1 td2} msg] $msg
} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
-test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {
+test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} {
cleanup
createfile tf1
file mkdir [file join td1 tf1]
list [catch {file rename -force tf1 td1} msg] $msg
} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
-test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {
+test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot} {
cleanup
file mkdir [file join td1 td2]
file mkdir td2
@@ -466,28 +480,26 @@ test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {
file rename -force td2 td1
file exists [file join td1 td2 tf1]
} {1}
-test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {
+test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {notRoot} {
cleanup
file mkdir [file join td1 td2]
createfile [file join td1 td2 tf1]
file mkdir td2
list [catch {file rename -force td2 td1} msg] $msg
} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
-test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {!$testConfig(win32s) || ($root == "C:/")} {
- # Don't run this test under Win32s on a drive mounted from an NT
- # machine; it causes the NT machine to die.
+test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} {
cleanup
list [catch {file rename -force $root tf1} msg] $msg
} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
-test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {
+test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {notRoot} {
cleanup
file mkdir [file join td1 td2]
createfile [file join td1 td2 tf1]
file mkdir td2
list [catch {file rename -force td2 td1} msg] $msg
} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
-test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly} {
+test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} {
cleanup /tmp
createfile tf1
file rename tf1 /tmp
@@ -504,19 +516,22 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
set msg
}
} {d:/tcl8975@}
-test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} {unixOnly} {
+test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
+ {unixOnly notRoot} {
cleanup /tmp
file mkdir td1
file rename td1 /tmp
glob td* /tmp/td*
} {/tmp/td1}
-test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} {unixOnly} {
+test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
+ {unixOnly notRoot} {
cleanup /tmp
createfile tf1
file rename tf1 /tmp
glob tf* /tmp/tf*
} {/tmp/tf1}
-test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
+test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
+ {unixOnly notRoot xdev} {
cleanup /tmp
file mkdir td1/td2/td3
exec chmod 000 td1
@@ -524,7 +539,8 @@ test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
exec chmod 755 td1
set msg
} {1 {error renaming "td1": permission denied}}
-test fCmd-6.24 {CopyRenameOneFile: error uses original name} {unixOnly} {
+test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
+ {unixOnly notRoot} {
cleanup
file mkdir ~/td1/td2
exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
@@ -533,7 +549,8 @@ test fCmd-6.24 {CopyRenameOneFile: error uses original name} {unixOnly} {
file delete -force ~/td1
set msg
} {1 {error copying "~/td1": permission denied}}
-test fCmd-6.25 {CopyRenameOneFile: error uses original name} {unixOnly} {
+test fCmd-6.25 {CopyRenameOneFile: error uses original name} \
+ {unixOnly notRoot} {
cleanup
file mkdir td2
file mkdir ~/td1
@@ -543,7 +560,8 @@ test fCmd-6.25 {CopyRenameOneFile: error uses original name} {unixOnly} {
file delete -force ~/td1
set msg
} {1 {error copying "td2" to "~/td1/td2": permission denied}}
-test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} {unixOnly} {
+test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \
+ {unixOnly notRoot} {
cleanup
file mkdir ~/td1/td2
exec chmod 000 [file join [file dirname ~] [file tail ~] td1 td2]
@@ -552,14 +570,16 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} {unixOnly} {
file delete -force ~/td1
set msg
} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
-test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
+test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \
+ {unixOnly notRoot xdev} {
cleanup /tmp
file mkdir td1/td2/td3
file mkdir /tmp/td1
createfile /tmp/td1/tf1
list [catch {file rename -force td1 /tmp} msg] $msg
} {1 {error renaming "td1" to "/tmp/td1": file already exists}}
-test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
+test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \
+ {unixOnly notRoot xdev} {
cleanup /tmp
file mkdir td1/td2/td3
exec chmod 000 td1/td2/td3
@@ -567,73 +587,81 @@ test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
exec chmod 755 td1/td2/td3
set msg
} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
-test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} {unixOnly xdev} {
+test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \
+ {unixOnly notRoot xdev} {
cleanup /tmp
file mkdir td1/td2/td3
file rename td1 /tmp
glob td* /tmp/td1/t*
} {/tmp/td1/td2}
-test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} {unixOnly} {
+test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \
+ {unixOnly notRoot} {
cleanup
file mkdir foo/bar
file attr foo -perm 040555
- set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
- set a1 {1 {can't unlink "foo/bar": permission denied}}
- set result [expr {$msg == $a1}]
+ set catchResult [catch {file rename foo/bar /tmp} msg]
+ set msg [lindex [split $msg :] end]
catch {file delete /tmp/bar}
catch {file attr foo -perm 040777}
catch {file delete -force foo}
- set result
-} {1}
-test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} {unixOnly xdev} {
+ list $catchResult $msg
+} {1 { permission denied}}
+test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \
+ {unixOnly notRoot xdev} {
catch {cleanup /tmp}
file mkdir /tmp/td1
createfile /tmp/td1/tf1
file rename /tmp/td1/tf1 tf1
list [file exists /tmp/td1/tf1] [file exists tf1]
} {0 1}
-test fCmd-6.32 {CopyRenameOneFile: copy} {
+test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} {
cleanup
list [catch {file copy tf1 tf2} msg] $msg
} {1 {error copying "tf1": no such file or directory}}
catch {cleanup /tmp}
-test fCmd-7.1 {FileForceOption: none} {
+test fCmd-7.1 {FileForceOption: none} {notRoot} {
cleanup
file mkdir [file join tf1 tf2]
list [catch {file delete tf1} msg] $msg
} {1 {error deleting "tf1": directory not empty}}
-test fCmd-7.2 {FileForceOption: -force} {
+test fCmd-7.2 {FileForceOption: -force} {notRoot} {
cleanup
file mkdir [file join tf1 tf2]
file delete -force tf1
} {}
-test fCmd-7.3 {FileForceOption: --} {
+test fCmd-7.3 {FileForceOption: --} {notRoot} {
createfile -tf1
file delete -- -tf1
} {}
-test fCmd-7.4 {FileForceOption: bad option} {
+test fCmd-7.4 {FileForceOption: bad option} {notRoot} {
createfile -tf1
set msg [list [catch {file delete -tf1} msg] $msg]
file delete -- -tf1
set msg
} {1 {bad option "-tf1": should be -force or --}}
-test fCmd-7.5 {FileForceOption: multiple times through loop} {
+test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} {
createfile --
createfile -force
file delete -force -force -- -- -force
list [catch {glob -- -- -force} msg] $msg
} {1 {no files matched glob patterns "-- -force"}}
-test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} {unixOnly} {
+test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
+ {unixOnly notRoot knownBug} {
+ # Labelled knownBug because it is dangerous [Bug: 3881]
file mkdir td1
file attr td1 -perm 040000
set result [list [catch {file rename ~$user td1} msg] $msg]
file delete -force td1
set result
} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
+test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
+ {unixOnly notRoot} {
+ file tail ~$user
+} "$user"
-test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly} {
+test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} {
cleanup
file mkdir td1
file mkdir td2
@@ -643,11 +671,11 @@ test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly} {
file delete -force td1
set result
} {1 {error renaming "td1" to "td2/td1": permission denied}}
-test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {
+test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {
cleanup
list [catch {file rename tf1 tf2} msg] $msg
} {1 {error renaming "tf1": no such file or directory}}
-test fCmd-9.3 {file rename: comprehensive: file to new name} {
+test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot} {
cleanup
createfile tf1
createfile tf2
@@ -656,7 +684,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} {
file rename tf2 tf4
list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
} {{tf3 tf4} 1 0}
-test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc} {
+test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot} {
cleanup
file mkdir td1 td2
testchmod 555 td2
@@ -664,7 +692,7 @@ test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc} {
file rename td2 td4
list [lsort [glob td*]] [file writable td3] [file writable td4]
} {{td3 td4} 1 0}
-test fCmd-9.5 {file rename: comprehensive: file to self} {
+test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot} {
cleanup
createfile tf1 tf1
createfile tf2 tf2
@@ -673,7 +701,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} {
file rename -force tf2 tf2
list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} {tf1 tf2 1 0}
-test fCmd-9.6 {file rename: comprehensive: dir to self} {unixOrPc} {
+test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc} {
cleanup
file mkdir td1
file mkdir td2
@@ -682,7 +710,7 @@ test fCmd-9.6 {file rename: comprehensive: dir to self} {unixOrPc} {
file rename -force td2 .
list [lsort [glob td*]] [file writable td1] [file writable td2]
} {{td1 td2} 1 0}
-test fCmd-9.7 {file rename: comprehensive: file to existing file} {
+test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot} {
cleanup
createfile tf1
createfile tf2
@@ -705,7 +733,7 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} {
file rename -force tfs4 tfd4
list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
-test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {
+test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot} {
# Under unix, you can rename a read-only directory, but you can't
# move it into another directory.
@@ -743,7 +771,7 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {
list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
[file writable [file join tdd2 tds2]] $w3 $w4
} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
-test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {
+test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot} {
cleanup
file mkdir tds1
file mkdir tds2
@@ -761,7 +789,7 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {
}
list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
} [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
-test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {
+test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot} {
cleanup
createfile tf1
createfile tf2
@@ -772,7 +800,7 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {
list [catch {glob tf*}] [lsort [glob [file join td1 t*]]] \
[file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
-test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {
+test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot} {
cleanup
file mkdir td1
file mkdir td2
@@ -790,7 +818,7 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {
list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
[file writable [file join td3 td3]] $w4
} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
-test fCmd-9.12 {file rename: comprehensive: target exists} {
+test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot} {
cleanup
file mkdir [file join td1 td2] [file join td2 td1]
if {$tcl_platform(platform) != "macintosh"} {
@@ -805,34 +833,36 @@ test fCmd-9.12 {file rename: comprehensive: target exists} {
}
set msg
} [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
-test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {
+test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {notRoot} {
cleanup
file mkdir [file join td1 td2] [file join td2 td1 td4]
list [catch {file rename -force td1 td2} msg] $msg
} [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
-test fCmd-9.14 {file rename: comprehensive: dir into self} {
+test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
cleanup
file mkdir td1
list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
-test fCmd-9.15 {file rename: comprehensive: source and target incompatible} {
+test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \
+ {notRoot} {
cleanup
file mkdir td1
createfile tf1
list [catch {file rename -force td1 tf1} msg] $msg
} {1 {can't overwrite file "tf1" with directory "td1"}}
-test fCmd-9.16 {file rename: comprehensive: source and target incompatible} {
+test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \
+ {notRoot} {
cleanup
file mkdir td1/tf1
createfile tf1
list [catch {file rename -force tf1 td1} msg] $msg
} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
-test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {
+test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {
cleanup
list [catch {file copy tf1 tf2} msg] $msg
} {1 {error copying "tf1": no such file or directory}}
-test fCmd-10.2 {file copy: comprehensive: file to new name} {
+test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot} {
cleanup
createfile tf1 tf1
createfile tf2 tf2
@@ -841,7 +871,7 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} {
file copy tf2 tf4
list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
-test fCmd-10.3 {file copy: comprehensive: dir to new name} {unixOrPc} {
+test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc} {
cleanup
file mkdir [file join td1 tdx]
file mkdir [file join td2 tdy]
@@ -856,7 +886,7 @@ test fCmd-10.3 {file copy: comprehensive: dir to new name} {unixOrPc} {
}
set msg
} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
-test fCmd-10.4 {file copy: comprehensive: file to existing file} {
+test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot} {
cleanup
createfile tf1
createfile tf2
@@ -879,7 +909,7 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} {
file copy -force tfs4 tfd4
list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
-test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {
+test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot} {
cleanup
file mkdir td1
file mkdir [file join td2 td1]
@@ -904,7 +934,8 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {
set a5 [catch {file copy -force tds4 tdd4}]
list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
-test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} {unixOrPc} {
+test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
+ {notRoot unixOrPc} {
cleanup
file mkdir tds1
file mkdir tds2
@@ -915,7 +946,7 @@ test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} {unixOrPc} {
set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
} [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
-test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {
+test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot} {
cleanup
createfile tf1
createfile tf2
@@ -926,7 +957,8 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {
list [lsort [glob tf*]] [lsort [glob [file join td1 t*]]] \
[file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
-test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} {unixOrPc} {
+test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
+ {notRoot unixOrPc} {
cleanup
file mkdir td1
file mkdir td2
@@ -937,13 +969,15 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} {unixOrPc}
list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
[file writable [file join td3 td3]] [file writable [file join td3 td4]]
} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
-test fCmd-10.9 {file copy: comprehensive: source and target incompatible} {
+test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \
+ {notRoot} {
cleanup
file mkdir td1
createfile tf1
list [catch {file copy -force td1 tf1} msg] $msg
} {1 {can't overwrite file "tf1" with directory "td1"}}
-test fCmd-10.10 {file copy: comprehensive: source and target incompatible} {
+test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \
+ {notRoot} {
cleanup
file mkdir [file join td1 tf1]
createfile tf1
@@ -953,7 +987,7 @@ cleanup
# old tests
-test fCmd-11.1 {TclFileRenameCmd: -- option } {
+test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
catch {file delete -force -- -tfa1}
set s [createfile -tfa1]
file rename -- -tfa1 tfa2
@@ -962,7 +996,7 @@ test fCmd-11.1 {TclFileRenameCmd: -- option } {
set result
} {1}
-test fCmd-11.2 {TclFileRenameCmd: bad option } {
+test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} {
catch {file delete -force -- tfa1}
set s [createfile tfa1]
set r1 [catch {file rename -x tfa1 tfa2}]
@@ -975,7 +1009,7 @@ test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
catch {file rename -- }
} {1}
-test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {
+test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} {
global env
set temp $env(HOME)
unset env(HOME)
@@ -984,7 +1018,7 @@ test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {
set result
} {1}
-test fCmd-11.5 {TclFileRenameCmd: more than one source and target is not a directory} {
+test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
createfile tfa1
createfile tfa2
@@ -994,7 +1028,7 @@ test fCmd-11.5 {TclFileRenameCmd: more than one source and target is not a direc
set result
} {1}
-test fCmd-11.6 {TclFileRenameCmd: : single file into directory } {
+test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} {
catch {file delete -force -- tfa1 tfad}
set s [createfile tfa1]
file mkdir tfad
@@ -1004,7 +1038,7 @@ test fCmd-11.6 {TclFileRenameCmd: : single file into directory } {
set result
} {1}
-test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory } {
+test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
catch {file delete -force -- tfa1 tfa2 tfad}
set s1 [createfile tfa1 ]
set s2 [createfile tfa2 ]
@@ -1019,7 +1053,7 @@ test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory } {
set result
} {1}
-test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory } {
+test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} {
catch {file delete -force -- tfa tfad}
set s [createfile tfa ]
file mkdir tfad
@@ -1035,7 +1069,7 @@ test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory } {
#
# Coverage tests for renamefile() ;
#
-test fCmd-12.1 {renamefile: source filename translation failing} {
+test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} {
global env
set temp $env(HOME)
unset env(HOME)
@@ -1044,7 +1078,7 @@ test fCmd-12.1 {renamefile: source filename translation failing} {
set result
} {1}
-test fCmd-12.2 {renamefile: src filename translation failing} {
+test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} {
global env
set temp $env(HOME)
unset env(HOME)
@@ -1056,13 +1090,13 @@ test fCmd-12.2 {renamefile: src filename translation failing} {
set result
} {1}
-test fCmd-12.3 {renamefile: stat failing on source} {
+test fCmd-12.3 {renamefile: stat failing on source} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
set r1 [catch {file rename tfa1 tfa2}]
expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
} {1}
-test fCmd-12.4 {renamefile: error renaming file to directory } {
+test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} {
catch {file delete -force -- tfa tfad}
set s1 [createfile tfa ]
file mkdir tfad
@@ -1075,7 +1109,7 @@ test fCmd-12.4 {renamefile: error renaming file to directory } {
set result
} {1}
-test fCmd-12.5 {renamefile: error renaming directory to file } {
+test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa
file mkdir tfad
@@ -1089,7 +1123,7 @@ test fCmd-12.5 {renamefile: error renaming directory to file } {
set result
} {1}
-test fCmd-12.6 {renamefile: TclRenameFile succeeding } {
+test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
set s [createfile tfa1]
file rename tfa1 tfa2
@@ -1098,7 +1132,7 @@ test fCmd-12.6 {renamefile: TclRenameFile succeeding } {
set result
} {1}
-test fCmd-12.7 {renamefile: renaming directory into offspring} {
+test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
catch {file delete -force -- tfad}
file mkdir tfad
file mkdir tfad/dir
@@ -1107,7 +1141,7 @@ test fCmd-12.7 {renamefile: renaming directory into offspring} {
set result
} {1}
-test fCmd-12.8 {renamefile: generic error } {unixOnly} {
+test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/dir
@@ -1119,7 +1153,7 @@ test fCmd-12.8 {renamefile: generic error } {unixOnly} {
} {1}
-test fCmd-12.9 {renamefile: moving a file across volumes } {unixOnly} {
+test fCmd-12.9 {renamefile: moving a file across volumes} {unixOnly notRoot} {
catch {file delete -force -- tfa /tmp/tfa}
set s [createfile tfa ]
file rename tfa /tmp
@@ -1128,7 +1162,8 @@ test fCmd-12.9 {renamefile: moving a file across volumes } {unixOnly} {
set result
} {1}
-test fCmd-12.10 {renamefile: moving a directory across volumes } {unixOnly} {
+test fCmd-12.10 {renamefile: moving a directory across volumes } \
+ {unixOnly notRoot} {
catch {file delete -force -- tfad /tmp/tfad}
file mkdir tfad
set s [createfile tfad/a ]
@@ -1141,7 +1176,7 @@ test fCmd-12.10 {renamefile: moving a directory across volumes } {unixOnly} {
#
# Coverage tests for TclCopyFilesCmd()
#
-test fCmd-13.1 {TclCopyFilesCmd: -force option } {
+test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} {
catch {file delete -force -- tfa1}
set s [createfile tfa1]
file copy -force tfa1 tfa2
@@ -1150,7 +1185,7 @@ test fCmd-13.1 {TclCopyFilesCmd: -force option } {
set result
} {1}
-test fCmd-13.2 {TclCopyFilesCmd: -- option } {
+test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} {
catch {file delete -force -- tfa1}
set s [createfile -tfa1]
file copy -- -tfa1 tfa2
@@ -1159,7 +1194,7 @@ test fCmd-13.2 {TclCopyFilesCmd: -- option } {
set result
} {1}
-test fCmd-13.3 {TclCopyFilesCmd: bad option } {
+test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} {
catch {file delete -force -- tfa1}
set s [createfile tfa1]
set r1 [catch {file copy -x tfa1 tfa2}]
@@ -1168,7 +1203,7 @@ test fCmd-13.3 {TclCopyFilesCmd: bad option } {
set result
} {1}
-test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {
+test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
catch {file copy -- }
} {1}
@@ -1181,7 +1216,7 @@ test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
set result
} {1}
-test fCmd-13.6 {TclCopyFilesCmd: more than one source and target is not a directory} {
+test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
createfile tfa1
createfile tfa2
@@ -1191,7 +1226,7 @@ test fCmd-13.6 {TclCopyFilesCmd: more than one source and target is not a direct
set result
} {1}
-test fCmd-13.7 {TclCopyFilesCmd: : single file into directory } {
+test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} {
catch {file delete -force -- tfa1 tfad}
set s [createfile tfa1]
file mkdir tfad
@@ -1201,7 +1236,7 @@ test fCmd-13.7 {TclCopyFilesCmd: : single file into directory } {
set result
} {1}
-test fCmd-13.8 {TclCopyFilesCmd: : multiple files into directory } {
+test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} {
catch {file delete -force -- tfa1 tfa2 tfad}
set s1 [createfile tfa1 ]
set s2 [createfile tfa2 ]
@@ -1217,7 +1252,7 @@ test fCmd-13.8 {TclCopyFilesCmd: : multiple files into directory } {
set result
} {1}
-test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory } {
+test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
catch {file delete -force -- tfa tfad}
set s [createfile tfa ]
file mkdir tfad
@@ -1233,7 +1268,7 @@ test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory } {
#
# Coverage tests for copyfile()
#
-test fCmd-14.1 {copyfile: source filename translation failing} {
+test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
global env
set temp $env(HOME)
unset env(HOME)
@@ -1242,7 +1277,7 @@ test fCmd-14.1 {copyfile: source filename translation failing} {
set result
} {1}
-test fCmd-14.2 {copyfile: dst filename translation failing} {
+test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {
global env
set temp $env(HOME)
unset env(HOME)
@@ -1255,13 +1290,13 @@ test fCmd-14.2 {copyfile: dst filename translation failing} {
set result
} {1}
-test fCmd-14.3 {copyfile: stat failing on source} {
+test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
set r1 [catch {file copy tfa1 tfa2}]
expr $r1 && ![file exists tfa1] && ![file exists tfa2]
} {1}
-test fCmd-14.4 {copyfile: error copying file to directory } {
+test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {
catch {file delete -force -- tfa tfad}
set s1 [createfile tfa ]
file mkdir tfad
@@ -1275,7 +1310,7 @@ test fCmd-14.4 {copyfile: error copying file to directory } {
set result
} {1}
- test fCmd-14.5 {copyfile: error copying directory to file } {
+ test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa
file mkdir tfad
@@ -1289,7 +1324,7 @@ test fCmd-14.4 {copyfile: error copying file to directory } {
set result
} {1}
-test fCmd-14.6 {copyfile: copy file succeeding } {
+test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {
catch {file delete -force -- tfa tfa2}
set s [createfile tfa]
file copy tfa tfa2
@@ -1298,7 +1333,7 @@ test fCmd-14.6 {copyfile: copy file succeeding } {
set result
} {1}
-test fCmd-14.7 {copyfile: copy directory succeeding } {
+test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
catch {file delete -force -- tfa tfa2}
file mkdir tfa
set s [createfile tfa/file]
@@ -1308,7 +1343,7 @@ test fCmd-14.7 {copyfile: copy directory succeeding } {
set result
} {1}
-test fCmd-14.8 {copyfile: copy directory failing } {unixOnly} {
+test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa/dir/a/b/c
exec chmod 000 tfa/dir
@@ -1322,7 +1357,7 @@ test fCmd-14.8 {copyfile: copy directory failing } {unixOnly} {
#
# Coverage tests for TclMkdirCmd()
#
-test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {
+test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
global env
set temp $env(HOME)
unset env(HOME)
@@ -1334,7 +1369,7 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {
# Can Tcl_SplitPath return argc == 0? If so them we need a
# test for that code.
#
-test fCmd-15.2 {TclMakeDirsCmd - one directory } {
+test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
set result [file isdirectory tfa]
@@ -1342,7 +1377,7 @@ test fCmd-15.2 {TclMakeDirsCmd - one directory } {
set result
} {1}
-test fCmd-15.3 {TclMakeDirsCmd: - two directories } {
+test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
file mkdir tfa1 tfa2
set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
@@ -1350,7 +1385,7 @@ test fCmd-15.3 {TclMakeDirsCmd: - two directories } {
set result
} {1}
-test fCmd-15.4 {TclMakeDirsCmd - stat failing } {unixOnly} {
+test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
createfile tfa/file
@@ -1361,7 +1396,8 @@ test fCmd-15.4 {TclMakeDirsCmd - stat failing } {unixOnly} {
set result
} {1}
-test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep } {
+test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \
+ {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa/a/b/c
set result [file isdir tfa/a/b/c]
@@ -1370,7 +1406,7 @@ test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep } {
} {1}
-test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file } {
+test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {
catch {file delete -force -- tfa}
set s [createfile tfa]
set r1 [catch {file mkdir tfa}]
@@ -1381,7 +1417,7 @@ test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file } {
set result
} {1}
-test fCmd-15.7 {TclMakeDirsCmd - making several directories } {
+test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
file mkdir tfa1 tfa2/a/b/c
set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
@@ -1389,7 +1425,7 @@ test fCmd-15.7 {TclMakeDirsCmd - making several directories } {
set result
} {1}
-test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {
+test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {
file mkdir tfa
file mkdir tfa
set result [file isdir tfa]
@@ -1399,21 +1435,21 @@ test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {
# Coverage tests for TclDeleteFilesCommand()
-test fCmd-16.1 { test the -- argument } {
+test fCmd-16.1 { test the -- argument } {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
file delete -- tfa
file exists tfa
} {0}
-test fCmd-16.2 { test the -force and -- arguments } {
+test fCmd-16.2 { test the -force and -- arguments } {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
file delete -force -- tfa
file exists tfa
} {0}
-test fCmd-16.3 { test bad option } {
+test fCmd-16.3 { test bad option } {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
set result [catch {file delete -dog tfa}]
@@ -1421,15 +1457,15 @@ test fCmd-16.3 { test bad option } {
set result
} {1}
-test fCmd-16.4 { test not enough args } {
+test fCmd-16.4 { test not enough args } {notRoot} {
catch {file delete}
} {1}
-test fCmd-16.5 { test not enough args with options } {
+test fCmd-16.5 { test not enough args with options } {notRoot} {
catch {file delete --}
} {1}
-test fCmd-16.6 {delete: source filename translation failing} {
+test fCmd-16.6 {delete: source filename translation failing} {notRoot} {
global env
set temp $env(HOME)
unset env(HOME)
@@ -1438,7 +1474,7 @@ test fCmd-16.6 {delete: source filename translation failing} {
set result
} {1}
-test fCmd-16.7 {remove a non-empty directory without -force } {
+test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
createfile tfa/a
@@ -1447,7 +1483,7 @@ test fCmd-16.7 {remove a non-empty directory without -force } {
set result
} {1}
-test fCmd-16.8 {remove a normal file } {
+test fCmd-16.8 {remove a normal file } {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
createfile tfa/a
@@ -1456,7 +1492,7 @@ test fCmd-16.8 {remove a normal file } {
set result
} {1}
-test fCmd-16.9 {error while deleting file } {unixOnly} {
+test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
createfile tfa/a
@@ -1472,7 +1508,7 @@ test fCmd-16.9 {error while deleting file } {unixOnly} {
set result
} {1}
-test fCmd-16.10 {deleting multiple files } {
+test fCmd-16.10 {deleting multiple files} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
createfile tfa1
createfile tfa2
@@ -1480,14 +1516,14 @@ test fCmd-16.10 {deleting multiple files } {
expr ![file exists tfa1] && ![file exists tfa2]
} {1}
-test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {
+test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
catch {file delete -force -- tfa}
file delete tfa
set result 1
} {1}
# More coverage tests for mkpath()
- test fCmd-17.1 {mkdir stat failing on target but not ENOENT } {unixOnly} {
+ test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {
catch {file delete -force -- tfa1}
file mkdir tfa1
exec chmod 555 tfa1
@@ -1497,7 +1533,7 @@ test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {
set result
} {1}
-test fCmd-17.2 {mkdir several levels deep - relative } {
+test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa/a/b
set result [file isdir tfa/a/b ]
@@ -1505,7 +1541,7 @@ test fCmd-17.2 {mkdir several levels deep - relative } {
set result
} {1}
-test fCmd-17.3 {mkdir several levels deep - absolute } {
+test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {
catch {file delete -force -- tfa}
set f [file join [pwd] tfa a ]
file mkdir $f
@@ -1518,7 +1554,8 @@ test fCmd-17.3 {mkdir several levels deep - absolute } {
# Functionality tests for TclFileRenameCmd()
#
-test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} {
+test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
+ {notRoot} {
catch {file delete -force -- tfad}
file mkdir tfad/dir
cd tfad/dir
@@ -1538,7 +1575,7 @@ test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} {
set result
} {1}
-test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant } {
+test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
file mkdir tfa1
file rename tfa1 tfa2
@@ -1547,7 +1584,7 @@ test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant } {
set result
} {1}
-test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory } {
+test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {
catch {file delete -force -- tfa1 tfad1 tfad2}
set s [createfile tfa1 ]
file mkdir tfad1 tfad2
@@ -1560,7 +1597,7 @@ test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory } {
set result
} {1}
-test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir } {
+test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {
catch {file delete -force -- tfa tfad}
set s [createfile tfa ]
file mkdir tfad
@@ -1572,7 +1609,7 @@ test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir } {
set result
} {1}
-test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir } {
+test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {
catch {file delete -force -- tfa tfad}
set s [createfile tfa ]
file mkdir tfad/tfa
@@ -1587,7 +1624,7 @@ test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir } {
#
# On Windows there is no easy way to determine if two files are the same
#
-test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix} {
+test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} {
catch {file delete -force -- tfa}
set s [createfile tfa]
set r1 [catch {file rename tfa tfa}]
@@ -1596,7 +1633,8 @@ test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix} {
set result
} {1}
-test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} {
+test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \
+ {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa tfad/tfa
set r1 [catch {file rename tfa tfad}]
@@ -1605,7 +1643,8 @@ test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -fo
set result
} {1}
-test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} {
+test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \
+ {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa tfad/tfa
file rename -force tfa tfad
@@ -1614,7 +1653,8 @@ test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -for
set result
} {1}
-test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} {
+test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \
+ {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa tfad/tfa/file
set r1 [catch {file rename tfa tfad}]
@@ -1623,7 +1663,8 @@ test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -forc
set result
} {1}
-test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} {
+test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \
+ {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa tfad/tfa/file
set r1 [catch {file rename -force tfa tfad}]
@@ -1632,13 +1673,14 @@ test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -forc
set result
} {1}
-test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {
+test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {
catch {file delete -force -- tfa1}
set r1 [catch {file rename tfa1 tfa2}]
set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
} {1}
-test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} {unixOnly} {
+test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
+ {unixOnly notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
set s [createfile tfa1]
@@ -1650,7 +1692,8 @@ test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} {unixOnly} {
set result
} {1}
-test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} {unixOnly} {
+test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
+ {unixOnly notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
file mkdir tfa1
@@ -1662,7 +1705,8 @@ test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} {unixOnly} {
set result
} {1}
-test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} {unixOnly} {
+test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
+ {unixOnly notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
file mkdir tfa1/a/b/c/d
@@ -1678,7 +1722,8 @@ test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} {unixOnly} {
set result
} {1}
-test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} {unixOnly} {
+test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
+ {unixOnly notRoot} {
catch {file delete -force -- tfa1 tfa2 tfalink}
file mkdir tfa1
@@ -1691,7 +1736,7 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} {unixOnly} {
set result
} {1}
-test fCmd-18.16 {TclFileRenameCmd : rename a dangling symlink} {unixOnly} {
+test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} {
catch {file delete -force -- tfa1 tfalink}
file mkdir tfa1
@@ -1707,14 +1752,14 @@ test fCmd-18.16 {TclFileRenameCmd : rename a dangling symlink} {unixOnly} {
#
# Coverage tests for TclUnixRmdir
#
-test fCmd-19.1 { remove empty directory } {
+test fCmd-19.1 { remove empty directory } {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file delete tfa
file exists tfa
} {0}
-test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly} {
+test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
@@ -1725,7 +1770,7 @@ test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly} {
set result
} {1}
-test fCmd-19.3 { recursive remove } {
+test fCmd-19.3 { recursive remove } {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
@@ -1743,7 +1788,8 @@ test fCmd-19.3 { recursive remove } {
# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
#
-test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } {unixOnly} {
+test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
+ {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
@@ -1758,7 +1804,7 @@ test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } {u
#
# Feature testing for TclCopyFilesCmd
#
-test fCmd-21.1 {copy : single file to nonexistant } {
+test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
catch {file delete -force -- tfa1 tfa2}
set s [createfile tfa1]
file copy tfa1 tfa2
@@ -1767,7 +1813,7 @@ test fCmd-21.1 {copy : single file to nonexistant } {
set result
} {1}
-test fCmd-21.2 {copy : single dir to nonexistant } {
+test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {
catch {file delete -force -- tfa1 tfa2}
file mkdir tfa1
file copy tfa1 tfa2
@@ -1776,7 +1822,7 @@ test fCmd-21.2 {copy : single dir to nonexistant } {
set result
} {1}
-test fCmd-21.3 {copy : single file into directory } {
+test fCmd-21.3 {copy : single file into directory } {notRoot} {
catch {file delete -force -- tfa1 tfad}
set s [createfile tfa1]
file mkdir tfad
@@ -1786,7 +1832,8 @@ test fCmd-21.3 {copy : single file into directory } {
set result
} {1}
-test fCmd-21.4 {copy : more than one source and target is not a directory} {
+test fCmd-21.4 {copy : more than one source and target is not a directory} \
+ {notRoot} {
catch {file delete -force -- tfa1 tfa2 tfa3}
createfile tfa1
createfile tfa2
@@ -1796,7 +1843,7 @@ test fCmd-21.4 {copy : more than one source and target is not a directory} {
set result
} {1}
-test fCmd-21.5 {copy : multiple files into directory } {
+test fCmd-21.5 {copy : multiple files into directory } {notRoot} {
catch {file delete -force -- tfa1 tfa2 tfad}
set s1 [createfile tfa1 ]
set s2 [createfile tfa2 ]
@@ -1811,7 +1858,8 @@ test fCmd-21.5 {copy : multiple files into directory } {
set result
} {1}
-test fCmd-21.6 {copy : mixed dirs and files into directory } {notFileSharing} {
+test fCmd-21.6 {copy: mixed dirs and files into directory} \
+ {notRoot notFileSharing} {
catch {file delete -force -- tfa1 tfad1 tfad2}
set s [createfile tfa1 ]
file mkdir tfad1 tfad2
@@ -1824,7 +1872,7 @@ test fCmd-21.6 {copy : mixed dirs and files into directory } {notFileSharing} {
set result
} {1}
-test fCmd-21.7 {TclCopyFilesCmd : copy a dangling link } {unixOnly} {
+test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
file mkdir tfad1
exec ln -s tfad1 tfalink
file delete tfad1
@@ -1834,7 +1882,7 @@ test fCmd-21.7 {TclCopyFilesCmd : copy a dangling link } {unixOnly} {
set result
} {1}
-test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly} {
+test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} {
file mkdir tfad1
exec ln -s tfad1 tfalink
file copy tfalink tfalink2
@@ -1846,7 +1894,7 @@ test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly} {
set result
} {1}
-test fCmd-21.9 {TclCopyFilesCmd : copy dir with a link in it } {unixOnly} {
+test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {
file mkdir tfad1
exec ln -s "[pwd]/tfad1" tfad1/tfalink
file copy tfad1 tfad2
@@ -1855,7 +1903,8 @@ test fCmd-21.9 {TclCopyFilesCmd : copy dir with a link in it } {unixOnly} {
set result
} {1}
-test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} {
+test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \
+ {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa [file join tfad tfa]
set r1 [catch {file copy tfa tfad}]
@@ -1864,7 +1913,7 @@ test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force
set result
} {1}
-test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {
+test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa [file join tfad tfa file]
set r1 [catch {file copy tfa tfad}]
@@ -1873,7 +1922,8 @@ test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {
set result
} {1}
-test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} {
+test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \
+ {notRoot} {
catch {file delete -force -- tfa tfad}
file mkdir tfa [file join tfad tfa file]
set r1 [catch {file copy -force tfa tfad}]
@@ -1885,7 +1935,7 @@ test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} {
#
# Coverage testing for TclpRenameFile
#
-test fCmd-22.1 { TclpRenameFile : rename and overwrite in a single dir } {
+test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
set s [createfile tfa1]
set s2 [createfile tfa2 q]
@@ -1897,7 +1947,7 @@ test fCmd-22.1 { TclpRenameFile : rename and overwrite in a single dir } {
set result
} {1}
-test fCmd-22.2 { TclpRenameFile : attempt to overwrite itself } {macOrUnix} {
+test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} {
catch {file delete -force -- tfa1}
set s [createfile tfa1]
file rename -force tfa1 tfa1
@@ -1906,7 +1956,7 @@ test fCmd-22.2 { TclpRenameFile : attempt to overwrite itself } {macOrUnix} {
set result
} {1}
-test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {
+test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {notRoot} {
catch {file delete -force -- d1 tfad}
file mkdir d1 [file join tfad d1]
set r1 [catch {file rename d1 tfad}]
@@ -1915,7 +1965,7 @@ test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {
set result
} {1}
-test fCmd-22.4 { TclpRenameFile : rename dir to dir several levels deep } {
+test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {
catch {file delete -force -- d1 tfad}
file mkdir d1 [file join tfad a b c]
file rename d1 [file join tfad a b c d1]
@@ -1928,7 +1978,7 @@ test fCmd-22.4 { TclpRenameFile : rename dir to dir several levels deep } {
#
# TclMacCopyFile needs to be redone.
#
-test fCmd-22.5 { TclMacCopyFile : copy and overwrite in a single dir } {
+test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
catch {file delete -force -- tfa1 tfa2}
set s [createfile tfa1]
set s2 [createfile tfa2 q]
@@ -1950,7 +2000,7 @@ test fCmd-22.5 { TclMacCopyFile : copy and overwrite in a single dir } {
# Error cases are not covered.
#
-test fCmd-23.1 { TclMacRmdir : trying to remove a nonempty directory } {
+test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
catch {file delete -force -- tfad}
file mkdir [file join tfad dir]
@@ -1964,7 +2014,7 @@ test fCmd-23.1 { TclMacRmdir : trying to remove a nonempty directory } {
# TclMacDeleteFile
# Error cases are not covered.
#
-test fCmd-24.1 { TclMacDeleteFile : deleting a normal file } {
+test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
catch {file delete -force -- tfa1}
createfile tfa1
@@ -1976,7 +2026,8 @@ test fCmd-24.1 { TclMacDeleteFile : deleting a normal file } {
# TclMacCopyDirectory
# Error cases are not covered.
#
-test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} {notFileSharing} {
+test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} \
+ {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir [file join tfad1 a b c]
@@ -1986,7 +2037,8 @@ test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} {notFileShari
set result
} {1}
-test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} {notFileSharing} {
+test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} \
+ {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
@@ -1996,7 +2048,8 @@ test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} {n
set result
} {1}
-test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} {notFileSharing} {
+test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} \
+ {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir [file join tfad1 x y z]
@@ -2011,7 +2064,7 @@ test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} {not
# Functionality tests for TclDeleteFilesCmd
#
-test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly} {
+test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
@@ -2026,7 +2079,7 @@ test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly} {
set result
} {1}
-test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly} {
+test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
@@ -2042,7 +2095,7 @@ test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly} {
set result
} {1}
-test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly} {
+test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
@@ -2057,13 +2110,10 @@ test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly} {
set result
} {1}
-test fCmd-27.1 {TclFileAttrsCmd - wrong # args} {
- list [catch {file attributes a b c d} msg] $msg
-} {1 {wrong # args: must be "file attributes name ?option? ?value? ?option value? ..."}}
test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {
testsetplatform unix
- list [catch {file attributes ~_bad_user} msg] $msg [testsetplatform $platform]
-} {1 {user "_bad_user" doesn't exist} {}}
+ list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform]
+} {1 {user "_totally_bogus_user" doesn't exist} {}}
test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
catch {file delete -force -- foo.tmp}
createfile foo.tmp
@@ -2076,27 +2126,46 @@ test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]
} {0 {}}
-set testConfig(tclGroup) 0
-if {($tcl_platform(platform) == "macintosh") \
- || ($tcl_platform(platform) == "windows")} {
- set testConfig(tclGroup) 1
-} elseif {[catch {exec {groups}} groupList] == 0} {
- if {[lsearch $groupList tcl] != -1} {
- set testConfig(tclGroup) 1
+# Find a group that exists on this Unix system, or else skip tests that
+# require Unix groups.
+if {$tcl_platform(platform) == "unix"} {
+ set ::tcltest::testConstraints(foundGroup) 0
+ catch {
+ set groupList [exec groups]
+ set group [lindex $groupList 0]
+ set ::tcltest::testConstraints(foundGroup) 1
}
+} else {
+ set ::tcltest::testConstraints(foundGroup) 1
}
-test fCmd-27.5 {TclFileAttrsCmd - setting one option} {tclGroup} {
+test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
catch {file delete -force -- foo.tmp}
createfile foo.tmp
set attrs [file attributes foo.tmp]
list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
} {0 {} {}}
-test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {tclGroup} {
+test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
catch {file delete -force -- foo.tmp}
createfile foo.tmp
set attrs [file attributes foo.tmp]
list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
} {0 {} {}}
+# cleanup
cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/fileName.test b/tcl/tests/fileName.test
index c095582ecd7..89175d4fb68 100644
--- a/tcl/tests/fileName.test
+++ b/tcl/tests/fileName.test
@@ -5,17 +5,22 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
if {[info commands testsetplatform] == {}} {
puts "This application hasn't been compiled with the \"testsetplatform\""
puts "command, so I can't test the filename conversion procedures."
+ ::tcltest::cleanupTests
return
}
@@ -1028,11 +1033,11 @@ test filename-10.22 {Tcl_TranslateFileName} {
testsetplatform $platform
-test filename-10.23 {Tcl_TranslateFileName} {nonPortable unixOnly} {
+test filename-10.23 {Tcl_TranslateFileName} {unixOnly nonPortable} {
# this test fails if ~ouster is not /home/ouster
list [catch {testtranslatefilename ~ouster} msg] $msg
} {0 /home/ouster}
-test filename-10.24 {Tcl_TranslateFileName} {nonPortable unixOnly} {
+test filename-10.24 {Tcl_TranslateFileName} {unixOnly nonPortable} {
# this test fails if ~ouster is not /home/ouster
list [catch {testtranslatefilename ~ouster/foo} msg] $msg
} {0 /home/ouster/foo}
@@ -1043,10 +1048,10 @@ test filename-11.1 {Tcl_GlobCmd} {
} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
test filename-11.2 {Tcl_GlobCmd} {
list [catch {glob -gorp} msg] $msg
-} {1 {bad switch "-gorp": must be -nocomplain or --}}
+} {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -types, or --}}
test filename-11.3 {Tcl_GlobCmd} {
list [catch {glob -nocomplai} msg] $msg
-} {1 {bad switch "-nocomplai": must be -nocomplain or --}}
+} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
test filename-11.4 {Tcl_GlobCmd} {
list [catch {glob -nocomplain} msg] $msg
} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
@@ -1058,14 +1063,14 @@ test filename-11.6 {Tcl_GlobCmd} {
} {1 {user "xyqrszzz" doesn't exist}}
test filename-11.7 {Tcl_GlobCmd} {
list [catch {glob -- -nocomplain} msg] $msg
-} {1 {no files matched glob patterns "-nocomplain"}}
+} {1 {no files matched glob pattern "-nocomplain"}}
test filename-11.8 {Tcl_GlobCmd} {
list [catch {glob -nocomplain -- -nocomplain} msg] $msg
} {0 {}}
test filename-11.9 {Tcl_GlobCmd} {
testsetplatform unix
list [catch {glob ~\\xyqrszzz/bar} msg] $msg
-} {1 {globbing characters not supported in user names}}
+} {1 {user "\xyqrszzz" doesn't exist}}
test filename-11.10 {Tcl_GlobCmd} {
testsetplatform unix
list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg
@@ -1103,10 +1108,6 @@ close [open "globTest/weird name.c" w]
close [open globTest/a1/b1/x2.c w]
close [open globTest/a1/b2/y2.c w]
-# Cannot create a file with the following names under Win32s. We have to
-# skip the tests that are checking the difference between a "." or "," in
-# the file name vs. a "." or "," in the glob pattern.
-
catch {close [open globTest/.1 w]}
catch {close [open globTest/x,z1.c w]}
@@ -1120,6 +1121,112 @@ test filename-11.16 {Tcl_GlobCmd} {
list [catch {glob globTest} msg] $msg
} {0 globTest}
+set globname "globTest"
+set horribleglobname "glob\[\{Test"
+
+test filename-11.17 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -directory $globname *]} msg] $msg
+} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname a3]\
+ [file join $globname "weird name.c"]\
+ [file join $globname x,z1.c]\
+ [file join $globname x1.c]\
+ [file join $globname y1.c] [file join $globname z1.c]]]]
+test filename-11.18 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -path $globname/ *]} msg] $msg
+} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname a3]\
+ [file join $globname "weird name.c"]\
+ [file join $globname x,z1.c]\
+ [file join $globname x1.c]\
+ [file join $globname y1.c] [file join $globname z1.c]]]]
+test filename-11.19 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -join -path \
+ [string range $globname 0 5] * *]} msg] $msg
+} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname a3]\
+ [file join $globname "weird name.c"]\
+ [file join $globname x,z1.c]\
+ [file join $globname x1.c]\
+ [file join $globname y1.c] [file join $globname z1.c]]]]
+test filename-11.20 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
+} [list 0 [lsort [list [file join $globname a1]\
+ [file join $globname a2]\
+ [file join $globname a3]]]]
+test filename-11.21 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -type d -path $globname *]} msg] $msg
+} [list 0 [lsort [list $globname]]]
+
+file rename globTest $horribleglobname
+set globname $horribleglobname
+
+test filename-11.22 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -dir $globname *]} msg] $msg
+} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname a3]\
+ [file join $globname "weird name.c"]\
+ [file join $globname x,z1.c]\
+ [file join $globname x1.c]\
+ [file join $globname y1.c] [file join $globname z1.c]]]]
+test filename-11.23 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -path $globname/ *]} msg] $msg
+} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname a3]\
+ [file join $globname "weird name.c"]\
+ [file join $globname x,z1.c]\
+ [file join $globname x1.c]\
+ [file join $globname y1.c] [file join $globname z1.c]]]]
+test filename-11.24 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -join -path \
+ [string range $globname 0 5] * *]} msg] $msg
+} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+ [file join $globname a3]\
+ [file join $globname "weird name.c"]\
+ [file join $globname x,z1.c]\
+ [file join $globname x1.c]\
+ [file join $globname y1.c] [file join $globname z1.c]]]]
+test filename-11.25 {Tcl_GlobCmd} {
+ list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
+} [list 0 [lsort [list [file join $globname a1]\
+ [file join $globname a2]\
+ [file join $globname a3]]]]
+test filename-11.26 {Tcl_GlobCmd} {
+ list [catch {glob -type d -path $globname *} msg] $msg
+} [list 0 [list $globname]]
+test filename-11.27 {Tcl_GlobCmd} {
+ list [catch {glob -types abcde *} msg] $msg
+} {1 {bad argument to "-types": abcde}}
+test filename-11.28 {Tcl_GlobCmd} {
+ list [catch {glob -types z *} msg] $msg
+} {1 {bad argument to "-types": z}}
+test filename-11.29 {Tcl_GlobCmd} {
+ list [catch {glob -types {abcd efgh} *} msg] $msg
+} {1 {only one MacOS type or creator argument to "-types" allowed}}
+test filename-11.30 {Tcl_GlobCmd} {
+ list [catch {glob -types {{macintosh type TEXT} \
+ {macintosh creator ALFA} efgh} *} msg] $msg
+} {1 {only one MacOS type or creator argument to "-types" allowed}}
+test filename-11.31 {Tcl_GlobCmd} {
+ list [catch {glob -types} msg] $msg
+} {1 {missing argument to "-types"}}
+test filename-11.32 {Tcl_GlobCmd} {
+ list [catch {glob -path hello -dir hello *} msg] $msg
+} {1 {"-directory" cannot be used with "-path"}}
+test filename-11.33 {Tcl_GlobCmd} {
+ list [catch {glob -path} msg] $msg
+} {1 {missing argument to "-path"}}
+test filename-11.34 {Tcl_GlobCmd} {
+ list [catch {glob -direct} msg] $msg
+} {1 {missing argument to "-directory"}}
+test filename-11.35 {Tcl_GlobCmd} {
+ list [catch {glob -paths *} msg] $msg
+} {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -types, or --}}
+
+file rename $horribleglobname globTest
+set globname globTest
+unset horribleglobname
+
test filename-12.1 {simple globbing} {unixOrPc} {
list [catch {glob {}} msg] $msg
} {0 .}
@@ -1171,13 +1278,13 @@ test filename-13.7 {globbing with brace substitution} {
test filename-13.8 {globbing with brace substitution} {
list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg
} "0 $globPreResult$x1"
-test filename-13.9 {globbing with brace substitution} {!win32s} {
+test filename-13.9 {globbing with brace substitution} {
list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg
} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
-test filename-13.10 {globbing with brace substitution} {!win32s} {
+test filename-13.10 {globbing with brace substitution} {
list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
-test filename-13.11 {globbing with brace substitution} {unixOrPc && !win32s} {
+test filename-13.11 {globbing with brace substitution} {unixOrPc} {
list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
} {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
test filename-13.12 {globbing with brace substitution} {macOnly} {
@@ -1214,14 +1321,11 @@ test filename-13.22 {globbing with brace substitution} {
list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
} {1 {unmatched open-brace in file name}}
-test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
- lsort [glob g*/*.c]
+test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
+ lsort [glob glo*/*.c]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.1 {asterisks, question marks, and brackets} {win32s} {
- lsort [glob g*/*.c]
-} {globtest/weirdn~1.c globtest/x1.c globtest/y1.c globtest/z1.c}
test filename-14.2 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob g*/*.c]
+ lsort [glob glo*/*.c]
} {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
lsort [glob globTest/?1.c]
@@ -1229,30 +1333,21 @@ test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
test filename-14.4 {asterisks, question marks, and brackets} {macOnly} {
lsort [glob globTest/?1.c]
} {:globTest:x1.c :globTest:y1.c :globTest:z1.c}
-test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
+test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} {
lsort [glob */*/*/*.c]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-test filename-14.5 {asterisks, question marks, and brackets} {win32s} {
- lsort [glob */*/*/*.c]
-} {globtest/a1/b1/x2.c globtest/a1/b2/y2.c}
test filename-14.6 {asterisks, question marks, and brackets} {macOnly} {
lsort [glob */*/*/*.c]
} {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
-test filename-14.7 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
+test filename-14.7 {asterisks, question marks, and brackets} {unixOrPc} {
lsort [glob globTest/*]
} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.7 {asterisks, question marks, and brackets} {win32s} {
- lsort [glob globTest/*]
-} {globTest/a1 globTest/a2 globTest/a3 globTest/weirdn~1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.8 {asterisks, question marks, and brackets} {macOnly} {
lsort [glob globTest/*]
} {:globTest:.1 :globTest:a1 :globTest:a2 :globTest:a3 {:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
-test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
+test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} {
lsort [glob globTest/.*]
} {globTest/. globTest/.. globTest/.1}
-test filename-14.9 {asterisks, question marks, and brackets} {win32s} {
- lsort [glob globTest/.*]
-} {globTest/. globTest/..}
test filename-14.10 {asterisks, question marks, and brackets} {macOnly} {
lsort [glob globTest/.*]
} {:globTest:.1}
@@ -1282,12 +1377,9 @@ test filename-14.17 {asterisks, question marks, and brackets} {
set env(HOME) $temp
set result
} [list 0 [list [file join $env(HOME) globTest z1.c]]]
-test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc && !win32s} {
+test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} {
list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
} {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
-test filename-14.18 {asterisks, question marks, and brackets} {win32s} {
- list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
-} {0 {globTest/weirdn~1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
test filename-14.19 {asterisks, question marks, and brackets} {macOnly} {
list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
} {0 {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}}
@@ -1306,144 +1398,152 @@ test filename-14.23 {slash globbing} {unixOrPc} {
test filename-14.24 {slash globbing} {pcOnly} {
glob {\\}
} /
+test filename-14.25 {type specific globbing} {
+ list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
+} [list 0 [lsort [list \
+ [file join $globname "weird name.c"]\
+ [file join $globname x,z1.c]\
+ [file join $globname x1.c]\
+ [file join $globname y1.c] [file join $globname z1.c]]]]
+test filename-14.26 {type specific globbing} {
+ list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg
+} [list 0 {}]
+
+unset globname
# The following tests are only valid for Unix systems.
+# On some systems, like AFS, "000" protection doesn't prevent
+# access by owner, so the following test is not portable.
-if {$tcl_platform(platform) == "unix"} {
- # On some systems, like AFS, "000" protection doesn't prevent
- # access by owner, so the following test is not portable.
+catch {exec chmod 000 globTest/a1}
+test filename-15.1 {unix specific globbing} {unixOnly nonPortable} {
+ string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
+} {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
+test filename-15.2 {unix specific no complain: no errors} {unixOnly nonPortable} {
+ glob -nocomplain globTest/a1/*
+} {}
+test filename-15.3 {unix specific no complain: no errors, good result} \
+ {unixOnly nonPortable knownBug} {
+ # test fails because if an error occur , the interp's result
+ # is reset...
+ glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
+} {globTest/a2 globTest/a3}
- exec chmod 000 globTest/a1
- test filename-15.1 {unix specific globbing} {nonPortable} {
- string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
- } {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
- test filename-15.2 {unix specific no complain: no errors} {nonPortable} {
- glob -nocomplain globTest/a1/*
- } {}
- test filename-15.3 {unix specific no complain: no errors, good result} {nonPortable knownBug} {
- # test fails because if an error occur , the interp's result
- # is reset...
- glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
- } {globTest/a2 globTest/a3}
- exec chmod 755 globTest/a1
- test filename-15.4 {unix specific no complain: no errors, good result} {nonPortable knownBug} {
- # test fails because if an error occur , the interp's result
- # is reset... (or you don't run at sunscript where the
- # outser and demailly's users exists
- glob -nocomplain ~ouster ~foo ~demailly
- } {/home/ouster /home/demailly}
- test filename-15.5 {unix specific globbing} {nonPortable} {
- glob ~ouster/.csh*
- } "/home/ouster/.cshrc"
- close [open globTest/odd\\\[\]*?\{\}name w]
- test filename-15.6 {unix specific globbing} {
- global env
- set temp $env(HOME)
- set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
- set result [list [catch {glob ~} msg] $msg]
- set env(HOME) $temp
- set result
- } [list 0 [list [glob ~]/globTest/odd\\\[\]*?\{\}name]]
- exec rm -f globTest/odd\\\[\]*?\{\}name
-}
+catch {exec chmod 755 globTest/a1}
+test filename-15.4 {unix specific no complain: no errors, good result} \
+ {unixOnly nonPortable knownBug} {
+ # test fails because if an error occurs, the interp's result
+ # is reset... or you don't run at scriptics where the
+ # outser and welch users exists
+ glob -nocomplain ~ouster ~foo ~welch
+} {/home/ouster /home/welch}
+test filename-15.5 {unix specific globbing} {unixOnly nonPortable} {
+ glob ~ouster/.csh*
+} "/home/ouster/.cshrc"
+catch {close [open globTest/odd\\\[\]*?\{\}name w]}
+test filename-15.6 {unix specific globbing} {unixOnly} {
+ global env
+ set temp $env(HOME)
+ set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
+ set result [list [catch {glob ~} msg] $msg]
+ set env(HOME) $temp
+ set result
+} [list 0 [list [glob ~]/globTest/odd\\\[\]*?\{\}name]]
+catch {exec rm -f globTest/odd\\\[\]*?\{\}name}
-# The following tests are only valid for Windows systems.
-if {$tcl_platform(platform) == "windows"} {
- set temp [pwd]
+# The following tests are only valid for Windows systems.
+set temp [pwd]
+catch {cd c:/}
+catch {
cd c:/
- catch {
- removeDirectory globTest
- makeDirectory globTest
- close [open globTest/x1.BAT w]
- close [open globTest/y1.Bat w]
- close [open globTest/z1.bat w]
- }
-
- test filename-16.1 {windows specific globbing} {!win32s} {
- lsort [glob globTest/*.bat]
- } {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
- test filename-16.1 {windows specific globbing} {win32s} {
- lsort [glob globTest/*.bat]
- } {globTest/x1.bat globTest/y1.bat globTest/z1.bat}
- test filename-16.2 {windows specific globbing} {
- glob c:
- } c:
- test filename-16.3 {windows specific globbing} {
- glob c:\\\\
- } c:/
- test filename-16.4 {windows specific globbing} {
- glob c:/
- } c:/
- test filename-16.5 {windows specific globbing} {!win32s} {
- glob c:*Test
- } c:globTest
- test filename-16.5 {windows specific globbing} {win32s} {
- glob c:*Test
- } c:globtest
- test filename-16.6 {windows specific globbing} {!win32s} {
- glob c:\\\\*Test
- } c:/globTest
- test filename-16.6 {windows specific globbing} {win32s} {
- glob c:\\\\*Test
- } c:/globtest
- test filename-16.7 {windows specific globbing} {!win32s} {
- glob c:/*Test
- } c:/globTest
- test filename-16.7 {windows specific globbing} {win32s} {
- glob c:/*Test
- } c:/globtest
- test filename-16.8 {windows specific globbing} {!win32s} {
- lsort [glob c:globTest/*.bat]
- } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
- test filename-16.8 {windows specific globbing} {win32s} {
- lsort [glob c:globTest/*.bat]
- } {c:globTest/x1.bat c:globTest/y1.bat c:globTest/z1.bat}
- test filename-16.9 {windows specific globbing} {!win32s} {
- lsort [glob c:/globTest/*.bat]
- } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
- test filename-16.9 {windows specific globbing} {win32s} {
- lsort [glob c:/globTest/*.bat]
- } {c:/globTest/x1.bat c:/globTest/y1.bat c:/globTest/z1.bat}
- test filename-16.10 {windows specific globbing} {!win32s} {
- lsort [glob c:globTest\\\\*.bat]
- } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
- test filename-16.10 {windows specific globbing} {win32s} {
- lsort [glob c:globTest\\\\*.bat]
- } {c:globTest/x1.bat c:globTest/y1.bat c:globTest/z1.bat}
- test filename-16.11 {windows specific globbing} {!win32s} {
- lsort [glob c:\\\\globTest\\\\*.bat]
- } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
- test filename-16.11 {windows specific globbing} {win32s} {
- lsort [glob c:\\\\globTest\\\\*.bat]
- } {c:/globTest/x1.bat c:/globTest/y1.bat c:/globTest/z1.bat}
-
removeDirectory globTest
+ makeDirectory globTest
+ close [open globTest/x1.BAT w]
+ close [open globTest/y1.Bat w]
+ close [open globTest/z1.bat w]
+}
- if {($testConfig(nonPortable) != 0) && [catch {cd //gaspode/d}] == 0} {
- removeDirectory globTest
- makeDirectory globTest
-
- close [open globTest/x1.BAT w]
- close [open globTest/y1.Bat w]
- close [open globTest/z1.bat w]
-
- test filename-16.12 {windows specific globbing} {
- glob //gaspode/d/*Test
- } //gaspode/d/globTest
- test filename-16.13 {windows specific globbing} {
- glob {\\\\gaspode\\d\\*Test}
- } //gaspode/d/globTest
+test filename-16.1 {windows specific globbing} {pcOnly} {
+ lsort [glob globTest/*.bat]
+} {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
+test filename-16.2 {windows specific globbing} {pcOnly} {
+ glob c:
+} c:
+test filename-16.3 {windows specific globbing} {pcOnly} {
+ glob c:\\\\
+} c:/
+test filename-16.4 {windows specific globbing} {pcOnly} {
+ glob c:/
+} c:/
+test filename-16.5 {windows specific globbing} {pcOnly} {
+ glob c:*Test
+} c:globTest
+test filename-16.6 {windows specific globbing} {pcOnly} {
+ glob c:\\\\*Test
+} c:/globTest
+test filename-16.7 {windows specific globbing} {pcOnly} {
+ glob c:/*Test
+} c:/globTest
+test filename-16.8 {windows specific globbing} {pcOnly} {
+ lsort [glob c:globTest/*.bat]
+} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
+test filename-16.9 {windows specific globbing} {pcOnly} {
+ lsort [glob c:/globTest/*.bat]
+} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
+test filename-16.10 {windows specific globbing} {pcOnly} {
+ lsort [glob c:globTest\\\\*.bat]
+} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
+test filename-16.11 {windows specific globbing} {pcOnly} {
+ lsort [glob c:\\\\globTest\\\\*.bat]
+} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
- removeDirectory globTest
- }
+# some tests require a shared C drive
- cd $temp
+if {[catch {cd //[info hostname]/c}]} {
+ set ::tcltest::testConstraints(sharedCdrive) 0
+} else {
+ set ::tcltest::testConstraints(sharedCdrive) 1
}
-removeDirectory globTest
-set env(HOME) $oldhome
+test filename-16.12 {windows specific globbing} {pcOnly sharedCdrive} {
+ cd //[info hostname]/c
+ removeDirectory globTest
+ makeDirectory globTest
+ close [open globTest/x1.BAT w]
+ close [open globTest/y1.Bat w]
+ close [open globTest/z1.bat w]
+ glob //[info hostname]/c/*Test
+} //[info hostname]/c/globTest
+test filename-16.13 {windows specific globbing} {pcOnly sharedCdrive} {
+ cd //[info hostname]/c
+ removeDirectory globTest
+ makeDirectory globTest
+ close [open globTest/x1.BAT w]
+ close [open globTest/y1.Bat w]
+ close [open globTest/z1.bat w]
+ glob "\\\\\\\\[info hostname]\\\\c\\\\*Test"
+} //[info hostname]/c/globTest
+# cleanup
+file delete -force //[info hostname]/c/globTest
+cd $temp
+file delete -force globTest
+set env(HOME) $oldhome
testsetplatform $platform
catch {unset oldhome platform temp result}
-concat ""
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/for-old.test b/tcl/tests/for-old.test
index 9ad7a6639c3..65a38200ccb 100644
--- a/tcl/tests/for-old.test
+++ b/tcl/tests/for-old.test
@@ -14,7 +14,10 @@
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Check "for" and its use of continue and break.
@@ -64,3 +67,20 @@ test for-old-1.9 {for tests} {
}
set a
} {1 2 3}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/for.test b/tcl/tests/for.test
index e12c47e8630..174475ee4c9 100644
--- a/tcl/tests/for.test
+++ b/tcl/tests/for.test
@@ -11,7 +11,10 @@
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Basic "for" operation.
@@ -582,11 +585,173 @@ test for-4.1 {break must reset the interp result} {
set j
} {}
-# Check "for" and computed command names.
+# Test for incorrect "double evaluation" semantics
+
+test for-5.1 {possible delayed substitution of increment command} {knownBug} {
+ # Increment should be 5, and lappend should always append 5
+ catch {unset a}
+ catch {unset i}
+ set a 5
+ set i {}
+ for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
+ set i
+} {1 6 11}
+
+test for-5.2 {possible delayed substitution of body command} {knownBug} {
+ # Increment should be 5, and lappend should always append 5
+ set a 5
+ set i {}
+ for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
+ set i
+} {5 5 5 5}
+
+# In the following tests we need to bypass the bytecode compiler by
+# substituting the command from a variable. This ensures that command
+# procedure is invoked directly.
-test for-5.1 {for and computed command names} {
- set j 0
+test for-6.1 {Tcl_ForObjCmd: number of args} {
set z for
- $z {set i 0} {$i<10} {incr i} {set j $i}
- set j
-} 9
+ catch {$z} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-6.2 {Tcl_ForObjCmd: number of args} {
+ set z for
+ catch {$z {set i 0}} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-6.3 {Tcl_ForObjCmd: number of args} {
+ set z for
+ catch {$z {set i 0} {$i < 5}} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-6.4 {Tcl_ForObjCmd: number of args} {
+ set z for
+ catch {$z {set i 0} {$i < 5} {incr i}} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-6.5 {Tcl_ForObjCmd: number of args} {
+ set z for
+ catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-6.6 {Tcl_ForObjCmd: error in initial command} {
+ set z for
+ list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo
+} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ ("for" initial command)
+ invoked from within
+"$z {set} {$i < 5} {incr i} {body}"}}
+test for-6.7 {Tcl_ForObjCmd: error in test expression} {
+ set z for
+ list [catch {$z {set i 0} {i < 5} {incr i} {body}} msg] $msg $errorInfo
+} {1 {syntax error in expression "i < 5"} {syntax error in expression "i < 5"
+ while executing
+"$z {set i 0} {i < 5} {incr i} {body}"}}
+test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
+ set z for
+ set i 0
+ $z {set i 6} "$i > 5" {incr i} {set y $i}
+ set i
+} 6
+test for-6.9 {Tcl_ForObjCmd: error executing command body} {
+ set z for
+ catch {$z {set i 0} {$i < 5} {incr i} {set}} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ ("for" body line 1)
+ invoked from within
+"$z {set i 0} {$i < 5} {incr i} {set}"}
+test for-6.10 {Tcl_ForObjCmd: simple command body} {
+ set z for
+ set a {}
+ $z {set i 1} {$i<6} {set i [expr $i+1]} {
+ if $i==4 break
+ set a [concat $a $i]
+ }
+ set a
+} {1 2 3}
+test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
+ set z for
+ set a {}
+ $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
+ set a
+} {xxxxx}
+test for-6.12 {Tcl_ForObjCmd: computed command body} {
+ set z for
+ catch {unset x1}
+ catch {unset bb}
+ catch {unset x2}
+ set x1 {append a x1; }
+ set bb {break}
+ set x2 {; append a x2}
+ set a {}
+ $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
+ set a
+} {x1}
+test for-6.13 {Tcl_ForObjCmd: error in "next" command} {
+ set z for
+ catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ ("for" loop-end command)
+ invoked from within
+"$z {set i 0} {$i < 5} {set} {set j 4}"}
+test for-6.14 {Tcl_ForObjCmd: long command body} {
+ set z for
+ set a {}
+ $z {set i 1} {$i<6} {set i [expr $i+1]} {
+ if $i==4 break
+ if $i>5 continue
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ set a [concat $a $i]
+ }
+ set a
+} {1 2 3}
+test for-6.15 {Tcl_ForObjCmd: for command result} {
+ set z for
+ set a [$z {set i 0} {$i < 5} {incr i} {}]
+ set a
+} {}
+test for-6.16 {Tcl_ForObjCmd: for command result} {
+ set z for
+ set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
+ set a
+} {}
+
+
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
diff --git a/tcl/tests/foreach.test b/tcl/tests/foreach.test
index 4eca220186b..83ce27b0566 100644
--- a/tcl/tests/foreach.test
+++ b/tcl/tests/foreach.test
@@ -12,7 +12,10 @@
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {unset a}
catch {unset x}
@@ -154,8 +157,8 @@ test foreach-3.1 {compiled foreach backward jump works correctly} {
return $l
}
array set x {0 zero 1 one 2 two 3 three}
- foo x
-} {{0 zero} {1 one} {2 two} {3 three}}
+ lsort [foo x]
+} [lsort {{0 zero} {1 one} {2 two} {3 three}}]
test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
catch {unset x}
@@ -208,5 +211,34 @@ test foreach-5.4 {break tests} {
set msg
} {wrong # args: should be "break"}
+# Test for incorrect "double evaluation" semantics
+
+test foreach-6.1 {delayed substitution of body} {knownBug} {
+ proc foo {} {
+ set a 0
+ foreach a [list 1 2 3] "
+ set x $a
+ "
+ set x
+ }
+ foo
+} {0}
+
+# cleanup
catch {unset a}
catch {unset x}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/format.test b/tcl/tests/format.test
index 48427ffa94e..416d47e9c0d 100644
--- a/tcl/tests/format.test
+++ b/tcl/tests/format.test
@@ -5,14 +5,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# The following code is needed because some versions of SCO Unix have
# a round-off error in sprintf which would cause some of the tests to
@@ -78,291 +81,337 @@ test format-2.3 {string formatting} {
test format-2.4 {string formatting} {
format "%s %s %% %c %s" abcd {This is a very long test string.} 120 x
} {abcd This is a very long test string. % x x}
+test format-2.5 {string formatting, embedded nulls} {
+ format "%10s" abc\0def
+} " abc\0def"
+test format-2.6 {string formatting, international chars} {
+ format "%10s" abc\ufeffdef
+} " abc\ufeffdef"
+test format-2.6 {string formatting, international chars} {
+ format "%.5s" abc\ufeffdef
+} "abc\ufeffd"
+test format-2.7 {string formatting, international chars} {
+ format "foo\ufeffbar%s" baz
+} "foo\ufeffbarbaz"
+test format-2.8 {string formatting, width} {
+ format "a%5sa" f
+} "a fa"
+test format-2.8 {string formatting, width} {
+ format "a%-5sa" f
+} "af a"
+test format-2.8 {string formatting, width} {
+ format "a%2sa" foo
+} "afooa"
+test format-2.8 {string formatting, width} {
+ format "a%0sa" foo
+} "afooa"
+test format-2.8 {string formatting, precision} {
+ format "a%.2sa" foobarbaz
+} "afoa"
+test format-2.8 {string formatting, precision} {
+ format "a%.sa" foobarbaz
+} "aa"
+test format-2.8 {string formatting, precision} {
+ list [catch {format "a%.-2sa" foobarbaz} msg] $msg
+} {1 {bad field specifier "-"}}
+test format-2.8 {string formatting, width and precision} {
+ format "a%5.2sa" foobarbaz
+} "a foa"
+test format-2.8 {string formatting, width and precision} {
+ format "a%5.7sa" foobarbaz
+} "afoobarba"
+
+test format-3.1 {Tcl_FormatObjCmd: character formatting} {
+ format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65
+} "|A|A|A|A|A | A| A|A |"
+test format-3.2 {Tcl_FormatObjCmd: international character formatting} {
+ format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xa2 0x4e4e 0x25a 0xc3 0xff08 0 3 0x6575 -4 0x4e4f
+} "|\ua2|\u4e4e|\u25a|\uc3|\uff08 | \0| \u6575|\u4e4f |"
-test format-3.1 {e and f formats} {eformat} {
+test format-4.1 {e and f formats} {eformat} {
format "%e %e %e %e" 34.2e12 68.514 -.125 -16000. .000053
} {3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04}
-test format-3.2 {e and f formats} {eformat} {
+test format-4.2 {e and f formats} {eformat} {
format "%20e %20e %20e %20e" 34.2e12 68.514 -.125 -16000. .000053
} { 3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04}
if {!$roundOffBug} {
- test format-3.3 {e and f formats} {eformat} {
+ test format-4.3 {e and f formats} {eformat} {
format "%.1e %.1e %.1e %.1e" 34.2e12 68.514 -.126 -16000. .000053
} {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04}
- test format-3.4 {e and f formats} {eformat} {
+ test format-4.4 {e and f formats} {eformat} {
format "%020e %020e %020e %020e" 34.2e12 68.514 -.126 -16000. .000053
} {000000003.420000e+13 000000006.851400e+01 -00000001.260000e-01 -00000001.600000e+04}
- test format-3.5 {e and f formats} {eformat} {
+ test format-4.5 {e and f formats} {eformat} {
format "%7.1e %7.1e %7.1e %7.1e" 34.2e12 68.514 -.126 -16000. .000053
} {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04}
- test format-3.6 {e and f formats} {
+ test format-4.6 {e and f formats} {
format "%f %f %f %f" 34.2e12 68.514 -.125 -16000. .000053
} {34200000000000.000000 68.514000 -0.125000 -16000.000000}
}
-test format-3.7 {e and f formats} {nonPortable} {
+test format-4.7 {e and f formats} {nonPortable} {
format "%.4f %.4f %.4f %.4f %.4f" 34.2e12 68.514 -.125 -16000. .000053
} {34200000000000.0000 68.5140 -0.1250 -16000.0000 0.0001}
-test format-3.8 {e and f formats} {eformat} {
+test format-4.8 {e and f formats} {eformat} {
format "%.4e %.5e %.6e" -9.99996 -9.99996 9.99996
} {-1.0000e+01 -9.99996e+00 9.999960e+00}
-test format-3.9 {e and f formats} {
+test format-4.9 {e and f formats} {
format "%.4f %.5f %.6f" -9.99996 -9.99996 9.99996
} {-10.0000 -9.99996 9.999960}
-test format-3.10 {e and f formats} {
+test format-4.10 {e and f formats} {
format "%20f %-20f %020f" -9.99996 -9.99996 9.99996
} { -9.999960 -9.999960 0000000000009.999960}
-test format-3.11 {e and f formats} {
+test format-4.11 {e and f formats} {
format "%-020f %020f" -9.99996 -9.99996 9.99996
} {-9.999960 -000000000009.999960}
-test format-3.12 {e and f formats} {eformat} {
+test format-4.12 {e and f formats} {eformat} {
format "%.0e %#.0e" -9.99996 -9.99996 9.99996
} {-1e+01 -1.e+01}
-test format-3.13 {e and f formats} {
+test format-4.13 {e and f formats} {
format "%.0f %#.0f" -9.99996 -9.99996 9.99996
} {-10 -10.}
-test format-3.14 {e and f formats} {
+test format-4.14 {e and f formats} {
format "%.4f %.5f %.6f" -9.99996 -9.99996 9.99996
} {-10.0000 -9.99996 9.999960}
-test format-3.15 {e and f formats} {
+test format-4.15 {e and f formats} {
format "%3.0f %3.0f %3.0f %3.0f" 1.0 1.1 1.01 1.001
} { 1 1 1 1}
-test format-3.16 {e and f formats} {
+test format-4.16 {e and f formats} {
format "%3.1f %3.1f %3.1f %3.1f" 0.0 0.1 0.01 0.001
} {0.0 0.1 0.0 0.0}
-test format-4.1 {g-format} {eformat} {
+test format-5.1 {g-format} {eformat} {
format "%.3g" 12341.0
} {1.23e+04}
-test format-4.2 {g-format} {eformat} {
+test format-5.2 {g-format} {eformat} {
format "%.3G" 1234.12345
} {1.23E+03}
-test format-4.3 {g-format} {
+test format-5.3 {g-format} {
format "%.3g" 123.412345
} {123}
-test format-4.4 {g-format} {
+test format-5.4 {g-format} {
format "%.3g" 12.3412345
} {12.3}
-test format-4.5 {g-format} {
+test format-5.5 {g-format} {
format "%.3g" 1.23412345
} {1.23}
-test format-4.6 {g-format} {
+test format-5.6 {g-format} {
format "%.3g" 1.23412345
} {1.23}
-test format-4.7 {g-format} {
+test format-5.7 {g-format} {
format "%.3g" .123412345
} {0.123}
-test format-4.8 {g-format} {
+test format-5.8 {g-format} {
format "%.3g" .012341
} {0.0123}
-test format-4.9 {g-format} {
+test format-5.9 {g-format} {
format "%.3g" .0012341
} {0.00123}
-test format-4.10 {g-format} {
+test format-5.10 {g-format} {
format "%.3g" .00012341
} {0.000123}
-test format-4.11 {g-format} {eformat} {
+test format-5.11 {g-format} {eformat} {
format "%.3g" .00001234
} {1.23e-05}
-test format-4.12 {g-format} {eformat} {
+test format-5.12 {g-format} {eformat} {
format "%.4g" 9999.6
} {1e+04}
-test format-4.13 {g-format} {
+test format-5.13 {g-format} {
format "%.4g" 999.96
} {1000}
-test format-4.14 {g-format} {
+test format-5.14 {g-format} {
format "%.3g" 1.0
} {1}
-test format-4.15 {g-format} {
+test format-5.15 {g-format} {
format "%.3g" .1
} {0.1}
-test format-4.16 {g-format} {
+test format-5.16 {g-format} {
format "%.3g" .01
} {0.01}
-test format-4.17 {g-format} {
+test format-5.17 {g-format} {
format "%.3g" .001
} {0.001}
-test format-4.18 {g-format} {eformat} {
+test format-5.18 {g-format} {eformat} {
format "%.3g" .00001
} {1e-05}
-test format-4.19 {g-format} {eformat} {
+test format-5.19 {g-format} {eformat} {
format "%#.3g" 1234.0
} {1.23e+03}
-test format-4.20 {g-format} {eformat} {
+test format-5.20 {g-format} {eformat} {
format "%#.3G" 9999.5
} {1.00E+04}
-test format-5.1 {floating-point zeroes} {eformat} {
+test format-6.1 {floating-point zeroes} {eformat} {
format "%e %f %g" 0.0 0.0 0.0 0.0
} {0.000000e+00 0.000000 0}
-test format-5.2 {floating-point zeroes} {eformat} {
+test format-6.2 {floating-point zeroes} {eformat} {
format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0
} {0.0000e+00 0.0000 0}
-test format-5.3 {floating-point zeroes} {eformat} {
+test format-6.3 {floating-point zeroes} {eformat} {
format "%#.4e %#.4f %#.4g" 0.0 0.0 0.0 0.0
} {0.0000e+00 0.0000 0.000}
-test format-5.4 {floating-point zeroes} {eformat} {
+test format-6.4 {floating-point zeroes} {eformat} {
format "%.0e %.0f %.0g" 0.0 0.0 0.0 0.0
} {0e+00 0 0}
-test format-5.5 {floating-point zeroes} {eformat} {
+test format-6.5 {floating-point zeroes} {eformat} {
format "%#.0e %#.0f %#.0g" 0.0 0.0 0.0 0.0
} {0.e+00 0. 0.}
-test format-5.6 {floating-point zeroes} {
+test format-6.6 {floating-point zeroes} {
format "%3.0f %3.0f %3.0f %3.0f" 0.0 0.0 0.0 0.0
} { 0 0 0 0}
-test format-5.7 {floating-point zeroes} {
+test format-6.7 {floating-point zeroes} {
format "%3.0f %3.0f %3.0f %3.0f" 1.0 1.1 1.01 1.001
} { 1 1 1 1}
-test format-5.8 {floating-point zeroes} {
+test format-6.8 {floating-point zeroes} {
format "%3.1f %3.1f %3.1f %3.1f" 0.0 0.1 0.01 0.001
} {0.0 0.1 0.0 0.0}
-test format-6.1 {various syntax features} {
+test format-7.1 {various syntax features} {
format "%*.*f" 12 3 12.345678901
} { 12.346}
-test format-6.2 {various syntax features} {
+test format-7.2 {various syntax features} {
format "%0*.*f" 12 3 12.345678901
} {00000012.346}
-test format-6.3 {various syntax features} {
+test format-7.3 {various syntax features} {
format "\*\t\\n"
} {* \n}
-test format-7.1 {error conditions} {
+test format-8.1 {error conditions} {
catch format
} 1
-test format-7.2 {error conditions} {
+test format-8.2 {error conditions} {
catch format msg
set msg
} {wrong # args: should be "format formatString ?arg arg ...?"}
-test format-7.3 {error conditions} {
+test format-8.3 {error conditions} {
catch {format %*d}
} 1
-test format-7.4 {error conditions} {
+test format-8.4 {error conditions} {
catch {format %*d} msg
set msg
} {not enough arguments for all format specifiers}
-test format-7.5 {error conditions} {
+test format-8.5 {error conditions} {
catch {format %*.*f 12}
} 1
-test format-7.6 {error conditions} {
+test format-8.6 {error conditions} {
catch {format %*.*f 12} msg
set msg
} {not enough arguments for all format specifiers}
-test format-7.7 {error conditions} {
+test format-8.7 {error conditions} {
catch {format %*.*f 12 3}
} 1
-test format-7.8 {error conditions} {
+test format-8.8 {error conditions} {
catch {format %*.*f 12 3} msg
set msg
} {not enough arguments for all format specifiers}
-test format-7.9 {error conditions} {
+test format-8.9 {error conditions} {
list [catch {format %*d x 3} msg] $msg
} {1 {expected integer but got "x"}}
-test format-7.10 {error conditions} {
+test format-8.10 {error conditions} {
list [catch {format %*.*f 2 xyz 3} msg] $msg
} {1 {expected integer but got "xyz"}}
-test format-7.11 {error conditions} {
+test format-8.11 {error conditions} {
catch {format %d 2a}
} 1
-test format-7.12 {error conditions} {
+test format-8.12 {error conditions} {
catch {format %d 2a} msg
set msg
} {expected integer but got "2a"}
-test format-7.13 {error conditions} {
+test format-8.13 {error conditions} {
catch {format %c 2x}
} 1
-test format-7.14 {error conditions} {
+test format-8.14 {error conditions} {
catch {format %c 2x} msg
set msg
} {expected integer but got "2x"}
-test format-7.15 {error conditions} {
+test format-8.15 {error conditions} {
catch {format %f 2.1z}
} 1
-test format-7.16 {error conditions} {
+test format-8.16 {error conditions} {
catch {format %f 2.1z} msg
set msg
} {expected floating-point number but got "2.1z"}
-test format-7.17 {error conditions} {
+test format-8.17 {error conditions} {
catch {format ab%}
} 1
-test format-7.18 {error conditions} {
+test format-8.18 {error conditions} {
catch {format ab% 12} msg
set msg
} {format string ended in middle of field specifier}
-test format-7.19 {error conditions} {
+test format-8.19 {error conditions} {
catch {format %q x}
} 1
-test format-7.20 {error conditions} {
+test format-8.20 {error conditions} {
catch {format %q x} msg
set msg
} {bad field specifier "q"}
-test format-7.21 {error conditions} {
+test format-8.21 {error conditions} {
catch {format %d}
} 1
-test format-7.22 {error conditions} {
+test format-8.22 {error conditions} {
catch {format %d} msg
set msg
} {not enough arguments for all format specifiers}
-test format-7.23 {error conditions} {
+test format-8.23 {error conditions} {
catch {format "%d %d" 24 xyz} msg
set msg
} {expected integer but got "xyz"}
-test format-8.1 {long result} {
+test format-9.1 {long result} {
set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
format {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG %s %s} $a $a
} {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
-test format-9.1 {"h" format specifier} {nonPortable} {
+test format-10.1 {"h" format specifier} {nonPortable} {
format %hd 0xffff
} -1
-test format-9.2 {"h" format specifier} {nonPortable} {
+test format-10.2 {"h" format specifier} {nonPortable} {
format %hx 0x10fff
} fff
-test format-9.3 {"h" format specifier} {nonPortable} {
+test format-10.3 {"h" format specifier} {nonPortable} {
format %hd 0x10000
} 0
-test format-10.1 {XPG3 %$n specifiers} {
+test format-11.1 {XPG3 %$n specifiers} {
format {%2$d %1$d} 4 5
} {5 4}
-test format-10.2 {XPG3 %$n specifiers} {
+test format-11.2 {XPG3 %$n specifiers} {
format {%2$d %1$d %1$d %3$d} 4 5 6
} {5 4 4 6}
-test format-10.3 {XPG3 %$n specifiers} {
+test format-11.3 {XPG3 %$n specifiers} {
list [catch {format {%2$d %3$d} 4 5} msg] $msg
} {1 {"%n$" argument index out of range}}
-test format-10.4 {XPG3 %$n specifiers} {
+test format-11.4 {XPG3 %$n specifiers} {
list [catch {format {%2$d %0$d} 4 5 6} msg] $msg
} {1 {"%n$" argument index out of range}}
-test format-10.5 {XPG3 %$n specifiers} {
+test format-11.5 {XPG3 %$n specifiers} {
list [catch {format {%d %1$d} 4 5 6} msg] $msg
} {1 {cannot mix "%" and "%n$" conversion specifiers}}
-test format-10.6 {XPG3 %$n specifiers} {
+test format-11.6 {XPG3 %$n specifiers} {
list [catch {format {%2$d %d} 4 5 6} msg] $msg
} {1 {cannot mix "%" and "%n$" conversion specifiers}}
-test format-10.7 {XPG3 %$n specifiers} {
+test format-11.7 {XPG3 %$n specifiers} {
list [catch {format {%2$d %3d} 4 5 6} msg] $msg
} {1 {cannot mix "%" and "%n$" conversion specifiers}}
-test format-10.8 {XPG3 %$n specifiers} {
+test format-11.8 {XPG3 %$n specifiers} {
format {%2$*d %3$d} 1 10 4
} { 4 4}
-test format-10.9 {XPG3 %$n specifiers} {
+test format-11.9 {XPG3 %$n specifiers} {
format {%2$.*s %4$d} 1 5 abcdefghijklmnop 44
} {abcde 44}
-test format-10.10 {XPG3 %$n specifiers} {
+test format-11.10 {XPG3 %$n specifiers} {
list [catch {format {%2$*d} 4} msg] $msg
} {1 {"%n$" argument index out of range}}
-test format-10.11 {XPG3 %$n specifiers} {
+test format-11.11 {XPG3 %$n specifiers} {
list [catch {format {%2$*d} 4 5} msg] $msg
} {1 {"%n$" argument index out of range}}
-test format-10.12 {XPG3 %$n specifiers} {
+test format-11.12 {XPG3 %$n specifiers} {
list [catch {format {%2$*d} 4 5 6} msg] $msg
} {0 { 6}}
-test format-11.1 {negative width specifiers} {
+test format-12.1 {negative width specifiers} {
format "%*d" -47 25
-} {25}
-test format-12.1 {tcl_precision fuzzy comparison} {
+} {25 }
+test format-13.1 {tcl_precision fuzzy comparison} {
catch {unset a}
catch {unset b}
catch {unset c}
@@ -373,7 +422,7 @@ test format-12.1 {tcl_precision fuzzy comparison} {
set d [expr $a + $b + $c]
format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
} {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001}
-test format-12.2 {tcl_precision fuzzy comparison} {
+test format-13.2 {tcl_precision fuzzy comparison} {
catch {unset a}
catch {unset b}
catch {unset c}
@@ -384,7 +433,7 @@ test format-12.2 {tcl_precision fuzzy comparison} {
set d [expr $a + $b + $c]
format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
} {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580}
-test format-12.3 {tcl_precision fuzzy comparison} {
+test format-13.3 {tcl_precision fuzzy comparison} {
catch {unset a}
catch {unset b}
catch {unset c}
@@ -393,7 +442,7 @@ test format-12.3 {tcl_precision fuzzy comparison} {
set c [expr $a + $b]
format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c
} {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100}
-test format-12.4 {tcl_precision fuzzy comparison} {
+test format-13.4 {tcl_precision fuzzy comparison} {
catch {unset a}
catch {unset b}
catch {unset c}
@@ -402,7 +451,7 @@ test format-12.4 {tcl_precision fuzzy comparison} {
set c [expr $a + $b]
format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c
} {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300}
-test format-12.5 {tcl_precision fuzzy comparison} {
+test format-13.5 {tcl_precision fuzzy comparison} {
catch {unset a}
catch {unset b}
catch {unset c}
@@ -411,28 +460,55 @@ test format-12.5 {tcl_precision fuzzy comparison} {
set c [expr $a + $b]
format {%0.10f %0.12f %0.15f} $c $c $c
} {1.4444444444 1.444444444444 1.444444444443990}
-test format-13.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
+test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
format {%s} ""
} {}
-test format-13.2 {testing MAX_FLOAT_SIZE for 0 and 1} {
+test format-14.2 {testing MAX_FLOAT_SIZE for 0 and 1} {
format {%s} "a"
} {a}
+test format-15.1 {testing %0..s 0 padding for chars/strings} {
+ format %05s a
+} {0000a}
+test format-15.2 {testing %0..s 0 padding for chars/strings} {
+ format "% 5s" a
+} { a}
+test format-15.3 {testing %0..s 0 padding for chars/strings} {
+ format %5s a
+} { a}
+test format-15.4 {testing %0..s 0 padding for chars/strings} {
+ format %05c 61
+} {0000=}
+
set a "0123456789"
set b ""
for {set i 0} {$i < 290} {incr i} {
append b $a
}
for {set i 290} {$i < 400} {incr i} {
- test format-14.[expr $i -290] {testing MAX_FLOAT_SIZE} {
+ test format-15.[expr $i -290] {testing MAX_FLOAT_SIZE} {
format {%s} $b
} $b
append b "x"
}
-
+# cleanup
catch {unset a}
catch {unset b}
catch {unset c}
catch {unset d}
+::tcltest::cleanupTests
return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/get.test b/tcl/tests/get.test
index f582048d411..585422d6972 100644
--- a/tcl/tests/get.test
+++ b/tcl/tests/get.test
@@ -5,13 +5,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test get-1.1 {Tcl_GetInt procedure} {
set x 44
@@ -39,39 +43,39 @@ test get-1.6 {Tcl_GetInt procedure} {
} {1 {expected integer but got "16 x"}}
# The following tests are non-portable because they depend on
-# word size. 18446744073709551614
+# word size.
if {0x80000000 > 0} {
- test get-1.7 {Tcl_GetInt procedure} {nonPortable unixOnly} {
+ test get-1.7 {Tcl_GetInt procedure} {
set x 44
list [catch {incr x 18446744073709551616} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
- test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
+ test get-1.8 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x 18446744073709551614} msg] $msg
} {0 -2}
- test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
+ test get-1.9 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x +18446744073709551614} msg] $msg
} {0 -2}
- test get-1.10 {Tcl_GetInt procedure} {nonPortable} {
+ test get-1.10 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x -18446744073709551614} msg] $msg
} {0 2}
} else {
- test get-1.7 {Tcl_GetInt procedure} {nonPortable unixOnly} {
+ test get-1.7 {Tcl_GetInt procedure} {
set x 44
list [catch {incr x 4294967296} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
- test get-1.8 {Tcl_GetInt procedure} {nonPortable} {
+ test get-1.8 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x 4294967294} msg] $msg
} {0 -2}
- test get-1.9 {Tcl_GetInt procedure} {nonPortable} {
+ test get-1.9 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x +4294967294} msg] $msg
} {0 -2}
- test get-1.10 {Tcl_GetInt procedure} {nonPortable} {
+ test get-1.10 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x -4294967294} msg] $msg
} {0 2}
@@ -89,3 +93,20 @@ test get-2.3 {Tcl_GetInt procedure} {
test get-2.4 {Tcl_GetInt procedure} {nonPortable} {
list [catch {format %g .000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001} msg] $msg $errorCode
} {1 {floating-point value too small to represent} {ARITH UNDERFLOW {floating-point value too small to represent}}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/history.test b/tcl/tests/history.test
index 876bb78fb71..04512210a0a 100644
--- a/tcl/tests/history.test
+++ b/tcl/tests/history.test
@@ -6,20 +6,25 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[catch {history}]} {
puts stdout "This version of Tcl was built without the history command;\n"
puts stdout "history tests will be skipped.\n"
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
set num [history nextid]
history keep 3
history add {set a 12345}
@@ -209,3 +214,19 @@ test history-9.2 {miscellaneous} {
set msg
} {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/http.test b/tcl/tests/http.test
index aa85e36406b..126cca12f87 100644
--- a/tcl/tests/http.test
+++ b/tcl/tests/http.test
@@ -6,6 +6,7 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 by Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -13,14 +14,19 @@
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+set tcltest::testConstraints(notLinux) \
+ [expr ![string equal Linux $tcl_platform(os)]]
-if {[catch {package require http 2.0}]} {
+if {[catch {package require http 2} version]} {
if {[info exist http2]} {
- catch {puts stderr "Cannot load http 2.0 package"}
+ catch {puts "Cannot load http 2.* package"}
return
} else {
- catch {puts stderr "Running http 2.0 tests in slave interp"}
+ catch {puts "Running http 2.* tests in slave interp"}
set interp [interp create http2]
$interp eval [list set http2 "running"]
$interp eval [list source [info script]]
@@ -29,164 +35,54 @@ if {[catch {package require http 2.0}]} {
}
}
-############### The httpd_ procedures implement a stub http server. ########
-proc httpd_init {{port 8015}} {
- socket -server httpdAccept $port
+proc bgerror {args} {
+ global errorInfo
+ puts stderr "http.test bgerror"
+ puts stderr [join $args]
+ puts stderr $errorInfo
}
-proc httpd_log {args} {
- global httpLog
- if {[info exists httpLog] && $httpLog} {
- puts stderr "httpd: [join $args { }]"
- }
-}
-array set httpdErrors {
- 204 {No Content}
- 400 {Bad Request}
- 404 {Not Found}
- 503 {Service Unavailable}
- 504 {Service Temporarily Unavailable}
- }
-
-proc httpdError {sock code args} {
- global httpdErrors
- puts $sock "$code $httpdErrors($code)"
- httpd_log "error: [join $args { }]"
-}
-proc httpdAccept {newsock ipaddr port} {
- global httpd
- upvar #0 httpd$newsock data
-
- fconfigure $newsock -blocking 0 -translation {auto crlf}
- httpd_log $newsock Connect $ipaddr $port
- set data(ipaddr) $ipaddr
- fileevent $newsock readable [list httpdRead $newsock]
-}
-
-# read data from a client request
-
-proc httpdRead { sock } {
- upvar #0 httpd$sock data
-
- set readCount [gets $sock line]
- if {![info exists data(state)]} {
- if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \
- $line x data(proto) data(url) data(query)] {
- set data(state) mime
- httpd_log $sock Query $line
- } else {
- httpdError $sock 400
- httpd_log $sock Error "bad first line:$line"
- httpdSockDone $sock
- }
- return
- }
-
- # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1
-
- set state [string compare $readCount 0],$data(state),$data(proto)
- httpd_log $sock $state
- switch -- $state {
- -1,mime,HEAD -
- -1,mime,GET -
- -1,mime,POST {
- # gets would block
- return
- }
- 0,mime,HEAD -
- 0,mime,GET -
- 0,query,POST { httpdRespond $sock }
- 0,mime,POST { set data(state) query }
- 1,mime,HEAD -
- 1,mime,POST -
- 1,mime,GET {
- if [regexp {([^:]+):[ ]*(.*)} $line dummy key value] {
- set data(mime,[string tolower $key]) $value
- }
- }
- 1,query,POST {
- append data(query) $line
- httpdRespond $sock
- }
- default {
- if [eof $sock] {
- httpd_log $sock Error "unexpected eof on <$data(url)> request"
- } else {
- httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"
- }
- httpdError $sock 404
- httpdSockDone $sock
- }
- }
-}
-proc httpdSockDone { sock } {
-upvar #0 httpd$sock data
- unset data
- close $sock
-}
-
-# Respond to the query.
+set port 8010
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
-proc httpdRespond { sock } {
- global httpd bindata port
- upvar #0 httpd$sock data
+catch {unset data}
- if {[string match *binary* $data(url)]} {
- set html "$bindata[info hostname]:$port$data(url)"
- set type application/octet-stream
- } else {
- set type text/html
+# Ensure httpd file exists
- set html "<html><head><title>HTTP/1.0 TEST</title></head><body>
-<h1>Hello, World!</h1>
-<h2>$data(proto) $data(url)</h2>
-"
- if {[info exists data(query)] && [string length $data(query)]} {
- append html "<h2>Query</h2>\n<dl>\n"
- foreach {key value} [split $data(query) &=] {
- append html "<dt>$key<dd>$value\n"
- if {[string compare $key timeout] == 0} {
- # Simulate a timeout by not responding,
- # but clean up our socket later.
-
- after 50 [list httpdSockDone $sock]
- httpd_log $sock Noresponse ""
- return
- }
- }
- append html </dl>\n
- }
- append html </body></html>
- }
-
- if {$data(proto) == "HEAD"} {
- puts $sock "HTTP/1.0 200 OK"
- } else {
- puts $sock "HTTP/1.0 200 Data follows"
+set origFile [file join $::tcltest::testsDirectory httpd]
+set newFile [file join $::tcltest::workingDirectory httpd]
+if {![file exists $newFile]} {
+ file copy $origFile $newFile
+ set removeHttpd 1
+}
+set httpdFile [file join $::tcltest::workingDirectory httpd]
+
+if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
+ set httpthread [testthread create "
+ source $httpdFile
+ testthread wait
+ "]
+ testthread send $httpthread [list set port $port]
+ testthread send $httpthread [list set bindata $bindata]
+ testthread send $httpthread {httpd_init $port}
+ puts "Running httpd in thread $httpthread"
+} else {
+ if ![file exists $httpdFile] {
+ puts "Cannot read $httpdFile script, http test skipped"
+ unset port
+ return
}
- puts $sock "Date: [clock format [clock clicks]]"
- puts $sock "Content-Type: $type"
- puts $sock "Content-Length: [string length $html]"
- puts $sock ""
- if {$data(proto) != "HEAD"} {
- fconfigure $sock -translation binary
- puts -nonewline $sock $html
+ source $httpdFile
+ if [catch {httpd_init $port} listen] {
+ puts "Cannot start http server, http test skipped"
+ unset port
+ return
}
- httpd_log $sock Done ""
- httpdSockDone $sock
}
-##################### end server ###########################
-set port 8010
-if [catch {httpd_init $port} listen] {
- puts stderr "Cannot start http server, http test skipped"
- unset port
- return
-}
test http-1.1 {http::config} {
http::config
-} {-accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 2.0}}
+} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent "Tcl http client package $version"]
test http-1.2 {http::config} {
http::config -proxyfilter
@@ -221,6 +117,7 @@ test http-3.2 {http::geturl} {
} {Unsupported URL: http:junk}
set url [info hostname]:$port
+set badurl www.scriptics.com:6666
test http-3.3 {http::geturl} {
set token [http::geturl $url]
http::data $token
@@ -232,6 +129,8 @@ test http-3.3 {http::geturl} {
set tail /a/b/c
set url [info hostname]:$port/a/b/c
set binurl [info hostname]:$port/binary
+set posturl [info hostname]:$port/post
+set badposturl [info hostname]:$port/droppost
test http-3.4 {http::geturl} {
set token [http::geturl $url]
@@ -274,7 +173,7 @@ test http-3.7 {http::geturl} {
</body></html>"
test http-3.8 {http::geturl} {
- set token [http::geturl $url -query Name=Value&Foo=Bar]
+ set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]
http::data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
@@ -291,6 +190,115 @@ test http-3.9 {http::geturl} {
http::code $token
} "HTTP/1.0 200 OK"
+test http-3.10 {http::geturl queryprogress} {
+ set query foo=bar
+ set sep ""
+ set i 0
+ # Create about 120K of query data
+ while {$i < 14} {
+ incr i
+ append query $sep$query
+ set sep &
+ }
+
+ proc postProgress {token x y} {
+ global postProgress
+ lappend postProgress $y
+ }
+ set postProgress {}
+ set t [http::geturl $posturl -query $query \
+ -queryprogress postProgress -queryblocksize 16384]
+ http::wait $t
+ list [http::status $t] [string length $query] $postProgress [http::data $t]
+} {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
+
+test http-3.11 {http::geturl querychannel with -command} {
+ set query foo=bar
+ set sep ""
+ set i 0
+ # Create about 120K of query data
+ while {$i < 14} {
+ incr i
+ append query $sep$query
+ set sep &
+ }
+ ::tcltest::makeFile $query outdata
+ set fp [open outdata]
+
+ proc asyncCB {token} {
+ global postResult
+ lappend postResult [http::data $token]
+ }
+ set postResult [list ]
+ set t [http::geturl $posturl -querychannel $fp]
+ http::wait $t
+ set testRes [list [http::status $t] [string length $query] [http::data $t]]
+
+ # Now do async
+ http::cleanup $t
+ close $fp
+ set fp [open outdata]
+ set t [http::geturl $posturl -querychannel $fp -command asyncCB]
+ set postResult [list PostStart]
+ http::wait $t
+
+ lappend testRes [http::status $t] $postResult
+ set testRes
+} {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
+
+# On Linux platforms when the client and server are on the same
+# host, the client is unable to read the server's response one
+# it hits the write error. The status is "eof"
+
+# On Windows, the http::wait procedure gets a
+# "connection reset by peer" error while reading the reply
+
+test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
+ set query foo=bar
+ set sep ""
+ set i 0
+ # Create about 120K of query data
+ while {$i < 14} {
+ incr i
+ append query $sep$query
+ set sep &
+ }
+ ::tcltest::makeFile $query outdata
+ set fp [open outdata]
+
+ proc asyncCB {token} {
+ global postResult
+ lappend postResult [http::data $token]
+ }
+ proc postProgress {token x y} {
+ global postProgress
+ lappend postProgress $y
+ }
+ set postProgress {}
+ # Now do async
+ set postResult [list PostStart]
+ if {[catch {
+ set t [http::geturl $badposturl -querychannel $fp -command asyncCB \
+ -queryprogress postProgress]
+ http::wait $t
+ upvar #0 $t state
+ } err]} {
+ puts $errorInfo
+ error $err
+ }
+
+ list [http::status $t] [http::code $t]
+} {ok {HTTP/1.0 200 Data follows}}
+
+test http-3.13 {http::geturl socket leak test} {
+ set chanCount [llength [file channels]]
+ for {set i 0} {$i < 3} {incr i} {
+ catch {http::geturl $badurl -timeout 5000}
+ }
+
+ # No extra channels should be taken
+ expr {[llength [file channels]] == $chanCount}
+} 1
test http-4.1 {http::Event} {
set token [http::geturl $url]
@@ -377,17 +385,63 @@ test http-4.10 {http::Event} {
set token [http::geturl $url -progress myProgress]
http::size $token
} {111}
+
+# Timeout cases
+
+# Short timeout to working server (the test server)
+# This lets us try a reset during the connection
+
test http-4.11 {http::Event} {
set token [http::geturl $url -timeout 1 -command {#}]
http::reset $token
http::status $token
} {reset}
+
+# Longer timeout with reset
+
test http-4.12 {http::Event} {
- set token [http::geturl $url?timeout=10 -timeout 1 -command {#}]
+ set token [http::geturl $url/?timeout=10 -command {#}]
+ http::reset $token
+ http::status $token
+} {reset}
+
+# Medium timeout to working server that waits even longer
+# The timeout hits while waiting for a reply
+
+test http-4.13 {http::Event} {
+ set token [http::geturl $url?timeout=30 -timeout 10 -command {#}]
http::wait $token
http::status $token
} {timeout}
+# Longer timeout to good host, bad port, gets an error
+# after the connection "completes" but the socket is bad
+
+test http-4.14 {http::Event} {
+ set code [catch {
+ set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}]
+ if {[string length $token] == 0} {
+ error "bogus return from http::geturl"
+ }
+ http::wait $token
+ http::status $token
+ } err]
+ # error code varies among platforms.
+ list $code [string match "connect failed*" $err]
+} {1 1}
+
+# Bogus host
+
+test http-4.15 {http::Event} {
+ set code [catch {
+ set token [http::geturl not_a_host.scriptics.com -timeout 1000 -command {#}]
+ http::wait $token
+ http::status $token
+ } err]
+ # error code varies among platforms.
+ list $code [string match "couldn't open socket*" $err]
+} {1 1}
+
test http-5.1 {http::formatQuery} {
http::formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}
@@ -412,6 +466,22 @@ test http-6.1 {http::ProxyRequired} {
<h2>GET http://$url</h2>
</body></html>"
-unset url
-unset port
-close $listen
+# cleanup
+catch {unset url}
+catch {unset badurl}
+catch {unset port}
+catch {unset data}
+if {[info exists httpthread]} {
+ testthread send -async $httpthread {
+ testthread exit
+ }
+} else {
+ close $listen
+}
+
+if {[info exist removeHttpd]} {
+ removeFile $httpdFile
+}
+
+::tcltest::cleanupTests
+
diff --git a/tcl/tests/httpd b/tcl/tests/httpd
new file mode 100644
index 00000000000..e5fa282ec12
--- /dev/null
+++ b/tcl/tests/httpd
@@ -0,0 +1,215 @@
+#
+# The httpd_ procedures implement a stub http server.
+#
+# Copyright (c) 1997-1998 Sun Microsystems, Inc.
+# Copyright (c) 1999-2000 Scriptics Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) httpd 1.2 98/02/20 14:51:59
+
+#set httpLog 1
+
+proc httpd_init {{port 8015}} {
+ socket -server httpdAccept $port
+}
+proc httpd_log {args} {
+ global httpLog
+ if {[info exists httpLog] && $httpLog} {
+ puts stderr "httpd: [join $args { }]"
+ }
+}
+array set httpdErrors {
+ 204 {No Content}
+ 400 {Bad Request}
+ 401 {Authorization Required}
+ 404 {Not Found}
+ 503 {Service Unavailable}
+ 504 {Service Temporarily Unavailable}
+ }
+
+proc httpdError {sock code args} {
+ global httpdErrors
+ puts $sock "$code $httpdErrors($code)"
+ httpd_log "error: [join $args { }]"
+}
+proc httpdAccept {newsock ipaddr port} {
+ global httpd
+ upvar #0 httpd$newsock data
+
+ fconfigure $newsock -blocking 0 -translation {auto crlf}
+ httpd_log $newsock Connect $ipaddr $port
+ set data(ipaddr) $ipaddr
+ fileevent $newsock readable [list httpdRead $newsock]
+}
+
+# read data from a client request
+
+proc httpdRead { sock } {
+ upvar #0 httpd$sock data
+
+ if {[eof $sock]} {
+ set readCount -1
+ } elseif {![info exists data(state)]} {
+
+ # Read the protocol line and parse out the URL and query
+
+ set readCount [gets $sock line]
+ if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} \
+ $line x data(proto) data(url) data(query) data(httpversion)] {
+ set data(state) mime
+ httpd_log $sock Query $line
+ } else {
+ httpdError $sock 400
+ httpd_log $sock Error "bad first line:$line"
+ httpdSockDone $sock
+ }
+ return
+ } elseif {$data(state) == "mime"} {
+
+ # Read the HTTP headers
+
+ set readCount [gets $sock line]
+ } elseif {$data(state) == "query"} {
+
+ # Read the query data
+
+ if {![info exist data(length_orig)]} {
+ set data(length_orig) $data(length)
+ }
+ set line [read $sock $data(length)]
+ set readCount [string length $line]
+ incr data(length) -$readCount
+ }
+
+ # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1
+
+ set state [string compare $readCount 0],$data(state),$data(proto)
+ httpd_log $sock $state
+ switch -- $state {
+ -1,mime,HEAD -
+ -1,mime,GET -
+ -1,mime,POST {
+ # gets would block
+ return
+ }
+ 0,mime,HEAD -
+ 0,mime,GET -
+ 0,query,POST {
+ # Empty line at end of headers,
+ # or eof after query data
+ httpdRespond $sock
+ }
+ 0,mime,POST {
+ # Empty line between headers and query data
+ if {![info exist data(mime,content-length)]} {
+ httpd_log $sock Error "No Content-Length for POST"
+ httpdError $sock 400
+ httpdSockDone $sock
+ } else {
+ set data(state) query
+ set data(length) $data(mime,content-length)
+
+ # Special case to simulate servers that respond
+ # without reading the post data.
+
+ if {[string match *droppost* $data(url)]} {
+ fileevent $sock readable {}
+ httpdRespond $sock
+ }
+ }
+ }
+ 1,mime,HEAD -
+ 1,mime,POST -
+ 1,mime,GET {
+ # A line of HTTP headers
+ if {[regexp {([^:]+):[ ]*(.*)} $line dummy key value]} {
+ set data(mime,[string tolower $key]) $value
+ }
+ }
+ -1,query,POST {
+ httpd_log $sock Error "unexpected eof on <$data(url)> request"
+ httpdError $sock 400
+ httpdSockDone $sock
+ }
+ 1,query,POST {
+ append data(query) $line
+ if {$data(length) <= 0} {
+ set data(length) $data(length_orig)
+ httpdRespond $sock
+ }
+ }
+ default {
+ if {[eof $sock]} {
+ httpd_log $sock Error "unexpected eof on <$data(url)> request"
+ } else {
+ httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"
+ }
+ httpdError $sock 404
+ httpdSockDone $sock
+ }
+ }
+}
+proc httpdSockDone { sock } {
+ upvar #0 httpd$sock data
+ unset data
+ catch {close $sock}
+}
+
+# Respond to the query.
+
+proc httpdRespond { sock } {
+ global httpd bindata port
+ upvar #0 httpd$sock data
+
+ switch -glob -- $data(url) {
+ *binary* {
+ set html "$bindata[info hostname]:$port$data(url)"
+ set type application/octet-stream
+ }
+ *post* {
+ set html "Got [string length $data(query)] bytes"
+ set type text/plain
+ }
+ default {
+ set type text/html
+
+ set html "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>$data(proto) $data(url)</h2>
+"
+ if {[info exists data(query)] && [string length $data(query)]} {
+ append html "<h2>Query</h2>\n<dl>\n"
+ foreach {key value} [split $data(query) &=] {
+ append html "<dt>$key<dd>$value\n"
+ }
+ append html </dl>\n
+ }
+ append html </body></html>
+ }
+ }
+
+ # Catch errors from premature client closes
+
+ catch {
+ if {$data(proto) == "HEAD"} {
+ puts $sock "HTTP/1.0 200 OK"
+ } else {
+ puts $sock "HTTP/1.0 200 Data follows"
+ }
+ puts $sock "Date: [clock format [clock clicks]]"
+ puts $sock "Content-Type: $type"
+ puts $sock "Content-Length: [string length $html]"
+ puts $sock ""
+ flush $sock
+ if {$data(proto) != "HEAD"} {
+ fconfigure $sock -translation binary
+ puts -nonewline $sock $html
+ }
+ }
+ httpd_log $sock Done ""
+ httpdSockDone $sock
+}
+
+
diff --git a/tcl/tests/httpold.test b/tcl/tests/httpold.test
index 79c3483ceca..bb4b133d0a9 100644
--- a/tcl/tests/httpold.test
+++ b/tcl/tests/httpold.test
@@ -6,173 +6,47 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
if {[catch {package require http 1.0}]} {
if {[info exist httpold]} {
- catch {puts stderr "Cannot load http 1.0 package"}
+ catch {puts "Cannot load http 1.0 package"}
+ ::tcltest::cleanupTests
return
} else {
- catch {puts stderr "Running http 1.0 tests in slave interp"}
+ catch {puts "Running http 1.0 tests in slave interp"}
set interp [interp create httpold]
$interp eval [list set httpold "running"]
$interp eval [list source [info script]]
interp delete $interp
+ ::tcltest::cleanupTests
return
}
}
-############### The httpd_ procedures implement a stub http server. ########
-proc httpd_init {{port 8015}} {
- socket -server httpdAccept $port
-}
-proc httpd_log {args} {
- global httpLog
- if {[info exists httpLog] && $httpLog} {
- puts stderr "httpd: [join $args { }]"
- }
-}
-array set httpdErrors {
- 204 {No Content}
- 400 {Bad Request}
- 404 {Not Found}
- 503 {Service Unavailable}
- 504 {Service Temporarily Unavailable}
- }
-
-proc httpdError {sock code args} {
- global httpdErrors
- puts $sock "$code $httpdErrors($code)"
- httpd_log "error: [join $args { }]"
-}
-proc httpdAccept {newsock ipaddr port} {
- global httpd
- upvar #0 httpd$newsock data
-
- fconfigure $newsock -blocking 0 -translation {auto crlf}
- httpd_log $newsock Connect $ipaddr $port
- set data(ipaddr) $ipaddr
- fileevent $newsock readable [list httpdRead $newsock]
-}
-
-# read data from a client request
-
-proc httpdRead { sock } {
- upvar #0 httpd$sock data
-
- set readCount [gets $sock line]
- if {![info exists data(state)]} {
- if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/1.0} \
- $line x data(proto) data(url) data(query)] {
- set data(state) mime
- httpd_log $sock Query $line
- } else {
- httpdError $sock 400
- httpd_log $sock Error "bad first line:$line"
- httpdSockDone $sock
- }
- return
- }
-
- # string compare $readCount 0 maps -1 to -1, 0 to 0, and > 0 to 1
-
- set state [string compare $readCount 0],$data(state),$data(proto)
- httpd_log $sock $state
- switch -- $state {
- -1,mime,HEAD -
- -1,mime,GET -
- -1,mime,POST {
- # gets would block
- return
- }
- 0,mime,HEAD -
- 0,mime,GET -
- 0,query,POST { httpdRespond $sock }
- 0,mime,POST { set data(state) query }
- 1,mime,HEAD -
- 1,mime,POST -
- 1,mime,GET {
- if [regexp {([^:]+):[ ]*(.*)} $line dummy key value] {
- set data(mime,[string tolower $key]) $value
- }
- }
- 1,query,POST {
- append data(query) $line
- httpdRespond $sock
- }
- default {
- if [eof $sock] {
- httpd_log $sock Error "unexpected eof on <$data(url)> request"
- } else {
- httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"
- }
- httpdError $sock 404
- httpdSockDone $sock
- }
- }
-}
-proc httpdSockDone { sock } {
-upvar #0 httpd$sock data
- unset data
- catch {close $sock}
-}
-
-# Respond to the query.
-
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
-proc httpdRespond { sock } {
- global httpd bindata port
- upvar #0 httpd$sock data
-
- if {[string match *binary* $data(url)]} {
- set html "$bindata[info hostname]:$port$data(url)"
- set type application/octet-stream
- } else {
- set type text/html
-
- set html "<html><head><title>HTTP/1.0 TEST</title></head><body>
-<h1>Hello, World!</h1>
-<h2>$data(proto) $data(url)</h2>
-"
- if {[info exists data(query)] && [string length $data(query)]} {
- append html "<h2>Query</h2>\n<dl>\n"
- foreach {key value} [split $data(query) &=] {
- append html "<dt>$key<dd>$value\n"
- }
- append html </dl>\n
- }
- append html </body></html>
- }
+catch {unset data}
- if {$data(proto) == "HEAD"} {
- puts $sock "HTTP/1.0 200 OK"
- } else {
- puts $sock "HTTP/1.0 200 Data follows"
- }
- puts $sock "Date: [clock format [clock clicks]]"
- puts $sock "Content-Type: $type"
- puts $sock "Content-Length: [string length $html]"
- puts $sock ""
- if {$data(proto) != "HEAD"} {
- fconfigure $sock -translation binary
- puts -nonewline $sock $html
- }
- httpd_log $sock Done ""
- httpdSockDone $sock
-}
-##################### end server ###########################
+##
+## The httpd script implement a stub http server
+##
+source [file join [file dirname [info script]] httpd]
set port 8010
if [catch {httpd_init $port} listen] {
- puts stderr "Cannot start http server, http test skipped"
+ puts "Cannot start http server, http test skipped"
unset port
+ ::tcltest::cleanupTests
return
}
@@ -376,10 +250,12 @@ test http-4.11 {httpEvent} {
} {reset}
test http-4.12 {httpEvent} {
update
- set token [http_get $url -timeout 1 -command {#}]
- update
- http_status $token
-} {timeout}
+ set x {}
+ after 500 {lappend x ok}
+ set token [http_get $url -timeout 1 -command {lappend x fail}]
+ vwait x
+ list [http_status $token] $x
+} {timeout ok}
test http-5.1 {http_formatQuery} {
http_formatQuery name1 value1 name2 "value two"
@@ -406,6 +282,23 @@ test http-6.1 {httpProxyRequired} {
<h2>GET http://$url</h2>
</body></html>"
-unset url
-unset port
+# cleanup
+catch {unset url}
+catch {unset port}
+catch {unset data}
close $listen
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/if-old.test b/tcl/tests/if-old.test
index 5b0630ebc89..e03e42b0da1 100644
--- a/tcl/tests/if-old.test
+++ b/tcl/tests/if-old.test
@@ -8,13 +8,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test if-old-1.1 {taking proper branch} {
set a {}
@@ -154,3 +158,20 @@ test if-old-4.10 {error conditions} {
test if-old-4.11 {error conditions} {
list [catch {if 0 then foo elseif 0 bar else {[error "error in else clause"]}} msg] $msg
} {1 {error in else clause}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/if.test b/tcl/tests/if.test
index 71c5110c850..eef417b3df2 100644
--- a/tcl/tests/if.test
+++ b/tcl/tests/if.test
@@ -5,13 +5,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Basic "if" operation.
@@ -495,11 +499,595 @@ test if-4.5 {TclCompileIfCmd: return value} {
# Check "if" and computed command names.
-test if-5.1 {if and computed command names} {
- set i 0
+catch {unset a}
+test if-5.1 {if cmd with computed command names: missing if/elseif test} {
set z if
- $z 1 {
- set i 1
- }
- set i
+ list [catch {$z} msg] $msg
+} {1 {wrong # args: no expression after "if" argument}}
+
+test if-5.2 {if cmd with computed command names: error in if/elseif test} {
+ set z if
+ list [catch {$z {[error "error in condition"]} foo} msg] $msg
+} {1 {error in condition}}
+test if-5.3 {if cmd with computed command names: error in if/elseif test} {
+ set z if
+ list [catch {$z {1+}} msg] $msg $errorInfo
+} {1 {syntax error in expression "1+"} {syntax error in expression "1+"
+ while executing
+"$z {1+}"}}
+test if-5.4 {if cmd with computed command names: if/elseif test in braces} {
+ set z if
+ set a {}
+ $z {1<2} {set a 1}
+ set a
+} {1}
+test if-5.5 {if cmd with computed command names: if/elseif test not in braces} {
+ set z if
+ set a {}
+ $z 1<2 {set a 1}
+ set a
+} {1}
+test if-5.6 {if cmd with computed command names: multiline test expr} {
+ set z if
+ set a {}
+ $z {($tcl_platform(platform) != "foobar1") && \
+ ($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
+ set a
+} 3
+test if-5.7 {if cmd with computed command names: "then" after if/elseif test} {
+ set z if
+ set a {}
+ $z 4>3 then {set a 1}
+ set a
+} {1}
+test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} {
+ set z if
+ set a {}
+ catch {$z 1<2 therefore {set a 1}} msg
+ set msg
+} {invalid command name "therefore"}
+test if-5.9 {if cmd with computed command names: missing "then" body} {
+ set z if
+ set a {}
+ catch {$z 1<2 then} msg
+ set msg
+} {wrong # args: no script following "then" argument}
+test if-5.10 {if cmd with computed command names: error in "then" body} {
+ set z if
+ set a {}
+ list [catch {$z {$a!="xxx"} then {set}} msg] $msg $errorInfo
+} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ invoked from within
+"$z {$a!="xxx"} then {set}"}}
+test if-5.11 {if cmd with computed command names: error in "then" body} {
+ set z if
+ list [catch {$z 2 then {[error "error in then clause"]}} msg] $msg
+} {1 {error in then clause}}
+test if-5.12 {if cmd with computed command names: "then" body in quotes} {
+ set z if
+ set a {}
+ $z 27>17 "append a x"
+ set a
+} {x}
+test if-5.13 {if cmd with computed command names: computed "then" body} {
+ set z if
+ catch {unset x1}
+ catch {unset x2}
+ set a {}
+ set x1 {append a x1}
+ set x2 {; append a x2}
+ set a {}
+ $z 1 $x1$x2
+ set a
+} {x1x2}
+test if-5.14 {if cmd with computed command names: taking proper branch} {
+ set z if
+ set a {}
+ $z 1<2 {set a 1}
+ set a
} 1
+test if-5.15 {if cmd with computed command names: taking proper branch} {
+ set z if
+ set a {}
+ $z 1>2 {set a 1}
+ set a
+} {}
+test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} {
+ set z if
+ catch {unset i}
+ set a {}
+ $z 1<2 {
+ set a 1
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 2
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 3
+ }
+ set a
+} 3
+test if-5.17 {if cmd with computed command names: if/elseif test in quotes} {
+ set z if
+ set a {}
+ list [catch {$z {"0 < 3"} {set a 1}} msg] $msg
+} {1 {expected boolean value but got "0 < 3"}}
+
+
+test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} {
+ set z if
+ set a {}
+ $z 3>4 {set a 1} elseif 1 {set a 2}
+ set a
+} {2}
+# Since "else" is optional, the "elwood" below is treated as a command.
+# But then there shouldn't be any additional argument words for the "if".
+test if-6.2 {if cmd with computed command names: keyword other than "elseif"} {
+ set z if
+ set a {}
+ catch {$z 1<2 {set a 1} elwood {set a 2}} msg
+ set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+test if-6.3 {if cmd with computed command names: missing expression after "elseif"} {
+ set z if
+ set a {}
+ catch {$z 1<2 {set a 1} elseif} msg
+ set msg
+} {wrong # args: no expression after "elseif" argument}
+test if-6.4 {if cmd with computed command names: error in expression after "elseif"} {
+ set z if
+ set a {}
+ list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
+} {1 {syntax error in expression "1>"} {syntax error in expression "1>"
+ while executing
+"$z 3>4 {set a 1} elseif {1>}"}}
+test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} {
+ set z if
+ catch {unset i}
+ set a {}
+ $z 1>2 {
+ set a 1
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 2
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 3
+ } elseif 1<2 then { #; this if arm should be taken
+ set a 4
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 5
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 6
+ }
+ set a
+} 6
+
+test if-7.1 {if cmd with computed command names: "else" clause} {
+ set z if
+ set a {}
+ $z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
+ set a
+} 3
+# Since "else" is optional, the "elsex" below is treated as a command.
+# But then there shouldn't be any additional argument words for the "if".
+test if-7.2 {if cmd with computed command names: keyword other than "else"} {
+ set z if
+ set a {}
+ catch {$z 1<2 then {set a 1} elsex {set a 2}} msg
+ set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+test if-7.3 {if cmd with computed command names: missing body after "else"} {
+ set z if
+ set a {}
+ catch {$z 2<1 {set a 1} else} msg
+ set msg
+} {wrong # args: no script following "else" argument}
+test if-7.4 {if cmd with computed command names: error compiling body after "else"} {
+ set z if
+ set a {}
+ catch {$z 2<1 {set a 1} else {set}} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ invoked from within
+"$z 2<1 {set a 1} else {set}"}
+test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} {
+ set z if
+ set a {}
+ catch {$z 2<1 {set a 1} else {set a 2} or something} msg
+ set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+# The following test also checks whether contained loops and other
+# commands are properly relocated because a short jump must be replaced
+# by a "long distance" one.
+test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} {
+ set z if
+ catch {unset i}
+ set a {}
+ $z 1>2 {
+ set a 1
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 2
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 3
+ } elseif 1==2 then { #; this if arm should be taken
+ set a 4
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 5
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 6
+ } else {
+ set a 7
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 8
+ while {$a != "xxx"} {
+ break;
+ while {$i >= 0} {
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ $z {[string compare $a "bar"] < 0} {
+ set i $i
+ set i [lindex $s $i]
+ }
+ set i [expr $i-1]
+ }
+ }
+ set a 9
+ }
+ set a
+} 9
+
+test if-8.1 {if cmd with computed command names: "if" command result} {
+ set z if
+ set a {}
+ set a [$z 3<4 {set i 27}]
+ set a
+} 27
+test if-8.2 {if cmd with computed command names: "if" command result} {
+ set z if
+ set a {}
+ set a [$z 3>4 {set i 27}]
+ set a
+} {}
+test if-8.3 {if cmd with computed command names: "if" command result} {
+ set z if
+ set a {}
+ set a [$z 0 {set i 1} elseif 1 {set i 2}]
+ set a
+} 2
+test if-8.4 {if cmd with computed command names: "if" command result} {
+ set z if
+ set a {}
+ set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
+ set a
+} 4
+test if-8.5 {if cmd with computed command names: return value} {
+ set z if
+ $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
+} def
+
+test if-9.1 {if cmd with namespace qualifiers} {
+ ::if {1} {set x 4}
+} 4
+
+# Test for incorrect "double evaluation semantics"
+
+test if-10.1 {delayed substitution of then body} {knownBug} {
+ set j 0
+ if {[incr j] == 1} "
+ set result $j
+ "
+ set result
+} {0}
+test if-10.2 {delayed substitution of elseif expression} {knownBug} {
+ set j 0
+ if {[incr j] == 0} {
+ set result badthen
+ } elseif "$j == 1" {
+ set result badelseif
+ } else {
+ set result ok
+ }
+ set result
+} {ok}
+test if-10.3 {delayed substitution of elseif body} {knownBug} {
+ set j 0
+ if {[incr j] == 0} {
+ set result badthen
+ } elseif {1} "
+ set result $j
+ "
+ set result
+} {0}
+test if-10.4 {delayed substitution of else body} {knownBug} {
+ set j 0
+ if {[incr j] == 0} {
+ set result badthen
+ } else "
+ set result $j
+ "
+ set result
+} {0}
+test if-10.5 {substituted control words} {knownBug} {
+ set then then; proc then {} {return badthen}
+ set else else; proc else {} {return badelse}
+ set elseif elseif; proc elseif {} {return badelseif}
+ list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a
+} {0 ok}
+test if-10.6 {double invocation of variable traces} {knownBug} {
+ set iftracecounter 0
+ proc iftraceproc {args} {
+ upvar #0 iftracecounter counter
+ set argc [llength $args]
+ set extraargs [lrange $args 0 [expr {$argc - 4}]]
+ set name [lindex $args [expr {$argc - 3}]]
+ upvar 1 $name var
+ if {[incr counter] % 2 == 1} {
+ set var "$counter oops [concat $extraargs]"
+ } else {
+ set var "$counter + [concat $extraargs]"
+ }
+ }
+ trace variable iftracevar r [list iftraceproc 10]
+ list [catch {if "$iftracevar + 20" {}} a] $a \
+ [catch {if "$iftracevar + 20" {}} b] $b \
+ [unset iftracevar iftracecounter]
+} {1 {syntax error in expression "1 oops 10 + 20"} 0 {} {}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/incr-old.test b/tcl/tests/incr-old.test
index b506be745f5..dc2f3f41bbf 100644
--- a/tcl/tests/incr-old.test
+++ b/tcl/tests/incr-old.test
@@ -8,13 +8,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {unset x}
@@ -86,4 +90,19 @@ test incr-old-2.10 {incr errors} {
list [catch {incr x 1} msg] $msg
} {1 {expected integer but got "20 x"}}
-concat {}
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/incr.test b/tcl/tests/incr.test
index 4e338878814..64d5197ed6e 100644
--- a/tcl/tests/incr.test
+++ b/tcl/tests/incr.test
@@ -5,13 +5,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Basic "incr" operation.
@@ -235,12 +239,283 @@ test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
set x " - "
list [catch {incr x 1} msg] $msg
} {1 {expected integer but got " - "}}
+
+test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
+ catch {unset array}
+ set array(\$foo) 4
+ incr {array($foo)}
+} 5
# Check "incr" and computed command names.
-test incr-2.1 {incr and computed command names} {
+test incr-2.0 {incr and computed command names} {
set i 5
set z incr
$z i -1
set i
} 4
+catch {unset x}
+catch {unset i}
+
+test incr-2.1 {incr command (not compiled): missing variable name} {
+ set z incr
+ list [catch {$z} msg] $msg
+} {1 {wrong # args: should be "incr varName ?increment?"}}
+test incr-2.2 {incr command (not compiled): simple variable name} {
+ set z incr
+ set i 10
+ list [$z i] $i
+} {11 11}
+test incr-2.3 {incr command (not compiled): error compiling variable name} {
+ set z incr
+ set i 10
+ catch {$z "i"xxx} msg
+ set msg
+} {extra characters after close-quote}
+test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
+ set z incr
+ set i 17
+ list [$z "i"] $i
+} {18 18}
+test incr-2.5 {incr command (not compiled): simple variable name in braces} {
+ set z incr
+ catch {unset {a simple var}}
+ set {a simple var} 27
+ list [$z {a simple var}] ${a simple var}
+} {28 28}
+test incr-2.6 {incr command (not compiled): simple array variable name} {
+ set z incr
+ catch {unset a}
+ set a(foo) 37
+ list [$z a(foo)] $a(foo)
+} {38 38}
+test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
+ set z incr
+ set x "i"
+ set i 77
+ list [$z $x 2] $i
+} {79 79}
+test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} {
+ set z incr
+ set x "i"
+ set i 77
+ list [$z [set x] +2] $i
+} {79 79}
+
+test incr-2.9 {incr command (not compiled): increment given} {
+ set z incr
+ set i 10
+ list [$z i +07] $i
+} {17 17}
+test incr-2.10 {incr command (not compiled): no increment given} {
+ set z incr
+ set i 10
+ list [$z i] $i
+} {11 11}
+
+test incr-2.11 {incr command (not compiled): simple global name} {
+ proc p {} {
+ set z incr
+ global i
+ set i 54
+ $z i
+ }
+ p
+} {55}
+test incr-2.12 {incr command (not compiled): simple local name} {
+ proc p {} {
+ set z incr
+ set foo 100
+ $z foo
+ }
+ p
+} {101}
+test incr-2.13 {incr command (not compiled): simple but new (unknown) local name} {
+ proc p {} {
+ set z incr
+ $z bar
+ }
+ catch {p} msg
+ set msg
+} {can't read "bar": no such variable}
+test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
+ proc 260locals {} {
+ set z incr
+ # create 260 locals
+ set a0 0; set a1 0; set a2 0; set a3 0; set a4 0
+ set a5 0; set a6 0; set a7 0; set a8 0; set a9 0
+ set b0 0; set b1 0; set b2 0; set b3 0; set b4 0
+ set b5 0; set b6 0; set b7 0; set b8 0; set b9 0
+ set c0 0; set c1 0; set c2 0; set c3 0; set c4 0
+ set c5 0; set c6 0; set c7 0; set c8 0; set c9 0
+ set d0 0; set d1 0; set d2 0; set d3 0; set d4 0
+ set d5 0; set d6 0; set d7 0; set d8 0; set d9 0
+ set e0 0; set e1 0; set e2 0; set e3 0; set e4 0
+ set e5 0; set e6 0; set e7 0; set e8 0; set e9 0
+ set f0 0; set f1 0; set f2 0; set f3 0; set f4 0
+ set f5 0; set f6 0; set f7 0; set f8 0; set f9 0
+ set g0 0; set g1 0; set g2 0; set g3 0; set g4 0
+ set g5 0; set g6 0; set g7 0; set g8 0; set g9 0
+ set h0 0; set h1 0; set h2 0; set h3 0; set h4 0
+ set h5 0; set h6 0; set h7 0; set h8 0; set h9 0
+ set i0 0; set i1 0; set i2 0; set i3 0; set i4 0
+ set i5 0; set i6 0; set i7 0; set i8 0; set i9 0
+ set j0 0; set j1 0; set j2 0; set j3 0; set j4 0
+ set j5 0; set j6 0; set j7 0; set j8 0; set j9 0
+ set k0 0; set k1 0; set k2 0; set k3 0; set k4 0
+ set k5 0; set k6 0; set k7 0; set k8 0; set k9 0
+ set l0 0; set l1 0; set l2 0; set l3 0; set l4 0
+ set l5 0; set l6 0; set l7 0; set l8 0; set l9 0
+ set m0 0; set m1 0; set m2 0; set m3 0; set m4 0
+ set m5 0; set m6 0; set m7 0; set m8 0; set m9 0
+ set n0 0; set n1 0; set n2 0; set n3 0; set n4 0
+ set n5 0; set n6 0; set n7 0; set n8 0; set n9 0
+ set o0 0; set o1 0; set o2 0; set o3 0; set o4 0
+ set o5 0; set o6 0; set o7 0; set o8 0; set o9 0
+ set p0 0; set p1 0; set p2 0; set p3 0; set p4 0
+ set p5 0; set p6 0; set p7 0; set p8 0; set p9 0
+ set q0 0; set q1 0; set q2 0; set q3 0; set q4 0
+ set q5 0; set q6 0; set q7 0; set q8 0; set q9 0
+ set r0 0; set r1 0; set r2 0; set r3 0; set r4 0
+ set r5 0; set r6 0; set r7 0; set r8 0; set r9 0
+ set s0 0; set s1 0; set s2 0; set s3 0; set s4 0
+ set s5 0; set s6 0; set s7 0; set s8 0; set s9 0
+ set t0 0; set t1 0; set t2 0; set t3 0; set t4 0
+ set t5 0; set t6 0; set t7 0; set t8 0; set t9 0
+ set u0 0; set u1 0; set u2 0; set u3 0; set u4 0
+ set u5 0; set u6 0; set u7 0; set u8 0; set u9 0
+ set v0 0; set v1 0; set v2 0; set v3 0; set v4 0
+ set v5 0; set v6 0; set v7 0; set v8 0; set v9 0
+ set w0 0; set w1 0; set w2 0; set w3 0; set w4 0
+ set w5 0; set w6 0; set w7 0; set w8 0; set w9 0
+ set x0 0; set x1 0; set x2 0; set x3 0; set x4 0
+ set x5 0; set x6 0; set x7 0; set x8 0; set x9 0
+ set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
+ set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
+ set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
+ set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
+ # now increment the last one (local var index > 255)
+ $z z9
+ }
+ 260locals
+} {1}
+test incr-2.15 {incr command (not compiled): variable is array} {
+ set z incr
+ catch {unset a}
+ set a(foo) 27
+ set x [$z a(foo) 11]
+ catch {unset a}
+ set x
+} 38
+test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
+ set z incr
+ catch {unset a}
+ set i 5
+ set a(foo5) 27
+ set x [$z a(foo$i) 11]
+ catch {unset a}
+ set x
+} 38
+
+test incr-2.17 {incr command (not compiled): increment given, simple int} {
+ set z incr
+ set i 5
+ $z i 123
+} 128
+test incr-2.18 {incr command (not compiled): increment given, simple int} {
+ set z incr
+ set i 5
+ $z i -100
+} -95
+test incr-2.19 {incr command (not compiled): increment given, but erroneous} {
+ set z incr
+ set i 5
+ catch {$z i [set]} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ while compiling
+"$z i [set]"}
+test incr-2.20 {incr command (not compiled): increment given, in quotes} {
+ set z incr
+ set i 25
+ $z i "-100"
+} -75
+test incr-2.21 {incr command (not compiled): increment given, in braces} {
+ set z incr
+ set i 24
+ $z i {126}
+} 150
+test incr-2.22 {incr command (not compiled): increment given, large int} {
+ set z incr
+ set i 5
+ $z i 200000
+} 200005
+test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
+ set z incr
+ set i 25
+ $z i 000012345 ;# an octal literal
+} 5374
+test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
+ set z incr
+ set i 25
+ catch {$z i 1a} msg
+ set msg
+} {expected integer but got "1a"}
+
+test incr-2.25 {incr command (not compiled): too many arguments} {
+ set z incr
+ set i 10
+ catch {$z i 10 20} msg
+ set msg
+} {wrong # args: should be "incr varName ?increment?"}
+
+
+test incr-2.26 {incr command (not compiled): runtime error, bad variable name} {
+ set z incr
+ list [catch {$z {"foo}} msg] $msg $errorInfo
+} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+ (reading value of variable to increment)
+ invoked from within
+"$z {"foo}"}}
+test incr-2.27 {incr command (not compiled): runtime error, bad variable name} {
+ set z incr
+ list [catch {$z [set]} msg] $msg $errorInfo
+} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ while compiling
+"$z [set]"}}
+test incr-2.28 {incr command (not compiled): runtime error, readonly variable} {
+ set z incr
+ proc readonly args {error "variable is read-only"}
+ set x 123
+ trace var x w readonly
+ list [catch {$z x 1} msg] $msg $errorInfo
+} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+ while executing
+"$z x 1"}}
+catch {unset x}
+test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
+ set z incr
+ set x " - "
+ list [catch {$z x 1} msg] $msg
+} {1 {expected integer but got " - "}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/indexObj.test b/tcl/tests/indexObj.test
index ea4c0750bea..c372ec7a385 100644
--- a/tcl/tests/indexObj.test
+++ b/tcl/tests/indexObj.test
@@ -3,19 +3,22 @@
# are organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
if {[info commands testindexobj] == {}} {
puts "This application hasn't been compiled with the \"testindexobj\""
puts "command, so I can't test Tcl_GetIndexFromObj etc."
+ ::tcltest::cleanupTests
return
}
@@ -66,3 +69,20 @@ test indexObj-4.1 {free old internal representation} {
lindex $x 1
testindexobj 1 1 $x abc def {a b} zzz
} {2}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/info.test b/tcl/tests/info.test
index 3149035c1bf..c2c2e62d7c3 100644
--- a/tcl/tests/info.test
+++ b/tcl/tests/info.test
@@ -5,14 +5,30 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# Set up namespaces needed to test operation of "info args", "info body",
+# "info default", and "info procs" with imported procedures.
+
+catch {namespace delete test_ns_info1 test_ns_info2}
+
+namespace eval test_ns_info1 {
+ namespace export *
+ proc p {x} {return "x=$x"}
+ proc q {{y 27} {z {}}} {return "y=$y"}
+}
+
test info-1.1 {info args option} {
proc t1 {a bbb c} {return foo}
@@ -38,6 +54,13 @@ test info-1.6 {info args option} {
t1 1 2
info args t1
} {a b}
+test info-1.7 {info args option} {
+ catch {namespace delete test_ns_info2}
+ namespace eval test_ns_info2 {
+ namespace import ::test_ns_info1::*
+ list [info args p] [info args q]
+ }
+} {x {y z}}
test info-2.1 {info body option} {
proc t1 {} {body of t1}
@@ -49,17 +72,50 @@ test info-2.2 {info body option} {
test info-2.3 {info body option} {
list [catch {info args set 1} msg] $msg
} {1 {wrong # args: should be "info args procname"}}
+test info-2.4 {info body option} {
+ catch {namespace delete test_ns_info2}
+ namespace eval test_ns_info2 {
+ namespace import ::test_ns_info1::*
+ list [info body p] [info body q]
+ }
+} {{return "x=$x"} {return "y=$y"}}
+test info-2.5 {info body option, returning bytecompiled bodies} {
+ # Prior to 8.3.0 this would cause a crash because [info body]
+ # would return the bytecompiled version of foo, which the catch
+ # would then try and eval out of the foo context, accessing
+ # compiled local indices
+ catch {unset args}
+ proc foo {args} {
+ foreach v $args {
+ upvar $v var
+ return "variable $v existence: [info exists var]"
+ }
+ }
+ foo a
+ list [catch [info body foo] msg] $msg
+} {1 {can't read "args": no such variable}}
-# "info cmdcount" is no longer accurate for compiled commands! The expected
-# result for info-3.1 used to be "3" and is now "1" since the "set"s have
-# been compiled away.
-test info-3.1 {info cmdcount option} {
+# "info cmdcount" is no longer accurate for compiled commands!
+# The expected result for info-3.1 used to be "3" and is now "1"
+# since the "set"s have been compiled away. info-3.2 was corrected
+# in 8.3 because the eval'ed body won't be compiled.
+proc testinfocmdcount {} {
set x [info cmdcount]
set y 12345
set z [info cm]
expr $z-$x
+}
+test info-3.1 {info cmdcount compiled} {
+ testinfocmdcount
} 1
-test info-3.2 {info body option} {
+test info-3.2 {info cmdcount evaled} {
+ set x [info cmdcount]
+ set y 12345
+ set z [info cm]
+ expr $z-$x
+} 3
+test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 3
+test info-3.4 {info cmdcount option} {
list [catch {info cmdcount 1} msg] $msg
} {1 {wrong # args: should be "info cmdcount"}}
@@ -93,151 +149,22 @@ test info-4.5 {info commands option} {
} {1 {wrong # args: should be "info commands ?pattern?"}}
test info-5.1 {info complete option} {
- info complete ""
-} 1
+ list [catch {info complete} msg] $msg
+} {1 {wrong # args: should be "info complete command"}}
test info-5.2 {info complete option} {
- info complete " \n"
+ info complete abc
} 1
+test info-5.2 {info complete option} {
+ info complete "\{abcd "
+} 0
test info-5.3 {info complete option} {
- info complete "abc def"
+ info complete {# Comment should be complete command}
} 1
test info-5.4 {info complete option} {
- info complete "a b c d e f \t\n"
-} 1
-test info-5.5 {info complete option} {
- info complete {a b c"d}
-} 1
-test info-5.6 {info complete option} {
- info complete {a b "c d" e}
-} 1
-test info-5.7 {info complete option} {
- info complete {a b "c d"}
-} 1
-test info-5.8 {info complete option} {
- info complete {a b "c d"}
-} 1
-test info-5.9 {info complete option} {
- info complete {a b "c d}
-} 0
-test info-5.10 {info complete option} {
- info complete {a b "}
-} 0
-test info-5.11 {info complete option} {
- info complete {a b "cd"xyz}
-} 1
-test info-5.12 {info complete option} {
- info complete {a b "c $d() d"}
-} 1
-test info-5.13 {info complete option} {
- info complete {a b "c $dd("}
-} 0
-test info-5.14 {info complete option} {
- info complete {a b "c \"}
-} 0
-test info-5.15 {info complete option} {
- info complete {a b "c [d e f]"}
-} 1
-test info-5.16 {info complete option} {
- info complete {a b "c [d e f] g"}
-} 1
-test info-5.17 {info complete option} {
- info complete {a b "c [d e f"}
-} 0
-test info-5.18 {info complete option} {
- info complete {a {b c d} e}
-} 1
-test info-5.19 {info complete option} {
- info complete {a {b c d}}
-} 1
-test info-5.20 {info complete option} {
- info complete "a b\{c d"
-} 1
-test info-5.21 {info complete option} {
- info complete "a b \{c"
-} 0
-test info-5.22 {info complete option} {
- info complete "a b \{c{ }"
-} 0
-test info-5.23 {info complete option} {
- info complete "a b {c d e}xxx"
-} 1
-test info-5.24 {info complete option} {
- info complete "a b {c \\\{d e}xxx"
-} 1
-test info-5.25 {info complete option} {
- info complete {a b [ab cd ef]}
-} 1
-test info-5.26 {info complete option} {
- info complete {a b x[ab][cd][ef] gh}
-} 1
-test info-5.27 {info complete option} {
- info complete {a b x[ab][cd[ef] gh}
-} 0
-test info-5.28 {info complete option} {
- info complete {a b x[ gh}
-} 0
-test info-5.29 {info complete option} {
- info complete {[]]]}
-} 1
-test info-5.30 {info complete option} {
- info complete {abc x$yyy}
-} 1
-test info-5.31 {info complete option} {
- info complete "abc x\${abc\[\\d} xyz"
-} 1
-test info-5.32 {info complete option} {
- info complete "abc x\$\{ xyz"
-} 0
-test info-5.33 {info complete option} {
- info complete {word $a(xyz)}
-} 1
-test info-5.34 {info complete option} {
- info complete {word $a(}
-} 0
-test info-5.35 {info complete option} {
- info complete "set a \\\n"
-} 0
-test info-5.36 {info complete option} {
- info complete "set a \\n "
-} 1
-test info-5.37 {info complete option} {
- info complete "set a \\"
-} 1
-test info-5.38 {info complete option} {
- info complete "foo \\\n\{"
-} 0
-test info-5.39 {info complete option} {
- info complete " # \{"
-} 1
-test info-5.40 {info complete option} {
- info complete "foo bar;# \{"
-} 1
-test info-5.41 {info complete option} {
- info complete "a\nb\n# \{\n# \{\nc\n"
-} 1
-test info-5.42 {info complete option} {
- info complete "#Incomplete comment\\\n"
-} 0
-test info-5.43 {info complete option} {
- info complete "#Incomplete comment\\\nBut now it's complete.\n"
-} 1
-test info-5.44 {info complete option} {
- info complete "# Complete comment\\\\\n"
-} 1
-test info-5.45 {info complete option} {
- info complete "abc\\\n def"
-} 1
-test info-5.46 {info complete option} {
- info complete "abc\\\n "
-} 1
-test info-5.47 {info complete option} {
- info complete "abc\\\n"
+ info complete {[a [b] }
} 0
-test info-5.48 {info complete option} {
- info complete "set x [binary format H 00]; puts hi"
-} 1
-test info-5.49 {info complete option} {
- info complete "set x [binary format H 00]; \{"
+test info-5.5 {info complete option} {
+ info complete {[a [b]}
} 0
test info-6.1 {info default option} {
@@ -288,6 +215,13 @@ test info-6.10 {info default option} {
proc t1 {{a 18} b} {}
list [catch {info default t1 a a} msg] $msg
} {1 {couldn't store default value in variable "a"}}
+test info-6.11 {info default option} {
+ catch {namespace delete test_ns_info2}
+ namespace eval test_ns_info2 {
+ namespace import ::test_ns_info1::*
+ list [info default p x foo] $foo [info default q y bar] $bar
+ }
+} {0 {} 1 27}
catch {unset a}
test info-7.1 {info exists option} {
@@ -416,7 +350,7 @@ test info-11.1 {info loaded option} {
} {1 {wrong # args: should be "info loaded ?interp?"}}
test info-11.2 {info loaded option} {
list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
-} {0 1 {couldn't find slave interpreter named "gorp"}}
+} {0 1 {could not find interpreter "gorp"}}
test info-12.1 {info locals option} {
set a 22
@@ -499,10 +433,71 @@ catch {rename _tt2 {}}
test info-15.3 {info procs option} {
list [catch {info procs 2 3} msg] $msg
} {1 {wrong # args: should be "info procs ?pattern?"}}
-
-set self info.test
-if {$tcl_platform(os) == "Win32s"} {
- set self info~1.tes
+test info-15.4 {info procs option} {
+ catch {namespace delete test_ns_info2}
+ namespace eval test_ns_info2 {
+ namespace import ::test_ns_info1::*
+ proc r {} {}
+ list [info procs] [info procs p*]
+ }
+} {{p q r} p}
+test info-15.5 {info procs option with a proc in a namespace} {
+ catch {namespace delete test_ns_info2}
+ namespace eval test_ns_info2 {
+ proc p1 { arg } {
+ puts cmd
+ }
+ proc p2 { arg } {
+ puts cmd
+ }
+ }
+ info procs ::test_ns_info2::p1
+} {::test_ns_info2::p1}
+test info-15.6 {info procs option with a pattern in a namespace} {
+ catch {namespace delete test_ns_info2}
+ namespace eval test_ns_info2 {
+ proc p1 { arg } {
+ puts cmd
+ }
+ proc p2 { arg } {
+ puts cmd
+ }
+ }
+ lsort [info procs ::test_ns_info2::p*]
+} [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
+test info-15.7 {info procs option with a global shadowing proc} {
+ catch {namespace delete test_ns_info2}
+ proc string_cmd { arg } {
+ puts cmd
+ }
+ namespace eval test_ns_info2 {
+ proc string_cmd { arg } {
+ puts cmd
+ }
+ }
+ info procs test_ns_info2::string*
+} {::test_ns_info2::string_cmd}
+# This regression test is currently commented out because it requires
+# that the implementation of "info procs" looks into the global namespace,
+# which it does not (in contrast to "info commands")
+if {0} {
+test info-15.8 {info procs option with a global shadowing proc} {
+ catch {namespace delete test_ns_info2}
+ proc string_cmd { arg } {
+ puts cmd
+ }
+ proc string_cmd2 { arg } {
+ puts cmd
+ }
+ namespace eval test_ns_info2 {
+ proc string_cmd { arg } {
+ puts cmd
+ }
+ }
+ namespace eval test_ns_info2 {
+ lsort [info procs string*]
+ }
+} [lsort [list string_cmd string_cmd2]]
}
test info-16.1 {info script option} {
@@ -510,20 +505,20 @@ test info-16.1 {info script option} {
} {1 {wrong # args: should be "info script"}}
test info-16.2 {info script option} {
file tail [info sc]
-} $self
+} "info.test"
removeFile gorp.info
makeFile "info script\n" gorp.info
test info-16.3 {info script option} {
list [source gorp.info] [file tail [info script]]
-} [list gorp.info $self]
+} [list gorp.info info.test]
test info-16.4 {resetting "info script" after errors} {
catch {source ~_nobody_/foo}
file tail [info script]
-} $self
+} "info.test"
test info-16.5 {resetting "info script" after errors} {
catch {source _nonexistent_}
file tail [info script]
-} $self
+} "info.test"
removeFile gorp.info
test info-17.1 {info sharedlibextension option} {
@@ -594,3 +589,9 @@ test info-20.4 {miscellaneous error conditions} {
test info-20.5 {miscellaneous error conditions} {
list [catch {info s} msg] $msg
} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+
+# cleanup
+catch {namespace delete test_ns_info1 test_ns_info2}
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/init.test b/tcl/tests/init.test
index cfea5054940..c74a43fe04d 100644
--- a/tcl/tests/init.test
+++ b/tcl/tests/init.test
@@ -5,14 +5,17 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Clear out any namespaces called test_ns_*
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -58,25 +61,28 @@ test init-1.8 {auto_qualify - multiple colons 2} {
# places where auto_loading occur (before loading the indexes files and after)
set testInterp [interp create]
-interp eval $testInterp [list set VERBOSE $VERBOSE]
-interp eval $testInterp [list set TESTS $TESTS]
+interp eval $testInterp [list set argv $argv]
+interp eval $testInterp [list package require tcltest]
+interp eval $testInterp [list namespace import -force ::tcltest::*]
interp eval $testInterp {
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+}
auto_reset
catch {rename parray {}}
test init-2.0 {load parray - stage 1} {
- set ret [catch {namespace eval ::test {parray}} error]
+ set ret [catch {namespace eval ::tcltest {parray}} error]
rename parray {} ; # remove it, for the next test - that should not fail.
list $ret $error
} {1 {no value given for parameter "a" to "parray"}}
test init-2.1 {load parray - stage 2} {
- set ret [catch {namespace eval ::test {parray}} error]
+ set ret [catch {namespace eval ::tcltest {parray}} error]
list $ret $error
} {1 {no value given for parameter "a" to "parray"}}
@@ -129,7 +135,7 @@ catch {rename ::http::geturl {}}
test init-2.8 {load http::geturl (package)} {
# 3 ':' on purpose
- set ret [catch {namespace eval ::test {http:::geturl}} error]
+ set ret [catch {namespace eval ::tcltest {http:::geturl}} error]
# removing it, for the next test. should not fail.
rename ::http::geturl {} ;
list $ret $error
@@ -138,12 +144,27 @@ test init-2.8 {load http::geturl (package)} {
test init-3.0 {random stuff in the auto_index, should still work} {
set auto_index(foo:::bar::blah) {
- namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
+ namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
}
foo:::bar::blah
} 1
}
+# cleanup
interp delete $testInterp
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/interp.test b/tcl/tests/interp.test
index 2062f95f8b0..86cf49dafa8 100644
--- a/tcl/tests/interp.test
+++ b/tcl/tests/interp.test
@@ -5,21 +5,24 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# The set of hidden commands is platform dependent:
if {"$tcl_platform(platform)" == "macintosh"} {
- set hidden_cmds {beep cd echo exit fconfigure file glob load ls open pwd socket source}
+ set hidden_cmds {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source}
} else {
- set hidden_cmds {cd exec exit fconfigure file glob load open pwd socket source}
+ set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source}
}
foreach i [interp slaves] {
@@ -40,7 +43,7 @@ test interp-1.3 {options for interp command} {
} ""
test interp-1.4 {options for interp command} {
list [catch {interp delete foo bar} msg] $msg
-} {1 {interpreter named "foo" not found}}
+} {1 {could not find interpreter "foo"}}
test interp-1.5 {options for interp command} {
list [catch {interp exists foo bar} msg] $msg
} {1 {wrong # args: should be "interp exists ?path?"}}
@@ -84,7 +87,7 @@ test interp-2.6 {basic interpreter creation} {
} d
test interp-2.7 {basic interpreter creation} {
list [catch {interp create -froboz} msg] $msg
-} {1 {bad option "-froboz": should be -safe}}
+} {1 {bad option "-froboz": must be -safe or --}}
test interp-2.8 {basic interpreter creation} {
interp create -- -froboz
} -froboz
@@ -100,17 +103,15 @@ test interp-2.11 {anonymous interps vs existing procs} {
set x [interp create]
regexp "interp(\[0-9]+)" $x dummy thenum
interp delete $x
- incr thenum
proc interp$thenum {} {}
set x [interp create]
regexp "interp(\[0-9]+)" $x dummy anothernum
- expr $anothernum - $thenum
+ expr $anothernum > $thenum
} 1
test interp-2.12 {anonymous interps vs existing procs} {
set x [interp create -safe]
regexp "interp(\[0-9]+)" $x dummy thenum
interp delete $x
- incr thenum
proc interp$thenum {} {}
set x [interp create -safe]
regexp "interp(\[0-9]+)" $x dummy anothernum
@@ -165,10 +166,10 @@ test interp-4.1 {testing interp delete} {
} ""
test interp-4.2 {testing interp delete} {
list [catch {interp delete nonexistent} msg] $msg
-} {1 {interpreter named "nonexistent" not found}}
+} {1 {could not find interpreter "nonexistent"}}
test interp-4.3 {testing interp delete} {
list [catch {interp delete x y z} msg] $msg
-} {1 {interpreter named "x" not found}}
+} {1 {could not find interpreter "x"}}
test interp-4.4 {testing interp delete} {
interp delete
} ""
@@ -188,10 +189,10 @@ test interp-4.7 {testing interp delete} {
interp create c1
interp create c2
list [catch {interp delete c1 c2 c3} msg] $msg
-} {1 {interpreter named "c3" not found}}
+} {1 {could not find interpreter "c3"}}
test interp-4.8 {testing interp delete} {
list [catch {interp delete {}} msg] $msg
-} {1 {interpreter named "" not found}}
+} {1 {cannot delete the current interpreter}}
foreach i [interp slaves] {
interp delete $i
@@ -1443,7 +1444,7 @@ test interp-20.45 {interp hide vs namespaces} {
catch {interp delete a}
interp create a
a eval {
- namespace eval foo {}
+ namespace eval foo {}
proc foo::x {} {}
}
set l [list [catch {interp hide a foo::x} msg] $msg]
@@ -1454,7 +1455,7 @@ test interp-20.46 {interp hide vs namespaces} {
catch {interp delete a}
interp create a
a eval {
- namespace eval foo {}
+ namespace eval foo {}
proc foo::x {} {}
}
set l [list [catch {interp hide a foo::x x} msg] $msg]
@@ -1475,7 +1476,7 @@ test interp-20.48 {interp hide vs namespaces} {
catch {interp delete a}
interp create a
a eval {
- namespace eval foo {}
+ namespace eval foo {}
proc foo::x {} {}
}
set l [list [catch {interp hide a foo::x bar::x} msg] $msg]
@@ -1598,7 +1599,7 @@ test interp-22.5 {testing interp marktrusted} {
catch {a eval {interp marktrusted b}} msg
interp delete a
set msg
-} {"interp marktrusted" can only be invoked from a trusted interpreter}
+} {permission denied: safe interpreter cannot mark trusted}
test interp-22.6 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
@@ -1606,7 +1607,7 @@ test interp-22.6 {testing interp marktrusted} {
catch {a eval {b marktrusted}} msg
interp delete a
set msg
-} {"b marktrusted" can only be invoked from a trusted interpreter}
+} {permission denied: safe interpreter cannot mark trusted}
test interp-22.7 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
@@ -1666,7 +1667,7 @@ test interp-23.1 {testing hiding vs aliases} {
interp delete a
set l
} {{} bar {} bar bar {} {}}
-test interp-23.2 {testing hiding vs aliases} {pc || unix} {
+test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
catch {interp delete a}
interp create a -safe
set l ""
@@ -1682,7 +1683,7 @@ test interp-23.2 {testing hiding vs aliases} {pc || unix} {
lappend l [lsort [interp hidden a]]
interp delete a
set l
-} {{cd exec exit fconfigure file glob load open pwd socket source} bar {cd exec exit fconfigure file glob load open pwd socket source} bar {bar cd exec exit fconfigure file glob load open pwd socket source} {} {cd exec exit fconfigure file glob load open pwd socket source}}
+} {{cd encoding exec exit fconfigure file glob load open pwd socket source} bar {cd encoding exec exit fconfigure file glob load open pwd socket source} bar {bar cd encoding exec exit fconfigure file glob load open pwd socket source} {} {cd encoding exec exit fconfigure file glob load open pwd socket source}}
test interp-23.3 {testing hiding vs aliases} {macOnly} {
catch {interp delete a}
@@ -1700,7 +1701,7 @@ test interp-23.3 {testing hiding vs aliases} {macOnly} {
lappend l [lsort [interp hidden a]]
interp delete a
set l
-} {{beep cd echo exit fconfigure file glob load ls open pwd socket source} bar {beep cd echo exit fconfigure file glob load ls open pwd socket source} bar {bar beep cd echo exit fconfigure file glob load ls open pwd socket source} {} {beep cd echo exit fconfigure file glob load ls open pwd socket source}}
+} {{beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} bar {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} bar {bar beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} {} {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source}}
test interp-24.1 {result resetting on error} {
catch {interp delete a}
@@ -1933,31 +1934,94 @@ test interp-25.1 {testing aliasing of string commands} {
} ""
+#
# Interps result transmission
-test interp-26.1 {result code transmission 1} {knownBug} {
- # This test currently fails ! (only ok/error are passed, not the other
- # codes). Fixing the code is thus needed... -- dl
- # (the only other acceptable result list would be
- # {-1 0 1 0 3 4 5} because of the way return -code return(=2) works)
- # test that all the possibles error codes from Tcl get passed
+#
+
+test interp-26.1 {result code transmission : interp eval direct} {
+ # Test that all the possibles error codes from Tcl get passed up
+ # from the slave interp's context to the master, even though the
+ # slave nominally thinks the command is running at the root level.
+
+ catch {interp delete a}
+ interp create a
+ set res {}
+ # use a for so if a return -code break 'escapes' we would notice
+ for {set code -1} {$code<=5} {incr code} {
+ lappend res [catch {interp eval a return -code $code} msg]
+ }
+ interp delete a
+ set res
+} {-1 0 1 2 3 4 5}
+
+
+test interp-26.2 {result code transmission : interp eval indirect} {
+ # retcode == 2 == return is special
catch {interp delete a}
interp create a
- interp eval a {proc ret {code} {return -code $code $code}}
+ interp eval a {proc retcode {code} {return -code $code ret$code}}
set res {}
# use a for so if a return -code break 'escapes' we would notice
for {set code -1} {$code<=5} {incr code} {
- lappend res [catch {interp eval a ret $code} msg]
+ lappend res [catch {interp eval a retcode $code} msg] $msg
+ }
+ interp delete a
+ set res
+} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
+
+test interp-26.3 {result code transmission : aliases} {
+ # Test that all the possibles error codes from Tcl get passed up
+ # from the slave interp's context to the master, even though the
+ # slave nominally thinks the command is running at the root level.
+
+ catch {interp delete a}
+ interp create a
+ set res {}
+ proc MyTestAlias {code} {
+ return -code $code ret$code
+ }
+ interp alias a Test {} MyTestAlias
+ for {set code -1} {$code<=5} {incr code} {
+ lappend res [interp eval a [list catch [list Test $code] msg]]
}
interp delete a
set res
} {-1 0 1 2 3 4 5}
-test interp-26.2 {result code transmission 2} {knownBug} {
- # This test currently fails ! (error is cleared)
- # Code fixing is needed... -- dl
- # (the only other acceptable result list would be
- # {-1 0 1 0 3 4 5} because of the way return -code return(=2) works)
- # test that all the possibles error codes from Tcl get passed
+test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \
+ {knownBug} {
+ # The known bug is that code 2 is returned, not the -code argument
+ catch {interp delete a}
+ interp create a
+ set res {}
+ interp hide a return
+ for {set code -1} {$code<=5} {incr code} {
+ lappend res [catch {interp invokehidden a return -code $code ret$code}]
+ }
+ interp delete a
+ set res
+} {-1 0 1 2 3 4 5}
+
+test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} \
+ {knownBug} {
+ # The known bug is that the break and continue should raise errors
+ # that they are used outside a loop.
+ catch {interp delete a}
+ interp create a
+ set res {}
+ interp eval a {proc retcode {code} {return -code $code ret$code}}
+ interp hide a retcode
+ for {set code -1} {$code<=5} {incr code} {
+ lappend res [catch {interp invokehidden a retcode $code} msg] $msg
+ }
+ interp delete a
+ set res
+} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
+
+test interp-26.6 {result code transmission: all combined--bug 1637} \
+ {knownBug} {
+ # Test that all the possibles error codes from Tcl get passed
+ # In both directions. This doesn't work.
set interp [interp create];
proc MyTestAlias {interp args} {
global aliasTrace;
@@ -1968,17 +2032,22 @@ test interp-26.2 {result code transmission 2} {knownBug} {
interp hide $interp $c;
interp alias $interp $c {} MyTestAlias $interp $c;
}
- interp eval $interp {proc ret {code} {return -code $code $code}}
+ interp eval $interp {proc ret {code} {return -code $code ret$code}}
set res {}
set aliasTrace {}
for {set code -1} {$code<=5} {incr code} {
- lappend res [catch {interp eval $interp ret $code} msg]
+ lappend res [catch {interp eval $interp ret $code} msg] $msg
}
interp delete $interp;
- list $res
-} {-1 0 1 2 3 4 5}
+ set res
+} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
-test interp-26.3 {errorInfo transmission : regular interps} {
+# Some tests might need to be added to check for difference between
+# toplevel and non toplevel evals.
+
+# End of return code transmission section
+
+test interp-26.7 {errorInfo transmission: regular interps} {
set interp [interp create];
proc MyError {secret} {
return -code error "msg"
@@ -1993,14 +2062,15 @@ test interp-26.3 {errorInfo transmission : regular interps} {
} {msg
while executing
"MyError "some secret""
- (procedure "test" line 2)
+ (procedure "MyTestAlias" line 2)
invoked from within
-"catch test"}
+"test"}
-test interp-26.4 {errorInfo transmission : safe interps} {knownBug} {
+test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
# this test fails because the errorInfo is fully transmitted
- # whether the interp is safe or not. this is maybe a feature
- # and not a bug.
+ # whether the interp is safe or not. The errorInfo should never
+ # report data from the master interpreter because it could
+ # contain sensitive information.
set interp [interp create -safe];
proc MyError {secret} {
return -code error "msg"
@@ -2014,7 +2084,7 @@ test interp-26.4 {errorInfo transmission : safe interps} {knownBug} {
set res
} {msg
while executing
-"catch test"}
+"test"}
# Interps & Namespaces
test interp-27.1 {interp aliases & namespaces} {
@@ -2079,7 +2149,7 @@ test interp-27.4 {interp aliases & namespaces} {
# test interp-27.5 {interp hidden & namespaces} {
# set i [interp create];
# interp eval $i {
-# namespace eval foo {
+# namespace eval foo {
# proc bar {args} {
# return "bar called ([namespace current]) ($args)"
# }
@@ -2104,7 +2174,7 @@ test interp-27.4 {interp aliases & namespaces} {
# }
# }
# interp eval $i {
-# namespace eval foo {
+# namespace eval foo {
# namespace export *
# variable v foo-slave;
# proc bar {args} {
@@ -2118,7 +2188,7 @@ test interp-27.4 {interp aliases & namespaces} {
# $i alias foo::bar foo::bar $i;
# set res [concat $res [interp eval $i {
# set v root-slave;
-# namespace eval test {
+# namespace eval test {
# variable v foo-test;
# namespace import ::foo::*;
# bar test2
@@ -2142,7 +2212,7 @@ test interp-27.4 {interp aliases & namespaces} {
# }
# }
# interp eval $i {
-# namespace eval foo {
+# namespace eval foo {
# namespace export *
# variable v foo-slave;
# proc bar {args} {
@@ -2151,7 +2221,7 @@ test interp-27.4 {interp aliases & namespaces} {
# }
# }
# set v root-slave;
-# namespace eval test {
+# namespace eval test {
# variable v foo-test;
# namespace import ::foo::*;
# }
@@ -2163,7 +2233,7 @@ test interp-27.4 {interp aliases & namespaces} {
# namespace delete mfoo;
# interp delete $i;
# set res
-# } {{slave bar called (foo-slave) (bar test1) (::test) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
+# } {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
#test interp-27.8 {hiding, namespaces and integrity} {
# namespace eval foo {
@@ -2182,7 +2252,7 @@ test interp-28.1 {getting fooled by slave's namespace ?} {
proc master {interp args} {interp hide $interp list}
$i alias master master $i;
set r [interp eval $i {
- namespace eval foo {
+ namespace eval foo {
proc list {args} {
return "dummy foo::list";
}
@@ -2258,12 +2328,35 @@ test interp-29.2 {recursion limit inheritance} {
}
# This test dumps core in Tcl 8.0.3!
-#test interp-30.1 {deletion of aliases inside namespaces} {
-# set i [interp create]
-# $i alias ns::cmd list
-# $i alias ns::cmd {}
-#} {}
+test interp-30.1 {deletion of aliases inside namespaces} {
+ set i [interp create]
+ $i alias ns::cmd list
+ $i alias ns::cmd {}
+} {}
+
+test interp-31.1 {alias invocation scope} {
+ proc mySet {varName value} {
+ upvar 1 $varName localVar
+ set localVar $value
+ }
+ interp alias {} myNewSet {} mySet
+ proc testMyNewSet {value} {
+ myNewSet a $value
+ return $a
+ }
+ catch {unset a}
+ set result [testMyNewSet "ok"]
+ rename testMyNewSet {}
+ rename mySet {}
+ rename myNewSet {}
+ set result
+} ok
+
+# cleanup
foreach i [interp slaves] {
interp delete $i
}
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/io.test b/tcl/tests/io.test
index 15da487f7d1..772f67dbd55 100644
--- a/tcl/tests/io.test
+++ b/tcl/tests/io.test
@@ -7,13 +7,17 @@
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
if {"[info commands testchannel]" != "testchannel"} {
puts "Skipping io tests. This application does not seem to have the"
@@ -21,9 +25,13 @@ if {"[info commands testchannel]" != "testchannel"} {
return
}
+::tcltest::saveState
+
removeFile test1
removeFile pipe
+catch {unset u}
+
# set up a long data file for some of the following tests
set f [open longfile w]
@@ -35,95 +43,1477 @@ for { set i 0 } { $i < 100 } { incr i} {
}
close $f
-set f [open cat w]
-puts $f {
- if {$argv == {}} {
- set argv -
- }
- foreach name $argv {
- if {$name == "-"} {
- set f stdin
- } elseif {[catch {open $name r} f] != 0} {
- puts stderr $f
- continue
- }
- while {[eof $f] == 0} {
- puts -nonewline stdout [read $f]
- }
- if {$f != "stdin"} {
+makeFile {
+ set f stdin
+ if {$argv != ""} {
+ set f [open $argv]
+ }
+ fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a
+ fconfigure stdout -encoding binary -translation lf -buffering none
+ fileevent $f readable "foo $f"
+ proc foo {f} {
+ set x [read $f]
+ catch {puts -nonewline $x}
+ if {[eof $f]} {
close $f
+ exit 0
}
}
+ vwait forever
+} cat
+
+set thisScript [file join [pwd] [info script]]
+
+proc contents {file} {
+ set f [open $file]
+ fconfigure $f -translation binary
+ set a [read $f]
+ close $f
+ return $a
}
-close $f
-# These tests are disabled until we decide what to do with "unsupported0".
-#
-#test io-1.7 {unsupported0 command} {
-# removeFile test1
-# set f1 [open iocmd.test]
-# set f2 [open test1 w]
-# unsupported0 $f1 $f2
-# close $f1
-# catch {close $f2}
-# set s1 [file size [info script]]
-# set s2 [file size test1]
-# set x ok
-# if {"$s1" != "$s2"} {
-# set x broken
-# }
-# set x
-#} ok
-#test io-1.8 {unsupported0 command} {
-# removeFile test1
-# set f1 [open [info script]]
-# set f2 [open test1 w]
-# unsupported0 $f1 $f2 40
-# close $f1
-# close $f2
-# file size test1
-#} 40
-#test io-1.9 {unsupported0 command} {
-# removeFile test1
-# set f1 [open [info script]]
-# set f2 [open test1 w]
-# unsupported0 $f1 $f2 -1
-# close $f1
-# close $f2
-# set x ok
-# set s1 [file size [info script]]
-# set s2 [file size test1]
-# if {$s1 != $s2} {
-# set x broken
-# }
-# set x
-#} ok
-#test io-1.10 {unsupported0 command} {unixOrPc} {
-# removeFile pipe
-# removeFile test1
-# set f1 [open pipe w]
-# puts $f1 {puts ready}
-# puts $f1 {gets stdin}
-# puts $f1 {set f1 [open [info script] r]}
-# puts $f1 {puts [read $f1 100]}
-# puts $f1 {close $f1}
-# close $f1
-# set f1 [open "|[list $tcltest pipe]" r+]
-# gets $f1
-# puts $f1 ready
-# flush $f1
-# set f2 [open test1 w]
-# set c [unsupported0 $f1 $f2 40]
-# catch {close $f1}
-# close $f2
-# set s1 [file size test1]
-# set x ok
-# if {$s1 != "40"} {
-# set x broken
-# }
-# list $c $x
-#} {40 ok}
+test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
+ # no test, need to cause an async error.
+} {}
+test io-1.6 {Tcl_WriteChars: WriteBytes} {
+ set f [open test1 w]
+ fconfigure $f -encoding binary
+ puts -nonewline $f "a\u4e4d\0"
+ close $f
+ contents test1
+} "a\x4d\x00"
+test io-1.7 {Tcl_WriteChars: WriteChars} {
+ set f [open test1 w]
+ fconfigure $f -encoding shiftjis
+ puts -nonewline $f "a\u4e4d\0"
+ close $f
+ contents test1
+} "a\x93\xe1\x00"
+
+test io-2.1 {WriteBytes} {
+ # loop until all bytes are written
+
+ set f [open test1 w]
+ fconfigure $f -encoding binary -buffersize 16 -translation crlf
+ puts $f "abcdefghijklmnopqrstuvwxyz"
+ close $f
+ contents test1
+} "abcdefghijklmnopqrstuvwxyz\r\n"
+test io-2.2 {WriteBytes: savedLF > 0} {
+ # After flushing buffer, there was a \n left over from the last
+ # \n -> \r\n expansion. It gets stuck at beginning of this buffer.
+
+ set f [open test1 w]
+ fconfigure $f -encoding binary -buffersize 16 -translation crlf
+ puts -nonewline $f "123456789012345\n12"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "123456789012345\r" "123456789012345\r\n12"]
+test io-2.3 {WriteBytes: flush on line} {
+ # Tcl "line" buffering has weird behavior: if current buffer contains
+ # a \n, entire buffer gets flushed. Logical behavior would be to flush
+ # only up to the \n.
+
+ set f [open test1 w]
+ fconfigure $f -encoding binary -buffering line -translation crlf
+ puts -nonewline $f "\n12"
+ set x [contents test1]
+ close $f
+ set x
+} "\r\n12"
+test io-2.4 {WriteBytes: reset sawLF after each buffer} {
+ set f [open test1 w]
+ fconfigure $f -encoding binary -buffering line -translation lf \
+ -buffersize 16
+ puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
+
+test io-3.1 {WriteChars: compatibility with WriteBytes} {
+ # loop until all bytes are written
+
+ set f [open test1 w]
+ fconfigure $f -encoding ascii -buffersize 16 -translation crlf
+ puts $f "abcdefghijklmnopqrstuvwxyz"
+ close $f
+ contents test1
+} "abcdefghijklmnopqrstuvwxyz\r\n"
+test io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
+ # After flushing buffer, there was a \n left over from the last
+ # \n -> \r\n expansion. It gets stuck at beginning of this buffer.
+
+ set f [open test1 w]
+ fconfigure $f -encoding ascii -buffersize 16 -translation crlf
+ puts -nonewline $f "123456789012345\n12"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "123456789012345\r" "123456789012345\r\n12"]
+test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
+ # Tcl "line" buffering has weird behavior: if current buffer contains
+ # a \n, entire buffer gets flushed. Logical behavior would be to flush
+ # only up to the \n.
+
+ set f [open test1 w]
+ fconfigure $f -encoding ascii -buffering line -translation crlf
+ puts -nonewline $f "\n12"
+ set x [contents test1]
+ close $f
+ set x
+} "\r\n12"
+test io-3.4 {WriteChars: loop over stage buffer} {
+ # stage buffer maps to more than can be queued at once.
+
+ set f [open test1 w]
+ fconfigure $f -encoding jis0208 -buffersize 16
+ puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test io-3.5 {WriteChars: saved != 0} {
+ # Bytes produced by UtfToExternal from end of last channel buffer
+ # had to be moved to beginning of next channel buffer to preserve
+ # requested buffersize.
+
+ set f [open test1 w]
+ fconfigure $f -encoding jis0208 -buffersize 17
+ puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
+ # One incomplete UTF-8 character at end of staging buffer. Backup
+ # in src to the beginning of that UTF-8 character and try again.
+ #
+ # Translate the first 16 bytes, produce 14 bytes of output, 2 left over
+ # (first two bytes of \uff21 in UTF-8). Given those two bytes try
+ # translating them again, find that no bytes are read produced, and break
+ # to outer loop where those two bytes will have the remaining 4 bytes
+ # (the last byte of \uff21 plus the all of \uff22) appended.
+
+ set f [open test1 w]
+ fconfigure $f -encoding shiftjis -buffersize 16
+ puts -nonewline $f "12345678901234\uff21\uff22"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
+test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
+ # When translating UTF-8 to external, the produced bytes went past end
+ # of the channel buffer. This is done purpose -- we then truncate the
+ # bytes at the end of the partial character to preserve the requested
+ # blocksize on flush. The truncated bytes are moved to the beginning
+ # of the next channel buffer.
+
+ set f [open test1 w]
+ fconfigure $f -encoding jis0208 -buffersize 17
+ puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test io-3.8 {WriteChars: reset sawLF after each buffer} {
+ set f [open test1 w]
+ fconfigure $f -encoding ascii -buffering line -translation lf \
+ -buffersize 16
+ puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
+
+test io-4.1 {TranslateOutputEOL: lf} {
+ # search for \n
+
+ set f [open test1 w]
+ fconfigure $f -buffering line -translation lf
+ puts $f "abcde"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "abcde\n" "abcde\n"]
+test io-4.2 {TranslateOutputEOL: cr} {
+ # search for \n, replace with \r
+
+ set f [open test1 w]
+ fconfigure $f -buffering line -translation cr
+ puts $f "abcde"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "abcde\r" "abcde\r"]
+test io-4.3 {TranslateOutputEOL: crlf} {
+ # simple case: search for \n, replace with \r
+
+ set f [open test1 w]
+ fconfigure $f -buffering line -translation crlf
+ puts $f "abcde"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "abcde\r\n" "abcde\r\n"]
+test io-4.4 {TranslateOutputEOL: crlf} {
+ # keep storing more bytes in output buffer until output buffer is full.
+ # We have 13 bytes initially that would turn into 18 bytes. Fill
+ # dest buffer while (dstEnd < dstMax).
+
+ set f [open test1 w]
+ fconfigure $f -translation crlf -buffersize 16
+ puts -nonewline $f "1234567\n\n\n\n\nA"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"]
+test io-4.5 {TranslateOutputEOL: crlf} {
+ # Check for overflow of the destination buffer
+
+ set f [open test1 w]
+ fconfigure $f -translation crlf -buffersize 12
+ puts -nonewline $f "12345678901\n456789012345678901234"
+ close $f
+ set x [contents test1]
+} "12345678901\r\n456789012345678901234"
+
+test io-5.1 {CheckFlush: not full} {
+ set f [open test1 w]
+ fconfigure $f
+ puts -nonewline $f "12345678901234567890"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "" "12345678901234567890"]
+test io-5.2 {CheckFlush: full} {
+ set f [open test1 w]
+ fconfigure $f -buffersize 16
+ puts -nonewline $f "12345678901234567890"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "1234567890123456" "12345678901234567890"]
+test io-5.3 {CheckFlush: not line} {
+ set f [open test1 w]
+ fconfigure $f -buffering line
+ puts -nonewline $f "12345678901234567890"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "" "12345678901234567890"]
+test io-5.4 {CheckFlush: line} {
+ set f [open test1 w]
+ fconfigure $f -buffering line -translation lf -encoding ascii
+ puts -nonewline $f "1234567890\n1234567890"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "1234567890\n1234567890" "1234567890\n1234567890"]
+test io-5.5 {CheckFlush: none} {
+ set f [open test1 w]
+ fconfigure $f -buffering none
+ puts -nonewline $f "1234567890"
+ set x [list [contents test1]]
+ close $f
+ lappend x [contents test1]
+} [list "1234567890" "1234567890"]
+
+test io-6.1 {Tcl_GetsObj: working} {
+ set f [open test1 w]
+ puts $f "foo\nboo"
+ close $f
+ set f [open test1]
+ set x [gets $f]
+ close $f
+ set x
+} {foo}
+test io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} {
+ # no test, need to cause an async error.
+} {}
+test io-6.3 {Tcl_GetsObj: how many have we used?} {
+ # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved}
+
+ set f [open test1 w]
+ fconfigure $f -translation crlf
+ puts $f "abc\ndefg"
+ close $f
+ set f [open test1]
+ set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]
+ close $f
+ set x
+} {0 3 5 4 defg}
+test io-6.4 {Tcl_GetsObj: encoding == NULL} {
+ set f [open test1 w]
+ fconfigure $f -translation binary
+ puts $f "\x81\u1234\0"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation binary
+ set x [list [gets $f line] $line]
+ close $f
+ set x
+} [list 3 "\x81\x34\x00"]
+test io-6.5 {Tcl_GetsObj: encoding != NULL} {
+ set f [open test1 w]
+ fconfigure $f -translation binary
+ puts $f "\x88\xea\x92\x9a"
+ close $f
+ set f [open test1]
+ fconfigure $f -encoding shiftjis
+ set x [list [gets $f line] $line]
+ close $f
+ set x
+} [list 2 "\u4e00\u4e01"]
+set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+append a $a
+append a $a
+test io-6.6 {Tcl_GetsObj: loop test} {
+ # if (dst >= dstEnd)
+
+ set f [open test1 w]
+ puts $f $a
+ puts $f hi
+ close $f
+ set f [open test1]
+ set x [list [gets $f line] $line]
+ close $f
+ set x
+} [list 256 $a]
+test io-6.7 {Tcl_GetsObj: error in input} {stdio} {
+ # if (FilterInputBytes(chanPtr, &gs) != 0)
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ puts -nonewline $f "hi\nwould"
+ flush $f
+ gets $f
+ fconfigure $f -blocking 0
+ set x [gets $f line]
+ close $f
+ set x
+} {-1}
+test io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
+ set f [open test1 w]
+ puts $f "abcdef\x1aghijk\nwombat"
+ close $f
+ set f [open test1]
+ fconfigure $f -eofchar \x1a
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {6 abcdef -1 {}}
+test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
+ set f [open test1 w]
+ puts $f "abcdefghijk\nwom\u001abat"
+ close $f
+ set f [open test1]
+ fconfigure $f -eofchar \x1a
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {11 abcdefghijk 3 wom}
+
+# Comprehensive tests
+
+test io-6.10 {Tcl_GetsObj: lf mode: no chars} {
+ set f [open test1 w]
+ close $f
+ set f [open test1]
+ fconfigure $f -translation lf
+ set x [list [gets $f line] $line]
+ close $f
+ set x
+} {-1 {}}
+test io-6.11 {Tcl_GetsObj: lf mode: lone \n} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation lf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {0 {} -1 {}}
+test io-6.12 {Tcl_GetsObj: lf mode: lone \r} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation lf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 1 "\r" -1 ""]
+test io-6.13 {Tcl_GetsObj: lf mode: 1 char} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f a
+ close $f
+ set f [open test1]
+ fconfigure $f -translation lf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {1 a -1 {}}
+test io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "a\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation lf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {1 a -1 {}}
+test io-6.15 {Tcl_GetsObj: lf mode: several chars} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation lf
+ set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
+test io-6.16 {Tcl_GetsObj: cr mode: no chars} {
+ set f [open test1 w]
+ close $f
+ set f [open test1]
+ fconfigure $f -translation cr
+ set x [list [gets $f line] $line]
+ close $f
+ set x
+} {-1 {}}
+test io-6.17 {Tcl_GetsObj: cr mode: lone \n} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation cr
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 1 "\n" -1 ""]
+test io-6.18 {Tcl_GetsObj: cr mode: lone \r} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation cr
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {0 {} -1 {}}
+test io-6.19 {Tcl_GetsObj: cr mode: 1 char} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f a
+ close $f
+ set f [open test1]
+ fconfigure $f -translation cr
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {1 a -1 {}}
+test io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "a\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation cr
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {1 a -1 {}}
+test io-6.21 {Tcl_GetsObj: cr mode: several chars} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation cr
+ set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
+test io-6.22 {Tcl_GetsObj: crlf mode: no chars} {
+ set f [open test1 w]
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [list [gets $f line] $line]
+ close $f
+ set x
+} {-1 {}}
+test io-6.23 {Tcl_GetsObj: crlf mode: lone \n} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 1 "\n" -1 ""]
+test io-6.24 {Tcl_GetsObj: crlf mode: lone \r} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 1 "\r" -1 ""]
+test io-6.25 {Tcl_GetsObj: crlf mode: \r\r} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 2 "\r\r" -1 ""]
+test io-6.26 {Tcl_GetsObj: crlf mode: \r\n} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 0 "" -1 ""]
+test io-6.27 {Tcl_GetsObj: crlf mode: 1 char} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f a
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {1 a -1 {}}
+test io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "a\r\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {1 a -1 {}}
+test io-6.29 {Tcl_GetsObj: crlf mode: several chars} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
+test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {
+ # if (eol >= dstEnd)
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf -buffersize 16
+ set x [list [gets $f line] $line [testchannel inputbuffered $f]]
+ close $f
+ set x
+} [list 15 "123456789012345" 15]
+test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio} {
+ # (FilterInputBytes() != 0)
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {crlf lf} -buffering none
+ puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
+ fconfigure $f -buffersize 16
+ set x [gets $f]
+ fconfigure $f -blocking 0
+ lappend x [gets $f line] $line [fblocked $f] [testchannel inputbuffered $f]
+ close $f
+ set x
+} [list "bbbbbbbbbbbbbb" -1 "" 1 16]
+test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {
+ # not (FilterInputBytes() != 0)
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456789012345\r\n123"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf -buffersize 16
+ set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]]
+ close $f
+ set x
+} [list 15 "123456789012345" 17 3]
+test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
+ # eol still equals dstEnd
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456789012345\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf -buffersize 16
+ set x [list [gets $f line] $line [eof $f]]
+ close $f
+ set x
+} [list 16 "123456789012345\r" 1]
+test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
+ # not (*eol == '\n')
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456789012345\rabcd\r\nefg"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf -buffersize 16
+ set x [list [gets $f line] $line [tell $f]]
+ close $f
+ set x
+} [list 20 "123456789012345\rabcd" 22]
+test io-6.35 {Tcl_GetsObj: auto mode: no chars} {
+ set f [open test1 w]
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [gets $f line] $line]
+ close $f
+ set x
+} {-1 {}}
+test io-6.36 {Tcl_GetsObj: auto mode: lone \n} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 0 "" -1 ""]
+test io-6.37 {Tcl_GetsObj: auto mode: lone \r} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 0 "" -1 ""]
+test io-6.38 {Tcl_GetsObj: auto mode: \r\r} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 0 "" 0 "" -1 ""]
+test io-6.39 {Tcl_GetsObj: auto mode: \r\n} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 0 "" -1 ""]
+test io-6.40 {Tcl_GetsObj: auto mode: 1 char} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f a
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {1 a -1 {}}
+test io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "a\r\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} {1 a -1 {}}
+test io-6.42 {Tcl_GetsObj: auto mode: several chars} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [gets $f line] $line [gets $f line] $line]
+ lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line
+ close $f
+ set x
+} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
+test io-6.43 {Tcl_GetsObj: input saw cr} {stdio} {
+ # if (chanPtr->flags & INPUT_SAW_CR)
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {auto lf} -buffering none
+ puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+ fconfigure $f -buffersize 16
+ set x [list [gets $f]]
+ fconfigure $f -blocking 0
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
+ fconfigure $f -blocking 1
+ puts -nonewline $f "\nabcd\refg\x1a"
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line
+ close $f
+ set x
+} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
+test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio} {
+ # not (*eol == '\n')
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {auto lf} -buffering none
+ puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+ fconfigure $f -buffersize 16
+ set x [list [gets $f]]
+ fconfigure $f -blocking 0
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
+ fconfigure $f -blocking 1
+ puts -nonewline $f "abcd\refg\x1a"
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line
+ close $f
+ set x
+} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
+test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio} {
+ # Tcl_ExternalToUtf()
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {auto lf} -buffering none
+ fconfigure $f -encoding unicode
+ puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+ fconfigure $f -buffersize 16
+ gets $f
+ fconfigure $f -blocking 0
+ set x [list [gets $f line] $line [testchannel queuedcr $f]]
+ fconfigure $f -blocking 1
+ puts -nonewline $f "\nabcd\refg"
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
+ close $f
+ set x
+} [list 15 "123456789abcdef" 1 4 "abcd" 0]
+test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio} {
+ # memmove()
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {auto lf} -buffering none
+ puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+ fconfigure $f -buffersize 16
+ gets $f
+ fconfigure $f -blocking 0
+ set x [list [gets $f line] $line [testchannel queuedcr $f]]
+ fconfigure $f -blocking 1
+ puts -nonewline $f "\n\x1a"
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
+ close $f
+ set x
+} [list 15 "123456789abcdef" 1 -1 "" 0]
+test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {
+ # (eol == dstEnd)
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto -buffersize 16
+ set x [list [gets $f] [testchannel inputbuffered $f]]
+ close $f
+ set x
+} [list "123456789012345" 15]
+test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {
+ # PeekAhead() did not get any, so (eol >= dstEnd)
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456789012345\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto -buffersize 16
+ set x [list [gets $f] [testchannel queuedcr $f]]
+ close $f
+ set x
+} [list "123456789012345" 1]
+test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {
+ # if (*eol == '\n') {skip++}
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456\r\n78901"
+ close $f
+ set f [open test1]
+ set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
+ close $f
+ set x
+} [list "123456" 0 8 "78901"]
+test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {
+ # not (*eol == '\n')
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456\r78901"
+ close $f
+ set f [open test1]
+ set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
+ close $f
+ set x
+} [list "123456" 0 7 "78901"]
+test io-6.51 {Tcl_GetsObj: auto mode: \n} {
+ # else if (*eol == '\n') {goto gotoeol;}
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456\n78901"
+ close $f
+ set f [open test1]
+ set x [list [gets $f] [tell $f] [gets $f]]
+ close $f
+ set x
+} [list "123456" 7 "78901"]
+test io-6.52 {Tcl_GetsObj: saw EOF character} {
+ # if (eof != NULL)
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "123456\x1ak9012345\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -eofchar \x1a
+ set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
+ close $f
+ set x
+} [list "123456" 0 6 ""]
+test io-6.53 {Tcl_GetsObj: device EOF} {
+ # didn't produce any bytes
+
+ set f [open test1 w]
+ close $f
+ set f [open test1]
+ set x [list [gets $f line] $line [eof $f]]
+ close $f
+ set x
+} {-1 {} 1}
+test io-6.54 {Tcl_GetsObj: device EOF} {
+ # got some bytes before EOF.
+
+ set f [open test1 w]
+ puts -nonewline $f abc
+ close $f
+ set f [open test1]
+ set x [list [gets $f line] $line [eof $f]]
+ close $f
+ set x
+} {3 abc 1}
+test io-6.55 {Tcl_GetsObj: overconverted} {
+ # Tcl_ExternalToUtf(), make sure state updated
+
+ set f [open test1 w]
+ fconfigure $f -encoding iso2022-jp
+ puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
+ close $f
+ set f [open test1]
+ fconfigure $f -encoding iso2022-jp
+ set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
+ close $f
+ set x
+} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
+test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio} {
+ update
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -buffering none
+ puts -nonewline $f "foobar"
+ fconfigure $f -blocking 0
+ set x {}
+ after 500 { lappend x timeout }
+ fileevent $f readable { lappend x [gets $f] }
+ vwait x
+ vwait x
+ fconfigure $f -blocking 1
+ puts -nonewline $f "baz\n"
+ after 500 { lappend x timeout }
+ fconfigure $f -blocking 0
+ vwait x
+ vwait x
+ close $f
+ set x
+} {{} timeout foobarbaz timeout}
+
+test io-7.1 {FilterInputBytes: split up character at end of buffer} {
+ # (result == TCL_CONVERT_MULTIBYTE)
+
+ set f [open test1 w]
+ fconfigure $f -encoding shiftjis
+ puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
+ close $f
+ set f [open test1]
+ fconfigure $f -encoding shiftjis -buffersize 16
+ set x [gets $f]
+ close $f
+ set x
+} "1234567890123\uff10\uff11\uff12\uff13\uff14"
+test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
+ # (bufPtr->nextAdded < bufPtr->bufLength)
+
+ set f [open test1 w]
+ fconfigure $f -encoding binary
+ puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
+ close $f
+ set f [open test1]
+ fconfigure $f -encoding shiftjis
+ set x [list [gets $f line] $line [eof $f]]
+ close $f
+ set x
+} [list 10 "1234567890" 0]
+test io-7.3 {FilterInputBytes: split up character at EOF} {
+ set f [open test1 w]
+ fconfigure $f -encoding binary
+ puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
+ close $f
+ set f [open test1]
+ fconfigure $f -encoding shiftjis
+ set x [list [gets $f line] $line]
+ lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
+ lappend x [gets $f line] $line
+ close $f
+ set x
+} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
+test io-7.4 {FilterInputBytes: recover from split up character} {stdio} {
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -encoding binary -buffering none
+ puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
+ fconfigure $f -encoding shiftjis -blocking 0
+ fileevent $f read "ready $f"
+ set x {}
+ proc ready {f} {
+ lappend ::x [gets $f line] $line [fblocked $f]
+ }
+ vwait x
+ fconfigure $f -encoding binary -blocking 1
+ puts $f "\x51\x82\x52"
+ fconfigure $f -encoding shiftjis
+ vwait x
+ close $f
+ set x
+} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
+
+test io-8.1 {PeekAhead: only go to device if no more cached data} {
+ # (bufPtr->nextPtr == NULL)
+
+ set f [open "test1" w]
+ fconfigure $f -encoding ascii -translation lf
+ puts -nonewline $f "123456789012345\r\n2345678"
+ close $f
+ set f [open "test1"]
+ fconfigure $f -encoding ascii -translation auto -buffersize 16
+ # here
+ gets $f
+ set x [testchannel inputbuffered $f]
+ close $f
+ set x
+} "7"
+test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio} {
+ # not (bufPtr->nextPtr == NULL)
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation lf -encoding ascii -buffering none
+ puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
+ set x {}
+ fileevent $f read "ready $f"
+ proc ready {f} {
+ lappend ::x [gets $f line] $line [testchannel inputbuffered $f]
+ }
+ fconfigure $f -encoding unicode -buffersize 16 -blocking 0
+ vwait x
+ fconfigure $f -translation auto -encoding ascii -blocking 1
+ # here
+ vwait x
+ close $f
+ set x
+} [list -1 "" 42 15 "123456789012345" 25]
+test io-8.3 {PeekAhead: no cached data available} {stdio} {
+ # (bytesLeft == 0)
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {auto binary}
+ puts -nonewline $f "abcdefghijklmno\r"
+ flush $f
+ set x [list [gets $f line] $line [testchannel queuedcr $f]]
+ close $f
+ set x
+} [list 15 "abcdefghijklmno" 1]
+set a "123456789012345678901234567890"
+append a "123456789012345678901234567890"
+append a "1234567890123456789012345678901"
+test io-8.4 {PeekAhead: cached data available in this buffer} {
+ # not (bytesLeft == 0)
+
+ set f [open test1 w+]
+ fconfigure $f -translation binary
+ puts $f "${a}\r\nabcdef"
+ close $f
+ set f [open test1]
+ fconfigure $f -encoding binary -translation auto
+
+ # "${a}\r" was converted in one operation (because ENCODING_LINESIZE
+ # is 30). To check if "\n" follows, calls PeekAhead and determines
+ # that cached data is available in buffer w/o having to call driver.
+
+ set x [gets $f]
+ close $f
+ set x
+} $a
+unset a
+test io-8.5 {PeekAhead: don't peek if last read was short} {stdio} {
+ # (bufPtr->nextAdded < bufPtr->length)
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {auto binary}
+ puts -nonewline $f "abcdefghijklmno\r"
+ flush $f
+ # here
+ set x [list [gets $f line] $line [testchannel queuedcr $f]]
+ close $f
+ set x
+} {15 abcdefghijklmno 1}
+test io-8.6 {PeekAhead: change to non-blocking mode} {stdio} {
+ # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {auto binary} -buffersize 16
+ puts -nonewline $f "abcdefghijklmno\r"
+ flush $f
+ # here
+ set x [list [gets $f line] $line [testchannel queuedcr $f]]
+ close $f
+ set x
+} {15 abcdefghijklmno 1}
+test io-8.7 {PeekAhead: cleanup} {stdio} {
+ # Make sure bytes are removed from buffer.
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -translation {auto binary} -buffering none
+ puts -nonewline $f "abcdefghijklmno\r"
+ # here
+ set x [list [gets $f line] $line [testchannel queuedcr $f]]
+ puts -nonewline $f "\x1a"
+ lappend x [gets $f line] $line
+ close $f
+ set x
+} {15 abcdefghijklmno 1 -1 {}}
+
+
+test io-9.1 {CommonGetsCleanup} {
+} {}
+
+test io-10.1 {Tcl_ReadChars: CheckChannelErrors} {
+ # no test, need to cause an async error.
+} {}
+test io-10.2 {Tcl_ReadChars: loop until enough copied} {
+ # one time
+ # for (copied = 0; (unsigned) toRead > 0; )
+
+ set f [open "test1" w]
+ puts $f abcdefghijklmnop
+ close $f
+
+ set f [open "test1"]
+ set x [read $f 5]
+ close $f
+ set x
+} {abcde}
+test io-10.3 {Tcl_ReadChars: loop until enough copied} {
+ # multiple times
+ # for (copied = 0; (unsigned) toRead > 0; )
+
+ set f [open "test1" w]
+ puts $f abcdefghijklmnopqrstuvwxyz
+ close $f
+
+ set f [open "test1"]
+ fconfigure $f -buffersize 16
+ # here
+ set x [read $f 19]
+ close $f
+ set x
+} {abcdefghijklmnopqrs}
+test io-10.4 {Tcl_ReadChars: no more in channel buffer} {
+ # (copiedNow < 0)
+
+ set f [open "test1" w]
+ puts -nonewline $f abcdefghijkl
+ close $f
+
+ set f [open "test1"]
+ # here
+ set x [read $f 1000]
+ close $f
+ set x
+} {abcdefghijkl}
+test io-10.5 {Tcl_ReadChars: stop on EOF} {
+ # (chanPtr->flags & CHANNEL_EOF)
+
+ set f [open "test1" w]
+ puts -nonewline $f abcdefghijkl
+ close $f
+
+ set f [open "test1"]
+ # here
+ set x [read $f 1000]
+ close $f
+ set x
+} {abcdefghijkl}
+
+test io-11.1 {ReadBytes: want to read a lot} {
+ # ((unsigned) toRead > (unsigned) srcLen)
+
+ set f [open "test1" w]
+ puts -nonewline $f abcdefghijkl
+ close $f
+ set f [open "test1"]
+ fconfigure $f -encoding binary
+ # here
+ set x [read $f 1000]
+ close $f
+ set x
+} {abcdefghijkl}
+test io-11.2 {ReadBytes: want to read all} {
+ # ((unsigned) toRead > (unsigned) srcLen)
+
+ set f [open "test1" w]
+ puts -nonewline $f abcdefghijkl
+ close $f
+ set f [open "test1"]
+ fconfigure $f -encoding binary
+ # here
+ set x [read $f]
+ close $f
+ set x
+} {abcdefghijkl}
+test io-11.3 {ReadBytes: allocate more space} {
+ # (toRead > length - offset - 1)
+
+ set f [open "test1" w]
+ puts -nonewline $f abcdefghijklmnopqrstuvwxyz
+ close $f
+ set f [open "test1"]
+ fconfigure $f -buffersize 16 -encoding binary
+ # here
+ set x [read $f]
+ close $f
+ set x
+} {abcdefghijklmnopqrstuvwxyz}
+test io-11.4 {ReadBytes: EOF char found} {
+ # (TranslateInputEOL() != 0)
+
+ set f [open "test1" w]
+ puts $f abcdefghijklmnopqrstuvwxyz
+ close $f
+ set f [open "test1"]
+ fconfigure $f -eofchar m -encoding binary
+ # here
+ set x [list [read $f] [eof $f] [read $f] [eof $f]]
+ close $f
+ set x
+} [list "abcdefghijkl" 1 "" 1]
+
+test io-12.1 {ReadChars: want to read a lot} {
+ # ((unsigned) toRead > (unsigned) srcLen)
+
+ set f [open "test1" w]
+ puts -nonewline $f abcdefghijkl
+ close $f
+ set f [open "test1"]
+ # here
+ set x [read $f 1000]
+ close $f
+ set x
+} {abcdefghijkl}
+test io-12.2 {ReadChars: want to read all} {
+ # ((unsigned) toRead > (unsigned) srcLen)
+
+ set f [open "test1" w]
+ puts -nonewline $f abcdefghijkl
+ close $f
+ set f [open "test1"]
+ # here
+ set x [read $f]
+ close $f
+ set x
+} {abcdefghijkl}
+test io-12.3 {ReadChars: allocate more space} {
+ # (toRead > length - offset - 1)
+
+ set f [open "test1" w]
+ puts -nonewline $f abcdefghijklmnopqrstuvwxyz
+ close $f
+ set f [open "test1"]
+ fconfigure $f -buffersize 16
+ # here
+ set x [read $f]
+ close $f
+ set x
+} {abcdefghijklmnopqrstuvwxyz}
+test io-12.4 {ReadChars: split-up char} {stdio} {
+ # (srcRead == 0)
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -encoding binary -buffering none -buffersize 16
+ puts -nonewline $f "123456789012345\x96"
+ fconfigure $f -encoding shiftjis -blocking 0
+
+ fileevent $f read "ready $f"
+ proc ready {f} {
+ lappend ::x [read $f] [testchannel inputbuffered $f]
+ }
+ set x {}
+
+ fconfigure $f -encoding shiftjis
+ vwait x
+ fconfigure $f -encoding binary -blocking 1
+ puts -nonewline $f "\x7b"
+ after 500 ;# Give the cat process time to catch up
+ fconfigure $f -encoding shiftjis -blocking 0
+ vwait x
+ close $f
+ set x
+} [list "123456789012345" 1 "\u672c" 0]
+test io-12.5 {ReadChars: fileevents on partial characters} {stdio} {
+ makeFile {
+ fconfigure stdout -encoding binary -buffering none
+ gets stdin; puts -nonewline "\xe7"
+ gets stdin; puts -nonewline "\x89"
+ gets stdin; puts -nonewline "\xa6"
+ } test1
+ set f [open "|[list $::tcltest::tcltest test1]" r+]
+ fileevent $f readable {
+ lappend x [read $f]
+ if {[eof $f]} {
+ lappend x eof
+ }
+ }
+ puts $f "go1"
+ flush $f
+ fconfigure $f -blocking 0 -encoding utf-8
+ set x {}
+ vwait x
+ after 500 { lappend x timeout }
+ vwait x
+ puts $f "go2"
+ flush $f
+ vwait x
+ after 500 { lappend x timeout }
+ vwait x
+ puts $f "go3"
+ flush $f
+ vwait x
+ vwait x
+ lappend x [catch {close $f} msg] $msg
+ set x
+} "{} timeout {} timeout \u7266 {} eof 0 {}"
+
+test io-13.1 {TranslateInputEOL: cr mode} {} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\rdef\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation cr
+ set x [read $f]
+ close $f
+ set x
+} "abcd\ndef\n"
+test io-13.2 {TranslateInputEOL: crlf mode} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r\ndef\r\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [read $f]
+ close $f
+ set x
+} "abcd\ndef\n"
+test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
+ # (src >= srcMax)
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r\ndef\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [read $f]
+ close $f
+ set x
+} "abcd\ndef\r"
+test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
+ # (src >= srcMax)
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r\ndef\rfgh"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [read $f]
+ close $f
+ set x
+} "abcd\ndef\rfgh"
+test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
+ # (src >= srcMax)
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r\ndef\nfgh"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation crlf
+ set x [read $f]
+ close $f
+ set x
+} "abcd\ndef\nfgh"
+test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} {
+ # (chanPtr->flags & INPUT_SAW_CR)
+ # This test may fail on slower machines.
+
+ set f [open "|[list $::tcltest::tcltest cat]" w+]
+ fconfigure $f -blocking 0 -buffering none -translation {auto lf}
+
+ fileevent $f read "ready $f"
+ proc ready {f} {
+ lappend ::x [read $f] [testchannel queuedcr $f]
+ }
+ set x {}
+
+ puts -nonewline $f "abcdefghj\r"
+ after 500 {set y ok}
+ vwait y
+
+ puts -nonewline $f "\n01234"
+ after 500 {set y ok}
+ vwait y
+
+ close $f
+ set x
+} [list "abcdefghj\n" 1 "01234" 0]
+test io-13.7 {TranslateInputEOL: auto mode: naked \r} {
+ # (src >= srcMax)
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [list [read $f] [testchannel queuedcr $f]]
+ close $f
+ set x
+} [list "abcd\n" 1]
+test io-13.8 {TranslateInputEOL: auto mode: \r\n} {
+ # (*src == '\n')
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r\ndef"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [read $f]
+ close $f
+ set x
+} "abcd\ndef"
+test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\rdef"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [read $f]
+ close $f
+ set x
+} "abcd\ndef"
+test io-13.10 {TranslateInputEOL: auto mode: \n} {
+ # not (*src == '\r')
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\ndef"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto
+ set x [read $f]
+ close $f
+ set x
+} "abcd\ndef"
+test io-13.11 {TranslateInputEOL: EOF char} {
+ # (*chanPtr->inEofChar != '\0')
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\ndefgh"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto -eofchar e
+ set x [read $f]
+ close $f
+ set x
+} "abcd\nd"
+test io-13.12 {TranslateInputEOL: find EOF char in src} {
+ # (*chanPtr->inEofChar != '\0')
+
+ set f [open test1 w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
+ close $f
+ set f [open test1]
+ fconfigure $f -translation auto -eofchar e
+ set x [read $f]
+ close $f
+ set x
+} "\n\n\nab\n\nd"
+
# Test standard handle management. The functions tested are
# Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are
# also testing channel table management.
@@ -133,7 +1523,7 @@ if {$tcl_platform(platform) == "macintosh"} {
} else {
set consoleFileNames [lsort [testchannel open]]
}
-test io-1.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
+test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
set l ""
lappend l [fconfigure stdin -buffering]
lappend l [fconfigure stdout -buffering]
@@ -141,7 +1531,7 @@ test io-1.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
lappend l [lsort [testchannel open]]
set l
} [list line line none $consoleFileNames]
-test io-1.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
+test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
interp create x
set l ""
lappend l [x eval {fconfigure stdin -buffering}]
@@ -150,7 +1540,7 @@ test io-1.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
interp delete x
set l
} {line line none}
-test io-1.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
+test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
set f [open test1 w]
puts $f {
close stdin
@@ -167,7 +1557,7 @@ test io-1.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
close $f3
}
close $f
- set result [exec $tcltest test1]
+ set result [exec $::tcltest::tcltest test1]
set f [open test2 r]
set f2 [open test3 r]
lappend result [read $f] [read $f2]
@@ -179,7 +1569,7 @@ out
} {err
}}
# This test relies on the fact that the smallest available fd is used first.
-test io-1.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
+test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
set f [open test1 w]
puts $f { close stdin
close stdout
@@ -195,7 +1585,7 @@ test io-1.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
close $f3
}
close $f
- set result [exec $tcltest test1]
+ set result [exec $::tcltest::tcltest test1]
set f [open test2 r]
set f2 [open test3 r]
lappend result [read $f] [read $f2]
@@ -207,7 +1597,7 @@ file1
} {file2
}}
catch {interp delete z}
-test io-1.5 {Tcl_GetChannel: stdio name translation} {
+test io-14.5 {Tcl_GetChannel: stdio name translation} {
interp create z
eof stdin
catch {z eval flush stdin} msg1
@@ -217,7 +1607,7 @@ test io-1.5 {Tcl_GetChannel: stdio name translation} {
interp delete z
set result
} {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
-test io-1.6 {Tcl_GetChannel: stdio name translation} {
+test io-14.6 {Tcl_GetChannel: stdio name translation} {
interp create z
eof stdout
catch {z eval flush stdout} msg1
@@ -227,7 +1617,7 @@ test io-1.6 {Tcl_GetChannel: stdio name translation} {
interp delete z
set result
} {{} {} {can not find channel named "stdout"}}
-test io-1.7 {Tcl_GetChannel: stdio name translation} {
+test io-14.7 {Tcl_GetChannel: stdio name translation} {
interp create z
eof stderr
catch {z eval flush stderr} msg1
@@ -237,7 +1627,7 @@ test io-1.7 {Tcl_GetChannel: stdio name translation} {
interp delete z
set result
} {{} {} {can not find channel named "stderr"}}
-test io-1.8 {reuse of stdio special channels} {unixOnly} {
+test io-14.8 {reuse of stdio special channels} {stdio} {
removeFile script
removeFile test1
set f [open script w]
@@ -250,12 +1640,12 @@ test io-1.8 {reuse of stdio special channels} {unixOnly} {
puts [gets $f]
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
set c [gets $f]
close $f
set c
} hello
-test io-1.9 {reuse of stdio special channels} {stdio} {
+test io-14.9 {reuse of stdio special channels} {stdio} {
removeFile script
removeFile test1
set f [open script w]
@@ -268,14 +1658,17 @@ test io-1.9 {reuse of stdio special channels} {stdio} {
puts [gets $f]
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
set c [gets $f]
close $f
set c
} hello
-# Must add test function for testing Tcl_CreateCloseHandler and
-# Tcl_DeleteCloseHandler.
+test io-15.1 {Tcl_CreateCloseHandler} {
+} {}
+
+test io-16.1 {Tcl_DeleteCloseHandler} {
+} {}
# Test channel table management. The functions tested are
# GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel,
@@ -284,16 +1677,7 @@ test io-1.9 {reuse of stdio special channels} {stdio} {
# These functions use "eof stdin" to ensure that the standard
# channels are added to the channel table of the interpreter.
-#
-# CYGNUS LOCAL:
-# I open tclConfig.sh to get the correct paths if I am not in the install
-# directory. This increments the refcount on the stdin WHEN the interpreter
-# is created, not when you call eof stdin in the child. Because of this, I
-# had to change the first value in the results for tests 2.1, 2.2 & 2.3 from
-# 0 to 1. This is really a side issue, and does not affect what the tests
-# were supposed to be looking for, however.
-
-test io-2.1 {GetChannelTable, DeleteChannelTable on std handles} {
+test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {
set l1 [testchannel refcount stdin]
eof stdin
interp create x
@@ -304,8 +1688,8 @@ test io-2.1 {GetChannelTable, DeleteChannelTable on std handles} {
interp delete x
lappend l [expr [testchannel refcount stdin] - $l1]
set l
-} {1 1 0}
-test io-2.2 {GetChannelTable, DeleteChannelTable on std handles} {
+} {0 1 0}
+test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {
set l1 [testchannel refcount stdout]
eof stdin
interp create x
@@ -316,8 +1700,8 @@ test io-2.2 {GetChannelTable, DeleteChannelTable on std handles} {
interp delete x
lappend l [expr [testchannel refcount stdout] - $l1]
set l
-} {1 1 0}
-test io-2.3 {GetChannelTable, DeleteChannelTable on std handles} {
+} {0 1 0}
+test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {
set l1 [testchannel refcount stderr]
eof stdin
interp create x
@@ -328,8 +1712,9 @@ test io-2.3 {GetChannelTable, DeleteChannelTable on std handles} {
interp delete x
lappend l [expr [testchannel refcount stderr] - $l1]
set l
-} {1 1 0}
-test io-2.4 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+} {0 1 0}
+
+test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
removeFile test1
set l ""
set f [open test1 w]
@@ -343,7 +1728,7 @@ test io-2.4 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
string compare [string tolower $l] \
[list 1 [format "can not find channel named \"%s\"" $f]]
} 0
-test io-2.5 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
removeFile test1
set l ""
set f [open test1 w]
@@ -364,7 +1749,7 @@ test io-2.5 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
string compare [string tolower $l] \
[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
} 0
-test io-2.6 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
removeFile test1
set l ""
set f [open test1 w]
@@ -383,20 +1768,21 @@ test io-2.6 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
string compare [string tolower $l] \
[list 1 2 1 [format "can not find channel named \"%s\"" $f]]
} 0
-test io-2.7 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
+
+test io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
eof stdin
} 0
-test io-2.8 {testing Tcl_GetChannel, user opened handle} {
+test io-19.2 {testing Tcl_GetChannel, user opened handle} {
removeFile test1
set f [open test1 w]
set x [eof $f]
close $f
set x
} 0
-test io-2.9 {Tcl_GetChannel, channel not found} {
+test io-19.3 {Tcl_GetChannel, channel not found} {
list [catch {eof file34} msg] $msg
} {1 {can not find channel named "file34"}}
-test io-2.10 {Tcl_CreateChannel, insertion into channel table} {
+test io-19.4 {Tcl_CreateChannel, insertion into channel table} {
removeFile test1
set f [open test1 w]
set l ""
@@ -411,27 +1797,79 @@ test io-2.10 {Tcl_CreateChannel, insertion into channel table} {
[list 0 [format "can not find channel named \"%s\"" $f]]
} 0
+test io-20.1 {Tcl_CreateChannel: initial settings} {
+ set a [open test2 w]
+ set old [encoding system]
+ encoding system ascii
+ set f [open test1 w]
+ set x [fconfigure $f -encoding]
+ close $f
+ encoding system $old
+ close $a
+ set x
+} {ascii}
+test io-20.2 {Tcl_CreateChannel: initial settings} {pcOnly} {
+ set f [open test1 w+]
+ set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
+ close $f
+ set x
+} [list [list \x1a ""] {auto crlf}]
+test io-20.3 {Tcl_CreateChannel: initial settings} {unixOnly} {
+ set f [open test1 w+]
+ set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
+ close $f
+ set x
+} {{{} {}} {auto lf}}
+test io-20.4 {Tcl_CreateChannel: initial settings} {macOnly} {
+ set f [open test1 w+]
+ set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
+ close $f
+ set x
+} {{{} {}} {auto cr}}
+test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio} {
+ set f [open script w]
+ puts $f {
+ close stdout
+ set f1 [open stdout w]
+ fconfigure $f1 -buffersize 777
+ puts stderr [fconfigure stdout -buffersize]
+ }
+ close $f
+ set f [open "|[list $::tcltest::tcltest script]"]
+ catch {close $f} msg
+ set msg
+} {777}
+
+test io-21.1 {CloseChannelsOnExit} {
+} {}
+
# Test management of attributes associated with a channel, such as
# its default translation, its name and type, etc. The functions
# tested in this group are Tcl_GetChannelName,
# Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData
# not tested because files do not use the instance data.
-test io-3.1 {Tcl_GetChannelName} {
+test io-22.1 {Tcl_GetChannelMode} {
+ # Not used anywhere in Tcl.
+} {}
+
+test io-23.1 {Tcl_GetChannelName} {
removeFile test1
set f [open test1 w]
set n [testchannel name $f]
close $f
string compare $n $f
} 0
-test io-3.2 {Tcl_GetChannelType} {
+
+test io-24.1 {Tcl_GetChannelType} {
removeFile test1
set f [open test1 w]
set t [testchannel type $f]
close $f
string compare $t file
} 0
-test io-3.3 {Tcl_GetChannelFile, input} {
+
+test io-25.1 {Tcl_GetChannelHandle, input} {
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
puts $f "1234567890\n098765432"
@@ -444,7 +1882,7 @@ test io-3.3 {Tcl_GetChannelFile, input} {
close $f
set l
} {10 11}
-test io-3.4 {Tcl_GetChannelFile, output} {
+test io-25.2 {Tcl_GetChannelHandle, output} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -460,9 +1898,18 @@ test io-3.4 {Tcl_GetChannelFile, output} {
set l
} {6 6 0 6}
+test io-26.1 {Tcl_GetChannelInstanceData} {stdio} {
+ # "pid" command uses Tcl_GetChannelInstanceData
+ # Don't care what pid is (but must be a number), just want to exercise it.
+
+ set f [open "|[list $::tcltest::tcltest << exit]"]
+ expr [pid $f]
+ close $f
+} {}
+
# Test flushing. The functions tested here are FlushChannel.
-test io-4.1 {FlushChannel, no output buffered} {
+test io-27.1 {FlushChannel, no output buffered} {
removeFile test1
set f [open test1 w]
flush $f
@@ -470,7 +1917,7 @@ test io-4.1 {FlushChannel, no output buffered} {
close $f
set s
} 0
-test io-4.2 {FlushChannel, some output buffered} {
+test io-27.2 {FlushChannel, some output buffered} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -483,7 +1930,7 @@ test io-4.2 {FlushChannel, some output buffered} {
lappend l [file size test1]
set l
} {0 6 6}
-test io-4.3 {FlushChannel, implicit flush on close} {
+test io-27.3 {FlushChannel, implicit flush on close} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -494,7 +1941,7 @@ test io-4.3 {FlushChannel, implicit flush on close} {
lappend l [file size test1]
set l
} {0 6}
-test io-4.4 {FlushChannel, implicit flush when buffer fills} {
+test io-27.4 {FlushChannel, implicit flush when buffer fills} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -510,7 +1957,8 @@ test io-4.4 {FlushChannel, implicit flush when buffer fills} {
close $f
set l
} {0 60 72}
-test io-4.5 {FlushChannel, implicit flush when buffer fills and on close} {unixOrPc} {
+test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
+ {unixOrPc} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -buffersize 60 -eofchar {}
@@ -524,7 +1972,8 @@ test io-4.5 {FlushChannel, implicit flush when buffer fills and on close} {unixO
lappend l [file size test1]
set l
} {0 60 72}
-test io-4.6 {FlushChannel, async flushing, async close} {stdio && asyncPipeClose} {
+test io-27.6 {FlushChannel, async flushing, async close} \
+ {stdio asyncPipeClose } {
removeFile pipe
removeFile output
set f [open pipe w]
@@ -544,7 +1993,7 @@ test io-4.6 {FlushChannel, async flushing, async close} {stdio && asyncPipeClose
}
set f [open output w]
close $f
- set f [open "|[list $tcltest pipe]" w]
+ set f [open "|[list $::tcltest::tcltest pipe]" w]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
@@ -555,7 +2004,7 @@ test io-4.6 {FlushChannel, async flushing, async close} {stdio && asyncPipeClose
update
}
if {$counter == 1000} {
- set result probably_broken
+ set result "file size only [file size output]"
} else {
set result ok
}
@@ -563,7 +2012,7 @@ test io-4.6 {FlushChannel, async flushing, async close} {stdio && asyncPipeClose
# Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.
-test io-5.1 {CloseChannel called when all references are dropped} {
+test io-28.1 {CloseChannel called when all references are dropped} {
removeFile test1
set f [open test1 w]
interp create x
@@ -576,7 +2025,7 @@ test io-5.1 {CloseChannel called when all references are dropped} {
close $f
set l
} {2 1}
-test io-5.2 {CloseChannel called when all references are dropped} {
+test io-28.2 {CloseChannel called when all references are dropped} {
removeFile test1
set f [open test1 w]
interp create x
@@ -591,7 +2040,8 @@ test io-5.2 {CloseChannel called when all references are dropped} {
close $f
set l
} abcdef
-test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc asyncPipeClose nonPortable tempNotPc} {
+test io-28.3 {CloseChannel, not called before output queue is empty} \
+ {stdio asyncPipeClose nonPortable} {
removeFile pipe
removeFile output
set f [open pipe w]
@@ -619,12 +2069,9 @@ test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc as
}
set f [open output w]
close $f
- set f [open "|[list $tcltest pipe]" r+]
+ set f [open "|[list $::tcltest::tcltest pipe]" r+]
fconfigure $f -blocking off -eofchar {}
- # Under windows, the first 24576 bytes of $x are copied to $f, and
- # then the writing fails.
-
puts -nonewline $f $x
close $f
set counter 0
@@ -639,7 +2086,7 @@ test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc as
set result ok
}
} ok
-test io-5.4 {Tcl_Close} {
+test io-28.4 {Tcl_Close} {
removeFile test1
set l ""
lappend l [lsort [testchannel open]]
@@ -652,7 +2099,7 @@ test io-5.4 {Tcl_Close} {
$consoleFileNames]
string compare $l $x
} 0
-test io-5.5 {Tcl_Close vs standard handles} {unixOnly} {
+test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly} {
removeFile script
set f [open script w]
puts $f {
@@ -660,19 +2107,16 @@ test io-5.5 {Tcl_Close vs standard handles} {unixOnly} {
puts [testchannel open]
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
set l [gets $f]
close $f
set l
} {file1 file2}
-# Test output on channels. The functions tested are Tcl_Write
-# and Tcl_Flush.
-
-test io-6.1 {Tcl_Write, channel not writable} {
+test io-29.1 {Tcl_WriteChars, channel not writable} {
list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
-test io-6.2 {Tcl_Write, empty string} {
+test io-29.2 {Tcl_WriteChars, empty string} {
removeFile test1
set f [open test1 w]
fconfigure $f -eofchar {}
@@ -680,7 +2124,7 @@ test io-6.2 {Tcl_Write, empty string} {
close $f
file size test1
} 0
-test io-6.3 {Tcl_Write, nonempty string} {
+test io-29.3 {Tcl_WriteChars, nonempty string} {
removeFile test1
set f [open test1 w]
fconfigure $f -eofchar {}
@@ -688,7 +2132,7 @@ test io-6.3 {Tcl_Write, nonempty string} {
close $f
file size test1
} 5
-test io-6.4 {Tcl_Write, buffering in full buffering mode} {
+test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -buffering full -eofchar {}
@@ -702,7 +2146,7 @@ test io-6.4 {Tcl_Write, buffering in full buffering mode} {
close $f
set l
} {6 0 0 6}
-test io-6.5 {Tcl_Write, buffering in line buffering mode} {
+test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -buffering line -eofchar {}
@@ -716,7 +2160,7 @@ test io-6.5 {Tcl_Write, buffering in line buffering mode} {
close $f
set l
} {5 0 0 11}
-test io-6.6 {Tcl_Write, buffering in no buffering mode} {
+test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -buffering none -eofchar {}
@@ -730,7 +2174,8 @@ test io-6.6 {Tcl_Write, buffering in no buffering mode} {
close $f
set l
} {0 5 0 11}
-test io-6.7 {Tcl_Flush, full buffering} {
+
+test io-29.7 {Tcl_Flush, full buffering} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -buffering full -eofchar {}
@@ -747,7 +2192,7 @@ test io-6.7 {Tcl_Flush, full buffering} {
close $f
set l
} {5 0 11 0 0 11}
-test io-6.8 {Tcl_Flush, full buffering} {
+test io-29.8 {Tcl_Flush, full buffering} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -buffering line
@@ -767,34 +2212,34 @@ test io-6.8 {Tcl_Flush, full buffering} {
close $f
set l
} {5 0 0 5 0 11 0 11}
-test io-6.9 {Tcl_Flush, channel not writable} {
+test io-29.9 {Tcl_Flush, channel not writable} {
list [catch {flush stdin} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
-test io-6.10 {Tcl_Write, looping and buffering} {
+test io-29.10 {Tcl_WriteChars, looping and buffering} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
set f2 [open longfile r]
for {set x 0} {$x < 10} {incr x} {
- puts $f1 [gets $f2]
+ puts $f1 [gets $f2]
}
close $f2
close $f1
file size test1
} 387
-test io-6.11 {Tcl_Write, no newline, implicit flush} {
+test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -eofchar {}
set f2 [open longfile r]
for {set x 0} {$x < 10} {incr x} {
- puts -nonewline $f1 [gets $f2]
+ puts -nonewline $f1 [gets $f2]
}
close $f1
close $f2
file size test1
} 377
-test io-6.12 {Tcl_Write on a pipe} {stdio} {
+test io-29.12 {Tcl_WriteChars on a pipe} {stdio} {
removeFile test1
removeFile pipe
set f1 [open pipe w]
@@ -805,21 +2250,21 @@ test io-6.12 {Tcl_Write on a pipe} {stdio} {
}
}
close $f1
- set f1 [open "|[list $tcltest pipe]" r]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r]
set f2 [open longfile r]
set y ok
for {set x 0} {$x < 10} {incr x} {
- set l1 [gets $f1]
- set l2 [gets $f2]
- if {"$l1" != "$l2"} {
- set y broken
- }
+ set l1 [gets $f1]
+ set l2 [gets $f2]
+ if {"$l1" != "$l2"} {
+ set y broken
+ }
}
close $f1
close $f2
set y
} ok
-test io-6.13 {Tcl_Write to a pipe, line buffered} {stdio} {
+test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio} {
removeFile test1
removeFile pipe
set f1 [open pipe w]
@@ -829,26 +2274,26 @@ test io-6.13 {Tcl_Write to a pipe, line buffered} {stdio} {
}
close $f1
set y ok
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
fconfigure $f1 -buffering line
set f2 [open longfile r]
set line [gets $f2]
puts $f1 $line
set backline [gets $f1]
if {"$line" != "$backline"} {
- set y broken
+ set y broken
}
set line [gets $f2]
puts $f1 $line
set backline [gets $f1]
if {"$line" != "$backline"} {
- set y broken
+ set y broken
}
close $f1
close $f2
set y
} ok
-test io-6.14 {Tcl_Write, buffering and implicit flush at close} {
+test io-29.14 {Tcl_WriteChars, buffering and implicit flush at close} {
removeFile test3
set f [open test3 w]
puts -nonewline $f "Text1"
@@ -860,7 +2305,7 @@ test io-6.14 {Tcl_Write, buffering and implicit flush at close} {
close $f
set x
} {Text1 Text 2 Text 3}
-test io-6.15 {Tcl_Flush, channel not open for writing} {
+test io-29.15 {Tcl_Flush, channel not open for writing} {
removeFile test1
set fd [open test1 w]
close $fd
@@ -870,14 +2315,14 @@ test io-6.15 {Tcl_Flush, channel not open for writing} {
string compare $x \
[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
-test io-6.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
- set fd [open "|[list $tcltest cat longfile]" r]
+test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
+ set fd [open "|[list $::tcltest::tcltest cat longfile]" r]
set x [list [catch {flush $fd} msg] $msg]
catch {close $fd}
string compare $x \
[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
-test io-6.17 {Tcl_Write buffers, then Tcl_Flush flushes} {
+test io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf
@@ -889,7 +2334,7 @@ test io-6.17 {Tcl_Write buffers, then Tcl_Flush flushes} {
close $f1
set x
} 18
-test io-6.18 {Tcl_Write and Tcl_Flush intermixed} {
+test io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} {
removeFile test1
set x ""
set f1 [open test1 w]
@@ -908,7 +2353,7 @@ test io-6.18 {Tcl_Write and Tcl_Flush intermixed} {
close $f1
set x
} {18 24 30}
-test io-6.19 {Explicit and implicit flushes} {
+test io-29.19 {Explicit and implicit flushes} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -926,7 +2371,7 @@ test io-6.19 {Explicit and implicit flushes} {
lappend x [file size test1]
set x
} {18 24 30}
-test io-6.20 {Implicit flush when buffer is full} {
+test io-29.20 {Implicit flush when buffer is full} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -937,28 +2382,28 @@ test io-6.20 {Implicit flush when buffer is full} {
set z ""
lappend z [file size test1]
for {set x 0} {$x < 100} {incr x} {
- puts $f1 $line
+ puts $f1 $line
}
lappend z [file size test1]
close $f1
lappend z [file size test1]
set z
} {4096 12288 12600}
-test io-6.21 {Tcl_Flush to pipe} {stdio} {
+test io-29.21 {Tcl_Flush to pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {set x [read stdin 6]}
puts $f1 {set cnt [string length $x]}
puts $f1 {puts "read $cnt characters"}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
puts $f1 hello
flush $f1
set x [gets $f1]
catch {close $f1}
set x
} "read 6 characters"
-test io-6.22 {Tcl_Flush called at other end of pipe} {stdio} {
+test io-29.22 {Tcl_Flush called at other end of pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {
@@ -971,7 +2416,7 @@ test io-6.22 {Tcl_Flush called at other end of pipe} {stdio} {
flush stdout
}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
set x ""
lappend x [gets $f1]
lappend x [gets $f1]
@@ -981,7 +2426,7 @@ test io-6.22 {Tcl_Flush called at other end of pipe} {stdio} {
close $f1
set x
} {hello hello bye}
-test io-6.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
+test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {
@@ -991,7 +2436,7 @@ test io-6.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
puts bye
}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
set x ""
lappend x [gets $f1]
lappend x [gets $f1]
@@ -1001,7 +2446,7 @@ test io-6.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
close $f1
set x
} {hello hello bye}
-test io-6.24 {Tcl_Write and Tcl_Flush move end of file} {
+test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
set f [open test3 w]
puts $f "Line 1"
puts $f "Line 2"
@@ -1015,11 +2460,10 @@ test io-6.24 {Tcl_Write and Tcl_Flush move end of file} {
close $f2
close $f
set x
-} {{} {Line 1
-Line 2}}
-test io-6.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
+} "{} {Line 1\nLine 2}"
+test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
removeFile test3
- set f [open "|[list $tcltest cat | $tcltest cat > test3]" w]
+ set f [open "|[list $::tcltest::tcltest cat | $::tcltest::tcltest cat > test3]" w]
puts $f "Line 1"
puts $f "Line 2"
close $f
@@ -1028,10 +2472,8 @@ test io-6.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
set x [read $f]
close $f
set x
-} {Line 1
-Line 2
-}
-test io-6.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc && unixExecs && tempNotPc} {
+} "Line 1\nLine 2\n"
+test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} {
set f [open "|[list cat -u]" r+]
puts $f "Line1"
flush $f
@@ -1039,12 +2481,12 @@ test io-6.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc && unix
close $f
set x
} {Line1}
-test io-6.27 {Tcl_Flush on closed pipeline} {stdio && tempNotPc} {
+test io-29.27 {Tcl_Flush on closed pipeline} {stdio} {
removeFile pipe
set f [open pipe w]
puts $f {exit}
close $f
- set f [open "|[list $tcltest pipe]" r+]
+ set f [open "|[list $::tcltest::tcltest pipe]" r+]
gets $f
puts $f output
after 50
@@ -1067,7 +2509,7 @@ test io-6.27 {Tcl_Flush on closed pipeline} {stdio && tempNotPc} {
regsub {".*":} $x {"":} x
string tolower $x
} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
-test io-6.28 {Tcl_Write, lf mode} {
+test io-29.28 {Tcl_WriteChars, lf mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -1077,7 +2519,7 @@ test io-6.28 {Tcl_Write, lf mode} {
close $f
set s
} 21
-test io-6.29 {Tcl_Write, cr mode} {
+test io-29.29 {Tcl_WriteChars, cr mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr -eofchar {}
@@ -1085,7 +2527,7 @@ test io-6.29 {Tcl_Write, cr mode} {
close $f
file size test1
} 21
-test io-6.30 {Tcl_Write, crlf mode} {
+test io-29.30 {Tcl_WriteChars, crlf mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf -eofchar {}
@@ -1093,7 +2535,7 @@ test io-6.30 {Tcl_Write, crlf mode} {
close $f
file size test1
} 25
-test io-6.31 {Tcl_Write, background flush} {stdio} {
+test io-29.31 {Tcl_WriteChars, background flush} {stdio} {
removeFile pipe
removeFile output
set f [open pipe w]
@@ -1109,27 +2551,28 @@ test io-6.31 {Tcl_Write, background flush} {stdio} {
close $f
set x 01234567890123456789012345678901
for {set i 0} {$i < 11} {incr i} {
- set x "$x$x"
+ set x "$x$x"
}
set f [open output w]
close $f
- set f [open "|[list $tcltest pipe]" r+]
+ set f [open "|[list $::tcltest::tcltest pipe]" r+]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
set counter 0
while {([file size output] < 65536) && ($counter < 1000)} {
- incr counter
- after 5
- update
+ incr counter
+ after 5
+ update
}
if {$counter == 1000} {
- set result probably_broken
+ set result "file size only [file size output]"
} else {
- set result ok
+ set result ok
}
} ok
-test io-6.32 {Tcl_Write, background flush to slow reader} {stdio && asyncPipeClose} {
+test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
+ {stdio asyncPipeClose} {
removeFile pipe
removeFile output
set f [open pipe w]
@@ -1146,27 +2589,27 @@ test io-6.32 {Tcl_Write, background flush to slow reader} {stdio && asyncPipeClo
close $f
set x 01234567890123456789012345678901
for {set i 0} {$i < 11} {incr i} {
- set x "$x$x"
+ set x "$x$x"
}
set f [open output w]
close $f
- set f [open "|[list $tcltest pipe]" r+]
+ set f [open "|[list $::tcltest::tcltest pipe]" r+]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
set counter 0
while {([file size output] < 65536) && ($counter < 1000)} {
- incr counter
- after 20
- update
+ incr counter
+ after 20
+ update
}
if {$counter == 1000} {
- set result probably_broken
+ set result "file size only [file size output]"
} else {
- set result ok
+ set result ok
}
} ok
-test io-6.33 {Tcl_Flush, implicit flush on exit} {stdio} {
+test io-29.33 {Tcl_Flush, implicit flush on exit} {stdio} {
set f [open script w]
puts $f {
set f [open test1 w]
@@ -1176,17 +2619,13 @@ test io-6.33 {Tcl_Flush, implicit flush on exit} {stdio} {
puts $f strange
}
close $f
- exec $tcltest script
+ exec $::tcltest::tcltest script
set f [open test1 r]
set r [read $f]
close $f
set r
-} {hello
-bye
-strange
-}
-
-test io-6.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {
+} "hello\nbye\nstrange\n"
+test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {
set c 0
set x running
set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
@@ -1222,7 +2661,10 @@ test io-6.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac
vwait x
set c
} 2000
-test io-6.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket} {
+test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac} {
+ # On Mac, this test screws up sockets such that subsequent tests using port 2828
+ # either cause errors or panic().
+
catch {interp delete x}
catch {interp delete y}
interp create x
@@ -1263,7 +2705,7 @@ test io-6.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket} {
# Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.
-test io-7.1 {Tcl_Write lf, Tcl_Read lf} {
+test io-30.1 {Tcl_Write lf, Tcl_Read lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1275,7 +2717,7 @@ test io-7.1 {Tcl_Write lf, Tcl_Read lf} {
close $f
set x
} "hello\nthere\nand\nhere\n"
-test io-7.2 {Tcl_Write lf, Tcl_Read cr} {
+test io-30.2 {Tcl_Write lf, Tcl_Read cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1287,7 +2729,7 @@ test io-7.2 {Tcl_Write lf, Tcl_Read cr} {
close $f
set x
} "hello\nthere\nand\nhere\n"
-test io-7.3 {Tcl_Write lf, Tcl_Read crlf} {
+test io-30.3 {Tcl_Write lf, Tcl_Read crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1299,7 +2741,7 @@ test io-7.3 {Tcl_Write lf, Tcl_Read crlf} {
close $f
set x
} "hello\nthere\nand\nhere\n"
-test io-7.4 {Tcl_Write cr, Tcl_Read cr} {
+test io-30.4 {Tcl_Write cr, Tcl_Read cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1311,7 +2753,7 @@ test io-7.4 {Tcl_Write cr, Tcl_Read cr} {
close $f
set x
} "hello\nthere\nand\nhere\n"
-test io-7.5 {Tcl_Write cr, Tcl_Read lf} {
+test io-30.5 {Tcl_Write cr, Tcl_Read lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1323,7 +2765,7 @@ test io-7.5 {Tcl_Write cr, Tcl_Read lf} {
close $f
set x
} "hello\rthere\rand\rhere\r"
-test io-7.6 {Tcl_Write cr, Tcl_Read crlf} {
+test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1335,7 +2777,7 @@ test io-7.6 {Tcl_Write cr, Tcl_Read crlf} {
close $f
set x
} "hello\rthere\rand\rhere\r"
-test io-7.7 {Tcl_Write crlf, Tcl_Read crlf} {
+test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1347,7 +2789,7 @@ test io-7.7 {Tcl_Write crlf, Tcl_Read crlf} {
close $f
set x
} "hello\nthere\nand\nhere\n"
-test io-7.8 {Tcl_Write crlf, Tcl_Read lf} {
+test io-30.8 {Tcl_Write crlf, Tcl_Read lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1359,7 +2801,7 @@ test io-7.8 {Tcl_Write crlf, Tcl_Read lf} {
close $f
set x
} "hello\r\nthere\r\nand\r\nhere\r\n"
-test io-7.9 {Tcl_Write crlf, Tcl_Read cr} {
+test io-30.9 {Tcl_Write crlf, Tcl_Read cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1371,7 +2813,7 @@ test io-7.9 {Tcl_Write crlf, Tcl_Read cr} {
close $f
set x
} "hello\n\nthere\n\nand\n\nhere\n\n"
-test io-7.10 {Tcl_Write lf, Tcl_Read auto} {
+test io-30.10 {Tcl_Write lf, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1387,7 +2829,7 @@ there
and
here
} auto}
-test io-7.11 {Tcl_Write cr, Tcl_Read auto} {
+test io-30.11 {Tcl_Write cr, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1403,7 +2845,7 @@ there
and
here
} auto}
-test io-7.12 {Tcl_Write crlf, Tcl_Read auto} {
+test io-30.12 {Tcl_Write crlf, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1420,7 +2862,7 @@ and
here
} auto}
-test io-7.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
+test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1437,7 +2879,7 @@ test io-7.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
string length $c
} [expr 700*15+1]
-test io-7.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
+test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1454,7 +2896,7 @@ test io-7.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
string length $c
} [expr 700*15+1]
-test io-7.15 {Tcl_Write mixed, Tcl_Read auto} {
+test io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1470,7 +2912,7 @@ there
and
here
}
-test io-7.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
+test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1486,7 +2928,7 @@ there
and
here
}
-test io-7.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} {
+test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} {
removeFile test1
set f [open test1 w]
fconfigure $f -eofchar \x1a -translation lf
@@ -1502,7 +2944,7 @@ there
and
here
}
-test io-7.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
+test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1522,7 +2964,7 @@ test io-7.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
close $f
set l
} {abc def 0 {} 1 {} 1}
-test io-7.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
+test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1542,7 +2984,7 @@ test io-7.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
close $f
set l
} {abc def 0 {} 1 {} 1}
-test io-7.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
+test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -1564,7 +3006,7 @@ test io-7.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
close $f
set l
} "abc def 0 \x1aghi 0 qrs 0 {} 1"
-test io-7.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
+test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -1575,14 +3017,14 @@ test io-7.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
fconfigure $f -translation cr -eofchar {}
set l ""
set x [gets $f]
- lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs"]
+ lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
close $f
set l
} {0 1 {} 1}
-test io-7.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
+test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -1593,14 +3035,14 @@ test io-7.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
fconfigure $f -translation crlf -eofchar {}
set l ""
set x [gets $f]
- lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs"]
+ lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
lappend l [eof $f]
lappend l [gets $f]
lappend l [eof $f]
close $f
set l
} {0 1 {} 1}
-test io-7.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
+test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1614,7 +3056,7 @@ test io-7.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
close $f
list $c $e
} {8 1}
-test io-7.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
+test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1628,7 +3070,7 @@ test io-7.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
close $f
list $c $e
} {8 1}
-test io-7.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
+test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1642,7 +3084,7 @@ test io-7.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
close $f
list $c $e
} {8 1}
-test io-7.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
+test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1656,7 +3098,7 @@ test io-7.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
close $f
list $c $e
} {8 1}
-test io-7.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
+test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1670,7 +3112,7 @@ test io-7.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
close $f
list $c $e
} {8 1}
-test io-7.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
+test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1687,7 +3129,7 @@ test io-7.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
# Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets.
-test io-8.1 {Tcl_Write lf, Tcl_Gets auto} {
+test io-31.1 {Tcl_Write lf, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1704,7 +3146,7 @@ test io-8.1 {Tcl_Write lf, Tcl_Gets auto} {
close $f
set l
} {hello 6 auto there 12 auto}
-test io-8.2 {Tcl_Write cr, Tcl_Gets auto} {
+test io-31.2 {Tcl_Write cr, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1721,7 +3163,7 @@ test io-8.2 {Tcl_Write cr, Tcl_Gets auto} {
close $f
set l
} {hello 6 auto there 12 auto}
-test io-8.3 {Tcl_Write crlf, Tcl_Gets auto} {
+test io-31.3 {Tcl_Write crlf, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1738,7 +3180,7 @@ test io-8.3 {Tcl_Write crlf, Tcl_Gets auto} {
close $f
set l
} {hello 7 auto there 14 auto}
-test io-8.4 {Tcl_Write lf, Tcl_Gets lf} {
+test io-31.4 {Tcl_Write lf, Tcl_Gets lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1756,7 +3198,7 @@ test io-8.4 {Tcl_Write lf, Tcl_Gets lf} {
close $f
set l
} {hello 6 lf there 12 lf}
-test io-8.5 {Tcl_Write lf, Tcl_Gets cr} {
+test io-31.5 {Tcl_Write lf, Tcl_Gets cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1775,8 +3217,8 @@ test io-8.5 {Tcl_Write lf, Tcl_Gets cr} {
lappend l [eof $f]
close $f
set l
-} {20 21 cr 1 {} 21 cr 1}
-test io-8.6 {Tcl_Write lf, Tcl_Gets crlf} {
+} {21 21 cr 1 {} 21 cr 1}
+test io-31.6 {Tcl_Write lf, Tcl_Gets crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1795,8 +3237,8 @@ test io-8.6 {Tcl_Write lf, Tcl_Gets crlf} {
lappend l [eof $f]
close $f
set l
-} {20 21 crlf 1 {} 21 crlf 1}
-test io-8.7 {Tcl_Write cr, Tcl_Gets cr} {
+} {21 21 crlf 1 {} 21 crlf 1}
+test io-31.7 {Tcl_Write cr, Tcl_Gets cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1816,7 +3258,7 @@ test io-8.7 {Tcl_Write cr, Tcl_Gets cr} {
close $f
set l
} {hello 6 cr 0 there 12 cr 0}
-test io-8.8 {Tcl_Write cr, Tcl_Gets lf} {
+test io-31.8 {Tcl_Write cr, Tcl_Gets lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1836,7 +3278,7 @@ test io-8.8 {Tcl_Write cr, Tcl_Gets lf} {
close $f
set l
} {21 21 lf 1 {} 21 lf 1}
-test io-8.9 {Tcl_Write cr, Tcl_Gets crlf} {
+test io-31.9 {Tcl_Write cr, Tcl_Gets crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -1856,7 +3298,7 @@ test io-8.9 {Tcl_Write cr, Tcl_Gets crlf} {
close $f
set l
} {21 21 crlf 1 {} 21 crlf 1}
-test io-8.10 {Tcl_Write crlf, Tcl_Gets crlf} {
+test io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1876,7 +3318,7 @@ test io-8.10 {Tcl_Write crlf, Tcl_Gets crlf} {
close $f
set l
} {hello 7 crlf 0 there 14 crlf 0}
-test io-8.11 {Tcl_Write crlf, Tcl_Gets cr} {
+test io-31.11 {Tcl_Write crlf, Tcl_Gets cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1896,7 +3338,7 @@ test io-8.11 {Tcl_Write crlf, Tcl_Gets cr} {
close $f
set l
} {hello 6 cr 0 6 13 cr 0}
-test io-8.12 {Tcl_Write crlf, Tcl_Gets lf} {
+test io-31.12 {Tcl_Write crlf, Tcl_Gets lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -1916,7 +3358,7 @@ test io-8.12 {Tcl_Write crlf, Tcl_Gets lf} {
close $f
set l
} {6 7 lf 0 6 14 lf 0}
-test io-8.13 {binary mode is synonym of lf mode} {
+test io-31.13 {binary mode is synonym of lf mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation binary
@@ -1928,7 +3370,7 @@ test io-8.13 {binary mode is synonym of lf mode} {
# Test io-9.14 has been removed because "auto" output translation mode is
# not supoprted.
#
-test io-8.14 {Tcl_Write mixed, Tcl_Gets auto} {
+test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1947,7 +3389,7 @@ test io-8.14 {Tcl_Write mixed, Tcl_Gets auto} {
close $f
set l
} {hello there and here 0 {} 1}
-test io-8.15 {Tcl_Write mixed, Tcl_Gets auto} {
+test io-31.15 {Tcl_Write mixed, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1966,7 +3408,7 @@ test io-8.15 {Tcl_Write mixed, Tcl_Gets auto} {
close $f
set l
} {hello there and here 0 {} 1}
-test io-8.16 {Tcl_Write mixed, Tcl_Gets auto} {
+test io-31.16 {Tcl_Write mixed, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -1984,7 +3426,7 @@ test io-8.16 {Tcl_Write mixed, Tcl_Gets auto} {
close $f
set l
} {hello there and here 0 {} 1}
-test io-8.17 {Tcl_Write mixed, Tcl_Gets auto} {
+test io-31.17 {Tcl_Write mixed, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -2003,7 +3445,7 @@ test io-8.17 {Tcl_Write mixed, Tcl_Gets auto} {
close $f
set l
} {hello there and here 0 {} 1}
-test io-8.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
+test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -2023,7 +3465,7 @@ test io-8.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
close $f
set l
} {hello there and here 0 {} 1}
-test io-8.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
+test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -eofchar \x1a -translation lf
@@ -2042,7 +3484,7 @@ test io-8.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
close $f
set l
} {hello there and here 0 {} 1}
-test io-8.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
+test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -2061,7 +3503,7 @@ test io-8.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
close $f
set l
} {abc def 0 {} 1}
-test io-8.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
+test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -2079,7 +3521,7 @@ test io-8.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
close $f
set l
} {abc def 0 {} 1}
-test io-8.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
+test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -2101,7 +3543,7 @@ test io-8.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
close $f
set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test io-8.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
+test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr -eofchar {}
@@ -2123,7 +3565,7 @@ test io-8.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
close $f
set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test io-8.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
+test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf -eofchar {}
@@ -2145,7 +3587,7 @@ test io-8.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
close $f
set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
-test io-8.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
+test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -2163,7 +3605,7 @@ test io-8.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
close $f
set l
} {abc def 0 {} 1}
-test io-8.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
+test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -2181,7 +3623,7 @@ test io-8.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
close $f
set l
} {abc def 0 {} 1}
-test io-8.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
+test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr -eofchar {}
@@ -2199,7 +3641,7 @@ test io-8.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
close $f
set l
} {abc def 0 {} 1}
-test io-8.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
+test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr -eofchar {}
@@ -2217,7 +3659,7 @@ test io-8.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
close $f
set l
} {abc def 0 {} 1}
-test io-8.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
+test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf -eofchar {}
@@ -2235,7 +3677,7 @@ test io-8.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
close $f
set l
} {abc def 0 {} 1}
-test io-8.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
+test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf -eofchar {}
@@ -2253,7 +3695,7 @@ test io-8.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
close $f
set l
} {abc def 0 {} 1}
-test io-8.31 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
+test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -2264,7 +3706,7 @@ test io-8.31 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
}
close $f
set f [open test1 r]
- fconfigure $f -translation auto
+ fconfigure $f -translation crlf
set c ""
while {[gets $f line] >= 0} {
append c $line\n
@@ -2272,13 +3714,13 @@ test io-8.31 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
close $f
string length $c
} [expr 700*15+1]
-test io-8.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
+test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
puts -nonewline $f x ;# shift crlf across block boundary
- for {set i 0} {$i < 256} {incr i} {
+ for {set i 0} {$i < 700} {incr i} {
puts $f $line
}
close $f
@@ -2290,24 +3732,24 @@ test io-8.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
}
close $f
string length $c
-} [expr 256*15+1]
+} [expr 700*15+1]
# Test Tcl_Read and buffering.
-test io-9.1 {Tcl_Read, channel not readable} {
+test io-32.1 {Tcl_Read, channel not readable} {
list [catch {read stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
-test io-9.2 {Tcl_Read, zero byte count} {
+test io-32.2 {Tcl_Read, zero byte count} {
read stdin 0
} ""
-test io-9.3 {Tcl_Read, negative byte count} {
+test io-32.3 {Tcl_Read, negative byte count} {
set f [open longfile r]
set l [list [catch {read $f -1} msg] $msg]
close $f
set l
} {1 {bad argument "-1": should be "nonewline"}}
-test io-9.4 {Tcl_Read, positive byte count} {
+test io-32.4 {Tcl_Read, positive byte count} {
set f [open longfile r]
set x [read $f 1024]
set s [string length $x]
@@ -2315,7 +3757,7 @@ test io-9.4 {Tcl_Read, positive byte count} {
close $f
set s
} 1024
-test io-9.5 {Tcl_Read, multiple buffers} {
+test io-32.5 {Tcl_Read, multiple buffers} {
set f [open longfile r]
fconfigure $f -buffersize 100
set x [read $f 1024]
@@ -2324,7 +3766,7 @@ test io-9.5 {Tcl_Read, multiple buffers} {
close $f
set s
} 1024
-test io-9.6 {Tcl_Read, very large read} {
+test io-32.6 {Tcl_Read, very large read} {
set f1 [open longfile r]
set z [read $f1 1000000]
close $f1
@@ -2332,11 +3774,11 @@ test io-9.6 {Tcl_Read, very large read} {
set x ok
set z [file size longfile]
if {$z != $l} {
- set x broken
+ set x broken
}
set x
} ok
-test io-9.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+test io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
set f1 [open longfile r]
fconfigure $f1 -blocking off
set z [read $f1 20]
@@ -2344,11 +3786,11 @@ test io-9.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
set l [string length $z]
set x ok
if {$l != 20} {
- set x broken
+ set x broken
}
set x
} ok
-test io-9.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+test io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
set f1 [open longfile r]
fconfigure $f1 -blocking off
set z [read $f1 1000000]
@@ -2357,11 +3799,11 @@ test io-9.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
set l [string length $z]]
set z [file size longfile]]
if {$z != $l} {
- set x broken
+ set x broken
}
set x
} ok
-test io-9.9 {Tcl_Read, read to end of file} {
+test io-32.9 {Tcl_Read, read to end of file} {
set f1 [open longfile r]
set z [read $f1]
close $f1
@@ -2369,29 +3811,29 @@ test io-9.9 {Tcl_Read, read to end of file} {
set x ok
set z [file size longfile]
if {$z != $l} {
- set x broken
+ set x broken
}
set x
} ok
-test io-9.10 {Tcl_Read from a pipe} {stdio} {
+test io-32.10 {Tcl_Read from a pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
puts $f1 hello
flush $f1
set x [read $f1]
close $f1
set x
} "hello\n"
-test io-9.11 {Tcl_Read from a pipe} {stdio} {
+test io-32.11 {Tcl_Read from a pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {puts [gets stdin]}
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
puts $f1 hello
flush $f1
set x ""
@@ -2404,7 +3846,7 @@ test io-9.11 {Tcl_Read from a pipe} {stdio} {
} {{hello
} {hello
}}
-test io-9.12 {Tcl_Read, -nonewline} {
+test io-32.12 {Tcl_Read, -nonewline} {
removeFile test1
set f1 [open test1 w]
puts $f1 hello
@@ -2416,7 +3858,7 @@ test io-9.12 {Tcl_Read, -nonewline} {
set c
} {hello
bye}
-test io-9.13 {Tcl_Read, -nonewline} {
+test io-32.13 {Tcl_Read, -nonewline} {
removeFile test1
set f1 [open test1 w]
puts $f1 hello
@@ -2428,7 +3870,7 @@ test io-9.13 {Tcl_Read, -nonewline} {
list [string length $c] $c
} {9 {hello
bye}}
-test io-9.14 {Tcl_Read, reading in small chunks} {
+test io-32.14 {Tcl_Read, reading in small chunks} {
removeFile test1
set f [open test1 w]
puts $f "Two lines: this one"
@@ -2441,7 +3883,7 @@ test io-9.14 {Tcl_Read, reading in small chunks} {
} {T wo { lines: this one
and this one
}}
-test io-9.15 {Tcl_Read, asking for more input than available} {
+test io-32.15 {Tcl_Read, asking for more input than available} {
removeFile test1
set f [open test1 w]
puts $f "Two lines: this one"
@@ -2454,7 +3896,7 @@ test io-9.15 {Tcl_Read, asking for more input than available} {
} {Two lines: this one
and this one
}
-test io-9.16 {Tcl_Read, read to end of file with -nonewline} {
+test io-32.16 {Tcl_Read, read to end of file with -nonewline} {
removeFile test1
set f [open test1 w]
puts $f "Two lines: this one"
@@ -2469,7 +3911,7 @@ and this one}
# Test Tcl_Gets.
-test io-10.1 {Tcl_Gets, reading what was written} {
+test io-33.1 {Tcl_Gets, reading what was written} {
removeFile test1
set f1 [open test1 w]
set y "first line"
@@ -2479,39 +3921,39 @@ test io-10.1 {Tcl_Gets, reading what was written} {
set x [gets $f1]
set z ok
if {"$x" != "$y"} {
- set z broken
+ set z broken
}
close $f1
set z
} ok
-test io-10.2 {Tcl_Gets into variable} {
+test io-33.2 {Tcl_Gets into variable} {
set f1 [open longfile r]
set c [gets $f1 x]
set l [string length x]
set z ok
if {$l != $l} {
- set z broken
+ set z broken
}
close $f1
set z
} ok
-test io-10.3 {Tcl_Gets from pipe} {stdio} {
+test io-33.3 {Tcl_Gets from pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
puts $f1 hello
flush $f1
set x [gets $f1]
close $f1
set z ok
if {"$x" != "hello"} {
- set z broken
+ set z broken
}
set z
} ok
-test io-10.4 {Tcl_Gets with long line} {
+test io-33.4 {Tcl_Gets with long line} {
removeFile test3
set f [open test3 w]
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
@@ -2525,13 +3967,13 @@ test io-10.4 {Tcl_Gets with long line} {
close $f
set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
-test io-10.5 {Tcl_Gets with long line} {
+test io-33.5 {Tcl_Gets with long line} {
set f [open test3]
set x [gets $f y]
close $f
list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
-test io-10.6 {Tcl_Gets and end of file} {
+test io-33.6 {Tcl_Gets and end of file} {
removeFile test3
set f [open test3 w]
puts -nonewline $f "Test1\nTest2"
@@ -2547,7 +3989,7 @@ test io-10.6 {Tcl_Gets and end of file} {
close $f
set x
} {5 Test1 5 Test2 -1 {}}
-test io-10.7 {Tcl_Gets and bad variable} {
+test io-33.7 {Tcl_Gets and bad variable} {
set f [open test3 w]
puts $f "Line 1"
puts $f "Line 2"
@@ -2559,7 +4001,7 @@ test io-10.7 {Tcl_Gets and bad variable} {
close $f
set result
} {1 {can't set "x(0)": variable isn't array}}
-test io-10.8 {Tcl_Gets, exercising double buffering} {
+test io-33.8 {Tcl_Gets, exercising double buffering} {
set f [open test3 w]
fconfigure $f -translation lf -eofchar {}
set x ""
@@ -2572,7 +4014,7 @@ test io-10.8 {Tcl_Gets, exercising double buffering} {
close $f
set y
} 100
-test io-10.9 {Tcl_Gets, exercising double buffering} {
+test io-33.9 {Tcl_Gets, exercising double buffering} {
set f [open test3 w]
fconfigure $f -translation lf -eofchar {}
set x ""
@@ -2585,7 +4027,7 @@ test io-10.9 {Tcl_Gets, exercising double buffering} {
close $f
set y
} 200
-test io-10.10 {Tcl_Gets, exercising double buffering} {
+test io-33.10 {Tcl_Gets, exercising double buffering} {
set f [open test3 w]
fconfigure $f -translation lf -eofchar {}
set x ""
@@ -2601,14 +4043,14 @@ test io-10.10 {Tcl_Gets, exercising double buffering} {
# Test Tcl_Seek and Tcl_Tell.
-test io-11.1 {Tcl_Seek to current position at start of file} {
+test io-34.1 {Tcl_Seek to current position at start of file} {
set f1 [open longfile r]
seek $f1 0 current
set c [tell $f1]
close $f1
set c
} 0
-test io-11.2 {Tcl_Seek to offset from start} {
+test io-34.2 {Tcl_Seek to offset from start} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -2621,7 +4063,7 @@ test io-11.2 {Tcl_Seek to offset from start} {
close $f1
set c
} 10
-test io-11.3 {Tcl_Seek to end of file} {
+test io-34.3 {Tcl_Seek to end of file} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -2634,7 +4076,7 @@ test io-11.3 {Tcl_Seek to end of file} {
close $f1
set c
} 54
-test io-11.4 {Tcl_Seek to offset from end of file} {
+test io-34.4 {Tcl_Seek to offset from end of file} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -2647,7 +4089,7 @@ test io-11.4 {Tcl_Seek to offset from end of file} {
close $f1
set c
} 44
-test io-11.5 {Tcl_Seek to offset from current position} {
+test io-34.5 {Tcl_Seek to offset from current position} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -2661,7 +4103,7 @@ test io-11.5 {Tcl_Seek to offset from current position} {
close $f1
set c
} 20
-test io-11.6 {Tcl_Seek to offset from end of file} {
+test io-34.6 {Tcl_Seek to offset from end of file} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -2676,7 +4118,7 @@ test io-11.6 {Tcl_Seek to offset from end of file} {
list $c $r
} {44 {rstuvwxyz
}}
-test io-11.7 {Tcl_Seek to offset from end of file, then to current position} {
+test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -2692,14 +4134,14 @@ test io-11.7 {Tcl_Seek to offset from end of file, then to current position} {
close $f1
list $c1 $r1 $c2
} {44 rstuv 49}
-test io-11.8 {Tcl_Seek on pipes: not supported} {stdio} {
- set f1 [open "|[list $tcltest]" r+]
+test io-34.8 {Tcl_Seek on pipes: not supported} {stdio} {
+ set f1 [open "|[list $::tcltest::tcltest]" r+]
set x [list [catch {seek $f1 0 current} msg] $msg]
close $f1
regsub {".*":} $x {"":} x
string tolower $x
} {1 {error during seek on "": invalid argument}}
-test io-11.9 {Tcl_Seek, testing buffered input flushing} {
+test io-34.9 {Tcl_Seek, testing buffered input flushing} {
removeFile test3
set f [open test3 w]
fconfigure $f -eofchar {}
@@ -2722,7 +4164,7 @@ test io-11.9 {Tcl_Seek, testing buffered input flushing} {
close $f
set x
} {a d a l Y {} b}
-test io-11.10 {Tcl_Seek testing flushing of buffered input} {
+test io-34.10 {Tcl_Seek testing flushing of buffered input} {
set f [open test3 w]
fconfigure $f -translation lf
puts $f xyz\n123
@@ -2736,7 +4178,7 @@ test io-11.10 {Tcl_Seek testing flushing of buffered input} {
list $x [viewFile test3]
} "xyz {xyz
456}"
-test io-11.11 {Tcl_Seek testing flushing of buffered output} {
+test io-34.11 {Tcl_Seek testing flushing of buffered output} {
set f [open test3 w]
puts $f xyz\n123
close $f
@@ -2747,7 +4189,7 @@ test io-11.11 {Tcl_Seek testing flushing of buffered output} {
close $f
list $x [viewFile test3]
} "zzy xyzzy"
-test io-11.12 {Tcl_Seek testing combination of write, seek back and read} {
+test io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
set f [open test3 w]
fconfigure $f -translation lf -eofchar {}
puts $f xyz\n123
@@ -2764,14 +4206,14 @@ test io-11.12 {Tcl_Seek testing combination of write, seek back and read} {
} {14 {xyz
123
xyzzy} zzy}
-test io-11.13 {Tcl_Tell at start of file} {
+test io-34.13 {Tcl_Tell at start of file} {
removeFile test1
set f1 [open test1 w]
set p [tell $f1]
close $f1
set p
} 0
-test io-11.14 {Tcl_Tell after seek to end of file} {
+test io-34.14 {Tcl_Tell after seek to end of file} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -2784,7 +4226,7 @@ test io-11.14 {Tcl_Tell after seek to end of file} {
close $f1
set c1
} 54
-test io-11.15 {Tcl_Tell combined with seeking} {
+test io-34.15 {Tcl_Tell combined with seeking} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -eofchar {}
@@ -2799,14 +4241,14 @@ test io-11.15 {Tcl_Tell combined with seeking} {
close $f1
list $c1 $c2
} {10 20}
-test io-11.16 {Tcl_tell on pipe: always -1} {stdio} {
- set f1 [open "|[list $tcltest]" r+]
+test io-34.16 {Tcl_tell on pipe: always -1} {stdio} {
+ set f1 [open "|[list $::tcltest::tcltest]" r+]
set c [tell $f1]
close $f1
set c
} -1
-test io-11.17 {Tcl_Tell on pipe: always -1} {stdio} {
- set f1 [open "|[list $tcltest]" r+]
+test io-34.17 {Tcl_Tell on pipe: always -1} {stdio} {
+ set f1 [open "|[list $::tcltest::tcltest]" r+]
puts $f1 {puts hello}
flush $f1
set c [tell $f1]
@@ -2814,7 +4256,7 @@ test io-11.17 {Tcl_Tell on pipe: always -1} {stdio} {
close $f1
set c
} -1
-test io-11.18 {Tcl_Tell combined with seeking and reading} {
+test io-34.18 {Tcl_Tell combined with seeking and reading} {
removeFile test2
set f [open test2 w]
fconfigure $f -translation lf -eofchar {}
@@ -2834,7 +4276,7 @@ test io-11.18 {Tcl_Tell combined with seeking and reading} {
close $f
set x
} {0 3 2 12 30}
-test io-11.19 {Tcl_Tell combined with opening in append mode} {
+test io-34.19 {Tcl_Tell combined with opening in append mode} {
set f [open test3 w]
fconfigure $f -translation lf -eofchar {}
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -2845,7 +4287,7 @@ test io-11.19 {Tcl_Tell combined with opening in append mode} {
close $f
set c
} 54
-test io-11.20 {Tcl_Tell combined with writing} {
+test io-34.20 {Tcl_Tell combined with writing} {
set f [open test3 w]
set l ""
seek $f 29 start
@@ -2863,7 +4305,7 @@ test io-11.20 {Tcl_Tell combined with writing} {
# Test Tcl_Eof
-test io-12.1 {Tcl_Eof} {
+test io-35.1 {Tcl_Eof} {
removeFile test1
set f [open test1 w]
puts $f hello
@@ -2882,13 +4324,13 @@ test io-12.1 {Tcl_Eof} {
close $f
set x
} {0 0 0 0 1 1}
-test io-12.2 {Tcl_Eof with pipe} {stdio} {
+test io-35.2 {Tcl_Eof with pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {gets stdin}
puts $f1 {puts hello}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
puts $f1 hello
set x [eof $f1]
flush $f1
@@ -2900,13 +4342,13 @@ test io-12.2 {Tcl_Eof with pipe} {stdio} {
close $f1
set x
} {0 0 0 1}
-test io-12.3 {Tcl_Eof with pipe} {stdio} {
+test io-35.3 {Tcl_Eof with pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {gets stdin}
puts $f1 {puts hello}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
puts $f1 hello
set x [eof $f1]
flush $f1
@@ -2922,7 +4364,7 @@ test io-12.3 {Tcl_Eof with pipe} {stdio} {
close $f1
set x
} {0 0 0 1 1 1}
-test io-12.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
+test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
removeFile test1
set f [open test1 w]
close $f
@@ -2934,21 +4376,21 @@ test io-12.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
close $f
set l
} {{} 1}
-test io-12.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} {
+test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} {
removeFile pipe
set f [open pipe w]
puts $f {
exit
}
close $f
- set f [open "|[list $tcltest pipe]" r]
+ set f [open "|[list $::tcltest::tcltest pipe]" r]
set l ""
lappend l [gets $f]
lappend l [eof $f]
close $f
set l
} {{} 1}
-test io-12.6 {Tcl_Eof, eof char, lf write, auto read} {
+test io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar \x1a
@@ -2962,7 +4404,7 @@ test io-12.6 {Tcl_Eof, eof char, lf write, auto read} {
close $f
list $s $l $e
} {9 8 1}
-test io-12.7 {Tcl_Eof, eof char, lf write, lf read} {
+test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar \x1a
@@ -2976,7 +4418,7 @@ test io-12.7 {Tcl_Eof, eof char, lf write, lf read} {
close $f
list $s $l $e
} {9 8 1}
-test io-12.8 {Tcl_Eof, eof char, cr write, auto read} {
+test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr -eofchar \x1a
@@ -2990,7 +4432,7 @@ test io-12.8 {Tcl_Eof, eof char, cr write, auto read} {
close $f
list $s $l $e
} {9 8 1}
-test io-12.9 {Tcl_Eof, eof char, cr write, cr read} {
+test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr -eofchar \x1a
@@ -3004,7 +4446,7 @@ test io-12.9 {Tcl_Eof, eof char, cr write, cr read} {
close $f
list $s $l $e
} {9 8 1}
-test io-12.10 {Tcl_Eof, eof char, crlf write, auto read} {
+test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf -eofchar \x1a
@@ -3018,7 +4460,7 @@ test io-12.10 {Tcl_Eof, eof char, crlf write, auto read} {
close $f
list $s $l $e
} {11 8 1}
-test io-12.11 {Tcl_Eof, eof char, crlf write, crlf read} {
+test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf -eofchar \x1a
@@ -3032,7 +4474,7 @@ test io-12.11 {Tcl_Eof, eof char, crlf write, crlf read} {
close $f
list $s $l $e
} {11 8 1}
-test io-12.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
+test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -3047,7 +4489,7 @@ test io-12.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
close $f
list $c $l $e
} {17 8 1}
-test io-12.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
+test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf -eofchar {}
@@ -3062,7 +4504,7 @@ test io-12.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
close $f
list $c $l $e
} {17 8 1}
-test io-12.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
+test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr -eofchar {}
@@ -3077,7 +4519,7 @@ test io-12.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
close $f
list $c $l $e
} {17 8 1}
-test io-12.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
+test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr -eofchar {}
@@ -3092,7 +4534,7 @@ test io-12.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
close $f
list $c $l $e
} {17 8 1}
-test io-12.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
+test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf -eofchar {}
@@ -3107,7 +4549,7 @@ test io-12.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
close $f
list $c $l $e
} {21 8 1}
-test io-12.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
+test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf -eofchar {}
@@ -3125,8 +4567,8 @@ test io-12.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
# Test Tcl_InputBlocked
-test io-13.1 {Tcl_InputBlocked on nonblocking pipe} {unixOrPc tempNotPc} {
- set f1 [open "|[list $tcltest]" r+]
+test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} {
+ set f1 [open "|[list $::tcltest::tcltest]" r+]
puts $f1 {puts hello_from_pipe}
flush $f1
gets $f1
@@ -3144,8 +4586,8 @@ test io-13.1 {Tcl_InputBlocked on nonblocking pipe} {unixOrPc tempNotPc} {
close $f1
set x
} {{} 1 hello 0 {} 1}
-test io-13.2 {Tcl_InputBlocked on blocking pipe} {unixOrPc tempNotPc} {
- set f1 [open "|[list $tcltest]" r+]
+test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio} {
+ set f1 [open "|[list $::tcltest::tcltest]" r+]
fconfigure $f1 -buffering line
puts $f1 {puts hello_from_pipe}
set x ""
@@ -3158,7 +4600,7 @@ test io-13.2 {Tcl_InputBlocked on blocking pipe} {unixOrPc tempNotPc} {
close $f1
set x
} {hello_from_pipe 0 {} 0 1}
-test io-13.3 {Tcl_InputBlocked vs files, short read} {
+test io-36.3 {Tcl_InputBlocked vs files, short read} {
removeFile test1
set f [open test1 w]
puts $f abcdefghijklmnop
@@ -3174,7 +4616,7 @@ test io-13.3 {Tcl_InputBlocked vs files, short read} {
close $f
set l
} {0 abc 0 defghijklmnop 0 1}
-test io-13.4 {Tcl_InputBlocked vs files, event driven read} {
+test io-36.4 {Tcl_InputBlocked vs files, event driven read} {
proc in {f} {
global l x
lappend l [read $f 3]
@@ -3191,7 +4633,7 @@ test io-13.4 {Tcl_InputBlocked vs files, event driven read} {
set l
} {abc def ghi jkl mno {p
} eof}
-test io-13.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
+test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
removeFile test1
set f [open test1 w]
puts $f abcdefghijklmnop
@@ -3208,7 +4650,7 @@ test io-13.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles
close $f
set l
} {0 abc 0 defghijklmnop 0 1}
-test io-13.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
+test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
proc in {f} {
global l x
lappend l [read $f 3]
@@ -3229,7 +4671,7 @@ test io-13.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
# Test Tcl_InputBuffered
-test io-14.1 {Tcl_InputBuffered} {
+test io-37.1 {Tcl_InputBuffered} {
set f [open longfile r]
fconfigure $f -buffersize 4096
read $f 3
@@ -3239,7 +4681,7 @@ test io-14.1 {Tcl_InputBuffered} {
close $f
set l
} {4093 3}
-test io-14.2 {Tcl_InputBuffered, test input flushing on seek} {
+test io-37.2 {Tcl_InputBuffered, test input flushing on seek} {
set f [open longfile r]
fconfigure $f -buffersize 4096
read $f 3
@@ -3255,13 +4697,13 @@ test io-14.2 {Tcl_InputBuffered, test input flushing on seek} {
# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
-test io-15.1 {Tcl_GetChannelBufferSize, default buffer size} {
+test io-38.1 {Tcl_GetChannelBufferSize, default buffer size} {
set f [open longfile r]
set s [fconfigure $f -buffersize]
close $f
set s
} 4096
-test io-15.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
+test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
set f [open longfile r]
set l ""
lappend l [fconfigure $f -buffersize]
@@ -3283,7 +4725,7 @@ test io-15.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
# Test Tcl_SetChannelOption, Tcl_GetChannelOption
-test io-16.1 {Tcl_GetChannelOption} {
+test io-39.1 {Tcl_GetChannelOption} {
removeFile test1
set f1 [open test1 w]
set x [fconfigure $f1 -blocking]
@@ -3293,14 +4735,14 @@ test io-16.1 {Tcl_GetChannelOption} {
#
# Test 17.2 was removed.
#
-test io-16.2 {Tcl_GetChannelOption} {
+test io-39.2 {Tcl_GetChannelOption} {
removeFile test1
set f1 [open test1 w]
set x [fconfigure $f1 -buffering]
close $f1
set x
} full
-test io-16.3 {Tcl_GetChannelOption} {
+test io-39.3 {Tcl_GetChannelOption} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -buffering line
@@ -3308,7 +4750,7 @@ test io-16.3 {Tcl_GetChannelOption} {
close $f1
set x
} line
-test io-16.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
+test io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
removeFile test1
set f1 [open test1 w]
set l ""
@@ -3324,7 +4766,7 @@ test io-16.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
close $f1
set l
} {full line none line full}
-test io-16.5 {Tcl_GetChannelOption, invariance} {
+test io-39.5 {Tcl_GetChannelOption, invariance} {
removeFile test1
set f1 [open test1 w]
set l ""
@@ -3334,7 +4776,7 @@ test io-16.5 {Tcl_GetChannelOption, invariance} {
close $f1
set l
} {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
-test io-16.6 {Tcl_SetChannelOption, multiple options} {
+test io-39.6 {Tcl_SetChannelOption, multiple options} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -buffering line
@@ -3344,7 +4786,7 @@ test io-16.6 {Tcl_SetChannelOption, multiple options} {
close $f1
set x
} 10
-test io-16.7 {Tcl_SetChannelOption, buffering, translation} {
+test io-39.7 {Tcl_SetChannelOption, buffering, translation} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf
@@ -3358,7 +4800,7 @@ test io-16.7 {Tcl_SetChannelOption, buffering, translation} {
close $f1
set x
} {0 21}
-test io-16.8 {Tcl_SetChannelOption, different buffering options} {
+test io-39.8 {Tcl_SetChannelOption, different buffering options} {
removeFile test1
set f1 [open test1 w]
set l ""
@@ -3378,7 +4820,7 @@ test io-16.8 {Tcl_SetChannelOption, different buffering options} {
lappend l [file size test1]
set l
} {5 10 10 10 20 20}
-test io-16.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
+test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
removeFile test1
set f1 [open test1 w]
close $f1
@@ -3394,24 +4836,30 @@ test io-16.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
close $f1
set x
} {1 0 {} {} 0 1}
-test io-16.10 {Tcl_SetChannelOption, blocking mode} {unixOrPc tempNotPc} {
+test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio} {
removeFile pipe
set f1 [open pipe w]
- puts $f1 {gets stdin}
- puts $f1 {after 100}
- puts $f1 {puts hi}
- puts $f1 {gets stdin}
+ puts $f1 {
+ gets stdin
+ after 100
+ puts hi
+ gets stdin
+ }
close $f1
set x ""
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
fconfigure $f1 -blocking off -buffering line
lappend x [fconfigure $f1 -blocking]
lappend x [gets $f1]
lappend x [fblocked $f1]
+ fconfigure $f1 -blocking on
puts $f1 hello
+ fconfigure $f1 -blocking off
lappend x [gets $f1]
lappend x [fblocked $f1]
+ fconfigure $f1 -blocking on
puts $f1 bye
+ fconfigure $f1 -blocking off
lappend x [gets $f1]
lappend x [fblocked $f1]
fconfigure $f1 -blocking on
@@ -3424,7 +4872,7 @@ test io-16.10 {Tcl_SetChannelOption, blocking mode} {unixOrPc tempNotPc} {
close $f1
set x
} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
-test io-16.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
removeFile test1
set f [open test1 w]
fconfigure $f -buffersize -10
@@ -3432,7 +4880,7 @@ test io-16.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
close $f
set x
} 4096
-test io-16.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
+test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
removeFile test1
set f [open test1 w]
fconfigure $f -buffersize 10000000
@@ -3440,7 +4888,7 @@ test io-16.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
close $f
set x
} 4096
-test io-16.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
removeFile test1
set f [open test1 w]
fconfigure $f -buffersize 40000
@@ -3448,12 +4896,66 @@ test io-16.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
close $f
set x
} 40000
-test io-16.14 {Tcl_SetChannelOption, setting read mode independently} \
+test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
+ removeFile test1
+ set f [open test1 w]
+ fconfigure $f -encoding {}
+ puts -nonewline $f \xe7\x89\xa6
+ close $f
+ set f [open test1 r]
+ fconfigure $f -encoding utf-8
+ set x [read $f]
+ close $f
+ set x
+} \u7266
+test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
+ removeFile test1
+ set f [open test1 w]
+ fconfigure $f -encoding binary
+ puts -nonewline $f \xe7\x89\xa6
+ close $f
+ set f [open test1 r]
+ fconfigure $f -encoding utf-8
+ set x [read $f]
+ close $f
+ set x
+} \u7266
+test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
+ removeFile test1
+ set f [open test1 w]
+ set result [list [catch {fconfigure $f -encoding foobar} msg] $msg]
+ close $f
+ set result
+} {1 {unknown encoding "foobar"}}
+test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio} {
+ set f [open "|[list $::tcltest::tcltest cat]" r+]
+ fconfigure $f -encoding binary
+ puts -nonewline $f "\xe7"
+ flush $f
+ fconfigure $f -encoding utf-8 -blocking 0
+ set x {}
+ fileevent $f readable { lappend x [read $f] }
+ vwait x
+ after 300 { lappend x timeout }
+ vwait x
+ fconfigure $f -encoding utf-8
+ vwait x
+ after 300 { lappend x timeout }
+ vwait x
+ fconfigure $f -encoding binary
+ vwait x
+ after 300 { lappend x timeout }
+ vwait x
+ close $f
+ set x
+} "{} timeout {} timeout \xe7 timeout"
+
+test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
set s1 [socket -server accept 0]
set port [lindex [fconfigure $s1 -sockname] 2]
- set s2 [socket localhost $port]
+ set s2 [socket 127.0.0.1 $port]
update
fconfigure $s2 -translation {auto lf}
set modes [fconfigure $s2 -translation]
@@ -3461,12 +4963,12 @@ test io-16.14 {Tcl_SetChannelOption, setting read mode independently} \
close $s2
set modes
} {auto lf}
-test io-16.15 {Tcl_SetChannelOption, setting read mode independently} \
+test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
set s1 [socket -server accept 0]
set port [lindex [fconfigure $s1 -sockname] 2]
- set s2 [socket localhost $port]
+ set s2 [socket 127.0.0.1 $port]
update
fconfigure $s2 -translation {auto crlf}
set modes [fconfigure $s2 -translation]
@@ -3474,12 +4976,12 @@ test io-16.15 {Tcl_SetChannelOption, setting read mode independently} \
close $s2
set modes
} {auto crlf}
-test io-16.16 {Tcl_SetChannelOption, setting read mode independently} \
+test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
set s1 [socket -server accept 0]
set port [lindex [fconfigure $s1 -sockname] 2]
- set s2 [socket localhost $port]
+ set s2 [socket 127.0.0.1 $port]
update
fconfigure $s2 -translation {auto cr}
set modes [fconfigure $s2 -translation]
@@ -3487,12 +4989,12 @@ test io-16.16 {Tcl_SetChannelOption, setting read mode independently} \
close $s2
set modes
} {auto cr}
-test io-16.17 {Tcl_SetChannelOption, setting read mode independently} \
+test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
set s1 [socket -server accept 0]
set port [lindex [fconfigure $s1 -sockname] 2]
- set s2 [socket localhost $port]
+ set s2 [socket 127.0.0.1 $port]
update
fconfigure $s2 -translation {auto auto}
set modes [fconfigure $s2 -translation]
@@ -3501,7 +5003,7 @@ test io-16.17 {Tcl_SetChannelOption, setting read mode independently} \
set modes
} {auto crlf}
-test io-17.1 {POSIX open access modes: RDWR} {
+test io-40.1 {POSIX open access modes: RDWR} {
removeFile test3
set f [open test3 w]
puts $f xyzzy
@@ -3516,7 +5018,7 @@ test io-17.1 {POSIX open access modes: RDWR} {
close $f
set x
} {zzy abzzy}
-test io-17.2 {POSIX open access modes: CREAT} {unixOnly} {
+test io-40.2 {POSIX open access modes: CREAT} {unixOnly} {
removeFile test3
set f [open test3 {WRONLY CREAT} 0600]
file stat test3 stats
@@ -3528,7 +5030,12 @@ test io-17.2 {POSIX open access modes: CREAT} {unixOnly} {
close $f
set x
} {0600 {line 1}}
-test io-17.3 {POSIX open access modes: CREAT} {$testConfig(unix) && ([exec umask] == 2)} {
+
+# some tests can only be run is umask is 2
+# if "umask" cannot be run, the tests will be skipped.
+catch {set ::tcltest::testConstraints(umask2) [expr {[exec umask] == 2}]}
+
+test io-40.3 {POSIX open access modes: CREAT} {unixOnly umask2} {
# This test only works if your umask is 2, like ouster's.
removeFile test3
set f [open test3 {WRONLY CREAT}]
@@ -3536,7 +5043,7 @@ test io-17.3 {POSIX open access modes: CREAT} {$testConfig(unix) && ([exec umask
file stat test3 stats
format "0%o" [expr $stats(mode)&0777]
} 0664
-test io-17.4 {POSIX open access modes: CREAT} {
+test io-40.4 {POSIX open access modes: CREAT} {
removeFile test3
set f [open test3 w]
fconfigure $f -eofchar {}
@@ -3551,7 +5058,7 @@ test io-17.4 {POSIX open access modes: CREAT} {
close $f
set x
} abzzy
-test io-17.5 {POSIX open access modes: APPEND} {
+test io-40.5 {POSIX open access modes: APPEND} {
removeFile test3
set f [open test3 w]
fconfigure $f -translation lf -eofchar {}
@@ -3572,7 +5079,7 @@ test io-17.5 {POSIX open access modes: APPEND} {
close $f
set x
} {{new line} abc}
-test io-17.6 {POSIX open access modes: EXCL} {
+test io-40.6 {POSIX open access modes: EXCL} {
removeFile test3
set f [open test3 w]
puts $f xyzzy
@@ -3581,7 +5088,7 @@ test io-17.6 {POSIX open access modes: EXCL} {
regsub " already " $msg " " msg
string tolower $msg
} {1 {couldn't open "test3": file exists}}
-test io-17.7 {POSIX open access modes: EXCL} {
+test io-40.7 {POSIX open access modes: EXCL} {
removeFile test3
set f [open test3 {WRONLY CREAT EXCL}]
fconfigure $f -eofchar {}
@@ -3589,7 +5096,7 @@ test io-17.7 {POSIX open access modes: EXCL} {
close $f
viewFile test3
} {A test line}
-test io-17.8 {POSIX open access modes: TRUNC} {
+test io-40.8 {POSIX open access modes: TRUNC} {
removeFile test3
set f [open test3 w]
puts $f xyzzy
@@ -3602,7 +5109,7 @@ test io-17.8 {POSIX open access modes: TRUNC} {
close $f
set x
} abc
-test io-17.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
+test io-40.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
removeFile test3
set f [open test3 {WRONLY NONBLOCK CREAT}]
puts $f "NONBLOCK test"
@@ -3612,7 +5119,7 @@ test io-17.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
close $f
set x
} {NONBLOCK test}
-test io-17.10 {POSIX open access modes: RDONLY} {
+test io-40.10 {POSIX open access modes: RDONLY} {
set f [open test1 w]
puts $f "two lines: this one"
puts $f "and this"
@@ -3624,15 +5131,15 @@ test io-17.10 {POSIX open access modes: RDONLY} {
[list {two lines: this one} 1 \
[format "channel \"%s\" wasn't opened for writing" $f]]
} 0
-test io-17.11 {POSIX open access modes: RDONLY} {
+test io-40.11 {POSIX open access modes: RDONLY} {
removeFile test3
string tolower [list [catch {open test3 RDONLY} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
-test io-17.12 {POSIX open access modes: WRONLY} {
+test io-40.12 {POSIX open access modes: WRONLY} {
removeFile test3
string tolower [list [catch {open test3 WRONLY} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
-test io-17.13 {POSIX open access modes: WRONLY} {
+test io-40.13 {POSIX open access modes: WRONLY} {
makeFile xyzzy test3
set f [open test3 WRONLY]
fconfigure $f -eofchar {}
@@ -3644,11 +5151,11 @@ test io-17.13 {POSIX open access modes: WRONLY} {
string compare [string tolower $x] \
[list 1 "channel \"$f\" wasn't opened for reading" abzzy]
} 0
-test io-17.14 {POSIX open access modes: RDWR} {
+test io-40.14 {POSIX open access modes: RDWR} {
removeFile test3
string tolower [list [catch {open test3 RDWR} msg] $msg]
} {1 {couldn't open "test3": no such file or directory}}
-test io-17.15 {POSIX open access modes: RDWR} {
+test io-40.15 {POSIX open access modes: RDWR} {
makeFile xyzzy test3
set f [open test3 RDWR]
puts -nonewline $f "ab"
@@ -3658,7 +5165,7 @@ test io-17.15 {POSIX open access modes: RDWR} {
lappend x [viewFile test3]
} {zzy abzzy}
if {![file exists ~/_test_] && [file writable ~]} {
- test io-17.16 {tilde substitution in open} {
+ test io-40.16 {tilde substitution in open} {
set f [open ~/_test_ w]
puts $f "Some text"
close $f
@@ -3667,7 +5174,7 @@ if {![file exists ~/_test_] && [file writable ~]} {
set x
} 1
}
-test io-17.17 {tilde substitution in open} {
+test io-40.17 {tilde substitution in open} {
set home $env(HOME)
unset env(HOME)
set x [list [catch {open ~/foo} msg] $msg]
@@ -3675,19 +5182,19 @@ test io-17.17 {tilde substitution in open} {
set x
} {1 {couldn't find HOME environment variable to expand path}}
-test io-18.1 {Tcl_FileeventCmd: errors} {
+test io-41.1 {Tcl_FileeventCmd: errors} {
list [catch {fileevent foo} msg] $msg
-} {1 {wrong # args: must be "fileevent channelId event ?script?}}
-test io-18.2 {Tcl_FileeventCmd: errors} {
+} {1 {wrong # args: should be "fileevent channelId event ?script?"}}
+test io-41.2 {Tcl_FileeventCmd: errors} {
list [catch {fileevent foo bar baz q} msg] $msg
-} {1 {wrong # args: must be "fileevent channelId event ?script?}}
-test io-18.3 {Tcl_FileeventCmd: errors} {
+} {1 {wrong # args: should be "fileevent channelId event ?script?"}}
+test io-41.3 {Tcl_FileeventCmd: errors} {
list [catch {fileevent gorp readable} msg] $msg
} {1 {can not find channel named "gorp"}}
-test io-18.4 {Tcl_FileeventCmd: errors} {
+test io-41.4 {Tcl_FileeventCmd: errors} {
list [catch {fileevent gorp writable} msg] $msg
} {1 {can not find channel named "gorp"}}
-test io-18.5 {Tcl_FileeventCmd: errors} {
+test io-41.5 {Tcl_FileeventCmd: errors} {
list [catch {fileevent gorp who-knows} msg] $msg
} {1 {bad event name "who-knows": must be readable or writable}}
@@ -3697,10 +5204,10 @@ test io-18.5 {Tcl_FileeventCmd: errors} {
set f [open foo w+]
-test io-19.1 {Tcl_FileeventCmd: creating, deleting, querying} {
+test io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {
list [fileevent $f readable] [fileevent $f writable]
} {{} {}}
-test io-19.2 {Tcl_FileeventCmd: replacing} {
+test io-42.2 {Tcl_FileeventCmd: replacing} {
set result {}
fileevent $f r "first script"
lappend result [fileevent $f readable]
@@ -3711,18 +5218,26 @@ test io-19.2 {Tcl_FileeventCmd: replacing} {
fileevent $f r ""
lappend result [fileevent $f readable]
} {{first script} {new script} {yet another} {}}
+test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {
+ set result {}
+ fileevent $f r "first scr\0ipt"
+ lappend result [string length [fileevent $f readable]]
+ fileevent $f r "new scr\0ipt"
+ lappend result [string length [fileevent $f readable]]
+ fileevent $f r "yet ano\0ther"
+ lappend result [string length [fileevent $f readable]]
+ fileevent $f r ""
+ lappend result [fileevent $f readable]
+} {13 11 12 {}}
#
# Test fileevent on a pipe
#
-if {($tcl_platform(platform) != "macintosh") && \
- ($testConfig(unixExecs) == 1)} {
-
catch {set f2 [open "|[list cat -u]" r+]}
catch {set f3 [open "|[list cat -u]" r+]}
-test io-20.1 {Tcl_FileeventCmd: creating, deleting, querying} {
+test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs} {
set result {}
fileevent $f readable "script 1"
lappend result [fileevent $f readable] [fileevent $f writable]
@@ -3733,7 +5248,7 @@ test io-20.1 {Tcl_FileeventCmd: creating, deleting, querying} {
fileevent $f writable {}
lappend result [fileevent $f readable] [fileevent $f writable]
} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
-test io-20.2 {Tcl_FileeventCmd: deleting when many present} {
+test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs} {
set result {}
lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
fileevent $f r "read f"
@@ -3748,7 +5263,7 @@ test io-20.2 {Tcl_FileeventCmd: deleting when many present} {
lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
} {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
-test io-21.1 {FileEventProc procedure: normal read event} {
+test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs} {
fileevent $f2 readable {
set x [gets $f2]; fileevent $f2 readable {}
}
@@ -3757,7 +5272,7 @@ test io-21.1 {FileEventProc procedure: normal read event} {
vwait x
set x
} {text}
-test io-21.2 {FileEventProc procedure: error in read event} {
+test io-44.2 {FileEventProc procedure: error in read event} {stdio unixExecs} {
proc bgerror args {
global x
set x $args
@@ -3769,7 +5284,7 @@ test io-21.2 {FileEventProc procedure: error in read event} {
rename bgerror {}
list $x [fileevent $f2 readable]
} {bogus {}}
-test io-21.3 {FileEventProc procedure: normal write event} {
+test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs} {
fileevent $f2 writable {
lappend x "triggered"
incr count -1
@@ -3784,7 +5299,7 @@ test io-21.3 {FileEventProc procedure: normal write event} {
vwait x
set x
} {initial triggered triggered triggered}
-test io-21.4 {FileEventProc procedure: eror in write event} {
+test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs} {
proc bgerror args {
global x
set x $args
@@ -3795,8 +5310,8 @@ test io-21.4 {FileEventProc procedure: eror in write event} {
rename bgerror {}
list $x [fileevent $f2 writable]
} {bad-write {}}
-test io-21.5 {FileEventProc procedure: end of file} {unixOrPc} {
- set f4 [open "|[list $tcltest cat << foo]" r]
+test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} {
+ set f4 [open "|[list $::tcltest::tcltest cat << foo]" r]
fileevent $f4 readable {
if {[gets $f4 line] < 0} {
lappend x eof
@@ -3815,13 +5330,10 @@ test io-21.5 {FileEventProc procedure: end of file} {unixOrPc} {
catch {close $f2}
catch {close $f3}
-}
- # Closes if {($platform(platform) != "macintosh") && \
- # ($testConfig(unixExecs) == 1)} clause
close $f
makeFile "foo bar" foo
-test io-22.1 {DeleteFileEvent, cleanup on close} {
+test io-45.1 {DeleteFileEvent, cleanup on close} {
set f [open foo r]
fileevent $f readable {
lappend x "binding triggered: \"[gets $f]\""
@@ -3833,7 +5345,7 @@ test io-22.1 {DeleteFileEvent, cleanup on close} {
vwait y
set x
} {initial}
-test io-22.2 {DeleteFileEvent, cleanup on close} {
+test io-45.2 {DeleteFileEvent, cleanup on close} {
set f [open foo r]
set f2 [open foo r]
fileevent $f readable {
@@ -3850,7 +5362,7 @@ test io-22.2 {DeleteFileEvent, cleanup on close} {
close $f2
set x
} {initial {f2 triggered: "foo bar"}}
-test io-22.3 {DeleteFileEvent, cleanup on close} {
+test io-45.3 {DeleteFileEvent, cleanup on close} {
set f [open foo r]
set f2 [open foo r]
set f3 [open foo r]
@@ -3876,7 +5388,7 @@ test io-22.3 {DeleteFileEvent, cleanup on close} {
if {[info commands testfevent] == "testfevent"} {
-test io-23.1 {Tcl event loop vs multiple interpreters} {
+ test io-46.1 {Tcl event loop vs multiple interpreters} {} {
testfevent create
testfevent cmd {
set f [open foo r]
@@ -3891,7 +5403,7 @@ test io-23.1 {Tcl event loop vs multiple interpreters} {
testfevent cmd {close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
-test io-23.2 {Tcl event loop vs multiple interpreters} {
+test io-46.2 {Tcl event loop vs multiple interpreters} {
testfevent create
testfevent cmd {
set x 0
@@ -3900,7 +5412,7 @@ test io-23.2 {Tcl event loop vs multiple interpreters} {
set x
}
} {triggered}
-test io-23.3 {Tcl event loop vs multiple interpreters} {
+test io-46.3 {Tcl event loop vs multiple interpreters} {
testfevent create
testfevent cmd {
set x 0
@@ -3914,7 +5426,7 @@ test io-23.3 {Tcl event loop vs multiple interpreters} {
}
} {0 0 {0 timer}}
-test io-24.1 {fileevent vs multiple interpreters} {
+test io-47.1 {fileevent vs multiple interpreters} {
set f [open foo r]
set f2 [open foo r]
set f3 [open foo r]
@@ -3933,7 +5445,7 @@ test io-24.1 {fileevent vs multiple interpreters} {
close $f3
set x
} {{} {script 1} {} {sript 3}}
-test io-24.2 {deleting fileevent on interpreter delete} {
+test io-47.2 {deleting fileevent on interpreter delete} {
set f [open foo r]
set f2 [open foo r]
set f3 [open foo r]
@@ -3954,7 +5466,7 @@ test io-24.2 {deleting fileevent on interpreter delete} {
close $f4
set x
} {{script 1} {} {} {script 4}}
-test io-24.3 {deleting fileevent on interpreter delete} {
+test io-47.3 {deleting fileevent on interpreter delete} {
set f [open foo r]
set f2 [open foo r]
set f3 [open foo r]
@@ -3975,7 +5487,7 @@ test io-24.3 {deleting fileevent on interpreter delete} {
close $f4
set x
} {{script 1} {script 2} {} {}}
-test io-24.4 {file events on shared files and multiple interpreters} {
+test io-47.4 {file events on shared files and multiple interpreters} {
set f [open foo r]
set f2 [open foo r]
testfevent create
@@ -3991,7 +5503,7 @@ test io-24.4 {file events on shared files and multiple interpreters} {
close $f2
set x
} {{script 3} {script 1} {script 2}}
-test io-24.5 {file events on shared files, deleting file events} {
+test io-47.5 {file events on shared files, deleting file events} {
set f [open foo r]
testfevent create
testfevent share $f
@@ -4004,7 +5516,7 @@ test io-24.5 {file events on shared files, deleting file events} {
close $f
set x
} {{} {script 2}}
-test io-24.6 {file events on shared files, deleting file events} {
+test io-47.6 {file events on shared files, deleting file events} {
set f [open foo r]
testfevent create
testfevent share $f
@@ -4022,7 +5534,7 @@ test io-24.6 {file events on shared files, deleting file events} {
# The above curly closes the test for presence of the "testfevent" command.
-test io-25.1 {testing readability conditions} {
+test io-48.1 {testing readability conditions} {
set f [open bar w]
puts $f abcdefg
puts $f abcdefg
@@ -4047,7 +5559,7 @@ test io-25.1 {testing readability conditions} {
vwait x
list $x $l
} {done {called called called called called called called}}
-test io-25.2 {testing readability conditions} {nonBlockFiles} {
+test io-48.2 {testing readability conditions} {nonBlockFiles} {
set f [open bar w]
puts $f abcdefg
puts $f abcdefg
@@ -4073,7 +5585,7 @@ test io-25.2 {testing readability conditions} {nonBlockFiles} {
vwait x
list $x $l
} {done {called called called called called called called}}
-test io-25.3 {testing readability conditions} {unixOnly nonBlockFiles} {
+test io-48.3 {testing readability conditions} {unixOnly nonBlockFiles} {
set f [open bar w]
puts $f abcdefg
puts $f abcdefg
@@ -4092,7 +5604,7 @@ test io-25.3 {testing readability conditions} {unixOnly nonBlockFiles} {
}
}
close $f
- set f [open "|[list $tcltest]" r+]
+ set f [open "|[list $::tcltest::tcltest]" r+]
fileevent $f readable [list consume $f]
fconfigure $f -buffering line
fconfigure $f -blocking off
@@ -4117,7 +5629,7 @@ test io-25.3 {testing readability conditions} {unixOnly nonBlockFiles} {
close $f
list $x $l
} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
-test io-25.4 {lf write, testing readability, ^Z termination, auto read mode} {
+test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4142,7 +5654,7 @@ test io-25.4 {lf write, testing readability, ^Z termination, auto read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.5 {lf write, testing readability, ^Z in middle, auto read mode} {
+test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4167,7 +5679,7 @@ test io-25.5 {lf write, testing readability, ^Z in middle, auto read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.6 {cr write, testing readability, ^Z termination, auto read mode} {
+test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -4192,7 +5704,7 @@ test io-25.6 {cr write, testing readability, ^Z termination, auto read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.7 {cr write, testing readability, ^Z in middle, auto read mode} {
+test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -4217,7 +5729,7 @@ test io-25.7 {cr write, testing readability, ^Z in middle, auto read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.8 {crlf write, testing readability, ^Z termination, auto read mode} {
+test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -4242,7 +5754,7 @@ test io-25.8 {crlf write, testing readability, ^Z termination, auto read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
+test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -4267,7 +5779,7 @@ test io-25.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.10 {lf write, testing readability, ^Z in middle, lf read mode} {
+test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4292,7 +5804,7 @@ test io-25.10 {lf write, testing readability, ^Z in middle, lf read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.11 {lf write, testing readability, ^Z termination, lf read mode} {
+test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4317,7 +5829,7 @@ test io-25.11 {lf write, testing readability, ^Z termination, lf read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.12 {cr write, testing readability, ^Z in middle, cr read mode} {
+test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -4342,7 +5854,7 @@ test io-25.12 {cr write, testing readability, ^Z in middle, cr read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.13 {cr write, testing readability, ^Z termination, cr read mode} {
+test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation cr
@@ -4367,7 +5879,7 @@ test io-25.13 {cr write, testing readability, ^Z termination, cr read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
+test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -4392,7 +5904,7 @@ test io-25.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
vwait x
list $c $l
} {3 {abc def {}}}
-test io-25.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
+test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation crlf
@@ -4418,7 +5930,7 @@ test io-25.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
list $c $l
} {3 {abc def {}}}
-test io-26.1 {testing crlf reading, leftover cr disgorgment} {
+test io-49.1 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4447,7 +5959,7 @@ test io-26.1 {testing crlf reading, leftover cr disgorgment} {
set l
} "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
} 7 0 {} 1"
-test io-26.2 {testing crlf reading, leftover cr disgorgment} {
+test io-49.2 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4470,7 +5982,7 @@ test io-26.2 {testing crlf reading, leftover cr disgorgment} {
close $f
set l
} "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
-test io-26.3 {testing crlf reading, leftover cr disgorgment} {
+test io-49.3 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4491,7 +6003,7 @@ test io-26.3 {testing crlf reading, leftover cr disgorgment} {
close $f
set l
} "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
-test io-26.4 {testing crlf reading, leftover cr disgorgment} {
+test io-49.4 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4512,7 +6024,7 @@ test io-26.4 {testing crlf reading, leftover cr disgorgment} {
close $f
set l
} "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
-test io-26.5 {testing crlf reading, leftover cr disgorgment} {
+test io-49.5 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
set f [open test1 w]
fconfigure $f -translation lf
@@ -4531,7 +6043,7 @@ test io-26.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-27.1 {testing handler deletion} {
+test io-50.1 {testing handler deletion} {} {
removeFile test1
set f [open test1 w]
close $f
@@ -4547,7 +6059,7 @@ test io-27.1 {testing handler deletion} {
close $f
set z
} called
-test io-27.2 {testing handler deletion with multiple handlers} {
+test io-50.2 {testing handler deletion with multiple handlers} {} {
removeFile test1
set f [open test1 w]
close $f
@@ -4565,7 +6077,7 @@ test io-27.2 {testing handler deletion with multiple handlers} {
string compare [string tolower $z] \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
} 0
-test io-27.3 {testing handler deletion with multiple handlers} {
+test io-50.3 {testing handler deletion with multiple handlers} {} {
removeFile test1
set f [open test1 w]
close $f
@@ -4591,7 +6103,7 @@ test io-27.3 {testing handler deletion with multiple handlers} {
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
} 0
-test io-27.4 {testing handler deletion vs reentrant calls} {
+test io-50.4 {testing handler deletion vs reentrant calls} {} {
removeFile test1
set f [open test1 w]
close $f
@@ -4615,7 +6127,7 @@ test io-27.4 {testing handler deletion vs reentrant calls} {
string compare [string tolower $z] \
{{delrecursive calling recursive} {delrecursive deleting recursive}}
} 0
-test io-27.5 {testing handler deletion vs reentrant calls} {
+test io-50.5 {testing handler deletion vs reentrant calls} {} {
removeFile test1
set f [open test1 w]
close $f
@@ -4648,7 +6160,7 @@ test io-27.5 {testing handler deletion vs reentrant calls} {
[list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
} 0
-test io-27.6 {testing handler deletion vs reentrant calls} {
+test io-50.6 {testing handler deletion vs reentrant calls} {} {
removeFile test1
set f [open test1 w]
close $f
@@ -4690,7 +6202,7 @@ test io-27.6 {testing handler deletion vs reentrant calls} {
{first after update}]
} 0
-test io-28.1 {Test old socket deletion on Macintosh} {socket} {
+test io-51.1 {Test old socket deletion on Macintosh} {socket} {
set x 0
set result ""
proc accept {s a p} {
@@ -4728,9 +6240,9 @@ test io-28.1 {Test old socket deletion on Macintosh} {socket} {
set result
} {sock1 sock2 sock3 sock4}
-test io-29.1 {TclCopyChannel} {
+test io-52.1 {TclCopyChannel} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
fcopy $f1 $f2 -command { # }
catch { fcopy $f1 $f2 } msg
@@ -4738,11 +6250,11 @@ test io-29.1 {TclCopyChannel} {
close $f2
string compare $msg "channel \"$f1\" is busy"
} {0}
-test io-29.2 {TclCopyChannel} {
+test io-52.2 {TclCopyChannel} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
- set f3 [open [info script]]
+ set f3 [open $thisScript]
fcopy $f1 $f2 -command { # }
catch { fcopy $f3 $f2 } msg
close $f1
@@ -4750,9 +6262,9 @@ test io-29.2 {TclCopyChannel} {
close $f3
string compare $msg "channel \"$f2\" is busy"
} {0}
-test io-29.3 {TclCopyChannel} {
+test io-52.3 {TclCopyChannel} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
@@ -4760,16 +6272,16 @@ test io-29.3 {TclCopyChannel} {
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
- set s1 [file size [info script]]
+ set s1 [file size $thisScript]
set s2 [file size test1]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
}
set result
} {0 0 ok}
-test io-29.4 {TclCopyChannel} {
+test io-52.4 {TclCopyChannel} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
@@ -4779,9 +6291,9 @@ test io-29.4 {TclCopyChannel} {
close $f2
lappend result [file size test1]
} {0 0 40}
-test io-29.5 {TclCopyChannel} {
+test io-52.5 {TclCopyChannel} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
@@ -4789,39 +6301,39 @@ test io-29.5 {TclCopyChannel} {
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
- set s1 [file size [info script]]
+ set s1 [file size $thisScript]
set s2 [file size test1]
if {"$s1" == "$s2"} {
lappend result ok
}
set result
} {0 0 ok}
-test io-29.6 {TclCopyChannel} {
+test io-52.6 {TclCopyChannel} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
- set s0 [fcopy $f1 $f2 -size [expr [file size [info script]] + 5]]
+ set s0 [fcopy $f1 $f2 -size [expr [file size $thisScript] + 5]]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
- set s1 [file size [info script]]
+ set s1 [file size $thisScript]
set s2 [file size test1]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
}
set result
} {0 0 ok}
-test io-29.7 {TclCopyChannel} {
+test io-52.7 {TclCopyChannel} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
fcopy $f1 $f2
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
- set s1 [file size [info script]]
+ set s1 [file size $thisScript]
set s2 [file size test1]
close $f1
close $f2
@@ -4830,21 +6342,21 @@ test io-29.7 {TclCopyChannel} {
}
set result
} {0 0 ok}
-test io-29.8 {TclCopyChannel} {stdio} {
+test io-52.8 {TclCopyChannel} {stdio} {
removeFile test1
removeFile pipe
set f1 [open pipe w]
fconfigure $f1 -translation lf
- puts $f1 {
+ puts $f1 "
puts ready
gets stdin
- set f1 [open [info script] r]
- fconfigure $f1 -translation lf
- puts [read $f1 100]
- close $f1
- }
+ set f1 \[open [list $thisScript] r\]
+ fconfigure \$f1 -translation lf
+ puts \[read \$f1 100\]
+ close \$f1
+ "
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
fconfigure $f1 -translation lf
gets $f1
puts $f1 ready
@@ -4857,9 +6369,9 @@ test io-29.8 {TclCopyChannel} {stdio} {
list $s0 [file size test1]
} {40 40}
-test io-30.1 {CopyData} {
+test io-53.1 {CopyData} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
@@ -4869,9 +6381,9 @@ test io-30.1 {CopyData} {
close $f2
lappend result [file size test1]
} {0 0 0}
-test io-30.2 {CopyData} {
+test io-53.2 {CopyData} {
removeFile test1
- set f1 [open [info script]]
+ set f1 [open $thisScript]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
@@ -4880,14 +6392,14 @@ test io-30.2 {CopyData} {
vwait s0
close $f1
close $f2
- set s1 [file size [info script]]
+ set s1 [file size $thisScript]
set s2 [file size test1]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
}
set result
} {0 0 ok}
-test io-30.3 {CopyData: background read underflow} {unixOnly} {
+test io-53.3 {CopyData: background read underflow} {unixOnly} {
removeFile test1
removeFile pipe
set f1 [open pipe w]
@@ -4902,7 +6414,7 @@ test io-30.3 {CopyData: background read underflow} {unixOnly} {
close $f
}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
set result [gets $f1]
puts $f1 line1
flush $f1
@@ -4917,8 +6429,8 @@ test io-30.3 {CopyData: background read underflow} {unixOnly} {
close $f
set result
} "ready line1 line2 {done\n}"
-test io-30.4 {CopyData: background write overflow} {unixOnly} {
- set big aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n
+test io-53.4 {CopyData: background write overflow} {unixOnly} {
+ set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
for {set x 0} {$x < 12} {incr x} {
append big $big
}
@@ -4935,7 +6447,7 @@ test io-30.4 {CopyData: background write overflow} {unixOnly} {
close $f
}
close $f1
- set f1 [open "|[list $tcltest pipe]" r+]
+ set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
set result [gets $f1]
fconfigure $f1 -blocking 0
puts $f1 $big
@@ -4953,6 +6465,7 @@ test io-30.4 {CopyData: background write overflow} {unixOnly} {
set big {}
set x
} done
+set result {}
proc FcopyTestAccept {sock args} {
after 1000 "close $sock"
@@ -4965,31 +6478,29 @@ proc FcopyTestDone {bytes {error {}}} {
set fcopyTestDone 0
}
}
-if [catch {socket -server FcopyTestAccept 2828} listen] {
- puts stderr "Skipping fcopy error test"
-} else {
- test io-30.5 {CopyData: error during fcopy} {
- set in [open [info script]] ;# 126 K
- set out [socket localhost 2828]
- catch {unset fcopyTestDone}
- close $listen ;# This means the socket open never really succeeds
- fcopy $in $out -command FcopyTestDone
- if ![info exists fcopyTestDone] {
- vwait fcopyTestDone ;# The error occurs here in the b.g.
- }
- close $in
- close $out
- set fcopyTestDone ;# 1 for error condition
- } 1
-}
-test io-30.6 {CopyData: error during fcopy} {stdio} {
+
+test io-53.5 {CopyData: error during fcopy} {socket} {
+ set listen [socket -server FcopyTestAccept 2828]
+ set in [open $thisScript] ;# 126 K
+ set out [socket 127.0.0.1 2828]
+ catch {unset fcopyTestDone}
+ close $listen ;# This means the socket open never really succeeds
+ fcopy $in $out -command FcopyTestDone
+ if ![info exists fcopyTestDone] {
+ vwait fcopyTestDone ;# The error occurs here in the b.g.
+ }
+ close $in
+ close $out
+ set fcopyTestDone ;# 1 for error condition
+} 1
+test io-53.6 {CopyData: error during fcopy} {stdio} {
removeFile pipe
removeFile test1
catch {unset fcopyTestDone}
set f1 [open pipe w]
puts $f1 "exit 1"
close $f1
- set in [open "|[list $tcltest pipe]" r+]
+ set in [open "|[list $::tcltest::tcltest pipe]" r+]
set out [open test1 w]
fcopy $in $out -command [list FcopyTestDone]
if ![info exists fcopyTestDone] {
@@ -5000,7 +6511,7 @@ test io-30.6 {CopyData: error during fcopy} {stdio} {
set fcopyTestDone ;# 0 for plain end of file
} {0}
-test io-31.1 {Recursive channel events} {socket} {
+test io-54.1 {Recursive channel events} {socket} {
# This test checks to see if file events are delivered during recursive
# event loops when there is buffered data on the channel.
@@ -5052,36 +6563,40 @@ test io-31.1 {Recursive channel events} {socket} {
close $cs
list $result $x
} {{{line 1} 1 2} 2}
-test io-31.2 {Testing for busy-wait in recursive channel events} {socket} {
+test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
+ set accept {}
+ set after {}
set s [socket -server accept 3939]
proc accept {s a p} {
- global counter
+ global counter accept
+ set accept $s
set counter 0
fconfigure $s -blocking off -buffering line -translation lf
fileevent $s readable "doit $s"
}
proc doit {s} {
- global counter
+ global counter after
incr counter
set l [gets $s]
if {"$l" == ""} {
fileevent $s readable "doit1 $s"
- after 1000 newline
+ set after [after 1000 newline]
}
}
proc doit1 {s} {
- global counter
+ global counter accept
incr counter
set l [gets $s]
close $s
+ set accept {}
}
proc producer {} {
global writer
- set writer [socket localhost 3939]
+ set writer [socket 127.0.0.1 3939]
fconfigure $writer -buffering line
puts -nonewline $writer hello
flush $writer
@@ -5097,9 +6612,12 @@ test io-31.2 {Testing for busy-wait in recursive channel events} {socket} {
vwait done
close $writer
close $s
+ after cancel $after
+ if {$accept != {}} {close $accept}
set counter
} 1
-test io-32.1 {ChannelEventScriptInvoker: deletion} {
+
+test io-55.1 {ChannelEventScriptInvoker: deletion} {
proc eventScript {fd} {
close $fd
error "planned error"
@@ -5115,7 +6633,7 @@ test io-32.1 {ChannelEventScriptInvoker: deletion} {
set x
} {got_error}
-test io-33.1 {ChannelTimerProc} {
+test io-56.1 {ChannelTimerProc} {
set f [open fooBar w]
puts $f "this is a test"
close $f
@@ -5135,12 +6653,12 @@ test io-33.1 {ChannelTimerProc} {
lappend result $y
} {2 done}
-test io-34.1 {buffered data and file events, gets} {
+test io-57.1 {buffered data and file events, gets} {
proc accept {sock args} {
set ::s2 $sock
}
set server [socket -server accept 4040]
- set s [socket localhost 4040]
+ set s [socket 127.0.0.1 4040]
vwait s2
update
fileevent $s2 readable {lappend result readable}
@@ -5156,12 +6674,12 @@ test io-34.1 {buffered data and file events, gets} {
close $server
set result
} {12 readable 34567890 timer}
-test io-34.2 {buffered data and file events, read} {
+test io-57.2 {buffered data and file events, read} {
proc accept {sock args} {
set ::s2 $sock
}
set server [socket -server accept 4041]
- set s [socket localhost 4041]
+ set s [socket 127.0.0.1 4041]
vwait s2
update
fileevent $s2 readable {lappend result readable}
@@ -5178,7 +6696,7 @@ test io-34.2 {buffered data and file events, read} {
set result
} {1 readable 234567890 timer}
-test io-35.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
+test io-58.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
set out [open script w]
puts $out {
puts "normal message from pipe"
@@ -5196,7 +6714,7 @@ test io-35.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
}
}
close $out
- set pipe [open "|[list $tcltest] script" r]
+ set pipe [open "|[list $::tcltest::tcltest] script" r]
fileevent $pipe readable [list readit $pipe]
set x ""
set result ""
@@ -5204,20 +6722,25 @@ test io-35.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
list $x $result
} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}
+# cleanup
+foreach file [list fooBar longfile script output test1 pipe my_script foo \
+ bar test2 test3 cat stdout] {
+ ::tcltest::removeFile $file
+}
+::tcltest::restoreState
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
-removeFile fooBar
-removeFile longfile
-removeFile script
-removeFile output
-removeFile test1
-removeFile pipe
-removeFile my_script
-removeFile foo
-removeFile bar
-removeFile test2
-removeFile test3
-file delete cat
-set x ""
-unset x
diff --git a/tcl/tests/ioCmd.test b/tcl/tests/ioCmd.test
index 5d4743ff99a..c668299cfa4 100644
--- a/tcl/tests/ioCmd.test
+++ b/tcl/tests/ioCmd.test
@@ -7,13 +7,17 @@
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
removeFile test1
removeFile pipe
@@ -97,16 +101,16 @@ test iocmd-3.5 {gets command} {
test iocmd-4.1 {read command} {
list [catch {read} msg] $msg
-} {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"}}
+} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
test iocmd-4.2 {read command} {
list [catch {read a b c d e f g h} msg] $msg
-} {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"}}
+} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
test iocmd-4.3 {read command} {
list [catch {read aaa} msg] $msg
} {1 {can not find channel named "aaa"}}
test iocmd-4.4 {read command} {
list [catch {read -nonewline} msg] $msg
-} {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"}}
+} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
test iocmd-4.5 {read command} {
list [catch {read -nonew file4} msg] $msg $errorCode
} {1 {can not find channel named "-nonew"} NONE}
@@ -126,7 +130,7 @@ test iocmd-4.8 {read command with incorrect combination of arguments} {
set x [list [catch {read -nonewline $f 20 z} msg] $msg $errorCode]
close $f
set x
-} {1 {wrong # args: should be "read channelId ?numBytes?" or "read ?-nonewline? channelId"} NONE}
+} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE}
test iocmd-4.9 {read command} {
list [catch {read stdin foo} msg] $msg $errorCode
} {1 {bad argument "foo": should be "nonewline"} NONE}
@@ -158,7 +162,7 @@ test iocmd-5.3 {seek command} {
} {1 {expected integer but got "gugu"}}
test iocmd-5.4 {seek command} {
list [catch {seek stdin 100 gugu} msg] $msg
-} {1 {bad origin "gugu": should be start, current, or end}}
+} {1 {bad origin "gugu": must be start, current, or end}}
test iocmd-6.1 {tell command} {
list [catch {tell} msg] $msg
@@ -195,7 +199,7 @@ test iocmd-8.4 {fconfigure command} {
set x [list [catch {fconfigure $f1 froboz} msg] $msg]
close $f1
set x
-} {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -eofchar, or -translation}}
+} {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
test iocmd-8.5 {fconfigure command} {
list [catch {fconfigure stdin -buffering froboz} msg] $msg
} {1 {bad value for -buffering: must be one of full, line, or none}}
@@ -205,43 +209,43 @@ test iocmd-8.6 {fconfigure command} {
test iocmd-8.7 {fconfigure command} {
removeFile test1
set f1 [open test1 w]
- fconfigure $f1 -translation lf -eofchar {}
+ fconfigure $f1 -translation lf -eofchar {} -encoding unicode
set x [fconfigure $f1]
close $f1
set x
-} {-blocking 1 -buffering full -buffersize 4096 -eofchar {} -translation lf}
+} {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf}
test iocmd-8.8 {fconfigure command} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
- -eofchar {}
+ -eofchar {} -encoding unicode
set x ""
lappend x [fconfigure $f1 -buffering]
lappend x [fconfigure $f1]
close $f1
set x
-} {line {-blocking 1 -buffering line -buffersize 3030 -eofchar {} -translation lf}}
+} {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}}
test iocmd-8.9 {fconfigure command} {
removeFile test1
set f1 [open test1 w]
fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
- -eofchar {}
+ -eofchar {} -encoding binary
set x [fconfigure $f1]
close $f1
set x
-} {-blocking 1 -buffering none -buffersize 4040 -eofchar {} -translation lf}
+} {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf}
test iocmd-8.10 {fconfigure command} {
list [catch {fconfigure a b} msg] $msg
} {1 {can not find channel named "a"}}
test iocmd-8.11 {fconfigure command} {
list [catch {fconfigure stdout -froboz blarfo} msg] $msg
-} {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -eofchar, or -translation}}
+} {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
test iocmd-8.12 {fconfigure command} {
list [catch {fconfigure stdout -b blarfo} msg] $msg
-} {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -eofchar, or -translation}}
+} {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
test iocmd-8.13 {fconfigure command} {
list [catch {fconfigure stdout -buffer blarfo} msg] $msg
-} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -eofchar, or -translation}}
+} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
test iocmd-8.14 {fconfigure command} {
fconfigure stdin -buffers
} 4096
@@ -250,7 +254,7 @@ proc iocmdSSETUP {} {
set srv [socket -server iocmdSRV 0];
set port [lindex [fconfigure $srv -sockname] 2];
proc iocmdSRV {sock ip port} {close $sock}
- set cli [socket localhost $port];
+ set cli [socket 127.0.0.1 $port];
}
}
proc iocmdSSHTDWN {} {
@@ -267,7 +271,7 @@ test iocmd-8.15 {fconfigure command / tcp channel} {socket} {
set r [list [catch {fconfigure $cli -blah} msg] $msg];
iocmdSSHTDWN
set r;
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -eofchar, -translation, -peername, or -sockname}}
+} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}}
test iocmd-8.16 {fconfigure command / tcp channel} {socket} {
iocmdSSETUP
set r [expr [lindex [fconfigure $cli -peername] 2]==$port];
@@ -292,15 +296,14 @@ test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unixOnly} {
set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
close $tty;
set r;
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -eofchar, -translation, or -mode}}
-test iocmd-8.19 {fconfigure command / win tty channel} {pcOnly && !win32s} {
- # None of the com port functions are implemented on Win32s.
- # Also, might fail if com1 is unavailable
+} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}}
+test iocmd-8.19 {fconfigure command / win tty channel} {nonPortable pcOnly} {
+ # might fail if com1 is unavailable
set tty [open com1]
set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
close $tty;
set r;
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -eofchar, -translation, or -mode}}
+} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, or -pollinterval}}
test iocmd-9.1 {eof command} {
list [catch {eof} msg] $msg $errorCode
@@ -313,6 +316,8 @@ test iocmd-9.3 {eof command} {
list [catch {eof file100} msg] $msg $errorCode
} {1 {can not find channel named "file100"} NONE}
+# The tests for Tcl_ExecObjCmd are in exec.test
+
test iocmd-10.1 {fblocked command} {
list [catch {fblocked} msg] $msg
} {1 {wrong # args: should be "fblocked channelId"}}
@@ -488,7 +493,7 @@ test iocmd-15.9 {Tcl_FcopyObjCmd} {
} "1 {channel \"$rfile\" wasn't opened for writing}"
test iocmd-15.10 {Tcl_FcopyObjCmd} {
list [catch {fcopy $rfile $wfile foo bar} msg] $msg
-} {1 {bad switch "foo": must be -size, or -command}}
+} {1 {bad switch "foo": must be -size or -command}}
test iocmd-15.11 {Tcl_FcopyObjCmd} {
list [catch {fcopy $rfile $wfile -size foo} msg] $msg
} {1 {expected integer but got "foo"}}
@@ -499,14 +504,27 @@ test iocmd-15.12 {Tcl_FcopyObjCmd} {
close $rfile
close $wfile
-removeFile test1
-removeFile test2
-removeFile test3
-removeFile test4
+# cleanup
+foreach file [list test1 test2 test3 test4] {
+ ::tcltest::removeFile $file
+}
# delay long enough for background processes to finish
after 500
-removeFile test5
-removeFile pipe
-removeFile output
-set x ""
-set x
+foreach file [list test5 pipe output] {
+ ::tcltest::removeFile $file
+}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/ioUtil.test b/tcl/tests/ioUtil.test
new file mode 100644
index 00000000000..95b2df6b530
--- /dev/null
+++ b/tcl/tests/ioUtil.test
@@ -0,0 +1,320 @@
+# This file (ioUtil.test) tests the hookable TclStat(), TclAccess(),
+# and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+set unsetScript {
+ catch {unset testStat1(size)}
+ catch {unset testStat2(size)}
+ catch {unset testStat3(size)}
+}
+
+test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {knownBug} {
+ catch {file stat testStat1%.fil testStat1} err1
+ catch {file stat testStat2%.fil testStat2} err2
+ catch {file stat testStat3%.fil testStat3} err3
+ list $err1 $err2 $err3
+} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}}
+
+if {[info commands teststatproc] == {}} {
+ puts "This application hasn't been compiled with the \"teststatproc\""
+ puts "command, so I can't test Tcl_Stat_* etc."
+} else {
+test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {
+ catch {teststatproc insert TclpStat} err1
+ teststatproc insert TestStatProc1
+ teststatproc insert TestStatProc2
+ teststatproc insert TestStatProc3
+ set err1
+} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}
+
+test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {knownBug} {
+ file stat testStat2%.fil testStat2
+ file stat testStat1%.fil testStat1
+ file stat testStat3%.fil testStat3
+
+ list $testStat2(size) $testStat1(size) $testStat3(size)
+} {2345 1234 3456}
+
+eval $unsetScript
+
+test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} {
+ catch {teststatproc delete TclpStat} err2
+ set err2
+} {"TclpStat": could not be deleteed}
+
+test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {knownBug} {
+ # Delete the 2nd procedure and test that it longer exists but that
+ # the others do actually return a result.
+
+ teststatproc delete TestStatProc2
+ file stat testStat1%.fil testStat1
+ catch {file stat testStat2%.fil testStat2} err3
+ file stat testStat3%.fil testStat3
+
+ list $testStat1(size) $err3 $testStat3(size)
+} {1234 {couldn't stat "testStat2%.fil": no such file or directory} 3456}
+
+eval $unsetScript
+
+test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {knownBug} {
+ # Next delete the 1st procedure and test that only the 3rd procedure
+ # is the only one that exists.
+
+ teststatproc delete TestStatProc1
+ catch {file stat testStat1%.fil testStat1} err4
+ catch {file stat testStat2%.fil testStat2} err5
+ file stat testStat3%.fil testStat3
+
+ list $err4 $err5 $testStat3(size)
+} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} 3456}
+
+eval $unsetScript
+
+test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {knownBug} {
+ # Finally delete the 3rd procedure and check that none of the
+ # procedures exist.
+
+ teststatproc delete TestStatProc3
+ catch {file stat testStat1%.fil testStat1} err6
+ catch {file stat testStat2%.fil testStat2} err7
+ catch {file stat testStat3%.fil testStat3} err8
+
+ list $err6 $err7 $err8
+} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}}
+
+eval $unsetScript
+
+test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {knownBug} {
+ # Attempt to delete all the Stat procs. again to ensure they no longer
+ # exist and an error is returned.
+
+ catch {teststatproc delete TestStatProc1} err9
+ catch {teststatproc delete TestStatProc2} err10
+ catch {teststatproc delete TestStatProc3} err11
+
+ list $err9 $err10 $err11
+} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}}
+}
+
+eval $unsetScript
+
+
+test access-1.1 {TclAccess: Check that none of the test procs are there.} {
+ catch {file exists testAccess1%.fil} err1
+ catch {file exists testAccess2%.fil} err2
+ catch {file exists testAccess3%.fil} err3
+ list $err1 $err2 $err3
+} {0 0 0}
+
+if {[info commands testaccessproc] == {}} {
+ puts "This application hasn't been compiled with the \"testaccessproc\""
+ puts "command, so I can't test Tcl_Access_* etc."
+} else {
+test ioUtil-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {
+ catch {testaccessproc insert TclpAccess} err1
+ testaccessproc insert TestAccessProc1
+ testaccessproc insert TestAccessProc2
+ testaccessproc insert TestAccessProc3
+ set err1
+} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
+
+test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {
+ list \
+ [file exists testAccess2%.fil] \
+ [file exists testAccess1%.fil] \
+ [file exists testAccess3%.fil]
+} {1 1 1}
+
+test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletedable.} {
+ catch {testaccessproc delete TclpAccess} err2
+ set err2
+} {"TclpAccess": could not be deleteed}
+
+test accesst-1.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {
+ # Delete the 2nd procedure and test that it longer exists but that
+ # the others do actually return a result.
+
+ testaccessproc delete TestAccessProc2
+ set res1 [file exists testAccess1%.fil]
+ catch {file exists testAccess2%.fil} err3
+ set res2 [file exists testAccess3%.fil]
+
+ list $res1 $err3 $res2
+} {1 0 1}
+
+test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {
+ # Next delete the 1st procedure and test that only the 3rd procedure
+ # is the only one that exists.
+
+ testaccessproc delete TestAccessProc1
+ catch {file exists testAccess1%.fil} err4
+ catch {file exists testAccess2%.fil} err5
+ set res3 [file exists testAccess3%.fil]
+
+ list $err4 $err5 $res3
+} {0 0 1}
+
+test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {
+ # Finally delete the 3rd procedure and check that none of the
+ # procedures exist.
+
+ testaccessproc delete TestAccessProc3
+ catch {file exists testAccess1%.fil} err6
+ catch {file exists testAccess2%.fil} err7
+ catch {file exists testAccess3%.fil} err8
+
+ list $err6 $err7 $err8
+} {0 0 0}
+
+test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {
+ # Attempt to delete all the Access procs. again to ensure they no longer
+ # exist and an error is returned.
+
+ catch {testaccessproc delete TestAccessProc1} err9
+ catch {testaccessproc delete TestAccessProc2} err10
+ catch {testaccessproc delete TestAccessProc3} err11
+
+ list $err9 $err10 $err11
+} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
+}
+
+test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {
+ catch {file exists __testOpenFileChannel1%__.fil} err1
+ catch {file exists __testOpenFileChannel2%__.fil} err2
+ catch {file exists __testOpenFileChannel3%__.fil} err3
+ catch {file exists __testOpenFileChannel1%__.fil} err4
+ catch {file exists __testOpenFileChannel2%__.fil} err5
+ catch {file exists __testOpenFileChannel3%__.fil} err6
+ list $err1 $err2 $err3 $err4 $err5 $err6
+} {0 0 0 0 0 0}
+
+if {[info commands testopenfilechannelproc] == {}} {
+ puts "This application hasn't been compiled with the \"testopenfilechannelproc\""
+ puts "command, so I can't test Tcl_OpenFileChannelInsert"
+} else {
+test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {
+ catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
+ testopenfilechannelproc insert TestOpenFileChannelProc1
+ testopenfilechannelproc insert TestOpenFileChannelProc2
+ testopenfilechannelproc insert TestOpenFileChannelProc3
+ set err1
+} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}
+
+test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {
+ close [open __testOpenFileChannel1%__.fil w]
+ close [open __testOpenFileChannel2%__.fil w]
+ close [open __testOpenFileChannel3%__.fil w]
+
+ catch {
+ close [open testOpenFileChannel1%.fil r]
+ close [open testOpenFileChannel2%.fil r]
+ close [open testOpenFileChannel3%.fil r]
+ } err
+
+ file delete __testOpenFileChannel1%__.fil
+ file delete __testOpenFileChannel2%__.fil
+ file delete __testOpenFileChannel3%__.fil
+
+ set err
+} {}
+
+test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletedable.} {
+ catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
+ set err2
+} {"TclpOpenFileChannel": could not be deleteed}
+
+test openfilechannelt-1.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {
+ # Delete the 2nd procedure and test that it longer exists but that
+ # the others do actually return a result.
+
+ testopenfilechannelproc delete TestOpenFileChannelProc2
+
+ close [open __testOpenFileChannel1%__.fil w]
+ close [open __testOpenFileChannel3%__.fil w]
+
+ catch {
+ close [open testOpenFileChannel1%.fil r]
+ catch {close [open testOpenFileChannel2%.fil r]}
+ close [open testOpenFileChannel3%.fil r]
+ } err3
+
+ file delete __testOpenFileChannel1%__.fil
+ file delete __testOpenFileChannel3%__.fil
+
+ set err3
+} {}
+
+test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {
+ # Next delete the 1st procedure and test that only the 3rd procedure
+ # is the only one that exists.
+
+ testopenfilechannelproc delete TestOpenFileChannelProc1
+
+ close [open __testOpenFileChannel3%__.fil w]
+
+ catch {
+ catch {close [open testOpenFileChannel1%.fil r]}
+ catch {close [open testOpenFileChannel2%.fil r]}
+ close [open testOpenFileChannel3%.fil r]
+ } err4
+
+ file delete __testOpenFileChannel3%__.fil
+
+ set err4
+} {}
+
+test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {
+ # Finally delete the 3rd procedure and check that none of the
+ # procedures exist.
+
+ testopenfilechannelproc delete TestOpenFileChannelProc3
+ catch {
+ catch [open testOpenFileChannel1%.fil r]
+ catch [open testOpenFileChannel2%.fil r]
+ catch [open testOpenFileChannel3%.fil r]
+ } err5
+
+ set err5
+} {1}
+
+test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {
+ # Attempt to delete all the OpenFileChannel procs. again to ensure they no longer
+ # exist and an error is returned.
+
+ catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9
+ catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10
+ catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11
+
+ list $err9 $err10 $err11
+} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
+}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/iogt.test b/tcl/tests/iogt.test
new file mode 100644
index 00000000000..0ee5d559c55
--- /dev/null
+++ b/tcl/tests/iogt.test
@@ -0,0 +1,940 @@
+# -*- tcl -*-
+# Commands covered: transform, and stacking in general
+#
+# This file contains a collection of tests for Giot
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 2000 Ajuba Solutions.
+# Copyright (c) 2000 Andreas Kupries.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+if {[info commands testchannel] == ""} {
+ puts "Skipping io tests. This application does not seem to have the"
+ puts "testchannel command that is needed to run these tests."
+ return
+}
+
+::tcltest::saveState
+
+#::tcltest::makeFile contents name
+
+::tcltest::makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=} dummy
+
+# " capture coloring of quotes
+
+::tcltest::makeFile {} dummyout
+
+::tcltest::makeFile {
+#!/usr/local/bin/tclsh
+# -*- tcl -*-
+# echo server
+#
+# arguments, options: port to listen on for connections.
+# delay till echo of first block
+# delay between blocks
+# blocksize ...
+
+set port [lindex $argv 0]
+set fdelay [lindex $argv 1]
+set idelay [lindex $argv 2]
+set bsizes [lrange $argv 3 end]
+set c 0
+
+proc newconn {sock rhost rport} {
+ global c fdelay
+ incr c
+
+ #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout
+
+ upvar #0 c$c conn
+ set conn(after) {}
+ set conn(state) 0
+ set conn(size) 0
+ set conn(data) ""
+ set conn(delay) $fdelay
+
+ fileevent $sock readable [list echoGet $c $sock]
+ fconfigure $sock -translation binary -buffering none -blocking 0
+}
+
+proc echoGet {c sock} {
+ global fdelay
+ upvar #0 c$c conn
+
+ if {[eof $sock]} {
+ # one-shot echo
+ exit
+ }
+
+ append conn(data) [read $sock]
+
+ #puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout
+
+ if {$conn(after) == {}} {
+ set conn(after) [after $conn(delay) [list echoPut $c $sock]]
+ }
+}
+
+proc echoPut {c sock} {
+ global idelay fdelay bsizes
+ upvar #0 c$c conn
+
+ if {[string length $conn(data)] == 0} {
+ #puts stdout "C $c $sock" ; flush stdout
+ # auto terminate
+ close $sock
+ exit
+ #set conn(delay) $fdelay
+ return
+ }
+
+
+ set conn(delay) $idelay
+
+ set n [lindex $bsizes $conn(size)]
+
+ #puts stdout "P $c $sock $n >>" ; flush stdout
+
+ #puts __________________________________________
+ #parray conn
+ #puts n=<$n>
+
+
+ if {[string length $conn(data)] >= $n} {
+ puts -nonewline $sock [string range $conn(data) 0 $n]
+ set conn(data) [string range $conn(data) [incr n] end]
+ }
+
+ incr conn(size)
+ if {$conn(size) >= [llength $bsizes]} {
+ set conn(size) [expr {[llength $bsizes]-1}]
+ }
+
+ set conn(after) [after $conn(delay) [list echoPut $c $sock]]
+}
+
+#fileevent stdin readable {exit ;#cut}
+
+# main
+socket -server newconn $port
+vwait forever
+} __echo_srv__.tcl
+
+
+########################################################################
+
+proc fevent {fdelay idelay blocks script data} {
+ # start and initialize an echo server, prepare data
+ # transmission, then hand over to the test script.
+ # this has to start real transmission via 'flush'.
+ # The server is stopped after completion of the test.
+
+ # fixed port, not so good. lets hope for the best, for now.
+ set port 4000
+
+ eval exec tclsh __echo_srv__.tcl \
+ $port $fdelay $idelay $blocks >@stdout &
+
+ after 500
+
+ #puts stdout "> $port" ; flush stdout
+
+ set sk [socket localhost $port]
+ fconfigure $sk \
+ -blocking 0 \
+ -buffering full \
+ -buffersize [expr {10+[llength $data]}]
+
+ puts -nonewline $sk $data
+
+ # The channel is prepared to go off.
+
+ #puts stdout ">>>>>" ; flush stdout
+
+ uplevel #0 set sock $sk
+ set res [uplevel #0 $script]
+
+ catch {close $sk}
+ return $res
+}
+
+# --------------------------------------------------------------
+# utility transformations ...
+
+proc id {op data} {
+ switch -- $op {
+ create/write -
+ create/read -
+ delete/write -
+ delete/read -
+ clear_read {;#ignore}
+ flush/write -
+ flush/read -
+ write -
+ read {
+ return $data
+ }
+ query/maxRead {return -1}
+ }
+}
+
+proc id_optrail {var op data} {
+ upvar #0 $var trail
+
+ lappend trail $op
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ flush/read -
+ clear/read { #ignore }
+ flush/write -
+ write -
+ read {
+ return $data
+ }
+ query/maxRead {
+ return -1
+ }
+ default {
+ lappend trail "error $op"
+ error $op
+ }
+ }
+}
+
+
+proc id_fulltrail {var op data} {
+ upvar #0 $var trail
+
+ #puts stdout ">> $var $op $data" ; flush stdout
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {
+ set res *ignored*
+ }
+ flush/write - flush/read -
+ write -
+ read {
+ set res $data
+ }
+ query/maxRead {
+ set res -1
+ }
+ }
+
+ #catch {puts stdout "\t>* $res" ; flush stdout}
+ #catch {puts stdout "x$res"} msg
+
+ lappend trail [list $op $data $res]
+ return $res
+}
+
+proc counter {var op data} {
+ upvar #0 $var n
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {;#ignore}
+ flush/write - flush/read {return {}}
+ write {
+ return $data
+ }
+ read {
+ if {$n > 0} {
+ incr n -[string length $data]
+ if {$n < 0} {
+ set n 0
+ }
+ }
+ return $data
+ }
+ query/maxRead {
+ return $n
+ }
+ }
+}
+
+
+proc counter_audit {var vtrail op data} {
+ upvar #0 $var n $vtrail trail
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {
+ set res {}
+ }
+ flush/write - flush/read {
+ set res {}
+ }
+ write {
+ set res $data
+ }
+ read {
+ if {$n > 0} {
+ incr n -[string length $data]
+ if {$n < 0} {
+ set n 0
+ }
+ }
+ set res $data
+ }
+ query/maxRead {
+ set res $n
+ }
+ }
+
+ lappend trail [list counter:$op $data $res]
+ return $res
+}
+
+
+proc rblocks {var vtrail n op data} {
+ upvar #0 $var buf $vtrail trail
+
+ set res {}
+
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {
+ set buf {}
+ }
+ flush/write {
+ }
+ flush/read {
+ set res $buf
+ set buf {}
+ }
+ write {
+ set data
+ }
+ read {
+ append buf $data
+
+ set b [expr {$n * ([string length $buf] / $n)}]
+
+ append op " $n [string length $buf] :- $b"
+
+ set res [string range $buf 0 [incr b -1]]
+ set buf [string range $buf [incr b] end]
+ #return $res
+ }
+ query/maxRead {
+ set res -1
+ }
+ }
+
+ lappend trail [list rblock | $op $data $res | $buf]
+ return $res
+}
+
+
+# --------------------------------------------------------------
+# ... and convenience procedures to stack them
+
+proc identity {-attach channel} {
+ testchannel transform $channel -command id
+}
+
+proc audit_ops {var -attach channel} {
+ testchannel transform $channel -command [list id_optrail $var]
+}
+
+proc audit_flow {var -attach channel} {
+ testchannel transform $channel -command [list id_fulltrail $var]
+}
+
+proc stopafter {var n -attach channel} {
+ upvar #0 $var vn
+ set vn $n
+ testchannel transform $channel -command [list counter $var]
+}
+
+proc stopafter_audit {var trail n -attach channel} {
+ upvar #0 $var vn
+ set vn $n
+ testchannel transform $channel -command [list counter_audit $var $trail]
+}
+
+proc rblocks_t {var trail n -attach channel} {
+ testchannel transform $channel -command [list rblocks $var $trail $n]
+}
+
+# --------------------------------------------------------------
+# serialize an array, with keys in sorted order.
+
+proc array_sget {v} {
+ upvar $v a
+
+ set res [list]
+ foreach n [lsort [array names a]] {
+ lappend res $n $a($n)
+ }
+ set res
+}
+
+proc asort {alist} {
+ # sort a list of key/value pairs by key, removes duplicates too.
+
+ array set a $alist
+ array_sget a
+}
+
+########################################################################
+
+
+test iogt-1.1 {stack/unstack} {
+ set fh [open dummy r]
+ identity -attach $fh
+ testchannel unstack $fh
+ close $fh
+} {}
+
+test iogt-1.2 {stack/close} {
+ set fh [open dummy r]
+ identity -attach $fh
+ close $fh
+} {}
+
+test iogt-1.3 {stack/unstack, configuration, options} {
+ set fh [open dummy r]
+ set ca [asort [fconfigure $fh]]
+ identity -attach $fh
+ set cb [asort [fconfigure $fh]]
+ testchannel unstack $fh
+ set cc [asort [fconfigure $fh]]
+ close $fh
+
+ # With this system none of the buffering, translation and
+ # encoding option may change their values with channels
+ # stacked upon each other or not.
+
+ # cb == ca == cc
+
+ list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
+} {1 1 1}
+
+test iogt-1.4 {stack/unstack, configuration} {
+ set fh [open dummy r]
+ set ca [asort [fconfigure $fh]]
+ identity -attach $fh
+ fconfigure $fh \
+ -buffering line \
+ -translation cr \
+ -encoding shiftjis
+ testchannel unstack $fh
+ set cc [asort [fconfigure $fh]]
+
+ set res [list \
+ [string equal $ca $cc] \
+ [fconfigure $fh -buffering] \
+ [fconfigure $fh -translation] \
+ [fconfigure $fh -encoding] \
+ ]
+
+ close $fh
+ set res
+} {0 line cr shiftjis}
+
+test iogt-2.0 {basic I/O going through transform} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ identity -attach $fin
+ identity -attach $fout
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ set fin [open dummy r]
+ set fout [open dummyout r]
+
+ set res [string equal [set in [read $fin]] [set out [read $fout]]]
+ lappend res [string length $in] [string length $out]
+
+ close $fin
+ close $fout
+
+ set res
+} {1 71 71}
+
+
+test iogt-2.1 {basic I/O, operation trail} {unixOnly} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ set ain [list] ; set aout [list]
+ audit_ops ain -attach $fin
+ audit_ops aout -attach $fout
+
+ fconfigure $fin -buffersize 10
+ fconfigure $fout -buffersize 5
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ set res "[join $ain \n]\n--------\n[join $aout \n]"
+} {create/read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+read
+query/maxRead
+flush/read
+query/maxRead
+delete/read
+--------
+create/write
+write
+write
+write
+write
+write
+write
+write
+write
+flush/write
+delete/write}
+
+test iogt-2.2 {basic I/O, data trail} {unixOnly} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ set ain [list] ; set aout [list]
+ audit_flow ain -attach $fin
+ audit_flow aout -attach $fout
+
+ fconfigure $fin -buffersize 10
+ fconfigure $fout -buffersize 5
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ set res "[join $ain \n]\n--------\n[join $aout \n]"
+} {create/read {} *ignored*
+query/maxRead {} -1
+read abcdefghij abcdefghij
+query/maxRead {} -1
+read klmnopqrst klmnopqrst
+query/maxRead {} -1
+read uvwxyz0123 uvwxyz0123
+query/maxRead {} -1
+read 456789,./? 456789,./?
+query/maxRead {} -1
+read {><;'\|":[]} {><;'\|":[]}
+query/maxRead {} -1
+read {\}\{`~!@#$} {\}\{`~!@#$}
+query/maxRead {} -1
+read %^&*()_+-= %^&*()_+-=
+query/maxRead {} -1
+read {
+} {
+}
+query/maxRead {} -1
+flush/read {} {}
+query/maxRead {} -1
+delete/read {} *ignored*
+--------
+create/write {} *ignored*
+write abcdefghij abcdefghij
+write klmnopqrst klmnopqrst
+write uvwxyz0123 uvwxyz0123
+write 456789,./? 456789,./?
+write {><;'\|":[]} {><;'\|":[]}
+write {\}\{`~!@#$} {\}\{`~!@#$}
+write %^&*()_+-= %^&*()_+-=
+write {
+} {
+}
+flush/write {} {}
+delete/write {} *ignored*}
+
+
+test iogt-2.3 {basic I/O, mixed trail} {unixOnly} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ set trail [list]
+ audit_flow trail -attach $fin
+ audit_flow trail -attach $fout
+
+ fconfigure $fin -buffersize 20
+ fconfigure $fout -buffersize 10
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ join $trail \n
+} {create/read {} *ignored*
+create/write {} *ignored*
+query/maxRead {} -1
+read abcdefghijklmnopqrst abcdefghijklmnopqrst
+write abcdefghij abcdefghij
+write klmnopqrst klmnopqrst
+query/maxRead {} -1
+read uvwxyz0123456789,./? uvwxyz0123456789,./?
+write uvwxyz0123 uvwxyz0123
+write 456789,./? 456789,./?
+query/maxRead {} -1
+read {><;'\|":[]\}\{`~!@#$} {><;'\|":[]\}\{`~!@#$}
+write {><;'\|":[]} {><;'\|":[]}
+write {\}\{`~!@#$} {\}\{`~!@#$}
+query/maxRead {} -1
+read {%^&*()_+-=
+} {%^&*()_+-=
+}
+query/maxRead {} -1
+flush/read {} {}
+write %^&*()_+-= %^&*()_+-=
+write {
+} {
+}
+query/maxRead {} -1
+delete/read {} *ignored*
+flush/write {} {}
+delete/write {} *ignored*}
+
+
+test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
+ {unknownFailure} {
+ # This test to check the validity of aquired Tcl_Channel references is
+ # not possible because even a backgrounded fcopy will immediately start
+ # to copy data, without waiting for the event loop. This is done only in
+ # case of an underflow on the read size!. So stacking transforms after the
+ # fcopy will miss information, or are not used at all.
+ #
+ # I was able to circumvent this by using the echo.tcl server with a big
+ # delay, causing the fcopy to underflow immediately.
+
+ proc DoneCopy {n {err {}}} {
+ global copy ; set copy 1
+ }
+
+ set fin [open dummy r]
+
+ fevent 1000 500 {20 20 20 10 1 1} {
+ close $fin
+
+ set fout [open dummyout w]
+
+ flush $sock ; # now, or fcopy will error us out
+ # But the 1 second delay should be enough to
+ # initialize everything else here.
+
+ fcopy $sock $fout -command DoneCopy
+
+ # transform after fcopy got its handles !
+ # They should be still valid for fcopy.
+
+ set trail [list]
+ audit_ops trail -attach $fout
+
+ vwait copy
+ } [read $fin] ; # {}
+
+ close $fout
+
+ rename DoneCopy {}
+
+ # Check result of copy.
+
+ set fin [open dummy r]
+ set fout [open dummyout r]
+
+ set res [string equal [read $fin] [read $fout]]
+
+ close $fin
+ close $fout
+
+ list $res $trail
+} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
+
+
+test iogt-4.0 {fileevent readable, after transform} {unknownFailure} {
+ set fin [open dummy r]
+ set data [read $fin]
+ close $fin
+
+ set trail [list]
+ set got [list]
+
+ proc Done {args} {
+ global stop
+ set stop 1
+ }
+
+ proc Get {sock} {
+ global trail got
+ if {[eof $sock]} {
+ Done
+ lappend trail "xxxxxxxxxxxxx"
+ close $sock
+ return
+ }
+ lappend trail "vvvvvvvvvvvvv"
+ lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
+ lappend trail "============="
+ #puts stdout $__ ; flush stdout
+ #read $sock
+ }
+
+ fevent 1000 500 {20 20 20 10 1} {
+ audit_flow trail -attach $sock
+ rblocks_t rbuf trail 23 -attach $sock
+
+ fileevent $sock readable [list Get $sock]
+
+ flush $sock ; # now, or fcopy will error us out
+ # But the 1 second delay should be enough to
+ # initialize everything else here.
+
+ vwait stop
+ } $data
+
+
+ rename Done {}
+ rename Get {}
+
+ join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
+} {[[]]
+[[abcdefghijklmnopqrstuvw]]
+[[xyz0123456789,./?><;'\|]]
+[[]]
+[[]]
+[[":[]\}\{`~!@#$%^&*()]]
+[[]]
+~~~~~~~~
+create/write {} *ignored*
+create/read {} *ignored*
+rblock | create/write {} {} | {}
+rblock | create/read {} {} | {}
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {}
+query/maxRead {} -1
+read abcdefghijklmnopqrstu abcdefghijklmnopqrstu
+query/maxRead {} -1
+rblock | {read 23 21 :- 0} abcdefghijklmnopqrstu {} | abcdefghijklmnopqrstu
+rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
+query/maxRead {} -1
+ got: {[[]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
+query/maxRead {} -1
+read vwxyz0123456789,./?>< vwxyz0123456789,./?><
+query/maxRead {} -1
+rblock | {read 23 42 :- 23} vwxyz0123456789,./?>< abcdefghijklmnopqrstuvw | xyz0123456789,./?><
+rblock | query/maxRead {} -1 | xyz0123456789,./?><
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | xyz0123456789,./?><
+query/maxRead {} -1
+read {;'\|":[]\}\{`~!@#$%^&} {;'\|":[]\}\{`~!@#$%^&}
+query/maxRead {} -1
+rblock | {read 23 40 :- 23} {;'\|":[]\}\{`~!@#$%^&} {xyz0123456789,./?><;'\|} | {":[]\}\{`~!@#$%^&}
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
+query/maxRead {} -1
+read *( *(
+query/maxRead {} -1
+rblock | {read 23 19 :- 0} *( {} | {":[]\}\{`~!@#$%^&*(}
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
+query/maxRead {} -1
+read ) )
+query/maxRead {} -1
+rblock | {read 23 20 :- 0} ) {} | {":[]\}\{`~!@#$%^&*()}
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
+query/maxRead {} -1
+flush/read {} {}
+rblock | flush/read {} {":[]\}\{`~!@#$%^&*()} | {}
+rblock | query/maxRead {} -1 | {}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]}
+=============
+vvvvvvvvvvvvv
+rblock | query/maxRead {} -1 | {}
+query/maxRead {} -1
+ got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} {[[]]}
+xxxxxxxxxxxxx
+rblock | flush/write {} {} | {}
+rblock | delete/write {} {} | {}
+rblock | delete/read {} {} | {}
+flush/write {} {}
+delete/write {} *ignored*
+delete/read {} *ignored*} ; # catch unescaped quote "
+
+
+test iogt-5.0 {EOF simulation} {unknownFailure} {
+ set fin [open dummy r]
+ set fout [open dummyout w]
+
+ set trail [list]
+
+ audit_flow trail -attach $fin
+ stopafter_audit d trail 20 -attach $fin
+ audit_flow trail -attach $fout
+
+ fconfigure $fin -buffersize 20
+ fconfigure $fout -buffersize 10
+
+ fcopy $fin $fout
+ testchannel unstack $fin
+
+ # now copy the rest in the channel
+ lappend trail {**after unstack**}
+
+ fcopy $fin $fout
+
+ close $fin
+ close $fout
+
+ join $trail \n
+} {create/read {} *ignored*
+counter:create/read {} {}
+create/write {} *ignored*
+counter:query/maxRead {} 20
+query/maxRead {} -1
+read {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
+} {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
+}
+query/maxRead {} -1
+flush/read {} {}
+counter:read abcdefghijklmnopqrst abcdefghijklmnopqrst
+write abcdefghij abcdefghij
+write klmnopqrst klmnopqrst
+counter:query/maxRead {} 0
+counter:flush/read {} {}
+counter:delete/read {} {}
+**after unstack**
+query/maxRead {} -1
+write uvwxyz0123 uvwxyz0123
+write 456789,./? 456789,./?
+write {><;'\|":[]} {><;'\|":[]}
+write {\}\{`~!@#$} {\}\{`~!@#$}
+write %^&*()_+-= %^&*()_+-=
+write {
+} {
+}
+query/maxRead {} -1
+delete/read {} *ignored*
+flush/write {} {}
+delete/write {} *ignored*}
+
+
+
+
+
+proc constX {op data} {
+ # replace anything coming in with a same-length string of x'es.
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ clear_read {;#ignore}
+ flush/write - flush/read -
+ write -
+ read {
+ return [string repeat x [string length $data]]
+ }
+ query/maxRead {return -1}
+ }
+}
+
+proc constx {-attach channel} {
+ testchannel transform $channel -command constX
+}
+
+test iogt-6.0 {Push back} {
+ set f [open dummy r]
+
+ # contents of dummy = "abcdefghi..."
+ read $f 3 ; # skip behind "abc"
+
+ constx -attach $f
+
+ # expect to get "xxx" from the transform because
+ # of unread "def" input to transform which returns "xxx".
+ #
+ # Actually the IO layer pre-read the whole file and will
+ # read "def" directly from the buffer without bothering
+ # to consult the newly stacked transformation. This is
+ # wrong.
+
+ set res [read $f 3]
+ close $f
+ set res
+} {xxx}
+
+test iogt-6.1 {Push back and up} {knownBug} {
+ set f [open dummy r]
+
+ # contents of dummy = "abcdefghi..."
+ read $f 3 ; # skip behind "abc"
+
+ constx -attach $f
+ set res [read $f 3]
+
+ testchannel unstack $f
+ append res [read $f 3]
+ close $f
+ set res
+} {xxxghi}
+
+
+# cleanup
+foreach file [list dummy dummyout __echo_srv__.tcl] {
+ ::tcltest::removeFile $file
+}
+::tcltest::restoreState
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/join.test b/tcl/tests/join.test
index 365421495da..d2721a66192 100644
--- a/tcl/tests/join.test
+++ b/tcl/tests/join.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test join-1.1 {basic join commands} {
join {a b c} xyz
@@ -45,4 +49,19 @@ test join-3.2 {join is binary ok} {
string length [join "a\0b a\0b a\0b"]
} 11
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/lindex.test b/tcl/tests/lindex.test
index 6a73b53a7d0..3060c7c039e 100644
--- a/tcl/tests/lindex.test
+++ b/tcl/tests/lindex.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test lindex-1.1 {basic tests} {
lindex {a b c} 0} a
@@ -49,7 +53,7 @@ test lindex-2.2 {error conditions} {
} {1 {wrong # args: should be "lindex list index"}}
test lindex-2.3 {error conditions} {
list [catch {lindex 1 2a2} msg] $msg
-} {1 {bad index "2a2": must be integer or "end"}}
+} {1 {bad index "2a2": must be integer or end?-integer?}}
test lindex-2.4 {error conditions} {
list [catch {lindex "a \{" 2} msg] $msg
} {1 {unmatched open brace in list}}
@@ -72,3 +76,8 @@ test lindex-3.3 {quoted elements} {
test lindex-3.4 {quoted elements} {
lindex {a b {c d "e} {f g"}} 2
} {c d "e}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/link.test b/tcl/tests/link.test
index 5a878952f5e..1aaf1133058 100644
--- a/tcl/tests/link.test
+++ b/tcl/tests/link.test
@@ -6,20 +6,25 @@
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testlink] == {}} {
puts "This application hasn't been compiled with the \"testlink\""
puts "command, so I can't test Tcl_LinkVar et al."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
foreach i {int real bool string} {
catch {unset $i}
}
@@ -228,7 +233,25 @@ test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {
list [catch {testlink update 47 {} {} {}} msg] $msg $int
} {0 {} 47}
+testlink set 0 0 0 -
testlink delete
foreach i {int real bool string} {
catch {unset $i}
}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/linsert.test b/tcl/tests/linsert.test
index 2f5bde55f08..b110c700b96 100644
--- a/tcl/tests/linsert.test
+++ b/tcl/tests/linsert.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {unset lis}
catch {rename p ""}
@@ -74,6 +78,9 @@ test linsert-1.18 {linsert command} {
test linsert-1.19 {linsert command} {
linsert {} end q r
} {q r}
+test linsert-1.20 {linsert command, use of end-int index} {
+ linsert {a b c d} end-2 e f
+} {a b e f c d}
test linsert-2.1 {linsert errors} {
list [catch linsert msg] $msg
@@ -83,7 +90,7 @@ test linsert-2.2 {linsert errors} {
} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
test linsert-2.3 {linsert errors} {
list [catch {linsert a 12x 2} msg] $msg
-} {1 {bad index "12x": must be integer or "end"}}
+} {1 {bad index "12x": must be integer or end?-integer?}}
test linsert-2.4 {linsert errors} {
list [catch {linsert \{ 12 2} msg] $msg
} {1 {unmatched open brace in list}}
@@ -101,5 +108,9 @@ test linsert-3.2 {linsert won't modify shared argument objects} {
linsert $lis 0 [string length $lis]
} "7 a b c"
+# cleanup
catch {unset lis}
catch {rename p ""}
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/list.test b/tcl/tests/list.test
index 14be313e2aa..88763272d19 100644
--- a/tcl/tests/list.test
+++ b/tcl/tests/list.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# First, a bunch of individual tests
@@ -105,3 +109,20 @@ proc slowsort list {
test list-3.1 {SetListFromAny and lrange/concat results} {
slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/listObj.test b/tcl/tests/listObj.test
index 3e6a091e924..f4bc31ba2ca 100644
--- a/tcl/tests/listObj.test
+++ b/tcl/tests/listObj.test
@@ -6,20 +6,25 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testobj] == {}} {
puts "This application hasn't been compiled with the \"testobj\""
puts "command, so I can't test the Tcl type and object support."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
catch {unset x}
test listobj-1.1 {Tcl_GetListObjType} {
set t [testobj types]
@@ -27,16 +32,19 @@ test listobj-1.1 {Tcl_GetListObjType} {
set result [expr {$first != -1}]
} {1}
-test listobj-2.1 {Tcl_ListObjForObjArray, use in lappend} {
+test listobj-2.1 {Tcl_SetListObj, use in lappend} {
catch {unset x}
list [lappend x 1 abc def] [lappend x 1 ghi jkl] $x
} {{1 abc def} {1 abc def 1 ghi jkl} {1 abc def 1 ghi jkl}}
-test listobj-2.2 {Tcl_ListObjForObjArray, use in ObjInterpProc} {
+test listobj-2.2 {Tcl_SetListObj, use in ObjInterpProc} {
proc return_args {args} {
return $args
}
list [return_args] [return_args x] [return_args x y]
} {{} x {x y}}
+test listobj-2.3 {Tcl_SetListObj, zero element count} {
+ list
+} {}
test listobj-3.1 {Tcl_ListObjAppend, list conversion} {
catch {unset x}
@@ -174,3 +182,20 @@ test listobj-8.1 {SetListFromAny} {
test listobj-9.1 {UpdateStringOfList} {
string length [list foo\x00help]
} 8
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/llength.test b/tcl/tests/llength.test
index 5e8a0a3b04a..72a422f7b49 100644
--- a/tcl/tests/llength.test
+++ b/tcl/tests/llength.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test llength-1.1 {length of list} {
llength {a b c d}
@@ -33,3 +37,20 @@ test llength-2.2 {error conditions} {
test llength-2.3 {error conditions} {
list [catch {llength "a b c \{"} msg] $msg
} {1 {unmatched open brace in list}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/load.test b/tcl/tests/load.test
index 25a1c960d6a..bd746ae6fe9 100644
--- a/tcl/tests/load.test
+++ b/tcl/tests/load.test
@@ -5,79 +5,93 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Figure out what extension is used for shared libraries on this
# platform.
if {$tcl_platform(platform) == "macintosh"} {
puts "can't run dynamic library tests on macintosh machines"
+ ::tcltest::cleanupTests
return
}
+
+# Tests require the existence of one of the DLLs in the dltest directory.
set ext [info sharedlibextension]
set testDir [file join [file dirname [info nameofexecutable]] dltest]
-if ![file readable [file join $testDir pkga$ext]] {
- puts "libraries in $testDir haven't been compiled: skipping tests"
- return
-}
+set x [file join $testDir pkga$ext]
+set dll "[file tail $x]Required"
+set ::tcltest::testConstraints($dll) [file readable $x]
-if [string match *pkga* [set alreadyLoaded [info loaded]]] {
- puts "load tests have already been run once: skipping (can't rerun)"
- return
-}
+# Tests also require that this DLL has not already been loaded.
+set loaded "[file tail $x]Loaded"
+set alreadyLoaded [info loaded]
+set ::tcltest::testConstraints($loaded) \
+ [expr {![string match *pkga* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
-test load-1.1 {basic errors} {
+test load-1.1 {basic errors} [list $dll $loaded] {
list [catch {load} msg] $msg
} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
-test load-1.2 {basic errors} {
+test load-1.2 {basic errors} [list $dll $loaded] {
list [catch {load a b c d} msg] $msg
} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
-test load-1.3 {basic errors} {
+test load-1.3 {basic errors} [list $dll $loaded] {
list [catch {load a b foobar} msg] $msg
-} {1 {couldn't find slave interpreter named "foobar"}}
-test load-1.4 {basic errors} {
+} {1 {could not find interpreter "foobar"}}
+test load-1.4 {basic errors} [list $dll $loaded] {
list [catch {load {}} msg] $msg
} {1 {must specify either file name or package name}}
-test load-1.5 {basic errors} {
+test load-1.5 {basic errors} [list $dll $loaded] {
list [catch {load {} {}} msg] $msg
} {1 {must specify either file name or package name}}
-test load-1.6 {basic errors} {
+test load-1.6 {basic errors} [list $dll $loaded] {
list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
-test load-2.1 {basic loading, with guess for package name} {
+test load-2.1 {basic loading, with guess for package name} \
+ [list $dll $loaded] {
load [file join $testDir pkga$ext]
list [pkga_eq abc def] [info commands pkga_*]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
-test load-2.2 {loading into a safe interpreter, with package name conversion} {
+test load-2.2 {loading into a safe interpreter, with package name conversion} \
+ [list $dll $loaded] {
load [file join $testDir pkgb$ext] pKgB child
list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
[catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
-test load-2.3 {loading with no _Init procedure} {
+test load-2.3 {loading with no _Init procedure} [list $dll $loaded] {
list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
} {1 {couldn't find procedure Foo_Init}}
-test load-2.4 {loading with no _SafeInit procedure} {
+test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
-test load-3.1 {error in _Init procedure, same interpreter} {
- list [catch {load [file join $testDir pkge$ext] pkge} msg] $msg $errorInfo $errorCode
+test load-3.1 {error in _Init procedure, same interpreter} \
+ [list $dll $loaded] {
+ list [catch {load [file join $testDir pkge$ext] pkge} msg] \
+ $msg $errorInfo $errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
while executing
"open non_existent"
invoked from within
+"if 44 {open non_existent}"
+ invoked from within
"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
-test load-3.2 {error in _Init procedure, slave interpreter} {
+test load-3.2 {error in _Init procedure, slave interpreter} \
+ [list $dll $loaded] {
catch {interp delete x}
interp create x
set errorCode foo
@@ -90,16 +104,19 @@ test load-3.2 {error in _Init procedure, slave interpreter} {
while executing
"open non_existent"
invoked from within
+"if 44 {open non_existent}"
+ invoked from within
"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}
-test load-4.1 {reloading package into same interpreter} {
+test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
-test load-4.2 {reloading package into same interpreter} {
+test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
} "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}"
-test load-5.1 {file name not specified and no static package: pick default} {
+test load-5.1 {file name not specified and no static package: pick default} \
+ [list $dll $loaded] {
catch {interp delete x}
interp create x
load [file join $testDir pkga$ext] pkga
@@ -112,49 +129,68 @@ test load-5.1 {file name not specified and no static package: pick default} {
# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
-test load-6.1 {errors loading file} {nonPortable} {
+test load-6.1 {errors loading file} [list $dll $loaded nonPortable] {
catch {load foo foo}
} {1}
if {[info command teststaticpkg] != ""} {
- test load-7.1 {Tcl_StaticPackage procedure} {
+ test load-7.1 {Tcl_StaticPackage procedure} [list $dll $loaded] {
set x "not loaded"
teststaticpkg Test 1 0
load {} Test
load {} Test child
list [set x] [child eval set x]
} {loaded loaded}
- test load-7.2 {Tcl_StaticPackage procedure} {
+ test load-7.2 {Tcl_StaticPackage procedure} [list $dll $loaded] {
set x "not loaded"
teststaticpkg Another 0 0
load {} Another
child eval {set x "not loaded"}
- list [catch {load {} Another child} msg] $msg [child eval set x] [set x]
+ list [catch {load {} Another child} msg] $msg \
+ [child eval set x] [set x]
} {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
- test load-7.3 {Tcl_StaticPackage procedure} {
+ test load-7.3 {Tcl_StaticPackage procedure} [list $dll $loaded] {
set x "not loaded"
teststaticpkg More 0 1
load {} More
set x
} {not loaded}
- test load-7.4 {Tcl_StaticPackage procedure, redundant calls} {
+ test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
+ [list $dll $loaded] {
teststaticpkg Double 0 1
teststaticpkg Double 0 1
info loaded
} "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
- test load-8.1 {TclGetLoadedPackages procedure} {
+ test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] {
info loaded
} "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
- test load-8.2 {TclGetLoadedPackages procedure} {
+ test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] {
list [catch {info loaded gorp} msg] $msg
- } {1 {couldn't find slave interpreter named "gorp"}}
- test load-8.3 {TclGetLoadedPackages procedure} {
+ } {1 {could not find interpreter "gorp"}}
+ test load-8.3 {TclGetLoadedPackages procedure} [list $dll $loaded] {
list [info loaded {}] [info loaded child]
} "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}"
- test load-8.4 {TclGetLoadedPackages procedure} {
+ test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] {
load [file join $testDir pkgb$ext] pkgb
list [info loaded {}] [lsort [info commands pkgb_*]]
} "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
interp delete child
}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/lrange.test b/tcl/tests/lrange.test
index 84f08583417..e4bc3be37b7 100644
--- a/tcl/tests/lrange.test
+++ b/tcl/tests/lrange.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test lrange-1.1 {range of list elements} {
lrange {a b c d} 1 2
@@ -71,13 +75,18 @@ test lrange-2.2 {error conditions} {
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.3 {error conditions} {
list [catch {lrange a b 6} msg] $msg
-} {1 {bad index "b": must be integer or "end"}}
+} {1 {bad index "b": must be integer or end?-integer?}}
test lrange-2.4 {error conditions} {
list [catch {lrange a 0 enigma} msg] $msg
-} {1 {bad index "enigma": must be integer or "end"}}
+} {1 {bad index "enigma": must be integer or end?-integer?}}
test lrange-2.5 {error conditions} {
list [catch {lrange "a \{b c" 3 4} msg] $msg
} {1 {unmatched open brace in list}}
test lrange-2.6 {error conditions} {
list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
} {1 {unmatched open brace in list}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/lreplace.test b/tcl/tests/lreplace.test
index 23098878741..f91ed199624 100644
--- a/tcl/tests/lreplace.test
+++ b/tcl/tests/lreplace.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test lreplace-1.1 {lreplace command} {
lreplace {1 2 3 4 5} 0 0 a
@@ -106,13 +110,13 @@ test lreplace-2.2 {lreplace errors} {
} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
test lreplace-2.3 {lreplace errors} {
list [catch {lreplace x a 10} msg] $msg
-} {1 {bad index "a": must be integer or "end"}}
+} {1 {bad index "a": must be integer or end?-integer?}}
test lreplace-2.4 {lreplace errors} {
list [catch {lreplace x 10 x} msg] $msg
-} {1 {bad index "x": must be integer or "end"}}
+} {1 {bad index "x": must be integer or end?-integer?}}
test lreplace-2.5 {lreplace errors} {
list [catch {lreplace x 10 1x} msg] $msg
-} {1 {bad index "1x": must be integer or "end"}}
+} {1 {bad index "1x": must be integer or end?-integer?}}
test lreplace-2.6 {lreplace errors} {
list [catch {lreplace x 3 2} msg] $msg
} {1 {list doesn't contain element 3}}
@@ -128,4 +132,8 @@ test lreplace-3.1 {lreplace won't modify shared argument objects} {
p
} "a b c"
+# cleanup
catch {unset foo}
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/lsearch.test b/tcl/tests/lsearch.test
index 4d10d3894ee..eeef99e1a0f 100644
--- a/tcl/tests/lsearch.test
+++ b/tcl/tests/lsearch.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
set x {abcd bbcd 123 234 345}
test lsearch-1.1 {lsearch command} {
@@ -45,7 +49,7 @@ test lsearch-2.5 {search modes} {
} 1
test lsearch-2.6 {search modes} {
list [catch {lsearch -regexp {xyz bbcc *bc*} *bc*} msg] $msg
-} {1 {couldn't compile regular expression pattern: ?+* follows nothing}}
+} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
test lsearch-2.7 {search modes} {
lsearch -regexp {b.x ^bc xy bcx} ^bc
} 3
@@ -57,7 +61,7 @@ test lsearch-2.9 {search modes} {
} 1
test lsearch-2.10 {search modes} {
list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
-} {1 {bad search mode "-glib": must be -exact, -glob, -regexp, -dictionary, or -nocase}}
+} {1 {bad search mode "-glib": must be -exact, -glob, or -regexp}}
test lsearch-3.1 {lsearch errors} {
list [catch lsearch msg] $msg
@@ -67,7 +71,7 @@ test lsearch-3.2 {lsearch errors} {
} {1 {wrong # args: should be "lsearch ?mode? list pattern"}}
test lsearch-3.3 {lsearch errors} {
list [catch {lsearch a b c} msg] $msg
-} {1 {bad search mode "a": must be -exact, -glob, -regexp, -dictionary, or -nocase}}
+} {1 {bad search mode "a": must be -exact, -glob, or -regexp}}
test lsearch-3.4 {lsearch errors} {
list [catch {lsearch a b c d} msg] $msg
} {1 {wrong # args: should be "lsearch ?mode? list pattern"}}
@@ -84,3 +88,20 @@ test lsearch-4.2 {binary data} {
append x two
lsearch -exact [list foo one\000two bar] $x
} 1
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/macFCmd.test b/tcl/tests/macFCmd.test
index 89e50cdcdca..afb1b51c26c 100644
--- a/tcl/tests/macFCmd.test
+++ b/tcl/tests/macFCmd.test
@@ -5,6 +5,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -12,157 +13,198 @@
# RCS: @(#) $Id$
#
-if {$tcl_platform(platform) != "macintosh"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
catch {file delete -force foo.dir}
file mkdir foo.dir
if {[catch {file attributes foo.dir -readonly 1}]} {
- set testConfig(fileSharing) 0
- set testConfig(notFileSharing) 1
+ set ::tcltest::testConstraints(fileSharing) 0
+ set ::tcltest::testConstraints(notFileSharing) 1
} else {
- set testConfig(fileSharing) 1
- set testConfig(notFileSharing) 0
+ set ::tcltest::testConstraints(fileSharing) 1
+ set ::tcltest::testConstraints(notFileSharing) 0
}
file delete -force foo.dir
-test macFCmd-1.1 {GetFileFinderAttributes - no file} {
+test macFCmd-1.1 {GetFileFinderAttributes - no file} {macOnly} {
catch {file delete -force foo.file}
list [catch {file attributes foo.file -creator} msg] $msg
-} {1 {couldn't get attributes for file ":foo.file": no such file or directory}}
-test macFCmd-1.2 {GetFileFinderAttributes - creator} {
+} {1 {could not read ":foo.file": no such file or directory}}
+test macFCmd-1.2 {GetFileFinderAttributes - creator} {macOnly} {
catch {file delete -force foo.file}
catch {close [open foo.file w]}
- list [catch {file attributes foo.file -creator} msg] $msg [file delete -force foo.file]
+ list [catch {file attributes foo.file -creator} msg] $msg \
+ [file delete -force foo.file]
} {0 {MPW } {}}
-test macFCmd-1.3 {GetFileFinderAttributes - type} {
+test macFCmd-1.3 {GetFileFinderAttributes - type} {macOnly} {
catch {file delete -force foo.file}
catch {close [open foo.file w]}
- list [catch {file attributes foo.file -type} msg] $msg [file delete -force foo.file]
+ list [catch {file attributes foo.file -type} msg] $msg \
+ [file delete -force foo.file]
} {0 TEXT {}}
-test macFCmd-1.4 {GetFileFinderAttributes - not hidden} {
+test macFCmd-1.4 {GetFileFinderAttributes - not hidden} {macOnly} {
catch {file delete -force foo.file}
catch {close [open foo.file w]}
- list [catch {file attributes foo.file -hidden} msg] $msg [file delete -force foo.file]
+ list [catch {file attributes foo.file -hidden} msg] $msg \
+ [file delete -force foo.file]
} {0 0 {}}
-test macFCmd-1.5 {GetFileFinderAttributes - hidden} {
+test macFCmd-1.5 {GetFileFinderAttributes - hidden} {macOnly} {
catch {file delete -force foo.file}
catch {close [open foo.file w]}
file attributes foo.file -hidden 1
- list [catch {file attributes foo.file -hidden} msg] $msg [file delete -force foo.file]
+ list [catch {file attributes foo.file -hidden} msg] $msg \
+ [file delete -force foo.file]
} {0 1 {}}
-test macFCmd-1.6 {GetFileFinderAttributes - folder creator} {
+test macFCmd-1.6 {GetFileFinderAttributes - folder creator} {macOnly} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -creator} msg] $msg [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -creator} msg] $msg \
+ [file delete -force foo.dir]
} {0 Fldr {}}
-test macFCmd-1.7 {GetFileFinderAttributes - folder type} {
+test macFCmd-1.7 {GetFileFinderAttributes - folder type} {macOnly} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -type} msg] $msg [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -type} msg] $msg \
+ [file delete -force foo.dir]
} {0 Fldr {}}
-test macFCmd-1.8 {GetFileFinderAttributes - folder hidden} {
+test macFCmd-1.8 {GetFileFinderAttributes - folder hidden} {macOnly} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -hidden} msg] $msg [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -hidden} msg] $msg \
+ [file delete -force foo.dir]
} {0 0 {}}
-test macFCmd-2.1 {GetFileReadOnly - bad file} {
+test macFCmd-2.1 {GetFileReadOnly - bad file} {macOnly} {
catch {file delete -force foo.file}
list [catch {file attributes foo.file -readonly} msg] $msg
-} {1 {couldn't get attributes for file ":foo.file": no such file or directory}}
-test macFCmd-2.2 {GetFileReadOnly - file not read only} {
+} {1 {could not read ":foo.file": no such file or directory}}
+test macFCmd-2.2 {GetFileReadOnly - file not read only} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
- list [catch {file attributes foo.file -readonly} msg] $msg [file delete -force foo.file]
+ list [catch {file attributes foo.file -readonly} msg] $msg \
+ [file delete -force foo.file]
} {0 0 {}}
-test macFCmd-2.3 {GetFileReadOnly - file read only} {
+test macFCmd-2.3 {GetFileReadOnly - file read only} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
file attributes foo.file -readonly 1
- list [catch {file attributes foo.file -readonly} msg] $msg [file delete -force foo.file]
+ list [catch {file attributes foo.file -readonly} msg] $msg \
+ [file delete -force foo.file]
} {0 1 {}}
-test macFCmd-2.4 {GetFileReadOnly - directory not read only} {
+test macFCmd-2.4 {GetFileReadOnly - directory not read only} {macOnly} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly} msg] $msg [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -readonly} msg] $msg \
+ [file delete -force foo.dir]
} {0 0 {}}
-test macFCmd-2.5 {GetFileReadOnly - directory read only} {fileSharing} {
+test macFCmd-2.5 {GetFileReadOnly - directory read only} {macOnly fileSharing} {
catch {file delete -force foo.dir}
file mkdir foo.dir
file attributes foo.dir -readonly 1
- list [catch {file attributes foo.dir -readonly} msg] $msg [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -readonly} msg] $msg \
+ [file delete -force foo.dir]
} {0 1 {}}
-test macFCmd-3.1 {SetFileFinderAttributes - bad file} {
+test macFCmd-3.1 {SetFileFinderAttributes - bad file} {macOnly} {
catch {file delete -force foo.file}
list [catch {file attributes foo.file -creator FOOO} msg] $msg
-} {1 {couldn't set attributes for file ":foo.file": no such file or directory}}
-test macFCmd-3.2 {SetFileFinderAttributes - creator} {
+} {1 {could not read ":foo.file": no such file or directory}}
+test macFCmd-3.2 {SetFileFinderAttributes - creator} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
- list [catch {file attributes foo.file -creator FOOO} msg] $msg [file attributes foo.file -creator] [file delete -force foo.file]
+ list [catch {file attributes foo.file -creator FOOO} msg] $msg \
+ [file attributes foo.file -creator] [file delete -force foo.file]
} {0 {} FOOO {}}
-test macFCmd-3.3 {SetFileFinderAttributes - bad creator} {
+test macFCmd-3.3 {SetFileFinderAttributes - bad creator} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
- list [catch {file attributes foo.file -creator 0} msg] $msg [file delete -force foo.file]
+ list [catch {file attributes foo.file -creator 0} msg] $msg \
+ [file delete -force foo.file]
} {1 {expected Macintosh OS type but got "0"} {}}
-test macFCmd-3.4 {SetFileFinderAttributes - hidden} {
+test macFCmd-3.4 {SetFileFinderAttributes - hidden} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
- list [catch {file attributes foo.file -hidden 1} msg] $msg [file attributes foo.file -hidden] [file delete -force foo.file]
+ list [catch {file attributes foo.file -hidden 1} msg] $msg \
+ [file attributes foo.file -hidden] [file delete -force foo.file]
} {0 {} 1 {}}
-test macFCmd-3.5 {SetFileFinderAttributes - type} {
+test macFCmd-3.5 {SetFileFinderAttributes - type} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
- list [catch {file attributes foo.file -type FOOO} msg] $msg [file attributes foo.file -type] [file delete -force foo.file]
+ list [catch {file attributes foo.file -type FOOO} msg] $msg \
+ [file attributes foo.file -type] [file delete -force foo.file]
} {0 {} FOOO {}}
-test macFCmd-3.6 {SetFileFinderAttributes - bad type} {
+test macFCmd-3.6 {SetFileFinderAttributes - bad type} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
- list [catch {file attributes foo.file -type 0} msg] $msg [file delete -force foo.file]
+ list [catch {file attributes foo.file -type 0} msg] $msg \
+ [file delete -force foo.file]
} {1 {expected Macintosh OS type but got "0"} {}}
-test macFCmd-3.7 {SetFileFinderAttributes - directory} {
+test macFCmd-3.7 {SetFileFinderAttributes - directory} {macOnly} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -creator FOOO} msg] $msg [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -creator FOOO} msg] \
+ $msg [file delete -force foo.dir]
} {1 {cannot set -creator: ":foo.dir" is a directory} {}}
-test macFCmd-4.1 {SetFileReadOnly - bad file} {
+test macFCmd-4.1 {SetFileReadOnly - bad file} {macOnly} {
catch {file delete -force foo.file}
list [catch {file attributes foo.file -readonly 1} msg] $msg
-} {1 {couldn't set attributes for file ":foo.file": no such file or directory}}
-test macFCmd-4.2 {SetFileReadOnly - file not readonly} {
+} {1 {could not read ":foo.file": no such file or directory}}
+test macFCmd-4.2 {SetFileReadOnly - file not readonly} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
- list [catch {file attributes foo.file -readonly 0} msg] $msg [file attributes foo.file -readonly] [file delete -force foo.file]
+ list [catch {file attributes foo.file -readonly 0} msg] \
+ $msg [file attributes foo.file -readonly] [file delete -force foo.file]
} {0 {} 0 {}}
-test macFCmd-4.3 {SetFileReadOnly - file readonly} {
+test macFCmd-4.3 {SetFileReadOnly - file readonly} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
- list [catch {file attributes foo.file -readonly 1} msg] $msg [file attributes foo.file -readonly] [file delete -force foo.file]
+ list [catch {file attributes foo.file -readonly 1} msg] \
+ $msg [file attributes foo.file -readonly] [file delete -force foo.file]
} {0 {} 1 {}}
-test macFCmd-4.4 {SetFileReadOnly - directory not readonly} {fileSharing} {
+test macFCmd-4.4 {SetFileReadOnly - directory not readonly} \
+ {macOnly fileSharing} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly 0} msg] $msg [file attributes foo.dir -readonly] [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -readonly 0} msg] \
+ $msg [file attributes foo.dir -readonly] [file delete -force foo.dir]
} {0 {} 0 {}}
-test macFCmd-4.5 {SetFileReadOnly - directory not readonly} {notFileSharing} {
+test macFCmd-4.5 {SetFileReadOnly - directory not readonly} \
+ {macOnly notFileSharing} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly 0} msg] $msg [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -readonly 0} msg] $msg \
+ [file delete -force foo.dir]
} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}
-test macFCmd-4.6 {SetFileReadOnly - directory readonly} {fileSharing} {
+test macFCmd-4.6 {SetFileReadOnly - directory readonly} {macOnly fileSharing} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly 1} msg] $msg [file attributes foo.dir -readonly] [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -readonly 1} msg] $msg \
+ [file attributes foo.dir -readonly] [file delete -force foo.dir]
} {0 {} 1 {}}
-test macFCmd-4.7 {SetFileReadOnly - directory readonly} {notFileSharing} {
+test macFCmd-4.7 {SetFileReadOnly - directory readonly} {macOnly notFileSharing} {
catch {file delete -force foo.dir}
file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly 1} msg] $msg [file delete -force foo.dir]
+ list [catch {file attributes foo.dir -readonly 1} msg] $msg \
+ [file delete -force foo.dir]
} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/misc.test b/tcl/tests/misc.test
index a18f3940b81..7ba5f9736da 100644
--- a/tcl/tests/misc.test
+++ b/tcl/tests/misc.test
@@ -7,13 +7,17 @@
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test misc-1.1 {error in variable ref. in command in array reference} {
proc tstProc {} {
@@ -48,4 +52,26 @@ test misc-1.2 {error in variable ref. in command in array reference} {
"
set msg {}
list [catch tstProc msg] $msg $errorInfo
-} {1 {missing close-bracket or close-brace} missing\ close-bracket\ or\ close-brace\n\ \ \ \ while\ compiling\n\"set\ tst\ \$a(\[winfo\ name\ \$\{zz)\"\n\ \ \ \ (compiling\ body\ of\ proc\ \"tstProc\",\ line\ 4)\n\ \ \ \ invoked\ from\ within\n\"tstProc\"}
+} {1 {missing close-brace for variable name} {missing close-brace for variable name
+ while compiling
+"set tst $a([winfo name "
+ (compiling body of proc "tstProc", line 4)
+ invoked from within
+"tstProc"}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/msgcat.test b/tcl/tests/msgcat.test
new file mode 100644
index 00000000000..b2f0b20fcd9
--- /dev/null
+++ b/tcl/tests/msgcat.test
@@ -0,0 +1,413 @@
+# Commands covered: ::msgcat::mc ::msgcat::mclocale
+# ::msgcat::mcpreferences ::msgcat::mcload
+# ::msgcat::mcset ::msgcat::mcunknown
+#
+# This file contains a collection of tests for the msgcat script library.
+# Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1998 Mark Harrison.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+if {[catch {package require msgcat 1.0}]} {
+ if {[info exist msgcat1]} {
+ catch {puts "Cannot load msgcat 1.0 package"}
+ return
+ } else {
+ catch {puts "Running msgcat 1.0 tests in slave interp"}
+ set interp [interp create msgcat1]
+ $interp eval [list set msgcat1 "running"]
+ $interp eval [list source [info script]]
+ interp delete $interp
+ return
+ }
+}
+
+set oldlocale [::msgcat::mclocale]
+
+# some tests fail in tne environment variable LANG exists and is not C
+
+if {[info exists env(LANG)] && ($env(LANG) != "C")} {
+ set ::tcltest::testConstraints(LANGisC) 0
+} else {
+ set ::tcltest::testConstraints(LANGisC) 1
+}
+
+#
+# Test the various permutations of mclocale
+# and mcpreferences.
+#
+
+test msgcat-1.1 {::msgcat::mclocale default} {LANGisC} {
+ ::msgcat::mclocale
+} {c}
+test msgcat-1.2 {::msgcat::mcpreferences, single element} {LANGisC} {
+ ::msgcat::mcpreferences
+} {c}
+test msgcat-1.3 {::msgcat::mclocale, single element} {
+ ::msgcat::mclocale en
+} {en}
+test msgcat-1.4 {::msgcat::mclocale, single element} {
+ ::msgcat::mclocale
+} {en}
+test msgcat-1.5 {::msgcat::mcpreferences, single element} {
+ ::msgcat::mcpreferences
+} {en}
+test msgcat-1.6 {::msgcat::mclocale, two elements} {
+ ::msgcat::mclocale en_US
+} {en_us}
+test msgcat-1.7 {::msgcat::mclocale, two elements} {
+ ::msgcat::mclocale en_US
+ ::msgcat::mclocale
+} {en_us}
+test msgcat-1.8 {::msgcat::mcpreferences, two elements} {
+ ::msgcat::mcpreferences
+} {en_us en}
+test msgcat-1.9 {::msgcat::mclocale, three elements} {
+ ::msgcat::mclocale en_US_funky
+} {en_us_funky}
+test msgcat-1.10 {::msgcat::mclocale, three elements} {
+ ::msgcat::mclocale
+} {en_us_funky}
+test msgcat-1.11 {::msgcat::mcpreferences, three elements} {
+ ::msgcat::mcpreferences
+} {en_us_funky en_us en}
+
+#
+# Test mcset and mcc, ensuring that namespace partitioning
+# is working.
+#
+
+test msgcat-2.1 {::msgcat::mcset, global scope} {
+ ::msgcat::mcset foo_BAR text1 text2
+} {text2}
+test msgcat-2.2 {::msgcat::mcset, global scope, default} {
+ ::msgcat::mcset foo_BAR text3
+} {text3}
+test msgcat-2.2 {::msgcat::mcset, namespace overlap} {
+ namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar}
+ namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz}
+} {con1baz}
+test msgcat-2.3 {::msgcat::mcset, namespace overlap} {
+ ::msgcat::mclocale foo_BAR
+ namespace eval bar {::msgcat::mc con1}
+} {con1bar}
+test msgcat-2.4 {::msgcat::mcset, namespace overlap} {
+ ::msgcat::mclocale foo_BAR
+ namespace eval baz {::msgcat::mc con1}
+} {con1baz}
+
+#
+# Test mcset and mc, ensuring that more specific locales
+# (e.g. "en_UK") will search less specific locales
+# (e.g. "en") for translation strings.
+#
+# Do this for the 12 permutations of
+# locales: {foo foo_BAR foo_BAR_baz}
+# strings: {ov1 ov2 ov3 ov4}
+# locale foo defines ov1, ov2, ov3
+# locale foo_BAR defines ov2, ov3
+# locale foo_BAR_BAZ defines ov3
+# (ov4 is defined in none)
+# So,
+# ov3 should be resolved in foo, foo_BAR, foo_BAR_baz
+# ov2 should be resolved in foo, foo_BAR
+# ov2 should resolve to foo_BAR in foo_BAR_baz
+# ov1 should be resolved in foo
+# ov1 should resolve to foo in foo_BAR, foo_BAR_baz
+# ov4 should be resolved in none, and call mcunknown
+#
+
+test msgcat-3.1 {::msgcat::mcset, overlap} {
+ ::msgcat::mcset foo ov1 ov1_foo
+ ::msgcat::mcset foo ov2 ov2_foo
+ ::msgcat::mcset foo ov3 ov3_foo
+ ::msgcat::mcset foo_BAR ov2 ov2_foo_BAR
+ ::msgcat::mcset foo_BAR ov3 ov3_foo_BAR
+ ::msgcat::mcset foo_BAR_baz ov3 ov3_foo_BAR_baz
+} {ov3_foo_BAR_baz}
+# top level, locale foo
+test msgcat-3.2 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo
+ ::msgcat::mc ov1
+} {ov1_foo}
+test msgcat-3.3 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo
+ ::msgcat::mc ov2
+} {ov2_foo}
+test msgcat-3.4 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo
+ ::msgcat::mc ov3
+} {ov3_foo}
+test msgcat-3.5 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo
+ ::msgcat::mc ov4
+} {ov4}
+# second level, locale foo_BAR
+test msgcat-3.6 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo_BAR
+ ::msgcat::mc ov1
+} {ov1_foo}
+test msgcat-3.7 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo_BAR
+ ::msgcat::mc ov2
+} {ov2_foo_BAR}
+test msgcat-3.8 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo_BAR
+ ::msgcat::mc ov3
+} {ov3_foo_BAR}
+test msgcat-3.9 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo_BAR
+ ::msgcat::mc ov4
+} {ov4}
+# third level, locale foo_BAR_baz
+test msgcat-3.10 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo_BAR_baz
+ ::msgcat::mc ov1
+} {ov1_foo}
+test msgcat-3.11 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo_BAR_baz
+ ::msgcat::mc ov2
+} {ov2_foo_BAR}
+test msgcat-3.12 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo_BAR_baz
+ ::msgcat::mc ov3
+} {ov3_foo_BAR_baz}
+test msgcat-3.13 {::msgcat::mcset, overlap} {
+ ::msgcat::mclocale foo_BAR_baz
+ ::msgcat::mc ov4
+} {ov4}
+
+#
+# Test mcunknown, first the default operation
+# and then with an overridden definition.
+#
+
+test msgcat-4.1 {::msgcat::mcunknown, default} {
+ ::msgcat::mcset foo unk1 "unknown 1"
+} {unknown 1}
+test msgcat-4.2 {::msgcat::mcunknown, default} {
+ ::msgcat::mclocale foo
+ ::msgcat::mc unk1
+} {unknown 1}
+test msgcat-4.3 {::msgcat::mcunknown, default} {
+ ::msgcat::mclocale foo
+ ::msgcat::mc unk2
+} {unk2}
+test msgcat-4.4 {::msgcat::mcunknown, overridden} {
+ rename ::msgcat::mcunknown oldproc
+ proc ::msgcat::mcunknown {dom s} {
+ return "unknown:$dom:$s"
+ }
+ ::msgcat::mclocale foo
+ set result [::msgcat::mc unk1]
+ rename ::msgcat::mcunknown {}
+ rename oldproc ::msgcat::mcunknown
+ set result
+} {unknown 1}
+test msgcat-4.5 {::msgcat::mcunknown, overridden} {
+ rename ::msgcat::mcunknown oldproc
+ proc ::msgcat::mcunknown {dom s} {
+ return "unknown:$dom:$s"
+ }
+ ::msgcat::mclocale foo
+ set result [::msgcat::mc unk2]
+ rename ::msgcat::mcunknown {}
+ rename oldproc ::msgcat::mcunknown
+ set result
+} {unknown:foo:unk2}
+test msgcat-4.6 {::msgcat::mcunknown, uplevel context} {
+ rename ::msgcat::mcunknown oldproc
+ proc ::msgcat::mcunknown {dom s} {
+ return "unknown:$dom:$s:[info level]"
+ }
+ ::msgcat::mclocale foo
+ set result [::msgcat::mc unk2]
+ rename ::msgcat::mcunknown {}
+ rename oldproc ::msgcat::mcunknown
+ set result
+} {unknown:foo:unk2:1}
+
+
+#
+# Test mcload. Need to set up an environment for
+# these tests by creating a temporary directory and
+# message files.
+#
+
+set locales {en en_US en_US_funky}
+
+catch {file mkdir msgdir}
+foreach l $locales {
+ set fd [open [string tolower [file join msgdir $l.msg]] w]
+ puts $fd "::msgcat::mcset $l abc abc-$l"
+ close $fd
+}
+
+test msgcat-5.1 {::msgcat::mcload} {
+ ::msgcat::mclocale en
+ ::msgcat::mcload msgdir
+} {1}
+test msgcat-5.2 {::msgcat::mcload} {
+ ::msgcat::mclocale en_US
+ ::msgcat::mcload msgdir
+} {2}
+test msgcat-5.3 {::msgcat::mcload} {
+ ::msgcat::mclocale en_US_funky
+ ::msgcat::mcload msgdir
+} {3}
+
+# Even though en_US_notexist does not exist,
+# en_US and en should be loaded.
+
+test msgcat-5.4 {::msgcat::mcload} {
+ ::msgcat::mclocale en_US_notexist
+ ::msgcat::mcload msgdir
+} {2}
+test msgcat-5.5 {::msgcat::mcload} {
+ ::msgcat::mclocale no_FI_notexist
+ ::msgcat::mcload msgdir
+} {0}
+test msgcat-5.6 {::msgcat::mcload} {
+ ::msgcat::mclocale en
+ ::msgcat::mc abc
+} {abc-en}
+test msgcat-5.7 {::msgcat::mcload} {
+ ::msgcat::mclocale en_US
+ ::msgcat::mc abc
+} {abc-en_US}
+test msgcat-5.8 {::msgcat::mcload} {
+ ::msgcat::mclocale en_US_funky
+ ::msgcat::mc abc
+} {abc-en_US_funky}
+test msgcat-5.9 {::msgcat::mcload} {
+ rename ::msgcat::mcunknown oldproc
+ proc ::msgcat::mcunknown {dom s} {
+ return "unknown:$dom:$s"
+ }
+ ::msgcat::mclocale no_FI_notexist
+ set result [::msgcat::mc abc]
+ rename ::msgcat::mcunknown {}
+ rename oldproc ::msgcat::mcunknown
+ set result
+} {unknown:no_fi_notexist:abc}
+
+# cleanup temp files
+foreach l $locales {
+ file delete [string tolower [file join msgdir $l.msg]]
+}
+# Clean out the msg catalogs
+file delete msgdir
+
+#
+# Test mcset and mc, ensuring that resolution for messages
+# proceeds from the current ns to its parent and so on to the
+# global ns.
+#
+# Do this for the 12 permutations of
+# locales: foo
+# namespaces: ::foo ::foo::bar ::foo::bar::baz
+# strings: {ov1 ov2 ov3 ov4}
+# namespace ::foo defines ov1, ov2, ov3
+# namespace ::foo::bar defines ov2, ov3
+# namespace ::foo::bar::baz defines ov3
+#
+# ov4 is not defined in any namespace.
+#
+# So,
+# ov3 should be resolved in ::foo::bar::baz, ::foo::bar, ::foo;
+# ov2 should be resolved in ::foo, ::foo::bar
+# ov1 should be resolved in ::foo
+# ov4 should be resolved in none, and call mcunknown
+#
+
+namespace eval ::foo {
+ ::msgcat::mcset foo ov1 "ov1_foo"
+ ::msgcat::mcset foo ov2 "ov2_foo"
+ ::msgcat::mcset foo ov3 "ov3_foo"
+}
+namespace eval ::foo::bar {
+ ::msgcat::mcset foo ov2 "ov2_foo_bar"
+ ::msgcat::mcset foo ov3 "ov3_foo_bar"
+}
+namespace eval ::foo::bar::baz {
+ ::msgcat::mcset foo ov3 "ov3_foo_bar_baz"
+}
+::msgcat::mclocale foo
+
+# namespace ::foo
+test msgcat-6.1 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo {::msgcat::mc ov1}
+} {ov1_foo}
+test msgcat-6.2 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo {::msgcat::mc ov2}
+} {ov2_foo}
+test msgcat-6.3 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo {::msgcat::mc ov3}
+} {ov3_foo}
+test msgcat-6.4 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo {::msgcat::mc ov4}
+} {ov4}
+# namespace ::foo::bar
+test msgcat-6.5 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo::bar {::msgcat::mc ov1}
+} {ov1_foo}
+test msgcat-6.6 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo::bar {::msgcat::mc ov2}
+} {ov2_foo_bar}
+test msgcat-6.7 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo::bar {::msgcat::mc ov3}
+} {ov3_foo_bar}
+test msgcat-6.8 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo::bar {::msgcat::mc ov4}
+} {ov4}
+# namespace ::foo
+test msgcat-6.9 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo::bar::baz {::msgcat::mc ov1}
+} {ov1_foo}
+test msgcat-6.10 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo::bar::baz {::msgcat::mc ov2}
+} {ov2_foo_bar}
+test msgcat-6.11 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo::bar::baz {::msgcat::mc ov3}
+} {ov3_foo_bar_baz}
+test msgcat-6.12 {::msgcat::mc, namespace resolution} {
+ namespace eval ::foo::bar::baz {::msgcat::mc ov4}
+} {ov4}
+
+namespace delete ::foo::bar::baz ::foo::bar ::foo
+
+::msgcat::mclocale foo
+::msgcat::mcset foo format1 "this is a test"
+::msgcat::mcset foo format2 "this is a %s"
+::msgcat::mcset foo format3 "this is a %s %s"
+
+test msgcat-7.1 {::msgcat::mc, extra args go through to format} {
+ ::msgcat::mc format1 "good test"
+} "this is a test"
+test msgcat-7.2 {::msgcat::mc, extra args go through to format} {
+ ::msgcat::mc format2 "good test"
+} "this is a good test"
+test msgcat-7.3 {::msgcat::mc, errors from format are propagated} {
+ catch {::msgcat::mc format3 "good test"}
+} 1
+test msgcat-7.4 {::msgcat::mc, extra args are given to unknown} {
+ ::msgcat::mc "this is a %s" "good test"
+} "this is a good test"
+
+# Reset the locale
+::msgcat::mclocale $oldlocale
+
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/namespace-old.test b/tcl/tests/namespace-old.test
index 5a4b1124968..76febca8681 100644
--- a/tcl/tests/namespace-old.test
+++ b/tcl/tests/namespace-old.test
@@ -9,13 +9,17 @@
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1997 Lucent Technologies
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Clear out any namespaces called test_ns_*
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -842,3 +846,20 @@ catch {unset x}
catch {unset test_ns_var_global}
catch {unset cmd}
eval namespace delete [namespace children :: test_ns_*]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/namespace.test b/tcl/tests/namespace.test
index bc8fc18e1b5..0e32f270a5a 100644
--- a/tcl/tests/namespace.test
+++ b/tcl/tests/namespace.test
@@ -6,13 +6,17 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Clear out any namespaces called test_ns_*
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -77,14 +81,14 @@ test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
test namespace-6.1 {Tcl_CreateNamespace} {
catch {eval namespace delete [namespace children :: test_ns_*]}
list [lsort [namespace children :: test_ns_*]] \
- [namespace eval test_ns_1 {namespace current}] \
- [namespace eval test_ns_2 {namespace current}] \
- [namespace eval ::test_ns_3 {namespace current}] \
- [namespace eval ::test_ns_4 \
- {namespace eval foo {namespace current}}] \
- [namespace eval ::test_ns_5 \
- {namespace eval ::test_ns_6 {namespace current}}] \
- [lsort [namespace children :: test_ns_*]]
+ [namespace eval test_ns_1 {namespace current}] \
+ [namespace eval test_ns_2 {namespace current}] \
+ [namespace eval ::test_ns_3 {namespace current}] \
+ [namespace eval ::test_ns_4 \
+ {namespace eval foo {namespace current}}] \
+ [namespace eval ::test_ns_5 \
+ {namespace eval ::test_ns_6 {namespace current}}] \
+ [lsort [namespace children :: test_ns_*]]
} {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}}
test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
list [namespace eval :::test_ns_1::::foo {namespace current}] \
@@ -99,8 +103,8 @@ test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
namespace eval test_ns_2:: {}
namespace eval test_ns_3:: {}
}
- namespace children ::test_ns_1
-} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}
+ lsort [namespace children ::test_ns_1]
+} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}]
test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
set trigger {
namespace eval test_ns_2 {namespace current}
@@ -185,10 +189,10 @@ test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away}
namespace import ::test_ns_export::*
proc p {} {return foo}
}
- list [info commands test_ns_import::*] \
+ list [lsort [info commands test_ns_import::*]] \
[namespace delete test_ns_export] \
[info commands test_ns_import::*]
-} {{::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2} {} ::test_ns_import::p}
+} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
test namespace-9.1 {Tcl_Import, empty import pattern} {
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -259,12 +263,12 @@ test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
namespace import ::test_ns_export::*
proc p {} {return [cmd1 123]}
set l {}
- lappend l [info commands ::test_ns_import::*]
+ lappend l [lsort [info commands ::test_ns_import::*]]
namespace forget ::test_ns_export::cmd1
lappend l [info commands ::test_ns_import::*]
lappend l [catch {cmd1 777} msg] $msg
}
-} {{::test_ns_import::p ::test_ns_import::cmd1} ::test_ns_import::p 1 {invalid command name "cmd1"}}
+} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -322,9 +326,9 @@ test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
}
namespace eval test_ns_1 {
list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
- [namespace children :: test_ns_*]
+ [lsort [namespace children :: test_ns_*]]
}
-} {10 30 20 {::test_ns_1 ::test_ns_2}}
+} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
namespace eval test_ns_1 {
list [catch {set ::test_ns_777::v} msg] $msg \
@@ -671,8 +675,8 @@ test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
} {::test_ns_1::test_ns_foo}
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
namespace eval test_ns_1::test_ns_foo {}
- namespace children test_ns_1 test*
-} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
+ lsort [namespace children test_ns_1 test*]
+} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
test namespace-22.1 {NamespaceCodeCmd, bad args} {
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -797,13 +801,13 @@ test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumula
namespace eval test_ns_2 {
namespace import -force ::test_ns_1::*
}
- list [info commands test_ns_2::*] [test_ns_2::cmd3 hello]
-} {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
-test namespace-26.6 {NamespaceExportCmd, no patterns means return export list} {
+ list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
+} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
+test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
namespace eval test_ns_1 {
namespace export
}
-} {cmd1 cmd1 cmd3}
+} {cmd1 cmd3}
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
namespace eval test_ns_1 {
namespace export -clear cmd4
@@ -811,8 +815,8 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
namespace eval test_ns_2 {
namespace import ::test_ns_1::*
}
- list [info commands test_ns_2::*] [test_ns_2::cmd4 hello]
-} {{::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd4: hello}}
+ list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
+} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
test namespace-27.1 {NamespaceForgetCmd, no args} {
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -1090,8 +1094,24 @@ test namespace-38.1 {UpdateStringOfNsName} {
[namespace eval {} {namespace current}]
} {:: ::}
+# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
eval namespace delete [namespace children :: test_ns_*]
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/obj.test b/tcl/tests/obj.test
index 8ea4ff1c0a3..74ec8685e00 100644
--- a/tcl/tests/obj.test
+++ b/tcl/tests/obj.test
@@ -6,20 +6,25 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testobj] == {}} {
puts "This application hasn't been compiled with the \"testobj\""
puts "command, so I can't test the Tcl type and object support."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
set r 1
foreach {t} {list boolean cmdName bytecode string int double} {
@@ -83,31 +88,55 @@ test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
lappend result [testobj refcount 2]
} {{} {} {} {} 2 3}
-test obj-7.1 {Tcl_GetStringFromObj, return existing string rep} {
+test obj-7.1 {Tcl_GetString, return existing string rep} {
+ set result ""
+ lappend result [testintobj set 1 47]
+ lappend result [testintobj get2 1]
+} {47 47}
+test obj-7.2 {Tcl_GetString, "empty string" object} {
+ set result ""
+ lappend result [testobj newobj 1]
+ lappend result [teststringobj append 1 abc -1]
+ lappend result [teststringobj get2 1]
+} {{} abc abc}
+test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} {
+ set result ""
+ lappend result [teststringobj set 1 xyz]
+ lappend result [teststringobj append 1 abc -1]
+ lappend result [teststringobj get2 1]
+} {xyz xyzabc xyzabc}
+test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} {
+ set result ""
+ lappend result [testintobj set 1 77]
+ lappend result [testintobj mult10 1]
+ lappend result [teststringobj get2 1]
+} {77 770 770}
+
+test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} {
set result ""
lappend result [testintobj set 1 47]
lappend result [testintobj get 1]
} {47 47}
-test obj-7.2 {Tcl_GetStringFromObj, "empty string" object} {
+test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} {
set result ""
lappend result [testobj newobj 1]
lappend result [teststringobj append 1 abc -1]
lappend result [teststringobj get 1]
} {{} abc abc}
-test obj-7.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
+test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
set result ""
lappend result [teststringobj set 1 xyz]
lappend result [teststringobj append 1 abc -1]
lappend result [teststringobj get 1]
} {xyz xyzabc xyzabc}
-test obj-7.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
+test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
set result ""
lappend result [testintobj set 1 77]
lappend result [testintobj mult10 1]
lappend result [teststringobj get 1]
} {77 770 770}
-test obj-8.1 {Tcl_NewBooleanObj} {
+test obj-9.1 {Tcl_NewBooleanObj} {
set result ""
lappend result [testobj freeallvars]
lappend result [testbooleanobj set 1 0]
@@ -115,7 +144,7 @@ test obj-8.1 {Tcl_NewBooleanObj} {
lappend result [testobj refcount 1]
} {{} 0 boolean 2}
-test obj-9.1 {Tcl_SetBooleanObj, existing "empty string" object} {
+test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -123,7 +152,7 @@ test obj-9.1 {Tcl_SetBooleanObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 0 boolean 2}
-test obj-9.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
+test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 98765]
@@ -132,50 +161,50 @@ test obj-9.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 98765 1 boolean 2}
-test obj-10.1 {Tcl_GetBooleanFromObj, existing boolean object} {
+test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} {
set result ""
lappend result [testbooleanobj set 1 1]
lappend result [testbooleanobj not 1] ;# gets existing boolean rep
} {1 0}
-test obj-10.2 {Tcl_GetBooleanFromObj, convert to boolean} {
+test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} {
set result ""
lappend result [testintobj set 1 47]
lappend result [testbooleanobj not 1] ;# must convert to bool
lappend result [testobj type 1]
} {47 0 boolean}
-test obj-10.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
+test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {abc 1 {expected boolean value but got "abc"}}
-test obj-10.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
+test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {{} 1 {expected boolean value but got ""}}
-test obj-11.1 {DupBooleanInternalRep} {
+test obj-12.1 {DupBooleanInternalRep} {
set result ""
lappend result [testbooleanobj set 1 1]
lappend result [testobj duplicate 1 2] ;# uses DupBooleanInternalRep
lappend result [testbooleanobj get 2]
} {1 1 1}
-test obj-12.1 {SetBooleanFromAny, int to boolean special case} {
+test obj-13.1 {SetBooleanFromAny, int to boolean special case} {
set result ""
lappend result [testintobj set 1 1234]
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
} {1234 0 boolean}
-test obj-12.2 {SetBooleanFromAny, double to boolean special case} {
+test obj-13.2 {SetBooleanFromAny, double to boolean special case} {
set result ""
lappend result [testdoubleobj set 1 3.14159]
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
} {3.14159 0 boolean}
-test obj-12.3 {SetBooleanFromAny, special case strings representing booleans} {
+test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} {
set result ""
foreach s {yes no true false on off} {
teststringobj set 1 $s
@@ -183,40 +212,46 @@ test obj-12.3 {SetBooleanFromAny, special case strings representing booleans} {
}
lappend result [testobj type 1]
} {0 1 0 1 0 1 boolean}
-test obj-12.4 {SetBooleanFromAny, recompute string rep then parse it} {
+test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} {
set result ""
lappend result [testintobj set 1 456]
lappend result [testintobj div10 1]
lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
lappend result [testobj type 1]
} {456 45 0 boolean}
-test obj-12.5 {SetBooleanFromAny, error parsing string} {
+test obj-13.5 {SetBooleanFromAny, error parsing string} {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {abc 1 {expected boolean value but got "abc"}}
-test obj-12.6 {SetBooleanFromAny, error parsing string} {
+test obj-13.6 {SetBooleanFromAny, error parsing string} {
set result ""
lappend result [teststringobj set 1 x1.0]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {x1.0 1 {expected boolean value but got "x1.0"}}
-test obj-12.7 {SetBooleanFromAny, error converting from "empty string"} {
+test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {{} 1 {expected boolean value but got ""}}
+test obj-13.8 {SetBooleanFromAny, unicode strings} {
+ set result ""
+ lappend result [teststringobj set 1 1\u7777]
+ lappend result [catch {testbooleanobj not 1} msg]
+ lappend result $msg
+} "1\u7777 1 {expected boolean value but got \"1\u7777\"}"
-test obj-13.1 {UpdateStringOfBoolean} {
+test obj-14.1 {UpdateStringOfBoolean} {
set result ""
lappend result [testbooleanobj set 1 0]
lappend result [testbooleanobj not 1]
lappend result [testbooleanobj get 1] ;# must update string rep
} {0 1 1}
-test obj-14.1 {Tcl_NewDoubleObj} {
+test obj-15.1 {Tcl_NewDoubleObj} {
set result ""
lappend result [testobj freeallvars]
lappend result [testdoubleobj set 1 3.1459]
@@ -224,7 +259,7 @@ test obj-14.1 {Tcl_NewDoubleObj} {
lappend result [testobj refcount 1]
} {{} 3.1459 double 2}
-test obj-15.1 {Tcl_SetDoubleObj, existing "empty string" object} {
+test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -232,7 +267,7 @@ test obj-15.1 {Tcl_SetDoubleObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 0.123 double 2}
-test obj-15.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
+test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 98765]
@@ -241,83 +276,83 @@ test obj-15.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 98765 27.56 double 2}
-test obj-16.1 {Tcl_GetDoubleFromObj, existing double object} {
+test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} {
set result ""
lappend result [testdoubleobj set 1 16.1]
lappend result [testdoubleobj mult10 1] ;# gets existing double rep
} {16.1 161.0}
-test obj-16.2 {Tcl_GetDoubleFromObj, convert to double} {
+test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} {
set result ""
lappend result [testintobj set 1 477]
lappend result [testdoubleobj div10 1] ;# must convert to bool
lappend result [testobj type 1]
} {477 47.7 double}
-test obj-16.3 {Tcl_GetDoubleFromObj, error converting to double} {
+test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testdoubleobj mult10 1} msg]
lappend result $msg
} {abc 1 {expected floating-point number but got "abc"}}
-test obj-16.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
+test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testdoubleobj div10 1} msg]
lappend result $msg
} {{} 1 {expected floating-point number but got ""}}
-test obj-17.1 {DupDoubleInternalRep} {
+test obj-18.1 {DupDoubleInternalRep} {
set result ""
lappend result [testdoubleobj set 1 17.1]
lappend result [testobj duplicate 1 2] ;# uses DupDoubleInternalRep
lappend result [testdoubleobj get 2]
} {17.1 17.1 17.1}
-test obj-18.1 {SetDoubleFromAny, int to double special case} {
+test obj-19.1 {SetDoubleFromAny, int to double special case} {
set result ""
lappend result [testintobj set 1 1234]
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
lappend result [testobj type 1]
} {1234 12340.0 double}
-test obj-18.2 {SetDoubleFromAny, boolean to double special case} {
+test obj-19.2 {SetDoubleFromAny, boolean to double special case} {
set result ""
lappend result [testbooleanobj set 1 1]
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
lappend result [testobj type 1]
} {1 10.0 double}
-test obj-18.3 {SetDoubleFromAny, recompute string rep then parse it} {
+test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} {
set result ""
lappend result [testintobj set 1 456]
lappend result [testintobj div10 1]
lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
lappend result [testobj type 1]
} {456 45 450.0 double}
-test obj-18.4 {SetDoubleFromAny, error parsing string} {
+test obj-19.4 {SetDoubleFromAny, error parsing string} {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testdoubleobj mult10 1} msg]
lappend result $msg
} {abc 1 {expected floating-point number but got "abc"}}
-test obj-18.5 {SetDoubleFromAny, error parsing string} {
+test obj-19.5 {SetDoubleFromAny, error parsing string} {
set result ""
lappend result [teststringobj set 1 x1.0]
lappend result [catch {testdoubleobj mult10 1} msg]
lappend result $msg
} {x1.0 1 {expected floating-point number but got "x1.0"}}
-test obj-18.6 {SetDoubleFromAny, error converting from "empty string"} {
+test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testdoubleobj div10 1} msg]
lappend result $msg
} {{} 1 {expected floating-point number but got ""}}
-test obj-19.1 {UpdateStringOfDouble} {
+test obj-20.1 {UpdateStringOfDouble} {
set result ""
lappend result [testdoubleobj set 1 3.14159]
lappend result [testdoubleobj mult10 1]
lappend result [testdoubleobj get 1] ;# must update string rep
} {3.14159 31.4159 31.4159}
-test obj-20.1 {Tcl_NewIntObj} {
+test obj-21.1 {Tcl_NewIntObj} {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 55]
@@ -325,7 +360,7 @@ test obj-20.1 {Tcl_NewIntObj} {
lappend result [testobj refcount 1]
} {{} 55 int 2}
-test obj-21.1 {Tcl_SetIntObj, existing "empty string" object} {
+test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -333,7 +368,7 @@ test obj-21.1 {Tcl_SetIntObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 77 int 2}
-test obj-21.2 {Tcl_SetIntObj, existing non-"empty string" object} {
+test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} {
set result ""
lappend result [testobj freeallvars]
lappend result [testdoubleobj set 1 12.34]
@@ -342,94 +377,94 @@ test obj-21.2 {Tcl_SetIntObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}
-test obj-22.1 {Tcl_GetIntFromObj, existing int object} {
+test obj-23.1 {Tcl_GetIntFromObj, existing int object} {
set result ""
lappend result [testintobj set 1 22]
lappend result [testintobj mult10 1] ;# gets existing int rep
} {22 220}
-test obj-22.2 {Tcl_GetIntFromObj, convert to int} {
+test obj-23.2 {Tcl_GetIntFromObj, convert to int} {
set result ""
lappend result [testintobj set 1 477]
lappend result [testintobj div10 1] ;# must convert to bool
lappend result [testobj type 1]
} {477 47 int}
-test obj-22.3 {Tcl_GetIntFromObj, error converting to int} {
+test obj-23.3 {Tcl_GetIntFromObj, error converting to int} {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testintobj mult10 1} msg]
lappend result $msg
} {abc 1 {expected integer but got "abc"}}
-test obj-22.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
+test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testintobj div10 1} msg]
lappend result $msg
} {{} 1 {expected integer but got ""}}
-test obj-22.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
+test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
set result ""
lappend result [testobj newobj 1]
lappend result [testintobj inttoobigtest 1]
} {{} 1}
-test obj-23.1 {DupIntInternalRep} {
+test obj-24.1 {DupIntInternalRep} {
set result ""
lappend result [testintobj set 1 23]
lappend result [testobj duplicate 1 2] ;# uses DupIntInternalRep
lappend result [testintobj get 2]
} {23 23 23}
-test obj-24.1 {SetIntFromAny, int to int special case} {
+test obj-25.1 {SetIntFromAny, int to int special case} {
set result ""
lappend result [testintobj set 1 1234]
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
lappend result [testobj type 1]
} {1234 12340 int}
-test obj-24.2 {SetIntFromAny, boolean to int special case} {
+test obj-25.2 {SetIntFromAny, boolean to int special case} {
set result ""
lappend result [testbooleanobj set 1 1]
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
lappend result [testobj type 1]
} {1 10 int}
-test obj-24.3 {SetIntFromAny, recompute string rep then parse it} {
+test obj-25.3 {SetIntFromAny, recompute string rep then parse it} {
set result ""
lappend result [testintobj set 1 456]
lappend result [testintobj div10 1]
lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
lappend result [testobj type 1]
} {456 45 450 int}
-test obj-24.4 {SetIntFromAny, error parsing string} {
+test obj-25.4 {SetIntFromAny, error parsing string} {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testintobj mult10 1} msg]
lappend result $msg
} {abc 1 {expected integer but got "abc"}}
-test obj-24.5 {SetIntFromAny, error parsing string} {
+test obj-25.5 {SetIntFromAny, error parsing string} {
set result ""
lappend result [teststringobj set 1 x17]
lappend result [catch {testintobj mult10 1} msg]
lappend result $msg
} {x17 1 {expected integer but got "x17"}}
-test obj-24.6 {SetIntFromAny, integer too large} {nonPortable} {
+test obj-25.6 {SetIntFromAny, integer too large} {nonPortable} {
set result ""
lappend result [teststringobj set 1 123456789012345678901]
lappend result [catch {testintobj mult10 1} msg]
lappend result $msg
} {123456789012345678901 1 {integer value too large to represent}}
-test obj-24.7 {SetIntFromAny, error converting from "empty string"} {
+test obj-25.7 {SetIntFromAny, error converting from "empty string"} {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testintobj div10 1} msg]
lappend result $msg
} {{} 1 {expected integer but got ""}}
-test obj-25.1 {UpdateStringOfInt} {
+test obj-26.1 {UpdateStringOfInt} {
set result ""
lappend result [testintobj set 1 512]
lappend result [testintobj mult10 1]
lappend result [testintobj get 1] ;# must update string rep
} {512 5120 5120}
-test obj-26.1 {Tcl_NewLongObj} {
+test obj-27.1 {Tcl_NewLongObj} {
set result ""
lappend result [testobj freeallvars]
testintobj setmaxlong 1
@@ -438,7 +473,7 @@ test obj-26.1 {Tcl_NewLongObj} {
lappend result [testobj refcount 1]
} {{} 1 int 1}
-test obj-27.1 {Tcl_SetLongObj, existing "empty string" object} {
+test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
@@ -446,7 +481,7 @@ test obj-27.1 {Tcl_SetLongObj, existing "empty string" object} {
lappend result [testobj type 1]
lappend result [testobj refcount 1]
} {{} {} 77 int 2}
-test obj-27.2 {Tcl_SetLongObj, existing non-"empty string" object} {
+test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} {
set result ""
lappend result [testobj freeallvars]
lappend result [testdoubleobj set 1 12.34]
@@ -455,31 +490,31 @@ test obj-27.2 {Tcl_SetLongObj, existing non-"empty string" object} {
lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}
-test obj-28.1 {Tcl_GetLongFromObj, existing long integer object} {
+test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} {
set result ""
lappend result [testintobj setlong 1 22]
lappend result [testintobj mult10 1] ;# gets existing long int rep
} {22 220}
-test obj-28.2 {Tcl_GetLongFromObj, convert to long} {
+test obj-29.2 {Tcl_GetLongFromObj, convert to long} {
set result ""
lappend result [testintobj setlong 1 477]
lappend result [testintobj div10 1] ;# must convert to bool
lappend result [testobj type 1]
} {477 47 int}
-test obj-28.3 {Tcl_GetLongFromObj, error converting to long integer} {
+test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} {
set result ""
lappend result [teststringobj set 1 abc]
lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
lappend result $msg
} {abc 1 {expected integer but got "abc"}}
-test obj-28.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
+test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
set result ""
lappend result [testobj newobj 1]
lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
lappend result $msg
} {{} 1 {expected integer but got ""}}
-test obj-29.1 {Ref counting and object deletion, simple types} {
+test obj-30.1 {Ref counting and object deletion, simple types} {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 1024]
@@ -494,3 +529,20 @@ test obj-29.1 {Ref counting and object deletion, simple types} {
} {{} 1024 1024 int 4 4 0 boolean 3 2}
testobj freeallvars
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/opt.test b/tcl/tests/opt.test
index 67e95cf7af6..55a565685eb 100644
--- a/tcl/tests/opt.test
+++ b/tcl/tests/opt.test
@@ -1,4 +1,4 @@
-# Package covered: opt0.1/optparse.tcl
+# Package covered: opt1.0/optparse.tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
@@ -6,16 +6,20 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# the package we are going to test
-package require opt 0.1
+package require opt 0.4.1
# we are using implementation specifics to test the package
@@ -29,9 +33,11 @@ test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing k
} "$n [expr $n+1] [expr $n+2]"
test opt-2.1 {OptKeyDelete} {
- list [::tcl::OptKeyRegister {} testkey] [::tcl::OptKeyDelete testkey] \
- [catch {::tcl::OptKeyDelete testkey} msg] $msg;
-} {testkey {} 1 {can't unset "OptDesc(testkey)": no such element in array}}
+ list [::tcl::OptKeyRegister {} testkey] \
+ [info exists ::tcl::OptDesc(testkey)] \
+ [::tcl::OptKeyDelete testkey] \
+ [info exists ::tcl::OptDesc(testkey)]
+} {testkey 1 {} 0}
test opt-3.1 {OptParse / temp key is removed} {
@@ -131,17 +137,6 @@ test opt-8.7 {List utilities} {
set l
} {a {b c -2 e} f}
-test opt-8.8 {List utilities} {
- set l {{b c 7 e} f}
- ::tcl::Lfirst $l
-} {b c 7 e}
-
-
-test opt-8.9 {List utilities} {
- set l {a {b c 7 e} f}
- ::tcl::Lrest $l
-} {{b c 7 e} f}
-
test opt-8.10 {List utilities} {
set l {a {b c 7 e} f}
::tcl::Lvarpop l
@@ -253,7 +248,6 @@ test opt-10.10 {medium size overall test} {
list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0]
} {1 {too many arguments (unexpected argument(s): foo), usage:}}
-
test opt-11.1 {too many args test 2} {
set key [::tcl::OptKeyRegister {-foo}]
list [catch {::tcl::OptKeyParse $key {-foo blah}} msg] $msg\
@@ -263,9 +257,6 @@ test opt-11.1 {too many args test 2} {
------------ ---- ----- ----
( -help gives this help )
-foo boolflag (false) } {}}
-
-
-
test opt-11.2 {default value for args} {
set args {}
set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
@@ -274,4 +265,19 @@ test opt-11.2 {default value for args} {
set args
} {a b c}
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/osa.test b/tcl/tests/osa.test
index d70774d332c..df6935af23e 100644
--- a/tcl/tests/osa.test
+++ b/tcl/tests/osa.test
@@ -5,32 +5,45 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-# This command only runs on the Macintosh, only run the test if we
-# can load the command
-if {$tcl_platform(platform) != "macintosh"} {
- puts "skipping: Mac only tests..."
- return
-}
-if {[info commands AppleScript] == ""} {
- puts "couldn't find AppleScript command..."
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
-test osa-1.1 {Tcl_OSAComponentCmd} {
+# Only run the test if we can load the AppleScript command
+set ::tcltest::testConstraints(appleScript) [expr {[info commands AppleScript] != ""}]
+
+test osa-1.1 {Tcl_OSAComponentCmd} {macOnly appleScript} {
list [catch AppleScript msg] $msg
} {1 {wrong # args: should be "AppleScript option ?arg ...?"}}
-test osa-1.2 {Tcl_OSAComponentCmd} {
+test osa-1.2 {Tcl_OSAComponentCmd} {macOnly appleScript} {
list [catch {AppleScript x} msg] $msg
} {1 {bad option "x": should be compile, decompile, delete, execute, info, load, run or store}}
-test osa-1.3 {TclOSACompileCmd} {
+test osa-1.3 {TclOSACompileCmd} {macOnly appleScript} {
list [catch {AppleScript compile} msg] $msg
} {1 {wrong # args: should be "AppleScript compile ?options? code"}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/package.test b/tcl/tests/package.test
new file mode 100644
index 00000000000..13c06e43b09
--- /dev/null
+++ b/tcl/tests/package.test
@@ -0,0 +1,72 @@
+# This file contains tests for the ::package::* commands.
+# Note that the tests are limited to Tcl scripts only, there are no shared
+# libraries against which to test.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+test package-1.1 {pkg::create gives error on insufficient args} {
+ catch {::pkg::create}
+} 1
+test package-1.2 {pkg::create gives error on bad args} {
+ catch {::pkg::create -foo bar -bar baz -baz boo}
+} 1
+test package-1.3 {pkg::create gives error on no value given} {
+ catch {::pkg::create -name foo -version 1.0 -source test.tcl -load}
+} 1
+test package-1.4 {pkg::create gives error on no name given} {
+ catch {::pkg::create -version 1.0 -source test.tcl -load foo.so}
+} 1
+test package-1.5 {pkg::create gives error on no version given} {
+ catch {::pkg::create -name foo -source test.tcl -load foo.so}
+} 1
+test package-1.6 {pkg::create gives error on no source or load options} {
+ catch {::pkg::create -name foo -version 1.0 -version 2.0}
+} 1
+test package-1.7 {pkg::create gives correct output for 1 direct source} {
+ ::pkg::create -name foo -version 1.0 -source test.tcl
+} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]}
+test package-1.8 {pkg::create gives correct output for 2 direct sources} {
+ ::pkg::create -name foo -version 1.0 -source test.tcl -source test2.tcl
+} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list source [file join $dir test2.tcl]]}
+test package-1.9 {pkg::create gives correct output for 1 direct load} {
+ ::pkg::create -name foo -version 1.0 -load test.so
+} {package ifneeded foo 1.0 [list load [file join $dir test.so]]}
+test package-1.10 {pkg::create gives correct output for 2 direct loads} {
+ ::pkg::create -name foo -version 1.0 -load test.so -load test2.so
+} {package ifneeded foo 1.0 [list load [file join $dir test.so]]\n[list load [file join $dir test2.so]]}
+test package-1.11 {pkg::create gives correct output for 1 lazy source} {
+ ::pkg::create -name foo -version 1.0 -source {test.tcl {foo bar}}
+} {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.tcl source {foo bar}}}]}
+test package-1.12 {pkg::create gives correct output for 2 lazy sources} {
+ ::pkg::create -name foo -version 1.0 -source {test.tcl {foo bar}} \
+ -source {test2.tcl {baz boo}}
+} {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.tcl source {foo bar}} {test2.tcl source {baz boo}}}]}
+test package-1.13 {pkg::create gives correct output for 1 lazy load} {
+ ::pkg::create -name foo -version 1.0 -load {test.so {foo bar}}
+} {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.so load {foo bar}}}]}
+test package-1.14 {pkg::create gives correct output for 2 lazy loads} {
+ ::pkg::create -name foo -version 1.0 -load {test.so {foo bar}} \
+ -load {test2.so {baz boo}}
+} {package ifneeded foo 1.0 [list tclPkgSetup $dir foo 1.0 {{test.so load {foo bar}} {test2.so load {baz boo}}}]}
+test package-1.15 {pkg::create gives correct output for 1 each, direct} {
+ ::pkg::create -name foo -version 1.0 -source test.tcl -load test2.so
+} {package ifneeded foo 1.0 [list load [file join $dir test2.so]]\n[list source [file join $dir test.tcl]]}
+test package-1.16 {pkg::create gives correct output for 1 direct, 1 lazy} {
+ ::pkg::create -name foo -version 1.0 -source test.tcl \
+ -source {test2.tcl {foo bar}}
+} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list tclPkgSetup $dir foo 1.0 {{test2.tcl source {foo bar}}}]}
+
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/parse.test b/tcl/tests/parse.test
index e5b9fecd19a..3d399828c17 100644
--- a/tcl/tests/parse.test
+++ b/tcl/tests/parse.test
@@ -1,556 +1,752 @@
-# Commands covered: set (plus basic command syntax). Also tests
-# the procedures in the file tclParse.c.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
+# This file contains a collection of tests for the procedures in the
+# file tclParse.c. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-proc fourArgs {a b c d} {
- global arg1 arg2 arg3 arg4
- set arg1 $a
- set arg2 $b
- set arg3 $c
- set arg4 $d
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
-proc getArgs args {
- global argv
- set argv $args
+if {[info commands testparser] == {}} {
+ puts "This application hasn't been compiled with the \"testparser\""
+ puts "command, so I can't test the Tcl parser."
+ ::tcltest::cleanupTests
+ return
}
-# Basic argument parsing.
-
-test parse-1.1 {basic argument parsing} {
- set arg1 {}
- fourArgs a b c d
- list $arg1 $arg2 $arg3 $arg4
-} {a b c d}
-test parse-1.2 {basic argument parsing} {
- set arg1 {}
- eval "fourArgs 123\v4\f56\r7890"
- list $arg1 $arg2 $arg3 $arg4
-} {123 4 56 7890}
-
-# Quotes.
-
-test parse-2.1 {quotes and variable-substitution} {
- getArgs "a b c" d
- set argv
-} {{a b c} d}
-test parse-2.2 {quotes and variable-substitution} {
- set a 101
- getArgs "a$a b c"
- set argv
-} {{a101 b c}}
-test parse-2.3 {quotes and variable-substitution} {
- set argv "xy[format xabc]"
- set argv
-} {xyxabc}
-test parse-2.4 {quotes and variable-substitution} {
- set argv "xy\t"
- set argv
-} xy\t
-test parse-2.5 {quotes and variable-substitution} {
- set argv "a b c
-d e f"
- set argv
-} a\ b\tc\nd\ e\ f
-test parse-2.6 {quotes and variable-substitution} {
- set argv a"bcd"e
- set argv
-} {a"bcd"e}
-
-# Braces.
-
-test parse-3.1 {braces} {
- getArgs {a b c} d
- set argv
-} "{a b c} d"
-test parse-3.2 {braces} {
- set a 101
- set argv {a$a b c}
- set b [string index $argv 1]
- set b
-} {$}
-test parse-3.3 {braces} {
- set argv {a[format xyz] b}
- string length $argv
-} 15
-test parse-3.4 {braces} {
- set argv {a\nb\}}
- string length $argv
-} 6
-test parse-3.5 {braces} {
- set argv {{{{}}}}
- set argv
-} "{{{}}}"
-test parse-3.6 {braces} {
- set argv a{{}}b
- set argv
-} "a{{}}b"
-test parse-3.7 {braces} {
- set a [format "last]"]
- set a
-} {last]}
-
-# Command substitution.
-
-test parse-4.1 {command substitution} {
- set a [format xyz]
- set a
-} xyz
-test parse-4.2 {command substitution} {
- set a a[format xyz]b[format q]
- set a
-} axyzbq
-test parse-4.3 {command substitution} {
- set a a[
-set b 22;
-format %s $b
-
-]b
- set a
-} a22b
-test parse-4.4 {command substitution} {
- set a 7.7
- if [catch {expr int($a)}] {set a foo}
- set a
-} 7.7
-
-# Variable substitution.
-
-test parse-5.1 {variable substitution} {
- set a 123
- set b $a
- set b
-} 123
-test parse-5.2 {variable substitution} {
- set a 345
- set b x$a.b
- set b
-} x345.b
-test parse-5.3 {variable substitution} {
- set _123z xx
- set b $_123z^
- set b
-} xx^
-test parse-5.4 {variable substitution} {
- set a 78
- set b a${a}b
- set b
-} a78b
-test parse-5.5 {variable substitution} {catch {$_non_existent_} msg} 1
-test parse-5.6 {variable substitution} {
- catch {$_non_existent_} msg
- set msg
-} {can't read "_non_existent_": no such variable}
-test parse-5.7 {array variable substitution} {
+test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {
+ testparser [bytestring "foo\0 bar"] -1
+} {- foo 1 simple foo 1 text foo 0 {}}
+test parse-1.2 {Tcl_ParseCommand procedure, computing string length} {
+ testparser "foo bar" -1
+} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
+test parse-1.3 {Tcl_ParseCommand procedure, leading space} {
+ testparser " \n\t foo" 0
+} {- foo 1 simple foo 1 text foo 0 {}}
+test parse-1.4 {Tcl_ParseCommand procedure, leading space} {
+ testparser "\f\r\vfoo" 0
+} {- foo 1 simple foo 1 text foo 0 {}}
+test parse-1.5 {Tcl_ParseCommand procedure, backslash-newline in leading space} {
+ testparser " \\\n foo" 0
+} {- foo 1 simple foo 1 text foo 0 {}}
+test parse-1.6 {Tcl_ParseCommand procedure, backslash-newline in leading space} {
+ testparser { \a foo} 0
+} {- {\a foo} 2 word {\a} 1 backslash {\a} 0 simple foo 1 text foo 0 {}}
+test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading space} {
+ testparser " \\\n" 0
+} {- {} 0 {}}
+test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} {
+ testparser " foo" 3
+} {- {} 0 { foo}}
+
+test parse-2.1 {Tcl_ParseCommand procedure, comments} {
+ testparser "# foo bar\n foo" 0
+} {{# foo bar
+} foo 1 simple foo 1 text foo 0 {}}
+test parse-2.2 {Tcl_ParseCommand procedure, several comments} {
+ testparser " # foo bar\n # another comment\n\n foo" 0
+} {{# foo bar
+ # another comment
+} foo 1 simple foo 1 text foo 0 {}}
+test parse-2.3 {Tcl_ParseCommand procedure, backslash-newline in comments} {
+ testparser " # foo bar\\\ncomment on continuation line\nfoo" 0
+} {#\ foo\ bar\\\ncomment\ on\ continuation\ line\n foo 1 simple foo 1 text foo 0 {}}
+test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} {
+ testparser "# \\\n" 0
+} {#\ \ \ \\\n {} 0 {}}
+test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} {
+ testparser " # foo bar\nfoo" 8
+} {{# foo b} {} 0 {ar
+foo}}
+
+test parse-3.1 {Tcl_ParseCommand procedure, parsing words, skipping space} {
+ testparser "foo bar\t\tx" 0
+} {- {foo bar x} 3 simple foo 1 text foo 0 simple bar 1 text bar 0 simple x 1 text x 0 {}}
+test parse-3.2 {Tcl_ParseCommand procedure, missing continuation line in leading space} {
+ testparser "abc \\\n" 0
+} {- abc\ \ \\\n 1 simple abc 1 text abc 0 {}}
+test parse-3.3 {Tcl_ParseCommand procedure, parsing words, command ends in space} {
+ testparser "foo ; bar x" 0
+} {- {foo ;} 1 simple foo 1 text foo 0 { bar x}}
+test parse-3.4 {Tcl_ParseCommand procedure, parsing words, command ends in space} {
+ testparser "foo " 5
+} {- {foo } 1 simple foo 1 text foo 0 { }}
+test parse-3.5 {Tcl_ParseCommand procedure, quoted words} {
+ testparser {foo "a b c" d "efg";} 0
+} {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
+test parse-3.6 {Tcl_ParseCommand procedure, words in braces} {
+ testparser {foo {a $b [concat foo]} {c d}} 0
+} {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
+test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} {
+ list [catch {testparser "foo \$\{abc" 0} msg] $msg $errorInfo
+} {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\$\\\{abc\"\ 0\"}
+
+test parse-4.1 {Tcl_ParseCommand procedure, simple words} {
+ testparser {foo} 0
+} {- foo 1 simple foo 1 text foo 0 {}}
+test parse-4.2 {Tcl_ParseCommand procedure, simple words} {
+ testparser {{abc}} 0
+} {- {{abc}} 1 simple {{abc}} 1 text abc 0 {}}
+test parse-4.3 {Tcl_ParseCommand procedure, simple words} {
+ testparser {"c d"} 0
+} {- {"c d"} 1 simple {"c d"} 1 text {c d} 0 {}}
+test parse-4.4 {Tcl_ParseCommand procedure, simple words} {
+ testparser {x$d} 0
+} {- {x$d} 1 word {x$d} 3 text x 0 variable {$d} 1 text d 0 {}}
+test parse-4.5 {Tcl_ParseCommand procedure, simple words} {
+ testparser {"a [foo] b"} 0
+} {- {"a [foo] b"} 1 word {"a [foo] b"} 3 text {a } 0 command {[foo]} 0 text { b} 0 {}}
+test parse-4.6 {Tcl_ParseCommand procedure, simple words} {
+ testparser {$x} 0
+} {- {$x} 1 word {$x} 2 variable {$x} 1 text x 0 {}}
+
+test parse-5.1 {Tcl_ParseCommand procedure, backslash-newline terminates word} {
+ testparser "{abc}\\\n" 0
+} {- \{abc\}\\\n 1 simple {{abc}} 1 text abc 0 {}}
+test parse-5.2 {Tcl_ParseCommand procedure, backslash-newline terminates word} {
+ testparser "foo\\\nbar" 0
+} {- foo\\\nbar 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
+test parse-5.3 {Tcl_ParseCommand procedure, word terminator is command terminator} {
+ testparser "foo\n bar" 0
+} {- {foo
+} 1 simple foo 1 text foo 0 { bar}}
+test parse-5.4 {Tcl_ParseCommand procedure, word terminator is command terminator} {
+ testparser "foo; bar" 0
+} {- {foo;} 1 simple foo 1 text foo 0 { bar}}
+test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} {
+ testparser "\"foo\" bar" 5
+} {- {"foo"} 1 simple {"foo"} 1 text foo 0 { bar}}
+test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} {
+ list [catch {testparser {foo "bar"x} 0} msg] $msg $errorInfo
+} {1 {extra characters after close-quote} {extra characters after close-quote
+ (remainder of script: "x")
+ invoked from within
+"testparser {foo "bar"x} 0"}}
+test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote} {
+ testparser "foo \"bar\"\\\nx" 0
+} {- foo\ \"bar\"\\\nx 3 simple foo 1 text foo 0 simple {"bar"} 1 text bar 0 simple x 1 text x 0 {}}
+test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} {
+ list [catch {testparser {foo {bar}x} 0} msg] $msg $errorInfo
+} {1 {extra characters after close-brace} {extra characters after close-brace
+ (remainder of script: "x")
+ invoked from within
+"testparser {foo {bar}x} 0"}}
+test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} {
+ testparser "foo {bar}\\\nx" 0
+} {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}}
+test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} {
+ # This test is designed to catch bug 1681.
+ list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $errorInfo
+} "1 {missing \"} {missing \"
+ (remainder of script: \"\"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8\")
+ invoked from within
+\"testparser \"a \\\"\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\\\\9\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\" 0\"}"
+
+test parse-6.1 {ParseTokens procedure, empty word} {
+ testparser {""} 0
+} {- {""} 1 simple {""} 1 text {} 0 {}}
+test parse-6.2 {ParseTokens procedure, simple range} {
+ testparser {"abc$x.e"} 0
+} {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}}
+test parse-6.3 {ParseTokens procedure, variable reference} {
+ testparser {abc$x.e $y(z)} 0
+} {- {abc$x.e $y(z)} 2 word {abc$x.e} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 word {$y(z)} 3 variable {$y(z)} 2 text y 0 text z 0 {}}
+test parse-6.4 {ParseTokens procedure, variable reference} {
+ list [catch {testparser {$x([a )} 0} msg] $msg
+} {1 {missing close-bracket}}
+test parse-6.5 {ParseTokens procedure, command substitution} {
+ testparser {[foo $x bar]z} 0
+} {- {[foo $x bar]z} 1 word {[foo $x bar]z} 2 command {[foo $x bar]} 0 text z 0 {}}
+test parse-6.6 {ParseTokens procedure, command substitution} {
+ testparser {[foo \] [a b]]} 0
+} {- {[foo \] [a b]]} 1 word {[foo \] [a b]]} 1 command {[foo \] [a b]]} 0 {}}
+test parse-6.7 {ParseTokens procedure, error in command substitution} {
+ list [catch {testparser {a [b {}c d] e} 0} msg] $msg $errorInfo
+} {1 {extra characters after close-brace} {extra characters after close-brace
+ (remainder of script: "c d] e")
+ invoked from within
+"testparser {a [b {}c d] e} 0"}}
+test parse-6.8 {ParseTokens procedure, error in command substitution} {
+ info complete {a [b {}c d]}
+} {1}
+test parse-6.9 {ParseTokens procedure, error in command substitution} {
+ info complete {a [b "c d}
+} {0}
+test parse-6.10 {ParseTokens procedure, incomplete sub-command} {
+ info complete {puts [
+ expr 1+1
+ #this is a comment ]}
+} {0}
+test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} {
+ testparser {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0
+} {- {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 word {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 command {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 {}}
+test parse-6.12 {ParseTokens procedure, missing close bracket} {
+ list [catch {testparser {[foo $x bar} 0} msg] $msg $errorInfo
+} {1 {missing close-bracket} {missing close-bracket
+ (remainder of script: "[foo $x bar")
+ invoked from within
+"testparser {[foo $x bar} 0"}}
+test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} {
+ list [catch {testparser "\"a b\\\n" 0} msg] $msg $errorInfo
+} {1 {missing "} missing\ \"\n\ \ \ \ (remainder\ of\ script:\ \"\"a\ b\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\"a\ b\\\\\\n\"\ 0\"}
+test parse-6.14 {ParseTokens procedure, backslash-newline} {
+ testparser "b\\\nc" 0
+} {- b\\\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}}
+test parse-6.15 {ParseTokens procedure, backslash-newline} {
+ testparser "\"b\\\nc\"" 0
+} {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}}
+test parse-6.16 {ParseTokens procedure, backslash substitution} {
+ testparser {\n\a\x7f} 0
+} {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}}
+test parse-6.17 {ParseTokens procedure, null characters} {
+ testparser [bytestring "foo\0zz"] 0
+} "- [bytestring foo\0zz] 1 word [bytestring foo\0zz] 3 text foo 0 text [bytestring \0] 0 text zz 0 {}"
+
+test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} {
+ testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0
+} {- {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 16 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 {}}
+
+test parse-8.1 {Tcl_EvalObjv procedure} {
+ testevalobjv 0 concat this is a test
+} {this is a test}
+test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} {
+ rename unknown unknown.old
+ set x [catch {testevalobjv 10 asdf poiu} msg]
+ rename unknown.old unknown
+ list $x $msg
+} {1 {invalid command name "asdf"}}
+test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} {
+ rename unknown unknown.old
+ proc unknown args {
+ return "unknown $args"
+ }
+ set x [catch {testevalobjv 0 asdf poiu} msg]
+ rename unknown {}
+ rename unknown.old unknown
+ list $x $msg
+} {0 {unknown asdf poiu}}
+test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} {
+ rename unknown unknown.old
+ proc unknown args {
+ error "I don't like that command"
+ }
+ set x [catch {testevalobjv 0 asdf poiu} msg]
+ rename unknown {}
+ rename unknown.old unknown
+ list $x $msg
+} {1 {I don't like that command}}
+test parse-8.5 {Tcl_EvalObjv procedure, command traces} {
+ testevalobjv 0 set x 123
+ testcmdtrace tracetest {testevalobjv 0 set x $x}
+} {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}}
+test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} {
+ proc x {} {
+ set y 23
+ set z [testevalobjv 1 set y]
+ return [list $z $y]
+ }
+ catch {unset y}
+ set y 16
+ x
+} {16 23}
+test parse-8.8 {Tcl_EvalObjv procedure, async handlers} {
+ proc async1 {result code} {
+ global aresult acode
+ set aresult $result
+ set acode $code
+ return "new result"
+ }
+ set handler1 [testasync create async1]
+ set aresult xxx
+ set acode yyy
+ set x [list [catch [list testevalobjv 0 testasync mark $handler1 original 0] msg] $msg $acode $aresult]
+ testasync delete
+ set x
+} {0 {new result} 0 original}
+test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} {
+ list [catch {testevalobjv 0 error message} msg] $msg
+} {1 message}
+
+test parse-9.1 {Tcl_LogCommandInfo, line numbers} {
+ catch {unset x}
+ list [catch {testevalex {for {} 1 {} {
+
+
+ # asdf
+ set x
+ }}}] $errorInfo
+} {1 {can't read "x": no such variable
+ while executing
+"set x"
+ ("for" body line 5)
+ invoked from within
+"for {} 1 {} {
+
+
+ # asdf
+ set x
+ }"
+ invoked from within
+"testevalex {for {} 1 {} {
+
+
+ # asdf
+ set x
+ }}"}}
+test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} {
+ list [testevalex {catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}}] $errorInfo
+} {1 {wrong # args: should be "set varName ?newValue?"
+ while executing
+"set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}}
+
+test parse-10.1 {Tcl_EvalTokens, simple text} {
+ testevalex {concat test}
+} {test}
+test parse-10.2 {Tcl_EvalTokens, backslash sequences} {
+ testevalex {concat test\063\062test}
+} {test32test}
+test parse-10.3 {Tcl_EvalTokens, nested commands} {
+ testevalex {concat [expr 2 + 6]}
+} {8}
+test parse-10.4 {Tcl_EvalTokens, nested commands} {
catch {unset a}
- set a(xyz) 123
- set b $a(xyz)foo
- set b
-} 123foo
-test parse-5.8 {array variable substitution} {
+ list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
+} {1 {can't read "a": no such variable}}
+test parse-10.5 {Tcl_EvalTokens, simple variables} {
+ set a hello
+ testevalex {concat $a}
+} {hello}
+test parse-10.6 {Tcl_EvalTokens, array variables} {
catch {unset a}
- set "a(x y z)" 123
- set b $a(x y z)foo
- set b
-} 123foo
-test parse-5.9 {array variable substitution} {
- catch {unset a}; catch {unset qqq}
- set "a(x y z)" qqq
- set $a([format x]\ y [format z]) foo
- set qqq
-} foo
-test parse-5.10 {array variable substitution} {
+ set a(12) 46
+ testevalex {concat $a(12)}
+} {46}
+test parse-10.7 {Tcl_EvalTokens, array variables} {
catch {unset a}
- list [catch {set b $a(22)} msg] $msg
-} {1 {can't read "a(22)": no such variable}}
-test parse-5.11 {array variable substitution} {
- set b a$!
- set b
-} {a$!}
-test parse-5.12 {array variable substitution} {
- set b a$()
- set b
-} {a$()}
-catch {unset a}
-test parse-5.13 {array variable substitution} {
+ set a(12) 46
+ testevalex {concat $a(1[expr 3 - 1])}
+} {46}
+test parse-10.8 {Tcl_EvalTokens, array variables} {
catch {unset a}
- set long {This is a very long variable, long enough to cause storage \
- allocation to occur in Tcl_ParseVar. If that storage isn't getting \
- freed up correctly, then a core leak will occur when this test is \
- run. This text is probably beginning to sound like drivel, but I've \
- run out of things to say and I need more characters still.}
- set a($long) 777
- set b $a($long)
- list $b [array names a]
-} {777 {{This is a very long variable, long enough to cause storage \
- allocation to occur in Tcl_ParseVar. If that storage isn't getting \
- freed up correctly, then a core leak will occur when this test is \
- run. This text is probably beginning to sound like drivel, but I've \
- run out of things to say and I need more characters still.}}}
-test parse-5.14 {array variable substitution} {
- catch {unset a}; catch {unset b}; catch {unset a1}
- set a1(22) foo
- set a(foo) bar
- set b $a($a1(22))
- set b
-} bar
-catch {unset a}; catch {unset a1}
-
-# Backslash substitution.
-
-set errNum 1
-proc bsCheck {char num} {
- global errNum
-; test parse-6.$errNum {backslash substitution} {
- scan $char %c value
- set value
- } $num
- set errNum [expr $errNum+1]
-}
+ list [catch {testevalex {concat $x($a)}} msg] $msg
+} {1 {can't read "a": no such variable}}
+test parse-10.9 {Tcl_EvalTokens, array variables} {
+ catch {unset a}
+ list [catch {testevalex {concat xyz$a(1)}} msg] $msg
+} {1 {can't read "a(1)": no such variable}}
+test parse-10.10 {Tcl_EvalTokens, object values} {
+ set a 123
+ testevalex {concat $a}
+} {123}
+test parse-10.11 {Tcl_EvalTokens, object values} {
+ set a 123
+ testevalex {concat $a$a$a}
+} {123123123}
+test parse-10.12 {Tcl_EvalTokens, object values} {
+ testevalex {concat [expr 2][expr 4][expr 6]}
+} {246}
+test parse-10.13 {Tcl_EvalTokens, string values} {
+ testevalex {concat {a" b"}}
+} {a" b"}
+test parse-10.14 {Tcl_EvalTokens, string values} {
+ set a 111
+ testevalex {concat x$a.$a.$a}
+} {x111.111.111}
+
+test parse-11.1 {Tcl_EvalEx, TCL_EVAL_GLOBAL flag} {
+ proc x {} {
+ set y 777
+ set z [testevalex "set y" global]
+ return [list $z $y]
+ }
+ catch {unset y}
+ set y 321
+ x
+} {321 777}
+test parse-11.2 {Tcl_EvalEx, error while parsing} {
+ list [catch {testevalex {concat "abc}} msg] $msg
+} {1 {missing "}}
+test parse-11.3 {Tcl_EvalEx, error while collecting words} {
+ catch {unset a}
+ list [catch {testevalex {concat xyz $a}} msg] $msg
+} {1 {can't read "a": no such variable}}
+test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} {
+ catch {unset a}
+ list [catch {testevalex {_bogus_ a b c d}} msg] $msg
+} {1 {invalid command name "_bogus_"}}
+test parse-11.5 {Tcl_EvalEx, exceptional return} {
+ list [catch {testevalex {break}} msg] $msg
+} {3 {}}
+test parse-11.6 {Tcl_EvalEx, freeing memory} {
+ testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z}
+} {a b c d e f g h i j k l m n o p q r s t u v w x y z}
+test parse-11.7 {Tcl_EvalEx, multiple commands in script} {
+ list [testevalex {set a b; set c d}] $a $c
+} {d b d}
+test parse-11.8 {Tcl_EvalEx, multiple commands in script} {
+ list [testevalex {
+ set a b
+ set c d
+ }] $a $c
+} {d b d}
+test parse-11.9 {Tcl_EvalEx, freeing memory after error} {
+ catch {unset a}
+ list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg
+} {1 {can't read "a": no such variable}}
+test parse-11.10 {Tcl_EvalTokens, empty commands} {
+ testevalex {concat xyz; }
+} {xyz}
+test parse-11.11 {Tcl_EvalTokens, empty commands} {
+ testevalex "concat abc; ; # this is a comment\n"
+} {abc}
+test parse-11.12 {Tcl_EvalTokens, empty commands} {
+ testevalex {}
+} {}
-bsCheck \b 8
-bsCheck \e 101
-bsCheck \f 12
-bsCheck \n 10
-bsCheck \r 13
-bsCheck \t 9
-bsCheck \v 11
-bsCheck \{ 123
-bsCheck \} 125
-bsCheck \[ 91
-bsCheck \] 93
-bsCheck \$ 36
-bsCheck \ 32
-bsCheck \; 59
-bsCheck \\ 92
-bsCheck \Ca 67
-bsCheck \Ma 77
-bsCheck \CMa 67
-bsCheck \8a 8
-bsCheck \14 12
-bsCheck \141 97
-bsCheck \340 224
-bsCheck b\0 98
-bsCheck \x 120
-bsCheck \xa 10
-bsCheck \x41 65
-bsCheck \x541 65
-
-test parse-6.1 {backslash substitution} {
- set a "\a\c\n\]\}"
- string length $a
-} 5
-test parse-6.2 {backslash substitution} {
- set a {\a\c\n\]\}}
- string length $a
-} 10
-test parse-6.3 {backslash substitution} {
- set a "abc\
-def"
- set a
-} {abc def}
-test parse-6.4 {backslash substitution} {
- set a {abc\
-def}
- set a
-} {abc def}
-test parse-6.5 {backslash substitution} {
- set msg {}
- set a xxx
- set error [catch {if {24 < \
- 35} {set a 22} {set \
- a 33}} msg]
- list $error $msg $a
-} {0 22 22}
-test parse-6.6 {backslash substitution} {
- eval "concat abc\\"
-} "abc\\"
-test parse-6.7 {backslash substitution} {
- eval "concat \\\na"
-} "a"
-test parse-6.8 {backslash substitution} {
- eval "concat x\\\n a"
-} "x a"
-test parse-6.9 {backslash substitution} {
- eval "concat \\x"
-} "x"
-test parse-6.10 {backslash substitution} {
- eval "list a b\\\nc d"
-} {a b c d}
-test parse-6.11 {backslash substitution} {
- eval "list a \"b c\"\\\nd e"
-} {a {b c} d e}
-
-# Semi-colon.
-
-test parse-7.1 {semi-colons} {
- set b 0
- getArgs a;set b 2
- set argv
-} a
-test parse-7.2 {semi-colons} {
- set b 0
- getArgs a;set b 2
- set b
-} 2
-test parse-7.3 {semi-colons} {
- getArgs a b ; set b 1
- set argv
-} {a b}
-test parse-7.4 {semi-colons} {
- getArgs a b ; set b 1
- set b
-} 1
-
-# The following checks are to ensure that the interpreter's result
-# gets re-initialized by Tcl_Eval in all the right places.
-
-test parse-8.1 {result initialization} {concat abc} abc
-test parse-8.2 {result initialization} {concat abc; proc foo {} {}} {}
-test parse-8.3 {result initialization} {concat abc; proc foo {} $a} {}
-test parse-8.4 {result initialization} {proc foo {} [concat abc]} {}
-test parse-8.5 {result initialization} {concat abc; } abc
-test parse-8.6 {result initialization} {
- eval {
- concat abc
-}} abc
-test parse-8.7 {result initialization} {} {}
-test parse-8.8 {result initialization} {concat abc; ; ;} abc
-
-# Syntax errors.
-
-test parse-9.1 {syntax errors} {catch "set a \{bcd" msg} 1
-test parse-9.2 {syntax errors} {
- catch "set a \{bcd" msg
- set msg
-} {missing close-brace}
-test parse-9.3 {syntax errors} {catch {set a "bcd} msg} 1
-test parse-9.4 {syntax errors} {
- catch {set a "bcd} msg
- set msg
-} {quoted string doesn't terminate properly}
-test parse-9.5 {syntax errors} {catch {set a "bcd"xy} msg} 1
-test parse-9.6 {syntax errors} {
- catch {set a "bcd"xy} msg
- set msg
-} {quoted string doesn't terminate properly}
-test parse-9.7 {syntax errors} {catch "set a {bcd}xy" msg} 1
-test parse-9.8 {syntax errors} {
- catch "set a {bcd}xy" msg
- set msg
-} {argument word in braces doesn't terminate properly}
-test parse-9.9 {syntax errors} {catch {set a [format abc} msg} 1
-test parse-9.10 {syntax errors} {
- catch {set a [format abc} msg
- set msg
-} {missing close-bracket or close-brace}
-test parse-9.11 {syntax errors} {catch gorp-a-lot msg} 1
-test parse-9.12 {syntax errors} {
- catch gorp-a-lot msg
- set msg
-} {invalid command name "gorp-a-lot"}
-test parse-9.13 {syntax errors} {
- set a [concat {a}\
- {b}]
- set a
-} {a b}
-test parse-9.14 {syntax errors} {
- list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
+test parse-12.1 {Tcl_ParseVarName procedure, initialization} {
+ list [catch {testparsevarname {$a([first second])} 8 0} msg] $msg
+} {1 {missing close-bracket}}
+test parse-12.2 {Tcl_ParseVarName procedure, initialization} {
+ testparsevarname {$a([first second])} 0 0
+} {- {} 0 variable {$a([first second])} 2 text a 0 command {[first second]} 0 {}}
+test parse-12.3 {Tcl_ParseVarName procedure, initialization} {
+ list [catch {testparsevarname {$abcd} 3 0} msg] $msg
+} {0 {- {} 0 variable {$ab} 1 text ab 0 cd}}
+test parse-12.4 {Tcl_ParseVarName procedure, initialization} {
+ testparsevarname {$abcd} 0 0
+} {- {} 0 variable {$abcd} 1 text abcd 0 {}}
+test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} {
+ testparsevarname {$abcd} 1 0
+} {- {} 0 text {$} 0 abcd}
+test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} {
+ testparser {${..[]b}cd} 0
+} {- {${..[]b}cd} 1 word {${..[]b}cd} 3 variable {${..[]b}} 1 text {..[]b} 0 text cd 0 {}}
+test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} {
+ testparser "\$\{\{\} " 0
+} {- \$\{\{\}\ 1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}}
+test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} {
+ list [catch {testparser "$\{abc" 0} msg] $msg $errorInfo
+} {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\$\\\{abc\"\ 0\"}
+test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} {
+ list [catch {testparsevarname {${bcd}} 4 0} msg] $msg
+} {1 {missing close-brace for variable name}}
+test parse-12.10 {Tcl_ParseVarName procedure, missing close brace} {
+ list [catch {testparsevarname {${bc}} 4 0} msg] $msg
+} {1 {missing close-brace for variable name}}
+test parse-12.11 {Tcl_ParseVarName procedure, simple variable name} {
+ testparser {$az_AZ.} 0
+} {- {$az_AZ.} 1 word {$az_AZ.} 3 variable {$az_AZ} 1 text az_AZ 0 text . 0 {}}
+test parse-12.12 {Tcl_ParseVarName procedure, simple variable name} {
+ testparser {$abcdefg} 4
+} {- {$abc} 1 word {$abc} 2 variable {$abc} 1 text abc 0 defg}
+test parse-12.13 {Tcl_ParseVarName procedure, simple variable name with ::} {
+ testparser {$xyz::ab:c} 0
+} {- {$xyz::ab:c} 1 word {$xyz::ab:c} 3 variable {$xyz::ab} 1 text xyz::ab 0 text :c 0 {}}
+test parse-12.14 {Tcl_ParseVarName procedure, variable names with many colons} {
+ testparser {$xyz:::::c} 0
+} {- {$xyz:::::c} 1 word {$xyz:::::c} 2 variable {$xyz:::::c} 1 text xyz:::::c 0 {}}
+test parse-12.15 {Tcl_ParseVarName procedure, : vs. ::} {
+ testparsevarname {$ab:cd} 0 0
+} {- {} 0 variable {$ab} 1 text ab 0 :cd}
+test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} {
+ testparsevarname {$ab::cd} 4 0
+} {- {} 0 variable {$ab} 1 text ab 0 ::cd}
+test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} {
+ testparsevarname {$ab:::cd} 5 0
+} {- {} 0 variable {$ab::} 1 text ab:: 0 :cd}
+test parse-12.18 {Tcl_ParseVarName procedure, no variable name} {
+ testparser {$$ $.} 0
+} {- {$$ $.} 2 word {$$} 2 text {$} 0 text {$} 0 word {$.} 2 text {$} 0 text . 0 {}}
+test parse-12.19 {Tcl_ParseVarName procedure, EOF before (} {
+ testparsevarname {$ab(cd)} 3 0
+} {- {} 0 variable {$ab} 1 text ab 0 (cd)}
+test parse-12.20 {Tcl_ParseVarName procedure, array reference} {
+ testparser {$x(abc)} 0
+} {- {$x(abc)} 1 word {$x(abc)} 3 variable {$x(abc)} 2 text x 0 text abc 0 {}}
+test parse-12.21 {Tcl_ParseVarName procedure, array reference} {
+ testparser {$x(ab$cde[foo bar])} 0
+} {- {$x(ab$cde[foo bar])} 1 word {$x(ab$cde[foo bar])} 6 variable {$x(ab$cde[foo bar])} 5 text x 0 text ab 0 variable {$cde} 1 text cde 0 command {[foo bar]} 0 {}}
+test parse-12.22 {Tcl_ParseVarName procedure, array reference} {
+ testparser {$x([cmd arg]zz)} 0
+} {- {$x([cmd arg]zz)} 1 word {$x([cmd arg]zz)} 4 variable {$x([cmd arg]zz)} 3 text x 0 command {[cmd arg]} 0 text zz 0 {}}
+test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} {
+ list [catch {testparser {$x(poiu} 0} msg] $msg $errorInfo
} {1 {missing )} {missing )
- (parsing index for array "x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")
- while compiling
-"$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ..."
- ("eval" body line 1)
+ (remainder of script: "(poiu")
invoked from within
-"eval \$x[format "%01000d" 0]("}}
-test parse-9.15 {syntax errors, missplaced braces} {
- catch {
- proc misplaced_end_brace {} {
- set what foo
- set when [expr ${what}size - [set off$what]}]
- } msg
- set msg
-} {wrong # args: should be "proc name args body"}
-test parse-9.16 {syntax errors, missplaced braces} {
- catch {
- set a {
- set what foo
- set when [expr ${what}size - [set off$what]}]
- } msg
- set msg
-} {argument word in braces doesn't terminate properly}
-
-# Long values (stressing storage management)
-
-set a {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH}
-
-test parse-10.1 {long values} {
- string length $a
-} 214
-test parse-10.2 {long values} {
- llength $a
-} 43
-test parse-10.3 {long values} {
- set b "1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH"
- set b
-} $a
-test parse-10.4 {long values} {
- set b "$a"
- set b
-} $a
-test parse-10.5 {long values} {
- set b [set a]
- set b
-} $a
-test parse-10.6 {long values} {
- set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
- string length $b
-} 214
-test parse-10.7 {long values} {
- set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
- llength $b
-} 43
-test parse-10.8 {long values} {
- set b
-} $a
-test parse-10.9 {long values} {
- set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ]
- llength $a
-} 62
-set i 0
-foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] {
- set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i]
- set test $test$test$test$test
- set i [expr $i+1]
- test parse-10.10 {long values} {
- set j
- } $test
-}
-test parse-10.11 {test buffer overflow in backslashes in braces} {
- expr {"a" == {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101}}
-} 0
+"testparser {$x(poiu} 0"}}
+test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} {
+ list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $errorInfo
+} {1 {missing )} {missing )
+ (remainder of script: "(cd)")
+ invoked from within
+"testparsevarname {$ab(cd)} 6 0"}}
+test parse-12.25 {Tcl_ParseVarName procedure, nested array reference} {
+ testparser {$x(a$y(b$z))} 0
+} {- {$x(a$y(b$z))} 1 word {$x(a$y(b$z))} 8 variable {$x(a$y(b$z))} 7 text x 0 text a 0 variable {$y(b$z)} 4 text y 0 text b 0 variable {$z} 1 text z 0 {}}
-test parse-11.1 {comments} {
- set a old
- eval { # set a new}
- set a
-} {old}
-test parse-11.2 {comments} {
- set a old
- eval " # set a new\nset a new"
- set a
-} {new}
-test parse-11.3 {comments} {
- set a old
- eval " # set a new\\\nset a new"
- set a
-} {old}
-test parse-11.4 {comments} {
- set a old
- eval " # set a new\\\\\nset a new"
- set a
-} {new}
-
-test parse-12.1 {comments at the end of a bracketed script} {
- set x "[
-expr 1+1
-# skip this!
-]"
-} {2}
-
-if {[info command testwordend] == "testwordend"} {
- test parse-13.1 {TclWordEnd procedure} {
- testwordend " \n abc"
- } {c}
- test parse-13.2 {TclWordEnd procedure} {
- testwordend " \\\n"
- } {}
- test parse-13.3 {TclWordEnd procedure} {
- testwordend " \\\n "
- } { }
- test parse-13.4 {TclWordEnd procedure} {
- testwordend {"abc"}
- } {"}
- test parse-13.5 {TclWordEnd procedure} {
- testwordend {{xyz}}
- } \}
- test parse-13.6 {TclWordEnd procedure} {
- testwordend {{a{}b{}\}} xyz}
- } "\} xyz"
- test parse-13.7 {TclWordEnd procedure} {
- testwordend {abc[this is a]def ghi}
- } {f ghi}
- test parse-13.8 {TclWordEnd procedure} {
- testwordend "puts\\\n\n "
- } "s\\\n\n "
- test parse-13.9 {TclWordEnd procedure} {
- testwordend "puts\\\n "
- } "s\\\n "
- test parse-13.10 {TclWordEnd procedure} {
- testwordend "puts\\\n xyz"
- } "s\\\n xyz"
- test parse-13.11 {TclWordEnd procedure} {
- testwordend {a$x.$y(a long index) foo}
- } ") foo"
- test parse-13.12 {TclWordEnd procedure} {
- testwordend {abc; def}
- } {; def}
- test parse-13.13 {TclWordEnd procedure} {
- testwordend {abc def}
- } {c def}
- test parse-13.14 {TclWordEnd procedure} {
- testwordend {abc def}
- } {c def}
- test parse-13.15 {TclWordEnd procedure} {
- testwordend "abc\ndef"
- } "c\ndef"
- test parse-13.16 {TclWordEnd procedure} {
- testwordend "abc"
- } {c}
- test parse-13.17 {TclWordEnd procedure} {
- testwordend "a\000bc"
- } {c}
- test parse-13.18 {TclWordEnd procedure} {
- testwordend \[a\000\]
- } {]}
- test parse-13.19 {TclWordEnd procedure} {
- testwordend \"a\000\"
- } {"}
- test parse-13.20 {TclWordEnd procedure} {
- testwordend a{\000}b
- } {b}
- test parse-13.21 {TclWordEnd procedure} {
- testwordend " \000b"
- } {b}
-}
+test parse-13.1 {Tcl_ParseVar procedure} {
+ set abc 24
+ testparsevar {$abc.fg}
+} {24 .fg}
+test parse-13.2 {Tcl_ParseVar procedure, no variable name} {
+ testparsevar {$}
+} {{$} {}}
+test parse-13.3 {Tcl_ParseVar procedure, no variable name} {
+ testparsevar {$.123}
+} {{$} .123}
+test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} {
+ catch {unset abc}
+ list [catch {testparsevar {$abc}} msg] $msg
+} {1 {can't read "abc": no such variable}}
+test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} {
+ catch {unset abc}
+ list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
+} {1 {invalid command name "bogus"}}
-test parse-14.1 {TclScriptEnd procedure} {
- info complete {puts [
- expr 1+1
- #this is a comment ]}
-} {0}
-test parse-14.2 {TclScriptEnd procedure} {
+test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {
+ testparser [bytestring "foo\0 bar"] -1
+} {- foo 1 simple foo 1 text foo 0 {}}
+test parse-14.2 {Tcl_ParseBraces procedure, computing string length} {
+ testparser "foo bar" -1
+} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
+test parse-14.3 {Tcl_ParseBraces procedure, words in braces} {
+ testparser {foo {a $b [concat foo]} {c d}} 0
+} {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
+test parse-14.4 {Tcl_ParseBraces procedure, empty nested braces} {
+ testparser {foo {{}}} 0
+} {- {foo {{}}} 2 simple foo 1 text foo 0 simple {{{}}} 1 text {{}} 0 {}}
+test parse-14.5 {Tcl_ParseBraces procedure, nested braces} {
+ testparser {foo {{a {b} c} {} {d e}}} 0
+} {- {foo {{a {b} c} {} {d e}}} 2 simple foo 1 text foo 0 simple {{{a {b} c} {} {d e}}} 1 text {{a {b} c} {} {d e}} 0 {}}
+test parse-14.6 {Tcl_ParseBraces procedure, backslashes in words in braces} {
+ testparser "foo {a \\n\\\{}" 0
+} {- {foo {a \n\{}} 2 simple foo 1 text foo 0 simple {{a \n\{}} 1 text {a \n\{} 0 {}}
+test parse-14.7 {Tcl_ParseBraces procedure, missing continuation line in braces} {
+ list [catch {testparser "\{abc\\\n" 0} msg] $msg $errorInfo
+} {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\{abc\\\\\\n\"\ 0\"}
+test parse-14.8 {Tcl_ParseBraces procedure, backslash-newline in braces} {
+ testparser "foo {\\\nx}" 0
+} {- foo\ \{\\\nx\} 2 simple foo 1 text foo 0 word \{\\\nx\} 2 backslash \\\n 0 text x 0 {}}
+test parse-14.9 {Tcl_ParseBraces procedure, backslash-newline in braces} {
+ testparser "foo {a \\\n b}" 0
+} {- foo\ \{a\ \\\n\ \ \ b\} 2 simple foo 1 text foo 0 word \{a\ \\\n\ \ \ b\} 3 text {a } 0 backslash \\\n\ \ \ 0 text b 0 {}}
+test parse-14.10 {Tcl_ParseBraces procedure, backslash-newline in braces} {
+ testparser "foo {xyz\\\n }" 0
+} {- foo\ \{xyz\\\n\ \} 2 simple foo 1 text foo 0 word \{xyz\\\n\ \} 2 text xyz 0 backslash \\\n\ 0 {}}
+test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} {
+ testparser {foo {}} 0
+} {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}}
+test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} {
+ list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $errorInfo
+} {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"}
+
+test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} {
+ testparser [bytestring "foo\0 bar"] -1
+} {- foo 1 simple foo 1 text foo 0 {}}
+test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} {
+ testparser "foo bar" -1
+} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
+test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} {
+ testparser {foo "a b c" d "efg";} 0
+} {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
+test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} {
+ list [catch {testparser {foo "a b c"d} 0} msg] $msg $errorInfo
+} {1 {extra characters after close-quote} {extra characters after close-quote
+ (remainder of script: "d")
+ invoked from within
+"testparser {foo "a b c"d} 0"}}
+
+test parse-15.5 {CommandComplete procedure} {
+ info complete ""
+} 1
+test parse-15.6 {CommandComplete procedure} {
+ info complete " \n"
+} 1
+test parse-15.7 {CommandComplete procedure} {
+ info complete "abc def"
+} 1
+test parse-15.8 {CommandComplete procedure} {
+ info complete "a b c d e f \t\n"
+} 1
+test parse-15.9 {CommandComplete procedure} {
+ info complete {a b c"d}
+} 1
+test parse-15.10 {CommandComplete procedure} {
+ info complete {a b "c d" e}
+} 1
+test parse-15.11 {CommandComplete procedure} {
+ info complete {a b "c d"}
+} 1
+test parse-15.12 {CommandComplete procedure} {
+ info complete {a b "c d"}
+} 1
+test parse-15.13 {CommandComplete procedure} {
+ info complete {a b "c d}
+} 0
+test parse-15.14 {CommandComplete procedure} {
+ info complete {a b "}
+} 0
+test parse-15.15 {CommandComplete procedure} {
+ info complete {a b "cd"xyz}
+} 1
+test parse-15.16 {CommandComplete procedure} {
+ info complete {a b "c $d() d"}
+} 1
+test parse-15.17 {CommandComplete procedure} {
+ info complete {a b "c $dd("}
+} 0
+test parse-15.18 {CommandComplete procedure} {
+ info complete {a b "c \"}
+} 0
+test parse-15.19 {CommandComplete procedure} {
+ info complete {a b "c [d e f]"}
+} 1
+test parse-15.20 {CommandComplete procedure} {
+ info complete {a b "c [d e f] g"}
+} 1
+test parse-15.21 {CommandComplete procedure} {
+ info complete {a b "c [d e f"}
+} 0
+test parse-15.22 {CommandComplete procedure} {
+ info complete {a {b c d} e}
+} 1
+test parse-15.23 {CommandComplete procedure} {
+ info complete {a {b c d}}
+} 1
+test parse-15.24 {CommandComplete procedure} {
+ info complete "a b\{c d"
+} 1
+test parse-15.25 {CommandComplete procedure} {
+ info complete "a b \{c"
+} 0
+test parse-15.26 {CommandComplete procedure} {
+ info complete "a b \{c{ }"
+} 0
+test parse-15.27 {CommandComplete procedure} {
+ info complete "a b {c d e}xxx"
+} 1
+test parse-15.28 {CommandComplete procedure} {
+ info complete "a b {c \\\{d e}xxx"
+} 1
+test parse-15.29 {CommandComplete procedure} {
+ info complete {a b [ab cd ef]}
+} 1
+test parse-15.30 {CommandComplete procedure} {
+ info complete {a b x[ab][cd][ef] gh}
+} 1
+test parse-15.31 {CommandComplete procedure} {
+ info complete {a b x[ab][cd[ef] gh}
+} 0
+test parse-15.32 {CommandComplete procedure} {
+ info complete {a b x[ gh}
+} 0
+test parse-15.33 {CommandComplete procedure} {
+ info complete {[]]]}
+} 1
+test parse-15.34 {CommandComplete procedure} {
+ info complete {abc x$yyy}
+} 1
+test parse-15.35 {CommandComplete procedure} {
+ info complete "abc x\${abc\[\\d} xyz"
+} 1
+test parse-15.36 {CommandComplete procedure} {
+ info complete "abc x\$\{ xyz"
+} 0
+test parse-15.37 {CommandComplete procedure} {
+ info complete {word $a(xyz)}
+} 1
+test parse-15.38 {CommandComplete procedure} {
+ info complete {word $a(}
+} 0
+test parse-15.39 {CommandComplete procedure} {
+ info complete "set a \\\n"
+} 0
+test parse-15.40 {CommandComplete procedure} {
+ info complete "set a \\\\\n"
+} 1
+test parse-15.41 {CommandComplete procedure} {
+ info complete "set a \\n "
+} 1
+test parse-15.42 {CommandComplete procedure} {
+ info complete "set a \\"
+} 1
+test parse-15.43 {CommandComplete procedure} {
+ info complete "foo \\\n\{"
+} 0
+test parse-15.44 {CommandComplete procedure} {
+ info complete "a\nb\n# \{\n# \{\nc\n"
+} 1
+test parse-15.45 {CommandComplete procedure} {
+ info complete "#Incomplete comment\\\n"
+} 0
+test parse-15.46 {CommandComplete procedure} {
+ info complete "#Incomplete comment\\\nBut now it's complete.\n"
+} 1
+test parse-15.47 {CommandComplete procedure} {
+ info complete "# Complete comment\\\\\n"
+} 1
+test parse-15.48 {CommandComplete procedure} {
+ info complete "abc\\\n def"
+} 1
+test parse-15.49 {CommandComplete procedure} {
+ info complete "abc\\\n "
+} 1
+test parse-15.50 {CommandComplete procedure} {
info complete "abc\\\n"
-} {0}
-test parse-14.3 {TclScriptEnd procedure} {
- info complete "abc\\\\\n"
-} {1}
-test parse-14.4 {TclScriptEnd procedure} {
- info complete "xyz \[abc \{abc\]"
-} {0}
-test parse-14.5 {TclScriptEnd procedure} {
- info complete "xyz \[abc"
-} {0}
+} 0
+test parse-15.51 {CommandComplete procedure} "
+ info complete \"\\{abc\\}\\{\"
+" 1
+test parse-15.52 {CommandComplete procedure} {
+ info complete "\"abc\"("
+} 1
+test parse-15.53 {CommandComplete procedure} "
+ info complete \" # {\"
+" 1
+test parse-15.54 {CommandComplete procedure} "
+ info complete \"foo bar;# {\"
+" 1
+test parse-15.55 {CommandComplete procedure} {
+ info complete "set x [bytestring \0]; puts hi"
+} 1
+test parse-15.56 {CommandComplete procedure} {
+ info complete "set x [bytestring \0]; \{"
+} 0
+test parse-15.57 {CommandComplete procedure} {
+ info complete "# Comment should be complete command"
+} 1
+test parse-15.58 {CommandComplete procedure, memory leaks} {
+ info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22"
+} 1
+
+test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} {
+ subst {[eval {return foo}]bar}
+} foobar
+
+# cleanup
+catch {unset a}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/parseExpr.test b/tcl/tests/parseExpr.test
new file mode 100644
index 00000000000..49d2ff73572
--- /dev/null
+++ b/tcl/tests/parseExpr.test
@@ -0,0 +1,639 @@
+# This file contains a collection of tests for the procedures in the
+# file tclParseExpr.c. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# Note that the Tcl expression parser (tclParseExpr.c) does not check
+# the semantic validity of the expressions it parses. It does not check,
+# for example, that a math function actually exists, or that the operands
+# of "<<" are integers.
+
+if {[info commands testexprparser] == {}} {
+ puts "This application hasn't been compiled with the \"testexprparser\""
+ puts "command, so I can't test the Tcl expression parser."
+ ::tcltest::cleanupTests
+ return
+}
+
+test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {
+ testexprparser [bytestring "1+2\0 +3"] -1
+} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} {
+ testexprparser "1 + 2" -1
+} {- {} 0 subexpr {1 + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} {nonPortable} {
+ list [catch {testexprparser {12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-1.4 {Tcl_ParseExpr procedure, error in conditional expression} {
+ list [catch {testexprparser {foo+} -1} msg] $msg
+} {1 {syntax error in expression "foo+"}}
+test parseExpr-1.5 {Tcl_ParseExpr procedure, lexemes after the expression} {
+ list [catch {testexprparser {1+2 345} -1} msg] $msg
+} {1 {syntax error in expression "1+2 345"}}
+
+test parseExpr-2.1 {ParseCondExpr procedure, valid test subexpr} {
+ testexprparser {2>3? 1 : 0} -1
+} {- {} 0 subexpr {2>3? 1 : 0} 11 operator ? 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-2.2 {ParseCondExpr procedure, error in test subexpr} {
+ list [catch {testexprparser {0 || foo} -1} msg] $msg
+} {1 {syntax error in expression "0 || foo"}}
+test parseExpr-2.3 {ParseCondExpr procedure, next lexeme isn't "?"} {
+ testexprparser {1+2} -1
+} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-2.4 {ParseCondExpr procedure, next lexeme is "?"} {
+ testexprparser {1+2 ? 3 : 4} -1
+} {- {} 0 subexpr {1+2 ? 3 : 4} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-2.5 {ParseCondExpr procedure, bad lexeme after "?"} {nonPortable} {
+ list [catch {testexprparser {1+2 ? 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-2.6 {ParseCondExpr procedure, valid "then" subexpression} {
+ testexprparser {1? 3 : 4} -1
+} {- {} 0 subexpr {1? 3 : 4} 7 operator ? 0 subexpr 1 1 text 1 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-2.7 {ParseCondExpr procedure, error in "then" subexpression} {
+ list [catch {testexprparser {1? fred : martha} -1} msg] $msg
+} {1 {syntax error in expression "1? fred : martha"}}
+test parseExpr-2.8 {ParseCondExpr procedure, lexeme after "then" subexpr isn't ":"} {
+ list [catch {testexprparser {1? 2 martha 3} -1} msg] $msg
+} {1 {syntax error in expression "1? 2 martha 3"}}
+test parseExpr-2.9 {ParseCondExpr procedure, valid "else" subexpression} {
+ testexprparser {27||3? 3 : 4&&9} -1
+} {- {} 0 subexpr {27||3? 3 : 4&&9} 15 operator ? 0 subexpr 27||3 5 operator || 0 subexpr 27 1 text 27 0 subexpr 3 1 text 3 0 subexpr 3 1 text 3 0 subexpr 4&&9 5 operator && 0 subexpr 4 1 text 4 0 subexpr 9 1 text 9 0 {}}
+test parseExpr-2.10 {ParseCondExpr procedure, error in "else" subexpression} {
+ list [catch {testexprparser {1? 2 : martha} -1} msg] $msg
+} {1 {syntax error in expression "1? 2 : martha"}}
+
+test parseExpr-3.1 {ParseLorExpr procedure, valid logical and subexpr} {
+ testexprparser {1&&2 || 3} -1
+} {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-3.2 {ParseLorExpr procedure, error in logical and subexpr} {
+ list [catch {testexprparser {1&&foo || 3} -1} msg] $msg
+} {1 {syntax error in expression "1&&foo || 3"}}
+test parseExpr-3.3 {ParseLorExpr procedure, next lexeme isn't "||"} {
+ testexprparser {1&&2? 1 : 0} -1
+} {- {} 0 subexpr {1&&2? 1 : 0} 11 operator ? 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-3.4 {ParseLorExpr procedure, next lexeme is "||"} {
+ testexprparser {1&&2 || 3} -1
+} {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-3.5 {ParseLorExpr procedure, bad lexeme after "||"} {nonPortable} {
+ list [catch {testexprparser {1&&2 || 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-3.6 {ParseLorExpr procedure, valid RHS subexpression} {
+ testexprparser {1&&2 || 3 || 4} -1
+} {- {} 0 subexpr {1&&2 || 3 || 4} 13 operator || 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-3.7 {ParseLorExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1&&2 || 3 || martha} -1} msg] $msg
+} {1 {syntax error in expression "1&&2 || 3 || martha"}}
+
+test parseExpr-4.1 {ParseLandExpr procedure, valid LHS "|" subexpr} {
+ testexprparser {1|2 && 3} -1
+} {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-4.2 {ParseLandExpr procedure, error in LHS "|" subexpr} {
+ list [catch {testexprparser {1&&foo && 3} -1} msg] $msg
+} {1 {syntax error in expression "1&&foo && 3"}}
+test parseExpr-4.3 {ParseLandExpr procedure, next lexeme isn't "&&"} {
+ testexprparser {1|2? 1 : 0} -1
+} {- {} 0 subexpr {1|2? 1 : 0} 11 operator ? 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-4.4 {ParseLandExpr procedure, next lexeme is "&&"} {
+ testexprparser {1|2 && 3} -1
+} {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-4.5 {ParseLandExpr procedure, bad lexeme after "&&"} {nonPortable} {
+ list [catch {testexprparser {1|2 && 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-4.6 {ParseLandExpr procedure, valid RHS subexpression} {
+ testexprparser {1|2 && 3 && 4} -1
+} {- {} 0 subexpr {1|2 && 3 && 4} 13 operator && 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-4.7 {ParseLandExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1|2 && 3 && martha} -1} msg] $msg
+} {1 {syntax error in expression "1|2 && 3 && martha"}}
+
+test parseExpr-5.1 {ParseBitOrExpr procedure, valid LHS "^" subexpr} {
+ testexprparser {1^2 | 3} -1
+} {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-5.2 {ParseBitOrExpr procedure, error in LHS "^" subexpr} {
+ list [catch {testexprparser {1|foo | 3} -1} msg] $msg
+} {1 {syntax error in expression "1|foo | 3"}}
+test parseExpr-5.3 {ParseBitOrExpr procedure, next lexeme isn't "|"} {
+ testexprparser {1^2? 1 : 0} -1
+} {- {} 0 subexpr {1^2? 1 : 0} 11 operator ? 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-5.4 {ParseBitOrExpr procedure, next lexeme is "|"} {
+ testexprparser {1^2 | 3} -1
+} {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-5.5 {ParseBitOrExpr procedure, bad lexeme after "|"} {nonPortable} {
+ list [catch {testexprparser {1^2 | 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-5.6 {ParseBitOrExpr procedure, valid RHS subexpression} {
+ testexprparser {1^2 | 3 | 4} -1
+} {- {} 0 subexpr {1^2 | 3 | 4} 13 operator | 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-5.7 {ParseBitOrExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1^2 | 3 | martha} -1} msg] $msg
+} {1 {syntax error in expression "1^2 | 3 | martha"}}
+
+test parseExpr-6.1 {ParseBitXorExpr procedure, valid LHS "&" subexpr} {
+ testexprparser {1&2 ^ 3} -1
+} {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-6.2 {ParseBitXorExpr procedure, error in LHS "&" subexpr} {
+ list [catch {testexprparser {1^foo ^ 3} -1} msg] $msg
+} {1 {syntax error in expression "1^foo ^ 3"}}
+test parseExpr-6.3 {ParseBitXorExpr procedure, next lexeme isn't "^"} {
+ testexprparser {1&2? 1 : 0} -1
+} {- {} 0 subexpr {1&2? 1 : 0} 11 operator ? 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-6.4 {ParseBitXorExpr procedure, next lexeme is "^"} {
+ testexprparser {1&2 ^ 3} -1
+} {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-6.5 {ParseBitXorExpr procedure, bad lexeme after "^"} {nonPortable} {
+ list [catch {testexprparser {1&2 ^ 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-6.6 {ParseBitXorExpr procedure, valid RHS subexpression} {
+ testexprparser {1&2 ^ 3 ^ 4} -1
+} {- {} 0 subexpr {1&2 ^ 3 ^ 4} 13 operator ^ 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-6.7 {ParseBitXorExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1&2 ^ 3 ^ martha} -1} msg] $msg
+} {1 {syntax error in expression "1&2 ^ 3 ^ martha"}}
+
+test parseExpr-7.1 {ParseBitAndExpr procedure, valid LHS equality subexpr} {
+ testexprparser {1==2 & 3} -1
+} {- {} 0 subexpr {1==2 & 3} 9 operator & 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-7.2 {ParseBitAndExpr procedure, error in LHS equality subexpr} {
+ list [catch {testexprparser {1!=foo & 3} -1} msg] $msg
+} {1 {syntax error in expression "1!=foo & 3"}}
+test parseExpr-7.3 {ParseBitAndExpr procedure, next lexeme isn't "&"} {
+ testexprparser {1==2? 1 : 0} -1
+} {- {} 0 subexpr {1==2? 1 : 0} 11 operator ? 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-7.4 {ParseBitAndExpr procedure, next lexeme is "&"} {
+ testexprparser {1>2 & 3} -1
+} {- {} 0 subexpr {1>2 & 3} 9 operator & 0 subexpr 1>2 5 operator > 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-7.5 {ParseBitAndExpr procedure, bad lexeme after "&"} {nonPortable} {
+ list [catch {testexprparser {1==2 & 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-7.6 {ParseBitAndExpr procedure, valid RHS subexpression} {
+ testexprparser {1<2 & 3 & 4} -1
+} {- {} 0 subexpr {1<2 & 3 & 4} 13 operator & 0 subexpr {1<2 & 3} 9 operator & 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-7.7 {ParseBitAndExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1==2 & 3>2 & martha} -1} msg] $msg
+} {1 {syntax error in expression "1==2 & 3>2 & martha"}}
+
+test parseExpr-7.1 {ParseEqualityExpr procedure, valid LHS relational subexpr} {
+ testexprparser {1<2 == 3} -1
+} {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-7.2 {ParseEqualityExpr procedure, error in LHS relational subexpr} {
+ list [catch {testexprparser {1>=foo == 3} -1} msg] $msg
+} {1 {syntax error in expression "1>=foo == 3"}}
+test parseExpr-7.3 {ParseEqualityExpr procedure, next lexeme isn't "==" or "!="} {
+ testexprparser {1<2? 1 : 0} -1
+} {- {} 0 subexpr {1<2? 1 : 0} 11 operator ? 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-7.4 {ParseEqualityExpr procedure, next lexeme is "==" or "!=} {
+ testexprparser {1<2 == 3} -1
+} {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-7.5 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} {
+ testexprparser {1<2 != 3} -1
+} {- {} 0 subexpr {1<2 != 3} 9 operator != 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-7.6 {ParseEqualityExpr procedure, bad lexeme after "==" or "!="} {nonPortable} {
+ list [catch {testexprparser {1<2 == 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-7.7 {ParseEqualityExpr procedure, valid RHS subexpression} {
+ testexprparser {1<2 == 3 == 4} -1
+} {- {} 0 subexpr {1<2 == 3 == 4} 13 operator == 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-7.8 {ParseEqualityExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1<2 == 3 != martha} -1} msg] $msg
+} {1 {syntax error in expression "1<2 == 3 != martha"}}
+
+test parseExpr-8.1 {ParseRelationalExpr procedure, valid LHS shift subexpr} {
+ testexprparser {1<<2 < 3} -1
+} {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-8.2 {ParseRelationalExpr procedure, error in LHS shift subexpr} {
+ list [catch {testexprparser {1>=foo < 3} -1} msg] $msg
+} {1 {syntax error in expression "1>=foo < 3"}}
+test parseExpr-8.3 {ParseRelationalExpr procedure, next lexeme isn't relational op} {
+ testexprparser {1<<2? 1 : 0} -1
+} {- {} 0 subexpr {1<<2? 1 : 0} 11 operator ? 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-8.4 {ParseRelationalExpr procedure, next lexeme is relational op} {
+ testexprparser {1<<2 < 3} -1
+} {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-8.5 {ParseRelationalExpr procedure, next lexeme is relational op} {
+ testexprparser {1>>2 > 3} -1
+} {- {} 0 subexpr {1>>2 > 3} 9 operator > 0 subexpr 1>>2 5 operator >> 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-8.6 {ParseRelationalExpr procedure, next lexeme is relational op} {
+ testexprparser {1<<2 <= 3} -1
+} {- {} 0 subexpr {1<<2 <= 3} 9 operator <= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-8.7 {ParseRelationalExpr procedure, next lexeme is relational op} {
+ testexprparser {1<<2 >= 3} -1
+} {- {} 0 subexpr {1<<2 >= 3} 9 operator >= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-8.8 {ParseRelationalExpr procedure, bad lexeme after relational op} {nonPortable} {
+ list [catch {testexprparser {1<<2 < 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-8.9 {ParseRelationalExpr procedure, valid RHS subexpression} {
+ testexprparser {1<<2 < 3 < 4} -1
+} {- {} 0 subexpr {1<<2 < 3 < 4} 13 operator < 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-8.8 {ParseRelationalExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1<<2 < 3 > martha} -1} msg] $msg
+} {1 {syntax error in expression "1<<2 < 3 > martha"}}
+
+test parseExpr-9.1 {ParseShiftExpr procedure, valid LHS add subexpr} {
+ testexprparser {1+2 << 3} -1
+} {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-9.2 {ParseShiftExpr procedure, error in LHS add subexpr} {
+ list [catch {testexprparser {1-foo << 3} -1} msg] $msg
+} {1 {syntax error in expression "1-foo << 3"}}
+test parseExpr-9.3 {ParseShiftExpr procedure, next lexeme isn't "<<" or ">>"} {
+ testexprparser {1+2? 1 : 0} -1
+} {- {} 0 subexpr {1+2? 1 : 0} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-9.4 {ParseShiftExpr procedure, next lexeme is "<<" or ">>} {
+ testexprparser {1+2 << 3} -1
+} {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-9.5 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} {
+ testexprparser {1+2 >> 3} -1
+} {- {} 0 subexpr {1+2 >> 3} 9 operator >> 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-9.6 {ParseShiftExpr procedure, bad lexeme after "<<" or ">>"} {nonPortable} {
+ list [catch {testexprparser {1+2 << 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-9.7 {ParseShiftExpr procedure, valid RHS subexpression} {
+ testexprparser {1+2 << 3 << 4} -1
+} {- {} 0 subexpr {1+2 << 3 << 4} 13 operator << 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-9.8 {ParseShiftExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1+2 << 3 >> martha} -1} msg] $msg
+} {1 {syntax error in expression "1+2 << 3 >> martha"}}
+
+test parseExpr-10.1 {ParseAddExpr procedure, valid LHS multiply subexpr} {
+ testexprparser {1*2 + 3} -1
+} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-10.2 {ParseAddExpr procedure, error in LHS multiply subexpr} {
+ list [catch {testexprparser {1/foo + 3} -1} msg] $msg
+} {1 {syntax error in expression "1/foo + 3"}}
+test parseExpr-10.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} {
+ testexprparser {1*2? 1 : 0} -1
+} {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-10.4 {ParseAddExpr procedure, next lexeme is "+" or "-} {
+ testexprparser {1*2 + 3} -1
+} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-10.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
+ testexprparser {1*2 - 3} -1
+} {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-10.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {nonPortable} {
+ list [catch {testexprparser {1*2 + 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-10.7 {ParseAddExpr procedure, valid RHS subexpression} {
+ testexprparser {1*2 + 3 + 4} -1
+} {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-10.8 {ParseAddExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1*2 + 3 - martha} -1} msg] $msg
+} {1 {syntax error in expression "1*2 + 3 - martha"}}
+
+test parseExpr-10.1 {ParseAddExpr procedure, valid LHS multiply subexpr} {
+ testexprparser {1*2 + 3} -1
+} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-10.2 {ParseAddExpr procedure, error in LHS multiply subexpr} {
+ list [catch {testexprparser {1/foo + 3} -1} msg] $msg
+} {1 {syntax error in expression "1/foo + 3"}}
+test parseExpr-10.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} {
+ testexprparser {1*2? 1 : 0} -1
+} {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-10.4 {ParseAddExpr procedure, next lexeme is "+" or "-} {
+ testexprparser {1*2 + 3} -1
+} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-10.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
+ testexprparser {1*2 - 3} -1
+} {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-10.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {nonPortable} {
+ list [catch {testexprparser {1*2 + 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-10.7 {ParseAddExpr procedure, valid RHS subexpression} {
+ testexprparser {1*2 + 3 + 4} -1
+} {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-10.8 {ParseAddExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {1*2 + 3 - martha} -1} msg] $msg
+} {1 {syntax error in expression "1*2 + 3 - martha"}}
+
+test parseExpr-11.1 {ParseMultiplyExpr procedure, valid LHS unary subexpr} {
+ testexprparser {+2 * 3} -1
+} {- {} 0 subexpr {+2 * 3} 7 operator * 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-11.2 {ParseMultiplyExpr procedure, error in LHS unary subexpr} {nonPortable} {
+ list [catch {testexprparser {-12345678901234567890 * 3} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-11.3 {ParseMultiplyExpr procedure, next lexeme isn't "*", "/", or "%"} {
+ testexprparser {+2? 1 : 0} -1
+} {- {} 0 subexpr {+2? 1 : 0} 9 operator ? 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-11.4 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+ testexprparser {-123 * 3} -1
+} {- {} 0 subexpr {-123 * 3} 7 operator * 0 subexpr -123 3 operator - 0 subexpr 123 1 text 123 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-11.5 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+ testexprparser {+-456 / 3} -1
+} {- {} 0 subexpr {+-456 / 3} 9 operator / 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-11.6 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+ testexprparser {+-456 % 3} -1
+} {- {} 0 subexpr {+-456 % 3} 9 operator % 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-11.7 {ParseMultiplyExpr procedure, bad lexeme after "*", "/", or "%"} {nonPortable} {
+ list [catch {testexprparser {--++5 / 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-11.8 {ParseMultiplyExpr procedure, valid RHS subexpression} {
+ testexprparser {-2 / 3 % 4} -1
+} {- {} 0 subexpr {-2 / 3 % 4} 11 operator % 0 subexpr {-2 / 3} 7 operator / 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-11.9 {ParseMultiplyExpr procedure, error in RHS subexpression} {
+ list [catch {testexprparser {++2 / 3 * martha} -1} msg] $msg
+} {1 {syntax error in expression "++2 / 3 * martha"}}
+
+test parseExpr-12.1 {ParseUnaryExpr procedure, first token is unary operator} {
+ testexprparser {+2} -1
+} {- {} 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-12.2 {ParseUnaryExpr procedure, first token is unary operator} {
+ testexprparser {-2} -1
+} {- {} 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-12.3 {ParseUnaryExpr procedure, first token is unary operator} {
+ testexprparser {~2} -1
+} {- {} 0 subexpr ~2 3 operator ~ 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-12.4 {ParseUnaryExpr procedure, first token is unary operator} {
+ testexprparser {!2} -1
+} {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-12.5 {ParseUnaryExpr procedure, error in lexeme after unary op} {nonPortable} {
+ list [catch {testexprparser {-12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-12.6 {ParseUnaryExpr procedure, simple unary expr after unary op} {
+ testexprparser {+"1234"} -1
+} {- {} 0 subexpr +\"1234\" 3 operator + 0 subexpr {"1234"} 1 text 1234 0 {}}
+test parseExpr-12.7 {ParseUnaryExpr procedure, another unary expr after unary op} {
+ testexprparser {~!{fred}} -1
+} {- {} 0 subexpr ~!{fred} 5 operator ~ 0 subexpr !{fred} 3 operator ! 0 subexpr {{fred}} 1 text fred 0 {}}
+test parseExpr-12.8 {ParseUnaryExpr procedure, error in unary expr after unary op} {
+ list [catch {testexprparser {+-||27} -1} msg] $msg
+} {1 {syntax error in expression "+-||27"}}
+test parseExpr-12.9 {ParseUnaryExpr procedure, error in unary expr after unary op} {
+ list [catch {testexprparser {+-||27} -1} msg] $msg
+} {1 {syntax error in expression "+-||27"}}
+test parseExpr-12.10 {ParseUnaryExpr procedure, first token is not unary op} {
+ testexprparser {123} -1
+} {- {} 0 subexpr 123 1 text 123 0 {}}
+test parseExpr-12.11 {ParseUnaryExpr procedure, not unary expr, complex primary expr} {
+ testexprparser {(1+2)} -1
+} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-12.12 {ParseUnaryExpr procedure, not unary expr, error in primary expr} {nonPortable} {
+ list [catch {testexprparser {(12345678901234567890)} -1} msg] $msg
+} {1 {integer value too large to represent}}
+
+test parseExpr-13.1 {ParsePrimaryExpr procedure, just parenthesized subexpr} {
+ testexprparser {({abc}/{def})} -1
+} {- {} 0 subexpr {{abc}/{def}} 5 operator / 0 subexpr {{abc}} 1 text abc 0 subexpr {{def}} 1 text def 0 {}}
+test parseExpr-13.2 {ParsePrimaryExpr procedure, bad lexeme after "("} {nonPortable} {
+ list [catch {testexprparser {(12345678901234567890)} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-13.3 {ParsePrimaryExpr procedure, valid parenthesized subexpr} {
+ testexprparser {({abc}? 2*4 : -6)} -1
+} {- {} 0 subexpr {{abc}? 2*4 : -6} 13 operator ? 0 subexpr {{abc}} 1 text abc 0 subexpr 2*4 5 operator * 0 subexpr 2 1 text 2 0 subexpr 4 1 text 4 0 subexpr -6 3 operator - 0 subexpr 6 1 text 6 0 {}}
+test parseExpr-13.4 {ParsePrimaryExpr procedure, error in parenthesized subexpr} {
+ list [catch {testexprparser {(? 123 : 456)} -1} msg] $msg
+} {1 {syntax error in expression "(? 123 : 456)"}}
+test parseExpr-13.5 {ParsePrimaryExpr procedure, missing ")" after in parenthesized subexpr} {
+ list [catch {testexprparser {({abc}/{def}} -1} msg] $msg
+} {1 {syntax error in expression "({abc}/{def}"}}
+test parseExpr-13.6 {ParsePrimaryExpr procedure, primary is literal} {
+ testexprparser {12345} -1
+} {- {} 0 subexpr 12345 1 text 12345 0 {}}
+test parseExpr-13.7 {ParsePrimaryExpr procedure, primary is literal} {
+ testexprparser {12345.6789} -1
+} {- {} 0 subexpr 12345.6789 1 text 12345.6789 0 {}}
+test parseExpr-13.8 {ParsePrimaryExpr procedure, primary is var reference} {
+ testexprparser {$a} -1
+} {- {} 0 subexpr {$a} 2 variable {$a} 1 text a 0 {}}
+test parseExpr-13.9 {ParsePrimaryExpr procedure, primary is var reference} {
+ testexprparser {$a(hello$there)} -1
+} {- {} 0 subexpr {$a(hello$there)} 5 variable {$a(hello$there)} 4 text a 0 text hello 0 variable {$there} 1 text there 0 {}}
+test parseExpr-13.10 {ParsePrimaryExpr procedure, primary is var reference} {
+ testexprparser {$a()} -1
+} {- {} 0 subexpr {$a()} 3 variable {$a()} 2 text a 0 text {} 0 {}}
+test parseExpr-13.11 {ParsePrimaryExpr procedure, error in var reference} {
+ list [catch {testexprparser {$a(} -1} msg] $msg
+} {1 {missing )}}
+test parseExpr-13.12 {ParsePrimaryExpr procedure, primary is quoted string} {
+ testexprparser {"abc $xyz def"} -1
+} {- {} 0 subexpr {"abc $xyz def"} 5 word {"abc $xyz def"} 4 text {abc } 0 variable {$xyz} 1 text xyz 0 text { def} 0 {}}
+test parseExpr-13.13 {ParsePrimaryExpr procedure, error in quoted string} {
+ list [catch {testexprparser {"$a(12"} -1} msg] $msg
+} {1 {missing )}}
+test parseExpr-13.14 {ParsePrimaryExpr procedure, quoted string has multiple tokens} {
+ testexprparser {"abc [xyz] $def"} -1
+} {- {} 0 subexpr {"abc [xyz] $def"} 6 word {"abc [xyz] $def"} 5 text {abc } 0 command {[xyz]} 0 text { } 0 variable {$def} 1 text def 0 {}}
+test parseExpr-13.15 {ParsePrimaryExpr procedure, primary is command} {
+ testexprparser {[def]} -1
+} {- {} 0 subexpr {[def]} 1 command {[def]} 0 {}}
+test parseExpr-13.16 {ParsePrimaryExpr procedure, primary is multiple commands} {
+ testexprparser {[one; two; three; four;]} -1
+} {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}}
+test parseExpr-13.17 {ParsePrimaryExpr procedure, primary is multiple commands} {
+ testexprparser {[one; two; three; four;]} -1
+} {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}}
+test parseExpr-13.18 {ParsePrimaryExpr procedure, missing close bracket} {
+ list [catch {testexprparser {[one} -1} msg] $msg
+} {1 {missing close-bracket}}
+test parseExpr-13.19 {ParsePrimaryExpr procedure, primary is braced string} {
+ testexprparser {{hello world}} -1
+} {- {} 0 subexpr {{hello world}} 1 text {hello world} 0 {}}
+test parseExpr-13.20 {ParsePrimaryExpr procedure, error in primary, which is braced string} {
+ list [catch {testexprparser "\{abc\\\n" -1} msg] $msg
+} {1 {missing close-brace}}
+test parseExpr-13.21 {ParsePrimaryExpr procedure, primary is braced string with multiple tokens} {
+ testexprparser "\{ \\
+ +123 \}" -1
+} {- {} 0 subexpr \{\ \ \\\n\ +123\ \} 4 word \{\ \ \\\n\ +123\ \} 3 text { } 0 backslash \\\n\ 0 text {+123 } 0 {}}
+test parseExpr-13.22 {ParsePrimaryExpr procedure, primary is function call} {
+ testexprparser {foo(123)} -1
+} {- {} 0 subexpr foo(123) 3 operator foo 0 subexpr 123 1 text 123 0 {}}
+test parseExpr-13.23 {ParsePrimaryExpr procedure, bad lexeme after function name} {nonPortable} {
+ list [catch {testexprparser {foo 12345678901234567890 123)} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-13.24 {ParsePrimaryExpr procedure, lexeme after function name isn't "("} {
+ list [catch {testexprparser {foo 27.4 123)} -1} msg] $msg
+} {1 {syntax error in expression "foo 27.4 123)"}}
+test parseExpr-13.25 {ParsePrimaryExpr procedure, bad lexeme after "("} {nonPortable} {
+ list [catch {testexprparser {foo(12345678901234567890)} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-13.26 {ParsePrimaryExpr procedure, function call, one arg} {
+ testexprparser {foo(27*4)} -1
+} {- {} 0 subexpr foo(27*4) 7 operator foo 0 subexpr 27*4 5 operator * 0 subexpr 27 1 text 27 0 subexpr 4 1 text 4 0 {}}
+test parseExpr-13.27 {ParsePrimaryExpr procedure, error in function arg} {
+ list [catch {testexprparser {foo(*1-2)} -1} msg] $msg
+} {1 {syntax error in expression "foo(*1-2)"}}
+test parseExpr-13.28 {ParsePrimaryExpr procedure, error in function arg} {
+ list [catch {testexprparser {foo(*1-2)} -1} msg] $msg
+} {1 {syntax error in expression "foo(*1-2)"}}
+test parseExpr-13.29 {ParsePrimaryExpr procedure, function call, comma after arg} {
+ testexprparser {foo(27-2, (-2*[foo]))} -1
+} {- {} 0 subexpr {foo(27-2, (-2*[foo]))} 15 operator foo 0 subexpr 27-2 5 operator - 0 subexpr 27 1 text 27 0 subexpr 2 1 text 2 0 subexpr {-2*[foo]} 7 operator * 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr {[foo]} 1 command {[foo]} 0 {}}
+test parseExpr-13.30 {ParsePrimaryExpr procedure, bad lexeme after comma} {nonPortable} {
+ list [catch {testexprparser {foo(123, 12345678901234567890)} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-13.31 {ParsePrimaryExpr procedure, lexeme not "," or ")" after arg} {
+ list [catch {testexprparser {foo(123 [foo])} -1} msg] $msg
+} {1 {syntax error in expression "foo(123 [foo])"}}
+test parseExpr-13.32 {ParsePrimaryExpr procedure, bad lexeme after primary} {nonPortable} {
+ list [catch {testexprparser {123 12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+
+test parseExpr-14.1 {GetLexeme procedure, whitespace before lexeme} {
+ testexprparser { 123} -1
+} {- {} 0 subexpr 123 1 text 123 0 {}}
+test parseExpr-14.2 {GetLexeme procedure, whitespace before lexeme} {
+ testexprparser { \
+456} -1
+} {- {} 0 subexpr 456 1 text 456 0 {}}
+test parseExpr-14.3 {GetLexeme procedure, no lexeme after whitespace} {
+ testexprparser { 123 \
+ } -1
+} {- {} 0 subexpr 123 1 text 123 0 {}}
+test parseExpr-14.4 {GetLexeme procedure, integer lexeme} {
+ testexprparser {000} -1
+} {- {} 0 subexpr 000 1 text 000 0 {}}
+test parseExpr-14.5 {GetLexeme procedure, integer lexeme too big} {nonPortable} {
+ list [catch {testexprparser {12345678901234567890} -1} msg] $msg
+} {1 {integer value too large to represent}}
+test parseExpr-14.6 {GetLexeme procedure, bad integer lexeme} {
+ list [catch {testexprparser {0999} -1} msg] $msg
+} {1 {"0999" is an invalid octal number}}
+test parseExpr-14.7 {GetLexeme procedure, double lexeme} {
+ testexprparser {0.999} -1
+} {- {} 0 subexpr 0.999 1 text 0.999 0 {}}
+test parseExpr-14.8 {GetLexeme procedure, double lexeme} {
+ testexprparser {.123} -1
+} {- {} 0 subexpr .123 1 text .123 0 {}}
+test parseExpr-14.9 {GetLexeme procedure, double lexeme} {nonPortable unixOnly} {
+ testexprparser {nan} -1
+} {- {} 0 subexpr nan 1 text nan 0 {}}
+test parseExpr-14.10 {GetLexeme procedure, double lexeme} {nonPortable unixOnly} {
+ testexprparser {NaN} -1
+} {- {} 0 subexpr NaN 1 text NaN 0 {}}
+test parseExpr-14.11 {GetLexeme procedure, bad double lexeme too big} {
+ list [catch {testexprparser {123.e+99999999999999} -1} msg] $msg
+} {1 {floating-point value too large to represent}}
+test parseExpr-14.12 {GetLexeme procedure, bad double lexeme} {
+ list [catch {testexprparser {123.4x56} -1} msg] $msg
+} {1 {syntax error in expression "123.4x56"}}
+test parseExpr-14.13 {GetLexeme procedure, lexeme is "["} {
+ testexprparser {[foo]} -1
+} {- {} 0 subexpr {[foo]} 1 command {[foo]} 0 {}}
+test parseExpr-14.14 {GetLexeme procedure, lexeme is open brace} {
+ testexprparser {{bar}} -1
+} {- {} 0 subexpr {{bar}} 1 text bar 0 {}}
+test parseExpr-14.15 {GetLexeme procedure, lexeme is "("} {
+ testexprparser {(123)} -1
+} {- {} 0 subexpr 123 1 text 123 0 {}}
+test parseExpr-14.16 {GetLexeme procedure, lexeme is ")"} {
+ testexprparser {(2*3)} -1
+} {- {} 0 subexpr 2*3 5 operator * 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.17 {GetLexeme procedure, lexeme is "$"} {
+ testexprparser {$wombat} -1
+} {- {} 0 subexpr {$wombat} 2 variable {$wombat} 1 text wombat 0 {}}
+test parseExpr-14.18 {GetLexeme procedure, lexeme is '"'} {
+ testexprparser {"fred"} -1
+} {- {} 0 subexpr {"fred"} 1 text fred 0 {}}
+test parseExpr-14.19 {GetLexeme procedure, lexeme is ","} {
+ testexprparser {foo(1,2)} -1
+} {- {} 0 subexpr foo(1,2) 5 operator foo 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-14.20 {GetLexeme procedure, lexeme is "*"} {
+ testexprparser {$a*$b} -1
+} {- {} 0 subexpr {$a*$b} 7 operator * 0 subexpr {$a} 2 variable {$a} 1 text a 0 subexpr {$b} 2 variable {$b} 1 text b 0 {}}
+test parseExpr-14.21 {GetLexeme procedure, lexeme is "/"} {
+ testexprparser {5/6} -1
+} {- {} 0 subexpr 5/6 5 operator / 0 subexpr 5 1 text 5 0 subexpr 6 1 text 6 0 {}}
+test parseExpr-14.22 {GetLexeme procedure, lexeme is "%"} {
+ testexprparser {5%[xxx]} -1
+} {- {} 0 subexpr {5%[xxx]} 5 operator % 0 subexpr 5 1 text 5 0 subexpr {[xxx]} 1 command {[xxx]} 0 {}}
+test parseExpr-14.23 {GetLexeme procedure, lexeme is "+"} {
+ testexprparser {1+2} -1
+} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-14.24 {GetLexeme procedure, lexeme is "-"} {
+ testexprparser {.12-0e27} -1
+} {- {} 0 subexpr .12-0e27 5 operator - 0 subexpr .12 1 text .12 0 subexpr 0e27 1 text 0e27 0 {}}
+test parseExpr-14.25 {GetLexeme procedure, lexeme is "?" or ":"} {
+ testexprparser {$b? 1 : 0} -1
+} {- {} 0 subexpr {$b? 1 : 0} 8 operator ? 0 subexpr {$b} 2 variable {$b} 1 text b 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
+test parseExpr-14.26 {GetLexeme procedure, lexeme is "<"} {
+ testexprparser {2<3} -1
+} {- {} 0 subexpr 2<3 5 operator < 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.27 {GetLexeme procedure, lexeme is "<<"} {
+ testexprparser {2<<3} -1
+} {- {} 0 subexpr 2<<3 5 operator << 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.28 {GetLexeme procedure, lexeme is "<="} {
+ testexprparser {2<=3} -1
+} {- {} 0 subexpr 2<=3 5 operator <= 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.29 {GetLexeme procedure, lexeme is ">"} {
+ testexprparser {2>3} -1
+} {- {} 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.30 {GetLexeme procedure, lexeme is ">>"} {
+ testexprparser {2>>3} -1
+} {- {} 0 subexpr 2>>3 5 operator >> 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.31 {GetLexeme procedure, lexeme is ">="} {
+ testexprparser {2>=3} -1
+} {- {} 0 subexpr 2>=3 5 operator >= 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.32 {GetLexeme procedure, lexeme is "=="} {
+ testexprparser {2==3} -1
+} {- {} 0 subexpr 2==3 5 operator == 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.33 {GetLexeme procedure, bad lexeme starting with "="} {
+ list [catch {testexprparser {2=+3} -1} msg] $msg
+} {1 {syntax error in expression "2=+3"}}
+test parseExpr-14.34 {GetLexeme procedure, lexeme is "!="} {
+ testexprparser {2!=3} -1
+} {- {} 0 subexpr 2!=3 5 operator != 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.35 {GetLexeme procedure, lexeme is "!"} {
+ testexprparser {!2} -1
+} {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-14.36 {GetLexeme procedure, lexeme is "&&"} {
+ testexprparser {2&&3} -1
+} {- {} 0 subexpr 2&&3 5 operator && 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.37 {GetLexeme procedure, lexeme is "&"} {
+ testexprparser {1&2} -1
+} {- {} 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-14.38 {GetLexeme procedure, lexeme is "^"} {
+ testexprparser {1^2} -1
+} {- {} 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-14.39 {GetLexeme procedure, lexeme is "||"} {
+ testexprparser {2||3} -1
+} {- {} 0 subexpr 2||3 5 operator || 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.40 {GetLexeme procedure, lexeme is "|"} {
+ testexprparser {1|2} -1
+} {- {} 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-14.41 {GetLexeme procedure, lexeme is "~"} {
+ testexprparser {~2} -1
+} {- {} 0 subexpr ~2 3 operator ~ 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-14.42 {GetLexeme procedure, lexeme is func name} {
+ testexprparser {george()} -1
+} {- {} 0 subexpr george() 1 operator george 0 {}}
+test parseExpr-14.43 {GetLexeme procedure, lexeme is func name} {
+ testexprparser {harmonic_ratio(2,3)} -1
+} {- {} 0 subexpr harmonic_ratio(2,3) 5 operator harmonic_ratio 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
+test parseExpr-14.44 {GetLexeme procedure, unknown lexeme} {
+ list [catch {testexprparser {@27} -1} msg] $msg
+} {1 {syntax error in expression "@27"}}
+
+test parseExpr-15.1 {PrependSubExprTokens procedure, expand token array} {
+ testexprparser {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} -1
+} {- {} 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 13 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 9 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 5 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 {}}
+
+test parse-16.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
+ list [catch {testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1} msg] $msg
+} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/parseOld.test b/tcl/tests/parseOld.test
new file mode 100644
index 00000000000..516c2b2fa4a
--- /dev/null
+++ b/tcl/tests/parseOld.test
@@ -0,0 +1,552 @@
+# Commands covered: set (plus basic command syntax). Also tests the
+# procedures in the file tclOldParse.c. This set of tests is an old
+# one that predates the new parser in Tcl 8.1.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+proc fourArgs {a b c d} {
+ global arg1 arg2 arg3 arg4
+ set arg1 $a
+ set arg2 $b
+ set arg3 $c
+ set arg4 $d
+}
+
+proc getArgs args {
+ global argv
+ set argv $args
+}
+
+# Basic argument parsing.
+
+test parseOld-1.1 {basic argument parsing} {
+ set arg1 {}
+ fourArgs a b c d
+ list $arg1 $arg2 $arg3 $arg4
+} {a b c d}
+test parseOld-1.2 {basic argument parsing} {
+ set arg1 {}
+ eval "fourArgs 123\v4\f56\r7890"
+ list $arg1 $arg2 $arg3 $arg4
+} {123 4 56 7890}
+
+# Quotes.
+
+test parseOld-2.1 {quotes and variable-substitution} {
+ getArgs "a b c" d
+ set argv
+} {{a b c} d}
+test parseOld-2.2 {quotes and variable-substitution} {
+ set a 101
+ getArgs "a$a b c"
+ set argv
+} {{a101 b c}}
+test parseOld-2.3 {quotes and variable-substitution} {
+ set argv "xy[format xabc]"
+ set argv
+} {xyxabc}
+test parseOld-2.4 {quotes and variable-substitution} {
+ set argv "xy\t"
+ set argv
+} xy\t
+test parseOld-2.5 {quotes and variable-substitution} {
+ set argv "a b c
+d e f"
+ set argv
+} a\ b\tc\nd\ e\ f
+test parseOld-2.6 {quotes and variable-substitution} {
+ set argv a"bcd"e
+ set argv
+} {a"bcd"e}
+
+# Braces.
+
+test parseOld-3.1 {braces} {
+ getArgs {a b c} d
+ set argv
+} "{a b c} d"
+test parseOld-3.2 {braces} {
+ set a 101
+ set argv {a$a b c}
+ set b [string index $argv 1]
+ set b
+} {$}
+test parseOld-3.3 {braces} {
+ set argv {a[format xyz] b}
+ string length $argv
+} 15
+test parseOld-3.4 {braces} {
+ set argv {a\nb\}}
+ string length $argv
+} 6
+test parseOld-3.5 {braces} {
+ set argv {{{{}}}}
+ set argv
+} "{{{}}}"
+test parseOld-3.6 {braces} {
+ set argv a{{}}b
+ set argv
+} "a{{}}b"
+test parseOld-3.7 {braces} {
+ set a [format "last]"]
+ set a
+} {last]}
+
+# Command substitution.
+
+test parseOld-4.1 {command substitution} {
+ set a [format xyz]
+ set a
+} xyz
+test parseOld-4.2 {command substitution} {
+ set a a[format xyz]b[format q]
+ set a
+} axyzbq
+test parseOld-4.3 {command substitution} {
+ set a a[
+set b 22;
+format %s $b
+
+]b
+ set a
+} a22b
+test parseOld-4.4 {command substitution} {
+ set a 7.7
+ if [catch {expr int($a)}] {set a foo}
+ set a
+} 7.7
+
+# Variable substitution.
+
+test parseOld-5.1 {variable substitution} {
+ set a 123
+ set b $a
+ set b
+} 123
+test parseOld-5.2 {variable substitution} {
+ set a 345
+ set b x$a.b
+ set b
+} x345.b
+test parseOld-5.3 {variable substitution} {
+ set _123z xx
+ set b $_123z^
+ set b
+} xx^
+test parseOld-5.4 {variable substitution} {
+ set a 78
+ set b a${a}b
+ set b
+} a78b
+test parseOld-5.5 {variable substitution} {catch {$_non_existent_} msg} 1
+test parseOld-5.6 {variable substitution} {
+ catch {$_non_existent_} msg
+ set msg
+} {can't read "_non_existent_": no such variable}
+test parseOld-5.7 {array variable substitution} {
+ catch {unset a}
+ set a(xyz) 123
+ set b $a(xyz)foo
+ set b
+} 123foo
+test parseOld-5.8 {array variable substitution} {
+ catch {unset a}
+ set "a(x y z)" 123
+ set b $a(x y z)foo
+ set b
+} 123foo
+test parseOld-5.9 {array variable substitution} {
+ catch {unset a}; catch {unset qqq}
+ set "a(x y z)" qqq
+ set $a([format x]\ y [format z]) foo
+ set qqq
+} foo
+test parseOld-5.10 {array variable substitution} {
+ catch {unset a}
+ list [catch {set b $a(22)} msg] $msg
+} {1 {can't read "a(22)": no such variable}}
+test parseOld-5.11 {array variable substitution} {
+ set b a$!
+ set b
+} {a$!}
+test parseOld-5.12 {empty array name support} {
+ list [catch {set b a$()} msg] $msg
+} {1 {can't read "()": no such variable}}
+catch {unset a}
+test parseOld-5.13 {array variable substitution} {
+ catch {unset a}
+ set long {This is a very long variable, long enough to cause storage \
+ allocation to occur in Tcl_ParseVar. If that storage isn't getting \
+ freed up correctly, then a core leak will occur when this test is \
+ run. This text is probably beginning to sound like drivel, but I've \
+ run out of things to say and I need more characters still.}
+ set a($long) 777
+ set b $a($long)
+ list $b [array names a]
+} {777 {{This is a very long variable, long enough to cause storage \
+ allocation to occur in Tcl_ParseVar. If that storage isn't getting \
+ freed up correctly, then a core leak will occur when this test is \
+ run. This text is probably beginning to sound like drivel, but I've \
+ run out of things to say and I need more characters still.}}}
+test parseOld-5.14 {array variable substitution} {
+ catch {unset a}; catch {unset b}; catch {unset a1}
+ set a1(22) foo
+ set a(foo) bar
+ set b $a($a1(22))
+ set b
+} bar
+catch {unset a}; catch {unset a1}
+
+test parseOld-7.1 {backslash substitution} {
+ set a "\a\c\n\]\}"
+ string length $a
+} 5
+test parseOld-7.2 {backslash substitution} {
+ set a {\a\c\n\]\}}
+ string length $a
+} 10
+test parseOld-7.3 {backslash substitution} {
+ set a "abc\
+def"
+ set a
+} {abc def}
+test parseOld-7.4 {backslash substitution} {
+ set a {abc\
+def}
+ set a
+} {abc def}
+test parseOld-7.5 {backslash substitution} {
+ set msg {}
+ set a xxx
+ set error [catch {if {24 < \
+ 35} {set a 22} {set \
+ a 33}} msg]
+ list $error $msg $a
+} {0 22 22}
+test parseOld-7.6 {backslash substitution} {
+ eval "concat abc\\"
+} "abc\\"
+test parseOld-7.7 {backslash substitution} {
+ eval "concat \\\na"
+} "a"
+test parseOld-7.8 {backslash substitution} {
+ eval "concat x\\\n a"
+} "x a"
+test parseOld-7.9 {backslash substitution} {
+ eval "concat \\x"
+} "x"
+test parseOld-7.10 {backslash substitution} {
+ eval "list a b\\\nc d"
+} {a b c d}
+test parseOld-7.11 {backslash substitution} {
+ eval "list a \"b c\"\\\nd e"
+} {a {b c} d e}
+test parseOld-7.12 {backslash substitution} {
+ list \ua2
+} [bytestring "\xc2\xa2"]
+test parseOld-7.13 {backslash substitution} {
+ list \u4e21
+} [bytestring "\xe4\xb8\xa1"]
+test parseOld-7.14 {backslash substitution} {
+ list \u4e2k
+} [bytestring "\xd3\xa2k"]
+
+# Semi-colon.
+
+test parseOld-8.1 {semi-colons} {
+ set b 0
+ getArgs a;set b 2
+ set argv
+} a
+test parseOld-8.2 {semi-colons} {
+ set b 0
+ getArgs a;set b 2
+ set b
+} 2
+test parseOld-8.3 {semi-colons} {
+ getArgs a b ; set b 1
+ set argv
+} {a b}
+test parseOld-8.4 {semi-colons} {
+ getArgs a b ; set b 1
+ set b
+} 1
+
+# The following checks are to ensure that the interpreter's result
+# gets re-initialized by Tcl_Eval in all the right places.
+
+test parseOld-9.1 {result initialization} {concat abc} abc
+test parseOld-9.2 {result initialization} {concat abc; proc foo {} {}} {}
+test parseOld-9.3 {result initialization} {concat abc; proc foo {} $a} {}
+test parseOld-9.4 {result initialization} {proc foo {} [concat abc]} {}
+test parseOld-9.5 {result initialization} {concat abc; } abc
+test parseOld-9.6 {result initialization} {
+ eval {
+ concat abc
+}} abc
+test parseOld-9.7 {result initialization} {} {}
+test parseOld-9.8 {result initialization} {concat abc; ; ;} abc
+
+# Syntax errors.
+
+test parseOld-10.1 {syntax errors} {catch "set a \{bcd" msg} 1
+test parseOld-10.2 {syntax errors} {
+ catch "set a \{bcd" msg
+ set msg
+} {missing close-brace}
+test parseOld-10.3 {syntax errors} {catch {set a "bcd} msg} 1
+test parseOld-10.4 {syntax errors} {
+ catch {set a "bcd} msg
+ set msg
+} {missing "}
+test parseOld-10.5 {syntax errors} {catch {set a "bcd"xy} msg} 1
+test parseOld-10.6 {syntax errors} {
+ catch {set a "bcd"xy} msg
+ set msg
+} {extra characters after close-quote}
+test parseOld-10.7 {syntax errors} {catch "set a {bcd}xy" msg} 1
+test parseOld-10.8 {syntax errors} {
+ catch "set a {bcd}xy" msg
+ set msg
+} {extra characters after close-brace}
+test parseOld-10.9 {syntax errors} {catch {set a [format abc} msg} 1
+test parseOld-10.10 {syntax errors} {
+ catch {set a [format abc} msg
+ set msg
+} {missing close-bracket}
+test parseOld-10.11 {syntax errors} {catch gorp-a-lot msg} 1
+test parseOld-10.12 {syntax errors} {
+ catch gorp-a-lot msg
+ set msg
+} {invalid command name "gorp-a-lot"}
+test parseOld-10.13 {syntax errors} {
+ set a [concat {a}\
+ {b}]
+ set a
+} {a b}
+
+# The next test will fail on the Mac, 'cause the MSL uses a fixed sized
+# buffer for %d conversions (LAME!). I won't leave the test out, however,
+# since MetroWerks may some day fix this.
+
+test parseOld-10.14 {syntax errors} {
+ list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
+} {1 {missing )} {missing )
+ while executing
+"$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000..."
+ ("eval" body line 1)
+ invoked from within
+"eval \$x[format "%01000d" 0]("}}
+test parseOld-10.15 {syntax errors, missplaced braces} {
+ catch {
+ proc misplaced_end_brace {} {
+ set what foo
+ set when [expr ${what}size - [set off$what]}]
+ } msg
+ set msg
+} {extra characters after close-brace}
+test parseOld-10.16 {syntax errors, missplaced braces} {
+ catch {
+ set a {
+ set what foo
+ set when [expr ${what}size - [set off$what]}]
+ } msg
+ set msg
+} {extra characters after close-brace}
+test parseOld-10.17 {syntax errors, unusual spacing} {
+ list [catch {return [ [1]]} msg] $msg
+} {1 {invalid command name "1"}}
+# Long values (stressing storage management)
+
+set a {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH}
+
+test parseOld-11.1 {long values} {
+ string length $a
+} 214
+test parseOld-11.2 {long values} {
+ llength $a
+} 43
+test parseOld-11.3 {long values} {
+ set b "1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH"
+ set b
+} $a
+test parseOld-11.4 {long values} {
+ set b "$a"
+ set b
+} $a
+test parseOld-11.5 {long values} {
+ set b [set a]
+ set b
+} $a
+test parseOld-11.6 {long values} {
+ set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
+ string length $b
+} 214
+test parseOld-11.7 {long values} {
+ set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
+ llength $b
+} 43
+test parseOld-11.8 {long values} {
+ set b
+} $a
+test parseOld-11.9 {long values} {
+ set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ]
+ llength $a
+} 62
+set i 0
+foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] {
+ set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i]
+ set test $test$test$test$test
+ set i [expr $i+1]
+ test parseOld-11.10 {long values} {
+ set j
+ } $test
+}
+test parseOld-11.11 {test buffer overflow in backslashes in braces} {
+ expr {"a" == {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101}}
+} 0
+
+test parseOld-12.1 {comments} {
+ set a old
+ eval { # set a new}
+ set a
+} {old}
+test parseOld-12.2 {comments} {
+ set a old
+ eval " # set a new\nset a new"
+ set a
+} {new}
+test parseOld-12.3 {comments} {
+ set a old
+ eval " # set a new\\\nset a new"
+ set a
+} {old}
+test parseOld-12.4 {comments} {
+ set a old
+ eval " # set a new\\\\\nset a new"
+ set a
+} {new}
+
+test parseOld-13.1 {comments at the end of a bracketed script} {
+ set x "[
+expr 1+1
+# skip this!
+]"
+} {2}
+
+if {[info command testwordend] == "testwordend"} {
+ test parseOld-14.1 {TclWordEnd procedure} {
+ testwordend " \n abc"
+ } {c}
+ test parseOld-14.2 {TclWordEnd procedure} {
+ testwordend " \\\n"
+ } {}
+ test parseOld-14.3 {TclWordEnd procedure} {
+ testwordend " \\\n "
+ } { }
+ test parseOld-14.4 {TclWordEnd procedure} {
+ testwordend {"abc"}
+ } {"}
+ test parseOld-14.5 {TclWordEnd procedure} {
+ testwordend {{xyz}}
+ } \}
+ test parseOld-14.6 {TclWordEnd procedure} {
+ testwordend {{a{}b{}\}} xyz}
+ } "\} xyz"
+ test parseOld-14.7 {TclWordEnd procedure} {
+ testwordend {abc[this is a]def ghi}
+ } {f ghi}
+ test parseOld-14.8 {TclWordEnd procedure} {
+ testwordend "puts\\\n\n "
+ } "s\\\n\n "
+ test parseOld-14.9 {TclWordEnd procedure} {
+ testwordend "puts\\\n "
+ } "s\\\n "
+ test parseOld-14.10 {TclWordEnd procedure} {
+ testwordend "puts\\\n xyz"
+ } "s\\\n xyz"
+ test parseOld-14.11 {TclWordEnd procedure} {
+ testwordend {a$x.$y(a long index) foo}
+ } ") foo"
+ test parseOld-14.12 {TclWordEnd procedure} {
+ testwordend {abc; def}
+ } {; def}
+ test parseOld-14.13 {TclWordEnd procedure} {
+ testwordend {abc def}
+ } {c def}
+ test parseOld-14.14 {TclWordEnd procedure} {
+ testwordend {abc def}
+ } {c def}
+ test parseOld-14.15 {TclWordEnd procedure} {
+ testwordend "abc\ndef"
+ } "c\ndef"
+ test parseOld-14.16 {TclWordEnd procedure} {
+ testwordend "abc"
+ } {c}
+ test parseOld-14.17 {TclWordEnd procedure} {
+ testwordend "a\000bc"
+ } {c}
+ test parseOld-14.18 {TclWordEnd procedure} {
+ testwordend \[a\000\]
+ } {]}
+ test parseOld-14.19 {TclWordEnd procedure} {
+ testwordend \"a\000\"
+ } {"}
+ test parseOld-14.20 {TclWordEnd procedure} {
+ testwordend a{\000}b
+ } {b}
+ test parseOld-14.21 {TclWordEnd procedure} {
+ testwordend " \000b"
+ } {b}
+}
+
+test parseOld-15.1 {TclScriptEnd procedure} {
+ info complete {puts [
+ expr 1+1
+ #this is a comment ]}
+} {0}
+test parseOld-15.2 {TclScriptEnd procedure} {
+ info complete "abc\\\n"
+} {0}
+test parseOld-15.3 {TclScriptEnd procedure} {
+ info complete "abc\\\\\n"
+} {1}
+test parseOld-15.4 {TclScriptEnd procedure} {
+ info complete "xyz \[abc \{abc\]"
+} {0}
+test parseOld-15.5 {TclScriptEnd procedure} {
+ info complete "xyz \[abc"
+} {0}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/pid.test b/tcl/tests/pid.test
index 85c44cff9e9..bd4ea090ecb 100644
--- a/tcl/tests/pid.test
+++ b/tcl/tests/pid.test
@@ -6,21 +6,26 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
# If pid is not defined just return with no error
# Some platforms may not have the pid command implemented
if {[info commands pid] == ""} {
puts "pid is not implemented for this machine"
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
catch {removeFile test1}
test pid-1.1 {pid command} {
@@ -48,5 +53,20 @@ test pid-1.5 {pid command} {
list [catch {pid gorp} msg] $msg
} {1 {can not find channel named "gorp"}}
-catch {removeFile test1}
-concat {}
+# cleanup
+catch {::tcltest::removeFile test1}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/pkg.test b/tcl/tests/pkg.test
index 5d6314bce93..77848537b59 100644
--- a/tcl/tests/pkg.test
+++ b/tcl/tests/pkg.test
@@ -5,23 +5,26 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Do all this in a slave interp to avoid garbaging the
# package list
set i [interp create]
-interp eval $i [list set VERBOSE $VERBOSE]
-interp eval $i [list set TESTS $TESTS]
+interp eval $i [list set argv $argv]
+interp eval $i [list package require tcltest]
+interp eval $i [list namespace import -force ::tcltest::*]
interp eval $i {
-if {[string compare test [info procs test]] == 1} then {source defs}
-
eval package forget [package names]
set oldPkgUnknown [package unknown]
package unknown {}
@@ -483,7 +486,7 @@ test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
} {0}
test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} {
list [catch {package foo} msg] $msg
-} {1 {bad option "foo": should be forget, ifneeded, names, provide, require, unknown, vcompare, versions, or vsatisfies}}
+} {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
# No tests for FindPackage; can't think up anything detectable
# errors.
@@ -526,6 +529,9 @@ test pkg-5.3 {CheckVersion procedure} {
test pkg-5.4 {CheckVersion procedure} {
list [catch {package vcompare 1.2.3. 2.1} msg] $msg
} {1 {expected version number but got "1.2.3."}}
+test pkg-5.5 {CheckVersion procedure} {
+ list [catch {package vcompare 1.2..3 2.1} msg] $msg
+} {1 {expected version number but got "1.2..3"}}
test pkg-6.1 {ComparePkgVersions procedure} {
package vcompare 1.23 1.22
@@ -555,9 +561,98 @@ test pkg-6.9 {ComparePkgVersions procedure} {
package vsatisfies 2 1
} {0}
+test pkg-7.1 {Tcl_PkgPresent procedure, any version} {
+ package forget t
+ package provide t 2.4
+ package present t
+} {2.4}
+test pkg-7.2 {Tcl_PkgPresent procedure, correct version} {
+ package forget t
+ package provide t 2.4
+ package present t 2.4
+} {2.4}
+test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} {
+ package forget t
+ package provide t 2.4
+ package present t 2.0
+} {2.4}
+test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} {
+ package forget t
+ package provide t 2.4
+ list [catch {package present t 2.6} msg] $msg
+} {1 {version conflict for package "t": have 2.4, need 2.6}}
+test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} {
+ package forget t
+ package provide t 2.4
+ list [catch {package present t 1.0} msg] $msg
+} {1 {version conflict for package "t": have 2.4, need 1.0}}
+test pkg-7.6 {Tcl_PkgPresent procedure, exact version} {
+ package forget t
+ package provide t 2.4
+ package present -exact t 2.4
+} {2.4}
+test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} {
+ package forget t
+ package provide t 2.4
+ list [catch {package present -exact t 2.3} msg] $msg
+} {1 {version conflict for package "t": have 2.4, need 2.3}}
+test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} {
+ package forget t
+ list [catch {package present t} msg] $msg
+} {1 {package t is not present}}
+test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} {
+ package forget t
+ list [catch {package present t 2.4} msg] $msg
+} {1 {package t 2.4 is not present}}
+test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} {
+ package forget t
+ list [catch {package present -exact t 2.4} msg] $msg
+} {1 {package t 2.4 is not present}}
+test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} {
+ list [catch {package present} msg] $msg
+} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} {
+ list [catch {package present a b c} msg] $msg
+} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} {
+ list [catch {package present -exact a b c} msg] $msg
+} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} {
+ list [catch {package present -bs a b} msg] $msg
+} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} {
+ list [catch {package present x a.b} msg] $msg
+} {1 {expected version number but got "a.b"}}
+test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} {
+ list [catch {package present -exact x a.b} msg] $msg
+} {1 {expected version number but got "a.b"}}
+test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} {
+ list [catch {package present -exact x} msg] $msg
+} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} {
+ list [catch {package present -exact} msg] $msg
+} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+
set auto_path $oldPath
package unknown $oldPkgUnknown
concat
}
+
+# cleanup
interp delete $i
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/pkg/import.tcl b/tcl/tests/pkg/import.tcl
new file mode 100644
index 00000000000..e7196f532ef
--- /dev/null
+++ b/tcl/tests/pkg/import.tcl
@@ -0,0 +1,16 @@
+package provide fubar 1.0
+
+namespace eval ::fubar:: {
+ #
+ # export only public functions.
+ #
+ namespace export {[a-z]*}
+}
+
+proc ::fubar::foo {bar} {
+ puts "$bar"
+ return true
+}
+
+namespace import ::fubar::foo
+
diff --git a/tcl/tests/pkg/license.terms b/tcl/tests/pkg/license.terms
new file mode 100644
index 00000000000..9df3e600352
--- /dev/null
+++ b/tcl/tests/pkg/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., Scriptics Corporation,
+and other parties. The following terms apply to all files associated
+with the software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tcl/tests/pkg/magicchar.tcl b/tcl/tests/pkg/magicchar.tcl
new file mode 100644
index 00000000000..dc68fcd9699
--- /dev/null
+++ b/tcl/tests/pkg/magicchar.tcl
@@ -0,0 +1,6 @@
+set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
+set dollar2 "this string contains an escaped dollar sign -> \$foo \\\$foo"
+set bracket1 "this contains an unescaped bracket [NoSuchProc]"
+set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
+set bracket3 "this contains nested unescaped brackets [[NoSuchProc]]"
+proc testProc {} {}
diff --git a/tcl/tests/pkg/magicchar2.tcl b/tcl/tests/pkg/magicchar2.tcl
new file mode 100644
index 00000000000..2e7b47f649d
--- /dev/null
+++ b/tcl/tests/pkg/magicchar2.tcl
@@ -0,0 +1 @@
+proc {[magic mojo proc]} {} {}
diff --git a/tcl/tests/pkg/samename.tcl b/tcl/tests/pkg/samename.tcl
new file mode 100644
index 00000000000..8aa50808c5e
--- /dev/null
+++ b/tcl/tests/pkg/samename.tcl
@@ -0,0 +1,25 @@
+package provide football 1.0
+
+namespace eval ::pro:: {
+ #
+ # export only public functions.
+ #
+ namespace export {[a-z]*}
+}
+namespace eval ::college:: {
+ #
+ # export only public functions.
+ #
+ namespace export {[a-z]*}
+}
+
+proc ::pro::team {} {
+ puts "go packers!"
+ return true
+}
+
+proc ::college::team {} {
+ puts "go badgers!"
+ return true
+}
+
diff --git a/tcl/tests/pkg/spacename.tcl b/tcl/tests/pkg/spacename.tcl
new file mode 100644
index 00000000000..7b48e7617ed
--- /dev/null
+++ b/tcl/tests/pkg/spacename.tcl
@@ -0,0 +1,3 @@
+package provide spacename 1.0
+proc {a b} {} {}
+proc {c d} {} {}
diff --git a/tcl/tests/pkgMkIndex.test b/tcl/tests/pkgMkIndex.test
index 83fd704bb0d..0acb34a0b1f 100644
--- a/tcl/tests/pkgMkIndex.test
+++ b/tcl/tests/pkgMkIndex.test
@@ -5,20 +5,26 @@
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+set origDir [pwd]
+cd $::tcltest::testsDirectory
+
+set fullPkgPath [file join $::tcltest::testsDirectory pkg]
# Add the pkg1 directory to auto_path, so that its packages can be found.
# packages in pkg1 are used to test indexing of packages in pkg.
# Make sure that the path to pkg1 is absolute.
-set scriptDir [file dirname [info script]]
-set oldDir [pwd]
-lappend auto_path [file join [pwd] $scriptDir pkg1]
+lappend auto_path [file join $::tcltest::testsDirectory pkg1]
namespace eval pkgtest {
# Namespace for procs we can discard
@@ -155,6 +161,8 @@ proc pkgtest::createIndex { args } {
set dirPath [lindex $parsed 1]
set patternList [lindex $parsed 2]
+ file mkdir $dirPath
+
if {[catch {
file delete [file join $dirPath pkgIndex.tcl]
eval pkg_mkIndex $options $dirPath $patternList
@@ -240,7 +248,7 @@ proc pkgtest::runIndex { args } {
set result [list 0 [makePkgList [parseIndex $idxFile]]]
} err]} {
set result [list 1 $err]
- }
+ }
file delete $idxFile
} else {
set result $rv
@@ -253,29 +261,33 @@ proc pkgtest::runIndex { args } {
# changed on us
test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} {
- list [pkgtest::runIndex pkg nomatch.tcl] [pwd]
+ list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd]
} [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]]
-cd $oldDir ;# 'cause 8.0.3 is left in the wrong place
+
test pkgMkIndex-2.1 {simple package} {
- pkgtest::runIndex pkg simple.tcl
+ pkgtest::runIndex -lazy $fullPkgPath simple.tcl
} {0 {{simple:1.0 {tclPkgSetup {simple.tcl source {::simple::lower ::simple::upper}}}}}}
test pkgMkIndex-2.2 {simple package - use -direct} {
- pkgtest::runIndex -direct pkg simple.tcl
-} "0 {{simple:1.0 {source [file join pkg simple.tcl]}}}"
+ pkgtest::runIndex -direct $fullPkgPath simple.tcl
+} "0 {{simple:1.0 {source [file join $fullPkgPath simple.tcl]}}}"
+
+test pkgMkIndex-2.3 {simple package - direct loading is default} {
+ pkgtest::runIndex $fullPkgPath simple.tcl
+} "0 {{simple:1.0 {source [file join $fullPkgPath simple.tcl]}}}"
test pkgMkIndex-3.1 {simple package with global symbols} {
- pkgtest::runIndex pkg global.tcl
+ pkgtest::runIndex -lazy $fullPkgPath global.tcl
} {0 {{global:1.0 {tclPkgSetup {global.tcl source {global_lower global_upper}}}}}}
test pkgMkIndex-4.1 {split package} {
- pkgtest::runIndex pkg pkg2_a.tcl pkg2_b.tcl
+ pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl
} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}}
test pkgMkIndex-4.2 {split package - direct loading} {
- pkgtest::runIndex -direct pkg pkg2_a.tcl pkg2_b.tcl
-} "0 {{pkg2:1.0 {source [file join pkg pkg2_a.tcl]
-source [file join pkg pkg2_b.tcl]}}}"
+ pkgtest::runIndex -direct $fullPkgPath pkg2_a.tcl pkg2_b.tcl
+} "0 {{pkg2:1.0 {source [file join $fullPkgPath pkg2_a.tcl]
+source [file join $fullPkgPath pkg2_b.tcl]}}}"
# This will fail, with "direct1" procedures in the list of procedures
# provided by std.
@@ -284,57 +296,77 @@ source [file join pkg pkg2_b.tcl]}}}"
# Both failures are caused by Tcl code executed in pkgIndex.tcl.
test pkgMkIndex-5.1 {requires -direct package} {
- pkgtest::runIndex pkg std.tcl
+ pkgtest::runIndex -lazy $fullPkgPath std.tcl
} {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}}
test pkgMkIndex-6.1 {pkg1 requires pkg3} {
- pkgtest::runIndex pkg pkg1.tcl pkg3.tcl
+ pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl
} {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}}
test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} {
- pkgtest::runIndex -direct pkg pkg1.tcl pkg3.tcl
-} "0 {{pkg1:1.0 {source [file join pkg pkg1.tcl]}} {pkg3:1.0 {source [file join pkg pkg3.tcl]}}}"
+ pkgtest::runIndex -direct $fullPkgPath pkg1.tcl pkg3.tcl
+} "0 {{pkg1:1.0 {source [file join $fullPkgPath pkg1.tcl]}} {pkg3:1.0 {source [file join $fullPkgPath pkg3.tcl]}}}"
test pkgMkIndex-7.1 {pkg4 uses pkg3} {
- pkgtest::runIndex pkg pkg4.tcl pkg3.tcl
+ pkgtest::runIndex -lazy $fullPkgPath pkg4.tcl pkg3.tcl
} {0 {{pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}} {pkg4:1.0 {tclPkgSetup {pkg4.tcl source {::pkg4::p4-1 ::pkg4::p4-2}}}}}}
test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} {
- pkgtest::runIndex -direct pkg pkg4.tcl pkg3.tcl
-} "0 {{pkg3:1.0 {source [file join pkg pkg3.tcl]}} {pkg4:1.0 {source [file join pkg pkg4.tcl]}}}"
+ pkgtest::runIndex -direct $fullPkgPath pkg4.tcl pkg3.tcl
+} "0 {{pkg3:1.0 {source [file join $fullPkgPath pkg3.tcl]}} {pkg4:1.0 {source [file join $fullPkgPath pkg4.tcl]}}}"
test pkgMkIndex-8.1 {pkg5 uses pkg2} {
- pkgtest::runIndex pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl
+ pkgtest::runIndex -lazy $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl
} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}} {pkg5:1.0 {tclPkgSetup {pkg5.tcl source {::pkg5::p5-1 ::pkg5::p5-2}}}}}}
test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} {
- pkgtest::runIndex -direct pkg pkg5.tcl pkg2_a.tcl pkg2_b.tcl
-} "0 {{pkg2:1.0 {source [file join pkg pkg2_a.tcl]
-source [file join pkg pkg2_b.tcl]}} {pkg5:1.0 {source [file join pkg pkg5.tcl]}}}"
+ pkgtest::runIndex -direct $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl
+} "0 {{pkg2:1.0 {source [file join $fullPkgPath pkg2_a.tcl]
+source [file join $fullPkgPath pkg2_b.tcl]}} {pkg5:1.0 {source [file join $fullPkgPath pkg5.tcl]}}}"
test pkgMkIndex-9.1 {circular packages} {
- pkgtest::runIndex pkg circ1.tcl circ2.tcl circ3.tcl
+ pkgtest::runIndex -lazy $fullPkgPath circ1.tcl circ2.tcl circ3.tcl
} {0 {{circ1:1.0 {tclPkgSetup {circ1.tcl source {::circ1::c1-1 ::circ1::c1-2 ::circ1::c1-3 ::circ1::c1-4}}}} {circ2:1.0 {tclPkgSetup {circ2.tcl source {::circ2::c2-1 ::circ2::c2-2}}}} {circ3:1.0 {tclPkgSetup {circ3.tcl source ::circ3::c3-1}}}}}
-# Try to find one of the DLLs in the dltest directory
-set x [file join [pwd] [file dirname [info script]]]
-set x [file join $x ../unix/dltest/pkga[info sharedlibextension]]
-if {[file exists $x]} {
- file copy -force $x pkg
- test pkgMkIndex-10.1 {package in DLL and script} {
- pkgtest::runIndex pkg pkga[info sharedlibextension] pkga.tcl
- } {0 {{Pkga:1.0 {tclPkgSetup {pkga.so load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}}
- test pkgMkIndex-10.2 {package in DLL hidden by -load} {
- pkgtest::runIndex -load Pkg* -- pkg pkga[info sharedlibextension]
- } {0 {}}
-} else {
- puts "Skipping pkgMkIndex-10.1 (index of DLL and script)"
-}
+# Some tests require the existence of one of the DLLs in the dltest directory
+set x [file join [file dirname [info nameofexecutable]] dltest \
+ pkga[info sharedlibextension]]
+set dll "[file tail $x]Required"
+set ::tcltest::testConstraints($dll) [file exists $x]
+
+test pkgMkIndex-10.1 {package in DLL and script} $dll {
+ file copy -force $x $fullPkgPath
+ pkgtest::runIndex -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
+} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
+test pkgMkIndex-10.2 {package in DLL hidden by -load} $dll {
+ pkgtest::runIndex -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
+} {0 {}}
+
+# Tolerate "namespace import" at the global scope
+
+test pkgMkIndex-11.1 {conflicting namespace imports} {
+ pkgtest::runIndex -lazy $fullPkgPath import.tcl
+} {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}}
+
+# Verify that the auto load list generated is correct even when there
+# is a proc name conflict between two namespaces (ie, ::foo::baz and
+# ::bar::baz)
+
+test pkgMkIndex-12.1 {same name procs in different namespace} {
+ pkgtest::runIndex -lazy $fullPkgPath samename.tcl
+} {0 {{football:1.0 {tclPkgSetup {samename.tcl source {::college::team ::pro::team}}}}}}
+
+# Proc names with embedded spaces are properly listed (ie, correct number of
+# braces) in result
+test pkgMkIndex-13.1 {proc names with embedded spaces} {
+ pkgtest::runIndex -lazy $fullPkgPath spacename.tcl
+} {0 {{spacename:1.0 {tclPkgSetup {spacename.tcl source {{a b} {c d}}}}}}}
-#
# cleanup
-#
-if {![info exist TESTS]} {
- file delete [file join pkg pkgIndex.tcl]
- namespace delete pkgtest
-}
+
+namespace delete pkgtest
+cd $origDir
+::tcltest::cleanupTests
+return
+
+
diff --git a/tcl/tests/platform.test b/tcl/tests/platform.test
new file mode 100644
index 00000000000..9c7dec51a5d
--- /dev/null
+++ b/tcl/tests/platform.test
@@ -0,0 +1,41 @@
+# The file tests the tcl_platform variable
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1999 by Scriptics Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#)
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+test platform-1.1 {TclpSetVariables: tcl_platform} {
+ interp create i
+ i eval {catch {unset tcl_platform(debug)}}
+ i eval {catch {unset tcl_platform(threaded)}}
+ set result [i eval {lsort [array names tcl_platform]}]
+ interp delete i
+ set result
+} {byteOrder machine os osVersion platform user}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/proc-old.test b/tcl/tests/proc-old.test
index 60a1616608f..eec85d2b91e 100644
--- a/tcl/tests/proc-old.test
+++ b/tcl/tests/proc-old.test
@@ -9,13 +9,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {rename t1 ""}
catch {rename foo ""}
@@ -501,5 +505,21 @@ test proc-old-10.1 {ByteCode epoch change during recursive proc execution} {
t1 1
} 20
+# cleanup
catch {rename t1 ""}
catch {rename foo ""}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/proc.test b/tcl/tests/proc.test
index f00a42137ef..7820404e357 100644
--- a/tcl/tests/proc.test
+++ b/tcl/tests/proc.test
@@ -8,13 +8,17 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename p ""}
@@ -165,6 +169,7 @@ catch {unset msg}
if {[catch {package require procbodytest}]} {
puts "This application couldn't load the \"procbodytest\" package, so I"
puts "can't test creation of procs whose bodies have type \"procbody\"."
+ ::tcltest::cleanupTests
return
}
@@ -289,5 +294,21 @@ test proc-4.7 {TclCreateProc, procbody obj, inconsitent arg default value} {
set result
} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
+# cleanup
catch {rename p ""}
catch {rename t ""}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/pwd.test b/tcl/tests/pwd.test
index b6455cb649e..6cf000753d2 100644
--- a/tcl/tests/pwd.test
+++ b/tcl/tests/pwd.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test pwd-1.1 {simple pwd} {
catch pwd
@@ -20,3 +24,20 @@ test pwd-1.1 {simple pwd} {
test pwd-1.2 {simple pwd} {
expr [string length pwd]>0
} 1
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/reg.test b/tcl/tests/reg.test
new file mode 100644
index 00000000000..acc250cae23
--- /dev/null
+++ b/tcl/tests/reg.test
@@ -0,0 +1,995 @@
+# reg.test --
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+# (Don't panic if you are seeing this as part of the reg distribution
+# and aren't using Tcl -- reg's own regression tester also knows how
+# to read this file, ignoring the Tcl-isms.)
+#
+# Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# All tests require the testregexp command, return if this
+# command doesn't exist
+
+set ::tcltest::testConstraints(testregexp) \
+ [expr {[info commands testregexp] != {}}]
+set ::tcltest::testConstraints(localeRegexp) 0
+
+# This file uses some custom procedures, defined below, for regexp regression
+# testing. The name of the procedure indicates the general nature of the
+# test:
+# e compile error expected
+# f match failure expected
+# m successful match
+# i successful match with -indices (used in checking things like
+# nonparticipating subexpressions)
+# p unsuccessful match with -indices (!!) (used in checking
+# partial-match reporting)
+# There is also "doing" which sets up title and major test number for each
+# block of tests.
+
+# The first 3 arguments are constant: a minor number (which often gets
+# a letter or two suffixed to it internally), some flags, and the RE itself.
+# For e, the remaining argument is the name of the compile error expected,
+# less the leading "REG_". For the rest, the next argument is the string
+# to try the match against. Remaining arguments are the substring expected
+# to be matched, and any substrings expected to be matched by subexpressions.
+# (For f, these arguments are optional, and if present are ignored except
+# that they indicate how many subexpressions should be present in the RE.)
+# It is an error for the number of subexpression arguments to be wrong.
+# Cases involving nonparticipating subexpressions, checking where empty
+# substrings are located, etc. should be done using i and p.
+
+# The flag characters are complex and a bit eclectic. Generally speaking,
+# lowercase letters are compile options, uppercase are expected re_info
+# bits, and nonalphabetics are match options, controls for how the test is
+# run, or testing options. The one small surprise is that AREs are the
+# default, and you must explicitly request lesser flavors of RE. The flags
+# are as follows. It is admitted that some are not very mnemonic.
+# There are some others which are purely debugging tools and are not
+# useful in this file.
+#
+# - no-op (placeholder)
+# + provide fake xy equivalence class and ch collating element
+# % force small state-set cache in matcher (to test cache replace)
+# ^ beginning of string is not beginning of line
+# $ end of string is not end of line
+# * test is Unicode-specific, needs big character set
+#
+# & test as both ARE and BRE
+# b BRE
+# e ERE
+# a turn advanced-features bit on (error unless ERE already)
+# q literal string, no metacharacters at all
+#
+# i case-independent matching
+# o ("opaque") no subexpression capture
+# p newlines are half-magic, excluded from . and [^ only
+# w newlines are half-magic, significant to ^ and $ only
+# n newlines are fully magic, both effects
+# x expanded RE syntax
+# t incomplete-match reporting
+#
+# A backslash-_a_lphanumeric seen
+# B ERE/ARE literal-_b_race heuristic used
+# E backslash (_e_scape) seen within []
+# H looka_h_ead constraint seen
+# I _i_mpossible to match
+# L _l_ocale-specific construct seen
+# M unportable (_m_achine-specific) construct seen
+# N RE can match empty (_n_ull) string
+# P non-_P_OSIX construct seen
+# Q {} _q_uantifier seen
+# R back _r_eference seen
+# S POSIX-un_s_pecified syntax seen
+# T prefers shortest (_t_iny)
+# U saw original-POSIX botch: unmatched right paren in ERE (_u_gh)
+
+# The one area we can't easily test is memory-allocation failures (which
+# are hard to provoke on command). Embedded NULs also are not tested at
+# the moment, but this is a historical accident which should be fixed.
+
+
+
+# test procedures and related
+
+set ask "about"
+set xflags "xflags"
+set testbypassed 0
+
+# re_info abbreviation mapping table
+set infonames(A) "REG_UBSALNUM"
+set infonames(B) "REG_UBRACES"
+set infonames(E) "REG_UBBS"
+set infonames(H) "REG_ULOOKAHEAD"
+set infonames(I) "REG_UIMPOSSIBLE"
+set infonames(L) "REG_ULOCALE"
+set infonames(M) "REG_UUNPORT"
+set infonames(N) "REG_UEMPTYMATCH"
+set infonames(P) "REG_UNONPOSIX"
+set infonames(Q) "REG_UBOUNDS"
+set infonames(R) "REG_UBACKREF"
+set infonames(S) "REG_UUNSPEC"
+set infonames(T) "REG_USHORTEST"
+set infonames(U) "REG_UPBOTCH"
+set infonameorder "RHQBAUEPSMLNIT" ;# must match bit order, lsb first
+
+# set major test number and description
+proc doing {major desc} {
+ global prefix description testbypassed
+
+ if {$testbypassed != 0} {
+ puts stdout "!!! bypassed $testbypassed tests in\
+ $prefix, `$description'"
+ }
+
+ set prefix reg-$major
+ set description "reg $desc"
+ set testbypassed 0
+}
+
+# build test number (internal)
+proc tno {testid} {
+ return [lindex $testid 0]
+}
+
+# build description, with possible modifiers (internal)
+proc desc {testid} {
+ global description
+
+ set d $description
+ if {[llength $testid] > 1} {
+ set d "([lreplace $testid 0 0]) $d"
+ }
+ return $d
+}
+
+# build trailing options and flags argument from a flags string (internal)
+proc flags {fl} {
+ global xflags
+
+ set args [list]
+ set flags ""
+ foreach f [split $fl ""] {
+ switch -exact -- $f {
+ "i" { lappend args "-nocase" }
+ "x" { lappend args "-expanded" }
+ "n" { lappend args "-line" }
+ "p" { lappend args "-linestop" }
+ "w" { lappend args "-lineanchor" }
+ "-" { }
+ default { append flags $f }
+ }
+ }
+ if {[string compare $flags ""] != 0} {
+ lappend args -$xflags $flags
+ }
+ return $args
+}
+
+# build info-flags list from a flags string (internal)
+proc infoflags {fl} {
+ global infonames infonameorder
+
+ set ret [list]
+ foreach f [split $infonameorder ""] {
+ if {[string first $f $fl] >= 0} {
+ lappend ret $infonames($f)
+ }
+ }
+ return $ret
+}
+
+# compilation error expected
+proc e {testid flags re err} {
+ global prefix ask errorCode
+
+ # Tcl locale stuff doesn't do the ch/xy test fakery yet
+ if {[string first "+" $flags] >= 0} {
+ # This will register as a skipped test
+ test $prefix.[tno $testid] [desc $testid] localeRegexp {} {}
+ return
+ }
+
+ # if &, test as both ARE and BRE
+ set amp [string first "&" $flags]
+ if {$amp >= 0} {
+ set f [string range $flags 0 [expr $amp - 1]]
+ append f [string range $flags [expr $amp + 1] end]
+ e [linsert $testid end ARE] ${f} $re $err
+ e [linsert $testid end BRE] ${f}b $re $err
+ return
+ }
+
+ set cmd [concat [list testregexp -$ask] [flags $flags] [list $re]]
+ set run "list \[catch \{$cmd\}\] \[lindex \$errorCode 1\]"
+ test $prefix.[tno $testid] [desc $testid] \
+ {testregexp} $run [list 1 REG_$err]
+}
+
+# match failure expected
+proc f {testid flags re target args} {
+ global prefix description ask
+
+ # Tcl locale stuff doesn't do the ch/xy test fakery yet
+ if {[string first "+" $flags] >= 0} {
+ # This will register as a skipped test
+ test $prefix.[tno $testid] [desc $testid] localeRegexp {} {}
+ return
+ }
+
+ # if &, test as both ARE and BRE
+ set amp [string first "&" $flags]
+ if {$amp >= 0} {
+ set f [string range $flags 0 [expr $amp - 1]]
+ append f [string range $flags [expr $amp + 1] end]
+ eval [linsert $args 0 f [linsert $testid end ARE] ${f} $re \
+ $target]
+ eval [linsert $args 0 f [linsert $testid end BRE] ${f}b $re \
+ $target]
+ return
+ }
+
+ set f [flags $flags]
+ set infoflags [infoflags $flags]
+ set ccmd [concat [list testregexp -$ask] $f [list $re]]
+ set nsub [expr [llength $args] - 1]
+ if {$nsub == -1} {
+ # didn't tell us number of subexps
+ set ccmd "lreplace \[$ccmd\] 0 0"
+ set info [list $infoflags]
+ } else {
+ set info [list $nsub $infoflags]
+ }
+ lappend testid "compile"
+ test $prefix.[tno $testid] [desc $testid] {testregexp} $ccmd $info
+
+ set testid [lreplace $testid end end "execute"]
+ set ecmd [concat [list testregexp] $f [list $re $target]]
+ test $prefix.[tno $testid] [desc $testid] {testregexp} $ecmd 0
+}
+
+# match expected, internal routine that does the work
+# parameters like the "real" routines except they don't have "opts",
+# which is a possibly-empty list of switches for the regexp match attempt
+# The ! flag is used to indicate expected match failure (for REG_EXPECT,
+# which wants argument testing even in the event of failure).
+proc matchexpected {opts testid flags re target args} {
+ global prefix description ask regBug
+
+ if {[info exists regBug] && $regBug} {
+ # This will register as a skipped test
+ test $prefix.[tno $testid] [desc $testid] knownBug {} {}
+ return
+ }
+
+ # Tcl locale stuff doesn't do the ch/xy test fakery yet
+ if {[string first "+" $flags] >= 0} {
+ # This will register as a skipped test
+ test $prefix.[tno $testid] [desc $testid] localeRegexp {} {}
+ return
+ }
+
+ # if &, test as both BRE and ARE
+ set amp [string first "&" $flags]
+ if {$amp >= 0} {
+ set f [string range $flags 0 [expr $amp - 1]]
+ append f [string range $flags [expr $amp + 1] end]
+ eval [concat [list matchexpected $opts \
+ [linsert $testid end ARE] ${f} $re $target] $args]
+ eval [concat [list matchexpected $opts \
+ [linsert $testid end BRE] ${f}b $re $target] $args]
+ return
+ }
+
+ set f [flags $flags]
+ set infoflags [infoflags $flags]
+ set ccmd [concat [list testregexp -$ask] $f [list $re]]
+ set ecmd [concat [list testregexp] $opts $f [list $re $target]]
+
+ set nsub [expr [llength $args] - 1]
+ set names [list]
+ set refs ""
+ for {set i 0} {$i <= $nsub} {incr i} {
+ if {$i == 0} {
+ set name match
+ } else {
+ set name sub$i
+ }
+ lappend names $name
+ append refs " \$$name"
+ set $name ""
+ }
+ if {[string first "o" $flags] >= 0} { ;# REG_NOSUB kludge
+ set nsub 0 ;# unsigned value cannot be -1
+ }
+ if {[string first "t" $flags] >= 0} { ;# REG_EXPECT
+ incr nsub -1 ;# the extra does not count
+ }
+ set ecmd [concat $ecmd $names]
+ set erun "list \[$ecmd\] $refs"
+ set retcode [list 1]
+ if {[string first "!" $flags] >= 0} {
+ set retcode [list 0]
+ }
+ set result [concat $retcode $args]
+
+ set info [list $nsub $infoflags]
+ lappend testid "compile"
+ test $prefix.[tno $testid] [desc $testid] {testregexp} $ccmd $info
+ set testid [lreplace $testid end end "execute"]
+ test $prefix.[tno $testid] [desc $testid] {testregexp} $erun $result
+}
+
+# match expected (no missing, empty, or ambiguous submatches)
+# m testno flags re target mat submat ...
+proc m {args} {
+ eval matchexpected [linsert $args 0 [list]]
+}
+
+# match expected (full fanciness)
+# i testno flags re target mat submat ...
+proc i {args} {
+ eval matchexpected [linsert $args 0 [list "-indices"]]
+}
+
+# partial match expected
+# p testno flags re target mat "" ...
+# Quirk: number of ""s must be one more than number of subREs.
+proc p {args} {
+ set f [lindex $args 1] ;# add ! flag
+ set args [lreplace $args 1 1 "!$f"]
+ eval matchexpected [linsert $args 0 [list "-indices"]]
+}
+
+# test is a knownBug
+proc knownBug {args} {
+ set ::regBug 1
+ uplevel #0 $args
+ set ::regBug 0
+}
+
+
+
+# the tests themselves
+
+
+
+# support functions and preliminary misc.
+# This is sensitive to changes in message wording, but we really have to
+# test the code->message expansion at least once.
+test reg-0.1 "regexp error reporting" {
+ list [catch {regexp (*) ign} msg] $msg
+} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
+
+
+
+doing 1 "basic sanity checks"
+m 1 & abc abc abc
+f 2 & abc def
+m 3 & abc xyabxabce abc
+
+
+
+doing 2 "invalid option combinations"
+e 1 qe a INVARG
+e 2 qa a INVARG
+e 3 qx a INVARG
+e 4 qn a INVARG
+e 5 ba a INVARG
+
+
+
+doing 3 "basic syntax"
+i 1 &NS "" a {0 -1}
+m 2 NS a| a a
+m 3 - a|b a a
+m 4 - a|b b b
+m 5 NS a||b b b
+m 6 & ab ab ab
+
+
+
+doing 4 "parentheses"
+m 1 - (a)e ae ae a
+m 2 o (a)e ae
+m 3 b {\(a\)b} ab ab a
+m 4 - a((b)c) abc abc bc b
+m 5 - a(b)(c) abc abc b c
+e 6 - a(b EPAREN
+e 7 b {a\(b} EPAREN
+# sigh, we blew it on the specs here... someday this will be fixed in POSIX,
+# but meanwhile, it's fixed in AREs
+m 8 eU a)b a)b a)b
+e 9 - a)b EPAREN
+e 10 b {a\)b} EPAREN
+m 11 P a(?:b)c abc abc
+e 12 e a(?:b)c BADRPT
+i 13 S a()b ab {0 1} {1 0}
+m 14 SP a(?:)b ab ab
+i 15 S a(|b)c ac {0 1} {1 0}
+m 16 S a(b|)c abc abc b
+
+
+
+doing 5 "simple one-char matching"
+# general case of brackets done later
+m 1 & a.b axb axb
+f 2 &n "a.b" "a\nb"
+m 3 & {a[bc]d} abd abd
+m 4 & {a[bc]d} acd acd
+f 5 & {a[bc]d} aed
+f 6 & {a[^bc]d} abd
+m 7 & {a[^bc]d} aed aed
+f 8 &p "a\[^bc]d" "a\nd"
+
+
+
+doing 6 "context-dependent syntax"
+# plus odds and ends
+e 1 - * BADRPT
+m 2 b * * *
+m 3 b {\(*\)} * * *
+e 4 - (*) BADRPT
+m 5 b ^* * *
+e 6 - ^* BADRPT
+f 7 & ^b ^b
+m 8 b x^ x^ x^
+f 9 I x^ x
+m 10 n "\n^" "x\nb" "\n"
+f 11 bS {\(^b\)} ^b
+m 12 - (^b) b b b
+m 13 & {x$} x x
+m 14 bS {\(x$\)} x x x
+m 15 - {(x$)} x x x
+m 16 b {x$y} "x\$y" "x\$y"
+f 17 I {x$y} xy
+m 18 n "x\$\n" "x\n" "x\n"
+e 19 - + BADRPT
+e 20 - ? BADRPT
+
+
+
+doing 7 "simple quantifiers"
+m 1 &N a* aa aa
+i 2 &N a* b {0 -1}
+m 3 - a+ aa aa
+m 4 - a?b ab ab
+m 5 - a?b b b
+e 6 - ** BADRPT
+m 7 bN ** *** ***
+e 8 & a** BADRPT
+e 9 & a**b BADRPT
+e 10 & *** BADRPT
+e 11 - a++ BADRPT
+e 12 - a?+ BADRPT
+e 13 - a?* BADRPT
+e 14 - a+* BADRPT
+e 15 - a*+ BADRPT
+
+
+
+doing 8 "braces"
+m 1 NQ "a{0,1}" "" ""
+m 2 NQ "a{0,1}" ac a
+e 3 - "a{1,0}" BADBR
+e 4 - "a{1,2,3}" BADBR
+e 5 - "a{257}" BADBR
+e 6 - "a{1000}" BADBR
+e 7 - "a{1" EBRACE
+e 8 - "a{1n}" BADBR
+m 9 BS "a{b" "a\{b" "a\{b"
+m 10 BS "a{" "a\{" "a\{"
+m 11 bQ "a\\{0,1\\}b" cb b
+e 12 b "a\\{0,1" EBRACE
+e 13 - "a{0,1\\" BADBR
+m 14 Q "a{0}b" ab b
+m 15 Q "a{0,0}b" ab b
+m 16 Q "a{0,1}b" ab ab
+m 17 Q "a{0,2}b" b b
+m 18 Q "a{0,2}b" aab aab
+m 19 Q "a{0,}b" aab aab
+m 20 Q "a{1,1}b" aab ab
+m 21 Q "a{1,3}b" aaaab aaab
+f 22 Q "a{1,3}b" b
+m 23 Q "a{1,}b" aab aab
+f 24 Q "a{2,3}b" ab
+m 25 Q "a{2,3}b" aaaab aaab
+f 26 Q "a{2,}b" ab
+m 27 Q "a{2,}b" aaaab aaaab
+
+
+
+doing 9 "brackets"
+m 1 & {a[bc]} ac ac
+m 2 & {a[-]} a- a-
+m 3 & {a[[.-.]]} a- a-
+m 4 &L {a[[.zero.]]} a0 a0
+m 5 &LM {a[[.zero.]-9]} a2 a2
+m 6 &M {a[0-[.9.]]} a2 a2
+m 7 &+L {a[[=x=]]} ax ax
+m 8 &+L {a[[=x=]]} ay ay
+f 9 &+L {a[[=x=]]} az
+e 10 & {a[0-[=x=]]} ERANGE
+m 11 &L {a[[:digit:]]} a0 a0
+e 12 & {a[[:woopsie:]]} ECTYPE
+f 13 &L {a[[:digit:]]} ab
+e 14 & {a[0-[:digit:]]} ERANGE
+m 15 &LP {[[:<:]]a} a a
+m 16 &LP {a[[:>:]]} a a
+e 17 & {a[[..]]b} ECOLLATE
+e 18 & {a[[==]]b} ECOLLATE
+e 19 & {a[[::]]b} ECTYPE
+e 20 & {a[[.a} EBRACK
+e 21 & {a[[=a} EBRACK
+e 22 & {a[[:a} EBRACK
+e 23 & {a[} EBRACK
+e 24 & {a[b} EBRACK
+e 25 & {a[b-} EBRACK
+e 26 & {a[b-c} EBRACK
+m 27 &M {a[b-c]} ab ab
+m 28 & {a[b-b]} ab ab
+m 29 &M {a[1-2]} a2 a2
+e 30 & {a[c-b]} ERANGE
+e 31 & {a[a-b-c]} ERANGE
+m 32 &M {a[--?]b} a?b a?b
+m 33 & {a[---]b} a-b a-b
+m 34 & {a[]b]c} a]c a]c
+m 35 EP {a[\]]b} a]b a]b
+f 36 bE {a[\]]b} a]b
+m 37 bE {a[\]]b} "a\\]b" "a\\]b"
+m 38 eE {a[\]]b} "a\\]b" "a\\]b"
+m 39 EP {a[\\]b} "a\\b" "a\\b"
+m 40 eE {a[\\]b} "a\\b" "a\\b"
+m 41 bE {a[\\]b} "a\\b" "a\\b"
+e 42 - {a[\Z]b} EESCAPE
+m 43 & {a[[b]c} "a\[c" "a\[c"
+m 44 EMP* {a[\u00fe-\u0507][\u00ff-\u0300]b} \
+ "a\u0102\u02ffb" "a\u0102\u02ffb"
+
+
+
+doing 10 "anchors and newlines"
+m 1 & ^a a a
+f 2 &^ ^a a
+i 3 &N ^ a {0 -1}
+i 4 & {a$} aba {2 2}
+f 5 {&$} {a$} a
+i 6 &N {$} ab {2 1}
+m 7 &n ^a a a
+m 8 &n "^a" "b\na" "a"
+i 9 &w "^a" "a\na" {0 0}
+i 10 &n^ "^a" "a\na" {2 2}
+m 11 &n {a$} a a
+m 12 &n "a\$" "a\nb" "a"
+i 13 &n "a\$" "a\na" {0 0}
+i 14 N ^^ a {0 -1}
+m 15 b ^^ ^ ^
+i 16 N {$$} a {1 0}
+m 17 b {$$} "\$" "\$"
+m 18 &N {^$} "" ""
+f 19 &N {^$} a
+i 20 &nN "^\$" "a\n\nb" {2 1}
+m 21 N {$^} "" ""
+m 22 b {$^} "\$^" "\$^"
+m 23 P {\Aa} a a
+m 24 ^P {\Aa} a a
+f 25 ^nP {\Aa} "b\na"
+m 26 P {a\Z} a a
+m 27 {$P} {a\Z} a a
+f 28 {$nP} {a\Z} "a\nb"
+e 29 - ^* BADRPT
+e 30 - {$*} BADRPT
+e 31 - {\A*} BADRPT
+e 32 - {\Z*} BADRPT
+
+
+
+doing 11 "boundary constraints"
+m 1 &LP {[[:<:]]a} a a
+m 2 &LP {[[:<:]]a} -a a
+f 3 &LP {[[:<:]]a} ba
+m 4 &LP {a[[:>:]]} a a
+m 5 &LP {a[[:>:]]} a- a
+f 6 &LP {a[[:>:]]} ab
+m 7 bLP {\<a} a a
+f 8 bLP {\<a} ba
+m 9 bLP {a\>} a a
+f 10 bLP {a\>} ab
+m 11 LP {\ya} a a
+f 12 LP {\ya} ba
+m 13 LP {a\y} a a
+f 14 LP {a\y} ab
+m 15 LP {a\Y} ab a
+f 16 LP {a\Y} a-
+f 17 LP {a\Y} a
+f 18 LP {-\Y} -a
+m 19 LP {-\Y} -% -
+f 20 LP {\Y-} a-
+e 21 - {[[:<:]]*} BADRPT
+e 22 - {[[:>:]]*} BADRPT
+e 23 b {\<*} BADRPT
+e 24 b {\>*} BADRPT
+e 25 - {\y*} BADRPT
+e 26 - {\Y*} BADRPT
+m 27 LP {\ma} a a
+f 28 LP {\ma} ba
+m 29 LP {a\M} a a
+f 30 LP {a\M} ab
+f 31 ILP {\Ma} a
+f 32 ILP {a\m} a
+
+
+
+doing 12 "character classes"
+m 1 LP {a\db} a0b a0b
+f 2 LP {a\db} axb
+f 3 LP {a\Db} a0b
+m 4 LP {a\Db} axb axb
+m 5 LP "a\\sb" "a b" "a b"
+m 6 LP "a\\sb" "a\tb" "a\tb"
+m 7 LP "a\\sb" "a\nb" "a\nb"
+f 8 LP {a\sb} axb
+m 9 LP {a\Sb} axb axb
+f 10 LP "a\\Sb" "a b"
+m 11 LP {a\wb} axb axb
+f 12 LP {a\wb} a-b
+f 13 LP {a\Wb} axb
+m 14 LP {a\Wb} a-b a-b
+m 15 LP {\y\w+z\y} adze-guz guz
+m 16 LPE {a[\d]b} a1b a1b
+m 17 LPE "a\[\\s]b" "a b" "a b"
+m 18 LPE {a[\w]b} axb axb
+
+
+
+doing 13 "escapes"
+e 1 & "a\\" EESCAPE
+m 2 - {a\<b} a<b a<b
+m 3 e {a\<b} a<b a<b
+m 4 bAS {a\wb} awb awb
+m 5 eAS {a\wb} awb awb
+m 6 PL "a\\ab" "a\007b" "a\007b"
+m 7 P "a\\bb" "a\bb" "a\bb"
+m 8 P {a\Bb} "a\\b" "a\\b"
+m 9 MP "a\\chb" "a\bb" "a\bb"
+m 10 MP "a\\cHb" "a\bb" "a\bb"
+m 11 LMP "a\\e" "a\033" "a\033"
+m 12 P "a\\fb" "a\fb" "a\fb"
+m 13 P "a\\nb" "a\nb" "a\nb"
+m 14 P "a\\rb" "a\rb" "a\rb"
+m 15 P "a\\tb" "a\tb" "a\tb"
+m 16 P "a\\u0008x" "a\bx" "a\bx"
+e 17 - {a\u008x} EESCAPE
+m 18 P "a\\u00088x" "a\b8x" "a\b8x"
+m 19 P "a\\U00000008x" "a\bx" "a\bx"
+e 20 - {a\U0000008x} EESCAPE
+m 21 P "a\\vb" "a\vb" "a\vb"
+m 22 MP "a\\x08x" "a\bx" "a\bx"
+e 23 - {a\xq} EESCAPE
+m 24 MP "a\\x0008x" "a\bx" "a\bx"
+e 25 - {a\z} EESCAPE
+m 26 MP "a\\010b" "a\bb" "a\bb"
+
+
+
+doing 14 "back references"
+# ugh
+m 1 RP {a(b*)c\1} abbcbb abbcbb bb
+m 2 RP {a(b*)c\1} ac ac ""
+f 3 RP {a(b*)c\1} abbcb
+m 4 RP {a(b*)\1} abbcbb abb b
+m 5 RP {a(b|bb)\1} abbcbb abb b
+m 6 RP {a([bc])\1} abb abb b
+f 7 RP {a([bc])\1} abc
+m 8 RP {a([bc])\1} abcabb abb b
+f 9 RP {a([bc])*\1} abc
+f 10 RP {a([bc])\1} abB
+m 11 iRP {a([bc])\1} abB abB b
+m 12 RP {a([bc])\1+} abbb abbb b
+m 13 QRP "a(\[bc])\\1{3,4}" abbbb abbbb b
+f 14 QRP "a(\[bc])\\1{3,4}" abbb
+m 15 RP {a([bc])\1*} abbb abbb b
+m 16 RP {a([bc])\1*} ab ab b
+m 17 RP {a([bc])(\1*)} ab ab b ""
+e 18 - {a((b)\1)} ESUBREG
+e 19 - {a(b)c\2} ESUBREG
+m 20 bR {a\(b*\)c\1} abbcbb abbcbb bb
+
+
+
+doing 15 "octal escapes vs back references"
+# initial zero is always octal
+m 1 MP "a\\010b" "a\bb" "a\bb"
+m 2 MP "a\\0070b" "a\0070b" "a\0070b"
+m 3 MP "a\\07b" "a\007b" "a\007b"
+m 4 MP "a(b)(b)(b)(b)(b)(b)(b)(b)(b)(b)\\07c" "abbbbbbbbbb\007c" \
+ "abbbbbbbbbb\007c" "b" "b" "b" "b" "b" "b" \
+ "b" "b" "b" "b"
+# a single digit is always a backref
+e 5 - {a\7b} ESUBREG
+# otherwise it's a backref only if within range (barf!)
+m 6 MP "a\\10b" "a\bb" "a\bb"
+m 7 MP {a\101b} aAb aAb
+m 8 RP {a(b)(b)(b)(b)(b)(b)(b)(b)(b)(b)\10c} abbbbbbbbbbbc \
+ abbbbbbbbbbbc b b b b b b b \
+ b b b
+# but we're fussy about border cases -- guys who want octal should use the zero
+e 9 - {a((((((((((b\10))))))))))c} ESUBREG
+# BREs don't have octal, EREs don't have backrefs
+m 10 MP "a\\12b" "a\nb" "a\nb"
+e 11 b {a\12b} ESUBREG
+m 12 eAS {a\12b} a12b a12b
+
+
+
+doing 16 "expanded syntax"
+m 1 xP "a b c" "abc" "abc"
+m 2 xP "a b #oops\nc\td" "abcd" "abcd"
+m 3 x "a\\ b\\\tc" "a b\tc" "a b\tc"
+m 4 xP "a b\\#c" "ab#c" "ab#c"
+m 5 xP "a b\[c d]e" "ab e" "ab e"
+m 6 xP "a b\[c#d]e" "ab#e" "ab#e"
+m 7 xP "a b\[c#d]e" "abde" "abde"
+m 8 xSPB "ab{ d" "ab\{d" "ab\{d"
+m 9 xPQ "ab{ 1 , 2 }c" "abc" "abc"
+
+
+
+doing 17 "misc syntax"
+m 1 P a(?#comment)b ab ab
+
+
+
+doing 18 "unmatchable REs"
+f 1 I a^b ab
+
+
+
+doing 19 "case independence"
+m 1 &i ab Ab Ab
+m 2 &i {a[bc]} aC aC
+f 3 &i {a[^bc]} aB
+m 4 &iM {a[b-d]} aC aC
+f 5 &iM {a[^b-d]} aC
+
+
+
+doing 20 "directors and embedded options"
+e 1 & ***? BADPAT
+m 2 q ***? ***? ***?
+m 3 &P ***=a*b a*b a*b
+m 4 q ***=a*b ***=a*b ***=a*b
+m 5 bLP {***:\w+} ab ab
+m 6 eLP {***:\w+} ab ab
+e 7 & ***:***=a*b BADRPT
+m 8 &P ***:(?b)a+b a+b a+b
+m 9 P (?b)a+b a+b a+b
+e 10 e {(?b)\w+} BADRPT
+m 11 bAS {(?b)\w+} (?b)w+ (?b)w+
+m 12 iP (?c)a a a
+f 13 iP (?c)a A
+m 14 APS {(?e)\W+} WW WW
+m 15 P (?i)a+ Aa Aa
+f 16 P "(?m)a.b" "a\nb"
+m 17 P "(?m)^b" "a\nb" "b"
+f 18 P "(?n)a.b" "a\nb"
+m 19 P "(?n)^b" "a\nb" "b"
+f 20 P "(?p)a.b" "a\nb"
+f 21 P "(?p)^b" "a\nb"
+m 22 P (?q)a+b a+b a+b
+m 23 nP "(?s)a.b" "a\nb" "a\nb"
+m 24 xP "(?t)a b" "a b" "a b"
+m 25 P "(?w)a.b" "a\nb" "a\nb"
+m 26 P "(?w)^b" "a\nb" "b"
+m 27 P "(?x)a b" "ab" "ab"
+e 28 - (?z)ab BADOPT
+m 29 P (?ici)a+ Aa Aa
+e 30 P (?i)(?q)a+ BADRPT
+m 31 P (?q)(?i)a+ (?i)a+ (?i)a+
+m 32 P (?qe)a+ a a
+m 33 xP "(?q)a b" "a b" "a b"
+m 34 P "(?qx)a b" "a b" "a b"
+m 35 P (?qi)ab Ab Ab
+
+
+
+doing 21 "capturing"
+m 1 - a(b)c abc abc b
+m 2 P a(?:b)c xabc abc
+m 3 - a((b))c xabcy abc b b
+m 4 P a(?:(b))c abcy abc b
+m 5 P a((?:b))c abc abc b
+m 6 P a(?:(?:b))c abc abc
+i 7 Q "a(b){0}c" ac {0 1} {-1 -1}
+m 8 - a(b)c(d)e abcde abcde b d
+m 9 - (b)c(d)e bcde bcde b d
+m 10 - a(b)(d)e abde abde b d
+m 11 - a(b)c(d) abcd abcd b d
+m 12 - (ab)(cd) xabcdy abcd ab cd
+m 13 - a(b)?c xabcy abc b
+i 14 - a(b)?c xacy {1 2} {-1 -1}
+m 15 - a(b)?c(d)?e xabcdey abcde b d
+i 16 - a(b)?c(d)?e xacdey {1 4} {-1 -1} {3 3}
+i 17 - a(b)?c(d)?e xabcey {1 4} {2 2} {-1 -1}
+i 18 - a(b)?c(d)?e xacey {1 3} {-1 -1} {-1 -1}
+m 19 - a(b)*c xabcy abc b
+i 20 - a(b)*c xabbbcy {1 5} {4 4}
+i 21 - a(b)*c xacy {1 2} {-1 -1}
+m 22 - a(b*)c xabbbcy abbbc bbb
+m 23 - a(b*)c xacy ac ""
+f 24 - a(b)+c xacy
+m 25 - a(b)+c xabcy abc b
+i 26 - a(b)+c xabbbcy {1 5} {4 4}
+m 27 - a(b+)c xabbbcy abbbc bbb
+i 28 Q "a(b){2,3}c" xabbbcy {1 5} {4 4}
+i 29 Q "a(b){2,3}c" xabbcy {1 4} {3 3}
+f 30 Q "a(b){2,3}c" xabcy
+m 31 LP "\\y(\\w+)\\y" "-- abc-" "abc" "abc"
+m 32 - a((b|c)d+)+ abacdbd acdbd bd b
+m 33 N (.*).* abc abc abc
+m 34 N (a*)* bc "" ""
+
+
+
+doing 22 "multicharacter collating elements"
+# again ugh
+m 1 &+L {a[c]e} ace ace
+f 2 &+IL {a[c]h} ach
+m 3 &+L {a[[.ch.]]} ach ach
+f 4 &+L {a[[.ch.]]} ace
+m 5 &+L {a[c[.ch.]]} ac ac
+m 6 &+L {a[c[.ch.]]} ace ac
+m 7 &+L {a[c[.ch.]]} ache ach
+f 8 &+L {a[^c]e} ace
+m 9 &+L {a[^c]e} abe abe
+m 10 &+L {a[^c]e} ache ache
+f 11 &+L {a[^[.ch.]]} ach
+m 12 &+L {a[^[.ch.]]} ace ac
+m 13 &+L {a[^[.ch.]]} ac ac
+m 14 &+L {a[^[.ch.]]} abe ab
+f 15 &+L {a[^c[.ch.]]} ach
+f 16 &+L {a[^c[.ch.]]} ace
+f 17 &+L {a[^c[.ch.]]} ac
+m 18 &+L {a[^c[.ch.]]} abe ab
+m 19 &+L {a[^b]} ac ac
+m 20 &+L {a[^b]} ace ac
+m 21 &+L {a[^b]} ach ach
+f 22 &+L {a[^b]} abe
+
+
+
+doing 23 "lookahead constraints"
+m 1 HP a(?=b)b* ab ab
+f 2 HP a(?=b)b* a
+m 3 HP a(?=b)b*(?=c)c* abc abc
+f 4 HP a(?=b)b*(?=c)c* ab
+f 5 HP a(?!b)b* ab
+m 6 HP a(?!b)b* a a
+m 7 HP (?=b)b b b
+f 8 HP (?=b)b a
+
+
+
+doing 24 "non-greedy quantifiers"
+m 1 PT ab+? abb ab
+m 2 PT ab+?c abbc abbc
+m 3 PT ab*? abb a
+m 4 PT ab*?c abbc abbc
+m 5 PT ab?? ab a
+m 6 PT ab??c abc abc
+m 7 PQT "ab{2,4}?" abbbb abb
+m 8 PQT "ab{2,4}?c" abbbbc abbbbc
+m 9 - 3z* 123zzzz456 3zzzz
+m 10 PT 3z*? 123zzzz456 3
+m 11 - z*4 123zzzz456 zzzz4
+m 12 PT z*?4 123zzzz456 zzzz4
+
+
+
+doing 25 "mixed quantifiers"
+# this is very incomplete as yet
+# should include |
+m 1 PNT {^(.*?)(a*)$} xyza xyza xyz a
+m 2 PNT {^(.*?)(a*)$} xyzaa xyzaa xyz aa
+m 3 PNT {^(.*?)(a*)$} xyz xyz xyz ""
+
+
+
+doing 26 "tricky cases"
+# attempts to trick the matcher into accepting a short match
+m 1 - (week|wee)(night|knights) weeknights weeknights \
+ wee knights
+m 2 RP {a(bc*).*\1} abccbccb abccbccb b
+m 3 - {a(b.[bc]*)+} abcbd abcbd bd
+
+
+
+doing 27 "implementation misc."
+# duplicate arcs are suppressed
+m 1 P a(?:b|b)c abc abc
+# make color/subcolor relationship go back and forth
+m 2 & {[ab][ab][ab]} aba aba
+m 3 & {[ab][ab][ab][ab][ab][ab][ab]} abababa abababa
+
+
+
+doing 28 "boundary busters etc."
+# color-descriptor allocation changes at 10
+m 1 & abcdefghijkl abcdefghijkl abcdefghijkl
+# so does arc allocation
+m 2 P a(?:b|c|d|e|f|g|h|i|j|k|l|m)n agn agn
+# subexpression tracking also at 10
+m 3 - a(((((((((((((b)))))))))))))c abc abc b b b b b b b b b b b b b
+# state-set handling changes slightly at unsigned size (might be 64...)
+# (also stresses arc allocation)
+m 4 Q "ab{1,100}c" abbc abbc
+m 5 Q "ab{1,100}c" abbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbc \
+ abbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbc
+m 6 Q "ab{1,100}c" \
+ abbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbc \
+ abbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbc
+# force small cache and bust it, several ways
+m 7 LP {\w+abcdefgh} xyzabcdefgh xyzabcdefgh
+m 8 %LP {\w+abcdefgh} xyzabcdefgh xyzabcdefgh
+m 9 %LP {\w+abcdefghijklmnopqrst} xyzabcdefghijklmnopqrst \
+ xyzabcdefghijklmnopqrst
+i 10 %LP {\w+(abcdefgh)?} xyz {0 2} {-1 -1}
+i 11 %LP {\w+(abcdefgh)?} xyzabcdefg {0 9} {-1 -1}
+i 12 %LP {\w+(abcdefghijklmnopqrst)?} xyzabcdefghijklmnopqrs \
+ {0 21} {-1 -1}
+
+
+
+doing 29 "incomplete matches"
+p 1 t def abc {3 2} ""
+p 2 t bcd abc {1 2} ""
+p 3 t abc abab {0 3} ""
+p 4 t abc abdab {3 4} ""
+i 5 t abc abc {0 2} {0 2}
+i 6 t abc xyabc {2 4} {2 4}
+p 7 t abc+ xyab {2 3} ""
+i 8 t abc+ xyabc {2 4} {2 4}
+knownBug i 9 t abc+ xyabcd {2 4} {6 5}
+i 10 t abc+ xyabcdd {2 4} {7 6}
+p 11 tPT abc+? xyab {2 3} ""
+# the retain numbers in these two may look wrong, but they aren't
+i 12 tPT abc+? xyabc {2 4} {5 4}
+i 13 tPT abc+? xyabcc {2 4} {6 5}
+i 14 tPT abc+? xyabcd {2 4} {6 5}
+i 15 tPT abc+? xyabcdd {2 4} {7 6}
+i 16 t abcd|bc xyabc {3 4} {2 4}
+p 17 tn .*k "xx\nyyy" {3 5} ""
+
+
+doing 30 "misc. oddities and old bugs"
+e 1 & *** BADRPT
+m 2 N a?b* abb abb
+m 3 N a?b* bb bb
+m 4 & a*b aab aab
+m 5 & ^a*b aaaab aaaab
+m 6 &M {[0-6][1-2][0-3][0-6][1-6][0-6]} 010010 010010
+# temporary REG_BOSONLY kludge
+m 7 s abc abcd abc
+f 8 s abc xabcd
+# back to normal stuff
+m 9 HLP {(?n)^(?![t#])\S+} "tk\n\n#\n#\nit0" it0
+
+
+# flush any leftover complaints
+doing 0 "flush"
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
diff --git a/tcl/tests/regexp.test b/tcl/tests/regexp.test
index 141e7151389..c05ae964e13 100644
--- a/tcl/tests/regexp.test
+++ b/tcl/tests/regexp.test
@@ -5,14 +5,18 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {unset foo}
test regexp-1.1 {basic regexp operation} {
@@ -30,6 +34,15 @@ test regexp-1.4 {basic regexp operation} {
test regexp-1.5 {basic regexp operation} {
regexp {^([^ ]*)[ ]*([^ ]*)} "" a
} 1
+test regexp-1.6 {basic regexp operation} {
+ list [catch {regexp {} abc} msg] $msg
+} {0 1}
+test regexp-1.7 {regexp utf compliance} {
+ # if not UTF-8 aware, result is "0 1"
+ set foo "\u4e4eb q"
+ regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar
+ list [string compare $foo $bar] [regexp 4 $bar]
+} {0 0}
test regexp-2.1 {getting substrings back from regexp} {
set foo {}
@@ -67,7 +80,10 @@ test regexp-2.7 {getting substrings back from regexp} {
set foo 1; set f2 1; set f3 1; set f4 1
list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
} {1 ac a {} c}
-
+test regexp-2.8 {getting substrings back from regexp} {
+ set match {}
+ list [regexp {^a*b} aaaab match] $match
+} {1 aaaab}
test regexp-3.1 {-indices option to regexp} {
set foo {}
@@ -120,10 +136,10 @@ test regexp-4.3 {-nocase option to regexp} {
} 1
set x abcdefghijklmnopqrstuvwxyz1234567890
set x $x$x$x$x$x$x$x$x$x$x$x$x
-test regexp-4.4 {case conversion in regsub} {
+test regexp-4.4 {case conversion in regexp} {
list [regexp -nocase $x $x foo] $foo
} "1 $x"
-unset x
+catch {unset x}
test regexp-5.1 {exercise cache of compiled expressions} {
regexp .*a b
@@ -174,23 +190,27 @@ test regexp-6.2 {regexp errors} {
} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
test regexp-6.3 {regexp errors} {
list [catch {regexp -gorp a} msg] $msg
-} {1 {bad switch "-gorp": must be -indices, -nocase, or --}}
+} {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
test regexp-6.4 {regexp errors} {
list [catch {regexp a( b} msg] $msg
-} {1 {couldn't compile regular expression pattern: unmatched ()}}
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-6.5 {regexp errors} {
list [catch {regexp a( b} msg] $msg
-} {1 {couldn't compile regular expression pattern: unmatched ()}}
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-6.6 {regexp errors} {
list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
} {0 1}
test regexp-6.7 {regexp errors} {
list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
-} {1 {couldn't compile regular expression pattern: too many ()}}
+} {0 0}
test regexp-6.8 {regexp errors} {
+ catch {unset f1}
set f1 44
list [catch {regexp abc abc f1(f2)} msg] $msg
} {1 {couldn't set variable "f1(f2)"}}
+test regexp-6.9 {regexp errors, -start bad int check} {
+ list [catch {regexp -start bogus {^$} {}} msg] $msg
+} {1 {expected integer but got "bogus"}}
test regexp-7.1 {basic regsub operation} {
list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
@@ -244,6 +264,12 @@ test regexp-7.16 {basic regsub operation} {
set foo xxx
list [regsub x "" y foo] $foo
} {0 {}}
+test regexp-7.17 {regsub utf compliance} {
+ # if not UTF-8 aware, result is "0 1"
+ set foo "xyz555ijka\u4e4ebpqr"
+ regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar
+ list [string compare $foo $bar] [regexp 4 $bar]
+} {0 0}
test regexp-8.1 {case conversion in regsub} {
list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
@@ -295,24 +321,227 @@ test regexp-9.6 {-all option to regsub} {
list [regsub -all ^ xxx 123 foo] $foo
} {1 123xxx}
-test regexp-10.1 {regsub errors} {
+test regexp-10.1 {expanded syntax in regsub} {
+ set foo xxx
+ list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo
+} {1 defc}
+test regexp-10.2 {newline sensitivity in regsub} {
+ set foo xxx
+ list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo
+} "1 {dabc\n123\n}"
+test regexp-10.3 {newline sensitivity in regsub} {
+ set foo xxx
+ list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo
+} "1 {dabc\n123\nxb}"
+test regexp-10.4 {partial newline sensitivity in regsub} {
+ set foo xxx
+ list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo
+} "1 {da\n123}"
+test regexp-10.5 {inverse partial newline sensitivity in regsub} {
+ set foo xxx
+ list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo
+} "1 {da\nb123\nxb}"
+
+test regexp-11.1 {regsub errors} {
list [catch {regsub a b c} msg] $msg
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
-test regexp-10.2 {regsub errors} {
+test regexp-11.2 {regsub errors} {
list [catch {regsub -nocase a b c} msg] $msg
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
-test regexp-10.3 {regsub errors} {
+test regexp-11.3 {regsub errors} {
list [catch {regsub -nocase -all a b c} msg] $msg
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
-test regexp-10.4 {regsub errors} {
+test regexp-11.4 {regsub errors} {
list [catch {regsub a b c d e f} msg] $msg
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
-test regexp-10.5 {regsub errors} {
+test regexp-11.5 {regsub errors} {
list [catch {regsub -gorp a b c} msg] $msg
-} {1 {bad switch "-gorp": must be -all, -nocase, or --}}
-test regexp-10.6 {regsub errors} {
+} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
+test regexp-11.6 {regsub errors} {
list [catch {regsub -nocase a( b c d} msg] $msg
-} {1 {couldn't compile regular expression pattern: unmatched ()}}
-test regexp-10.7 {regsub errors} {
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
+test regexp-11.7 {regsub errors} {
+ catch {unset f1}
+ set f1 44
list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
} {1 {couldn't set variable "f1(f2)"}}
+test regexp-11.8 {regsub errors, -start bad int check} {
+ list [catch {regsub -start bogus pattern string rep var} msg] $msg
+} {1 {expected integer but got "bogus"}}
+
+# This test crashes on the Mac unless you increase the Stack Space to about 1
+# Meg. This is probably bigger than most users want...
+# 8.2.3 regexp reduced stack space requirements, but this should be
+# tested again
+test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
+ list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
+} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}
+
+test regexp-13.1 {regsub of a very large string} {
+ # This test is designed to stress the memory subsystem in order
+ # to catch Bug #933. It only fails if the Tcl memory allocator
+ # is in use.
+
+ set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
+ set filedata [string repeat $line 200]
+ for {set i 1} {$i<10} {incr i} {
+ regsub -all "BEGIN_TABLE " $filedata "" newfiledata
+ }
+ set x done
+} {done}
+
+test regexp-14.1 {CompileRegexp: regexp cache} {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ set x .
+ append x *a
+ regexp $x bbba
+} 1
+test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ set x .
+ append x *a
+ regexp -nocase $x bbba
+} 1
+
+# There is no exec on the Mac ...
+
+test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {unixOrPc} {
+ makeFile {puts [regexp {} foo]} junk.tcl
+ exec $::tcltest::tcltest junk.tcl
+} 1
+
+test regexp-15.1 {regexp -start} {
+ catch {unset x}
+ list [regexp -start -10 {\d} 1abc2de3 x] $x
+} {1 1}
+test regexp-15.2 {regexp -start} {
+ catch {unset x}
+ list [regexp -start 2 {\d} 1abc2de3 x] $x
+} {1 2}
+test regexp-15.3 {regexp -start} {
+ catch {unset x}
+ list [regexp -start 4 {\d} 1abc2de3 x] $x
+} {1 2}
+test regexp-15.4 {regexp -start} {
+ catch {unset x}
+ list [regexp -start 5 {\d} 1abc2de3 x] $x
+} {1 3}
+test regexp-15.5 {regexp -start, over end of string} {
+ catch {unset x}
+ list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
+} {0 0}
+test regexp-15.6 {regexp -start, loss of ^$ behavior} {
+ list [regexp -start 2 {^$} {}]
+} {0}
+
+test regexp-16.1 {regsub -start} {
+ catch {unset x}
+ list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
+} {4 a1b/2c/3d/4e/5}
+test regexp-16.2 {regsub -start} {
+ catch {unset x}
+ list [regsub -all -start -25 {z} hello {/&} x] $x
+} {0 hello}
+test regexp-16.3 {regsub -start} {
+ catch {unset x}
+ list [regsub -all -start 3 {z} hello {/&} x] $x
+} {0 hello}
+test regexp-16.4 {regsub -start, \A behavior} {
+ set out {}
+ lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
+ lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
+} {5 /a/b/c/d/e 3 ab/c/d/e}
+
+test regexp-17.1 {regexp -inline} {
+ regexp -inline b ababa
+} {b}
+test regexp-17.2 {regexp -inline} {
+ regexp -inline (b) ababa
+} {b b}
+test regexp-17.3 {regexp -inline -indices} {
+ regexp -inline -indices (b) ababa
+} {{1 1} {1 1}}
+test regexp-17.4 {regexp -inline} {
+ regexp -inline {\w(\d+)\w} " hello 23 there456def "
+} {e456d 456}
+test regexp-17.5 {regexp -inline no matches} {
+ regexp -inline {\w(\d+)\w} ""
+} {}
+test regexp-17.6 {regexp -inline no matches} {
+ regexp -inline hello goodbye
+} {}
+test regexp-17.7 {regexp -inline, no matchvars allowed} {
+ list [catch {regexp -inline b abc match} msg] $msg
+} {1 {regexp match variables not allowed when using -inline}}
+
+test regexp-18.1 {regexp -all} {
+ regexp -all b bbbbb
+} {5}
+test regexp-18.2 {regexp -all} {
+ regexp -all b abababbabaaaaaaaaaab
+} {6}
+test regexp-18.3 {regexp -all -inline} {
+ regexp -all -inline b abababbabaaaaaaaaaab
+} {b b b b b b}
+test regexp-18.4 {regexp -all -inline} {
+ regexp -all -inline {\w(\w)} abcdefg
+} {ab b cd d ef f}
+test regexp-18.5 {regexp -all -inline} {
+ regexp -all -inline {\w(\w)$} abcdefg
+} {fg g}
+test regexp-18.6 {regexp -all -inline} {
+ regexp -all -inline {\d+} 10:20:30:40
+} {10 20 30 40}
+test regexp-18.7 {regexp -all -inline} {
+ list [catch {regexp -all -inline b abc match} msg] $msg
+} {1 {regexp match variables not allowed when using -inline}}
+test regexp-18.8 {regexp -all} {
+ # This should not cause an infinite loop
+ regexp -all -inline {a*} a
+} {a}
+test regexp-18.9 {regexp -all} {
+ # Yes, the expected result is {a {}}. Here's why:
+ # Start at index 0; a* matches the "a" there then stops.
+ # Go to index 1; a* matches the lambda (or {}) there then stops. Recall
+ # that a* matches zero or more "a"'s; thus it matches the string "b", as
+ # there are zero or more "a"'s there.
+ # Go to index 2; this is past the end of the string, so stop.
+ regexp -all -inline {a*} ab
+} {a {}}
+test regexp-18.10 {regexp -all} {
+ # Yes, the expected result is {a {} a}. Here's why:
+ # Start at index 0; a* matches the "a" there then stops.
+ # Go to index 1; a* matches the lambda (or {}) there then stops. Recall
+ # that a* matches zero or more "a"'s; thus it matches the string "b", as
+ # there are zero or more "a"'s there.
+ # Go to index 2; a* matches the "a" there then stops.
+ # Go to index 3; this is past the end of the string, so stop.
+ regexp -all -inline {a*} aba
+} {a {} a}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/registry.test b/tcl/tests/registry.test
index 62d689e5656..8bf11678719 100644
--- a/tcl/tests/registry.test
+++ b/tcl/tests/registry.test
@@ -8,150 +8,160 @@
# auto_path or the registry package must have been loaded already.
#
# Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) != "windows"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-set lib [lindex [glob [file join [pwd] [file dirname \
- [info nameofexecutable]] tclreg*.dll]] 0]
-
-if [catch {load $lib registry}] {
- puts "Unable to find the registry package. Skipping registry tests."
- return
-}
-
-if {$testConfig(win32s)} {
- puts "Skipping registry tests under Win32s"
- return
+if {$tcl_platform(platform) == "windows"} {
+ if [catch {
+ set lib [lindex [glob [file join [pwd] [file dirname \
+ [info nameofexecutable]] tclreg*.dll]] 0]
+ load $lib registry
+ }] {
+ puts "Unable to find the registry package. Skipping registry tests."
+ return
+ }
}
-switch $tcl_platform(os) {
- "Windows NT" {set testConfig(NT) 1}
- "Windows 95" {set testConfig(95) 1}
+# determine the current locale
+set old [testlocale all]
+if {![string compare [testlocale all ""] "English_United States.1252"]} {
+ # error messages from registry package are already localized.
+ set ::tcltest::testConstraints(english) 1
}
+testlocale all $old
+unset old
set hostname [info hostname]
-test registry-1.1 {argument parsing for registry command} {
+test registry-1.1 {argument parsing for registry command} {pcOnly} {
list [catch {registry} msg] $msg
} {1 {wrong # args: should be "registry option ?arg arg ...?"}}
-test registry-1.2 {argument parsing for registry command} {
+test registry-1.2 {argument parsing for registry command} {pcOnly} {
list [catch {registry foo} msg] $msg
} {1 {bad option "foo": must be delete, get, keys, set, type, or values}}
-test registry-1.3 {argument parsing for registry command} {
+test registry-1.3 {argument parsing for registry command} {pcOnly} {
list [catch {registry d} msg] $msg
} {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
-test registry-1.4 {argument parsing for registry command} {
+test registry-1.4 {argument parsing for registry command} {pcOnly} {
list [catch {registry delete} msg] $msg
} {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
-test registry-1.5 {argument parsing for registry command} {
+test registry-1.5 {argument parsing for registry command} {pcOnly} {
list [catch {registry delete foo bar baz} msg] $msg
} {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
-test registry-1.6 {argument parsing for registry command} {
+test registry-1.6 {argument parsing for registry command} {pcOnly} {
list [catch {registry g} msg] $msg
} {1 {wrong # args: should be "registry get keyName valueName"}}
-test registry-1.7 {argument parsing for registry command} {
+test registry-1.7 {argument parsing for registry command} {pcOnly} {
list [catch {registry get} msg] $msg
} {1 {wrong # args: should be "registry get keyName valueName"}}
-test registry-1.8 {argument parsing for registry command} {
+test registry-1.8 {argument parsing for registry command} {pcOnly} {
list [catch {registry get foo} msg] $msg
} {1 {wrong # args: should be "registry get keyName valueName"}}
-test registry-1.9 {argument parsing for registry command} {
+test registry-1.9 {argument parsing for registry command} {pcOnly} {
list [catch {registry get foo bar baz} msg] $msg
} {1 {wrong # args: should be "registry get keyName valueName"}}
-test registry-1.10 {argument parsing for registry command} {
+test registry-1.10 {argument parsing for registry command} {pcOnly} {
list [catch {registry k} msg] $msg
} {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
-test registry-1.11 {argument parsing for registry command} {
+test registry-1.11 {argument parsing for registry command} {pcOnly} {
list [catch {registry keys} msg] $msg
} {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
-test registry-1.12 {argument parsing for registry command} {
+test registry-1.12 {argument parsing for registry command} {pcOnly} {
list [catch {registry keys foo bar baz} msg] $msg
} {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
-test registry-1.13 {argument parsing for registry command} {
+test registry-1.13 {argument parsing for registry command} {pcOnly} {
list [catch {registry s} msg] $msg
} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
-test registry-1.14 {argument parsing for registry command} {
+test registry-1.14 {argument parsing for registry command} {pcOnly} {
list [catch {registry set} msg] $msg
} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
-test registry-1.15 {argument parsing for registry command} {
+test registry-1.15 {argument parsing for registry command} {pcOnly} {
list [catch {registry set foo bar} msg] $msg
} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
-test registry-1.16 {argument parsing for registry command} {
+test registry-1.16 {argument parsing for registry command} {pcOnly} {
list [catch {registry set foo bar baz blat gorp} msg] $msg
} {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
-test registry-1.17 {argument parsing for registry command} {
+test registry-1.17 {argument parsing for registry command} {pcOnly} {
list [catch {registry t} msg] $msg
} {1 {wrong # args: should be "registry type keyName valueName"}}
-test registry-1.18 {argument parsing for registry command} {
+test registry-1.18 {argument parsing for registry command} {pcOnly} {
list [catch {registry type} msg] $msg
} {1 {wrong # args: should be "registry type keyName valueName"}}
-test registry-1.19 {argument parsing for registry command} {
+test registry-1.19 {argument parsing for registry command} {pcOnly} {
list [catch {registry type foo} msg] $msg
} {1 {wrong # args: should be "registry type keyName valueName"}}
-test registry-1.20 {argument parsing for registry command} {
+test registry-1.20 {argument parsing for registry command} {pcOnly} {
list [catch {registry type foo bar baz} msg] $msg
} {1 {wrong # args: should be "registry type keyName valueName"}}
-test registry-1.21 {argument parsing for registry command} {
+test registry-1.21 {argument parsing for registry command} {pcOnly} {
list [catch {registry v} msg] $msg
} {1 {wrong # args: should be "registry values keyName ?pattern?"}}
-test registry-1.22 {argument parsing for registry command} {
+test registry-1.22 {argument parsing for registry command} {pcOnly} {
list [catch {registry values} msg] $msg
} {1 {wrong # args: should be "registry values keyName ?pattern?"}}
-test registry-1.23 {argument parsing for registry command} {
+test registry-1.23 {argument parsing for registry command} {pcOnly} {
list [catch {registry values foo bar baz} msg] $msg
} {1 {wrong # args: should be "registry values keyName ?pattern?"}}
-test registry-2.1 {DeleteKey: bad key} {
+test registry-2.1 {DeleteKey: bad key} {pcOnly} {
list [catch {registry delete foo} msg] $msg
-} {1 {bad root name "foo": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
-test registry-2.2 {DeleteKey: bad key} {
+} {1 {bad root name "foo": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
+test registry-2.2 {DeleteKey: bad key} {pcOnly} {
list [catch {registry delete HKEY_CLASSES_ROOT} msg] $msg
} {1 {bad key: cannot delete root keys}}
-test registry-2.3 {DeleteKey: bad key} {
+test registry-2.3 {DeleteKey: bad key} {pcOnly} {
list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg
} {1 {bad key: cannot delete root keys}}
-test registry-2.4 {DeleteKey: subkey at root level} {
+test registry-2.4 {DeleteKey: subkey at root level} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry keys HKEY_CLASSES_ROOT TclFoobar
} {}
-test registry-2.5 {DeleteKey: subkey below root level} {
+test registry-2.5 {DeleteKey: subkey below root level} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar\\test
registry delete HKEY_CLASSES_ROOT\\TclFoobar\\test
set result [registry keys HKEY_CLASSES_ROOT TclFoobar\\test]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {}
-test registry-2.6 {DeleteKey: recursive delete} {
+test registry-2.6 {DeleteKey: recursive delete} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
set result
} {}
-test registry-2.7 {DeleteKey: trailing backslashes} {
+test registry-2.7 {DeleteKey: trailing backslashes} {pcOnly english} {
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar\\} msg] $msg
} {1 {unable to delete key: The configuration registry key is invalid.}}
-test registry-2.8 {DeleteKey: failure} {
+test registry-2.8 {DeleteKey: failure} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry delete HKEY_CLASSES_ROOT\\TclFoobar
} {}
+test registry-2.9 {DeleteKey: unicode} {pcOnly} {
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\test\u00c7bar\\a
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\test\u00c7bar\\b
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar\\test\u00c7bar
+ set result [registry keys HKEY_CLASSES_ROOT\\TclFoobar]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} {}
-
-test registry-3.1 {DeleteValue} {
+test registry-3.1 {DeleteValue} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test1 blort
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test2 blat
@@ -160,44 +170,52 @@ test registry-3.1 {DeleteValue} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} test2
-test registry-3.2 {DeleteValue: bad key} {
+test registry-3.2 {DeleteValue: bad key} {pcOnly english} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar test} msg] $msg
} {1 {unable to open key: The system cannot find the file specified.}}
-test registry-3.3 {DeleteValue: bad value} {
+test registry-3.3 {DeleteValue: bad value} {pcOnly english} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test2 blort
set result [list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar test1} msg] $msg]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {1 {unable to delete value "test1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
+test registry-3.4 {DeleteValue: Unicode} {pcOnly} {
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\\u00c7baz \u00c7test1 blort
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\\u00c7baz test2 blat
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar\\\u00c7baz \u00c7test1
+ set result [registry values HKEY_CLASSES_ROOT\\TclFoobar\\\u00c7baz]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} test2
-
-test registry-4.1 {GetKeyNames: bad key} {
+test registry-4.1 {GetKeyNames: bad key} {pcOnly english} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
} {1 {unable to open key: The system cannot find the file specified.}}
-test registry-4.2 {GetKeyNames} {
+test registry-4.2 {GetKeyNames} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
set result [registry keys HKEY_CLASSES_ROOT\\TclFoobar]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {baz}
-test registry-4.3 {GetKeyNames: remote key} {nonPortable} {
+test registry-4.3 {GetKeyNames: remote key} {pcOnly nonPortable english} {
registry set \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar\\baz
set result [registry keys \\\\gaspode\\HKEY_CLASSES_ROOT\\TclFoobar]
registry delete \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar
set result
} {baz}
-test registry-4.4 {GetKeyNames: empty key} {
+test registry-4.4 {GetKeyNames: empty key} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar
set result [registry keys HKEY_CLASSES_ROOT\\TclFoobar]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {}
-test registry-4.5 {GetKeyNames: patterns} {
+test registry-4.5 {GetKeyNames: patterns} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
@@ -206,7 +224,7 @@ test registry-4.5 {GetKeyNames: patterns} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {baz blat}
-test registry-4.6 {GetKeyNames: names with spaces} {
+test registry-4.6 {GetKeyNames: names with spaces} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz\ bar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
@@ -215,187 +233,236 @@ test registry-4.6 {GetKeyNames: names with spaces} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {{baz bar} blat}
+test registry-4.7 {GetKeyNames: Unicode} {pcOnly english} {
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz\u00c7bar
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
+ set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} "baz\u00c7bar blat"
+test registry-4.8 {GetKeyNames: Unicode} {pcOnly} {
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz\u30b7bar
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
+ registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
+ set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} "baz\u30b7bar blat"
-test registry-5.1 {GetType} {
+test registry-5.1 {GetType} {pcOnly english} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
list [catch {registry type HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
} {1 {unable to open key: The system cannot find the file specified.}}
-test registry-5.2 {GetType} {
+test registry-5.2 {GetType} {pcOnly english} {
registry set HKEY_CLASSES_ROOT\\TclFoobar
list [catch {registry type HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
} {1 {unable to get type of value "val1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
-test registry-5.3 {GetType} {
+test registry-5.3 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar none
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} none
-test registry-5.4 {GetType} {
+test registry-5.4 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} sz
-test registry-5.5 {GetType} {
+test registry-5.5 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar sz
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} sz
-test registry-5.6 {GetType} {
+test registry-5.6 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar expand_sz
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} expand_sz
-test registry-5.7 {GetType} {
+test registry-5.7 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 binary
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} binary
-test registry-5.8 {GetType} {
+test registry-5.8 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 dword
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} dword
-test registry-5.9 {GetType} {
+test registry-5.9 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 dword_big_endian
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} dword_big_endian
-test registry-5.10 {GetType} {
+test registry-5.10 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 link
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} link
-test registry-5.11 {GetType} {
+test registry-5.11 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar multi_sz
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} multi_sz
-test registry-5.12 {GetType} {
+test registry-5.12 {GetType} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 resource_list
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} resource_list
-test registry-5.13 {GetType: unknown types} {
+test registry-5.13 {GetType: unknown types} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 24
set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} 24
+test registry-5.14 {GetType: Unicode} {pcOnly} {
+ registry set HKEY_CLASSES_ROOT\\TclFoobar va\u00c7l1 1 24
+ set result [registry type HKEY_CLASSES_ROOT\\TclFoobar va\u00c7l1]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} 24
-test registry-6.1 {GetValue} {
+test registry-6.1 {GetValue} {pcOnly english} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
list [catch {registry get HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
} {1 {unable to open key: The system cannot find the file specified.}}
-test registry-6.2 {GetValue} {
+test registry-6.2 {GetValue} {pcOnly english} {
registry set HKEY_CLASSES_ROOT\\TclFoobar
list [catch {registry get HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
} {1 {unable to get value "val1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
-test registry-6.3 {GetValue} {
+test registry-6.3 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar none
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} foobar
-test registry-6.4 {GetValue} {
+test registry-6.4 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} foobar
-test registry-6.5 {GetValue} {
+test registry-6.5 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar sz
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} foobar
-test registry-6.6 {GetValue} {
+test registry-6.6 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar expand_sz
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} foobar
-test registry-6.7 {GetValue} {
+test registry-6.7 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 binary
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} 1
-test registry-6.8 {GetValue} {
+test registry-6.8 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 0x20 dword
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} 32
-test registry-6.9 {GetValue} {
+test registry-6.9 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 0x20 dword_big_endian
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} 32
-test registry-6.10 {GetValue} {
+test registry-6.10 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 link
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} 1
-test registry-6.11 {GetValue} {
+test registry-6.11 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar multi_sz
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} foobar
-test registry-6.12 {GetValue} {
+test registry-6.12 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo\ bar baz} multi_sz
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {{foo bar} baz}
-test registry-6.13 {GetValue} {
+test registry-6.13 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {} multi_sz
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {}
-test registry-6.14 {GetValue: truncation of multivalues with null elements} {
+test registry-6.14 {GetValue: truncation of multivalues with null elements} \
+ {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {a {} b} multi_sz
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} a
-test registry-6.15 {GetValue} {
+test registry-6.15 {GetValue} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 resource_list
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} 1
-test registry-6.16 {GetValue: unknown types} {
+test registry-6.16 {GetValue: unknown types} {pcOnly} {
registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 24
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} 1
+test registry-6.17 {GetValue: Unicode value names} {pcOnly} {
+ registry set HKEY_CLASSES_ROOT\\TclFoobar val\u00c71 foobar multi_sz
+ set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val\u00c71]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} foobar
+test registry-6.18 {GetValue: values with Unicode strings} {pcOnly} {
+ registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
+ set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} "foo ba\u30b7r baz"
+test registry-6.19 {GetValue: values with Unicode strings} {pcOnly english} {
+ registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz
+ set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} "foo ba\u00c7r baz"
+test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {pcOnly} {
+ registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo ba\u0000r baz} multi_sz
+ set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
+ registry delete HKEY_CLASSES_ROOT\\TclFoobar
+ set result
+} "foo ba r baz"
-test registry-7.1 {GetValueNames: bad key} {
+test registry-7.1 {GetValueNames: bad key} {pcOnly english} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
list [catch {registry values HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
} {1 {unable to open key: The system cannot find the file specified.}}
-test registry-7.2 {GetValueNames} {
+test registry-7.2 {GetValueNames} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar
set result [registry values HKEY_CLASSES_ROOT\\TclFoobar]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} baz
-test registry-7.3 {GetValueNames} {
+test registry-7.3 {GetValueNames} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar1
registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
@@ -404,20 +471,20 @@ test registry-7.3 {GetValueNames} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {{} baz blat}
-test registry-7.4 {GetValueNames: remote key} {nonPortable} {
+test registry-7.4 {GetValueNames: remote key} {pcOnly nonPortable english} {
registry set \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar baz blat
- set result [registry values \\\\gaspode\\HKEY_CLASSES_ROOT\\TclFoobar]
+ set result [registry values \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar]
registry delete \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar
set result
} baz
-test registry-7.5 {GetValueNames: empty key} {
+test registry-7.5 {GetValueNames: empty key} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar
set result [registry values HKEY_CLASSES_ROOT\\TclFoobar]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {}
-test registry-7.6 {GetValueNames: patterns} {
+test registry-7.6 {GetValueNames: patterns} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar1
registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
@@ -426,7 +493,7 @@ test registry-7.6 {GetValueNames: patterns} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} {baz blat}
-test registry-7.7 {GetValueNames: names with spaces} {
+test registry-7.7 {GetValueNames: names with spaces} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar baz\ bar foobar1
registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
@@ -436,50 +503,52 @@ test registry-7.7 {GetValueNames: names with spaces} {
set result
} {{baz bar} blat}
-test registry-8.1 {OpenSubKey} {nonPortable} {
- list [catch {registry keys {\\petrouchka\HKEY_LOCAL_MACHINE}} msg] $msg
+test registry-8.1 {OpenSubKey} {pcOnly nonPortable english} {
+ # This test will only succeed if the current user does not have registry
+ # access on the specified machine.
+ list [catch {registry keys {\\mom\HKEY_LOCAL_MACHINE}} msg] $msg
} {1 {unable to open key: Access is denied.}}
-test registry-8.2 {OpenSubKey} {
+test registry-8.2 {OpenSubKey} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar
set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
registry delete HKEY_CLASSES_ROOT\\TclFoobar
set result
} TclFoobar
-test registry-8.3 {OpenSubKey} {
+test registry-8.3 {OpenSubKey} {pcOnly english} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
} {1 {unable to open key: The system cannot find the file specified.}}
-test registry-9.1 {ParseKeyName: bad keys} {
+test registry-9.1 {ParseKeyName: bad keys} {pcOnly} {
list [catch {registry values \\} msg] $msg
} "1 {bad key \"\\\": must start with a valid root}"
-test registry-9.2 {ParseKeyName: bad keys} {
+test registry-9.2 {ParseKeyName: bad keys} {pcOnly} {
list [catch {registry values \\foobar} msg] $msg
} {1 {bad key "\foobar": must start with a valid root}}
-test registry-9.3 {ParseKeyName: bad keys} {
+test registry-9.3 {ParseKeyName: bad keys} {pcOnly} {
list [catch {registry values \\\\} msg] $msg
-} {1 {ambiguous root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
-test registry-9.4 {ParseKeyName: bad keys} {
+} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
+test registry-9.4 {ParseKeyName: bad keys} {pcOnly} {
list [catch {registry values \\\\\\} msg] $msg
-} {1 {ambiguous root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
-test registry-9.5 {ParseKeyName: bad keys} {
+} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
+test registry-9.5 {ParseKeyName: bad keys} {pcOnly english} {
list [catch {registry values \\\\\\HKEY_CLASSES_ROOT} msg] $msg
} {1 {unable to open key: The network address is invalid.}}
-test registry-9.6 {ParseKeyName: bad keys} {
+test registry-9.6 {ParseKeyName: bad keys} {pcOnly} {
list [catch {registry values \\\\gaspode} msg] $msg
-} {1 {ambiguous root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
-test registry-9.7 {ParseKeyName: bad keys} {
+} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
+test registry-9.7 {ParseKeyName: bad keys} {pcOnly} {
list [catch {registry values foobar} msg] $msg
-} {1 {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, or HKEY_CURRENT_CONFIG}}
-test registry-9.8 {ParseKeyName: null keys} {
+} {1 {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
+test registry-9.8 {ParseKeyName: null keys} {pcOnly} {
list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg
} {1 {bad key: cannot delete root keys}}
-test registry-9.9 {ParseKeyName: null keys} {
+test registry-9.9 {ParseKeyName: null keys} {pcOnly english} {
list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} msg] $msg
} {1 {unable to open key: The system cannot find the file specified.}}
-test registry-10.1 {RecursiveDeleteKey} {
+test registry-10.1 {RecursiveDeleteKey} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
@@ -487,7 +556,7 @@ test registry-10.1 {RecursiveDeleteKey} {
set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
set result
} {}
-test registry-10.2 {RecursiveDeleteKey} {
+test registry-10.2 {RecursiveDeleteKey} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
@@ -496,20 +565,39 @@ test registry-10.2 {RecursiveDeleteKey} {
set result
} {}
-test registry-11.1 {SetValue: recursive creation} {
+test registry-11.1 {SetValue: recursive creation} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat foobar
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar\\baz blat]
} foobar
-test registry-11.2 {SetValue: modification} {
+test registry-11.2 {SetValue: modification} {pcOnly} {
registry delete HKEY_CLASSES_ROOT\\TclFoobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat foobar
registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat frob
set result [registry get HKEY_CLASSES_ROOT\\TclFoobar\\baz blat]
} frob
-test registry-11.3 {SetValue: failure} {nonPortable} {
- list [catch {registry set {\\petrouchka\HKEY_CLASSES_ROOT\TclFoobar} bar foobar} msg] $msg
+test registry-11.3 {SetValue: failure} {pcOnly nonPortable english} {
+ # This test will only succeed if the current user does not have registry
+ # access on the specified machine.
+ list [catch {registry set {\\mom\HKEY_CLASSES_ROOT\TclFoobar} bar foobar} msg] $msg
} {1 {unable to open key: Access is denied.}}
+# cleanup
unset hostname
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/remote.tcl b/tcl/tests/remote.tcl
index 660f5a41016..57ad65a8303 100644
--- a/tcl/tests/remote.tcl
+++ b/tcl/tests/remote.tcl
@@ -159,3 +159,14 @@ if {[catch {set serverSocket \
} else {
vwait __server_wait_variable__
}
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/rename.test b/tcl/tests/rename.test
index 0b1e63420f5..d2b1332433f 100644
--- a/tcl/tests/rename.test
+++ b/tcl/tests/rename.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Must eliminate the "unknown" command while the test is running,
# especially if the test is being run in a program with its
@@ -128,6 +132,9 @@ if {[info command testdel] == "testdel"} {
testdel foo cmd {set env(value) deleted; kill}
list [catch {interp delete foo} msg] $msg $env(value)
} {0 {} deleted}
+ if {[info exists env(value)]} {
+ unset env(value)
+ }
}
# Save the unknown procedure which is modified by the following test.
@@ -163,10 +170,10 @@ test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile
set msg
} {called "incr" with too many arguments}
-catch {rename incr {}}
-catch {rename incr.old incr}
-
-# Make the file return an empty string (cleaner.).
-
-set x ""
+if {[info commands incr.old] != {}} {
+ catch {rename incr {}}
+ catch {rename incr.old incr}
+}
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/resource.test b/tcl/tests/resource.test
index 78005f2d4a8..c593f1b695c 100644
--- a/tcl/tests/resource.test
+++ b/tcl/tests/resource.test
@@ -5,45 +5,45 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-# Only run this test on Macintosh systems
-if {$tcl_platform(platform) != "macintosh"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-test resource-1.1 {resource tests} {
+test resource-1.1 {resource tests} {macOnly} {
list [catch {resource} msg] $msg
} {1 {wrong # args: should be "resource option ?arg ...?"}}
-test resource-1.2 {resource tests} {
+test resource-1.2 {resource tests} {macOnly} {
list [catch {resource _bad_} msg] $msg
} {1 {bad option "_bad_": must be close, delete, files, list, open, read, types, or write}}
# resource open & close tests
-test resource-2.1 {resource open & close tests} {
+test resource-2.1 {resource open & close tests} {macOnly} {
list [catch {resource open} msg] $msg
} {1 {wrong # args: should be "resource open fileName ?permissions?"}}
-test resource-2.2 {resource open & close tests} {
+test resource-2.2 {resource open & close tests} {macOnly} {
list [catch {resource open resource.test r extraArg} msg] $msg
} {1 {wrong # args: should be "resource open fileName ?permissions?"}}
-test resource-2.3 {resource open & close tests} {
+test resource-2.3 {resource open & close tests} {macOnly} {
list [catch {resource open resource.test bad_perms} msg] $msg
} {1 {illegal access mode "bad_perms"}}
-test resource-2.4 {resource open & close tests} {
+test resource-2.4 {resource open & close tests} {macOnly} {
list [catch {resource open _bad_file_} msg] $msg
} {1 {file does not exist}}
-test resource-2.5 {resource open & close tests} {
+test resource-2.5 {resource open & close tests} {macOnly} {
testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"}
set id [resource open rsrc.file]
resource close $id
file delete rsrc.file
} {}
-test resource-2.6 {resource open & close tests} {
+test resource-2.6 {resource open & close tests} {macOnly} {
catch {file delete rsrc.file}
testWriteTextResource -rsrc fileRsrcName -file rsrc.file {A test string}
set id [resource open rsrc.file]
@@ -53,7 +53,7 @@ test resource-2.6 {resource open & close tests} {
file delete rsrc.file
set result
} {0 {A test string}}
-test resource-2.7 {resource open & close tests} {
+test resource-2.7 {resource open & close tests} {macOnly} {
catch {file delete rsrc.file}
testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"}
set id [resource open rsrc.file r]
@@ -63,38 +63,38 @@ test resource-2.7 {resource open & close tests} {
lappend result $mssg
set result
} {1 {Resource already open with different permissions.}}
-test resource-2.8 {resource open & close tests} {
+test resource-2.8 {resource open & close tests} {macOnly} {
list [catch {resource close} msg] $msg
} {1 {wrong # args: should be "resource close resourceRef"}}
-test resource-2.9 {resource open & close tests} {
+test resource-2.9 {resource open & close tests} {macOnly} {
list [catch {resource close foo bar} msg] $msg
} {1 {wrong # args: should be "resource close resourceRef"}}
-test resource-2.10 {resource open & close tests} {
+test resource-2.10 {resource open & close tests} {macOnly} {
list [catch {resource close _bad_resource_} msg] $msg
} {1 {invalid resource file reference "_bad_resource_"}}
-test resource-2.11 {resource open & close tests} {
+test resource-2.11 {resource open & close tests} {macOnly} {
set result [catch {resource close System} mssg]
lappend result $mssg
} {1 {can't close "System" resource file}}
-test resource-2.12 {resource open & close tests} {
+test resource-2.12 {resource open & close tests} {macOnly} {
set result [catch {resource close application} mssg]
lappend result $mssg
} {1 {can't close "application" resource file}}
# Tests for listing resources
-test resource-3.1 {resource list tests} {
+test resource-3.1 {resource list tests} {macOnly} {
list [catch {resource list} msg] $msg
} {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}}
-test resource-3.2 {resource list tests} {
+test resource-3.2 {resource list tests} {macOnly} {
list [catch {resource list _bad_type_} msg] $msg
} {1 {expected Macintosh OS type but got "_bad_type_"}}
-test resource-3.3 {resource list tests} {
+test resource-3.3 {resource list tests} {macOnly} {
list [catch {resource list TEXT _bad_ref_} msg] $msg
} {1 {invalid resource file reference "_bad_ref_"}}
-test resource-3.4 {resource list tests} {
+test resource-3.4 {resource list tests} {macOnly} {
list [catch {resource list TEXT _bad_ref_ extraArg} msg] $msg
} {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}}
-test resource-3.5 {resource list tests} {
+test resource-3.5 {resource list tests} {macOnly} {
catch {file delete rsrc.file}
testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"}
set id [resource open rsrc.file]
@@ -102,11 +102,11 @@ test resource-3.5 {resource list tests} {
resource close $id
set result
} {fileRsrcName}
-test resource-3.6 {resource list tests} {
+test resource-3.6 {resource list tests} {macOnly} {
# There should not be any resource of this type
resource list XXXX
} {}
-test resource-3.7 {resource list tests} {
+test resource-3.7 {resource list tests} {macOnly} {
set resourceList [resource list STR#]
if {[lsearch $resourceList {Tcl Environment Variables}] == -1} {
set result {couldn't find resource that should exist}
@@ -116,32 +116,32 @@ test resource-3.7 {resource list tests} {
} {ok}
# Tests for reading resources
-test resource-4.1 {resource read tests} {
+test resource-4.1 {resource read tests} {macOnly} {
list [catch {resource read} msg] $msg
} {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}}
-test resource-4.2 {resource read tests} {
+test resource-4.2 {resource read tests} {macOnly} {
list [catch {resource read TEXT} msg] $msg
} {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}}
-test resource-4.3 {resource read tests} {
+test resource-4.3 {resource read tests} {macOnly} {
list [catch {resource read STR# {_non_existant_resource_}} msg] $msg
} {1 {could not load resource}}
-test resource-4.4 {resource read tests} {
+test resource-4.4 {resource read tests} {macOnly} {
# The following resource should exist and load OK without error
catch {resource read STR# {Tcl Environment Variables}}
} {0}
# Tests for getting resource types
-test resource-5.1 {resource types tests} {
+test resource-5.1 {resource types tests} {macOnly} {
list [catch {resource types _bad_ref_} msg] $msg
} {1 {invalid resource file reference "_bad_ref_"}}
-test resource-5.2 {resource types tests} {
+test resource-5.2 {resource types tests} {macOnly} {
list [catch {resource types _bad_ref_ extraArg} msg] $msg
} {1 {wrong # args: should be "resource types ?resourceRef?"}}
-test resource-5.3 {resource types tests} {
+test resource-5.3 {resource types tests} {macOnly} {
# This should never cause an error
catch {resource types}
} {0}
-test resource-5.4 {resource types tests} {
+test resource-5.4 {resource types tests} {macOnly} {
testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"}
set id [resource open rsrc.file]
set result [resource types $id]
@@ -150,13 +150,13 @@ test resource-5.4 {resource types tests} {
} {TEXT}
# resource write tests
-test resource-6.1 {resource write tests} {
+test resource-6.1 {resource write tests} {macOnly} {
list [catch {resource write} msg] $msg
} {1 {wrong # args: should be "resource write ?-id resourceId? ?-name resourceName? ?-file resourceRef? ?-force? resourceType data"}}
-test resource-6.2 {resource write tests} {
+test resource-6.2 {resource write tests} {macOnly} {
list [catch {resource write _bad_type_ data} msg] $msg
} {1 {expected Macintosh OS type but got "_bad_type_"}}
-test resource-6.3 {resource write tests} {
+test resource-6.3 {resource write tests} {macOnly} {
catch {file delete rsrc2.file}
set id [resource open rsrc2.file w]
resource close $id
@@ -168,7 +168,7 @@ test resource-6.3 {resource write tests} {
file delete rsrc2.file
set result
} {1 0 -1}
-test resource-6.4 {resource write tests} {
+test resource-6.4 {resource write tests} {macOnly} {
catch {file delete rsrc2.file}
set id [resource open rsrc2.file w]
resource write -file $id -name Hello TEXT {set x "our test data"}
@@ -177,7 +177,7 @@ test resource-6.4 {resource write tests} {
file delete rsrc2.file
set x
} {our test data}
-test resource-6.5 {resource write tests} {
+test resource-6.5 {resource write tests} {macOnly} {
catch {file delete rsrc2.file}
set id [resource open rsrc2.file w]
resource write -file $id -id 256 TEXT {HAHAHAHAHAHAHA}
@@ -186,7 +186,7 @@ test resource-6.5 {resource write tests} {
file delete rsrc2.file
lappend result $mssg
} {1 {the resource 256 already exists, use "-force" to overwrite it.}}
-test resource-6.6 {resource write tests} {
+test resource-6.6 {resource write tests} {macOnly} {
catch {file delete rsrc2.file}
testWriteTextResource -rsrc fileRsrcName -rsrcid 256 -file rsrc2.file -protected {error "don't tread on me"}
set id [resource open rsrc2.file w]
@@ -195,7 +195,7 @@ test resource-6.6 {resource write tests} {
file delete rsrc2.file
lappend result $mssg
} {1 {could not write resource id 256 of type TEXT, it was protected.}}
-test resource-6.7 {resource write tests} {
+test resource-6.7 {resource write tests} {macOnly} {
catch {file delete rsrc2.file}
set id [resource open rsrc2.file w]
resource write -file $id -id 256 -name FOO TEXT {set x [list "our first test data"]}
@@ -208,11 +208,11 @@ test resource-6.7 {resource write tests} {
} {{our second test data} BAR}
#Tests for listing open resource files
-test resource-7.1 {resource file tests} {
+test resource-7.1 {resource file tests} {macOnly} {
catch {resource files foo bar} mssg
set mssg
} {wrong # args: should be "resource files ?resourceId?"}
-test resource-7.2 {resource file tests} {
+test resource-7.2 {resource file tests} {macOnly} {
catch {file delete rsrc2.file}
set rsrcFiles [resource files]
set id [resource open rsrc2.file w]
@@ -222,7 +222,7 @@ test resource-7.2 {resource file tests} {
file delete rsrc2.file
set result
} {0 0}
-test resource-7.3 {resource file tests} {
+test resource-7.3 {resource file tests} {macOnly} {
set result 0
foreach file [resource files] {
if {[catch {resource types $file}] != 0} {
@@ -231,31 +231,31 @@ test resource-7.3 {resource file tests} {
}
set result
} {0}
-test resource-7.4 {resource file tests} {
+test resource-7.4 {resource file tests} {macOnly} {
catch {resource files __NO_SUCH_RESOURCE__} mssg
set mssg
} {invalid resource file reference "__NO_SUCH_RESOURCE__"}
-test resource-7.5 {resource file tests} {
+test resource-7.5 {resource file tests} {macOnly} {
set sys [resource files System]
string compare $sys [file join $env(SYS_FOLDER) System]
} {0}
-test resource-7.6 {resource file tests} {
+test resource-7.6 {resource file tests} {macOnly} {
set app [resource files application]
string compare $app [info nameofexecutable]
} {0}
#Tests for the resource delete command
-test resource-8.1 {resource delete tests} {
+test resource-8.1 {resource delete tests} {macOnly} {
list [catch {resource delete} msg] $msg
} {1 {wrong # args: should be "resource delete ?-id resourceId? ?-name resourceName? ?-file resourceRef? resourceType"}}
-test resource-8.2 {resource delete tests} {
+test resource-8.2 {resource delete tests} {macOnly} {
list [catch {resource delete TEXT} msg] $msg
} {1 {you must specify either "-id" or "-name" or both to "resource delete"}}
-test resource-8.3 {resource delete tests} {
+test resource-8.3 {resource delete tests} {macOnly} {
set result [catch {resource delete -file ffffff -id 128 TEXT} mssg]
lappend result $mssg
} {1 {invalid resource file reference "ffffff"}}
-test resource-8.4 {resource delete tests} {
+test resource-8.4 {resource delete tests} {macOnly} {
catch {file delete rsrc2.file}
testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
set id [resource open rsrc2.file r]
@@ -264,7 +264,7 @@ test resource-8.4 {resource delete tests} {
file delete rsrc2.file
lappend result [string compare $mssg "cannot delete from resource file \"$id\", it was opened read only"]
} {1 0}
-test resource-8.5 {resource delete tests} {
+test resource-8.5 {resource delete tests} {macOnly} {
catch {file delete rsrc2.file}
testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
set id [resource open rsrc2.file w]
@@ -273,7 +273,7 @@ test resource-8.5 {resource delete tests} {
file delete rsrc2.file
lappend result $mssg
} {1 {expected Macintosh OS type but got "_bad_type_"}}
-test resource-8.5 {resource delete tests} {
+test resource-8.5 {resource delete tests} {macOnly} {
catch {file delete rsrc2.file}
set id [resource open rsrc2.file w]
set result [catch {resource delete -id 128 -file $id TEXT} mssg]
@@ -281,7 +281,7 @@ test resource-8.5 {resource delete tests} {
file delete rsrc2.file
lappend result $mssg
} {1 {resource not found}}
-test resource-8.6 {resource delete tests} {
+test resource-8.6 {resource delete tests} {macOnly} {
catch {file delete rsrc2.file}
set id [resource open rsrc2.file w]
set result [catch {resource delete -name foo -file $id TEXT} mssg]
@@ -289,7 +289,7 @@ test resource-8.6 {resource delete tests} {
file delete rsrc2.file
lappend result $mssg
} {1 {resource not found}}
-test resource-8.7 {resource delete tests} {
+test resource-8.7 {resource delete tests} {macOnly} {
catch {file delete rsrc2.file}
set id [resource open rsrc2.file w]
resource write -file $id -name foo -id 128 TEXT {some stuff}
@@ -299,7 +299,7 @@ test resource-8.7 {resource delete tests} {
file delete rsrc2.file
lappend result $mssg
} {1 {"-id" and "-name" values do not point to the same resource}}
-test resource-8.8 {resource delete tests} {
+test resource-8.8 {resource delete tests} {macOnly} {
catch {file delete rsrc2.file}
testWriteTextResource -rsrc fileRsrcName -rsrcid 256 -file rsrc2.file -protected {error "don't tread on me"}
set id [resource open rsrc2.file w]
@@ -308,7 +308,7 @@ test resource-8.8 {resource delete tests} {
file delete rsrc2.file
lappend result $mssg
} {1 {resource cannot be deleted: it is protected.}}
-test resource-8.9 {resource delete tests} {
+test resource-8.9 {resource delete tests} {macOnly} {
catch {file delete rsrc2.file}
testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
set id [resource open rsrc2.file w]
@@ -322,31 +322,45 @@ test resource-8.9 {resource delete tests} {
# Tests for the Mac version of the source command
catch {file delete rsrc.file}
-testWriteTextResource -rsrc fileRsrcName -rsrcid 128 \
- -file rsrc.file {set rsrc_foo 1}
-test resource-9.1 {source command} {
+test resource-9.1 {source command} {macOnly} {
+ testWriteTextResource -rsrc fileRsrcName -rsrcid 128 \
+ -file rsrc.file {set rsrc_foo 1}
catch {unset rsrc_foo}
source -rsrc fileRsrcName rsrc.file
list [catch {set rsrc_foo} msg] $msg
} {0 1}
-test resource-9.2 {source command} {
+test resource-9.2 {source command} {macOnly} {
catch {unset rsrc_foo}
list [catch {source -rsrc no_resource rsrc.file} msg] $msg
} {1 {The resource "no_resource" could not be loaded from rsrc.file.}}
-test resource-9.3 {source command} {
+test resource-9.3 {source command} {macOnly} {
catch {unset rsrc_foo}
source -rsrcid 128 rsrc.file
list [catch {set rsrc_foo} msg] $msg
} {0 1}
-test resource-9.4 {source command} {
+test resource-9.4 {source command} {macOnly} {
catch {unset rsrc_foo}
list [catch {source -rsrcid bad_int rsrc.file} msg] $msg
} {1 {expected integer but got "bad_int"}}
-test resource-9.5 {source command} {
+test resource-9.5 {source command} {macOnly} {
catch {unset rsrc_foo}
list [catch {source -rsrcid 100 rsrc.file} msg] $msg
} {1 {The resource "ID=100" could not be loaded from rsrc.file.}}
-# Clean up and return
+# cleanup
catch {file delete rsrc.file}
+::tcltest::cleanupTests
return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/result.test b/tcl/tests/result.test
new file mode 100644
index 00000000000..e8418e271ed
--- /dev/null
+++ b/tcl/tests/result.test
@@ -0,0 +1,103 @@
+# This file tests the routines in tclResult.c.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) result.test 1.4 97/12/08 15:07:49
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# Some tests require the testsaveresult command
+
+set ::tcltest::testConstraints(testsaveresult) \
+ [expr {[info commands testsaveresult] != {}}]
+
+test result-1.1 {Tcl_SaveInterpResult} {testsaveresult} {
+ testsaveresult small {set x 42} 0
+} {small result}
+test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} {
+ testsaveresult append {set x 42} 0
+} {append result}
+test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} {
+ testsaveresult dynamic {set x 42} 0
+} {dynamic result notCalled present}
+test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} {
+ testsaveresult object {set x 42} 0
+} {object result same}
+test result-1.5 {Tcl_SaveInterpResult} {testsaveresult} {
+ testsaveresult small {set x 42} 1
+} {42}
+test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} {
+ testsaveresult append {set x 42} 1
+} {42}
+test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} {
+ testsaveresult dynamic {set x 42} 1
+} {42 called missing}
+test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} {
+ testsaveresult object {set x 42} 1
+} {42 different}
+
+
+# Tcl_RestoreInterpResult is mostly tested by the previous tests except
+# for the following case
+
+test result-2.1 {Tcl_RestoreInterpResult} {testsaveresult} {
+ testsaveresult append {cd _foobar} 0
+} {append result}
+
+# Tcl_DiscardInterpResult is mostly tested by the previous tests except
+# for the following cases
+
+test result-3.1 {Tcl_DiscardInterpResult} {testsaveresult} {
+ list [catch {testsaveresult append {cd _foobar} 1} msg] $msg
+} {1 {couldn't change working directory to "_foobar": no such file or directory}}
+test result-3.2 {Tcl_DiscardInterpResult} {testsaveresult} {
+ testsaveresult free {set x 42} 1
+} {42}
+
+test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsaveresult} {
+ catch {testsetobjerrorcode 1}
+ list [set errorCode]
+} {1}
+test result-4.2 {Tcl_SetObjErrorCode - two args} {testsaveresult} {
+ catch {testsetobjerrorcode 1 2}
+ list [set errorCode]
+} {{1 2}}
+test result-4.3 {Tcl_SetObjErrorCode - three args} {testsaveresult} {
+ catch {testsetobjerrorcode 1 2 3}
+ list [set errorCode]
+} {{1 2 3}}
+test result-4.4 {Tcl_SetObjErrorCode - four args} {testsaveresult} {
+ catch {testsetobjerrorcode 1 2 3 4}
+ list [set errorCode]
+} {{1 2 3 4}}
+test result-4.5 {Tcl_SetObjErrorCode - five args} {testsaveresult} {
+ catch {testsetobjerrorcode 1 2 3 4 5}
+ list [set errorCode]
+} {{1 2 3 4 5}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/safe.test b/tcl/tests/safe.test
index bf053eae03c..2520b24d9e7 100644
--- a/tcl/tests/safe.test
+++ b/tcl/tests/safe.test
@@ -5,13 +5,17 @@
# and generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
foreach i [interp slaves] {
interp delete $i
@@ -81,7 +85,7 @@ test safe-3.2 {calling safe::interpCreate on trusted interp} {
set l [lsort [a aliases]]
safe::interpDelete a
set l
-} {exit file load source}
+} {encoding exit file load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} {
catch {safe::interpDelete a}
safe::interpCreate a
@@ -167,11 +171,20 @@ test safe-6.1 {test safe interpreters knowledge of the world} {
test safe-6.2 {test safe interpreters knowledge of the world} {
SI; set r [$I eval {info script}]; DI; set r
} {}
-test safe-6.3 {test safe interpreters knowledge of the world} {pcOnly} {
- SI; set r [lsort [$I eval {array names tcl_platform}]]; DI; set r
-} {byteOrder debug platform}
-test safe-6.3 {test safe interpreters knowledge of the world} {macOrUnix} {
- SI; set r [lsort [$I eval {array names tcl_platform}]]; DI; set r
+test safe-6.3 {test safe interpreters knowledge of the world} {
+ SI
+ set r [lsort [$I eval {array names tcl_platform}]]
+ DI
+ # If running a windows-debug shell, remove the "debug" element from r.
+ if {$tcl_platform(platform) == "windows" && \
+ [lsearch $r "debug"] != -1} {
+ set r [lreplace $r 1 1]
+ }
+ set threaded [lsearch $r "threaded"]
+ if {$threaded != -1} {
+ set r [lreplace $r $threaded $threaded]
+ }
+ set r
} {byteOrder platform}
# more test should be added to check that hostname, nameofexecutable,
@@ -434,3 +447,87 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} {
}
+
+test safe-11.1 {testing safe encoding} {
+ set i [safe::interpCreate]
+ list \
+ [catch {interp eval $i encoding} msg] \
+ $msg \
+ [safe::interpDelete $i];
+} {1 {wrong # args: should be "encoding option ?arg ...?"} {}}
+
+test safe-11.2 {testing safe encoding} {
+ set i [safe::interpCreate]
+ list \
+ [catch {interp eval $i encoding system cp775} msg] \
+ $msg \
+ [safe::interpDelete $i];
+} {1 {wrong # args: should be "encoding system"} {}}
+
+test safe-11.3 {testing safe encoding} {
+ set i [safe::interpCreate]
+ set result [catch {
+ string match [encoding system] [interp eval $i encoding system]
+ } msg]
+ list $result $msg [safe::interpDelete $i]
+} {0 1 {}}
+
+test safe-11.4 {testing safe encoding} {
+ set i [safe::interpCreate]
+ set result [catch {
+ string match [encoding names] [interp eval $i encoding names]
+ } msg]
+ list $result $msg [safe::interpDelete $i]
+} {0 1 {}}
+
+test safe-11.5 {testing safe encoding} {
+ set i [safe::interpCreate]
+ list \
+ [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \
+ $msg \
+ [safe::interpDelete $i];
+} {0 foobar {}}
+
+
+test safe-11.6 {testing safe encoding} {
+ set i [safe::interpCreate]
+ list \
+ [catch {interp eval $i encoding convertto cp1258 foobar} msg] \
+ $msg \
+ [safe::interpDelete $i];
+} {0 foobar {}}
+
+test safe-11.7 {testing safe encoding} {
+ set i [safe::interpCreate]
+ list \
+ [catch {interp eval $i encoding convertfrom} msg] \
+ $msg \
+ [safe::interpDelete $i];
+} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}}
+
+
+test safe-11.8 {testing safe encoding} {
+ set i [safe::interpCreate]
+ list \
+ [catch {interp eval $i encoding convertto} msg] \
+ $msg \
+ [safe::interpDelete $i];
+} {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}}
+
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/scan.test b/tcl/tests/scan.test
index 21524ba1b97..1296d9cf3d7 100644
--- a/tcl/tests/scan.test
+++ b/tcl/tests/scan.test
@@ -6,52 +6,362 @@
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
-test scan-1.1 {integer scanning} {
+test scan-1.1 {BuildCharSet, CharInSet} {
+ list [scan foo {%[^o]} x] $x
+} {1 f}
+test scan-1.2 {BuildCharSet, CharInSet} {
+ list [scan \]foo {%[]f]} x] $x
+} {1 \]f}
+test scan-1.3 {BuildCharSet, CharInSet} {
+ list [scan abc-def {%[a-c]} x] $x
+} {1 abc}
+test scan-1.4 {BuildCharSet, CharInSet} {
+ list [scan abc-def {%[a-c]} x] $x
+} {1 abc}
+test scan-1.5 {BuildCharSet, CharInSet} {
+ list [scan -abc-def {%[-ac]} x] $x
+} {1 -a}
+test scan-1.6 {BuildCharSet, CharInSet} {
+ list [scan -abc-def {%[ac-]} x] $x
+} {1 -a}
+test scan-1.7 {BuildCharSet, CharInSet} {
+ list [scan abc-def {%[c-a]} x] $x
+} {1 abc}
+test scan-1.8 {BuildCharSet, CharInSet} {
+ list [scan def-abc {%[^c-a]} x] $x
+} {1 def-}
+test scan-1.9 {BuildCharSet, CharInSet no match} {
+ catch {unset x}
+ list [scan {= f} {= %[TF]} x] [info exists x]
+} {0 0}
+
+test scan-2.1 {ReleaseCharSet} {
+ list [scan abcde {%[abc]} x] $x
+} {1 abc}
+test scan-2.2 {ReleaseCharSet} {
+ list [scan abcde {%[a-c]} x] $x
+} {1 abc}
+
+test scan-3.1 {ValidateFormat} {
+ list [catch {scan {} {%d%1$d} x} msg] $msg
+} {1 {cannot mix "%" and "%n$" conversion specifiers}}
+test scan-3.2 {ValidateFormat} {
+ list [catch {scan {} {%d%1$d} x} msg] $msg
+} {1 {cannot mix "%" and "%n$" conversion specifiers}}
+test scan-3.3 {ValidateFormat} {
+ list [catch {scan {} {%2$d%d} x} msg] $msg
+} {1 {"%n$" argument index out of range}}
+test scan-3.4 {ValidateFormat} {
+ # degenerate case, before changed from 8.2 to 8.3
+ list [catch {scan {} %d} msg] $msg
+} {0 {}}
+test scan-3.5 {ValidateFormat} {
+ list [catch {scan {} {%10c} a} msg] $msg
+} {1 {field width may not be specified in %c conversion}}
+test scan-3.6 {ValidateFormat} {
+ list [catch {scan {} {%*1$d} a} msg] $msg
+} {1 {bad scan conversion character "$"}}
+test scan-3.7 {ValidateFormat} {
+ list [catch {scan {} {%1$d%1$d} a} msg] $msg
+} {1 {variable is assigned by multiple "%n$" conversion specifiers}}
+test scan-3.8 {ValidateFormat} {
+ list [catch {scan {} a x} msg] $msg
+} {1 {variable is not assigned by any conversion specifiers}}
+test scan-3.9 {ValidateFormat} {
+ list [catch {scan {} {%2$s} x y} msg] $msg
+} {1 {variable is not assigned by any conversion specifiers}}
+test scan-3.10 {ValidateFormat} {
+ list [catch {scan {} {%[a} x} msg] $msg
+} {1 {unmatched [ in format string}}
+test scan-3.11 {ValidateFormat} {
+ list [catch {scan {} {%[^a} x} msg] $msg
+} {1 {unmatched [ in format string}}
+test scan-3.12 {ValidateFormat} {
+ list [catch {scan {} {%[]a} x} msg] $msg
+} {1 {unmatched [ in format string}}
+test scan-3.13 {ValidateFormat} {
+ list [catch {scan {} {%[^]a} x} msg] $msg
+} {1 {unmatched [ in format string}}
+
+test scan-4.1 {Tcl_ScanObjCmd, argument checks} {
+ list [catch {scan} msg] $msg
+} {1 {wrong # args: should be "scan string format ?varName varName ...?"}}
+test scan-4.2 {Tcl_ScanObjCmd, argument checks} {
+ list [catch {scan string} msg] $msg
+} {1 {wrong # args: should be "scan string format ?varName varName ...?"}}
+test scan-4.3 {Tcl_ScanObjCmd, argument checks} {
+ # degenerate case, before changed from 8.2 to 8.3
+ list [catch {scan string format} msg] $msg
+} {0 {}}
+test scan-4.4 {Tcl_ScanObjCmd, whitespace} {
+ list [scan { abc def } {%s%s} x y] $x $y
+} {2 abc def}
+test scan-4.5 {Tcl_ScanObjCmd, whitespace} {
+ list [scan { abc def } { %s %s } x y] $x $y
+} {2 abc def}
+test scan-4.6 {Tcl_ScanObjCmd, whitespace} {
+ list [scan { abc def } { %s %s } x y] $x $y
+} {2 abc def}
+test scan-4.7 {Tcl_ScanObjCmd, literals} {
+ # degenerate case, before changed from 8.2 to 8.3
+ scan { abc def } { abc def }
+} {}
+test scan-4.8 {Tcl_ScanObjCmd, literals} {
+ set x {}
+ list [scan { abcg} { abc def %1s} x] $x
+} {0 {}}
+test scan-4.9 {Tcl_ScanObjCmd, literals} {
+ list [scan { abc%defghi} { abc %% def%n } x] $x
+} {1 10}
+test scan-4.10 {Tcl_ScanObjCmd, assignment suppression} {
+ list [scan { abc def } { %*c%s def } x] $x
+} {1 bc}
+test scan-4.11 {Tcl_ScanObjCmd, XPG3-style} {
+ list [scan { abc def } {%2$s %1$s} x y] $x $y
+} {2 def abc}
+test scan-4.12 {Tcl_ScanObjCmd, width specifiers} {
+ list [scan {abc123456789012} {%3s%3d%3f%3[0-9]%s} a b c d e] $a $b $c $d $e
+} {5 abc 123 456.0 789 012}
+test scan-4.13 {Tcl_ScanObjCmd, width specifiers} {
+ list [scan {abc123456789012} {%3s%3d%3f%3[0-9]%s} a b c d e] $a $b $c $d $e
+} {5 abc 123 456.0 789 012}
+test scan-4.14 {Tcl_ScanObjCmd, underflow} {
+ set x {}
+ list [scan {a} {a%d} x] $x
+} {-1 {}}
+test scan-4.15 {Tcl_ScanObjCmd, underflow} {
+ set x {}
+ list [scan {} {a%d} x] $x
+} {-1 {}}
+test scan-4.16 {Tcl_ScanObjCmd, underflow} {
+ set x {}
+ list [scan {ab} {a%d} x] $x
+} {0 {}}
+test scan-4.17 {Tcl_ScanObjCmd, underflow} {
+ set x {}
+ list [scan {a } {a%d} x] $x
+} {-1 {}}
+test scan-4.18 {Tcl_ScanObjCmd, skipping whitespace} {
+ list [scan { b} {%c%s} x y] $x $y
+} {2 32 b}
+test scan-4.19 {Tcl_ScanObjCmd, skipping whitespace} {
+ list [scan { b} {%[^b]%s} x y] $x $y
+} {2 { } b}
+test scan-4.20 {Tcl_ScanObjCmd, string scanning} {
+ list [scan {abc def} {%s} x] $x
+} {1 abc}
+test scan-4.21 {Tcl_ScanObjCmd, string scanning} {
+ list [scan {abc def} {%0s} x] $x
+} {1 abc}
+test scan-4.22 {Tcl_ScanObjCmd, string scanning} {
+ list [scan {abc def} {%2s} x] $x
+} {1 ab}
+test scan-4.23 {Tcl_ScanObjCmd, string scanning} {
+ list [scan {abc def} {%*s%n} x] $x
+} {1 3}
+test scan-4.24 {Tcl_ScanObjCmd, charset scanning} {
+ list [scan {abcdef} {%[a-c]} x] $x
+} {1 abc}
+test scan-4.25 {Tcl_ScanObjCmd, charset scanning} {
+ list [scan {abcdef} {%0[a-c]} x] $x
+} {1 abc}
+test scan-4.26 {Tcl_ScanObjCmd, charset scanning} {
+ list [scan {abcdef} {%2[a-c]} x] $x
+} {1 ab}
+test scan-4.27 {Tcl_ScanObjCmd, charset scanning} {
+ list [scan {abcdef} {%*[a-c]%n} x] $x
+} {1 3}
+test scan-4.28 {Tcl_ScanObjCmd, character scanning} {
+ list [scan {abcdef} {%c} x] $x
+} {1 97}
+test scan-4.29 {Tcl_ScanObjCmd, character scanning} {
+ list [scan {abcdef} {%*c%n} x] $x
+} {1 1}
+
+test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} {
+ set x {}
+ list [scan {1234567890a} {%3d} x] $x
+} {1 123}
+test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} {
+ set x {}
+ list [scan {1234567890a} {%d} x] $x
+} {1 1234567890}
+test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} {
+ set x {}
+ list [scan {01234567890a} {%d} x] $x
+} {1 1234567890}
+test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} {
+ set x {}
+ list [scan {+01234} {%d} x] $x
+} {1 1234}
+test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} {
+ set x {}
+ list [scan {-01234} {%d} x] $x
+} {1 -1234}
+test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} {
+ set x {}
+ list [scan {a01234} {%d} x] $x
+} {0 {}}
+test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} {
+ set x {}
+ list [scan {0x10} {%d} x] $x
+} {1 0}
+test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} {
+ set x {}
+ list [scan {012345678} {%o} x] $x
+} {1 342391}
+test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} {
+ set x {}
+ list [scan {+1238 -1239 123a} {%o%*s%o%*s%o} x y z] $x $y $z
+} {3 83 -83 83}
+test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} {
+ set x {}
+ list [scan {+1238 -123a 0123} {%x%x%x} x y z] $x $y $z
+} {3 4664 -4666 291}
+test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} {
+ set x {}
+ list [scan {aBcDeF AbCdEf 0x1} {%x%x%x} x y z] $x $y $z
+} {3 11259375 11259375 0}
+test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} {
+ set x {}
+ list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z
+} {3 10 8 16}
+test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} {
+ set x {}
+ list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z
+} {3 10 8 16}
+test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} {
+ set x {}
+ list [scan {+ } {%i} x] $x
+} {0 {}}
+test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} {
+ set x {}
+ list [scan {+} {%i} x] $x
+} {-1 {}}
+test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} {
+ set x {}
+ list [scan {0x} {%i%s} x y] $x $y
+} {2 0 x}
+test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} {
+ set x {}
+ list [scan {0X} {%i%s} x y] $x $y
+} {2 0 X}
+test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} {
+ set x {}
+ list [scan {123def} {%*i%s} x] $x
+} {1 def}
+test scan-4.48 {Tcl_ScanObjCmd, float scanning} {
+ list [scan {1 2 3} {%e %f %g} x y z] $x $y $z
+} {3 1.0 2.0 3.0}
+test scan-4.49 {Tcl_ScanObjCmd, float scanning} {
+ list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z
+} {3 0.1 0.2 3.0}
+test scan-4.50 {Tcl_ScanObjCmd, float scanning} {
+ list [scan {1234567890a} %f x] $x
+} {1 1234567890.0}
+test scan-4.51 {Tcl_ScanObjCmd, float scanning} {
+ list [scan {+123+45} %f x] $x
+} {1 123.0}
+test scan-4.52 {Tcl_ScanObjCmd, float scanning} {
+ list [scan {-123+45} %f x] $x
+} {1 -123.0}
+test scan-4.53 {Tcl_ScanObjCmd, float scanning} {
+ list [scan {1.0e1} %f x] $x
+} {1 10.0}
+test scan-4.54 {Tcl_ScanObjCmd, float scanning} {
+ list [scan {1.0e-1} %f x] $x
+} {1 0.1}
+test scan-4.55 {Tcl_ScanObjCmd, odd cases} {
+ set x {}
+ list [scan {+} %f x] $x
+} {-1 {}}
+test scan-4.56 {Tcl_ScanObjCmd, odd cases} {
+ set x {}
+ list [scan {1.0e} %f%s x y] $x $y
+} {2 1.0 e}
+test scan-4.57 {Tcl_ScanObjCmd, odd cases} {
+ set x {}
+ list [scan {1.0e+} %f%s x y] $x $y
+} {2 1.0 e+}
+test scan-4.58 {Tcl_ScanObjCmd, odd cases} {
+ set x {}
+ set y {}
+ list [scan {e1} %f%s x y] $x $y
+} {0 {} {}}
+test scan-4.59 {Tcl_ScanObjCmd, float scanning} {
+ list [scan {1.0e-1x} %*f%n x] $x
+} {1 6}
+
+test scan-4.60 {Tcl_ScanObjCmd, set errors} {
+ set x {}
+ set y {}
+ catch {unset z}; array set z {}
+ set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \
+ $msg $x $y]
+ unset z
+ set result
+} {1 {couldn't set variable "z"} abc ghi}
+test scan-4.61 {Tcl_ScanObjCmd, set errors} {
+ set x {}
+ catch {unset y}; array set y {}
+ catch {unset z}; array set z {}
+ set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \
+ $msg $x]
+ unset y
+ unset z
+ set result
+} {1 {couldn't set variable "z"couldn't set variable "y"} abc}
+
+test scan-5.1 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d
} {4 -20 1476 33 0}
-test scan-1.2 {integer scanning} {
+test scan-5.2 {integer scanning} {
set a {}; set b {}; set c {}
list [scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c] $a $b $c
} {3 -4 16 7890}
-test scan-1.3 {integer scanning} {
+test scan-5.3 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "-45 16 +10 987" "%ld %d %ld %d" a b c d] $a $b $c $d
} {4 -45 16 10 987}
-test scan-1.4 {integer scanning} {
+test scan-5.4 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "14 1ab 62 10" "%d %x %lo %x" a b c d] $a $b $c $d
} {4 14 427 50 16}
-test scan-1.5 {integer scanning} {
+test scan-5.5 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "12345670 1234567890ab cdefg" "%o %o %x %lx" a b c d] \
$a $b $c $d
} {4 2739128 342391 561323 52719}
-test scan-1.6 {integer scanning} {
+test scan-5.6 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "ab123-24642" "%2x %3x %3o %2o" a b c d] $a $b $c $d
} {4 171 291 -20 52}
-test scan-1.7 {integer scanning} {
+test scan-5.7 {integer scanning} {
set a {}; set b {}
list [scan "1234567 234 567 " "%*3x %x %*o %4o" a b] $a $b
} {2 17767 375}
-test scan-1.8 {integer scanning} {
+test scan-5.8 {integer scanning} {
set a {}; set b {}
list [scan "a 1234" "%d %d" a b] $a $b
} {0 {} {}}
-test scan-1.9 {integer scanning} {
+test scan-5.9 {integer scanning} {
set a {}; set b {}; set c {}; set d {};
list [scan "12345678" "%2d %2d %2ld %2d" a b c d] $a $b $c $d
} {4 12 34 56 78}
-test scan-1.10 {integer scanning} {
+test scan-5.10 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d
} {2 1 2 {} {}}
@@ -60,20 +370,21 @@ test scan-1.10 {integer scanning} {
# not defined by the ANSI spec. Some implementations wrap the
# input (-16) some return MAX_INT.
#
-test scan-1.11 {integer scanning} {nonPortable} {
+test scan-5.11 {integer scanning} {nonPortable} {
set a {}; set b {};
- list [scan "4294967280 4294967280" "%u %d" a b] $a $b
-} {2 4294967280 -16}
+ list [scan "4294967280 4294967280" "%u %d" a b] $a \
+ [expr {$b == -16 || $b == 0x7fffffff}]
+} {2 4294967280 1}
-test scan-2.1 {floating-point scanning} {
+test scan-6.1 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
} {3 2.1 -300000000.0 0.99962 {}}
-test scan-2.2 {floating-point scanning} {
+test scan-6.2 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d
} {4 -1.0 234.0 5.0 8.2}
-test scan-2.3 {floating-point scanning} {
+test scan-6.3 {floating-point scanning} {
set a {}; set b {}; set c {}
list [scan "1e00004 332E-4 3e+4" "%Lf %*2e %f %f" a b c] $a $c
} {3 10000.0 30000.0}
@@ -81,166 +392,256 @@ test scan-2.3 {floating-point scanning} {
# Some libc implementations consider 3.e- bad input. The ANSI
# spec states that digits must follow the - sign.
#
-test scan-2.4 {floating-point scanning} {nonPortable} {
+test scan-6.4 {floating-point scanning} {
set a {}; set b {}; set c {}
list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c
} {3 1.0 200.0 3.0}
-test scan-2.5 {floating-point scanning} {
+test scan-6.5 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
} {4 4.6 99999.7 87.643 118.0}
-test scan-2.6 {floating-point scanning} {eformat} {
+test scan-6.6 {floating-point scanning} {eformat} {
set a {}; set b {}; set c {}; set d {}
list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
} {4 1.2345 0.697 124.0 5e-05}
-test scan-2.7 {floating-point scanning} {
+test scan-6.7 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d
} {1 4.6 {} {} {}}
-test scan-2.8 {floating-point scanning} {
+test scan-6.8 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d
} {2 4.6 5.2 {} {}}
-test scan-3.1 {string and character scanning} {
+test scan-7.1 {string and character scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
} {4 abc def ghijk dum}
-test scan-3.2 {string and character scanning} {
+test scan-7.2 {string and character scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "a bcdef" "%c%c%1s %s" a b c d] $a $b $c $d
} {4 97 32 b cdef}
-test scan-3.3 {string and character scanning} {
+test scan-7.3 {string and character scanning} {
set a {}; set b {}; set c {}
list [scan "123456 test " "%*c%*s %s %s %s" a b c] $a $b $c
} {1 test {} {}}
-test scan-3.4 {string and character scanning} {
+test scan-7.4 {string and character scanning} {
set a {}; set b {}; set c {}; set d
list [scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d] $a $b $c $d
} {4 abab cd {01234 } {f 12345}}
-test scan-3.5 {string and character scanning} {
+test scan-7.5 {string and character scanning} {
set a {}; set b {}; set c {}
list [scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
} {3 aabc bcdefg 43}
+test scan-7.6 {string and character scanning, unicode} {
+ set a {}; set b {}; set c {}; set d {}
+ list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
+} "4 abc d\u00c7f ghijk dum"
+test scan-7.7 {string and character scanning, unicode} {
+ set a {}; set b {}
+ list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b
+} "2 199 99"
+test scan-7.8 {string and character scanning, unicode} {
+ set a {}; set b {}
+ list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a
+} "1 ab\ufeff"
-test scan-4.1 {error conditions} {
+test scan-8.1 {error conditions} {
catch {scan a}
} 1
-test scan-4.2 {error conditions} {
+test scan-8.2 {error conditions} {
catch {scan a} msg
set msg
} {wrong # args: should be "scan string format ?varName varName ...?"}
-test scan-4.3 {error conditions} {
- catch {scan "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21}
-} 1
-test scan-4.4 {error conditions} {
- catch {scan "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21} msg
- set msg
-} {too many fields to scan}
-test scan-4.5 {error conditions} {
- list [catch {scan a %D} msg] $msg
+test scan-8.3 {error conditions} {
+ list [catch {scan a %D x} msg] $msg
} {1 {bad scan conversion character "D"}}
-test scan-4.6 {error conditions} {
- list [catch {scan a %O} msg] $msg
+test scan-8.4 {error conditions} {
+ list [catch {scan a %O x} msg] $msg
} {1 {bad scan conversion character "O"}}
-test scan-4.7 {error conditions} {
- list [catch {scan a %X} msg] $msg
+test scan-8.5 {error conditions} {
+ list [catch {scan a %X x} msg] $msg
} {1 {bad scan conversion character "X"}}
-test scan-4.8 {error conditions} {
- list [catch {scan a %F} msg] $msg
+test scan-8.6 {error conditions} {
+ list [catch {scan a %F x} msg] $msg
} {1 {bad scan conversion character "F"}}
-test scan-4.9 {error conditions} {
- list [catch {scan a %E} msg] $msg
+test scan-8.7 {error conditions} {
+ list [catch {scan a %E x} msg] $msg
} {1 {bad scan conversion character "E"}}
-test scan-4.10 {error conditions} {
+test scan-8.8 {error conditions} {
list [catch {scan a "%d %d" a} msg] $msg
} {1 {different numbers of variable names and field specifiers}}
-test scan-4.11 {error conditions} {
+test scan-8.9 {error conditions} {
list [catch {scan a "%d %d" a b c} msg] $msg
-} {1 {different numbers of variable names and field specifiers}}
-test scan-4.12 {error conditions} {
+} {1 {variable is not assigned by any conversion specifiers}}
+test scan-8.10 {error conditions} {
set a {}; set b {}; set c {}; set d {}
list [expr {[scan " a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d
} {1 {} {} {} {}}
-test scan-4.13 {error conditions} {
+test scan-8.11 {error conditions} {
set a {}; set b {}; set c {}; set d {}
list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d
} {2 1 2 {} {}}
-test scan-4.14 {error conditions} {
+test scan-8.12 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %d a} msg] $msg
} {1 {couldn't set variable "a"}}
-test scan-4.15 {error conditions} {
+test scan-8.13 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %c a} msg] $msg
} {1 {couldn't set variable "a"}}
-test scan-4.16 {error conditions} {
+test scan-8.14 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %s a} msg] $msg
} {1 {couldn't set variable "a"}}
-test scan-4.17 {error conditions} {
+test scan-8.15 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %f a} msg] $msg
} {1 {couldn't set variable "a"}}
-test scan-4.18 {error conditions} {
+test scan-8.16 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %f a} msg] $msg
} {1 {couldn't set variable "a"}}
catch {unset a}
-test scan-4.19 {error conditions} {
+test scan-8.17 {error conditions} {
list [catch {scan 44 %2c a} msg] $msg
} {1 {field width may not be specified in %c conversion}}
-test scan-4.20 {error conditions} {
- list [catch {scan abc {%[}} msg] $msg
+test scan-8.18 {error conditions} {
+ list [catch {scan abc {%[} x} msg] $msg
+} {1 {unmatched [ in format string}}
+test scan-8.19 {error conditions} {
+ list [catch {scan abc {%[^a} x} msg] $msg
+} {1 {unmatched [ in format string}}
+test scan-8.20 {error conditions} {
+ list [catch {scan abc {%[^]a} x} msg] $msg
+} {1 {unmatched [ in format string}}
+test scan-8.21 {error conditions} {
+ list [catch {scan abc {%[]a} x} msg] $msg
} {1 {unmatched [ in format string}}
-test scan-5.1 {lots of arguments} {
+test scan-9.1 {lots of arguments} {
scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
} 20
-test scan-5.2 {lots of arguments} {
+test scan-9.2 {lots of arguments} {
scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
set a20
} 200
-test scan-6.1 {miscellaneous tests} {
+test scan-10.1 {miscellaneous tests} {
set a {}
list [scan ab16c ab%dc a] $a
} {1 16}
-test scan-6.2 {miscellaneous tests} {
+test scan-10.2 {miscellaneous tests} {
set a {}
list [scan ax16c ab%dc a] $a
} {0 {}}
-test scan-6.3 {miscellaneous tests} {
+test scan-10.3 {miscellaneous tests} {
set a {}
list [catch {scan ab%c114 ab%%c%d a} msg] $msg $a
} {0 1 114}
-test scan-6.4 {miscellaneous tests} {
+test scan-10.4 {miscellaneous tests} {
set a {}
list [catch {scan ab%c14 ab%%c%d a} msg] $msg $a
} {0 1 14}
+test scan-10.5 {miscellaneous tests} {
+ catch {unset arr}
+ set arr(2) {}
+ list [catch {scan ab%c14 ab%%c%d arr(2)} msg] $msg $arr(2)
+} {0 1 14}
-test scan-7.1 {alignment in results array (TCL_ALIGN)} {
+test scan-11.1 {alignment in results array (TCL_ALIGN)} {
scan "123 13.6" "%s %f" a b
set b
} 13.6
-test scan-7.2 {alignment in results array (TCL_ALIGN)} {
+test scan-11.2 {alignment in results array (TCL_ALIGN)} {
scan "1234567 13.6" "%s %f" a b
set b
} 13.6
-test scan-7.3 {alignment in results array (TCL_ALIGN)} {
+test scan-11.3 {alignment in results array (TCL_ALIGN)} {
scan "12345678901 13.6" "%s %f" a b
set b
} 13.6
-test scan-7.4 {alignment in results array (TCL_ALIGN)} {
+test scan-11.4 {alignment in results array (TCL_ALIGN)} {
scan "123456789012345 13.6" "%s %f" a b
set b
} 13.6
-test scan-7.5 {alignment in results array (TCL_ALIGN)} {
+test scan-11.5 {alignment in results array (TCL_ALIGN)} {
scan "1234567890123456789 13.6" "%s %f" a b
set b
} 13.6
+
+test scan-12.1 {Tcl_ScanObjCmd, inline case} {
+ scan a %c
+} 97
+test scan-12.2 {Tcl_ScanObjCmd, inline case} {
+ scan abc %c%c%c%c
+} {97 98 99 {}}
+test scan-12.3 {Tcl_ScanObjCmd, inline case} {
+ scan abc %s%c
+} {abc {}}
+test scan-12.4 {Tcl_ScanObjCmd, inline case, underflow} {
+ scan abc abc%c
+} {}
+test scan-12.5 {Tcl_ScanObjCmd, inline case} {
+ scan abc bogus%c%c%c
+} {{} {} {}}
+test scan-12.6 {Tcl_ScanObjCmd, inline case} {
+ # degenerate case, behavior changed from 8.2 to 8.3
+ list [catch {scan foo foobar} msg] $msg
+} {0 {}}
+test scan-12.7 {Tcl_ScanObjCmd, inline case lots of arguments} {
+ scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140\
+ 150 160 170 180 190 200" \
+ "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d"
+} {10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200 {}}
+
+test scan-13.1 {Tcl_ScanObjCmd, inline XPG case} {
+ scan a {%1$c}
+} 97
+test scan-13.2 {Tcl_ScanObjCmd, inline XPG case} {
+ scan abc {%1$c%2$c%3$c%4$c}
+} {97 98 99 {}}
+test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} {
+ list [catch {scan abc {%1$c%1$c}} msg] $msg
+} {1 {variable is assigned by multiple "%n$" conversion specifiers}}
+test scan-13.4 {Tcl_ScanObjCmd, inline XPG case} {
+ scan abc {%2$s%1$c}
+} {{} abc}
+test scan-13.5 {Tcl_ScanObjCmd, inline XPG case, underflow} {
+ scan abc {abc%5$c}
+} {}
+test scan-13.6 {Tcl_ScanObjCmd, inline XPG case} {
+ catch {scan abc {bogus%1$c%5$c%10$c}} msg
+ list [llength $msg] $msg
+} {10 {{} {} {} {} {} {} {} {} {} {}}}
+test scan-13.7 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
+ scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" {%20$d %18$d %17$d %16$d %15$d %14$d %13$d %12$d %11$d %10$d %9$d %8$d %7$d %6$d %5$d %4$d %3$d %2$d %1$d}
+} {190 180 170 160 150 140 130 120 110 100 90 80 70 60 50 40 30 20 {} 10}
+test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
+ set msg [scan "10 20 30" {%100$d %5$d %200$d}]
+ list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
+} {200 10 20 30}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/security.test b/tcl/tests/security.test
new file mode 100644
index 00000000000..e3dae8bab9b
--- /dev/null
+++ b/tcl/tests/security.test
@@ -0,0 +1,55 @@
+# security.test --
+#
+# Functionality covered: this file contains a collection of tests for the
+# auto loading and namespaces.
+#
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# If this proc becomes invoked, then there is a bug
+
+proc BUG {args} {
+ set ::BUG 1
+}
+
+# Check and Clear the bug flag (to do before each test)
+set ::BUG 0
+
+proc CB {} {
+ set ret $::BUG
+ set ::BUG 0
+ return $ret
+}
+
+
+test sec-1.1 {tcl_endOfPreviousWord} {
+ catch {tcl_startOfPreviousWord x {[BUG]}}
+ CB
+} 0
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/set-old.test b/tcl/tests/set-old.test
index 301d7eafc6f..d5203a80f23 100644
--- a/tcl/tests/set-old.test
+++ b/tcl/tests/set-old.test
@@ -8,13 +8,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
proc ignore args {}
@@ -292,7 +296,7 @@ test set-old-8.6 {array command} {
catch {unset a}
set a(22) 3
list [catch {array gorp a} msg] $msg
-} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, or startsearch}}
+} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, or unset}}
test set-old-8.7 {array command, anymore option} {
catch {unset a}
list [catch {array anymore a x} msg] $msg
@@ -497,6 +501,15 @@ test set-old-8.37.4 {array command, empty set with populated array} {
array set aVaRnAmE [list e3 v3]
list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg
} {{e1 e2 e3} 0 v2}
+test set-old-8.37.5 {array command, set with non-existent namespace} {
+ list [catch {array set bogusnamespace::var {}} msg] $msg
+} {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
+test set-old-8.37.6 {array command, set with non-existent namespace} {
+ list [catch {array set bogusnamespace::var {a b}} msg] $msg
+} {1 {can't set "bogusnamespace::var(a)": parent namespace doesn't exist}}
+test set-old-8.37.7 {array command, set with non-existent namespace} {
+ list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg
+} {1 {can't set "bogusnamespace::var(0)": variable isn't array}}
test set-old-8.38 {array command, size option} {
catch {unset a}
array size a
@@ -786,9 +799,24 @@ test set-old-12.2 {cleanup on procedure return} {
# Must delete variables when done, since these arrays get used as
# scalars by other tests.
-
catch {unset a}
catch {unset b}
catch {unset c}
catch {unset aVaRnAmE}
-return ""
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/set.test b/tcl/tests/set.test
index 01427d04747..07a20825a6c 100644
--- a/tcl/tests/set.test
+++ b/tcl/tests/set.test
@@ -5,13 +5,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {unset x}
catch {unset i}
@@ -27,7 +31,7 @@ test set-1.3 {TclCompileSetCmd: error compiling variable name} {
set i 10
catch {set "i"xxx} msg
set msg
-} {quoted string doesn't terminate properly}
+} {extra characters after close-quote}
test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
set i 17
list [set "i"] $i
@@ -196,6 +200,38 @@ test set-1.24 {TclCompileSetCmd: too many arguments} {
set msg
} {wrong # args: should be "set varName ?newValue?"}
+test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} {
+ # This was a known error in 8.1a* - 8.2.1
+ catch {unset array}
+ set {array($foo)} 5
+} 5
+test set-1.26 {TclCompileSetCmd: various array constructs} {
+ # Test all kinds of array constructs that TclCompileSetCmd
+ # may feel inclined to tamper with.
+ proc p {} {
+ set a x
+ set be(hej) 1 ; # hej
+ set be($a) 1 ; # x
+ set {be($a)} 1 ; # $a
+ set be($a,hej) 1 ; # x,hej
+ set be($a,$a) 5 ; # x,x
+ set be(c($a) 1 ; # c(x
+ set be(\w\w) 1 ; # ww
+ set be(a:$a) [set be(x,$a)] ; # a:x
+ set be(hej,$be($a,hej),hej) 1 ; # hej,1,hej
+ set be([string range hugge 0 2]) 1 ; # hug
+ set be(a\ a) 1 ; # a a
+ set be($a\ ,[string range hugge 1 3],hej) 1 ; # x ,ugg,hej
+ set be($a,h"ej) 1 ; # x,h"ej
+ set be([string range "a b c" 2 end]) 1 ; # b c
+ set [string range bet 0 1](foo) 1 ; # foo
+ set be([set be(a:$a)][set b\e($a)]) 1 ; # 51
+ return [lsort [array names be]]
+ }
+ p
+} [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej
+{b c} foo 51}]; # " just a matching end quote
+
test set-2.1 {set command: runtime error, bad variable name} {
list [catch {set {"foo}} msg] $msg $errorInfo
} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
@@ -226,8 +262,260 @@ test set-2.6 {set command: runtime error, basic array operations} {
list [catch {set a} msg] $msg
} {1 {can't read "a": variable is array}}
+# Test the uncompiled version of set
+
+catch {unset a}
+catch {unset b}
+catch {unset i}
+catch {unset x}
+
+test set-3.1 {uncompiled set command: missing variable name} {
+ set z set
+ list [catch {$z} msg] $msg
+} {1 {wrong # args: should be "set varName ?newValue?"}}
+test set-3.2 {uncompiled set command: simple variable name} {
+ set z set
+ $z i 10
+ list [$z i] $i
+} {10 10}
+test set-3.3 {uncompiled set command: error compiling variable name} {
+ set z set
+ $z i 10
+ catch {$z "i"xxx} msg
+ $z msg
+} {extra characters after close-quote}
+test set-3.4 {uncompiled set command: simple variable name in quotes} {
+ set z set
+ $z i 17
+ list [$z "i"] $i
+} {17 17}
+test set-3.5 {uncompiled set command: simple variable name in braces} {
+ set z set
+ catch {unset {a simple var}}
+ $z {a simple var} 27
+ list [$z {a simple var}] ${a simple var}
+} {27 27}
+test set-3.6 {uncompiled set command: simple array variable name} {
+ set z set
+ catch {unset a}
+ $z a(foo) 37
+ list [$z a(foo)] $a(foo)
+} {37 37}
+test set-3.7 {uncompiled set command: non-simple (computed) variable name} {
+ set z set
+ $z x "i"
+ $z i 77
+ list [$z $x] $i
+} {77 77}
+test set-3.8 {uncompiled set command: non-simple (computed) variable name} {
+ set z set
+ $z x "i"
+ $z i 77
+ list [$z [$z x] 2] $i
+} {2 2}
+
+test set-3.9 {uncompiled set command: 3rd arg => assignment} {
+ set z set
+ $z i "abcdef"
+ list [$z i] $i
+} {abcdef abcdef}
+test set-3.10 {uncompiled set command: only two args => just getting value} {
+ set z set
+ $z i {one two}
+ $z i
+} {one two}
+
+test set-3.11 {uncompiled set command: simple global name} {
+ proc p {} {
+ set z set
+ global i
+ $z i 54
+ $z i
+ }
+ p
+} {54}
+test set-3.12 {uncompiled set command: simple local name} {
+ proc p {bar} {
+ set z set
+ $z foo $bar
+ $z foo
+ }
+ p 999
+} {999}
+test set-3.13 {uncompiled set command: simple but new (unknown) local name} {
+ set z set
+ proc p {} {
+ set z set
+ $z bar
+ }
+ catch {p} msg
+ $z msg
+} {can't read "bar": no such variable}
+test set-3.14 {uncompiled set command: simple local name, >255 locals} {
+ proc 260locals {} {
+ set z set
+ # create 260 locals (the last ones with index > 255)
+ $z a0 0; $z a1 0; $z a2 0; $z a3 0; $z a4 0
+ $z a5 0; $z a6 0; $z a7 0; $z a8 0; $z a9 0
+ $z b0 0; $z b1 0; $z b2 0; $z b3 0; $z b4 0
+ $z b5 0; $z b6 0; $z b7 0; $z b8 0; $z b9 0
+ $z c0 0; $z c1 0; $z c2 0; $z c3 0; $z c4 0
+ $z c5 0; $z c6 0; $z c7 0; $z c8 0; $z c9 0
+ $z d0 0; $z d1 0; $z d2 0; $z d3 0; $z d4 0
+ $z d5 0; $z d6 0; $z d7 0; $z d8 0; $z d9 0
+ $z e0 0; $z e1 0; $z e2 0; $z e3 0; $z e4 0
+ $z e5 0; $z e6 0; $z e7 0; $z e8 0; $z e9 0
+ $z f0 0; $z f1 0; $z f2 0; $z f3 0; $z f4 0
+ $z f5 0; $z f6 0; $z f7 0; $z f8 0; $z f9 0
+ $z g0 0; $z g1 0; $z g2 0; $z g3 0; $z g4 0
+ $z g5 0; $z g6 0; $z g7 0; $z g8 0; $z g9 0
+ $z h0 0; $z h1 0; $z h2 0; $z h3 0; $z h4 0
+ $z h5 0; $z h6 0; $z h7 0; $z h8 0; $z h9 0
+ $z i0 0; $z i1 0; $z i2 0; $z i3 0; $z i4 0
+ $z i5 0; $z i6 0; $z i7 0; $z i8 0; $z i9 0
+ $z j0 0; $z j1 0; $z j2 0; $z j3 0; $z j4 0
+ $z j5 0; $z j6 0; $z j7 0; $z j8 0; $z j9 0
+ $z k0 0; $z k1 0; $z k2 0; $z k3 0; $z k4 0
+ $z k5 0; $z k6 0; $z k7 0; $z k8 0; $z k9 0
+ $z l0 0; $z l1 0; $z l2 0; $z l3 0; $z l4 0
+ $z l5 0; $z l6 0; $z l7 0; $z l8 0; $z l9 0
+ $z m0 0; $z m1 0; $z m2 0; $z m3 0; $z m4 0
+ $z m5 0; $z m6 0; $z m7 0; $z m8 0; $z m9 0
+ $z n0 0; $z n1 0; $z n2 0; $z n3 0; $z n4 0
+ $z n5 0; $z n6 0; $z n7 0; $z n8 0; $z n9 0
+ $z o0 0; $z o1 0; $z o2 0; $z o3 0; $z o4 0
+ $z o5 0; $z o6 0; $z o7 0; $z o8 0; $z o9 0
+ $z p0 0; $z p1 0; $z p2 0; $z p3 0; $z p4 0
+ $z p5 0; $z p6 0; $z p7 0; $z p8 0; $z p9 0
+ $z q0 0; $z q1 0; $z q2 0; $z q3 0; $z q4 0
+ $z q5 0; $z q6 0; $z q7 0; $z q8 0; $z q9 0
+ $z r0 0; $z r1 0; $z r2 0; $z r3 0; $z r4 0
+ $z r5 0; $z r6 0; $z r7 0; $z r8 0; $z r9 0
+ $z s0 0; $z s1 0; $z s2 0; $z s3 0; $z s4 0
+ $z s5 0; $z s6 0; $z s7 0; $z s8 0; $z s9 0
+ $z t0 0; $z t1 0; $z t2 0; $z t3 0; $z t4 0
+ $z t5 0; $z t6 0; $z t7 0; $z t8 0; $z t9 0
+ $z u0 0; $z u1 0; $z u2 0; $z u3 0; $z u4 0
+ $z u5 0; $z u6 0; $z u7 0; $z u8 0; $z u9 0
+ $z v0 0; $z v1 0; $z v2 0; $z v3 0; $z v4 0
+ $z v5 0; $z v6 0; $z v7 0; $z v8 0; $z v9 0
+ $z w0 0; $z w1 0; $z w2 0; $z w3 0; $z w4 0
+ $z w5 0; $z w6 0; $z w7 0; $z w8 0; $z w9 0
+ $z x0 0; $z x1 0; $z x2 0; $z x3 0; $z x4 0
+ $z x5 0; $z x6 0; $z x7 0; $z x8 0; $z x9 0
+ $z y0 0; $z y1 0; $z y2 0; $z y3 0; $z y4 0
+ $z y5 0; $z y6 0; $z y7 0; $z y8 0; $z y9 0
+ $z z0 0; $z z1 0; $z z2 0; $z z3 0; $z z4 0
+ $z z5 0; $z z6 0; $z z7 0; $z z8 0; $z z9 1234
+ }
+ 260locals
+} {1234}
+test set-3.15 {uncompiled set command: variable is array} {
+ set z set
+ catch {unset a}
+ $z x 27
+ $z x [$z a(foo) 11]
+ catch {unset a}
+ $z x
+} 11
+test set-3.16 {uncompiled set command: variable is array, elem substitutions} {
+ set z set
+ catch {unset a}
+ $z i 5
+ $z x 789
+ $z a(foo5) 27
+ $z x [$z a(foo$i)]
+ catch {unset a}
+ $z x
+} 27
+
+test set-3.17 {uncompiled set command: doing assignment, simple int} {
+ set z set
+ $z i 5
+ $z i 123
+} 123
+test set-3.18 {uncompiled set command: doing assignment, simple int} {
+ set z set
+ $z i 5
+ $z i -100
+} -100
+test set-3.19 {uncompiled set command: doing assignment, simple but not int} {
+ set z set
+ $z i 5
+ $z i 0x12MNOP
+ $z i
+} {0x12MNOP}
+test set-3.20 {uncompiled set command: doing assignment, in quotes} {
+ set z set
+ $z i 25
+ $z i "-100"
+} -100
+test set-3.21 {uncompiled set command: doing assignment, in braces} {
+ set z set
+ $z i 24
+ $z i {126}
+} 126
+test set-3.22 {uncompiled set command: doing assignment, large int} {
+ set z set
+ $z i 5
+ $z i 200000
+} 200000
+test set-3.23 {uncompiled set command: doing assignment, formatted int != int} {
+ set z set
+ $z i 25
+ $z i 000012345 ;# an octal literal == 5349 decimal
+ list $i [incr i]
+} {000012345 5350}
+
+test set-3.24 {uncompiled set command: too many arguments} {
+ set z set
+ $z i 10
+ catch {$z i 20 30} msg
+ $z msg
+} {wrong # args: should be "set varName ?newValue?"}
+
+test set-4.1 {uncompiled set command: runtime error, bad variable name} {
+ set z set
+ list [catch {$z {"foo}} msg] $msg $errorInfo
+} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+ while executing
+"$z {"foo}"}}
+test set-4.2 {uncompiled set command: runtime error, not array variable} {
+ set z set
+ catch {unset b}
+ $z b 44
+ list [catch {$z b(123)} msg] $msg
+} {1 {can't read "b(123)": variable isn't array}}
+test set-4.3 {uncompiled set command: runtime error, errors in reading variables} {
+ set z set
+ catch {unset a}
+ $z a(6) 44
+ list [catch {$z a(18)} msg] $msg
+} {1 {can't read "a(18)": no such element in array}}
+test set-4.4 {uncompiled set command: runtime error, readonly variable} {
+ set z set
+ proc readonly args {error "variable is read-only"}
+ $z x 123
+ trace var x w readonly
+ list [catch {$z x 1} msg] $msg $errorInfo
+} {1 {can't set "x": variable is read-only} {can't set "x": variable is read-only
+ while executing
+"$z x 1"}}
+test set-4.5 {uncompiled set command: runtime error, basic array operations} {
+ set z set
+ list [catch {$z a(other)} msg] $msg
+} {1 {can't read "a(other)": no such element in array}}
+test set-4.6 {set command: runtime error, basic array operations} {
+ set z set
+ list [catch {$z a} msg] $msg
+} {1 {can't read "a": variable is array}}
+
+# cleanup
catch {unset a}
catch {unset b}
catch {unset i}
catch {unset x}
-return ""
+catch {unset z}
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/socket.test b/tcl/tests/socket.test
index 438e1e171a6..aff5cffcb92 100644
--- a/tcl/tests/socket.test
+++ b/tcl/tests/socket.test
@@ -5,10 +5,13 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
+# RCS: @(#) $Id$
+
# Running socket tests with a remote server:
# ------------------------------------------
#
@@ -58,15 +61,18 @@
# server (via exec) on platforms that support this, on the local host,
# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.
-#
-# RCS: @(#) $Id$
-
-if {[string compare test [info procs test]] == 1} then {source defs}
-if {$testConfig(socket) == 0} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
+# Some tests require the testthread and exec commands
+
+set ::tcltest::testConstraints(testthread) \
+ [expr {[info commands testthread] != {}}]
+set ::tcltest::testConstraints(exec) [expr {[info commands exec] != {}}]
+
#
# If remoteServerIP or remoteServerPort are not set, check in the
# environment variables for externally set values.
@@ -93,7 +99,7 @@ if {![info exists remoteServerPort]} {
set doTestsWithRemoteServer 1
if {![info exists remoteServerIP] && ($tcl_platform(platform) != "macintosh")} {
- set remoteServerIP localhost
+ set remoteServerIP 127.0.0.1
}
if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {
set remoteServerPort 2048
@@ -115,13 +121,11 @@ if {$doTestsWithRemoteServer} {
if {[info commands exec] == ""} {
set noRemoteTestReason "can't exec"
set doTestsWithRemoteServer 0
- } elseif {$testConfig(win32s)} {
- set noRemoteTestReason "\ncan't run multiple instances of tcltest under win32s."
- set doTestsWithRemoteServer 0
} else {
- set remoteServerIP localhost
+ set remoteServerIP 127.0.0.1
+ set remoteFile [file join [pwd] remote.tcl]
if {[catch {set remoteProcChan \
- [open "|[list $tcltest remote.tcl \
+ [open "|[list $::tcltest::tcltest $remoteFile \
-serverIsSilent \
-port $remoteServerPort \
-address $remoteServerIP]" \
@@ -136,7 +140,7 @@ if {$doTestsWithRemoteServer} {
set doTestsWithRemoteServer 0
}
} else {
- set noRemoteTestReason "$msg $tcltest"
+ set noRemoteTestReason "$msg $::tcltest::tcltest"
set doTestsWithRemoteServer 0
}
}
@@ -145,10 +149,12 @@ if {$doTestsWithRemoteServer} {
}
}
+# Some tests are run only if we are doing testing against a remote server.
+set ::tcltest::testConstraints(doTestsWithRemoteServer) $doTestsWithRemoteServer
if {$doTestsWithRemoteServer == 0} {
- puts "Skipping tests with remote server. See tests/socket.test for"
- puts "information on how to run remote server."
- if {[info exists VERBOSE] && ($VERBOSE != 0)} {
+ if {[string first s $::tcltest::verbose] != -1} {
+ puts "Skipping tests with remote server. See tests/socket.test for"
+ puts "information on how to run remote server."
puts "Reason for not doing remote tests: $noRemoteTestReason"
}
}
@@ -192,54 +198,54 @@ if {$doTestsWithRemoteServer == 1} {
}
}
-test socket-1.1 {arg parsing for socket command} {
+test socket-1.1 {arg parsing for socket command} {socket} {
list [catch {socket -server} msg] $msg
} {1 {no argument given for -server option}}
-test socket-1.2 {arg parsing for socket command} {
+test socket-1.2 {arg parsing for socket command} {socket} {
list [catch {socket -server foo} msg] $msg
} {1 {wrong # args: should be either:
socket ?-myaddr addr? ?-myport myport? ?-async? host port
socket -server command ?-myaddr addr? port}}
-test socket-1.3 {arg parsing for socket command} {
+test socket-1.3 {arg parsing for socket command} {socket} {
list [catch {socket -myaddr} msg] $msg
} {1 {no argument given for -myaddr option}}
-test socket-1.4 {arg parsing for socket command} {
+test socket-1.4 {arg parsing for socket command} {socket} {
list [catch {socket -myaddr 127.0.0.1} msg] $msg
} {1 {wrong # args: should be either:
socket ?-myaddr addr? ?-myport myport? ?-async? host port
socket -server command ?-myaddr addr? port}}
-test socket-1.5 {arg parsing for socket command} {
+test socket-1.5 {arg parsing for socket command} {socket} {
list [catch {socket -myport} msg] $msg
} {1 {no argument given for -myport option}}
-test socket-1.6 {arg parsing for socket command} {
+test socket-1.6 {arg parsing for socket command} {socket} {
list [catch {socket -myport xxxx} msg] $msg
} {1 {expected integer but got "xxxx"}}
-test socket-1.7 {arg parsing for socket command} {
+test socket-1.7 {arg parsing for socket command} {socket} {
list [catch {socket -myport 2522} msg] $msg
} {1 {wrong # args: should be either:
socket ?-myaddr addr? ?-myport myport? ?-async? host port
socket -server command ?-myaddr addr? port}}
-test socket-1.8 {arg parsing for socket command} {
+test socket-1.8 {arg parsing for socket command} {socket} {
list [catch {socket -froboz} msg] $msg
-} {1 {bad option "-froboz", must be -async, -myaddr, -myport, or -server}}
-test socket-1.9 {arg parsing for socket command} {
+} {1 {bad option "-froboz": must be -async, -myaddr, -myport, or -server}}
+test socket-1.9 {arg parsing for socket command} {socket} {
list [catch {socket -server foo -myport 2521 3333} msg] $msg
} {1 {Option -myport is not valid for servers}}
-test socket-1.10 {arg parsing for socket command} {
+test socket-1.10 {arg parsing for socket command} {socket} {
list [catch {socket host 2528 -junk} msg] $msg
} {1 {wrong # args: should be either:
socket ?-myaddr addr? ?-myport myport? ?-async? host port
socket -server command ?-myaddr addr? port}}
-test socket-1.11 {arg parsing for socket command} {
+test socket-1.11 {arg parsing for socket command} {socket} {
list [catch {socket -server callback 2520 --} msg] $msg
} {1 {wrong # args: should be either:
socket ?-myaddr addr? ?-myport myport? ?-async? host port
socket -server command ?-myaddr addr? port}}
-test socket-1.12 {arg parsing for socket command} {
+test socket-1.12 {arg parsing for socket command} {socket} {
list [catch {socket foo badport} msg] $msg
} {1 {expected integer but got "badport"}}
-test socket-2.1 {tcp connection} {stdio} {
+test socket-2.1 {tcp connection} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
@@ -257,9 +263,9 @@ test socket-2.1 {tcp connection} {stdio} {
puts $x
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
- if {[catch {socket localhost 2828} msg]} {
+ if {[catch {socket 127.0.0.1 2828} msg]} {
set x $msg
} else {
lappend x [gets $f]
@@ -275,12 +281,12 @@ if [info exists port] {
} else {
set port [expr 2048 + [pid]%1024]
}
-test socket-2.2 {tcp connection with client port specified} {stdio} {
+test socket-2.2 {tcp connection with client port specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept 2828]
+ set f [socket -server accept 2829]
proc accept {file addr port} {
global x
puts "[gets $file] $port"
@@ -293,12 +299,12 @@ test socket-2.2 {tcp connection with client port specified} {stdio} {
close $f
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
global port
- if {[catch {socket -myport $port localhost 2828} sock]} {
+ if {[catch {socket -myport $port 127.0.0.1 2829} sock]} {
set x $sock
- close [socket localhost 2828]
+ close [socket 127.0.0.1 2829]
puts stderr $sock
} else {
puts $sock hello
@@ -309,12 +315,12 @@ test socket-2.2 {tcp connection with client port specified} {stdio} {
close $f
set x
} [list ready "hello $port"]
-test socket-2.3 {tcp connection with client interface specified} {stdio} {
+test socket-2.3 {tcp connection with client interface specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept 2828]
+ set f [socket -server accept 2830]
proc accept {file addr port} {
global x
puts "[gets $file] $addr"
@@ -327,9 +333,9 @@ test socket-2.3 {tcp connection with client interface specified} {stdio} {
close $f
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
- if {[catch {socket -myaddr localhost localhost 2828} sock]} {
+ if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
set x $sock
} else {
puts $sock hello
@@ -340,12 +346,12 @@ test socket-2.3 {tcp connection with client interface specified} {stdio} {
close $f
set x
} {ready {hello 127.0.0.1}}
-test socket-2.4 {tcp connection with server interface specified} {stdio} {
+test socket-2.4 {tcp connection with server interface specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept -myaddr [info hostname] 2828]
+ set f [socket -server accept -myaddr [info hostname] 2831]
proc accept {file addr port} {
global x
puts "[gets $file]"
@@ -358,9 +364,9 @@ test socket-2.4 {tcp connection with server interface specified} {stdio} {
close $f
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
- if {[catch {socket [info hostname] 2828} sock]} {
+ if {[catch {socket [info hostname] 2831} sock]} {
set x $sock
} else {
puts $sock hello
@@ -371,12 +377,12 @@ test socket-2.4 {tcp connection with server interface specified} {stdio} {
close $f
set x
} {ready hello}
-test socket-2.5 {tcp connection with redundant server port} {stdio} {
+test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept 2828]
+ set f [socket -server accept 2832]
proc accept {file addr port} {
global x
puts "[gets $file]"
@@ -389,9 +395,9 @@ test socket-2.5 {tcp connection with redundant server port} {stdio} {
close $f
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
- if {[catch {socket localhost 2828} sock]} {
+ if {[catch {socket 127.0.0.1 2832} sock]} {
set x $sock
} else {
puts $sock hello
@@ -402,9 +408,9 @@ test socket-2.5 {tcp connection with redundant server port} {stdio} {
close $f
set x
} {ready hello}
-test socket-2.6 {tcp connection} {} {
+test socket-2.6 {tcp connection} {socket} {
set status ok
- if {![catch {set sock [socket localhost 2828]}]} {
+ if {![catch {set sock [socket 127.0.0.1 2833]}]} {
if {![catch {gets $sock}]} {
set status broken
}
@@ -412,12 +418,12 @@ test socket-2.6 {tcp connection} {} {
}
set status
} ok
-test socket-2.7 {echo server, one line} {stdio} {
+test socket-2.7 {echo server, one line} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept 2828]
+ set f [socket -server accept 2834]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -translation lf -buffering line
@@ -439,22 +445,21 @@ test socket-2.7 {echo server, one line} {stdio} {
puts done
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
- set s [socket localhost 2828]
+ set s [socket 127.0.0.1 2834]
fconfigure $s -buffering line -translation lf
puts $s "hello abcdefghijklmnop"
+ after 1000
set x [gets $s]
close $s
set y [gets $f]
close $f
list $x $y
} {{hello abcdefghijklmnop} done}
-test socket-2.8 {echo server, loop 50 times, single connection} {stdio} {
- removeFile script
- set f [open script w]
- puts $f {
- set f [socket -server accept 2828]
+test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
+ makeFile {
+ set f [socket -server accept 2835]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
@@ -478,28 +483,29 @@ test socket-2.8 {echo server, loop 50 times, single connection} {stdio} {
after cancel $timer
close $f
puts "done $i"
- }
- close $f
- set f [open "|[list $tcltest script]" r]
+ } script
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
- set s [socket localhost 2828]
+ set s [socket 127.0.0.1 2835]
fconfigure $s -buffering line
- for {set x 0} {$x < 50} {incr x} {
- puts $s "hello abcdefghijklmnop"
- gets $s
+ catch {
+ for {set x 0} {$x < 50} {incr x} {
+ puts $s "hello abcdefghijklmnop"
+ gets $s
+ }
}
close $s
- set x [gets $f]
+ catch {set x [gets $f]}
close $f
set x
} {done 50}
-test socket-2.9 {socket conflict} {stdio} {
+test socket-2.9 {socket conflict} {socket stdio} {
set s [socket -server accept 2828]
removeFile script
set f [open script w]
- puts $f {set f [socket -server accept 2828]}
+ puts -nonewline $f {socket -server accept 2828}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
after 100
set x [list [catch {close $f} msg] $msg]
@@ -509,7 +515,7 @@ test socket-2.9 {socket conflict} {stdio} {
while executing
"socket -server accept 2828"
(file "script" line 1)}}
-test socket-2.10 {close on accept, accepted socket lives} {
+test socket-2.10 {close on accept, accepted socket lives} {socket} {
set done 0
set timer [after 20000 "set done timed_out"]
set ss [socket -server accept 2830]
@@ -532,7 +538,7 @@ test socket-2.10 {close on accept, accepted socket lives} {
after cancel $timer
set done
} 1
-test socket-2.11 {detecting new data} {
+test socket-2.11 {detecting new data} {socket} {
proc accept {s a p} {
global sock
set sock $s
@@ -540,28 +546,28 @@ test socket-2.11 {detecting new data} {
set s [socket -server accept 2400]
set sock ""
- set s2 [socket localhost 2400]
+ set s2 [socket 127.0.0.1 2400]
vwait sock
puts $s2 one
flush $s2
after 500
fconfigure $sock -blocking 0
- set result [gets $sock]
- lappend result [gets $sock]
+ set result a:[gets $sock]
+ lappend result b:[gets $sock]
fconfigure $sock -blocking 1
puts $s2 two
flush $s2
fconfigure $sock -blocking 0
- lappend result [gets $sock]
+ lappend result c:[gets $sock]
fconfigure $sock -blocking 1
close $s2
close $s
close $sock
set result
-} {one {} two}
+} {a:one b: c:two}
-test socket-3.1 {socket conflict} {stdio} {
+test socket-3.1 {socket conflict} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
@@ -571,7 +577,7 @@ test socket-3.1 {socket conflict} {stdio} {
close $f
}
close $f
- set f [open "|[list $tcltest script]" r+]
+ set f [open "|[list $::tcltest::tcltest script]" r+]
gets $f
set x [list [catch {socket -server accept 2828} msg] \
$msg]
@@ -579,7 +585,7 @@ test socket-3.1 {socket conflict} {stdio} {
close $f
set x
} {1 {couldn't open socket: address already in use}}
-test socket-3.2 {server with several clients} {stdio} {
+test socket-3.2 {server with several clients} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
@@ -613,13 +619,13 @@ test socket-3.2 {server with several clients} {stdio} {
puts $x
}
close $f
- set f [open "|[list $tcltest script]" r+]
+ set f [open "|[list $::tcltest::tcltest script]" r+]
set x [gets $f]
- set s1 [socket localhost 2828]
+ set s1 [socket 127.0.0.1 2828]
fconfigure $s1 -buffering line
- set s2 [socket localhost 2828]
+ set s2 [socket 127.0.0.1 2828]
fconfigure $s2 -buffering line
- set s3 [socket localhost 2828]
+ set s3 [socket 127.0.0.1 2828]
fconfigure $s3 -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s1 hello,s1
@@ -637,12 +643,12 @@ test socket-3.2 {server with several clients} {stdio} {
set x
} {ready done}
-test socket-4.1 {server with several clients} {stdio} {
+test socket-4.1 {server with several clients} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
gets stdin
- set s [socket localhost 2828]
+ set s [socket 127.0.0.1 2828]
fconfigure $s -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s hello
@@ -653,11 +659,11 @@ test socket-4.1 {server with several clients} {stdio} {
gets stdin
}
close $f
- set p1 [open "|[list $tcltest script]" r+]
+ set p1 [open "|[list $::tcltest::tcltest script]" r+]
fconfigure $p1 -buffering line
- set p2 [open "|[list $tcltest script]" r+]
+ set p2 [open "|[list $::tcltest::tcltest script]" r+]
fconfigure $p2 -buffering line
- set p3 [open "|[list $tcltest script]" r+]
+ set p3 [open "|[list $::tcltest::tcltest script]" r+]
fconfigure $p3 -buffering line
proc accept {s a p} {
fconfigure $s -buffering line
@@ -699,7 +705,7 @@ test socket-4.1 {server with several clients} {stdio} {
close $p3
set l
} {{p1 bye done} {p2 bye done} {p3 bye done}}
-test socket-4.2 {byte order problems, socket numbers, htons} {
+test socket-4.2 {byte order problems, socket numbers, htons} {socket} {
set x ok
if {[catch {socket -server dodo 0x3000} msg]} {
set x $msg
@@ -709,10 +715,8 @@ test socket-4.2 {byte order problems, socket numbers, htons} {
set x
} ok
-test socket-5.1 {byte order problems, socket numbers, htons} {unixOnly} {
- #
- # THIS TEST WILL FAIL if you are running as superuser.
- #
+test socket-5.1 {byte order problems, socket numbers, htons} \
+ {socket unixOnly notRoot} {
set x {couldn't open socket: not owner}
if {![catch {socket -server dodo 0x1} msg]} {
set x {htons problem, should be disallowed, are you running as SU?}
@@ -720,7 +724,7 @@ test socket-5.1 {byte order problems, socket numbers, htons} {unixOnly} {
}
set x
} {couldn't open socket: not owner}
-test socket-5.2 {byte order problems, socket numbers, htons} {
+test socket-5.2 {byte order problems, socket numbers, htons} {socket} {
set x {couldn't open socket: port number too high}
if {![catch {socket -server dodo 0x10000} msg]} {
set x {port resolution problem, should be disallowed}
@@ -728,10 +732,8 @@ test socket-5.2 {byte order problems, socket numbers, htons} {
}
set x
} {couldn't open socket: port number too high}
-test socket-5.3 {byte order problems, socket numbers, htons} {unixOnly} {
- #
- # THIS TEST WILL FAIL if you are running as superuser.
- #
+test socket-5.3 {byte order problems, socket numbers, htons} \
+ {socket unixOnly notRoot} {
set x {couldn't open socket: not owner}
if {![catch {socket -server dodo 21} msg]} {
set x {htons problem, should be disallowed, are you running as SU?}
@@ -740,15 +742,15 @@ test socket-5.3 {byte order problems, socket numbers, htons} {unixOnly} {
set x
} {couldn't open socket: not owner}
-test socket-6.1 {accept callback error} {stdio} {
+test socket-6.1 {accept callback error} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
gets stdin
- socket localhost 2848
+ socket 127.0.0.1 2848
}
close $f
- set f [open "|[list $tcltest script]" r+]
+ set f [open "|[list $::tcltest::tcltest script]" r+]
proc bgerror args {
global x
set x $args
@@ -765,7 +767,7 @@ test socket-6.1 {accept callback error} {stdio} {
set x
} {{divide by zero}}
-test socket-7.1 {testing socket specific options} {stdio} {
+test socket-7.1 {testing socket specific options} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
@@ -780,9 +782,9 @@ test socket-7.1 {testing socket specific options} {stdio} {
after cancel $timer
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
- set s [socket localhost 2820]
+ set s [socket 127.0.0.1 2820]
set p [fconfigure $s -peername]
close $s
close $f
@@ -791,7 +793,7 @@ test socket-7.1 {testing socket specific options} {stdio} {
lappend l [string compare [lindex $p 2] 2820]
lappend l [llength $p]
} {0 0 3}
-test socket-7.2 {testing socket specific options} {stdio} {
+test socket-7.2 {testing socket specific options} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
@@ -806,9 +808,9 @@ test socket-7.2 {testing socket specific options} {stdio} {
after cancel $timer
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
- set s [socket localhost 2821]
+ set s [socket 127.0.0.1 2821]
set p [fconfigure $s -sockname]
close $s
close $f
@@ -817,14 +819,14 @@ test socket-7.2 {testing socket specific options} {stdio} {
lappend l [lindex $p 0]
lappend l [expr [lindex $p 2] == 2821]
} {3 127.0.0.1 0}
-test socket-7.3 {testing socket specific options} {
+test socket-7.3 {testing socket specific options} {socket} {
set s [socket -server accept 2822]
set l [fconfigure $s]
close $s
update
llength $l
-} 10
-test socket-7.4 {testing socket specific options} {
+} 12
+test socket-7.4 {testing socket specific options} {socket} {
set s [socket -server accept 2823]
proc accept {s a p} {
global x
@@ -840,14 +842,14 @@ test socket-7.4 {testing socket specific options} {
set l ""
lappend l [lindex $x 2] [llength $x]
} {2823 3}
-test socket-7.5 {testing socket specific options} {unixOrPc} {
+test socket-7.5 {testing socket specific options} {socket unixOrPc} {
set s [socket -server accept 2829]
proc accept {s a p} {
global x
set x [fconfigure $s -sockname]
close $s
}
- set s1 [socket localhost 2829]
+ set s1 [socket 127.0.0.1 2829]
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
@@ -857,7 +859,7 @@ test socket-7.5 {testing socket specific options} {unixOrPc} {
lappend l [lindex $x 0] [lindex $x 2] [llength $x]
} {127.0.0.1 2829 3}
-test socket-8.1 {testing -async flag on sockets} {
+test socket-8.1 {testing -async flag on sockets} {socket} {
# NOTE: This test may fail on some Solaris 2.4 systems. If it does,
# check that you have these patches installed (using showrev -p):
#
@@ -887,7 +889,7 @@ test socket-8.1 {testing -async flag on sockets} {
set z
} bye
-test socket-9.1 {testing spurious events} {
+test socket-9.1 {testing spurious events} {socket} {
set len 0
set spurious 0
set done 0
@@ -919,7 +921,7 @@ test socket-9.1 {testing spurious events} {
close $s
list $spurious $len
} {0 50}
-test socket-9.2 {testing async write, fileevents, flush on close} {} {
+test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
set firstblock ""
for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
set secondblock ""
@@ -967,7 +969,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {} {
close $l
set count
} 65566
-test socket-9.3 {testing EOF stickyness} {
+test socket-9.3 {testing EOF stickyness} {socket} {
proc count_to_eof {s} {
global count done timer
set l [gets $s]
@@ -1007,30 +1009,21 @@ test socket-9.3 {testing EOF stickyness} {
set count
} {eof is sticky}
-test socket-10.1 {testing socket accept callback error handling} {
+removeFile script
+
+test socket-10.1 {testing socket accept callback error handling} {socket} {
set goterror 0
proc bgerror args {global goterror; set goterror 1}
set s [socket -server accept 2898]
proc accept {s a p} {close $s; error}
- set c [socket localhost 2898]
+ set c [socket 127.0.0.1 2898]
vwait goterror
close $s
close $c
set goterror
} 1
-removeFile script
-
-#
-# The rest of the tests are run only if we are doing testing against
-# a remote server.
-#
-
-if {$doTestsWithRemoteServer == 0} {
- return
-}
-
-test socket-11.1 {tcp connection} {
+test socket-11.1 {tcp connection} {socket doTestsWithRemoteServer} {
sendCommand {
set socket9_1_test_server [socket -server accept 2834]
proc accept {s a p} {
@@ -1044,7 +1037,7 @@ test socket-11.1 {tcp connection} {
sendCommand {close $socket9_1_test_server}
set r
} done
-test socket-11.2 {client specifies its port} {
+test socket-11.2 {client specifies its port} {socket doTestsWithRemoteServer} {
if {[info exists port]} {
incr port
} else {
@@ -1068,7 +1061,7 @@ test socket-11.2 {client specifies its port} {
}
set result
} ok
-test socket-11.3 {trying to connect, no server} {
+test socket-11.3 {trying to connect, no server} {socket doTestsWithRemoteServer} {
set status ok
if {![catch {set s [socket $remoteServerIp 2836]}]} {
if {![catch {gets $s}]} {
@@ -1078,7 +1071,7 @@ test socket-11.3 {trying to connect, no server} {
}
set status
} ok
-test socket-11.4 {remote echo, one line} {
+test socket-11.4 {remote echo, one line} {socket doTestsWithRemoteServer} {
sendCommand {
set socket10_6_test_server [socket -server accept 2836]
proc accept {s a p} {
@@ -1102,7 +1095,7 @@ test socket-11.4 {remote echo, one line} {
sendCommand {close $socket10_6_test_server}
set r
} hello
-test socket-11.5 {remote echo, 50 lines} {
+test socket-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} {
sendCommand {
set socket10_7_test_server [socket -server accept 2836]
proc accept {s a p} {
@@ -1136,7 +1129,7 @@ if {$tcl_platform(platform) == "macintosh"} {
} else {
set conflictResult {1 {couldn't open socket: address already in use}}
}
-test socket-11.6 {socket conflict} {
+test socket-11.6 {socket conflict} {socket doTestsWithRemoteServer} {
set s1 [socket -server accept 2836]
if {[catch {set s2 [socket -server accept 2836]} msg]} {
set result [list 1 $msg]
@@ -1147,7 +1140,7 @@ test socket-11.6 {socket conflict} {
close $s1
set result
} $conflictResult
-test socket-11.7 {server with several clients} {
+test socket-11.7 {server with several clients} {socket doTestsWithRemoteServer} {
sendCommand {
set socket10_9_test_server [socket -server accept 2836]
proc accept {s a p} {
@@ -1183,7 +1176,7 @@ test socket-11.7 {server with several clients} {
sendCommand {close $socket10_9_test_server}
set i
} 100
-test socket-11.8 {client with several servers} {
+test socket-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
sendCommand {
set s1 [socket -server "accept 4003" 4003]
set s2 [socket -server "accept 4004" 4004]
@@ -1209,7 +1202,7 @@ test socket-11.8 {client with several servers} {
}
set l
} {4003 {} 1 4004 {} 1 4005 {} 1}
-test socket-11.9 {accept callback error} {
+test socket-11.9 {accept callback error} {socket doTestsWithRemoteServer} {
set s [socket -server accept 2836]
proc accept {s a p} {expr 10 / 0}
proc bgerror args {
@@ -1231,7 +1224,7 @@ test socket-11.9 {accept callback error} {
rename bgerror {}
set x
} {{divide by zero}}
-test socket-11.10 {testing socket specific options} {
+test socket-11.10 {testing socket specific options} {socket doTestsWithRemoteServer} {
sendCommand {
set socket10_12_test_server [socket -server accept 2836]
proc accept {s a p} {close $s}
@@ -1245,7 +1238,7 @@ test socket-11.10 {testing socket specific options} {
sendCommand {close $socket10_12_test_server}
set l
} {2836 3 3}
-test socket-11.11 {testing spurious events} {
+test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
sendCommand {
set socket10_13_test_server [socket -server accept 2836]
proc accept {s a p} {
@@ -1284,7 +1277,8 @@ test socket-11.11 {testing spurious events} {
sendCommand {close $socket10_13_test_server}
list $spurious $len
} {0 2690}
-test socket-11.12 {testing EOF stickyness} {
+
+test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
set counter 0
set done 0
proc count_up {s} {
@@ -1311,13 +1305,15 @@ test socket-11.12 {testing EOF stickyness} {
}
}
set c [socket $remoteServerIP 2836]
- fileevent $c readable "count_up $c"
+ fileevent $c readable [list count_up $c]
set after_id [after 1000 timed_out]
vwait done
sendCommand {close $socket10_14_test_server}
set done
} {EOF is sticky}
-test socket-11.13 {testing async write, async flush, async close} {
+
+test socket-11.13 {testing async write, async flush, async close} \
+ {socket doTestsWithRemoteServer} {
proc readit {s} {
global count done
set l [read $s]
@@ -1370,12 +1366,276 @@ test socket-11.13 {testing async write, async flush, async close} {
set count
} 65566
+test socket-12.1 {testing inheritance of server sockets} {socket exec} {
+ removeFile script1
+ removeFile script2
+
+ # Script1 is just a 10 second delay. If the server socket
+ # is inherited, it will be held open for 10 seconds
+
+ set f [open script1 w]
+ puts $f {
+ after 10000 exit
+ vwait forever
+ }
+ close $f
+
+ # Script2 creates the server socket, launches script1,
+ # waits a second, and exits. The server socket will now
+ # be closed unless script1 inherited it.
+
+ set f [open script2 w]
+ puts $f [list set tclsh $::tcltest::tcltest]
+ puts $f {
+ set f [socket -server accept 2828]
+ proc accept { file addr port } {
+ close $file
+ }
+ exec $tclsh script1 &
+ close $f
+ after 1000 exit
+ vwait forever
+ }
+ close $f
+
+ # Launch script2 and wait 5 seconds
+
+ exec $::tcltest::tcltest script2 &
+ after 5000 { set ok_to_proceed 1 }
+ vwait ok_to_proceed
+
+ # If we can still connect to the server, the socket got inherited.
+
+ if {[catch {socket 127.0.0.1 2828} msg]} {
+ set x {server socket was not inherited}
+ } else {
+ close $msg
+ set x {server socket was inherited}
+ }
+
+ removeFile script1
+ removeFile script2
+ set x
+} {server socket was not inherited}
+test socket-12.2 {testing inheritance of client sockets} {socket exec} {
+ removeFile script1
+ removeFile script2
+
+ # Script1 is just a 10 second delay. If the server socket
+ # is inherited, it will be held open for 10 seconds
+
+ set f [open script1 w]
+ puts $f {
+ after 10000 exit
+ vwait forever
+ }
+ close $f
+
+ # Script2 opens the client socket and writes to it. It then
+ # launches script1 and exits. If the child process inherited the
+ # client socket, the socket will still be open.
+
+ set f [open script2 w]
+ puts $f [list set tclsh $::tcltest::tcltest]
+ puts $f {
+ set f [socket 127.0.0.1 2829]
+ exec $tclsh script1 &
+ puts $f testing
+ flush $f
+ after 1000 exit
+ vwait forever
+ }
+ close $f
+
+ # Create the server socket
+
+ set server [socket -server accept 2829]
+ proc accept { file host port } {
+ # When the client connects, establish the read handler
+ global server
+ close $server
+ fileevent $file readable [list getdata $file]
+ fconfigure $file -buffering line -blocking 0
+ return
+ }
+ proc getdata { file } {
+ # Read handler on the accepted socket.
+ global x
+ global failed
+ set status [catch {read $file} data]
+ if {$status != 0} {
+ set x {read failed, error was $data}
+ catch { close $file }
+ } elseif {[string compare {} $data]} {
+ } elseif {[fblocked $file]} {
+ } elseif {[eof $file]} {
+ if {$failed} {
+ set x {client socket was inherited}
+ } else {
+ set x {client socket was not inherited}
+ }
+ catch { close $file }
+ } else {
+ set x {impossible case}
+ catch { close $file }
+ }
+ return
+ }
+
+ # If the socket doesn't hit end-of-file in 5 seconds, the
+ # script1 process must have inherited the client.
+
+ set failed 0
+ after 5000 [list set failed 1]
+
+ # Launch the script2 process
+
+ exec $::tcltest::tcltest script2 &
+
+ vwait x
+ if {!$failed} {
+ vwait failed
+ }
+ removeFile script1
+ removeFile script2
+ set x
+} {client socket was not inherited}
+test socket-12.3 {testing inheritance of accepted sockets} {socket exec} {
+ removeFile script1
+ removeFile script2
+
+ set f [open script1 w]
+ puts $f {
+ after 10000 exit
+ vwait forever
+ }
+ close $f
+
+ set f [open script2 w]
+ puts $f [list set tclsh $::tcltest::tcltest]
+ puts $f {
+ set server [socket -server accept 2931]
+ proc accept { file host port } {
+ global tclsh
+ puts $file {test data on socket}
+ exec $tclsh script1 &
+ after 1000 exit
+ }
+ vwait forever
+ }
+ close $f
+
+ # Launch the script2 process and connect to it. See how long
+ # the socket stays open
+
+ exec $::tcltest::tcltest script2 &
+
+ after 1000 set ok_to_proceed 1
+ vwait ok_to_proceed
+
+ set f [socket 127.0.0.1 2931]
+ fconfigure $f -buffering full -blocking 0
+ fileevent $f readable [list getdata $f]
+
+ # If the socket is still open after 5 seconds, the script1 process
+ # must have inherited the accepted socket.
+
+ set failed 0
+ after 5000 set failed 1
+
+ proc getdata { file } {
+ # Read handler on the client socket.
+ global x
+ global failed
+ set status [catch {read $file} data]
+ if {$status != 0} {
+ set x {read failed, error was $data}
+ catch { close $file }
+ } elseif {[string compare {} $data]} {
+ } elseif {[fblocked $file]} {
+ } elseif {[eof $file]} {
+ if {$failed} {
+ set x {accepted socket was inherited}
+ } else {
+ set x {accepted socket was not inherited}
+ }
+ catch { close $file }
+ } else {
+ set x {impossible case}
+ catch { close $file }
+ }
+ return
+ }
+
+ vwait x
+
+ removeFile script1
+ removeFile script2
+ set x
+} {accepted socket was not inherited}
+
+test socket-13.1 {Testing use of shared socket between two threads} \
+ {socket testthread} {
+
+ removeFile script
+ threadReap
+
+ makeFile {
+ set f [socket -server accept 2828]
+ proc accept {s a p} {
+ fileevent $s readable [list echo $s]
+ fconfigure $s -buffering line
+ }
+ proc echo {s} {
+ global i
+ set l [gets $s]
+ if {[eof $s]} {
+ global x
+ close $s
+ set x done
+ } else {
+ incr i
+ puts $s $l
+ }
+ }
+ set i 0
+ vwait x
+ close $f
+
+ # thread cleans itself up.
+ testthread exit
+ } script
+
+ # create a thread
+ set serverthread [testthread create { source script } ]
+ update
+
+ after 1000
+ set s [socket 127.0.0.1 2828]
+ fconfigure $s -buffering line
+
+ catch {
+ puts $s "hello"
+ gets $s result
+ }
+ close $s
+ update
+
+ after 2000
+ lappend result [threadReap]
+
+ set result
+
+} {hello 1}
+
+# cleanup
if {[string match sock* $commandSocket] == 1} {
puts $commandSocket exit
flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
+::tcltest::cleanupTests
+flush stdout
+return
-set x ""
-unset x
diff --git a/tcl/tests/source.test b/tcl/tests/source.test
index 383e02c5376..8ab5755d6f3 100644
--- a/tcl/tests/source.test
+++ b/tcl/tests/source.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test source-1.1 {source command} {
set x "old x value"
@@ -30,23 +34,19 @@ test source-1.2 {source command} {
makeFile {list result} source.file
source source.file
} result
+test source-1.3 {source command} {
+ set y {\ }
-# The mac version of source returns a different result for
-# the next two tests.
+ set fd [open source.file w]
+ fconfigure $fd -translation lf
+ puts -nonewline $fd "list a b c "
+ puts $fd [string index $y 0]
+ puts $fd "d e f"
+ close $fd
+
+ source source.file
+} {a b c d e f}
-if {$tcl_platform(platform) == "macintosh"} {
- set retMsg1 {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
- set retMsg2 {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
-} else {
- set retMsg1 {1 {wrong # args: should be "source fileName"}}
- set retMsg2 {1 {wrong # args: should be "source fileName"}}
-}
-test source-2.1 {source error conditions} {
- list [catch {source} msg] $msg
-} $retMsg1
-test source-2.2 {source error conditions} {
- list [catch {source a b} msg] $msg
-} $retMsg2
test source-2.3 {source error conditions} {
makeFile {
set x 146
@@ -132,13 +132,13 @@ test source-4.2 {source error conditions} {macOnly} {
} [list 1 "expected integer but got \"bad_id\""]
test source-4.3 {source error conditions} {macOnly} {
list [catch {source -rsrc rsrcName fileName extra} msg] $msg
-} $retMsg1
+} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
test source-4.4 {source error conditions} {macOnly} {
list [catch {source non_switch rsrcName} msg] $msg
-} $retMsg2
+} {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
test source-4.5 {source error conditions} {macOnly} {
list [catch {source -bad_switch argument} msg] $msg
-} $retMsg2
+} {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
test source-5.1 {source resource files} {macOnly} {
list [catch {source -rsrc rsrcName bad_file} msg] $msg
} [list 1 "Error finding the file: \"bad_file\"."]
@@ -180,8 +180,20 @@ test source-6.1 {source is binary ok} {
string length $x
} 5
-catch {removeFile source.file}
+# cleanup
+catch {::tcltest::removeFile source.file}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
-# Generate null final value
-concat {}
diff --git a/tcl/tests/split.test b/tcl/tests/split.test
index 7a1cd45c5d1..54aa0b949d1 100644
--- a/tcl/tests/split.test
+++ b/tcl/tests/split.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test split-1.1 {basic split commands} {
split "a\n b\t\r c\n "
@@ -63,3 +67,20 @@ test split-2.1 {split errors} {
test split-2.2 {split errors} {
list [catch {split a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/stack.test b/tcl/tests/stack.test
index 58b2c4ad23e..a78bb1d7cec 100644
--- a/tcl/tests/stack.test
+++ b/tcl/tests/stack.test
@@ -4,14 +4,17 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Note that a failure in this test results in a crash of the executable.
@@ -21,3 +24,8 @@ test stack-1.1 {maxNestingDepth reached on infinite recursion} {
rename recurse {}
set rv
} {too many nested calls to Tcl_EvalObj (infinite loop?)}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/string.test b/tcl/tests/string.test
index 253852450df..786f726ffde 100644
--- a/tcl/tests/string.test
+++ b/tcl/tests/string.test
@@ -6,379 +6,1167 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
-test string-1.1 {string compare} {
+# Some tests require the testobj command
+
+set ::tcltest::testConstraints(testobj) \
+ [expr {[info commands testobj] != {}}]
+
+test string-1.1 {error conditions} {
+ list [catch {string gorp a b} msg] $msg
+} {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+test string-1.2 {error conditions} {
+ list [catch {string} msg] $msg
+} {1 {wrong # args: should be "string option arg ?arg ...?"}}
+
+test string-2.1 {string compare, too few args} {
+ list [catch {string compare a} msg] $msg
+} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
+test string-2.2 {string compare, bad args} {
+ list [catch {string compare a b c} msg] $msg
+} {1 {bad option "a": must be -nocase or -length}}
+test string-2.3 {string compare, bad args} {
+ list [catch {string compare -length -nocase str1 str2} msg] $msg
+} {1 {expected integer but got "-nocase"}}
+test string-2.4 {string compare, too many args} {
+ list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg
+} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
+test string-2.5 {string compare with length unspecified} {
+ list [catch {string compare -length 10 10} msg] $msg
+} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
+test string-2.6 {string compare} {
string compare abcde abdef
} -1
-test string-1.2 {string compare} {
+test string-2.7 {string compare, shortest method name} {
string c abcde ABCDE
} 1
-test string-1.3 {string compare} {
+test string-2.8 {string compare} {
string compare abcde abcde
} 0
-test string-1.4 {string compare} {
- list [catch {string compare a} msg] $msg
-} {1 {wrong # args: should be "string compare string1 string2"}}
-test string-1.5 {string compare} {
- list [catch {string compare a b c} msg] $msg
-} {1 {wrong # args: should be "string compare string1 string2"}}
+test string-2.9 {string compare with length} {
+ string compare -length 2 abcde abxyz
+} 0
+test string-2.10 {string compare with special index} {
+ list [catch {string compare -length end-3 abcde abxyz} msg] $msg
+} {1 {expected integer but got "end-3"}}
+test string-2.11 {string compare, unicode} {
+ string compare ab\u7266 ab\u7267
+} -1
+test string-2.12 {string compare, high bit} {
+ # This test will fail if the underlying comparaison
+ # is using signed chars instead of unsigned chars.
+ # (like SunOS's default memcmp thus the compat/memcmp.c)
+ string compare "\x80" "@"
+ # Nb this tests works also in utf8 space because \x80 is
+ # translated into a 2 or more bytelength but whose first byte has
+ # the high bit set.
+} 1
+test string-2.13 {string compare -nocase} {
+ string compare -nocase abcde abdef
+} -1
+test string-2.14 {string compare -nocase} {
+ string c -nocase abcde ABCDE
+} 0
+test string-2.15 {string compare -nocase} {
+ string compare -nocase abcde abcde
+} 0
+test string-2.16 {string compare -nocase with length} {
+ string compare -length 2 -nocase abcde Abxyz
+} 0
+test string-2.17 {string compare -nocase with length} {
+ string compare -nocase -length 3 abcde Abxyz
+} -1
+test string-2.18 {string compare -nocase with length <= 0} {
+ string compare -nocase -length -1 abcde AbCdEf
+} -1
+test string-2.19 {string compare -nocase with excessive length} {
+ string compare -nocase -length 50 AbCdEf abcde
+} 1
+test string-2.20 {string compare -len unicode} {
+ # These are strings that are 6 BYTELENGTH long, but the length
+ # shouldn't make a different because there are actually 3 CHARS long
+ string compare -len 5 \334\334\334 \334\334\374
+} -1
+test string-2.21 {string compare -nocase with special index} {
+ list [catch {string compare -nocase -length end-3 Abcde abxyz} msg] $msg
+} {1 {expected integer but got "end-3"}}
+test string-2.22 {string compare, null strings} {
+ string compare "" ""
+} 0
+test string-2.23 {string compare, null strings} {
+ string compare "" foo
+} -1
+test string-2.24 {string compare, null strings} {
+ string compare foo ""
+} 1
+test string-2.25 {string compare -nocase, null strings} {
+ string compare -nocase "" ""
+} 0
+test string-2.26 {string compare -nocase, null strings} {
+ string compare -nocase "" foo
+} -1
+test string-2.27 {string compare -nocase, null strings} {
+ string compare -nocase foo ""
+} 1
+test string-2.28 {string equal with length, unequal strings} {
+ string compare -length 2 abc abde
+} 0
+test string-2.29 {string equal with length, unequal strings} {
+ string compare -length 2 ab abde
+} 0
-test string-2.1 {string first} {
+# only need a few tests on equal, since it uses the same code as
+# string compare, but just modifies the return output
+test string-3.1 {string equal} {
+ string equal abcde abdef
+} 0
+test string-3.2 {string equal} {
+ string eq abcde ABCDE
+} 0
+test string-3.3 {string equal} {
+ string equal abcde abcde
+} 1
+test string-3.4 {string equal -nocase} {
+ string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334
+} 1
+test string-3.5 {string equal -nocase} {
+ string equal -nocase abcde abdef
+} 0
+test string-3.6 {string equal -nocase} {
+ string eq -nocase abcde ABCDE
+} 1
+test string-3.7 {string equal -nocase} {
+ string equal -nocase abcde abcde
+} 1
+test string-3.8 {string equal with length, unequal strings} {
+ string equal -length 2 abc abde
+} 1
+
+test string-4.1 {string first, too few args} {
+ list [catch {string first a} msg] $msg
+} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}}
+test string-4.2 {string first, bad args} {
+ list [catch {string first a b c} msg] $msg
+} {1 {bad index "c": must be integer or end?-integer?}}
+test string-4.3 {string first, too many args} {
+ list [catch {string first a b 5 d} msg] $msg
+} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}}
+test string-4.4 {string first} {
string first bq abcdefgbcefgbqrs
} 12
-test string-2.2 {string first} {
+test string-4.5 {string first} {
string fir bcd abcdefgbcefgbqrs
} 1
-test string-2.3 {string first} {
+test string-4.6 {string first} {
string f b abcdefgbcefgbqrs
} 1
-test string-2.4 {string first} {
+test string-4.7 {string first} {
string first xxx x123xx345xxx789xxx012
} 9
-test string-2.5 {string first} {
+test string-4.8 {string first} {
string first "" x123xx345xxx789xxx012
} -1
-test string-2.6 {string first} {
- list [catch {string first a} msg] $msg
-} {1 {wrong # args: should be "string first string1 string2"}}
-test string-2.7 {string first} {
- list [catch {string first a b c} msg] $msg
-} {1 {wrong # args: should be "string first string1 string2"}}
+test string-4.9 {string first, unicode} {
+ string first x abc\u7266x
+} 4
+test string-4.10 {string first, unicode} {
+ string first \u7266 abc\u7266x
+} 3
+test string-4.11 {string first, start index} {
+ string first \u7266 abc\u7266x 3
+} 3
+test string-4.12 {string first, start index} {
+ string first \u7266 abc\u7266x 4
+} -1
+test string-4.13 {string first, start index} {
+ string first \u7266 abc\u7266x end-2
+} 3
+test string-4.14 {string first, start index} {
+ string first a abcabc end-4
+} 3
-test string-3.1 {string index} {
+test string-5.1 {string index} {
+ list [catch {string index} msg] $msg
+} {1 {wrong # args: should be "string index string charIndex"}}
+test string-5.2 {string index} {
+ list [catch {string index a b c} msg] $msg
+} {1 {wrong # args: should be "string index string charIndex"}}
+test string-5.3 {string index} {
string index abcde 0
} a
-test string-3.2 {string index} {
- string i abcde 4
+test string-5.4 {string index} {
+ string in abcde 4
} e
-test string-3.3 {string index} {
+test string-5.5 {string index} {
string index abcde 5
} {}
-test string-3.4 {string index} {
+test string-5.6 {string index} {
list [catch {string index abcde -10} msg] $msg
} {0 {}}
-test string-3.5 {string index} {
- list [catch {string index} msg] $msg
-} {1 {wrong # args: should be "string index string charIndex"}}
-test string-3.6 {string index} {
- list [catch {string index a b c} msg] $msg
-} {1 {wrong # args: should be "string index string charIndex"}}
-test string-3.7 {string index} {
+test string-5.7 {string index} {
list [catch {string index a xyz} msg] $msg
-} {1 {expected integer but got "xyz"}}
+} {1 {bad index "xyz": must be integer or end?-integer?}}
+test string-5.8 {string index} {
+ string index abc end
+} c
+test string-5.9 {string index} {
+ string index abc end-1
+} b
+test string-5.10 {string index, unicode} {
+ string index abc\u7266d 4
+} d
+test string-5.11 {string index, unicode} {
+ string index abc\u7266d 3
+} \u7266
+test string-5.12 {string index, unicode over char length, under byte length} {
+ string index \334\374\334\374 6
+} {}
+test string-5.13 {string index, bytearray object} {
+ string index [binary format a5 fuz] 0
+} f
+test string-5.14 {string index, bytearray object} {
+ string index [binary format I* {0x50515253 0x52}] 3
+} S
+test string-5.15 {string index, bytearray object} {
+ set b [binary format I* {0x50515253 0x52}]
+ set i1 [string index $b end-6]
+ set i2 [string index $b 1]
+ string compare $i1 $i2
+} 0
+test string-5.16 {string index, bytearray object with string obj shimmering} {
+ set str "0123456789\x00 abcdedfghi"
+ binary scan $str H* dump
+ string compare [string index $str 10] \x00
+} 0
+test string-5.17 {string index, bad integer} {
+ list [catch {string index "abc" 08} msg] $msg
+} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}}
+test string-5.18 {string index, bad integer} {
+ list [catch {string index "abc" end-00289} msg] $msg
+} {1 {expected integer but got "-00289" (looks like invalid octal number)}}
+
+
+proc largest_int {} {
+ # This will give us what the largest valid int on this machine is,
+ # so we can test for overflow properly below on >32 bit systems
+ set int 1
+ set exp 7; # assume we get at least 8 bits
+ while {$int > 0} { set int [expr {1 << [incr exp]}] }
+ return [expr {$int-1}]
+}
-test string-4.1 {string last} {
+test string-6.1 {string is, too few args} {
+ list [catch {string is} msg] $msg
+} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
+test string-6.2 {string is, too few args} {
+ list [catch {string is alpha} msg] $msg
+} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
+test string-6.3 {string is, bad args} {
+ list [catch {string is alpha -failin str} msg] $msg
+} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
+test string-6.4 {string is, too many args} {
+ list [catch {string is alpha -failin var -strict str more} msg] $msg
+} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
+test string-6.5 {string is, class check} {
+ list [catch {string is bogus str} msg] $msg
+} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, punct, space, true, upper, wordchar, or xdigit}}
+test string-6.6 {string is, ambiguous class} {
+ list [catch {string is al str} msg] $msg
+} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, punct, space, true, upper, wordchar, or xdigit}}
+test string-6.7 {string is alpha, all ok} {
+ string is alpha -strict -failindex var abc
+} 1
+test string-6.8 {string is, error in var} {
+ list [string is alpha -failindex var abc5def] $var
+} {0 3}
+test string-6.9 {string is, var shouldn't get set} {
+ catch {unset var}
+ list [catch {string is alpha -failindex var abc; set var} msg] $msg
+} {1 {can't read "var": no such variable}}
+test string-6.10 {string is, ok on empty} {
+ string is alpha {}
+} 1
+test string-6.11 {string is, -strict check against empty} {
+ string is alpha -strict {}
+} 0
+test string-6.12 {string is alnum, true} {
+ string is alnum abc123
+} 1
+test string-6.13 {string is alnum, false} {
+ list [string is alnum -failindex var abc1.23] $var
+} {0 4}
+test string-6.14 {string is alnum, unicode} {
+ string is alnum abcü
+} 1
+test string-6.15 {string is alpha, true} {
+ string is alpha abc
+} 1
+test string-6.16 {string is alpha, false} {
+ list [string is alpha -fail var a1bcde] $var
+} {0 1}
+test string-6.17 {string is alpha, unicode} {
+ string is alpha abc\374
+} 1
+test string-6.18 {string is ascii, true} {
+ string is ascii abc\u007Fend
+} 1
+test string-6.19 {string is ascii, false} {
+ list [string is ascii -fail var abcdef\u0080more] $var
+} {0 6}
+test string-6.20 {string is boolean, true} {
+ string is boolean true
+} 1
+test string-6.21 {string is boolean, true} {
+ string is boolean f
+} 1
+test string-6.22 {string is boolean, true based on type} {
+ string is bool [string compare a a]
+} 1
+test string-6.23 {string is boolean, false} {
+ list [string is bool -fail var yada] $var
+} {0 0}
+test string-6.24 {string is digit, true} {
+ string is digit 0123456789
+} 1
+test string-6.25 {string is digit, false} {
+ list [string is digit -fail var 0123Ü567] $var
+} {0 4}
+test string-6.26 {string is digit, false} {
+ list [string is digit -fail var +123567] $var
+} {0 0}
+test string-6.27 {string is double, true} {
+ string is double 1
+} 1
+test string-6.28 {string is double, true} {
+ string is double [expr double(1)]
+} 1
+test string-6.29 {string is double, true} {
+ string is double 1.0
+} 1
+test string-6.30 {string is double, true} {
+ string is double [string compare a a]
+} 1
+test string-6.31 {string is double, true} {
+ string is double " +1.0e-1 "
+} 1
+test string-6.32 {string is double, true} {
+ string is double "\n1.0\v"
+} 1
+test string-6.33 {string is double, false} {
+ list [string is double -fail var 1abc] $var
+} {0 1}
+test string-6.34 {string is double, false} {
+ list [string is double -fail var abc] $var
+} {0 0}
+test string-6.35 {string is double, false} {
+ list [string is double -fail var " 1.0e4e4 "] $var
+} {0 8}
+test string-6.36 {string is double, false} {
+ list [string is double -fail var "\n"] $var
+} {0 0}
+test string-6.37 {string is double, false on int overflow} {
+ # Make it the largest int recognizable, with one more digit for overflow
+ list [string is double -fail var [largest_int]0] $var
+} {0 -1}
+test string-6.38 {string is double, false on underflow} {
+ catch {unset var}
+ list [string is double -fail var 123e-9999] $var
+} {0 -1}
+test string-6.39 {string is double, false} {nonPortable} {
+ # This test is non-portable because IRIX thinks
+ # that .e1 is a valid double - this is really a bug
+ # on IRIX as .e1 should NOT be a valid double
+
+ list [string is double -fail var .e1] $var
+} {0 0}
+test string-6.40 {string is false, true} {
+ string is false false
+} 1
+test string-6.41 {string is false, true} {
+ string is false FaLsE
+} 1
+test string-6.42 {string is false, true} {
+ string is false N
+} 1
+test string-6.43 {string is false, true} {
+ string is false 0
+} 1
+test string-6.44 {string is false, true} {
+ string is false off
+} 1
+test string-6.45 {string is false, false} {
+ list [string is false -fail var abc] $var
+} {0 0}
+test string-6.46 {string is false, false} {
+ catch {unset var}
+ list [string is false -fail var Y] $var
+} {0 0}
+test string-6.47 {string is false, false} {
+ catch {unset var}
+ list [string is false -fail var offensive] $var
+} {0 0}
+test string-6.48 {string is integer, true} {
+ string is integer +1234567890
+} 1
+test string-6.49 {string is integer, true on type} {
+ string is integer [expr int(50.0)]
+} 1
+test string-6.50 {string is integer, true} {
+ string is integer [list -10]
+} 1
+test string-6.51 {string is integer, true as hex} {
+ string is integer 0xabcdef
+} 1
+test string-6.52 {string is integer, true as octal} {
+ string is integer 012345
+} 1
+test string-6.53 {string is integer, true with whitespace} {
+ string is integer " \n1234\v"
+} 1
+test string-6.54 {string is integer, false} {
+ list [string is integer -fail var 123abc] $var
+} {0 3}
+test string-6.55 {string is integer, false on overflow} {
+ list [string is integer -fail var +[largest_int]0] $var
+} {0 -1}
+test string-6.56 {string is integer, false} {
+ list [string is integer -fail var [expr double(1)]] $var
+} {0 1}
+test string-6.57 {string is integer, false} {
+ list [string is integer -fail var " "] $var
+} {0 0}
+test string-6.58 {string is integer, false on bad octal} {
+ list [string is integer -fail var 036963] $var
+} {0 3}
+test string-6.59 {string is integer, false on bad hex} {
+ list [string is integer -fail var 0X345XYZ] $var
+} {0 5}
+test string-6.60 {string is lower, true} {
+ string is lower abc
+} 1
+test string-6.61 {string is lower, unicode true} {
+ string is lower abcüue
+} 1
+test string-6.62 {string is lower, false} {
+ list [string is lower -fail var aBc] $var
+} {0 1}
+test string-6.63 {string is lower, false} {
+ list [string is lower -fail var abc1] $var
+} {0 3}
+test string-6.64 {string is lower, unicode false} {
+ list [string is lower -fail var abÜUE] $var
+} {0 2}
+test string-6.65 {string is space, true} {
+ string is space " \t\n\v\f"
+} 1
+test string-6.66 {string is space, false} {
+ list [string is space -fail var " \t\n\v1\f"] $var
+} {0 4}
+test string-6.67 {string is true, true} {
+ string is true true
+} 1
+test string-6.68 {string is true, true} {
+ string is true TrU
+} 1
+test string-6.69 {string is true, true} {
+ string is true ye
+} 1
+test string-6.70 {string is true, true} {
+ string is true 1
+} 1
+test string-6.71 {string is true, true} {
+ string is true on
+} 1
+test string-6.72 {string is true, false} {
+ list [string is true -fail var onto] $var
+} {0 0}
+test string-6.73 {string is true, false} {
+ catch {unset var}
+ list [string is true -fail var 25] $var
+} {0 0}
+test string-6.74 {string is true, false} {
+ catch {unset var}
+ list [string is true -fail var no] $var
+} {0 0}
+test string-6.75 {string is upper, true} {
+ string is upper ABC
+} 1
+test string-6.76 {string is upper, unicode true} {
+ string is upper ABCÜUE
+} 1
+test string-6.77 {string is upper, false} {
+ list [string is upper -fail var AbC] $var
+} {0 1}
+test string-6.78 {string is upper, false} {
+ list [string is upper -fail var AB2C] $var
+} {0 2}
+test string-6.79 {string is upper, unicode false} {
+ list [string is upper -fail var ABCüue] $var
+} {0 3}
+test string-6.80 {string is wordchar, true} {
+ string is wordchar abc_123
+} 1
+test string-6.81 {string is wordchar, unicode true} {
+ string is wordchar abcüabÜAB\u5001
+} 1
+test string-6.82 {string is wordchar, false} {
+ list [string is wordchar -fail var abcd.ef] $var
+} {0 4}
+test string-6.83 {string is wordchar, unicode false} {
+ list [string is wordchar -fail var abc\u0080def] $var
+} {0 3}
+test string-6.84 {string is control} {
+ ## Control chars are in the ranges
+ ## 00..1F && 7F..9F
+ list [string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60] $var
+} {0 7}
+test string-6.85 {string is control} {
+ string is control \u0100
+} 0
+test string-6.86 {string is graph} {
+ ## graph is any print char, except space
+ list [string is gra -fail var "0123abc!@#\$\u0100 "] $var
+} {0 12}
+test string-6.87 {string is print} {
+ ## basically any printable char
+ list [string is print -fail var "0123abc!@#\$\u0100 \u0010"] $var
+} {0 13}
+test string-6.88 {string is punct} {
+ ## any graph char that isn't alnum
+ list [string is punct -fail var "_!@#\u00beq0"] $var
+} {0 4}
+test string-6.89 {string is xdigit} {
+ list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var
+} {0 22}
+
+catch {rename largest_int {}}
+
+test string-7.1 {string last, too few args} {
+ list [catch {string last a} msg] $msg
+} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}}
+test string-7.2 {string last, bad args} {
+ list [catch {string last a b c} msg] $msg
+} {1 {bad index "c": must be integer or end?-integer?}}
+test string-7.3 {string last, too many args} {
+ list [catch {string last a b c d} msg] $msg
+} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}}
+test string-7.4 {string last} {
string la xxx xxxx123xx345x678
} 1
-test string-4.2 {string last} {
+test string-7.5 {string last} {
string last xx xxxx123xx345x678
} 7
-test string-4.3 {string last} {
+test string-7.6 {string last} {
string las x xxxx123xx345x678
} 12
-test string-4.4 {string last} {
- list [catch {string last a} msg] $msg
-} {1 {wrong # args: should be "string last string1 string2"}}
-test string-4.5 {string last} {
- list [catch {string last a b c} msg] $msg
-} {1 {wrong # args: should be "string last string1 string2"}}
+test string-7.7 {string last, unicode} {
+ string las x xxxx12\u7266xx345x678
+} 12
+test string-7.8 {string last, unicode} {
+ string las \u7266 xxxx12\u7266xx345x678
+} 6
+test string-7.9 {string last, stop index} {
+ string las \u7266 xxxx12\u7266xx345x678
+} 6
+test string-7.10 {string last, unicode} {
+ string las \u7266 xxxx12\u7266xx345x678
+} 6
+test string-7.11 {string last, start index} {
+ string last \u7266 abc\u7266x 3
+} 3
+test string-7.12 {string last, start index} {
+ string last \u7266 abc\u7266x 2
+} -1
+test string-7.13 {string last, start index} {
+ ## Constrain to last 'a' should work
+ string last ba badbad end-1
+} 3
+test string-7.14 {string last, start index} {
+ ## Constrain to last 'b' should skip last 'ba'
+ string last ba badbad end-2
+} 0
+test string-7.15 {string last, start index} {
+ string last \334a \334ad\334ad 0
+} -1
+test string-7.16 {string last, start index} {
+ string last \334a \334ad\334ad end-1
+} 3
-test string-5.1 {string length} {
- string length "a little string"
-} 15
-test string-5.2 {string length} {
- string le ""
+test string-8.1 {string bytelength} {
+ list [catch {string bytelength} msg] $msg
+} {1 {wrong # args: should be "string bytelength string"}}
+test string-8.2 {string bytelength} {
+ list [catch {string bytelength a b} msg] $msg
+} {1 {wrong # args: should be "string bytelength string"}}
+test string-8.3 {string bytelength} {
+ string bytelength "\u00c7"
+} 2
+test string-8.4 {string bytelength} {
+ string b ""
} 0
-test string-5.3 {string length} {
+
+test string-9.1 {string length} {
list [catch {string length} msg] $msg
} {1 {wrong # args: should be "string length string"}}
-test string-5.4 {string length} {
+test string-9.2 {string length} {
list [catch {string length a b} msg] $msg
} {1 {wrong # args: should be "string length string"}}
+test string-9.3 {string length} {
+ string length "a little string"
+} 15
+test string-9.4 {string length} {
+ string le ""
+} 0
+test string-9.5 {string length, unicode} {
+ string le "abcd\u7266"
+} 5
+test string-9.6 {string length, bytearray object} {
+ string length [binary format a5 foo]
+} 5
+test string-9.7 {string length, bytearray object} {
+ string length [binary format I* {0x50515253 0x52}]
+} 8
-test string-6.1 {string match} {
+test string-10.1 {string map, too few args} {
+ list [catch {string map} msg] $msg
+} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
+test string-10.2 {string map, bad args} {
+ list [catch {string map {a b} abba oops} msg] $msg
+} {1 {bad option "a b": must be -nocase}}
+test string-10.3 {string map, too many args} {
+ list [catch {string map -nocase {a b} str1 str2} msg] $msg
+} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
+test string-10.4 {string map} {
+ string map {a b} abba
+} {bbbb}
+test string-10.5 {string map} {
+ string map {a b} a
+} {b}
+test string-10.6 {string map -nocase} {
+ string map -nocase {a b} Abba
+} {bbbb}
+test string-10.7 {string map} {
+ string map {abc 321 ab * a A} aabcabaababcab
+} {A321*A*321*}
+test string-10.8 {string map -nocase} {
+ string map -nocase {aBc 321 Ab * a A} aabcabaababcab
+} {A321*A*321*}
+test string-10.9 {string map -nocase} {
+ string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb
+} {A321*A*321*}
+test string-10.10 {string map} {
+ list [catch {string map {a b c} abba} msg] $msg
+} {1 {char map list unbalanced}}
+test string-10.11 {string map, nulls} {
+ string map {\x00 NULL blah \x00nix} {qwerty}
+} {qwerty}
+test string-10.12 {string map, unicode} {
+ string map [list \374 ue UE \334] "a\374ueUE\000EU"
+} aueue\334\0EU
+test string-10.13 {string map, -nocase unicode} {
+ string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"
+} aue\334\334\0EU
+test string-10.14 {string map, -nocase null arguments} {
+ string map -nocase {{} abc} foo
+} foo
+
+test string-11.1 {string match, too few args} {
+ list [catch {string match a} msg] $msg
+} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
+test string-11.2 {string match, too many args} {
+ list [catch {string match a b c d} msg] $msg
+} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
+test string-11.3 {string match} {
string match abc abc
} 1
-test string-6.2 {string match} {
- string m abc abd
+test string-11.4 {string match} {
+ string mat abc abd
} 0
-test string-6.3 {string match} {
+test string-11.5 {string match} {
string match ab*c abc
} 1
-test string-6.4 {string match} {
+test string-11.6 {string match} {
string match ab**c abc
} 1
-test string-6.5 {string match} {
+test string-11.7 {string match} {
string match ab* abcdef
} 1
-test string-6.6 {string match} {
+test string-11.8 {string match} {
string match *c abc
} 1
-test string-6.7 {string match} {
+test string-11.9 {string match} {
string match *3*6*9 0123456789
} 1
-test string-6.8 {string match} {
+test string-11.10 {string match} {
string match *3*6*9 01234567890
} 0
-test string-6.9 {string match} {
+test string-11.11 {string match} {
string match a?c abc
} 1
-test string-6.10 {string match} {
+test string-11.12 {string match} {
string match a??c abc
} 0
-test string-6.11 {string match} {
+test string-11.13 {string match} {
string match ?1??4???8? 0123456789
} 1
-test string-6.12 {string match} {
+test string-11.14 {string match} {
string match {[abc]bc} abc
} 1
-test string-6.13 {string match} {
+test string-11.15 {string match} {
string match {a[abc]c} abc
} 1
-test string-6.14 {string match} {
+test string-11.16 {string match} {
string match {a[xyz]c} abc
} 0
-test string-6.15 {string match} {
+test string-11.17 {string match} {
string match {12[2-7]45} 12345
} 1
-test string-6.16 {string match} {
+test string-11.18 {string match} {
string match {12[ab2-4cd]45} 12345
} 1
-test string-6.17 {string match} {
+test string-11.19 {string match} {
string match {12[ab2-4cd]45} 12b45
} 1
-test string-6.18 {string match} {
+test string-11.20 {string match} {
string match {12[ab2-4cd]45} 12d45
} 1
-test string-6.19 {string match} {
+test string-11.21 {string match} {
string match {12[ab2-4cd]45} 12145
} 0
-test string-6.20 {string match} {
+test string-11.22 {string match} {
string match {12[ab2-4cd]45} 12545
} 0
-test string-6.21 {string match} {
+test string-11.23 {string match} {
string match {a\*b} a*b
} 1
-test string-6.22 {string match} {
+test string-11.24 {string match} {
string match {a\*b} ab
} 0
-test string-6.23 {string match} {
+test string-11.25 {string match} {
string match {a\*\?\[\]\\\x} "a*?\[\]\\x"
} 1
-test string-6.24 {string match} {
+test string-11.26 {string match} {
string match ** ""
} 1
-test string-6.25 {string match} {
+test string-11.27 {string match} {
string match *. ""
} 0
-test string-6.26 {string match} {
+test string-11.28 {string match} {
string match "" ""
} 1
-test string-6.27 {string match} {
+test string-11.29 {string match} {
string match \[a a
} 1
-test string-6.28 {string match} {
- list [catch {string match a} msg] $msg
-} {1 {wrong # args: should be "string match pattern string"}}
-test string-6.29 {string match} {
- list [catch {string match a b c} msg] $msg
-} {1 {wrong # args: should be "string match pattern string"}}
+test string-11.30 {string match, bad args} {
+ list [catch {string match - b c} msg] $msg
+} {1 {bad option "-": must be -nocase}}
+test string-11.31 {string match case} {
+ string match a A
+} 0
+test string-11.32 {string match nocase} {
+ string match -n a A
+} 1
+test string-11.33 {string match nocase} {
+ string match -nocase a\334 A\374
+} 1
+test string-11.34 {string match nocase} {
+ string match -nocase a*f ABCDEf
+} 1
+test string-11.35 {string match case, false hope} {
+ # This is true because '_' lies between the A-Z and a-z ranges
+ string match {[A-z]} _
+} 1
+test string-11.36 {string match nocase range} {
+ # This is false because although '_' lies between the A-Z and a-z ranges,
+ # we lower case the end points before checking the ranges.
+ string match -nocase {[A-z]} _
+} 0
+test string-11.37 {string match nocase} {
+ string match -nocase {[A-fh-Z]} g
+} 0
+test string-11.38 {string match case, reverse range} {
+ string match {[A-fh-Z]} g
+} 1
-test string-7.1 {string range} {
+test string-12.1 {string range} {
+ list [catch {string range} msg] $msg
+} {1 {wrong # args: should be "string range string first last"}}
+test string-12.2 {string range} {
+ list [catch {string range a 1} msg] $msg
+} {1 {wrong # args: should be "string range string first last"}}
+test string-12.3 {string range} {
+ list [catch {string range a 1 2 3} msg] $msg
+} {1 {wrong # args: should be "string range string first last"}}
+test string-12.4 {string range} {
string range abcdefghijklmnop 2 14
} {cdefghijklmno}
-test string-7.2 {string range} {
+test string-12.5 {string range, last > length} {
string range abcdefghijklmnop 7 1000
} {hijklmnop}
-test string-7.3 {string range} {
+test string-12.6 {string range} {
string range abcdefghijklmnop 10 e
} {klmnop}
-test string-7.4 {string range} {
+test string-12.7 {string range, last < first} {
string range abcdefghijklmnop 10 9
} {}
-test string-7.5 {string range} {
+test string-12.8 {string range, first < 0} {
string range abcdefghijklmnop -3 2
} {abc}
-test string-7.6 {string range} {
+test string-12.9 {string range} {
string range abcdefghijklmnop -3 -2
} {}
-test string-7.7 {string range} {
+test string-12.10 {string range} {
string range abcdefghijklmnop 1000 1010
} {}
-test string-7.8 {string range} {
+test string-12.11 {string range} {
string range abcdefghijklmnop -100 end
} {abcdefghijklmnop}
-test string-7.9 {string range} {
- list [catch {string range} msg] $msg
-} {1 {wrong # args: should be "string range string first last"}}
-test string-7.10 {string range} {
- list [catch {string range a 1} msg] $msg
-} {1 {wrong # args: should be "string range string first last"}}
-test string-7.11 {string range} {
- list [catch {string range a 1 2 3} msg] $msg
-} {1 {wrong # args: should be "string range string first last"}}
-test string-7.12 {string range} {
+test string-12.12 {string range} {
list [catch {string range abc abc 1} msg] $msg
-} {1 {bad index "abc": must be integer or "end"}}
-test string-7.13 {string range} {
+} {1 {bad index "abc": must be integer or end?-integer?}}
+test string-12.13 {string range} {
list [catch {string range abc 1 eof} msg] $msg
-} {1 {bad index "eof": must be integer or "end"}}
-test string-7.14 {string range} {
- string range abcdefghijklmnop end end
-} {p}
-test string-7.15 {string range} {
+} {1 {bad index "eof": must be integer or end?-integer?}}
+test string-12.14 {string range} {
+ string range abcdefghijklmnop end-1 end
+} {op}
+test string-12.15 {string range} {
string range abcdefghijklmnop e 1000
} {p}
+test string-12.16 {string range} {
+ string range abcdefghijklmnop end end-1
+} {}
+test string-12.17 {string range, unicode} {
+ string range ab\u7266cdefghijklmnop 5 5
+} e
+test string-12.18 {string range, unicode} {
+ string range ab\u7266cdefghijklmnop 2 3
+} \u7266c
+test string-12.19 {string range, bytearray object} {
+ set b [binary format I* {0x50515253 0x52}]
+ set r1 [string range $b 1 end-1]
+ set r2 [string range $b 1 6]
+ string compare $r1 $r2
+} 0
+test string-12.20 {string range, out of bounds indices} {
+ string range \u00ff 0 1
+} \u00ff
+
+test string-13.1 {string repeat} {
+ list [catch {string repeat} msg] $msg
+} {1 {wrong # args: should be "string repeat string count"}}
+test string-13.2 {string repeat} {
+ list [catch {string repeat abc 10 oops} msg] $msg
+} {1 {wrong # args: should be "string repeat string count"}}
+test string-13.3 {string repeat} {
+ string repeat {} 100
+} {}
+test string-13.4 {string repeat} {
+ string repeat { } 5
+} { }
+test string-13.5 {string repeat} {
+ string repeat abc 3
+} {abcabcabc}
+test string-13.6 {string repeat} {
+ string repeat abc -1
+} {}
+test string-13.7 {string repeat} {
+ list [catch {string repeat abc end} msg] $msg
+} {1 {expected integer but got "end"}}
+
+test string-14.1 {string replace} {
+ list [catch {string replace} msg] $msg
+} {1 {wrong # args: should be "string replace string first last ?string?"}}
+test string-14.2 {string replace} {
+ list [catch {string replace a 1} msg] $msg
+} {1 {wrong # args: should be "string replace string first last ?string?"}}
+test string-14.3 {string replace} {
+ list [catch {string replace a 1 2 3 4} msg] $msg
+} {1 {wrong # args: should be "string replace string first last ?string?"}}
+test string-14.4 {string replace} {
+} {}
+test string-14.5 {string replace} {
+ string replace abcdefghijklmnop 2 14
+} {abp}
+test string-14.6 {string replace} {
+ string replace abcdefghijklmnop 7 1000
+} {abcdefg}
+test string-14.7 {string replace} {
+ string replace abcdefghijklmnop 10 e
+} {abcdefghij}
+test string-14.8 {string replace} {
+ string replace abcdefghijklmnop 10 9
+} {abcdefghijklmnop}
+test string-14.9 {string replace} {
+ string replace abcdefghijklmnop -3 2
+} {defghijklmnop}
+test string-14.10 {string replace} {
+ string replace abcdefghijklmnop -3 -2
+} {abcdefghijklmnop}
+test string-14.11 {string replace} {
+ string replace abcdefghijklmnop 1000 1010
+} {abcdefghijklmnop}
+test string-14.12 {string replace} {
+ string replace abcdefghijklmnop -100 end
+} {}
+test string-14.13 {string replace} {
+ list [catch {string replace abc abc 1} msg] $msg
+} {1 {bad index "abc": must be integer or end?-integer?}}
+test string-14.14 {string replace} {
+ list [catch {string replace abc 1 eof} msg] $msg
+} {1 {bad index "eof": must be integer or end?-integer?}}
+test string-14.15 {string replace} {
+ string replace abcdefghijklmnop end-10 end-2 NEW
+} {abcdeNEWop}
+test string-14.16 {string replace} {
+ string replace abcdefghijklmnop 0 e foo
+} {foo}
+test string-14.17 {string replace} {
+ string replace abcdefghijklmnop end end-1
+} {abcdefghijklmnop}
+
+test string-15.1 {string tolower too few args} {
+ list [catch {string tolower} msg] $msg
+} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
+test string-15.2 {string tolower bad args} {
+ list [catch {string tolower a b} msg] $msg
+} {1 {bad index "b": must be integer or end?-integer?}}
+test string-15.3 {string tolower too many args} {
+ list [catch {string tolower ABC 1 end oops} msg] $msg
+} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
+test string-15.4 {string tolower} {
+ string tolower ABCDeF
+} {abcdef}
+test string-15.5 {string tolower} {
+ string tolower "ABC XyZ"
+} {abc xyz}
+test string-15.6 {string tolower} {
+ string tolower {123#$&*()}
+} {123#$&*()}
+test string-15.7 {string tolower} {
+ string tolower ABC 1
+} AbC
+test string-15.8 {string tolower} {
+ string tolower ABC 1 end
+} Abc
+test string-15.9 {string tolower} {
+ string tolower ABC 0 end-1
+} abC
+test string-15.10 {string tolower, unicode} {
+ string tolower ABCabc\xc7\xe7
+} "abcabc\xe7\xe7"
+
+test string-16.1 {string toupper} {
+ list [catch {string toupper} msg] $msg
+} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
+test string-16.2 {string toupper} {
+ list [catch {string toupper a b} msg] $msg
+} {1 {bad index "b": must be integer or end?-integer?}}
+test string-16.3 {string toupper} {
+ list [catch {string toupper a 1 end oops} msg] $msg
+} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
+test string-16.4 {string toupper} {
+ string toupper abCDEf
+} {ABCDEF}
+test string-16.5 {string toupper} {
+ string toupper "abc xYz"
+} {ABC XYZ}
+test string-16.6 {string toupper} {
+ string toupper {123#$&*()}
+} {123#$&*()}
+test string-16.7 {string toupper} {
+ string toupper abc 1
+} aBc
+test string-16.8 {string toupper} {
+ string toupper abc 1 end
+} aBC
+test string-16.9 {string toupper} {
+ string toupper abc 0 end-1
+} ABc
+test string-16.10 {string toupper, unicode} {
+ string toupper ABCabc\xc7\xe7
+} "ABCABC\xc7\xc7"
-test string-8.1 {string trim} {
+test string-17.1 {string totitle} {
+ list [catch {string totitle} msg] $msg
+} {1 {wrong # args: should be "string totitle string ?first? ?last?"}}
+test string-17.2 {string totitle} {
+ list [catch {string totitle a b} msg] $msg
+} {1 {bad index "b": must be integer or end?-integer?}}
+test string-17.3 {string totitle} {
+ string totitle abCDEf
+} {Abcdef}
+test string-17.4 {string totitle} {
+ string totitle "abc xYz"
+} {Abc xyz}
+test string-17.5 {string totitle} {
+ string totitle {123#$&*()}
+} {123#$&*()}
+test string-17.6 {string totitle, unicode} {
+ string totitle ABCabc\xc7\xe7
+} "Abcabc\xe7\xe7"
+test string-17.7 {string totitle, unicode} {
+ string totitle \u01f3BCabc\xc7\xe7
+} "\u01f2bcabc\xe7\xe7"
+
+test string-18.1 {string trim} {
+ list [catch {string trim} msg] $msg
+} {1 {wrong # args: should be "string trim string ?chars?"}}
+test string-18.2 {string trim} {
+ list [catch {string trim a b c} msg] $msg
+} {1 {wrong # args: should be "string trim string ?chars?"}}
+test string-18.3 {string trim} {
string trim " XYZ "
} {XYZ}
-test string-8.2 {string trim} {
+test string-18.4 {string trim} {
string trim "\t\nXYZ\t\n\r\n"
} {XYZ}
-test string-8.3 {string trim} {
+test string-18.5 {string trim} {
string trim " A XYZ A "
} {A XYZ A}
-test string-8.4 {string trim} {
+test string-18.6 {string trim} {
string trim "XXYYZZABC XXYYZZ" ZYX
} {ABC }
-test string-8.5 {string trim} {
+test string-18.7 {string trim} {
string trim " \t\r "
} {}
-test string-8.6 {string trim} {
+test string-18.8 {string trim} {
string trim {abcdefg} {}
} {abcdefg}
-test string-8.7 {string trim} {
+test string-18.9 {string trim} {
string trim {}
} {}
-test string-8.8 {string trim} {
+test string-18.10 {string trim} {
string trim ABC DEF
} {ABC}
-test string-8.9 {string trim} {
- list [catch {string trim} msg] $msg
-} {1 {wrong # args: should be "string trim string ?chars?"}}
-test string-8.10 {string trim} {
- list [catch {string trim a b c} msg] $msg
-} {1 {wrong # args: should be "string trim string ?chars?"}}
+test string-18.11 {string trim, unicode} {
+ string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
+} " AB\xe7C "
-test string-9.1 {string trimleft} {
- string trimleft " XYZ "
-} {XYZ }
-test string-9.2 {string trimleft} {
+test string-19.1 {string trimleft} {
list [catch {string trimleft} msg] $msg
} {1 {wrong # args: should be "string trimleft string ?chars?"}}
+test string-19.2 {string trimleft} {
+ string trimleft " XYZ "
+} {XYZ }
-test string-10.1 {string trimright} {
+test string-20.1 {string trimright errors} {
+ list [catch {string trimright} msg] $msg
+} {1 {wrong # args: should be "string trimright string ?chars?"}}
+test string-20.2 {string trimright errors} {
+ list [catch {string trimg a} msg] $msg
+} {1 {bad option "trimg": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+test string-20.3 {string trimright} {
string trimright " XYZ "
} { XYZ}
-test string-10.2 {string trimright} {
+test string-20.4 {string trimright} {
string trimright " "
} {}
-test string-10.3 {string trimright} {
+test string-20.5 {string trimright} {
string trimright ""
} {}
-test string-10.4 {string trimright errors} {
- list [catch {string trimright} msg] $msg
-} {1 {wrong # args: should be "string trimright string ?chars?"}}
-test string-10.5 {string trimright errors} {
- list [catch {string trimg a} msg] $msg
-} {1 {bad option "trimg": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-
-test string-11.1 {string tolower} {
- string tolower ABCDeF
-} {abcdef}
-test string-11.2 {string tolower} {
- string tolower "ABC XyZ"
-} {abc xyz}
-test string-11.3 {string tolower} {
- string tolower {123#$&*()}
-} {123#$&*()}
-test string-11.4 {string tolower} {
- list [catch {string tolower} msg] $msg
-} {1 {wrong # args: should be "string tolower string"}}
-test string-11.5 {string tolower} {
- list [catch {string tolower a b} msg] $msg
-} {1 {wrong # args: should be "string tolower string"}}
-test string-12.1 {string toupper} {
- string toupper abCDEf
-} {ABCDEF}
-test string-12.2 {string toupper} {
- string toupper "abc xYz"
-} {ABC XYZ}
-test string-12.3 {string toupper} {
- string toupper {123#$&*()}
-} {123#$&*()}
-test string-12.4 {string toupper} {
- list [catch {string toupper} msg] $msg
-} {1 {wrong # args: should be "string toupper string"}}
-test string-12.5 {string toupper} {
- list [catch {string toupper a b} msg] $msg
-} {1 {wrong # args: should be "string toupper string"}}
-
-test string-13.1 {string wordend} {
+test string-21.1 {string wordend} {
list [catch {string wordend a} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
-test string-13.2 {string wordend} {
+test string-21.2 {string wordend} {
list [catch {string wordend a b c} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
-test string-13.3 {string wordend} {
+test string-21.3 {string wordend} {
list [catch {string wordend a gorp} msg] $msg
-} {1 {expected integer but got "gorp"}}
-test string-13.4 {string wordend} {
+} {1 {bad index "gorp": must be integer or end?-integer?}}
+test string-21.4 {string wordend} {
string wordend abc. -1
} 3
-test string-13.5 {string wordend} {
+test string-21.5 {string wordend} {
string wordend abc. 100
} 4
-test string-13.6 {string wordend} {
+test string-21.6 {string wordend} {
string wordend "word_one two three" 2
} 8
-test string-13.7 {string wordend} {
+test string-21.7 {string wordend} {
string wordend "one .&# three" 5
} 6
-test string-13.8 {string wordend} {
+test string-21.8 {string wordend} {
string worde "x.y" 0
} 1
+test string-21.9 {string wordend} {
+ string worde "x.y" end-1
+} 2
+test string-21.10 {string wordend, unicode} {
+ string wordend "xyz\u00c7de fg" 0
+} 6
+test string-21.11 {string wordend, unicode} {
+ string wordend "xyz\uc700de fg" 0
+} 6
+test string-21.12 {string wordend, unicode} {
+ string wordend "xyz\u203fde fg" 0
+} 6
+test string-21.13 {string wordend, unicode} {
+ string wordend "xyz\u2045de fg" 0
+} 3
+test string-21.14 {string wordend, unicode} {
+ string wordend "\uc700\uc700 abc" 8
+} 6
-test string-14.1 {string wordstart} {
+test string-22.1 {string wordstart} {
list [catch {string word a} msg] $msg
-} {1 {ambiguous option "word": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test string-14.2 {string wordstart} {
+} {1 {ambiguous option "word": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+test string-22.2 {string wordstart} {
list [catch {string wordstart a} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
-test string-14.3 {string wordstart} {
+test string-22.3 {string wordstart} {
list [catch {string wordstart a b c} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
-test string-14.4 {string wordstart} {
+test string-22.4 {string wordstart} {
list [catch {string wordstart a gorp} msg] $msg
-} {1 {expected integer but got "gorp"}}
-test string-14.5 {string wordstart} {
+} {1 {bad index "gorp": must be integer or end?-integer?}}
+test string-22.5 {string wordstart} {
string wordstart "one two three_words" 400
} 8
-test string-14.6 {string wordstart} {
+test string-22.6 {string wordstart} {
string wordstart "one two three_words" 2
} 0
-test string-14.7 {string wordend} {
+test string-22.7 {string wordstart} {
string wordstart "one two three_words" -2
} 0
-test string-14.8 {string wordend} {
+test string-22.8 {string wordstart} {
string wordstart "one .*&^ three" 6
} 6
-test string-14.9 {string wordend} {
+test string-22.9 {string wordstart} {
string wordstart "one two three" 4
} 4
+test string-22.10 {string wordstart} {
+ string wordstart "one two three" end-5
+} 7
+test string-22.11 {string wordstart, unicode} {
+ string wordstart "one tw\u00c7o three" 7
+} 4
+test string-22.12 {string wordstart, unicode} {
+ string wordstart "ab\uc700\uc700 cdef ghi" 12
+} 10
+test string-22.13 {string wordstart, unicode} {
+ string wordstart "\uc700\uc700 abc" 8
+} 3
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
-test string-15.1 {error conditions} {
- list [catch {string gorp a b} msg] $msg
-} {1 {bad option "gorp": must be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test string-15.2 {error conditions} {
- list [catch {string} msg] $msg
-} {1 {wrong # args: should be "string option arg ?arg ...?"}}
diff --git a/tcl/tests/stringObj.test b/tcl/tests/stringObj.test
index d906d3d66fd..7368fe2240a 100644
--- a/tcl/tests/stringObj.test
+++ b/tcl/tests/stringObj.test
@@ -7,20 +7,25 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testobj] == {}} {
puts "This application hasn't been compiled with the \"testobj\""
puts "command, so I can't test the Tcl type and object support."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
test stringObj-1.1 {string type registration} {
set t [testobj types]
set first [string first "string" $t]
@@ -161,20 +166,30 @@ test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {
list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}
-test stringObj-7.1 {ConvertToStringType procedure} {
+test stringObj-7.1 {SetStringFromAny procedure} {
testobj freeallvars
teststringobj set2 1 [list a b]
teststringobj append 1 x -1
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {4 8 {a bx}}
-test stringObj-7.2 {ConvertToStringType procedure, null object} {
+test stringObj-7.2 {SetStringFromAny procedure, null object} {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 {}
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {0 0 {}}
+test stringObj-7.3 {SetStringFromAny called with non-string obj} {
+ set x 2345
+ list [incr x] [testobj objtype $x] [string index $x end] \
+ [testobj objtype $x]
+} {2346 int 6 string}
+test stringObj-7.4 {SetStringFromAny called with string obj} {
+ set x "abcdef"
+ list [string length $x] [testobj objtype $x] \
+ [string length $x] [testobj objtype $x]
+} {6 string 6 string}
test stringObj-8.1 {DupStringInternalRep procedure} {
testobj freeallvars
@@ -182,8 +197,239 @@ test stringObj-8.1 {DupStringInternalRep procedure} {
teststringobj append 1 abcde -1
testobj duplicate 1 2
list [teststringobj length 1] [teststringobj length2 1] \
+ [teststringobj ualloc 1] [teststringobj get 1] \
[teststringobj length 2] [teststringobj length2 2] \
- [teststringobj get 2]
-} {5 10 5 5 abcde}
+ [teststringobj ualloc 2] [teststringobj get 2]
+} {5 10 0 abcde 5 5 0 abcde}
+test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} {
+ set x abcï¿®ghi
+ string length $x
+ set y $x
+ list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
+test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} {
+ set x abcï¿®ghi
+ set y $x
+ string length $x
+ list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
+test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} {
+ set x abcdefghi
+ string length $x
+ set y $x
+ list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string string abcdefghijkl abcdefghi string string}
+test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} {
+ set x abcdefghi
+ set y $x
+ string length $x
+ list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string string abcdefghijkl abcdefghi string string}
+
+test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {
+ set x abcï¿®ghi
+ set y ®¿ï
+ string length $x
+ list [testobj objtype $x] [testobj objtype $y] [append x $y] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string none abcï¿®ghi®¿ï ®¿ï string none}
+test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} {
+ set x abcï¿®ghi
+ string length $x
+ list [testobj objtype $x] [append x $x] [testobj objtype $x] \
+ [append x $x] [testobj objtype $x]
+} {string abcï¿®ghiabcï¿®ghi string\
+abcï¿®ghiabcï¿®ghiabcï¿®ghiabcï¿®ghi\
+string}
+test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {
+ set x abcdefghi
+ set y ®¿ï
+ string length $x
+ list [testobj objtype $x] [testobj objtype $y] [append x $y] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string none abcdefghi®¿ï ®¿ï string none}
+test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {
+ set x abcdefghi
+ set y jkl
+ string length $x
+ list [testobj objtype $x] [testobj objtype $y] [append x $y] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string none abcdefghijkl jkl string none}
+test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} {
+ set x abcdefghi
+ string length $x
+ list [testobj objtype $x] [append x $x] [testobj objtype $x] \
+ [append x $x] [testobj objtype $x]
+} {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\
+string}
+test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {
+ set x abcï¿®ghi
+ set y jkl
+ string length $x
+ list [testobj objtype $x] [testobj objtype $y] [append x $y] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string none abcï¿®ghijkl jkl string none}
+test stringObj-9.7 {TclAppendObjToObj, integer src & dest} {
+ set x [expr {4 * 5}]
+ set y [expr {4 + 5}]
+ list [testobj objtype $x] [testobj objtype $y] [append x $y] \
+ [testobj objtype $x] [append x $y] [testobj objtype $x] \
+ [testobj objtype $y]
+} {int int 209 string 2099 string int}
+test stringObj-9.8 {TclAppendObjToObj, integer src & dest} {
+ set x [expr {4 * 5}]
+ list [testobj objtype $x] [append x $x] [testobj objtype $x] \
+ [append x $x] [testobj objtype $x]
+} {int 2020 string 20202020 string}
+test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} {
+ set x abcdefghi
+ set y [expr {4 + 5}]
+ string length $x
+ list [testobj objtype $x] [testobj objtype $y] [append x $y] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string int abcdefghi9 9 string int}
+test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} {
+ set x abcï¿®ghi
+ set y [expr {4 + 5}]
+ string length $x
+ list [testobj objtype $x] [testobj objtype $y] [append x $y] \
+ [set y] [testobj objtype $x] [testobj objtype $y]
+} {string int abcï¿®ghi9 9 string int}
+test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} {
+ # bug 2678, in <=8.2.0, the second obj (the one to append) in
+ # Tcl_AppendObjToObj was not correctly checked to see if it was
+ # all one byte chars, so a unicode string would be added as one
+ # byte chars.
+ set x abcdef
+ set len [string length $x]
+ set y aübåcï
+ set len [string length $y]
+ append x $y
+ string length $x
+ set q {}
+ for {set i 0} {$i < 12} {incr i} {
+ lappend q [string index $x $i]
+ }
+ set q
+} {a b c d e f a ü b å c ï}
+
+test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {
+ set x "abcdef"
+ list [testobj objtype $x] [set y [string range $x 1 end-1]] \
+ [testobj objtype $x] [testobj objtype $y]
+} [list none bcde string string]
+test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {
+ # Because this test does not use \uXXXX notation below instead of
+ # hardcoding the values, it may fail in multibyte locales. However,
+ # we need to test that the parser produces untyped objects even when there
+ # are high-ASCII characters in the input (like "ï"). I don't know what
+ # else to do but inline those characters here.
+ set x "abcïïdef"
+ list [testobj objtype $x] [set y [string range $x 1 end-1]] \
+ [testobj objtype $x] [testobj objtype $y]
+} [list none "bc\u00EF\u00EFde" string string]
+test stringObj-10.3 {Tcl_GetRange with some mixed width chars} {
+ # set x "abcïïdef"
+ # Use \uXXXX notation below instead of hardcoding the values, otherwise
+ # the test will fail in multibyte locales.
+ set x "abc\u00EF\u00EFdef"
+ string length $x
+ list [testobj objtype $x] [set y [string range $x 1 end-1]] \
+ [testobj objtype $x] [testobj objtype $y]
+} [list string "bc\u00EF\u00EFde" string string]
+test stringObj-10.4 {Tcl_GetRange with some mixed width chars} {
+ # set a "ïa¿b®cï¿d®"
+ # Use \uXXXX notation below instead of hardcoding the values, otherwise
+ # the test will fail in multibyte locales.
+ set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
+ set result [list]
+ while {[string length $a] > 0} {
+ set a [string range $a 1 end-1]
+ lappend result $a
+ }
+ set result
+} [list a\u00BFb\u00AEc\u00EF\u00BFd \
+ \u00BFb\u00AEc\u00EF\u00BF \
+ b\u00AEc\u00EF \
+ \u00AEc \
+ {}]
+
+test stringObj-11.1 {UpdateStringOfString} {
+ set x 2345
+ list [string index $x end] [testobj objtype $x] [incr x] \
+ [testobj objtype $x]
+} {5 string 2346 int}
+
+test stringObj-12.1 {Tcl_GetUniChar with byte-size chars} {
+ set x "abcdefghi"
+ list [string index $x 0] [string index $x 1]
+} {a b}
+test stringObj-12.2 {Tcl_GetUniChar with byte-size chars} {
+ set x "abcdefghi"
+ list [string index $x 3] [string index $x end]
+} {d i}
+test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} {
+ set x "abcdefghi"
+ list [string index $x end] [string index $x end-1]
+} {i h}
+test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} {
+ string index "ïa¿b®c®¿dï" 0
+} "ï"
+test stringObj-12.5 {Tcl_GetUniChar} {
+ set x "ïa¿b®c®¿dï"
+ list [string index $x 4] [string index $x 0]
+} {® ï}
+test stringObj-12.6 {Tcl_GetUniChar} {
+ string index "ïa¿b®cï¿d®" end
+} "®"
+
+test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} {
+ set a ""
+ list [string length $a] [string length $a]
+} {0 0}
+test stringObj-13.2 {Tcl_GetCharLength with byte-size chars} {
+ string length "a"
+} 1
+test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} {
+ set a "abcdef"
+ list [string length $a] [string length $a]
+} {6 6}
+test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} {
+ string length "®"
+} 1
+test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} {
+ # string length "○○"
+ # Use \uXXXX notation below instead of hardcoding the values, otherwise
+ # the test will fail in multibyte locales.
+ string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
+} 6
+test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} {
+ # set a "ïa¿b®cï¿d®"
+ # Use \uXXXX notation below instead of hardcoding the values, otherwise
+ # the test will fail in multibyte locales.
+ set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
+ list [string length $a] [string length $a]
+} {10 10}
testobj freeallvars
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/subst.test b/tcl/tests/subst.test
index 79067adb904..e4e8b8eff09 100644
--- a/tcl/tests/subst.test
+++ b/tcl/tests/subst.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test subst-1.1 {basics} {
list [catch {subst} msg] $msg
@@ -84,7 +88,7 @@ test subst-7.1 {switches} {
} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
test subst-7.2 {switches} {
list [catch {subst -no bar} msg] $msg
-} {1 {bad switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
+} {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
test subst-7.3 {switches} {
list [catch {subst -bogus bar} msg] $msg
} {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}
@@ -104,3 +108,20 @@ test subst-7.7 {switches} {
set x 123
subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
} {abc $x [expr 1+2] \\\x41}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/switch.test b/tcl/tests/switch.test
index 2041dc31e19..c8ecbe7e72c 100644
--- a/tcl/tests/switch.test
+++ b/tcl/tests/switch.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test switch-1.1 {simple patterns} {
switch a a {format 1} b {format 2} c {format 3} default {format 4}
@@ -56,7 +60,7 @@ test switch-3.1 {-exact vs. -glob vs. -regexp} {
}
} exact
test switch-3.2 {-exact vs. -glob vs. -regexp} {
- switch -exact -regexp aaaab {
+ switch -regexp aaaab {
^a*b$ {concat regexp}
*b {concat glob}
aaaab {concat exact}
@@ -121,7 +125,7 @@ test switch-5.1 {errors in -regexp matching} {
aaaab {concat exact}
default {concat none}
}} msg] $msg
-} {1 {couldn't compile regular expression pattern: ?+* follows nothing}}
+} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
test switch-6.1 {backslashes in patterns} {
switch -exact {\a\$\.\[} {
@@ -177,3 +181,20 @@ test switch-8.1 {empty body} {
default {set msg 2}
}
} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/tcltest.test b/tcl/tests/tcltest.test
new file mode 100644
index 00000000000..c51c420d474
--- /dev/null
+++ b/tcl/tests/tcltest.test
@@ -0,0 +1,407 @@
+# Command line options covered:
+# -help, -verbose, -match, -skip, -file, -notfile, -constraints,
+# -limitconstraints, -preservecore, -tmpdir, -debug, -outfile,
+# -errfile, -args
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+makeFile {
+ package require tcltest
+ namespace import -force ::tcltest::*
+ test a-1.0 {test a} {
+ list 0
+ } {0}
+ test b-1.0 {test b} {
+ list 1
+ } {0}
+ test c-1.0 {test c} {knownBug} {
+ } {}
+ ::tcltest::cleanupTests
+ exit
+} test.tcl
+
+# test -help
+test tcltest-1.1 {tcltest -help} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -help} msg]
+ set result [catch {runCmd $cmd}]
+ list $result [regexp Usage $msg]
+} {1 1}
+test tcltest-1.2 {tcltest -help -something} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -help -something} msg]
+ list $result [regexp Usage $msg]
+} {1 1}
+test tcltest-1.3 {tcltest -h} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -h} msg]
+ list $result [regexp Usage $msg]
+} {1 1}
+
+# -verbose
+test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl} msg]
+ list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+ [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 0 0 1}
+test tcltest-2.1 {tcltest -v 'b'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -v 'b'} msg]
+ list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+ [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 0 0 1}
+test tcltest-2.2 {tcltest -v 'p'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -v 'p'} msg]
+ list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+ [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 0 1 0 1}
+test tcltest-2.3 {tcltest -v 's'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -v 's'} msg]
+ list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+ [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 0 0 1 1}
+test tcltest-2.4 {tcltest -v 'ps'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -verbose 'ps'} msg]
+ list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+ [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 0 1 1 1}
+test tcltest-2.5 {tcltest -v 'psb'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -v 'psb'} msg]
+ list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+ [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 1 1 1}
+
+# -match
+test tcltest-3.1 {tcltest -match 'a*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -match a* -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+} {0 1 0 0 1}
+test tcltest-3.2 {tcltest -match 'b*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -m b* -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
+} {0 0 1 0 1}
+test tcltest-3.3 {tcltest -match 'c*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -match c* -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+0.+Skipped.+3.+Failed.+0" $msg]
+} {0 0 0 1 1}
+test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -match {a* b*} -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 1 0 1}
+
+# -skip
+test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -skip a* -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
+} {0 0 1 1 1}
+test tcltest-4.2 {tcltest -skip 'b*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -s b* -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+} {0 1 0 1 1}
+test tcltest-4.3 {tcltest -skip 'c*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -skip c* -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+} {0 1 1 0 1}
+test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -skip {a* b*} -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+0.+Skipped.+3.+Failed.+0" $msg]
+} {0 0 0 1 1}
+test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -match {a* b*} -skip b* -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+} {0 1 0 0 1}
+
+# -constraints, -limitconstraints
+test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'ps'} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+2.+Skipped.+0.+Failed.+1" $msg]
+} {0 1 1 1 1}
+test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'p' -limitconstraints 1} msg]
+ list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
+ [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+} {0 0 0 1 1}
+
+makeFile {
+ package require tcltest
+ namespace import -force ::tcltest::*
+ puts $::tcltest::outputChannel "a test"
+ ::tcltest::PrintError "a really short string"
+ ::tcltest::PrintError "a really really really really really really long \
+ string containing \"quotes\" and other bad bad stuff"
+ ::tcltest::PrintError "a really really long string containing a \
+ \"Path/that/is/really/long/and/contains/no/spaces\""
+ ::tcltest::PrintError "a really really long string containing a \
+ \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\""
+ ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\""
+ exit
+} printerror.tcl
+
+# -outfile, -errfile
+test tcltest-6.1 {tcltest -outfile, -errfile defaults} {unixOrPc} {
+ catch {exec $::tcltest::tcltest printerror.tcl} msg
+ list [regexp "a test" $msg] [regexp "a really" $msg]
+} {1 1}
+test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc} {
+ catch {exec $::tcltest::tcltest printerror.tcl -outfile a.tmp} msg
+ set result1 [catch {exec grep "a test" a.tmp}]
+ set result2 [catch {exec grep "a really" a.tmp}]
+ list [regexp "a test" $msg] [regexp "a really" $msg] \
+ $result1 $result2 [file exists a.tmp] [file delete a.tmp]
+} {0 1 0 1 1 {}}
+test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc} {
+ catch {exec $::tcltest::tcltest printerror.tcl -errfile a.tmp} msg
+ set result1 [catch {exec grep "a test" a.tmp}]
+ set result2 [catch {exec grep "a really" a.tmp}]
+ list [regexp "a test" $msg] [regexp "a really" $msg] \
+ $result1 $result2 [file exists a.tmp] [file delete a.tmp]
+} {1 0 1 0 1 {}}
+test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc} {
+ catch {exec $::tcltest::tcltest printerror.tcl -o a.tmp -e b.tmp} msg
+ set result1 [catch {exec grep "a test" a.tmp}]
+ set result2 [catch {exec grep "a really" b.tmp}]
+ list [regexp "a test" $msg] [regexp "a really" $msg] \
+ $result1 $result2 \
+ [file exists a.tmp] [file delete a.tmp] \
+ [file exists b.tmp] [file delete b.tmp]
+} {0 0 0 0 1 {} 1 {}}
+
+# -debug
+test tcltest-7.1 {tcltest test.tcl -d 0} {unixOrPc} {
+ catch {exec $::tcltest::tcltest test.tcl -d 0} msg
+ regexp "Flags passed into tcltest" $msg
+} {0}
+test tcltest-7.2 {tcltest test.tcl -d 1} {unixOrPc} {
+ catch {exec $::tcltest::tcltest test.tcl -d 1 -s b*} msg
+ list [regexp userSpecifiedSkip $msg] \
+ [regexp "Flags passed into tcltest" $msg]
+} {1 0}
+test tcltest-7.3 {tcltest test.tcl -d 1} {unixOrPc} {
+ catch {exec $::tcltest::tcltest test.tcl -d 1 -m b*} msg
+ list [regexp userSpecifiedNonMatch $msg] \
+ [regexp "Flags passed into tcltest" $msg]
+} {1 0}
+test tcltest-7.4 {tcltest test.tcl -d 2} {unixOrPc} {
+ catch {exec $::tcltest::tcltest test.tcl -d 2} msg
+ list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
+} {1 0}
+test tcltest-7.5 {tcltest test.tcl -d 3} {unixOrPc} {
+ catch {exec $::tcltest::tcltest test.tcl -d 3} msg
+ list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
+} {1 1}
+
+makeFile {
+ package require tcltest
+ namespace import -force ::tcltest::*
+ makeFile {} a.tmp
+ exit
+} a.tcl
+
+makeFile {} thisdirectoryisafile
+
+# -tmpdir
+test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} {
+ file delete -force thisdirectorydoesnotexist
+ exec $::tcltest::tcltest a.tcl -tmpdir thisdirectorydoesnotexist
+ list [file exists [file join thisdirectorydoesnotexist a.tmp]] \
+ [file delete -force thisdirectorydoesnotexist]
+} {1 {}}
+test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {unixOrPc} {
+ catch {exec $::tcltest::tcltest a.tcl -tmpdir thisdirectoryisafile} msg
+ # The join is necessary because the message can be split on multiple lines
+ list [regexp "not a directory" [join $msg]]
+} {1}
+
+# Test non-writeable directories, non-readable directories with tmpdir
+set notReadableDir [file join $::tcltest::temporaryDirectory notreadable]
+set notWriteableDir [file join $::tcltest::temporaryDirectory notwriteable]
+
+::tcltest::makeDirectory notreadable
+::tcltest::makeDirectory notwriteable
+
+switch $tcl_platform(platform) {
+ "unix" {
+ file attributes $notReadableDir -permissions 00333
+ file attributes $notWriteableDir -permissions 00555
+ }
+ default {
+ file attributes $notWriteableDir -readonly 1
+ }
+}
+
+test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly} {
+ catch {exec $::tcltest::tcltest a.tcl -tmpdir $notReadableDir} msg
+ # The join is necessary because the message can be split on multiple lines
+ list [regexp {not readable} [join $msg]]
+} {1}
+
+test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc} {
+ catch {exec $::tcltest::tcltest a.tcl -tmpdir $notWriteableDir} msg
+ # The join is necessary because the message can be split on multiple lines
+ list [regexp {not writeable} [join $msg]]
+} {1}
+
+# -testdir
+test tcltest-8.5 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
+ file delete -force thisdirectorydoesnotexist
+ catch {exec $::tcltest::tcltest a.tcl -testdir thisdirectorydoesnotexist} msg
+ list [regexp "does not exist" [join $msg]]
+} {1}
+
+test tcltest-8.6 {tcltest a.tcl -testdir thisdirectoryisafile} {
+ catch {exec $::tcltest::tcltest a.tcl -testdir thisdirectoryisafile} msg
+ # The join is necessary because the message can be split on multiple lines
+ list [regexp "not a directory" [join $msg]]
+} {1}
+
+test tcltest-8.7 {tcltest a.tcl -testdir notReadableDir} {unixOnly} {
+ catch {exec $::tcltest::tcltest a.tcl -testdir $notReadableDir} msg
+ # The join is necessary because the message can be split on multiple lines
+ list [regexp {not readable} [join $msg]]
+} {1}
+
+
+switch $tcl_platform(platform) {
+ "unix" {
+ file attributes $notReadableDir -permissions 777
+ file attributes $notWriteableDir -permissions 777
+ }
+ default {
+ file attributes $notWriteableDir -readonly 0
+ }
+}
+
+file delete -force $notReadableDir $notWriteableDir
+
+# -file -notfile
+test tcltest-9.1 {-file a*.tcl} {unixOrPc} {
+ catch {exec $::tcltest::tcltest \
+ [file join $::tcltest::testsDirectory all.tcl] -file a*.test} msg
+ list [regexp assocd\.test $msg]
+} {1}
+test tcltest-9.2 {-file a*.tcl} {unixOrPc} {
+ catch {exec $::tcltest::tcltest \
+ [file join $::tcltest::testsDirectory all.tcl] \
+ -file a*.test -notfile assocd*} msg
+ list [regexp assocd\.test $msg]
+} {0}
+
+
+
+makeFile {
+ package require tcltest
+ namespace import -force ::tcltest::*
+
+ test makecore {make a core file} {
+ set f [open core w]
+ close $f
+ } {}
+ ::tcltest::cleanupTests
+ return
+} makecore.tcl
+
+# -preservecore
+test tcltest-10.1 {-preservecore 0} {unixOrPc} {
+ catch {exec $::tcltest::tcltest makecore.tcl -preservecore 0} msg
+ file delete core
+ regexp "produced core file" $msg
+} {0}
+test tcltest-10.2 {-preservecore 1} {unixOrPc} {
+ catch {exec $::tcltest::tcltest makecore.tcl -preservecore 1} msg
+ file delete core
+ regexp "produced core file" $msg
+} {1}
+test tcltest-10.3 {-preservecore 2} {unixOrPc} {
+ catch {exec $::tcltest::tcltest makecore.tcl -preservecore 2} msg
+ file delete core
+ list [regexp "==== makecore produced core file" $msg] [regexp "Moving file to" $msg] \
+ [regexp "core-" $msg] [file delete core-makecore]
+} {1 1 1 {}}
+test tcltest-10.4 {-preservecore 3} {unixOrPc} {
+ catch {exec $::tcltest::tcltest makecore.tcl -preservecore 3} msg
+ file delete core
+ list [regexp "produced core file" $msg] [regexp "Moving file to" $msg] \
+ [regexp "core-" $msg] [file delete core-makecore]
+} {1 1 1 {}}
+
+makeFile {
+ package require tcltest
+ namespace import -force ::tcltest::*
+ puts "=$::tcltest::parameters="
+ exit
+} args.tcl
+
+# -args
+test tcltest-11.1 {-args foo} {unixOrPc} {
+ catch {exec $::tcltest::tcltest args.tcl -args foo} msg
+ list $msg
+} {=foo=}
+
+test tcltest-11.2 {-args {}} {unixOrPc} {
+ catch {exec $::tcltest::tcltest args.tcl -args {}} msg
+ list $msg
+} {==}
+
+test tcltest-11.3 {-args {-foo bar -baz}} {unixOrPc} {
+ catch {exec $::tcltest::tcltest args.tcl -args {-foo bar -baz}} msg
+ list $msg
+} {{=-foo bar -baz=}}
+
+# -load -loadfile
+makeFile {
+ package require tcltest
+ namespace import -force ::tcltest::*
+ puts $::tcltest::loadScript
+ exit
+} load.tcl
+
+test tcltest-12.1 {-load xxx} {
+ catch {exec $::tcltest::tcltest load.tcl -load xxx} msg
+ set msg
+} {xxx}
+
+test tcltest-12.1 {-loadfile load.tcl} {
+ catch {exec $::tcltest::tcltest load.tcl -d 2 -loadfile load.tcl} msg
+ list \
+ [regexp {tcltest} [join $msg [split $msg \n]]] \
+ [regexp {loadScript} [join $msg [split $msg \n]]]
+} {1 1}
+
+# Begin testing of tcltest procs ...
+
+# PrintError
+test tcltest-20.1 {PrintError} {unixOrPc} {
+ set result [catch {exec $::tcltest::tcltest printerror.tcl} msg]
+ list $result [regexp "Error: a really short string" $msg] \
+ [regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \
+ [regexp " \"Really" $msg] [regexp Problem $msg]
+} {1 1 1 1 1 1}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/thread.test b/tcl/tests/thread.test
new file mode 100644
index 00000000000..70c616a6d24
--- /dev/null
+++ b/tcl/tests/thread.test
@@ -0,0 +1,236 @@
+# Commands covered: (test)thread
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# Some tests require the testthread command
+
+set ::tcltest::testConstraints(testthread) \
+ [expr {[info commands testthread] != {}}]
+
+if {$::tcltest::testConstraints(testthread)} {
+
+ testthread errorproc ThreadError
+
+ proc ThreadError {id info} {
+ global threadError
+ set threadError $info
+ }
+
+ proc ThreadNullError {id info} {
+ # ignore
+ }
+}
+
+
+test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
+ list [catch {testthread} msg] $msg
+} {1 {wrong # args: should be "testthread option ?args?"}}
+
+test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
+ list [catch {testthread foo} msg] $msg
+} {1 {bad option "foo": must be create, exit, id, names, send, wait, or errorproc}}
+
+test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {testthread} {
+ list [threadReap] [llength [testthread names]]
+} {1 1}
+
+test thread-1.4 {Tcl_ThreadObjCmd: thread create } {testthread} {
+ threadReap
+ set serverthread [testthread create]
+ update
+ set numthreads [llength [testthread names]]
+ threadReap
+ set numthreads
+} {2}
+
+test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {testthread} {
+ threadReap
+ testthread create {set x 5}
+ foreach try {0 1 2 4 5 6} {
+ # Try various ways to yeild
+ update
+ after 10
+ set l [llength [testthread names]]
+ if {$l == 1} {
+ break
+ }
+ }
+ threadReap
+ set l
+} {1}
+
+test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {testthread} {
+ threadReap
+ testthread create {testthread exit}
+ update
+ after 10
+ set result [llength [testthread names]]
+ threadReap
+ set result
+} {1}
+
+test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {testthread} {
+ set x [catch {testthread id x} msg]
+ list $x $msg
+} {1 {wrong # args: should be "testthread id"}}
+
+test thread-1.8 {Tcl_ThreadObjCmd: thread id} {testthread} {
+ string compare [testthread id] $::tcltest::mainThread
+} {0}
+
+test thread-1.9 {Tcl_ThreadObjCmd: thread names args} {testthread} {
+ set x [catch {testthread names x} msg]
+ list $x $msg
+} {1 {wrong # args: should be "testthread names"}}
+
+test thread-1.10 {Tcl_ThreadObjCmd: thread id} {testthread} {
+ string compare [testthread names] $::tcltest::mainThread
+} {0}
+
+test thread-1.11 {Tcl_ThreadObjCmd: send args} {testthread} {
+ set x [catch {testthread send} msg]
+ list $x $msg
+} {1 {wrong # args: should be "testthread send ?-async? id script"}}
+
+test thread-1.12 {Tcl_ThreadObjCmd: send nonint} {testthread} {
+ set x [catch {testthread send abc command} msg]
+ list $x $msg
+} {1 {expected integer but got "abc"}}
+
+test thread-1.13 {Tcl_ThreadObjCmd: send args} {testthread} {
+ threadReap
+ set serverthread [testthread create]
+ set five [testthread send $serverthread {set x 5}]
+ threadReap
+ set five
+} 5
+
+test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {testthread} {
+ set tid [expr $::tcltest::mainThread + 10]
+ set x [catch {testthread send $tid {set x 5}} msg]
+ list $x $msg
+} {1 {invalid thread id}}
+
+test thread-1.15 {Tcl_ThreadObjCmd: wait} {testthread} {
+ threadReap
+ set serverthread [testthread create {set z 5 ; testthread wait}]
+ set five [testthread send $serverthread {set z}]
+ threadReap
+ set five
+} 5
+
+test thread-1.16 {Tcl_ThreadObjCmd: errorproc args} {testthread} {
+ set x [catch {testthread errorproc foo bar} msg]
+ list $x $msg
+} {1 {wrong # args: should be "testthread errorproc proc"}}
+
+test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {testthread} {
+ testthread errorproc foo
+ testthread errorproc ThreadError
+} {}
+
+# The tests above also cover:
+# TclCreateThread, except when pthread_create fails
+# NewThread, safe and regular
+# ThreadErrorProc, except for printing to standard error
+
+test thread-2.1 {ListUpdateInner and ListRemove} {testthread} {
+ threadReap
+ catch {unset tid}
+ foreach t {0 1 2} {
+ upvar #0 t$t tid
+ set tid [testthread create]
+ }
+ threadReap
+} 1
+
+test thread-3.1 {TclThreadList} {testthread} {
+ threadReap
+ catch {unset tid}
+ set len [llength [testthread names]]
+ set l1 {}
+ foreach t {0 1 2} {
+ lappend l1 [testthread create]
+ }
+ set l2 [testthread names]
+ list $l1 $l2
+ set c [string compare \
+ [lsort -integer [concat $::tcltest::mainThread $l1]] \
+ [lsort -integer $l2]]
+ threadReap
+ list $len $c
+} {1 0}
+
+test thread-4.1 {TclThreadSend to self} {testthread} {
+ catch {unset x}
+ testthread send [testthread id] {
+ set x 4
+ }
+ set x
+} {4}
+
+test thread-4.2 {TclThreadSend -async} {testthread} {
+ threadReap
+ set len [llength [testthread names]]
+ set serverthread [testthread create]
+ testthread send -async $serverthread {
+ after 1000
+ testthread exit
+ }
+ set two [llength [testthread names]]
+ after 1500 {set done 1}
+ vwait done
+ threadReap
+ list $len [llength [testthread names]] $two
+} {1 1 2}
+
+test thread-4.3 {TclThreadSend preserve errorInfo} {testthread} {
+ threadReap
+ set len [llength [testthread names]]
+ set serverthread [testthread create]
+ set x [catch {testthread send $serverthread {set undef}} msg]
+ threadReap
+ list $len $x $msg $errorInfo
+} {1 1 {can't read "undef": no such variable} {can't read "undef": no such variable
+ while executing
+"set undef"
+ invoked from within
+"testthread send $serverthread {set undef}"}}
+
+test thread-4.4 {TclThreadSend preserve code} {testthread} {
+ threadReap
+ set len [llength [testthread names]]
+ set serverthread [testthread create]
+ set x [catch {testthread send $serverthread {break}} msg]
+ threadReap
+ list $len $x $msg $errorInfo
+} {1 3 {} {}}
+
+test thread-4.5 {TclThreadSend preserve errorCode} {testthread} {
+ threadReap
+ set ::tcltest::mainThread [testthread names]
+ set serverthread [testthread create]
+ set x [catch {testthread send $serverthread {error ERR INFO CODE}} msg]
+ threadReap
+ list $x $msg $errorCode
+} {1 ERR CODE}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/timer.test b/tcl/tests/timer.test
index 5d803746555..23dca314cdf 100644
--- a/tcl/tests/timer.test
+++ b/tcl/tests/timer.test
@@ -8,13 +8,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test timer-1.1 {Tcl_CreateTimerHandler procedure} {
foreach i [after info] {
@@ -333,12 +337,93 @@ test timer-6.21 {Tcl_AfterCmd, info option} {
test timer-6.22 {Tcl_AfterCmd, info option} {
list [after info $event1] [after info $event2]
} {{{event 1} idle} {{event 2} timer}}
+
after cancel $event1
after cancel $event2
interp delete x
+test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ set x "hello world"
+ after 1 "set x ab\0cd"
+ after 10
+ update
+ string length $x
+} {5}
+test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NULL} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ set x "hello world"
+ after 1 set x ab\0cd
+ after 10
+ update
+ string length $x
+} {5}
+test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ set x "hello world"
+ after 1 set x ab\0cd
+ after cancel "set x ab\0ef"
+ set x [llength [after info]]
+ foreach i [after info] {
+ after cancel $i
+ }
+ set x
+} {1}
+test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ set x "hello world"
+ after 1 set x ab\0cd
+ after cancel set x ab\0ef
+ set y [llength [after info]]
+ foreach i [after info] {
+ after cancel $i
+ }
+ set y
+} {1}
+test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NULL} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ set x "hello world"
+ after idle "set x ab\0cd"
+ update
+ string length $x
+} {5}
+test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NULL} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ set x "hello world"
+ after idle set x ab\0cd
+ update
+ string length $x
+} {5}
+test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} {
+ foreach i [after info] {
+ after cancel $i
+ }
+ set x "hello world"
+ set id junk
+ set id [after 10 set x ab\0cd]
+ update
+ set y [string length [lindex [lindex [after info $id] 0] 2]]
+ foreach i [after info] {
+ after cancel $i
+ }
+ set y
+} {5}
+
set event [after idle foo bar]
scan $event after#%d id
+
test timer-7.1 {GetAfterEvent procedure} {
list [catch {after info xfter#$id} msg] $msg
} "1 {event \"xfter#$id\" doesn't exist}"
@@ -453,3 +538,19 @@ test timer-9.1 {AfterCleanupProc procedure} {
set x
} {before after2 after4}
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/trace.test b/tcl/tests/trace.test
index 43773571df1..c2915fe260d 100644
--- a/tcl/tests/trace.test
+++ b/tcl/tests/trace.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
proc traceScalar {name1 name2 op} {
global info
@@ -610,10 +614,10 @@ test trace-12.1 {delete one trace from another} {
test trace-13.1 {trace command (overall)} {
list [catch {trace} msg] $msg
-} {1 {too few args: should be "trace option [arg arg ...]"}}
+} {1 {wrong # args: should be "trace option [arg arg ...]"}}
test trace-13.2 {trace command (overall)} {
list [catch {trace gorp} msg] $msg
-} {1 {bad option "gorp": should be variable, vdelete, or vinfo}}
+} {1 {bad option "gorp": must be variable, vdelete, or vinfo}}
test trace-13.3 {trace command ("variable" option)} {
list [catch {trace variable x y} msg] $msg
} {1 {wrong # args: should be "trace variable name ops command"}}
@@ -963,4 +967,20 @@ test trace-17.1 {unset traces on procedure returns} {
catch {unset x}
catch {unset y}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/unixFCmd.test b/tcl/tests/unixFCmd.test
index 02288a46f8a..adc0c7f26bc 100644
--- a/tcl/tests/unixFCmd.test
+++ b/tcl/tests/unixFCmd.test
@@ -11,16 +11,21 @@
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-if {$tcl_platform(platform) != "unix"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
-if {$user == "root"} {
- puts "Skipping unixFCmd tests. They depend on not being able to write to"
- puts "certain directories. It would be too dangerous to run them as root."
- return
+# Several tests require need to match results against the unix username
+set user {}
+if {$tcl_platform(platform) == "unix"} {
+ catch {set user [exec whoami]}
+ if {$user == ""} {
+ catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+ }
+ if {$user == ""} {
+ set user "root"
+ }
}
proc openup {path} {
@@ -49,7 +54,7 @@ proc cleanup {args} {
}
}
-test unixFCmd-1.1 {TclpRenameFile: EACCES} {
+test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} {
cleanup
file mkdir td1/td2/td3
exec chmod 000 td1/td2
@@ -57,46 +62,45 @@ test unixFCmd-1.1 {TclpRenameFile: EACCES} {
exec chmod 755 td1/td2
set msg
} {1 {error renaming "td1/td2/td3": permission denied}}
-test unixFCmd-1.2 {TclpRenameFile: EEXIST} {
+test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} {
cleanup
file mkdir td1/td2
file mkdir td2
list [catch {file rename td2 td1} msg] $msg
} {1 {error renaming "td2" to "td1/td2": file already exists}}
-test unixFCmd-1.3 {TclpRenameFile: EINVAL} {
+test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly notRoot} {
cleanup
file mkdir td1
list [catch {file rename td1 td1} msg] $msg
} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
-test unixFCmd-1.4 {TclpRenameFile: EISDIR} {
+test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unixOnly notRoot} {
# can't make it happen
} {}
-test unixFCmd-1.5 {TclpRenameFile: ENOENT} {
+test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unixOnly notRoot} {
cleanup
file mkdir td1
list [catch {file rename td2 td1} msg] $msg
} {1 {error renaming "td2": no such file or directory}}
-test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {
+test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unixOnly notRoot} {
# can't make it happen
} {}
-test unixFCmd-1.7 {TclpRenameFile: EXDEV} {
+test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly notRoot} {
cleanup
file mkdir foo/bar
file attr foo -perm 040555
- set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
- set a1 {1 {can't unlink "foo/bar": permission denied}}
- set result [expr {$msg == $a1}]
+ set catchResult [catch {file rename foo/bar /tmp} msg]
+ set msg [lindex [split $msg :] end]
catch {file delete /tmp/bar}
catch {file attr foo -perm 040777}
catch {file delete -force foo}
- set result
-} {1}
-test unixFCmd-1.8 {Checking EINTR Bug} nonPortable {
+ list $catchResult $msg
+} {1 { permission denied}}
+test unixFCmd-1.8 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
testalarm
after 2000
list [testgotsig] [testgotsig]
} {1 0}
-test unixFCmd-1.9 {Checking EINTR Bug} nonPortable {
+test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
cleanup
set f [open tfalarm w]
puts $f {
@@ -111,19 +115,20 @@ test unixFCmd-1.9 {Checking EINTR Bug} nonPortable {
catch {close $pipe}
list $line [testgotsig]
} {h 1}
-test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} {
+test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
+ {unixOnly notRoot} {
cleanup
exec touch tf1
exec touch tf2
file copy -force tf1 tf2
} {}
-test unixFCmd-2.2 {TclpCopyFile: src is symlink} {
+test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {
cleanup
exec ln -s tf1 tf2
file copy tf2 tf3
file type tf3
} {link}
-test unixFCmd-2.3 {TclpCopyFile: src is block} {
+test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} {
cleanup
set null "/dev/null"
while {[file type $null] != "characterSpecial"} {
@@ -131,7 +136,7 @@ test unixFCmd-2.3 {TclpCopyFile: src is block} {
}
# file copy $null tf1
} {}
-test unixFCmd-2.4 {TclpCopyFile: src is fifo} {
+test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} {
cleanup
if [catch {exec mknod tf1 p}] {
list 1
@@ -140,7 +145,7 @@ test unixFCmd-2.4 {TclpCopyFile: src is fifo} {
expr {"[file type tf1]" == "[file type tf2]"}
}
} {1}
-test unixFCmd-2.5 {TclpCopyFile: copy attributes} {
+test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} {
cleanup
exec touch tf1
exec chmod 472 tf1
@@ -148,111 +153,149 @@ test unixFCmd-2.5 {TclpCopyFile: copy attributes} {
string range [exec ls -l tf2] 0 9
} {-r--rwx-w-}
-test unixFCmd-3.1 {CopyFile not done} {
+test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-4.1 {TclpDeleteFile not done} {
+test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-5.1 {TclpCreateDirectory not done} {
+test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-6.1 {TclpCopyDirectory not done} {
+test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-7.1 {TclpRemoveDirectory not done} {
+test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-8.1 {TraverseUnixTree not done} {
+test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-9.1 {TraversalCopy not done} {
+test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-10.1 {TraversalDelete not done} {
+test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} {
} {}
-test unixFCmd-11.1 {CopyFileAttrs not done} {
+test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} {
} {}
-set testConfig(tclGroup) 0
-if {[catch {exec {groups}} groupList] == 0} {
- if {[lsearch $groupList tcl] != -1} {
- set testConfig(tclGroup) 1
- }
-}
-
-test unixFCmd-12.1 {GetGroupAttribute - file not found} {
+test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not stat file "foo.test": no such file or directory}}
-test unixFCmd-12.2 {GetGroupAttribute - file found} {
+} {1 {could not read "foo.test": no such file or directory}}
+test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
} {0 {}}
-test unixFCmd-13.1 {GetOwnerAttribute - file not found} {
+test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not stat file "foo.test": no such file or directory}}
-test unixFCmd-13.2 {GetOwnerAttribute} {
+} {1 {could not read "foo.test": no such file or directory}}
+test unixFCmd-13.2 {GetOwnerAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -owner} msg] [string compare $msg $user] [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -owner} msg] \
+ [string compare $msg $user] [file delete -force -- foo.test]
} {0 0 {}}
-test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {
+test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -permissions} msg] $msg
-} {1 {could not stat file "foo.test": no such file or directory}}
-test unixFCmd-14.2 {GetPermissionsAttribute} {
+} {1 {could not read "foo.test": no such file or directory}}
+test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attribute foo.test -permissions}] [file delete -force -- foo.test]
+ list [catch {file attribute foo.test -permissions}] \
+ [file delete -force -- foo.test]
} {0 {}}
+# Find a group that exists on this system, or else skip tests that require
+# groups
+set ::tcltest::testConstraints(foundGroup) 0
+catch {
+ set groupList [exec groups]
+ set group [lindex $groupList 0]
+ set ::tcltest::testConstraints(foundGroup) 1
+}
+
#groups hard to test
-test unixFCmd-15.1 {SetGroupAttribute - invalid group} {
+test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -group foozzz} msg] $msg [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -group foozzz} msg] \
+ $msg [file delete -force -- foo.test]
} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
-test unixFCmd-15.2 {SetGroupAttribute - invalid file} {tclGroup} {
+test unixFCmd-15.2 {SetGroupAttribute - invalid file} \
+ {unixOnly notRoot foundGroup} {
catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -group tcl} msg] $msg
+ list [catch {file attributes foo.test -group $group} msg] $msg
} {1 {could not set group for file "foo.test": no such file or directory}}
#changing owners hard to do
-test unixFCmd-16.1 {SetOwnerAttribute - current owner} {
+test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -owner $user} msg] $msg [string compare [file attributes foo.test -owner] $user] [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -owner $user} msg] \
+ $msg [string compare [file attributes foo.test -owner] $user] \
+ [file delete -force -- foo.test]
} {0 {} 0 {}}
-test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {
+test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -owner $user} msg] $msg
} {1 {could not set owner for file "foo.test": no such file or directory}}
-test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {
+test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -owner foozzz} msg] $msg
} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
-test unixFCmd-17.1 {SetPermissionsAttribute} {
+test unixFCmd-17.1 {SetPermissionsAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -permissions 0000} msg] $msg [file attributes foo.test -permissions] [file delete -force -- foo.test]
+ list [catch {file attributes foo.test -permissions 0000} msg] \
+ $msg [file attributes foo.test -permissions] \
+ [file delete -force -- foo.test]
} {0 {} 00000 {}}
-test unixFCmd-17.2 {SetPermissionsAttribute} {
+test unixFCmd-17.2 {SetPermissionsAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
list [catch {file attributes foo.test -permissions 0000} msg] $msg
} {1 {could not set permissions for file "foo.test": no such file or directory}}
-test unixFCmd-17.3 {SetPermissionsAttribute} {
+test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -permissions foo} msg] $msg \
+ [file delete -force -- foo.test]
+} {1 {unknown permission string format "foo"} {}}
+test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
- list [catch {file attributes foo.test -permissions foo} msg] $msg [file delete -force -- foo.test]
-} {1 {expected integer but got "foo"} {}}
-test unixFCmd-18.1 {Unix pwd} {nonPortable} {
+ list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \
+ [file delete -force -- foo.test]
+} {1 {unknown permission string format "---rwx"} {}}
+
+close [open foo.test w]
+set ::i 4
+proc permcheck {permstr expected} {
+ test unixFCmd-17.[incr ::i] {SetPermissionsAttribute} {unixOnly notRoot} \
+ [subst {
+ file attributes foo.test -permissions $permstr
+ file attributes foo.test -permissions
+ }
+ ] $expected
+}
+permcheck rwxrwxrwx 00777
+permcheck r--r---w- 00442
+permcheck 0 00000
+permcheck u+rwx,g+r 00740
+permcheck u-w 00540
+permcheck o+rwx 00547
+permcheck --x--x--x 00111
+permcheck a+rwx 00777
+file delete -force -- foo.test
+
+test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
# This test is nonportable because SunOS generates a weird error
# message when the current directory isn't readable.
set cd [pwd]
@@ -267,4 +310,20 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable} {
set r
} {1 {error getting working directory name:}}
+# cleanup
cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/unixFile.test b/tcl/tests/unixFile.test
index cecaedc1c4b..d9d273a70b7 100644
--- a/tcl/tests/unixFile.test
+++ b/tcl/tests/unixFile.test
@@ -4,63 +4,76 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
if {[info commands testobj] == {}} {
puts "This application hasn't been compiled with the \"testfindexecutable\""
puts "command, so I can't test the Tcl_FindExecutable function"
+ ::tcltest::cleanupTests
return
}
-if {$tcl_platform(platform) != "unix"} {
- return
+catch {
+ set oldPath $env(PATH)
+ close [open junk w]
+ file attributes junk -perm 0777
}
-
-
-set oldPath $env(PATH)
-close [open junk w]
-file attributes junk -perm 0777
-
set absPath [file join [pwd] junk]
-test unixFile-1.1 {Tcl_FindExecutable} {
+
+test unixFile-1.1 {Tcl_FindExecutable} {unixOnly} {
set env(PATH) ""
testfindexecutable junk
} $absPath
-test unixFile-1.2 {Tcl_FindExecutable} {
+test unixFile-1.2 {Tcl_FindExecutable} {unixOnly} {
set env(PATH) "/dummy"
testfindexecutable junk
} {}
-test unixFile-1.3 {Tcl_FindExecutable} {
+test unixFile-1.3 {Tcl_FindExecutable} {unixOnly} {
set env(PATH) "/dummy:[pwd]"
testfindexecutable junk
} $absPath
-test unixFile-1.4 {Tcl_FindExecutable} {
+test unixFile-1.4 {Tcl_FindExecutable} {unixOnly} {
set env(PATH) "/dummy:"
testfindexecutable junk
} $absPath
-test unixFile-1.5 {Tcl_FindExecutable} {
+test unixFile-1.5 {Tcl_FindExecutable} {unixOnly} {
set env(PATH) "/dummy:/dummy"
testfindexecutable junk
} {}
-test unixFile-1.6 {Tcl_FindExecutable} {
+test unixFile-1.6 {Tcl_FindExecutable} {unixOnly} {
set env(PATH) "/dummy::/dummy"
testfindexecutable junk
} $absPath
-test unixFile-1.7 {Tcl_FindExecutable} {
+test unixFile-1.7 {Tcl_FindExecutable} {unixOnly} {
set env(PATH) ":/dummy"
testfindexecutable junk
} $absPath
+# cleanup
+catch {set env(PATH) $oldPath}
+file delete junk
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
-set env(PATH) $oldPath
-file delete junk
diff --git a/tcl/tests/unixInit.test b/tcl/tests/unixInit.test
new file mode 100644
index 00000000000..40068ac038f
--- /dev/null
+++ b/tcl/tests/unixInit.test
@@ -0,0 +1,209 @@
+# The file tests the functions in the tclUnixInit.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+if {[info exists env(TCL_LIBRARY)]} {
+ set oldlibrary $env(TCL_LIBRARY)
+ unset env(TCL_LIBRARY)
+}
+catch {set oldlang $env(LANG)}
+set env(LANG) C
+
+# Some tests will fail if they are run on a machine that doesn't have
+# this Tcl version installed (as opposed to built) on it.
+if {[catch {
+ set f [open "|[list $::tcltest::tcltest exit]" w+]
+ exec kill -PIPE [pid $f]
+ close $f
+}]} {
+ set ::tcltest::testConstraints(installedTcl) 0
+} else {
+ set ::tcltest::testConstraints(installedTcl) 1
+}
+
+test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
+ set x {}
+
+ # Watch out for a race condition here. If tcltest is too slow to start
+ # then we'll kill it before it has a chance to set up its signal handler.
+
+ set f [open "|[list $::tcltest::tcltest]" w+]
+ puts $f "puts hi"
+ flush $f
+ gets $f
+ exec kill -PIPE [pid $f]
+ lappend x [catch {close $f}]
+
+ set f [open "|[list $::tcltest::tcltest]" w+]
+ puts $f "puts hi"
+ flush $f
+ gets $f
+ exec kill [pid $f]
+ lappend x [catch {close $f}]
+
+ set x
+} {0 1}
+
+proc getlibpath "{program [list $::tcltest::tcltest]}" {
+ set f [open "|$program" w+]
+ fconfigure $f -buffering none
+ puts $f {puts $tcl_libPath; exit}
+ set path [gets $f]
+ close $f
+ return $path
+}
+
+# Some tests require the testgetdefenc command
+
+set ::tcltest::testConstraints(testgetdefenc) \
+ [expr {[info commands testgetdefenc] != {}}]
+
+test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \
+ {unixOnly testgetdefenc} {
+ set origDir [testgetdefenc]
+ testsetdefenc slappy
+ set path [testgetdefenc]
+ testsetdefenc $origDir
+ set path
+} {slappy}
+test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \
+ {unixOnly installedTcl} {
+ set path [getlibpath]
+
+ set installLib lib/tcl[info tclversion]
+ if {[string match {*[ab]*} [info patchlevel]]} {
+ set developLib tcl[info patchlevel]/library
+ } else {
+ set developLib tcl[info tclversion]/library
+ }
+ set prefix [file dirname [file dirname $::tcltest::tcltest]]
+
+ set x {}
+ lappend x [string compare [lindex $path 0] $prefix/$installLib]
+ lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib]
+ set x
+} {0 0}
+test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly installedTcl} {
+ # ((str != NULL) && (str[0] != '\0'))
+
+ set env(TCL_LIBRARY) sparkly
+ set path [getlibpath]
+ unset env(TCL_LIBRARY)
+
+ lindex $path 0
+} "sparkly"
+test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} \
+ {unixOnly installedTcl} {
+ # ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
+
+ set env(TCL_LIBRARY) /a/b/tcl1.7
+ set path [getlibpath]
+ unset env(TCL_LIBRARY)
+
+ lrange $path 0 1
+} [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
+test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} \
+ {unixOnly installedTcl} {
+ # Child process translates env variable from native encoding.
+
+ set env(TCL_LIBRARY) "\xa7"
+ set x [lindex [getlibpath] 0]
+ unset env(TCL_LIBRARY)
+ unset env(LANG)
+
+ set x
+} "\xa7"
+test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} \
+ {emptyTest unixOnly} {
+ # cannot test
+} {}
+test unixInit-2.6 {TclpInitLibraryPath: executable relative} \
+ {unixOnly installedTcl} {
+ file delete -force /tmp/sparkly
+ file mkdir /tmp/sparkly/bin
+ file copy $::tcltest::tcltest /tmp/sparkly/bin/tcltest
+
+ file mkdir /tmp/sparkly/lib/tcl[info tclversion]
+ close [open /tmp/sparkly/lib/tcl[info tclversion]/init.tcl w]
+
+ set x [lrange [getlibpath /tmp/sparkly/bin/tcltest] 0 1]
+ file delete -force /tmp/sparkly
+ set x
+} [list /tmp/sparkly/lib/tcl[info tclversion] /tmp/lib/tcl[info tclversion]]
+test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \
+ {emptyTest unixOnly} {
+ # would need test command to get defaultLibDir and compare it to
+ # [lindex $auto_path end]
+} {}
+test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} {
+ set env(LANG) C
+
+ set f [open "|[list $::tcltest::tcltest]" w+]
+ fconfigure $f -buffering none
+ puts $f {puts [encoding system]; exit}
+ set enc [gets $f]
+ close $f
+ unset env(LANG)
+
+ set enc
+} {iso8859-1}
+test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly installedTcl} {
+ set env(LANG) japanese
+ catch {set oldlc_all $env(LC_ALL)}
+ set env(LC_ALL) japanese
+
+ set f [open "|[list $::tcltest::tcltest]" w+]
+ fconfigure $f -buffering none
+ puts $f {puts [encoding system]; exit}
+ set enc [gets $f]
+ close $f
+ unset env(LANG)
+ unset env(LC_ALL)
+ catch {set env(LC_ALL) $oldlc_all}
+
+ switch $tcl_platform(os) {
+ HP-UX {set expectedEncoding shiftjis}
+ default {set expectedEncoding euc-jp}
+ }
+ string compare $enc $expectedEncoding
+} 0
+
+test unixInit-4.1 {TclpSetVariables} {unixOnly} {
+ # just make sure they exist
+
+ set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
+ set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
+ set tcl_platform(platform)
+} "unix"
+
+test unixInit-5.1 {Tcl_Init} {emptyTest unixOnly} {
+ # test initScript
+} {}
+
+test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unixOnly} {
+} {}
+
+# cleanup
+if {[info exists oldlibrary]} {
+ set env(TCL_LIBRARY) $oldlibrary
+}
+catch {unset env(LANG); set env(LANG) $oldlang}
+::tcltest::cleanupTests
+return
+
+
diff --git a/tcl/tests/unixNotfy.test b/tcl/tests/unixNotfy.test
index 79d59b7d46d..e2fe25bd3c6 100644
--- a/tcl/tests/unixNotfy.test
+++ b/tcl/tests/unixNotfy.test
@@ -5,27 +5,36 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-if {$tcl_platform(platform) != "unix"} {
- return
-}
-
# The tests should not be run if you have a notifier which is unable to
# detect infinite vwaits, as the tests below will hang. The presence of
-# the "testeventloop" command indicates that this is the case.
+# the "testthread" command indicates that this is the case.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
-if {"[info commands testeventloop]" == "testeventloop"} {
+if {[info exists tk_version]} {
+ puts "When run in a Tk shell, these tests run hang. Skipping tests ..."
+ ::tcltest::cleanupTests
return
}
-test unixNotfy-1.1 {Tcl_DeleteFileHandler} {
+set ::tcltest::testConstraints(testthread) \
+ [expr {[info commands testthread] != {}}]
+
+# The next two tests will hang if threads are enabled because the notifier
+# will not necessarily wait for ever in this case, so it does not generate
+# an error.
+
+test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
catch {vwait x}
set f [open foo w]
fileevent $f writable {set x 1}
@@ -33,7 +42,7 @@ test unixNotfy-1.1 {Tcl_DeleteFileHandler} {
close $f
list [catch {vwait x} msg] $msg
} {1 {can't wait for variable "x": would wait forever}}
-test unixNotfy-1.2 {Tcl_DeleteFileHandler} {
+test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
catch {vwait x}
set f1 [open foo w]
set f2 [open foo2 w]
@@ -46,5 +55,53 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} {
list [catch {vwait x} msg] $msg
} {1 {can't wait for variable "x": would wait forever}}
+
+test unixNotfy-2.1 {Tcl_DeleteFileHandler} {unixOnly testthread} {
+ update
+ set f [open foo w]
+ fileevent $f writable {set x 1}
+ vwait x
+ close $f
+ testthread create "after 500
+ testthread send [testthread id] {set x ok}
+ testthread exit"
+ vwait x
+ set x
+} {ok}
+test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
+ update
+ set f1 [open foo w]
+ set f2 [open foo2 w]
+ fileevent $f1 writable {set x 1}
+ fileevent $f2 writable {set y 1}
+ vwait x
+ close $f1
+ vwait y
+ close $f2
+ testthread create "after 500
+ testthread send [testthread id] {set x ok}
+ testthread exit"
+ vwait x
+ set x
+} {ok}
+
+
+
+# cleanup
file delete foo
file delete foo2
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/unknown.test b/tcl/tests/unknown.test
index d769c315694..5a2bc4c68aa 100644
--- a/tcl/tests/unknown.test
+++ b/tcl/tests/unknown.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {unset x}
catch {rename unknown unknown.old}
@@ -56,6 +60,21 @@ test unknown-4.1 {errors in "unknown" procedure} {
list [catch {non-existent a b} msg] $msg $errorCode
} {1 {unknown failed} NONE}
+# cleanup
catch {rename unknown {}}
catch {rename unknown.old unknown}
-return {}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/uplevel.test b/tcl/tests/uplevel.test
index 986cd147443..45af2f04200 100644
--- a/tcl/tests/uplevel.test
+++ b/tcl/tests/uplevel.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
proc a {x y} {
newset z [expr $x+$y]
@@ -107,3 +111,20 @@ proc a3 {} {
a2
test uplevel-5.1 {info level} {set x} 1
test uplevel-5.2 {info level} {set y} a3
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/upvar.test b/tcl/tests/upvar.test
index e4ab63bcc60..54d6af29f1e 100644
--- a/tcl/tests/upvar.test
+++ b/tcl/tests/upvar.test
@@ -6,13 +6,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test upvar-1.1 {reading variables with upvar} {
proc p1 {a b} {set c 22; set d 33; p2}
@@ -396,4 +400,19 @@ if {[info commands testupvar] != {}} {
}
catch {unset a}
-concat
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/utf.test b/tcl/tests/utf.test
new file mode 100644
index 00000000000..4dcfdae4a34
--- /dev/null
+++ b/tcl/tests/utf.test
@@ -0,0 +1,294 @@
+# This file contains a collection of tests for tclUtf.c
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+catch {unset x}
+
+test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} {
+ set x \x01
+} [bytestring "\x01"]
+test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} {
+ set x "\x00"
+} [bytestring "\xc0\x80"]
+test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} {
+ set x "\xe0"
+} [bytestring "\xc3\xa0"]
+test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} {
+ set x "\u4e4e"
+} [bytestring "\xe4\xb9\x8e"]
+
+test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
+ string length "abc"
+} {3}
+test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} {
+ string length [bytestring "\x82\x83\x84"]
+} {3}
+test utf-2.3 {Tcl_UtfToUniChar: lead (2-byte) followed by non-trail} {
+ string length [bytestring "\xC2"]
+} {1}
+test utf-2.4 {Tcl_UtfToUniChar: lead (2-byte) followed by trail} {
+ string length [bytestring "\xC2\xa2"]
+} {1}
+test utf-2.5 {Tcl_UtfToUniChar: lead (3-byte) followed by non-trail} {
+ string length [bytestring "\xE2"]
+} {1}
+test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} {
+ string length [bytestring "\xE2\xA2"]
+} {2}
+test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} {
+ string length [bytestring "\xE4\xb9\x8e"]
+} {1}
+test utf-2.8 {Tcl_UtfToUniChar: longer UTF sequences not supported} {
+ string length [bytestring "\xF4\xA2\xA2\xA2"]
+} {4}
+
+test utf-3.1 {Tcl_UtfCharComplete} {
+} {}
+
+test utf-4.1 {Tcl_NumUtfChars: zero length} {
+ string length ""
+} {0}
+test utf-4.2 {Tcl_NumUtfChars: length 1} {
+ string length [bytestring "\xC2\xA2"]
+} {1}
+test utf-4.3 {Tcl_NumUtfChars: long string} {
+ string length [bytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"]
+} {7}
+
+test utf-5.1 {Tcl_UtfFindFirsts} {
+} {}
+
+test utf-6.1 {Tcl_UtfNext} {
+} {}
+
+test utf-7.1 {Tcl_UtfPrev} {
+} {}
+
+test utf-8.1 {Tcl_UniCharAtIndex: index = 0} {
+ string index abcd 0
+} {a}
+test utf-8.2 {Tcl_UniCharAtIndex: index = 0} {
+ string index \u4e4e\u25a 0
+} "\u4e4e"
+test utf-8.3 {Tcl_UniCharAtIndex: index > 0} {
+ string index abcd 2
+} {c}
+test utf-8.4 {Tcl_UniCharAtIndex: index > 0} {
+ string index \u4e4e\u25a\xff\u543 2
+} "\uff"
+
+test utf-9.1 {Tcl_UtfAtIndex: index = 0} {
+ string range abcd 0 2
+} {abc}
+test utf-9.2 {Tcl_UtfAtIndex: index > 0} {
+ string range \u4e4e\u25a\xff\u543klmnop 1 5
+} "\u25a\xff\u543kl"
+
+
+test utf-10.1 {Tcl_UtfBackslash: dst == NULL} {
+ set x \n
+} {
+}
+test utf-10.2 {Tcl_UtfBackslash: \u subst} {
+ set x \ua2
+} [bytestring "\xc2\xa2"]
+test utf-10.3 {Tcl_UtfBackslash: longer \u subst} {
+ set x \u4e21
+} [bytestring "\xe4\xb8\xa1"]
+test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} {
+ set x \u4e2k
+} "[bytestring \xd3\xa2]k"
+test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} {
+ set x \u4e216
+} "[bytestring \xe4\xb8\xa1]6"
+proc bsCheck {char num} {
+ global errNum
+ test utf-10.$errNum {backslash substitution} {
+ scan $char %c value
+ set value
+ } $num
+ incr errNum
+}
+set errNum 6
+bsCheck \b 8
+bsCheck \e 101
+bsCheck \f 12
+bsCheck \n 10
+bsCheck \r 13
+bsCheck \t 9
+bsCheck \v 11
+bsCheck \{ 123
+bsCheck \} 125
+bsCheck \[ 91
+bsCheck \] 93
+bsCheck \$ 36
+bsCheck \ 32
+bsCheck \; 59
+bsCheck \\ 92
+bsCheck \Ca 67
+bsCheck \Ma 77
+bsCheck \CMa 67
+# prior to 8.3, this returned 8, as \8 as accepted as an
+# octal value - but it isn't! [Bug: 3975]
+bsCheck \8a 56
+bsCheck \14 12
+bsCheck \141 97
+bsCheck b\0 98
+bsCheck \x 120
+bsCheck \xa 10
+bsCheck \xA 10
+bsCheck \x41 65
+bsCheck \x541 65
+bsCheck \u 117
+bsCheck \uk 117
+bsCheck \u41 65
+bsCheck \ua 10
+bsCheck \uA 10
+bsCheck \340 224
+bsCheck \ua1 161
+bsCheck \u4e21 20001
+
+test utf-11.1 {Tcl_UtfToUpper} {
+ string toupper {}
+} {}
+test utf-11.2 {Tcl_UtfToUpper} {
+ string toupper abc
+} ABC
+test utf-11.3 {Tcl_UtfToUpper} {
+ string toupper \u00e3ab
+} \u00c3AB
+test utf-11.4 {Tcl_UtfToUpper} {
+ string toupper \u01e3ab
+} \u01e2AB
+
+test utf-12.1 {Tcl_UtfToLower} {
+ string tolower {}
+} {}
+test utf-12.2 {Tcl_UtfToLower} {
+ string tolower ABC
+} abc
+test utf-12.3 {Tcl_UtfToLower} {
+ string tolower \u00c3AB
+} \u00e3ab
+test utf-12.4 {Tcl_UtfToLower} {
+ string tolower \u01e2AB
+} \u01e3ab
+
+test utf-13.1 {Tcl_UtfToTitle} {
+ string totitle {}
+} {}
+test utf-13.2 {Tcl_UtfToTitle} {
+ string totitle abc
+} Abc
+test utf-13.3 {Tcl_UtfToTitle} {
+ string totitle \u00e3ab
+} \u00c3ab
+test utf-13.4 {Tcl_UtfToTitle} {
+ string totitle \u01f3ab
+} \u01f2ab
+
+test utf-14.1 {Tcl_UtfNcasecmp} {
+ string compare -nocase a b
+} -1
+test utf-14.2 {Tcl_UtfNcasecmp} {
+ string compare -nocase b a
+} 1
+test utf-14.3 {Tcl_UtfNcasecmp} {
+ string compare -nocase B a
+} 1
+test utf-14.4 {Tcl_UtfNcasecmp} {
+ string compare -nocase aBcB abca
+} 1
+
+test utf-15.1 {Tcl_UniCharToUpper, negative delta} {
+ string toupper aA
+} AA
+test utf-15.2 {Tcl_UniCharToUpper, positive delta} {
+ string toupper \u0178\u00ff
+} \u0178\u0178
+test utf-15.3 {Tcl_UniCharToUpper, no delta} {
+ string toupper !
+} !
+
+test utf-16.1 {Tcl_UniCharToLower, negative delta} {
+ string tolower aA
+} aa
+test utf-16.2 {Tcl_UniCharToLower, positive delta} {
+ string tolower \u0178\u00ff
+} \u00ff\u00ff
+test utf-17.1 {Tcl_UniCharToLower, no delta} {
+ string tolower !
+} !
+
+test utf-18.1 {Tcl_UniCharToTitle, add one for title} {
+ string totitle \u01c4
+} \u01c5
+test utf-18.2 {Tcl_UniCharToTitle, subtract one for title} {
+ string totitle \u01c6
+} \u01c5
+test utf-18.3 {Tcl_UniCharToTitle, subtract delta for title (positive)} {
+ string totitle \u017f
+} \u0053
+test utf-18.4 {Tcl_UniCharToTitle, subtract delta for title (negative)} {
+ string totitle \u00ff
+} \u0178
+test utf-18.5 {Tcl_UniCharToTitle, no delta} {
+ string totitle !
+} !
+
+test utf-19.1 {TclUniCharLen} {
+ list [regexp \\d abc456def foo] $foo
+} {1 4}
+
+test utf-20.1 {TclUniCharNcmp} {
+} {}
+
+test utf-21.1 {TclUniCharIsAlnum} {
+} {}
+
+test utf-22.1 {TclUniCharIsWordChar} {
+ string wordend "xyz123_bar fg" 0
+} 10
+test utf-22.2 {TclUniCharIsWordChar} {
+ string wordend "x\u5080z123_bar\u203c fg" 0
+} 10
+
+test utf-23.1 {TclUniCharIsAlpha} {
+} {}
+
+test utf-24.1 {TclUniCharIsDigit} {
+} {}
+
+test utf-24.2 {TclUniCharIsSpace} {
+} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/util.test b/tcl/tests/util.test
index e7548f56711..ff3c1c08769 100644
--- a/tcl/tests/util.test
+++ b/tcl/tests/util.test
@@ -1,21 +1,26 @@
# This file is a Tcl script to test the code in the file tclUtil.c.
# This file is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1995-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
if {[info commands testobj] == {}} {
puts "This application hasn't been compiled with the \"testobj\""
puts "command, so I can't test the Tcl type and object support."
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then {source defs}
-
test util-1.1 {TclFindElement procedure - binary element in middle of list} {
lindex {0 foo\x00help 1} 1
} "foo\x00help"
@@ -58,26 +63,181 @@ test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
concat a { } c
} {a c}
-test util-5.1 {Tcl_SetObjErrorCode - one arg} {
- catch {testsetobjerrorcode 1}
- list [set errorCode]
-} {1}
-test util-5.2 {Tcl_SetObjErrorCode - two args} {
- catch {testsetobjerrorcode 1 2}
- list [set errorCode]
-} {{1 2}}
-test util-5.3 {Tcl_SetObjErrorCode - three args} {
- catch {testsetobjerrorcode 1 2 3}
- list [set errorCode]
-} {{1 2 3}}
-test util-5.4 {Tcl_SetObjErrorCode - four args} {
- catch {testsetobjerrorcode 1 2 3 4}
- list [set errorCode]
-} {{1 2 3 4}}
-test util-5.5 {Tcl_SetObjErrorCode - five args} {
- catch {testsetobjerrorcode 1 2 3 4 5}
- list [set errorCode]
-} {{1 2 3 4 5}}
+test util-5.1 {Tcl_StringMatch} {
+ string match ab*c abc
+} 1
+test util-5.2 {Tcl_StringMatch} {
+ string match ab**c abc
+} 1
+test util-5.3 {Tcl_StringMatch} {
+ string match ab* abcdef
+} 1
+test util-5.4 {Tcl_StringMatch} {
+ string match *c abc
+} 1
+test util-5.5 {Tcl_StringMatch} {
+ string match *3*6*9 0123456789
+} 1
+test util-5.6 {Tcl_StringMatch} {
+ string match *3*6*9 01234567890
+} 0
+test util-5.7 {Tcl_StringMatch: UTF-8} {
+ string match *u \u4e4fu
+} 1
+test util-5.8 {Tcl_StringMatch} {
+ string match a?c abc
+} 1
+test util-5.9 {Tcl_StringMatch: UTF-8} {
+ # skip one character in string
+
+ string match a?c a\u4e4fc
+} 1
+test util-5.10 {Tcl_StringMatch} {
+ string match a??c abc
+} 0
+test util-5.11 {Tcl_StringMatch} {
+ string match ?1??4???8? 0123456789
+} 1
+test util-5.12 {Tcl_StringMatch} {
+ string match {[abc]bc} abc
+} 1
+test util-5.13 {Tcl_StringMatch: UTF-8} {
+ # string += Tcl_UtfToUniChar(string, &ch);
+
+ string match "\[\u4e4fxy\]bc" "\u4e4fbc"
+} 1
+test util-5.14 {Tcl_StringMatch} {
+ # if ((*pattern == ']') || (*pattern == '\0'))
+ # badly formed pattern
+
+ string match {[]} {[]}
+} 0
+test util-5.15 {Tcl_StringMatch} {
+ # if ((*pattern == ']') || (*pattern == '\0'))
+ # badly formed pattern
+
+ string match {[} {[}
+} 0
+test util-5.16 {Tcl_StringMatch} {
+ string match {a[abc]c} abc
+} 1
+test util-5.17 {Tcl_StringMatch: UTF-8} {
+ # pattern += Tcl_UtfToUniChar(pattern, &endChar);
+ # get 1 UTF-8 character
+
+ string match "a\[a\u4e4fc]c" "a\u4e4fc"
+} 1
+test util-5.18 {Tcl_StringMatch: UTF-8} {
+ # pattern += Tcl_UtfToUniChar(pattern, &endChar);
+ # proper advance: wrong answer would match on UTF trail byte of \u4e4f
+
+ string match {a[a\u4e4fc]c} [bytestring a\u008fc]
+} 0
+test util-5.19 {Tcl_StringMatch: UTF-8} {
+ # pattern += Tcl_UtfToUniChar(pattern, &endChar);
+ # proper advance.
+
+ string match {a[a\u4e4fc]c} "acc"
+} 1
+test util-5.20 {Tcl_StringMatch} {
+ string match {a[xyz]c} abc
+} 0
+test util-5.21 {Tcl_StringMatch} {
+ string match {12[2-7]45} 12345
+} 1
+test util-5.22 {Tcl_StringMatch: UTF-8 range} {
+ string match "\[\u4e00-\u4e4f]" "0"
+} 0
+test util-5.23 {Tcl_StringMatch: UTF-8 range} {
+ string match "\[\u4e00-\u4e4f]" "\u4e33"
+} 1
+test util-5.24 {Tcl_StringMatch: UTF-8 range} {
+ string match "\[\u4e00-\u4e4f]" "\uff08"
+} 0
+test util-5.25 {Tcl_StringMatch} {
+ string match {12[ab2-4cd]45} 12345
+} 1
+test util-5.26 {Tcl_StringMatch} {
+ string match {12[ab2-4cd]45} 12b45
+} 1
+test util-5.27 {Tcl_StringMatch} {
+ string match {12[ab2-4cd]45} 12d45
+} 1
+test util-5.28 {Tcl_StringMatch} {
+ string match {12[ab2-4cd]45} 12145
+} 0
+test util-5.29 {Tcl_StringMatch} {
+ string match {12[ab2-4cd]45} 12545
+} 0
+test util-5.30 {Tcl_StringMatch: forwards range} {
+ string match {[k-w]} "z"
+} 0
+test util-5.31 {Tcl_StringMatch: forwards range} {
+ string match {[k-w]} "w"
+} 1
+test util-5.32 {Tcl_StringMatch: forwards range} {
+ string match {[k-w]} "r"
+} 1
+test util-5.33 {Tcl_StringMatch: forwards range} {
+ string match {[k-w]} "k"
+} 1
+test util-5.34 {Tcl_StringMatch: forwards range} {
+ string match {[k-w]} "a"
+} 0
+test util-5.35 {Tcl_StringMatch: reverse range} {
+ string match {[w-k]} "z"
+} 0
+test util-5.36 {Tcl_StringMatch: reverse range} {
+ string match {[w-k]} "w"
+} 1
+test util-5.37 {Tcl_StringMatch: reverse range} {
+ string match {[w-k]} "r"
+} 1
+test util-5.38 {Tcl_StringMatch: reverse range} {
+ string match {[w-k]} "k"
+} 1
+test util-5.39 {Tcl_StringMatch: reverse range} {
+ string match {[w-k]} "a"
+} 0
+test util-5.40 {Tcl_StringMatch: skip correct number of ']'} {
+ string match {[A-]x} Ax
+} 0
+test util-5.41 {Tcl_StringMatch: skip correct number of ']'} {
+ string match {[A-]]x} Ax
+} 1
+test util-5.42 {Tcl_StringMatch: skip correct number of ']'} {
+ string match {[A-]]x} \ue1x
+} 0
+test util-5.43 {Tcl_StringMatch: skip correct number of ']'} {
+ string match \[A-]\ue1]x \ue1x
+} 1
+test util-5.44 {Tcl_StringMatch: skip correct number of ']'} {
+ string match {[A-]h]x} hx
+} 1
+test util-5.45 {Tcl_StringMatch} {
+ # if (*pattern == '\0')
+ # badly formed pattern, still treats as a set
+
+ string match {[a} a
+} 1
+test util-5.46 {Tcl_StringMatch} {
+ string match {a\*b} a*b
+} 1
+test util-5.47 {Tcl_StringMatch} {
+ string match {a\*b} ab
+} 0
+test util-5.48 {Tcl_StringMatch} {
+ string match {a\*\?\[\]\\\x} "a*?\[\]\\x"
+} 1
+test util-5.49 {Tcl_StringMatch} {
+ string match ** ""
+} 1
+test util-5.50 {Tcl_StringMatch} {
+ string match *. ""
+} 0
+test util-5.51 {Tcl_StringMatch} {
+ string match "" ""
+} 1
test util-6.1 {Tcl_PrintDouble - using tcl_precision} {
concat x[expr 1.4]
@@ -93,10 +253,10 @@ test util-6.4 {Tcl_PrintDouble - using tcl_precision} {
concat x[expr 1.123412341234]
} {x1.1234}
set tcl_precision 12
-test util-6.4 {Tcl_PrintDouble - make sure there's a decimal point} {
+test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {
concat x[expr 2.0]
} {x2.0}
-test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} {
+test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} {eformat} {
concat x[expr 3.0e98]
} {x3e+98}
@@ -123,10 +283,26 @@ test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} {
interp delete child
list $x $tcl_precision
} {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12}
-test util-7.3 {TclPrecTraceProc - write traces, bogus values} {
+test util-7.4 {TclPrecTraceProc - write traces, bogus values} {
set tcl_precision 12
list [catch {set tcl_precision abc} msg] $msg $tcl_precision
} {1 {can't set "tcl_precision": improper value for precision} 12}
set tcl_precision 12
-concat ""
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/var.test b/tcl/tests/var.test
index 608e6b9e90e..0529b09edce 100644
--- a/tcl/tests/var.test
+++ b/tcl/tests/var.test
@@ -9,6 +9,7 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -16,7 +17,10 @@
# RCS: @(#) $Id$
#
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
catch {rename p ""}
catch {namespace delete test_ns_var}
@@ -27,7 +31,7 @@ catch {unset i}
catch {unset a}
catch {unset arr}
-test var-1.1 {TclLookupVar, TCL_PARSE_PART1 flag set} {
+test var-1.1 {TclLookupVar, Array handling} {
catch {unset a}
set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd
set i 10
@@ -113,6 +117,62 @@ test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of va
[expr {[lsearch [info vars] x:y:] != -1}]
}
} {123 456 789 123 456 789 1 1 1}
+test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
+ namespace eval test_ns_var {
+ variable foo 2
+ }
+ proc p {} {
+ variable ::test_ns_var::foo
+ lappend result [catch {set foo} msg] $msg
+ namespace delete ::test_ns_var
+ lappend result [catch {set foo 3} msg] $msg
+ lappend result [catch {set foo(3) 3} msg] $msg
+ }
+ p
+} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
+test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {
+ namespace eval test_ns_var {
+ variable result
+ namespace eval subns {
+ variable foo 2
+ }
+ upvar 0 subns::foo foo
+ lappend result [catch {set foo} msg] $msg
+ namespace delete subns
+ lappend result [catch {set foo 3} msg] $msg
+ lappend result [catch {set foo(3) 3} msg] $msg
+ namespace delete [namespace current]
+ set result
+ }
+} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
+test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
+ namespace eval test_ns_var {
+ variable result
+ proc p {} {
+ array set x {1 2 3 4}
+ upvar 0 x(1) foo
+ lappend result [catch {set foo} msg] $msg
+ unset x
+ lappend result [catch {set foo 3} msg] $msg
+ }
+ set result [p]
+ namespace delete [namespace current]
+ set result
+ }
+} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
+test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
+ namespace eval test_ns_var {
+ variable result {}
+ variable x
+ array set x {1 2 3 4}
+ upvar 0 x(1) foo
+ lappend result [catch {set foo} msg] $msg
+ unset x
+ lappend result [catch {set foo 3} msg] $msg
+ namespace delete [namespace current]
+ set result
+ }
+} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-2.1 {Tcl_LappendObjCmd, create var if new} {
catch {unset x}
@@ -283,16 +343,16 @@ test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
namespace eval test_ns_var {
variable two 2
}
- list [info vars test_ns_var::*] \
+ list [lsort [info vars test_ns_var::*]] \
[namespace eval test_ns_var {set two}]
-} {{::test_ns_var::two ::test_ns_var::one} 2}
+} [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
test var-7.4 {Tcl_VariableObjCmd, list of vars} {
namespace eval test_ns_var {
variable three 3 four 4
}
- list [info vars test_ns_var::*] \
+ list [lsort [info vars test_ns_var::*]] \
[namespace eval test_ns_var {expr $three+$four}]
-} {{::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one} 7}
+} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
catch {unset a}
catch {unset five}
@@ -341,28 +401,28 @@ test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until na
variable y
variable z
}
- lappend a [info vars test_ns_var2::*]
+ lappend a [lsort [info vars test_ns_var2::*]]
lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \
[info exists test_ns_var2::z]
lappend a [list [catch {set test_ns_var2::y} msg] $msg]
- lappend a [info vars test_ns_var2::*]
+ lappend a [lsort [info vars test_ns_var2::*]]
lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
lappend a [set test_ns_var2::y hello]
lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
- lappend a [info vars test_ns_var2::*]
+ lappend a [lsort [info vars test_ns_var2::*]]
lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
lappend a [namespace delete test_ns_var2]
set a
-} {{::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z} 1 0 0\
-{1 {can't read "test_ns_var2::y": no such variable}}\
-{::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z} 0 0\
-hello 1 0\
-{0 {}}\
-{::test_ns_var2::x ::test_ns_var2::z} 0 0\
-{1 {can't unset "test_ns_var2::z": no such variable}}\
-{}}
+} [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
+ {1 {can't read "test_ns_var2::y": no such variable}}\
+ [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
+ hello 1 0\
+ {0 {}}\
+ [lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
+ {1 {can't unset "test_ns_var2::z": no such variable}}\
+ {}]
test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
namespace eval test_ns_var {
proc p {} {
@@ -389,6 +449,30 @@ test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link v
}
p
} {{My name is empty} {{}}}
+test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
+ namespace eval test_ns_var {
+ variable : {My name is ":"}
+ proc p {} {
+ variable :
+ list [set :] [info vars]
+ }
+ p
+ }
+} {{My name is ":"} :}
+test var-7.14 {Tcl_VariableObjCmd, array element parameter} {
+ catch {namespace eval test_ns_var { variable arrayvar(1) }} res
+ set res
+} "can't define \"arrayvar(1)\": name refers to an element in an array"
+test var-7.15 {Tcl_VariableObjCmd, array element parameter} {
+ catch {
+ namespace eval test_ns_var {
+ variable arrayvar
+ set arrayvar(1) x
+ variable arrayvar(1) y
+ }
+ } res
+ set res
+} "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
catch {namespace delete test_ns_var}
@@ -411,49 +495,155 @@ if {[info commands testsetnoerr] == {}} {
puts "This application hasn't been compiled with the \"testsetnoerr\""
puts "command, so I can't test TclSetVar etc."
} else {
-test var-9.1 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
- testsetnoerr v 1
-} 1
-test var-9.2 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
- catch {unset v}
- list [catch {testsetnoerr v} res] $res;
-} {1 {before get}}
-test var-9.3 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
- catch {unset arr}
- set arr(1) 1;
- list [catch {testsetnoerr arr} res] $res;
-} {1 {before get}}
-test var-9.4 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
- namespace eval ns {variable v nsv}
- testsetnoerr ns::v;
-} nsv;
-test var-9.5 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
- catch {namespace delete ns}
- list [catch {testsetnoerr ns::v} res] $res;
-} {1 {before get}}
-test var-9.6 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
- catch {unset arr}
- set arr(1) 1;
- list [catch {testsetnoerr arr 2} res] $res;
-} {1 {before set}}
-test var-9.7 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
- catch {unset arr}
- set arr(1) 1;
- list [catch {testsetnoerr arr 2} res] $res;
-} {1 {before set}}
-test var-9.8 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
- # this test currently fails, should not...
- # (some namespace function resets the interp while it should not)
+test var-9.1 {behaviour of TclGet/SetVar simple get/set} {
+ catch {unset u}; catch {unset v}
+ list \
+ [set u a; testsetnoerr u] \
+ [testsetnoerr v b] \
+ [testseterr u] \
+ [unset v; testseterr v b]
+} [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.2 {behaviour of TclGet/SetVar namespace get/set} {
catch {namespace delete ns}
- list [catch {testsetnoerr ns::v 1} res] $res;
-} {1 {before set}}
-test var-9.9 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
+ namespace eval ns {variable u a; variable v}
+ list \
+ [testsetnoerr ns::u] \
+ [testsetnoerr ns::v b] \
+ [testseterr ns::u] \
+ [unset ns::v; testseterr ns::v b]
+} [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.3 {behaviour of TclGetVar no variable} {
+ catch {unset u}
+ list \
+ [catch {testsetnoerr u} res] $res \
+ [catch {testseterr u} res] $res
+} {1 {before get} 1 {can't read "u": no such variable}}
+test var-9.4 {behaviour of TclGetVar no namespace variable} {
+ catch {namespace delete ns}
+ namespace eval ns {}
+ list \
+ [catch {testsetnoerr ns::w} res] $res \
+ [catch {testseterr ns::w} res] $res
+} {1 {before get} 1 {can't read "ns::w": no such variable}}
+test var-9.5 {behaviour of TclGetVar no namespace} {
+ catch {namespace delete ns}
+ list \
+ [catch {testsetnoerr ns::u} res] $res \
+ [catch {testseterr ns::v} res] $res
+} {1 {before get} 1 {can't read "ns::v": no such variable}}
+test var-9.6 {behaviour of TclSetVar no namespace} {
+ catch {namespace delete ns}
+ list \
+ [catch {testsetnoerr ns::v 1} res] $res \
+ [catch {testseterr ns::v 1} res] $res
+} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
+test var-9.7 {behaviour of TclGetVar array variable} {
+ catch {unset arr}
+ set arr(1) 1;
+ list \
+ [catch {testsetnoerr arr} res] $res \
+ [catch {testseterr arr} res] $res
+} {1 {before get} 1 {can't read "arr": variable is array}}
+test var-9.8 {behaviour of TclSetVar array variable} {
+ catch {unset arr}
+ set arr(1) 1
+ list \
+ [catch {testsetnoerr arr 2} res] $res \
+ [catch {testseterr arr 2} res] $res
+} {1 {before set} 1 {can't set "arr": variable is array}}
+test var-9.9 {behaviour of TclGetVar read trace success} {
+ proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
+ catch {unset u}; catch {unset v}
+ set u 10
+ trace var u r [list resetvar 1]
+ trace var v r [list resetvar 2]
+ list \
+ [testsetnoerr u] \
+ [testseterr v]
+} {{before get 1} {before get 2}}
+test var-9.10 {behaviour of TclGetVar read trace error} {
+ proc writeonly args {error "write-only"}
+ set v 456
+ trace var v r writeonly
+ list \
+ [catch {testsetnoerr v} msg] $msg \
+ [catch {testseterr v} msg] $msg
+} {1 {before get} 1 {can't read "v": write-only}}
+test var-9.11 {behaviour of TclSetVar write trace success} {
+ proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
+ catch {unset u}; catch {unset v}
+ set v 1
+ trace var v w doubleval
+ trace var u w doubleval
+ list \
+ [testsetnoerr u 2] \
+ [testseterr v 3]
+} {{before set 4} {before set 6}}
+test var-9.12 {behaviour of TclSetVar write trace error} {
proc readonly args {error "read-only"}
set v 456
trace var v w readonly
- list [catch {testsetnoerr v 2} msg] $msg
-} {1 {before set}}
+ list \
+ [catch {testsetnoerr v 2} msg] $msg $v \
+ [catch {testseterr v 3} msg] $msg $v
+} {1 {before set} 2 1 {can't set "v": read-only} 3}
}
+test var-10.1 {can't nest arrays with array set} {
+ catch {unset arr}
+ list [catch {array set arr(x) {a 1 b 2}} res] $res
+} {1 {can't set "arr(x)": variable isn't array}}
+
+test var-10.2 {can't nest arrays with array set} {
+ catch {unset arr}
+ list [catch {array set arr(x) {}} res] $res
+} {1 {can't set "arr(x)": variable isn't array}}
+
+test var-11.1 {array unset} {
+ catch {unset a}
+ array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
+ array unset a 1,*
+ lsort -dict [array names a]
+} {2,1 2,3}
+test var-11.2 {array unset} {
+ catch {unset a}
+ array set a { 1,1 a 1,2 b }
+ array unset a
+ array exists a
+} 0
+test var-11.3 {array unset errors} {
+ catch {unset a}
+ array set a { 1,1 a 1,2 b }
+ list [catch {array unset a pattern too} msg] $msg
+} {1 {wrong # args: should be "array unset arrayName ?pattern?"}}
+
+test var-12.1 {TclFindCompiledLocals, {} array name} {
+ namespace eval n {
+ proc p {} {
+ variable {}
+ set (0) 0
+ set (1) 1
+ set n 2
+ set ($n) 2
+ set ($n,foo) 2
+ }
+ p
+ lsort -dictionary [array names {}]
+ }
+} {0 1 2 2,foo}
+
+test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} {
+ catch {unset t}
+ proc foo {var ind op} {
+ global t
+ set foo bar
+ }
+ namespace eval :: {
+ set t(1) 1
+ trace variable t(1) u foo
+ unset t
+ }
+ set x "If you see this, it worked"
+} "If you see this, it worked"
catch {namespace delete ns}
catch {unset arr}
@@ -470,3 +660,7 @@ catch {unset a}
catch {unset xxxxx}
catch {unset aaaaa}
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tcl/tests/while-old.test b/tcl/tests/while-old.test
index 084903654c5..0ee2e2be35f 100644
--- a/tcl/tests/while-old.test
+++ b/tcl/tests/while-old.test
@@ -8,13 +8,17 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
test while-old-1.1 {basic while loops} {
set count 0
@@ -111,3 +115,20 @@ test while-old-5.2 {while return result} {
set x 1
while {$x} {set x 0}
} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/while.test b/tcl/tests/while.test
index 1b54c3adcd7..d3ac4b167d6 100644
--- a/tcl/tests/while.test
+++ b/tcl/tests/while.test
@@ -5,13 +5,17 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# Basic "while" operation.
@@ -24,12 +28,12 @@ test while-1.1 {TclCompileWhileCmd: missing test expression} {
} {wrong # args: should be "while test command"}
test while-1.2 {TclCompileWhileCmd: error in test expression} {
set i 0
- catch {while {$i<}} msg
+ catch {while {$i<} break} msg
set errorInfo
} {syntax error in expression "$i<"
("while" test expression)
while compiling
-"while {$i<}"}
+"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} {
set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
list $err $msg
@@ -286,7 +290,7 @@ test while-3.3 {break tests, long command body} {
set a
} {1 3}
-# Check "while", "break", "continue" and computed command names.
+# Check "while" with computed command names.
test while-4.1 {while and computed command names} {
set i 0
@@ -296,6 +300,149 @@ test while-4.1 {while and computed command names} {
}
set i
} 10
+test while-4.2 {while (not compiled): missing test expression} {
+ set z while
+ catch {$z } msg
+ set msg
+} {wrong # args: should be "while test command"}
+test while-4.3 {while (not compiled): error in test expression} {
+ set i 0
+ set z while
+ catch {$z {$i<} {set x 1}} msg
+ set errorInfo
+} {syntax error in expression "$i<"
+ while executing
+"$z {$i<} {set x 1}"}
+test while-4.4 {while (not compiled): error in test expression} {
+ set z while
+ set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg]
+ list $err $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test while-4.5 {while (not compiled): multiline test expr} {
+ set value 1
+ set z while
+ $z {($tcl_platform(platform) != "foobar1") && \
+ ($tcl_platform(platform) != "foobar2")} {
+ incr value
+ break
+ }
+ set value
+} {2}
+test while-4.6 {while (not compiled): non-numeric boolean test expr} {
+ set value 1
+ set z while
+ $z {"true"} {
+ incr value;
+ if {$value > 5} {
+ break;
+ }
+ }
+ set value
+} 6
+test while-4.7 {while (not compiled): test expr is enclosed in quotes} {
+ set i 0
+ set z while
+ $z "$i > 5" {}
+} {}
+test while-4.8 {while (not compiled): missing command body} {
+ set i 0
+ set z while
+ catch {$z {$i < 5} } msg
+ set msg
+} {wrong # args: should be "while test command"}
+test while-4.9 {while (not compiled): error compiling command body} {
+ set i 0
+ set z while
+ catch {$z {$i < 5} {set}} msg
+ set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+ while compiling
+"set"
+ ("while" body line 1)
+ invoked from within
+"$z {$i < 5} {set}"}
+test while-4.10 {while (not compiled): simple command body} {
+ set a {}
+ set i 1
+ set z while
+ $z {$i<6} {
+ if $i==4 break
+ set a [concat $a $i]
+ incr i
+ }
+ set a
+} {1 2 3}
+test while-4.11 {while (not compiled): command body in quotes} {
+ set a {}
+ set i 1
+ set z while
+ $z {$i<6} "append a x; incr i"
+ set a
+} {xxxxx}
+test while-4.12 {while (not compiled): computed command body} {
+ set z while
+ catch {unset x1}
+ catch {unset bb}
+ catch {unset x2}
+ set x1 {append a x1; }
+ set bb {break}
+ set x2 {; append a x2; incr i}
+ set a {}
+ set i 1
+ $z {$i<6} $x1$bb$x2
+ set a
+} {x1}
+test while-4.13 {while (not compiled): long command body} {
+ set a {}
+ set z while
+ set i 1
+ $z {$i<6} {
+ if $i==4 break
+ if $i>5 continue
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ set a [concat $a $i]
+ incr i
+ }
+ set a
+} {1 2 3}
+test while-4.14 {while (not compiled): while command result} {
+ set i 0
+ set z while
+ set a [$z {$i < 5} {incr i}]
+ set a
+} {}
+test while-4.15 {while (not compiled): while command result} {
+ set i 0
+ set z while
+ set a [$z {$i < 5} {if $i==3 break; incr i}]
+ set a
+} {}
+
+# Check "break" with computed command names.
test while-5.1 {break and computed command names} {
set i 0
@@ -306,6 +453,73 @@ test while-5.1 {break and computed command names} {
}
set i
} 11
+test while-5.2 {break tests with computed command names} {
+ set a {}
+ set i 1
+ set z break
+ while {$i <= 4} {
+ if {$i == 3} $z
+ set a [concat $a $i]
+ incr i
+ }
+ set a
+} {1 2}
+test while-5.3 {break tests, nested loops with computed command names} {
+ set msg {}
+ set i 1
+ set z break
+ while {$i <= 4} {
+ set a 1
+ while {$a <= 2} {
+ if {$i>=2 && $a>=2} $z
+ set msg [concat $msg "$i.$a"]
+ incr a
+ }
+ incr i
+ }
+ set msg
+} {1.1 1.2 2.1 3.1 4.1}
+test while-5.4 {break tests, long command body with computed command names} {
+ set a {}
+ set i 1
+ set z break
+ while {$i<6} {
+ if $i==2 {incr i; continue}
+ if $i==5 $z
+ if $i>5 continue
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if $i==4 $z
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ set a [concat $a $i]
+ incr i
+ }
+ set a
+} {1 3}
+
+# Check "continue" with computed command names.
test while-6.1 {continue and computed command names} {
set i 0
@@ -317,3 +531,105 @@ test while-6.1 {continue and computed command names} {
}
set i
} 10
+test while-6.2 {continue tests} {
+ set a {}
+ set i 1
+ set z continue
+ while {$i <= 4} {
+ incr i
+ if {$i == 3} $z
+ set a [concat $a $i]
+ }
+ set a
+} {2 4 5}
+test while-6.3 {continue tests with computed command names} {
+ set a {}
+ set i 1
+ set z continue
+ while {$i <= 4} {
+ incr i
+ if {$i != 2} $z
+ set a [concat $a $i]
+ }
+ set a
+} {2}
+test while-6.4 {continue tests, nested loops with computed command names} {
+ set msg {}
+ set i 1
+ set z continue
+ while {$i <= 4} {
+ incr i
+ set a 1
+ while {$a <= 2} {
+ incr a
+ if {$i>=3 && $a>=3} $z
+ set msg [concat $msg "$i.$a"]
+ }
+ }
+ set msg
+} {2.2 2.3 3.2 4.2 5.2}
+test while-6.5 {continue tests, long command body with computed command names} {
+ set a {}
+ set i 1
+ set z continue
+ while {$i<6} {
+ if $i==2 {incr i; continue}
+ if $i==4 break
+ if $i>5 $z
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ if {$i>6 && $tcl_platform(machine)=="xxx"} {
+ catch {set a $a} msg
+ catch {incr i 5} msg
+ catch {incr i -5} msg
+ }
+ set a [concat $a $i]
+ incr i
+ }
+ set a
+} {1 3}
+
+# Test for incorrect "double evaluation" semantics
+
+test while-7.1 {delayed substitution of body} {knownBug} {
+ set i 0
+ while {[incr i] < 10} "
+ set result $i
+ "
+ set result
+} {0}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/winConsole.test b/tcl/tests/winConsole.test
new file mode 100644
index 00000000000..47d3eefb016
--- /dev/null
+++ b/tcl/tests/winConsole.test
@@ -0,0 +1,53 @@
+# This file tests the tclWinConsole.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+
+test winConsole-1.1 {Console file channel: non-blocking gets} \
+ {pcOnly interactive} {
+
+ set oldmode [fconfigure stdin]
+
+ puts stdout "Enter abcdef<return> now: " nonewline
+ flush stdout
+ fileevent stdin readable {
+ if {[gets stdin line] >= 0} {
+ set result $line
+ } else {
+ set result "gets failed"
+ }
+ }
+
+ fconfigure stdin -blocking 0 -buffering line
+
+ set result {}
+ vwait result
+
+ #cleanup the fileevent
+ fileevent stdin readable {}
+ eval fconfigure stdin $oldmode
+
+ set result
+
+} "abcdef"
+
+#cleanup
+
+::tcltest::cleanupTests
+return
+
+
diff --git a/tcl/tests/winDde.test b/tcl/tests/winDde.test
new file mode 100644
index 00000000000..823d10264ac
--- /dev/null
+++ b/tcl/tests/winDde.test
@@ -0,0 +1,169 @@
+# This file tests the tclWinDde.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+if {$tcl_platform(platform) == "windows"} {
+ if [catch {
+ set lib [lindex [glob [file join [pwd] [file dirname \
+ [info nameofexecutable]] tcldde*.dll]] 0]
+ load $lib dde
+ }] {
+ puts "Unable to find the dde package. Skipping registry tests."
+ ::tcltest::cleanupTests
+ return
+ }
+}
+
+set scriptName script1.tcl
+
+
+proc createChildProcess { ddeServerName } {
+
+ file delete -force $::scriptName
+
+ set f [open $::scriptName w+]
+ puts $f {
+ if [catch {
+ set lib [lindex [glob [file join [pwd] [file dirname \
+ [info nameofexecutable]] tcldde*.dll]] 0]
+ load $lib dde
+ }] {
+ puts "Unable to find the dde package. Skipping registry tests."
+ ::tcltest::cleanupTests
+ return
+ }
+ }
+ puts $f "dde servername $ddeServerName"
+ puts $f {
+ puts ready
+ vwait done
+ update
+ exit
+ }
+ close $f
+
+ set f [open "|$tcltest::tcltest $::scriptName" r]
+ gets $f
+ return $f
+}
+
+test winDde-1.1 {Settings the server's topic name} {pcOnly} {
+ list [dde servername foobar] [dde servername] [dde servername self]
+} {foobar foobar self}
+
+test winDde-2.1 {Checking for other services} {pcOnly} {
+ expr [llength [dde services {} {}]] >= 0
+} 1
+
+test winDde-2.2 {Checking for existence, with service and topic specified} \
+ {pcOnly} {
+ llength [dde services TclEval self]
+} 1
+
+test winDde-2.3 {Checking for existence, with only the service specified} \
+ {pcOnly} {
+ expr [llength [dde services TclEval {}]] >= 1
+} 1
+
+test winDde-3.1 {DDE execute locally} {pcOnly} {
+ set a ""
+ dde execute TclEval self {set a "foo"}
+ set a
+} foo
+
+test winDde-3.2 {DDE execute -async locally} {pcOnly} {
+ set a ""
+ dde execute -async TclEval self {set a "foo"}
+ update
+ set a
+} foo
+
+test winDde-3.3 {DDE request locally} {pcOnly} {
+ set a ""
+ dde execute TclEval self {set a "foo"}
+ dde request TclEval self a
+} foo
+
+test winDde-3.4 {DDE eval locally} {pcOnly} {
+ set a ""
+ dde eval self set a "foo"
+} foo
+
+test winDde-4.1 {DDE execute remotely} {pcOnly} {
+ set a ""
+ set child [createChildProcess child]
+ dde execute TclEval child {set a "foo"}
+
+ dde execute TclEval child {set done 1}
+
+ set a
+} ""
+
+test winDde-4.2 {DDE execute remotely} {pcOnly} {
+ set a ""
+ set child [createChildProcess child]
+ dde execute -async TclEval child {set a "foo"}
+
+ dde execute TclEval child {set done 1}
+
+ set a
+} ""
+
+test winDde-4.3 {DDE request locally} {pcOnly} {
+ set a ""
+ set child [createChildProcess child]
+ dde execute TclEval child {set a "foo"}
+ set a [dde request TclEval child a]
+
+
+ dde execute TclEval child {set done 1}
+
+ set a
+} foo
+
+test winDde-4.4 {DDE eval locally} {pcOnly} {
+ set a ""
+ set child [createChildProcess child]
+ set a [dde eval child set a "foo"]
+
+ dde execute TclEval child {set done 1}
+
+ set a
+} foo
+
+test winDde-5.1 {check for bad arguments} {pcOnly} {
+ catch {dde execute "" "" "" ""} result
+ set result
+} {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
+
+test winDde-5.2 {check for bad arguments} {pcOnly} {
+ catch {dde execute "" "" ""} result
+ set result
+} {cannot execute null data}
+
+test winDde-5.3 {check for bad arguments} {pcOnly} {
+ catch {dde execute -foo "" "" ""} result
+ set result
+} {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
+
+
+#cleanup
+file delete -force $::scriptName
+::tcltest::cleanupTests
+return
+
+
diff --git a/tcl/tests/winFCmd.test b/tcl/tests/winFCmd.test
index 7c27221b718..6116f10f742 100644
--- a/tcl/tests/winFCmd.test
+++ b/tcl/tests/winFCmd.test
@@ -5,6 +5,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -12,10 +13,9 @@
# RCS: @(#) $Id$
#
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-if {$tcl_platform(platform) != "windows"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
proc createfile {file {string a}} {
@@ -44,9 +44,8 @@ proc cleanup {args} {
}
}
-set testConfig(cdrom) 0
-set testConfig(exdev) 0
-set testConfig(UNCPath} 0
+set ::tcltest::testConstraints(cdrom) 0
+set ::tcltest::testConstraints(exdev) 0
# find a CD-ROM so we can test read-only filesystems.
@@ -85,11 +84,8 @@ proc findfile {dir} {
return ""
}
-if {$cdrom == ""} {
- puts "Couldn't find a CD-ROM. Skipping tests that access CD-ROM."
- puts "If you have a CD-ROM, insert a data disk and rerun tests."
-} else {
- set testConfig(cdrom) 1
+if {$cdrom != ""} {
+ set ::tcltest::testConstraints(cdrom) 1
set cdfile [findfile $cdrom]
}
@@ -97,21 +93,17 @@ if {[file exists c:/] && [file exists d:/]} {
catch {file delete d:/tf1}
if {[catch {close [open d:/tf1 w]}] == 0} {
file delete d:/tf1
- set testConfig(exdev) 1
+ set ::tcltest::testConstraints(exdev) 1
}
}
-if {[file exists //bisque/icepick]} {
- set testConfig(UNCPath) 1
-}
-
file delete -force -- td1
set foo [catch {open td1 w} testfile]
if {$foo} {
- set testConfig(longFileNames) 0
+ set ::tcltest::testConstraints(longFileNames) 0
} else {
close $testfile
- set testConfig(longFileNames) 1
+ set ::tcltest::testConstraints(longFileNames) 1
file delete -force -- td1
}
@@ -131,67 +123,64 @@ append longname $longname
# it can be difficult to actually forward "insane" arguments to the
# low-level posix emulation layer.
-test winFCmd-1.1 {TclpRenameFile: errno: EACCES} {cdrom} {
+test winFCmd-1.1 {TclpRenameFile: errno: EACCES} {pcOnly cdrom} {
list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
} {1 EACCES}
-test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} {
+test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} {pcOnly} {
cleanup
file mkdir td1/td2/td3
file mkdir td2
list [catch {testfile mv td2 td1/td2} msg] $msg
} {1 EEXIST}
-test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} {!$testConfig(win32s) || ("[lindex [file split [pwd]] end]" == "C:/")} {
- # Don't run this test under Win32s on a drive mounted from an NT
- # machine; it causes the NT machine to die.
-
+test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} {pcOnly} {
cleanup
list [catch {testfile mv / td1} msg] $msg
} {1 EINVAL}
-test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} {
+test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile mv td1 td1/td2} msg] $msg
} {1 EINVAL}
-test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} {
+test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} {pcOnly} {
cleanup
file mkdir td1
createfile tf1
list [catch {testfile mv tf1 td1} msg] $msg
} {1 EISDIR}
-test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} {
+test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile mv tf1 tf2} msg] $msg
} {1 ENOENT}
-test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} {
+test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile mv "" tf2} msg] $msg
} {1 ENOENT}
-test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} {
+test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} {pcOnly} {
cleanup
createfile tf1
list [catch {testfile mv tf1 ""} msg] $msg
} {1 ENOENT}
-test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} {
+test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} {pcOnly} {
cleanup
file mkdir td1
createfile tf1
list [catch {testfile mv td1 tf1} msg] $msg
} {1 ENOTDIR}
-test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} {exdev} {
+test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} {pcOnly exdev} {
file delete -force d:/tf1
file mkdir c:/tf1
set msg [list [catch {testfile mv c:/tf1 d:/tf1} msg] $msg]
file delete -force c:/tf1
set msg
} {1 EXDEV}
-test winFCmd-1.11 {TclpRenameFile: errno: EACCES} {
+test winFCmd-1.11 {TclpRenameFile: errno: EACCES} {pcOnly} {
cleanup
set fd [open tf1 w]
set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
close $fd
set msg
} {1 EACCES}
-test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {
+test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {pcOnly} {
cleanup
createfile tf1
set fd [open tf2 w]
@@ -199,7 +188,7 @@ test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {
close $fd
set msg
} {1 EACCES}
-test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {
+test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {pcOnly} {
cleanup
list [catch {testfile mv nul tf1} msg] $msg
} {1 EACCES}
@@ -213,166 +202,158 @@ test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} {nt} {
createfile tf1
list [catch {testfile mv tf1 nul} msg] $msg
} {1 EEXIST}
-test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} {
+test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} {pcOnly} {
cleanup
createfile tf1 tf1
testfile mv tf1 tf2
list [file exists tf1] [contents tf2]
} {0 tf1}
-test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} {
+test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} {pcOnly} {
cleanup
list [catch {testfile mv tf1 tf2} msg] $msg
} {1 ENOENT}
-test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {
+test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {pcOnly} {
cleanup
list [catch {testfile mv tf1 tf2} msg] $msg
} {1 ENOENT}
-test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {
+test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {pcOnly} {
cleanup
list [catch {testfile mv nul tf1} msg] $msg
} {1 EACCES}
-# under 95, this would actually succed and move the current dir out from
-# under yourself.
-test winFCmd-1.20 {TclpRenameFile: src is dir} {!95} {
+test winFCmd-1.20 {TclpRenameFile: src is dir} {nt} {
+ # under 95, this would actually succeed and move the current dir out from
+ # under the current process!
cleanup
file delete /tf1
list [catch {testfile mv [pwd] /tf1} msg] $msg
} {1 EACCES}
-test winFCmd-1.21 {TclpRenameFile: obscenely long src} {!win32s} {
- # Really long file names cause all the file system calls to lock up,
- # endlessly throwing an access violation and retrying the operation.
-
+test winFCmd-1.21 {TclpRenameFile: long src} {pcOnly} {
+ cleanup
list [catch {testfile mv $longname tf1} msg] $msg
} {1 ENAMETOOLONG}
-test winFCmd-1.22 {TclpRenameFile: obscenely long dst} {nt} {
- # return ENOENT if name is too long!
- cleanup
- createfile tf1
- list [catch {testfile mv tf1 $longname} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.23 {TclpRenameFile: obscenely long dst} {95} {
+test winFCmd-1.22 {TclpRenameFile: long dst} {pcOnly} {
cleanup
createfile tf1
list [catch {testfile mv tf1 $longname} msg] $msg
} {1 ENAMETOOLONG}
-test winFCmd-1.24 {TclpRenameFile: move dir into self} {
+test winFCmd-1.23 {TclpRenameFile: move dir into self} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile mv [pwd]/td1 td1/td2} msg] $msg
} {1 EINVAL}
-test winFCmd-1.25 {TclpRenameFile: move a root dir} {!$testConfig(win32s) || ("[lindex [file split [pwd]] end]" == "C:/")} {
- # Don't run this test under Win32s on a drive mounted from an NT
- # machine; it causes the NT machine to die.
-
+test winFCmd-1.24 {TclpRenameFile: move a root dir} {pcOnly} {
cleanup
list [catch {testfile mv / c:/} msg] $msg
} {1 EINVAL}
-test winFCmd-1.26 {TclpRenameFile: cross file systems} {cdrom} {
+test winFCmd-1.25 {TclpRenameFile: cross file systems} {pcOnly cdrom} {
cleanup
file mkdir td1
list [catch {testfile mv td1 $cdrom/td1} msg] $msg
} {1 EXDEV}
-test winFCmd-1.27 {TclpRenameFile: readonly fs} {cdrom} {
+test winFCmd-1.26 {TclpRenameFile: readonly fs} {pcOnly cdrom} {
cleanup
list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
} {1 EACCES}
-test winFCmd-1.28 {TclpRenameFile: open file} {
+test winFCmd-1.27 {TclpRenameFile: open file} {pcOnly} {
cleanup
set fd [open tf1 w]
set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
close $fd
set msg
} {1 EACCES}
-test winFCmd-1.29 {TclpRenameFile: errno == EEXIST} {
+test winFCmd-1.28 {TclpRenameFile: errno == EEXIST} {pcOnly} {
cleanup
createfile tf1
createfile tf2
testfile mv tf1 tf2
list [file exist tf1] [file exist tf2]
} {0 1}
-test winFCmd-1.30 {TclpRenameFile: src is dir} {
+test winFCmd-1.29 {TclpRenameFile: src is dir} {pcOnly} {
cleanup
file mkdir td1
createfile tf1
list [catch {testfile mv td1 tf1} msg] $msg
} {1 ENOTDIR}
-test winFCmd-1.31 {TclpRenameFile: dst is dir} {
+test winFCmd-1.30 {TclpRenameFile: dst is dir} {pcOnly} {
cleanup
file mkdir td1
file mkdir td2/td2
list [catch {testfile mv td1 td2} msg] $msg
} {1 EEXIST}
-test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory fails} {
+test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} {pcOnly} {
cleanup
file mkdir td1
file mkdir td2/td2
list [catch {testfile mv td1 td2} msg] $msg
} {1 EEXIST}
-test winFCmd-1.33 {TclpRenameFile: TclpRemoveDirectory succeeds} {
+test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} {pcOnly} {
cleanup
file mkdir td1/td2
file mkdir td2
testfile mv td1 td2
list [file exist td1] [file exist td2] [file exist td2/td2]
} {0 1 1}
-test winFCmd-1.34 {TclpRenameFile: After removing dst dir, MoveFile fails} {exdev} {
+test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
+ {pcOnly exdev} {
file mkdir d:/td1
testchmod 000 d:/td1
- set msg [list [catch {testfile mv c:/windows d:/td1} msg] $msg]
+ file mkdir c:/tf1
+ set msg [list [catch {testfile mv c:/tf1 d:/td1} msg] $msg]
set msg "$msg [file writable d:/td1]"
file delete d:/td1
+ file delete -force c:/tf1
set msg
} {1 EXDEV 0}
-test winFCmd-1.35 {TclpRenameFile: src is dir, dst is not} {
+test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} {pcOnly} {
file mkdir td1
createfile tf1
list [catch {testfile mv td1 tf1} msg] $msg
} {1 ENOTDIR}
-test winFCmd-1.36 {TclpRenameFile: src is not dir, dst is} {
+test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} {pcOnly} {
file mkdir td1
createfile tf1
list [catch {testfile mv tf1 td1} msg] $msg
} {1 EISDIR}
-test winFCmd-1.37 {TclpRenameFile: src and dst not dir} {
+test winFCmd-1.36 {TclpRenameFile: src and dst not dir} {pcOnly} {
createfile tf1 tf1
createfile tf2 tf2
testfile mv tf1 tf2
contents tf2
} {tf1}
-test winFCmd-1.38 {TclpRenameFile: need to restore temp file} {
+test winFCmd-1.37 {TclpRenameFile: need to restore temp file} {pcOnly} {
# Can't figure out how to cause this.
# Need a file that can't be copied.
} {}
-test winFCmd-2.1 {TclpCopyFile: errno: EACCES} {cdrom} {
+test winFCmd-2.1 {TclpCopyFile: errno: EACCES} {pcOnly cdrom} {
cleanup
list [catch {testfile cp $cdfile $cdrom/dummy~~.fil} msg] $msg
} {1 EACCES}
-test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} {
+test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile cp td1 tf1} msg] $msg
} {1 EISDIR}
-test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} {
+test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} {pcOnly} {
cleanup
createfile tf1
file mkdir td1
list [catch {testfile cp tf1 td1} msg] $msg
} {1 EISDIR}
-test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} {
+test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile cp tf1 tf2} msg] $msg
} {1 ENOENT}
-test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} {
+test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile cp "" tf2} msg] $msg
} {1 ENOENT}
-test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} {
+test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} {pcOnly} {
cleanup
createfile tf1
list [catch {testfile cp tf1 ""} msg] $msg
} {1 ENOENT}
-test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {!nt} {
+test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {95} {
cleanup
createfile tf1
set fd [open tf2 w]
@@ -388,49 +369,49 @@ test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} {95} {
cleanup
list [catch {testfile cp nul tf1} msg] $msg
} {1 ENOENT}
-test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} {
+test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} {pcOnly} {
cleanup
createfile tf1 tf1
testfile cp tf1 tf2
list [contents tf1] [contents tf2]
} {tf1 tf1}
-test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} {
+test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} {pcOnly} {
cleanup
createfile tf1 tf1
createfile tf2 tf2
testfile cp tf1 tf2
list [contents tf1] [contents tf2]
} {tf1 tf1}
-test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} {
+test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} {pcOnly} {
cleanup
createfile tf1 tf1
testchmod 000 tf1
testfile cp tf1 tf2
list [contents tf2] [file writable tf2]
} {tf1 0}
-test winFCmd-2.13 {TclpCopyFile: CopyFile fails} {
+test winFCmd-2.13 {TclpCopyFile: CopyFile fails} {pcOnly} {
cleanup
createfile tf1
file mkdir td1
list [catch {testfile cp tf1 td1} msg] $msg
} {1 EISDIR}
-test winFCmd-2.14 {TclpCopyFile: errno == EACCES} {
+test winFCmd-2.14 {TclpCopyFile: errno == EACCES} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile cp td1 tf1} msg] $msg
} {1 EISDIR}
-test winFCmd-2.15 {TclpCopyFile: src is directory} {
+test winFCmd-2.15 {TclpCopyFile: src is directory} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile cp td1 tf1} msg] $msg
} {1 EISDIR}
-test winFCmd-2.16 {TclpCopyFile: dst is directory} {
+test winFCmd-2.16 {TclpCopyFile: dst is directory} {pcOnly} {
cleanup
createfile tf1
file mkdir td1
list [catch {testfile cp tf1 td1} msg] $msg
} {1 EISDIR}
-test winFCmd-2.17 {TclpCopyFile: dst is readonly} {
+test winFCmd-2.17 {TclpCopyFile: dst is readonly} {pcOnly} {
cleanup
createfile tf1 tf1
createfile tf2 tf2
@@ -449,59 +430,59 @@ test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} {95} {
set msg "$msg [file writable tf2]"
} {1 EACCES 0}
-test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} {cdrom} {
+test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} {pcOnly cdrom} {
list [catch {testfile rm $cdfile $cdrom/dummy~~.fil} msg] $msg
} {1 EACCES}
-test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} {
+test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile rm td1} msg] $msg
} {1 EISDIR}
-test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} {
+test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile rm tf1} msg] $msg
} {1 ENOENT}
-test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} {
+test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile rm ""} msg] $msg
} {1 ENOENT}
-test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} {
+test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} {pcOnly} {
cleanup
set fd [open tf1 w]
set msg [list [catch {testfile rm tf1} msg] $msg]
close $fd
set msg
} {1 EACCES}
-test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} {
+test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} {pcOnly} {
cleanup
list [catch {testfile rm nul} msg] $msg
} {1 EACCES}
-test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} {
+test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} {pcOnly} {
cleanup
createfile tf1
testfile rm tf1
file exist tf1
} {0}
-test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} {
+test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile rm td1} msg] $msg
} {1 EISDIR}
-test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} {
+test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} {pcOnly} {
cleanup
set fd [open tf1 w]
set msg [list [catch {testfile rm tf1} msg] $msg]
close $fd
set msg
} {1 EACCES}
-test winFCmd-3.10 {TclpDeleteFile: path is readonly} {
+test winFCmd-3.10 {TclpDeleteFile: path is readonly} {pcOnly} {
cleanup
createfile tf1
testchmod 000 tf1
testfile rm tf1
file exists tf1
} {0}
-test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {
+test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {pcOnly} {
cleanup
set fd [open tf1 w]
testchmod 000 tf1
@@ -510,82 +491,82 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {
set msg
} {1 EACCES}
-test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {cdrom nt} {
+test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {nt cdrom} {
list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
} {1 EACCES}
-test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {cdrom 95} {
+test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {95 cdrom} {
list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
} {1 ENOSPC}
-test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} {
+test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile mkdir td1} msg] $msg
} {1 EEXIST}
-test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} {
+test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile mkdir td1/td2} msg] $msg
} {1 ENOENT}
-test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} {
+test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} {pcOnly} {
cleanup
testfile mkdir td1
file type td1
} {directory}
-test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} {
+test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} {pcOnly} {
cleanup
file mkdir td1
testfile cpdir td1 td2
list [file type td1] [file type td2]
} {directory directory}
-test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {
+test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {pcOnly} {
cleanup
file mkdir td1
testchmod 000 td1
testfile rmdir td1
file exist td1
} {0}
-test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {
+test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {pcOnly} {
cleanup
file mkdir td1/td2
list [catch {testfile rmdir td1} msg] $msg
} {1 {td1 EEXIST}}
-test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {
+test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {pcOnly} {
# can't test this w/o removing everything on your hard disk first!
# testfile rmdir /
} {}
-test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {
+test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile rmdir td1} msg] $msg
} {1 {td1 ENOENT}}
-test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {
+test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} {
cleanup
list [catch {testfile rmdir ""} msg] $msg
} {1 ENOENT}
-test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {
+test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {pcOnly} {
cleanup
createfile tf1
list [catch {testfile rmdir tf1} msg] $msg
} {1 {tf1 ENOTDIR}}
-test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {
+test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {pcOnly} {
cleanup
file mkdir td1
testfile rmdir td1
file exists td1
} {0}
-test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {
+test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {pcOnly} {
cleanup
createfile tf1
list [catch {testfile rmdir tf1} msg] $msg
} {1 {tf1 ENOTDIR}}
-test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {
+test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {pcOnly} {
cleanup
file mkdir td1
testchmod 000 td1
testfile rmdir td1
file exists td1
} {0}
-test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {!nt} {
+test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {95} {
cleanup
list [catch {testfile rmdir nul} msg] $msg
} {1 {nul EACCES}}
@@ -593,94 +574,95 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {nt} {
cleanup
list [catch {testfile rmdir /} msg] $msg
} {1 {\ EACCES}}
-test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {!nt} {
+test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {95} {
cleanup
createfile tf1
list [catch {testfile rmdir tf1} msg] $msg
} {1 {tf1 ENOTDIR}}
-test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {
+test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {pcOnly} {
cleanup
file mkdir td1
testchmod 000 td1
testfile rmdir td1
file exists td1
} {0}
-test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {!nt} {
+test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {95} {
cleanup
file mkdir td1/td2
list [catch {testfile rmdir td1} msg] $msg
} {1 {td1 EEXIST}}
-test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {
+test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {pcOnly} {
cleanup
file mkdir td1/td2
list [catch {testfile rmdir td1} msg] $msg
} {1 {td1 EEXIST}}
-test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {
+test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {pcOnly} {
cleanup
createfile tf1
list [catch {testfile rmdir -force tf1} msg] $msg
} {1 {tf1 ENOTDIR}}
-test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} {
+test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} {pcOnly} {
cleanup
file mkdir td1/td2
testfile rmdir -force td1
file exists td1
} {0}
-test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} {
+test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} {pcOnly} {
cleanup
file mkdir td1/td2/td3
testfile rmdir -force td1
file exists td1
} {0}
-test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} {
+test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} {pcOnly} {
cleanup
file mkdir td1/td2/td3
testfile cpdir td1 td2
list [file exists td1] [file exists td2]
} {1 1}
-test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} {
+test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} {pcOnly} {
cleanup
list [catch {testfile cpdir td1 td2} msg] $msg
} {1 {td1 ENOENT}}
-test winFCmd-7.4 {TraverseWinTree: source isn't directory} {
+test winFCmd-7.4 {TraverseWinTree: source isn't directory} {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1 tf1
testfile cpdir td1 td2
contents td2/tf1
} {tf1}
-test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} {
+test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1 tf1
testfile cpdir td1 td2
contents td2/tf1
} {tf1}
-test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} {
+test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1 tf1
testfile rmdir -force td1
file exists td1
} {0}
-test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} {
+test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1 tf1
testfile cpdir td1 td2
contents td2/tf1
} {tf1}
-test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {!nt && cdrom} {
+test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {95 cdrom} {
list [catch {testfile rmdir $cdrom/} msg] $msg
} "1 {$cdrom\\ EEXIST}"
test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} {nt cdrom} {
list [catch {testfile rmdir $cdrom/} msg] $msg
} "1 {$cdrom\\ EACCES}"
-test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} {
+test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
+ {pcOnly} {
# can't make it happen
} {}
-test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {
+test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {pcOnly} {
cleanup
file mkdir td1
testchmod 000 td1
@@ -688,21 +670,21 @@ test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {
testfile cpdir td1 td2
list [file exists td2] [file writable td2]
} {1 0}
-test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {
+test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1 tf1
testfile rmdir -force td1
file exists td1
} {0}
-test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {
+test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1 tf1
testfile cpdir td1 td2
contents td2/tf1
} {tf1}
-test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {!nt} {
+test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {95} {
cleanup
file mkdir td1
list [catch {testfile cpdir td1 /} msg] $msg
@@ -712,19 +694,20 @@ test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {nt} {
file mkdir td1
list [catch {testfile cpdir td1 /} msg] $msg
} {1 {\ EACCES}}
-test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {
+test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {pcOnly} {
cleanup
file mkdir td1
testfile cpdir td1 td2
} {}
-test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {
+test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {pcOnly} {
cleanup
file mkdir td1
createfile td1/td2
testfile cpdir td1 td2
glob td2/*
} {td2/td2}
-test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} {
+test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} \
+ {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1
@@ -733,9 +716,9 @@ test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} {
createfile td1/tf3
createfile td1/tf4
testfile cpdir td1 td2
- glob td2/*
-} {td2/tf1 td2/tf2 td2/td2 td2/tf3 td2/tf4}
-test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {
+ lsort [glob td2/*]
+} {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4}
+test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {pcOnly} {
cleanup
file mkdir td1
testchmod 000 td1
@@ -743,37 +726,38 @@ test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {
testfile cpdir td1 td2
list [file exists td2] [file writable td2]
} {1 0}
-test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} {
+test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} \
+ {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1 tf1
testfile rmdir -force td1
file exists td1
} {0}
-test winFCmd-7.21 {TraverseWinTree: fill errorPtr} {
+test winFCmd-7.21 {TraverseWinTree: fill errorPtr} {pcOnly} {
cleanup
list [catch {testfile cpdir td1 td2} msg] $msg
} {1 {td1 ENOENT}}
-test winFCmd-8.1 {TraversalCopy: DOTREE_F} {
+test winFCmd-8.1 {TraversalCopy: DOTREE_F} {pcOnly} {
cleanup
file mkdir td1
list [catch {testfile cpdir td1 td1} msg] $msg
} {1 {td1 EEXIST}}
-test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} {
+test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} {pcOnly} {
cleanup
file mkdir td1/td2
testchmod 000 td1
testfile cpdir td1 td2
list [file writable td1] [file writable td1/td2]
} {0 1}
-test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} {
+test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} {pcOnly} {
cleanup
file mkdir td1
testfile cpdir td1 td2
} {}
-test winFCmd-9.1 {TraversalDelete: DOTREE_F} {
+test winFCmd-9.1 {TraversalDelete: DOTREE_F} {pcOnly} {
cleanup
file mkdir td1
createfile td1/tf1
@@ -787,193 +771,212 @@ test winFCmd-9.2 {TraversalDelete: DOTREE_F} {95} {
close $fd
set msg
} {1 {td1\tf1 EACCES}}
-test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} {
+test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} {pcOnly} {
cleanup
file mkdir td1/td2
testchmod 000 td1
testfile rmdir -force td1
file exists td1
} {0}
-test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} {
+test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} {pcOnly} {
cleanup
file mkdir td1/td1/td3/td4/td5
testfile rmdir -force td1
} {}
-test winFCmd-10.1 {AttributesPosixError - get} {
+test winFCmd-10.1 {AttributesPosixError - get} {pcOnly} {
cleanup
list [catch {file attributes td1 -archive} msg] $msg
-} {1 {cannot get attribute "-archive" for file "td1": no such file or directory}}
-test winFCmd-10.2 {AttributesPosixError - set} {
+} {1 {could not read "td1": no such file or directory}}
+test winFCmd-10.2 {AttributesPosixError - set} {pcOnly} {
cleanup
list [catch {file attributes td1 -archive 0} msg] $msg
-} {1 {cannot set attribute "-archive" for file "td1": no such file or directory}}
+} {1 {could not read "td1": no such file or directory}}
-test winFCmd-11.1 {GetWinFileAttributes} {
+test winFCmd-11.1 {GetWinFileAttributes} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -archive} msg] $msg [cleanup]
} {0 1 {}}
-test winFCmd-11.2 {GetWinFileAttributes} {
+test winFCmd-11.2 {GetWinFileAttributes} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -readonly} msg] $msg [cleanup]
} {0 0 {}}
-test winFCmd-11.3 {GetWinFileAttributes} {
+test winFCmd-11.3 {GetWinFileAttributes} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -hidden} msg] $msg [cleanup]
} {0 0 {}}
-test winFCmd-11.4 {GetWinFileAttributes} {
+test winFCmd-11.4 {GetWinFileAttributes} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -system} msg] $msg [cleanup]
} {0 0 {}}
+test winfcmd-11.5 {GetWinFileAttributes} {pcOnly} {
+ # attr of relative paths that resolve to root was failing
+ # don't care about answer, just that test runs.
+
+ set old [pwd]
+ cd c:/
+ file attr c:
+ file attr c:.
+ file attr .
+ cd $old
+} {}
-test winFCmd-12.1 {ConvertFileNameFormat} {
+test winFCmd-12.1 {ConvertFileNameFormat} {pcOnly} {
cleanup
close [open td1 w]
list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
} {0 td1 {}}
-test winFCmd-12.2 {ConvertFileNameFormat} {
+test winFCmd-12.2 {ConvertFileNameFormat} {pcOnly} {
cleanup
file mkdir td1
close [open td1/td1 w]
list [catch {string tolower [file attributes td1/td1 -longname]} msg] $msg [cleanup]
} {0 td1/td1 {}}
-test winFCmd-12.3 {ConvertFileNameFormat} {
+test winFCmd-12.3 {ConvertFileNameFormat} {pcOnly} {
cleanup
file mkdir td1
file mkdir td1/td2
close [open td1/td3 w]
list [catch {string tolower [file attributes td1/td2/../td3 -longname]} msg] $msg [cleanup]
} {0 td1/td2/../td3 {}}
-test winFCmd-12.4 {ConvertFileNameFormat} {
+test winFCmd-12.4 {ConvertFileNameFormat} {pcOnly} {
cleanup
close [open td1 w]
list [catch {string tolower [file attributes ./td1 -longname]} msg] $msg [cleanup]
} {0 ./td1 {}}
-test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {
+test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {pcOnly} {
list [file attributes / -longname] [file attributes \\ -longname]
} {/ /}
-test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {
+test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {pcOnly} {
catch {file delete -force -- c:/td1}
close [open c:/td1 w]
list [catch {string tolower [file attributes c:/td1 -longname]} msg] $msg [file delete -force -- c:/td1]
} {0 c:/td1 {}}
-test winFCmd-12.7 {ConvertFileNameFormat} {UNCPath} {
- catch {file delete -force -- //bisque/icepick/test/td1}
- close [open //bisque/icepick/test/td1 w]
- list [catch {string tolower [file attributes //bisque/icepick/test/td1 -longname]} msg] $msg [file delete -force -- //bisque/icepick/test/td1]
-} {0 //bisque/icepick/test/td1 {}}
-test winFCmd-12.8 {ConvertFileNameFormat} {longFileNames} {
- cleanup
- close [open td1 w]
- list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
-} {0 td1 {}}
-test winFCmd-12.9 {ConvertFileNameFormat} {win32s} {
+test winFCmd-12.7 {ConvertFileNameFormat} {nonPortable pcOnly} {
+ string tolower [file attributes //bisque/tcl/ws -longname]
+} {//bisque/tcl/ws}
+test winFCmd-12.8 {ConvertFileNameFormat} {pcOnly longFileNames} {
cleanup
close [open td1 w]
list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
} {0 td1 {}}
-test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames} {
+test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames pcOnly} {
cleanup
close [open td1td1td1 w]
list [catch {file attributes td1td1td1 -shortname}] [cleanup]
} {0 {}}
-test winFCmd-12.11 {ConvertFileNameFormat} {longFileNames} {
+test winFCmd-12.11 {ConvertFileNameFormat} {longFileNames pcOnly} {
cleanup
close [open td1 w]
list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
} {0 td1 {}}
-test winFCmd-13.1 {GetWinFileLongName} {
+test winFCmd-13.1 {GetWinFileLongName} {pcOnly} {
cleanup
close [open td1 w]
list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
} {0 td1 {}}
-test winFCmd-14.1 {GetWinFileShortName} {
+test winFCmd-14.1 {GetWinFileShortName} {pcOnly} {
cleanup
close [open td1 w]
list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
} {0 td1 {}}
-test winFCmd-15.1 {SetWinFileAttributes} {
+test winFCmd-15.1 {SetWinFileAttributes} {pcOnly} {
cleanup
list [catch {file attributes td1 -archive 0} msg] $msg
-} {1 {cannot set attribute "-archive" for file "td1": no such file or directory}}
-test winFCmd-15.2 {SetWinFileAttributes - archive} {
+} {1 {could not read "td1": no such file or directory}}
+test winFCmd-15.2 {SetWinFileAttributes - archive} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -archive 1} msg] $msg [file attributes td1 -archive] [cleanup]
} {0 {} 1 {}}
-test winFCmd-15.3 {SetWinFileAttributes - archive} {
+test winFCmd-15.3 {SetWinFileAttributes - archive} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -archive 0} msg] $msg [file attributes td1 -archive] [cleanup]
} {0 {} 0 {}}
-test winFCmd-15.4 {SetWinFileAttributes - hidden} {
+test winFCmd-15.4 {SetWinFileAttributes - hidden} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -hidden 1} msg] $msg [file attributes td1 -hidden] [file attributes td1 -hidden 0] [cleanup]
} {0 {} 1 {} {}}
-test winFCmd-15.5 {SetWinFileAttributes - hidden} {
+test winFCmd-15.5 {SetWinFileAttributes - hidden} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -hidden 0} msg] $msg [file attributes td1 -hidden] [cleanup]
} {0 {} 0 {}}
-test winFCmd-15.6 {SetWinFileAttributes - readonly} {
+test winFCmd-15.6 {SetWinFileAttributes - readonly} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -readonly 1} msg] $msg [file attributes td1 -readonly] [cleanup]
} {0 {} 1 {}}
-test winFCmd-15.7 {SetWinFileAttributes - readonly} {
+test winFCmd-15.7 {SetWinFileAttributes - readonly} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -readonly 0} msg] $msg [file attributes td1 -readonly] [cleanup]
} {0 {} 0 {}}
-test winFCmd-15.8 {SetWinFileAttributes - system} {
+test winFCmd-15.8 {SetWinFileAttributes - system} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -system 1} msg] $msg [file attributes td1 -system] [cleanup]
} {0 {} 1 {}}
-test winFCmd-15.9 {SetWinFileAttributes - system} {
+test winFCmd-15.9 {SetWinFileAttributes - system} {pcOnly} {
cleanup
close [open td1 w]
list [catch {file attributes td1 -system 0} msg] $msg [file attributes td1 -system] [cleanup]
} {0 {} 0 {}}
-test winFCmd-15.10 {SetWinFileAttributes - failing} {cdrom} {
+test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} {
cleanup
catch {file attributes $cdfile -archive 1}
} {1}
+# This block of code used to occur after the "return" call, so I'm
+# commenting it out and assuming that this code is still under construction.
+#foreach source {tef ted tnf tnd "" nul com1} {
+# foreach chmodsrc {000 755} {
+# foreach dest "tfn tfe tdn tdempty tdfull td1/td2 $p $p/td1 {} nul" {
+# foreach chmoddst {000 755} {
+# puts hi
+# cleanup
+# file delete -force ted tef
+# file mkdir ted
+# createfile tef
+# createfile tfe
+# file mkdir tdempty
+# file mkdir tdfull/td1/td2
+#
+# catch {testchmod $chmodsrc $source}
+# catch {testchmod $chmoddst $dest}
+#
+# if [catch {file rename $source $dest} msg] {
+# puts "file rename $source ($chmodsrc) $dest ($chmoddst)"
+# puts $msg
+# }
+# }
+# }
+# }
+#}
+
+# cleanup
cleanup
-
+::tcltest::cleanupTests
return
-foreach source {tef ted tnf tnd "" nul com1} {
- foreach chmodsrc {000 755} {
- foreach dest "tfn tfe tdn tdempty tdfull td1/td2 $p $p/td1 {} nul" {
- foreach chmoddst {000 755} {
- puts hi
- cleanup
- file delete -force ted tef
- file mkdir ted
- createfile tef
- createfile tfe
- file mkdir tdempty
- file mkdir tdfull/td1/td2
-
- catch {testchmod $chmodsrc $source}
- catch {testchmod $chmoddst $dest}
-
- if [catch {file rename $source $dest} msg] {
- puts "file rename $source ($chmodsrc) $dest ($chmoddst)"
- puts $msg
- }
- }
- }
- }
-}
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/winFile.test b/tcl/tests/winFile.test
new file mode 100644
index 00000000000..2c4116a83f7
--- /dev/null
+++ b/tcl/tests/winFile.test
@@ -0,0 +1,80 @@
+# This file tests the tclWinFile.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+test winFile-1.1 {TclpGetUserHome} {pcOnly} {
+ list [catch {glob ~nosuchuser} msg] $msg
+} {1 {user "nosuchuser" doesn't exist}}
+test winFile-1.2 {TclpGetUserHome} {nt nonPortable} {
+ # The administrator account should always exist.
+
+ catch {glob ~administrator}
+} {0}
+test winFile-1.2 {TclpGetUserHome} {95} {
+ # Find some user in system.ini and then see if they have a home.
+
+ set f [open $::env(windir)/system.ini]
+ set x 0
+ while {![eof $f]} {
+ set line [gets $f]
+ if {$line == "\[Password Lists]"} {
+ gets $f
+ set name [lindex [split [gets $f] =] 0]
+ if {$name != ""} {
+ set x [catch {glob ~$name}]
+ break
+ }
+ }
+ }
+ close $f
+ set x
+} {0}
+test winFile-1.3 {TclpGetUserHome} {nt nonPortable} {
+ catch {glob ~stanton@workgroup}
+} {0}
+
+test winFile-2.1 {TclpMatchFiles: case sensitivity} {pcOnly} {
+ makeFile {} GlobCapS
+ set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]]
+ removeFile GlobCapS
+ set result
+} {GlobCapS GlobCapS}
+
+test winFile-2.2 {TclpMatchFiles: case sensitivity} {pcOnly} {
+ makeFile {} globlower
+ set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]]
+ removeFile globlower
+ set result
+} {globlower globlower}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/winNotify.test b/tcl/tests/winNotify.test
index 5eb3a2769e3..34efe7052af 100644
--- a/tcl/tests/winNotify.test
+++ b/tcl/tests/winNotify.test
@@ -5,27 +5,30 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-if {$tcl_platform(platform) != "windows"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
+set ::tcltest::testConstraints(testeventloop) \
+ [expr {[info commands testeventloop] != {}}]
+
# There is no explicit test for InitNotifier or NotifierExitHandler
-test winNotify-1.1 {Tcl_SetTimer: positive timeout} {
+test winNotify-1.1 {Tcl_SetTimer: positive timeout} {pcOnly} {
set done 0
after 1000 { set done 1 }
vwait done
set done
} 1
-test winNotify-1.2 {Tcl_SetTimer: positive timeout, message pending} {
+test winNotify-1.2 {Tcl_SetTimer: positive timeout, message pending} {pcOnly} {
set x 0
set y 1
set a1 [after 0 { incr y }]
@@ -34,7 +37,7 @@ test winNotify-1.2 {Tcl_SetTimer: positive timeout, message pending} {
vwait x
list $x $y
} {1 1}
-test winNotify-1.3 {Tcl_SetTimer: cancelling positive timeout} {
+test winNotify-1.3 {Tcl_SetTimer: cancelling positive timeout} {pcOnly} {
set x 0
set y 1
set id [after 10000 { incr y }]
@@ -43,7 +46,7 @@ test winNotify-1.3 {Tcl_SetTimer: cancelling positive timeout} {
after cancel $id
list $x $y
} {1 1}
-test winNotify-1.4 {Tcl_SetTimer: null timeout, message pending} {
+test winNotify-1.4 {Tcl_SetTimer: null timeout, message pending} {pcOnly} {
set x 0
set y 1
after 0 { incr x }
@@ -52,14 +55,14 @@ test winNotify-1.4 {Tcl_SetTimer: null timeout, message pending} {
list $x $y
} {1 2}
-test winNotify-2.1 {Tcl_ResetIdleTimer} {
+test winNotify-2.1 {Tcl_ResetIdleTimer} {pcOnly} {
set x 0
update
after idle { incr x }
vwait x
set x
} 1
-test winNotify-2.2 {Tcl_ResetIdleTimer: message pending} {
+test winNotify-2.2 {Tcl_ResetIdleTimer: message pending} {pcOnly} {
set x 0
set y 1
update
@@ -69,7 +72,7 @@ test winNotify-2.2 {Tcl_ResetIdleTimer: message pending} {
list $x $y
} {1 2}
-test winNotify-3.1 {NotifierProc: non-modal normal timer} {
+test winNotify-3.1 {NotifierProc: non-modal normal timer} {pcOnly testeventloop} {
update
set x 0
foreach i [after info] {
@@ -79,7 +82,7 @@ test winNotify-3.1 {NotifierProc: non-modal normal timer} {
testeventloop wait
set x
} 1
-test winNotify-3.2 {NotifierProc: non-modal normal timer, rescheduled} {
+test winNotify-3.2 {NotifierProc: non-modal normal timer, rescheduled} {pcOnly testeventloop} {
update
set x 0
foreach i [after info] {
@@ -89,7 +92,7 @@ test winNotify-3.2 {NotifierProc: non-modal normal timer, rescheduled} {
testeventloop wait
set x
} 2
-test winNotify-3.3 {NotifierProc: modal normal timer} {
+test winNotify-3.3 {NotifierProc: modal normal timer} {pcOnly} {
update
set x 0
foreach i [after info] {
@@ -99,7 +102,7 @@ test winNotify-3.3 {NotifierProc: modal normal timer} {
vwait x
set x
} 1
-test winNotify-3.4 {NotifierProc: modal normal timer, rescheduled} {
+test winNotify-3.4 {NotifierProc: modal normal timer, rescheduled} {pcOnly} {
update
set x 0
foreach i [after info] {
@@ -110,7 +113,7 @@ test winNotify-3.4 {NotifierProc: modal normal timer, rescheduled} {
vwait x
list $x $y
} {1 1}
-test winNotify-3.5 {NotifierProc: non-modal idle timer} {
+test winNotify-3.5 {NotifierProc: non-modal idle timer} {pcOnly testeventloop} {
update
set x 0
foreach i [after info] {
@@ -120,7 +123,7 @@ test winNotify-3.5 {NotifierProc: non-modal idle timer} {
testeventloop wait
set x
} 1
-test winNotify-3.6 {NotifierProc: non-modal idle timer, rescheduled} {
+test winNotify-3.6 {NotifierProc: non-modal idle timer, rescheduled} {pcOnly testeventloop} {
update
set x 0
foreach i [after info] {
@@ -130,7 +133,7 @@ test winNotify-3.6 {NotifierProc: non-modal idle timer, rescheduled} {
testeventloop wait
set x
} 2
-test winNotify-3.7 {NotifierProc: modal idle timer} {
+test winNotify-3.7 {NotifierProc: modal idle timer} {pcOnly} {
update
set x 0
foreach i [after info] {
@@ -140,7 +143,7 @@ test winNotify-3.7 {NotifierProc: modal idle timer} {
vwait x
set x
} 1
-test winNotify-3.8 {NotifierProc: modal idle timer, rescheduled} {
+test winNotify-3.8 {NotifierProc: modal idle timer, rescheduled} {pcOnly} {
update
set x 0
foreach i [after info] {
@@ -153,3 +156,20 @@ test winNotify-3.8 {NotifierProc: modal idle timer, rescheduled} {
} {1 1}
# Tcl_DoOneEvent is tested by the timer.test, io.test, and event.test files
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/winPipe.test b/tcl/tests/winPipe.test
index 8cf3f09adf6..8e3e011d459 100644
--- a/tcl/tests/winPipe.test
+++ b/tcl/tests/winPipe.test
@@ -2,34 +2,37 @@
# winPipe.test --
#
# This file contains a collection of tests for tclWinPipe.c
-
+#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) != "windows"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
}
set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat16 [file join $bindir cat16.exe]
set cat32 [file join $bindir cat32.exe]
-if {[string compare test [info procs test]] == 1} then {source defs}
+set ::tcltest::testConstraints(cat32) [file exists $cat32]
+set ::tcltest::testConstraints(cat16) [file exists $cat16]
-if [catch {puts console1 ""}] {
- set testConfig(AllocConsole) 1
+if {[catch {puts console1 ""}]} {
+ set ::tcltest::testConstraints(AllocConsole) 1
} else {
- set testConfig(.console) 1
+ set ::tcltest::testConstraints(.console) 1
}
-set big aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n
+set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big
append big $big
@@ -52,108 +55,114 @@ proc contents {file} {
set r
}
-if {$testConfig(stdio) && [file exists $cat32]} {
-test winpipe-1.1 {32 bit comprehensive tests: from little file} {
+set f [open more w]
+puts $f {
+ while {[eof stdin] == 0} {
+ puts -nonewline [read stdin]
+ }
+}
+close $f
+
+test winpipe-1.1 {32 bit comprehensive tests: from little file} {pcOnly stdio cat32} {
exec $cat32 < little > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "little stderr32"
-test winpipe-1.2 {32 bit comprehensive tests: from big file} {
+} {little stderr32}
+test winpipe-1.2 {32 bit comprehensive tests: from big file} {pcOnly stdio cat32} {
exec $cat32 < big > stdout 2> stderr
list [contents stdout] [contents stderr]
} "{$big} stderr32"
-test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {nt} {
- exec more < little | $cat32 > stdout 2> stderr
+test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {nt stdio cat32} {
+ exec $::tcltest::tcltest more < little | $cat32 > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{little\n} stderr32"
-test winpipe-1.4 {32 bit comprehensive tests: a little from pipe} {95} {
- exec more < little |& $cat32 > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{\nlittle} stderr32"
-test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {nt} {
- exec more < big | $cat32 > stdout 2> stderr
+} {little stderr32}
+test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {nt stdio cat32} {
+ exec $::tcltest::tcltest more < big | $cat32 > stdout 2> stderr
list [contents stdout] [contents stderr]
} "{$big} stderr32"
-test winpipe-1.6 {32 bit comprehensive tests: a lot from pipe} {95} {
+test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {95 stdio cat32} {
exec command /c type big |& $cat32 > stdout 2> stderr
list [contents stdout] [contents stderr]
} "{$big} stderr32"
-test winpipe-1.7 {32 bit comprehensive tests: from console} {AllocConsole} {
+test winpipe-1.6 {32 bit comprehensive tests: from console} \
+ {pcOnly stdio cat32 AllocConsole} {
# would block waiting for human input
} {}
-test winpipe-1.8 {32 bit comprehensive tests: from NUL} {
+test winpipe-1.7 {32 bit comprehensive tests: from NUL} {pcOnly stdio cat32} {
exec $cat32 < nul > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{} stderr32"
-test winpipe-1.9 {32 bit comprehensive tests: from socket} {
+} {{} stderr32}
+test winpipe-1.8 {32 bit comprehensive tests: from socket} {pcOnly stdio cat32} {
# doesn't work
} {}
-test winpipe-1.10 {32 bit comprehensive tests: from nowhere} {.console} {
+test winpipe-1.9 {32 bit comprehensive tests: from nowhere} \
+ {pcOnly stdio cat32 .console} {
exec $cat32 > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{} stderr32"
-test winpipe-1.11 {32 bit comprehensive tests: from file handle} {
+} {{} stderr32}
+test winpipe-1.10 {32 bit comprehensive tests: from file handle} \
+ {pcOnly stdio cat32} {
set f [open "little" r]
exec $cat32 <@$f > stdout 2> stderr
close $f
list [contents stdout] [contents stderr]
-} "little stderr32"
-test winpipe-1.12 {32 bit comprehensive tests: read from application} {
+} {little stderr32}
+test winpipe-1.11 {32 bit comprehensive tests: read from application} \
+ {pcOnly stdio cat32} {
set f [open "|$cat32 < little" r]
gets $f line
catch {close $f} msg
list $line $msg
-} "little stderr32"
-test winpipe-1.13 {32 bit comprehensive tests: a little to file} {
+} {little stderr32}
+test winpipe-1.12 {32 bit comprehensive tests: a little to file} \
+ {pcOnly stdio cat32} {
exec $cat32 < little > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "little stderr32"
-test winpipe-1.14 {32 bit comprehensive tests: a lot to file} {
+} {little stderr32}
+test winpipe-1.13 {32 bit comprehensive tests: a lot to file} \
+ {pcOnly stdio cat32} {
exec $cat32 < big > stdout 2> stderr
list [contents stdout] [contents stderr]
} "{$big} stderr32"
-test winpipe-1.15 {32 bit comprehensive tests: a little to pipe} {nt} {
- exec $cat32 < little | more > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{little\n} stderr32"
-test winpipe-1.16 {32 bit comprehensive tests: a little to pipe} {95} {
- exec $cat32 < little | more > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{\nlittle} stderr32"
-test winpipe-1.17 {32 bit comprehensive tests: a lot to pipe} {nt} {
- exec $cat32 < big | more > stdout 2> stderr
+test winpipe-1.14 {32 bit comprehensive tests: a little to pipe} \
+ {pcOnly stdio cat32} {
+ exec $cat32 < little | $::tcltest::tcltest more > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{$big\n} stderr32"
-test winpipe-1.18 {32 bit comprehensive tests: a lot to pipe} {95} {
- exec $cat32 < big | more > stdout 2> stderr
+} {little stderr32}
+test winpipe-1.15 {32 bit comprehensive tests: a lot to pipe} \
+ {pcOnly stdio cat32} {
+ exec $cat32 < big | $::tcltest::tcltest more > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{\n$big} stderr32"
-test winpipe-1.19 {32 bit comprehensive tests: to console} {
+} "{$big} stderr32"
+test winpipe-1.16 {32 bit comprehensive tests: to console} {pcOnly stdio cat32} {
catch {exec $cat32 << "You should see this\n" >@stdout} msg
set msg
} stderr32
-test winpipe-1.20 {32 bit comprehensive tests: to NUL} {
+test winpipe-1.17 {32 bit comprehensive tests: to NUL} {pcOnly stdio cat32} {
# some apps hang when sending a large amount to NUL. $cat32 isn't one.
catch {exec $cat32 < big > nul} msg
set msg
} stderr32
-test winpipe-1.21 {32 bit comprehensive tests: to nowhere} {.console} {
+test winpipe-1.18 {32 bit comprehensive tests: to nowhere} \
+ {pcOnly stdio cat32 .console} {
exec $cat32 < big >&@stdout
} {}
-test winpipe-1.22 {32 bit comprehensive tests: to file handle} {
+test winpipe-1.19 {32 bit comprehensive tests: to file handle} {pcOnly stdio cat32} {
set f1 [open "stdout" w]
set f2 [open "stderr" w]
exec $cat32 < little >@$f1 2>@$f2
close $f1
close $f2
list [contents stdout] [contents stderr]
-} "little stderr32"
-test winpipe-1.23 {32 bit comprehensive tests: write to application} {
+} {little stderr32}
+test winpipe-1.20 {32 bit comprehensive tests: write to application} \
+ {pcOnly stdio cat32} {
set f [open "|$cat32 > stdout" w]
puts -nonewline $f "foo"
catch {close $f} msg
list [contents stdout] $msg
-} "foo stderr32"
-test winpipe-1.24 {32 bit comprehensive tests: read/write application} {
+} {foo stderr32}
+test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
+ {pcOnly stdio cat32} {
set f [open "|$cat32" r+]
puts $f $big
puts $f \032
@@ -161,115 +170,103 @@ test winpipe-1.24 {32 bit comprehensive tests: read/write application} {
set r [read $f 64]
catch {close $f}
set r
-} "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-}
+} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+test winpipe-1.22 {Checking command.com for Win95/98 hanging} \
+ {pcOnly stdio} {
+ exec command.com /c dir /b
+ set result 1
+} 1
-set stderr16 "stderr16"
-if {$tcl_platform(os) == "Win32s"} {
- set stderr16 "{}"
-}
-if [file exists $cat16] {
-test winpipe-2.1 {16 bit comprehensive tests: from little file} {
+test winpipe-2.1 {16 bit comprehensive tests: from little file} {pcOnly stdio cat16} {
exec $cat16 < little > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "little $stderr16"
-test winpipe-2.2 {16 bit comprehensive tests: from big file} {
+} "little stderr16"
+test winpipe-2.2 {16 bit comprehensive tests: from big file} {pcOnly stdio cat16} {
exec $cat16 < big > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{$big} $stderr16"
-test winpipe-2.3 {16 bit comprehensive tests: a little from pipe} {nt} {
- exec more < little | $cat16 > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{little\n} stderr16"
-test winpipe-2.4 {16 bit comprehensive tests: a little from pipe} {95} {
- exec more < little | $cat16 > stdout 2> stderr
+} "{$big} stderr16"
+test winpipe-2.3 {16 bit comprehensive tests: a little from pipe} {pcOnly stdio cat16} {
+ exec $::tcltest::tcltest more < little | $cat16 > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{\nlittle} stderr16"
-test winpipe-2.5 {16 bit comprehensive tests: a lot from pipe} {nt} {
+} {little stderr16}
+test winpipe-2.4 {16 bit comprehensive tests: a lot from pipe} {nt stdio cat16} {
exec $cat16 < big | $cat16 > stdout 2> stderr
list [contents stdout] [contents stderr]
} "{$big} stderr16stderr16"
-test winpipe-2.6 {16 bit comprehensive tests: a lot from pipe} {95} {
- exec more < big | $cat16 > stdout 2> stderr
+test winpipe-2.5 {16 bit comprehensive tests: a lot from pipe} {95 stdio cat16} {
+ exec $::tcltest::tcltest more < big | $cat16 > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{\n$big} stderr16"
-test winpipe-2.7 {16 bit comprehensive tests: from console} {AllocConsole} {
+} "{$big} stderr16"
+test winpipe-2.6 {16 bit comprehensive tests: from console} \
+ {pcOnly stdio cat16 AllocConsole} {
# would block waiting for human input
} {}
-test winpipe-2.8 {16 bit comprehensive tests: from NUL} {nt} {
+test winpipe-2.7 {16 bit comprehensive tests: from NUL} {nt stdio cat16} {
exec $cat16 < nul > stdout 2> stderr
list [contents stdout] [contents stderr]
} "{} stderr16"
-test winpipe-2.9 {16 bit comprehensive tests: from socket} {
+test winpipe-2.8 {16 bit comprehensive tests: from socket} {pcOnly stdio cat16} {
# doesn't work
} {}
-test winpipe-2.10 {16 bit comprehensive tests: from nowhere} {.console} {
+test winpipe-2.9 {16 bit comprehensive tests: from nowhere} {pcOnly stdio cat16 .console} {
exec $cat16 > stdout 2> stderr
list [contents stdout] [contents stderr]
} "{} stderr16"
-test winpipe-2.11 {16 bit comprehensive tests: from file handle} {
+test winpipe-2.10 {16 bit comprehensive tests: from file handle} {pcOnly stdio cat16} {
set f [open "little" r]
exec $cat16 <@$f > stdout 2> stderr
close $f
list [contents stdout] [contents stderr]
-} "little $stderr16"
-test winpipe-2.12 {16 bit comprehensive tests: read from application} {
+} "little stderr16"
+test winpipe-2.11 {16 bit comprehensive tests: read from application} {pcOnly stdio cat16} {
set f [open "|$cat16 < little" r]
gets $f line
catch {close $f} msg
list $line $msg
-} "little $stderr16"
-test winpipe-2.13 {16 bit comprehensive tests: a little to file} {
+} "little stderr16"
+test winpipe-2.12 {16 bit comprehensive tests: a little to file} {pcOnly stdio cat16} {
exec $cat16 < little > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "little $stderr16"
-test winpipe-2.14 {16 bit comprehensive tests: a lot to file} {
+} "little stderr16"
+test winpipe-2.13 {16 bit comprehensive tests: a lot to file} {pcOnly stdio cat16} {
exec $cat16 < big > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{$big} $stderr16"
-test winpipe-2.15 {16 bit comprehensive tests: a little to pipe} {nt} {
- catch {exec $cat16 < little | more > stdout 2> stderr}
- list [contents stdout] [contents stderr]
-} "{little\n} stderr16"
-test winpipe-2.16 {16 bit comprehensive tests: a little to pipe} {95} {
- exec $cat16 < little | more > stdout 2> stderr
+} "{$big} stderr16"
+test winpipe-2.14 {16 bit comprehensive tests: a little to pipe} {pcOnly stdio cat16} {
+ exec $cat16 < little | $::tcltest::tcltest more > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{\nlittle} stderr16"
-test winpipe-2.17 {16 bit comprehensive tests: a lot to pipe} {nt} {
- catch {exec $cat16 < big | more > stdout 2> stderr}
+} {little stderr16}
+test winpipe-2.15 {16 bit comprehensive tests: a lot to pipe} {pcOnly stdio cat16} {
+ exec $cat16 < big | $::tcltest::tcltest more > stdout 2> stderr
list [contents stdout] [contents stderr]
-} "{$big\n} stderr16"
-test winpipe-2.18 {16 bit comprehensive tests: a lot to pipe} {95} {
- exec $cat16 < big | more > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{\n$big} stderr16"
-test winpipe-2.19 {16 bit comprehensive tests: to console} {
+} "{$big} stderr16"
+test winpipe-2.16 {16 bit comprehensive tests: to console} {pcOnly stdio cat16} {
catch {exec $cat16 << "You should see this\n" >@stdout} msg
set msg
-} [lindex $stderr16 0]
-test winpipe-2.20 {16 bit comprehensive tests: to NUL} {nt} {
+} [lindex stderr16 0]
+test winpipe-2.17 {16 bit comprehensive tests: to NUL} {nt stdio cat16} {
# some apps hang when sending a large amount to NUL. cat16 isn't one.
catch {exec $cat16 < big > nul} msg
set msg
} stderr16
-test winpipe-2.21 {16 bit comprehensive tests: to nowhere} {.console} {
+test winpipe-2.18 {16 bit comprehensive tests: to nowhere} {pcOnly stdio cat16 .console} {
exec $cat16 < big >&@stdout
} {}
-test winpipe-2.22 {16 bit comprehensive tests: to file handle} {
+test winpipe-2.19 {16 bit comprehensive tests: to file handle} {pcOnly stdio cat16} {
set f1 [open "stdout" w]
set f2 [open "stderr" w]
exec $cat16 < little >@$f1 2>@$f2
close $f1
close $f2
list [contents stdout] [contents stderr]
-} "little $stderr16"
-test winpipe-2.23 {16 bit comprehensive tests: write to application} {!win32s} {
+} "little stderr16"
+test winpipe-2.20 {16 bit comprehensive tests: write to application} {pcOnly stdio cat16} {
set f [open "|$cat16 > stdout" w]
puts -nonewline $f "foo"
catch {close $f} msg
list [contents stdout] $msg
} "foo stderr16"
-test winpipe-2.24 {16 bit comprehensive tests: read/write application} {nt} {
+test winpipe-2.21 {16 bit comprehensive tests: read/write application} {nt stdio cat16} {
set f [open "|$cat16" r+]
puts $f $big
puts $f \032
@@ -277,10 +274,10 @@ test winpipe-2.24 {16 bit comprehensive tests: read/write application} {nt} {
set r [read $f 64]
catch {close $f}
set r
-} "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-}
+} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+file delete more
-test winpipe-4.1 {Tcl_WaitPid} {nt} {
+test winpipe-4.1 {Tcl_WaitPid} {nt stdio} {
proc readResults {f} {
global x result
if { [eof $f] } {
@@ -309,63 +306,114 @@ catch {set env_temp $env(TEMP)}
set env(TMP) c:/
set env(TEMP) c:/
-test winpipe-3.1 {TclpCreateTempFile: cleanup temp files} {
+test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {pcOnly stdio} {
set x {}
set existing [glob -nocomplain c:/tcl*.tmp]
- exec $tcltest < nothing
+ exec $::tcltest::tcltest < nothing
foreach p [glob -nocomplain c:/tcl*.tmp] {
- if {[lsearch $existing $p] != -1} {
+ if {[lsearch $existing $p] == -1} {
lappend x $p
}
}
set x
} {}
-test winpipe-3.2 {TclpCreateTempFile: TMP and TEMP not defined} {
+test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {pcOnly stdio} {
set tmp $env(TMP)
set temp $env(TEMP)
unset env(TMP)
unset env(TEMP)
- exec $tcltest < nothing
+ exec $::tcltest::tcltest < nothing
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
} {}
-test winpipe-3.3 {TclpCreateTempFile: TMP specifies non-existent directory} {
+test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \
+ {pcOnly stdio} {
set tmp $env(TMP)
set env(TMP) snarky
- exec $tcltest < nothing
+ exec $::tcltest::tcltest < nothing
set env(TMP) $tmp
set x {}
} {}
-test winpipe-3.3 {TclpCreateTempFile: TEMP specifies non-existent directory} {
+test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \
+ {pcOnly stdio} {
set tmp $env(TMP)
set temp $env(TEMP)
unset env(TMP)
set env(TEMP) snarky
- exec $tcltest < nothing
+ exec $::tcltest::tcltest < nothing
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
} {}
+test winpipe-6.1 {PipeSetupProc & PipeCheckProc: read threads} \
+ {pcOnly stdio cat32} {
+ set f [open "|$cat32" r+]
+ fconfigure $f -blocking 0
+ fileevent $f writable { set x writable }
+ set x {}
+ vwait x
+ fileevent $f writable {}
+ fileevent $f readable { lappend x readable }
+ after 100 { lappend x timeout }
+ vwait x
+ puts $f foobar
+ flush $f
+ vwait x
+ lappend x [read $f]
+ after 100 { lappend x timeout }
+ vwait x
+ lappend x [catch {close $f} msg] $msg
+} {writable timeout readable {foobar
+} timeout 1 stderr32}
+test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \
+ {pcOnly stdio cat32} {
+ set f [open "|$cat32" r+]
+ fconfigure $f -blocking 0
+ fileevent $f writable { set x writable }
+ set x {}
+ vwait x
+ puts -nonewline $f $big$big$big$big
+ flush $f
+ after 100 { lappend x timeout }
+ vwait x
+ lappend x [catch {close $f} msg] $msg
+} {writable timeout 0 {}}
+
makeFile {
puts "[list $argv0 $argv]"
} echoArgs.tcl
-test winpipe-4.1 {BuildCommandLine: null arguments} {
- exec $tcltest echoArgs.tcl foo "" bar
+test winpipe-7.1 {BuildCommandLine: null arguments} {pcOnly stdio} {
+ exec $::tcltest::tcltest echoArgs.tcl foo "" bar
} {echoArgs.tcl {foo {} bar}}
-test winpipe-4.1 {BuildCommandLine: null arguments} {
- exec $tcltest echoArgs.tcl foo \" bar
+test winpipe-7.2 {BuildCommandLine: null arguments} {pcOnly stdio} {
+ exec $::tcltest::tcltest echoArgs.tcl foo \" bar
} {echoArgs.tcl {foo {"} bar}}
-# restore old values fro env(TMP) and env(TEMP)
+# restore old values for env(TMP) and env(TEMP)
if {[catch {set env(TMP) $env_tmp}]} {
- unset $env(TMP)
+ unset env(TMP)
}
if {[catch {set env(TEMP) $env_temp}]} {
- unset $env(TEMP)
+ unset env(TEMP)
}
-file delete big little stdout stderr nothing dummy.tcl
+# cleanup
+file delete big little stdout stderr nothing echoArgs.tcl
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tests/winTime.test b/tcl/tests/winTime.test
new file mode 100644
index 00000000000..aeb7734b28b
--- /dev/null
+++ b/tcl/tests/winTime.test
@@ -0,0 +1,51 @@
+# This file tests the tclWinTime.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# The next two tests will crash on Windows if the check for negative
+# clock values is not done properly.
+
+test winTime-1.1 {TclpGetDate} {pcOnly} {
+ set ::env(TZ) JST-9
+ set result [clock format -1 -format %Y]
+ unset ::env(TZ)
+ set result
+} {1970}
+test winTime-1.2 {TclpGetDate} {pcOnly} {
+ set ::env(TZ) PST8
+ set result [clock format 1 -format %Y]
+ unset ::env(TZ)
+ set result
+} {1969}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tcl/tools/Makefile.in b/tcl/tools/Makefile.in
new file mode 100644
index 00000000000..a2551c239d6
--- /dev/null
+++ b/tcl/tools/Makefile.in
@@ -0,0 +1,69 @@
+# This makefile is used to convert Tcl manual pages into various
+# alternate formats:
+#
+# Windows help file: 1. Build the winhelp target on Unix
+# 2. Build the helpfile target on Windows
+#
+# HTML: 1. Build the html target on Unix
+
+# RCS: @(#) $Id$
+
+TCL = tcl@TCL_VERSION@
+TK = tk@TCL_VERSION@
+VER = @TCL_WIN_VERSION@
+
+TCL_BIN_DIR = @TCL_BIN_DIR@
+TCL_SOURCE = @TCL_SRC_DIR@
+TK_SOURCE = $(TCL_SOURCE)/../$(TK)
+PRO_SOURCE = $(TCL_SOURCE)/../pro
+ITCL_SOURCE = $(TCL_SOURCE)/../itcl3.1.0
+
+TCL_DOCS = $(TCL_SOURCE)/doc/*.[13n]
+
+TK_DOCS = $(TK_SOURCE)/doc/*.[13n]
+
+PRO_DOCS = \
+ $(PRO_SOURCE)/doc/man/procheck.1 \
+ $(PRO_SOURCE)/doc/man/prodebug.1 \
+ $(PRO_SOURCE)/doc/man/prodebug.n \
+ $(PRO_SOURCE)/doc/man/prolicense.1
+
+ITCL_DOCS = \
+ $(ITCL_SOURCE)/itcl/doc/*.[13n] \
+ $(ITCL_SOURCE)/itk/doc/*.[13n]
+
+# $(ITCL_SOURCE)/iwidgets3.0.0/doc/*.[13n]
+
+COREDOCS = $(TCL_DOCS) $(TK_DOCS)
+#PRODOCS = $(COREDOCS) $(PRO_DOCS) $(ITCL_DOCS)
+PRODOCS = $(COREDOCS) $(PRO_DOCS)
+TCLSH = $(TCL_BIN_DIR)/tclsh
+CC = @CC@
+
+#
+# Targets
+#
+
+all: core
+
+pro:
+ $(MAKE) DOCS="$(PRODOCS)" VER="" rtf
+
+core:
+ $(MAKE) DOCS="$(COREDOCS)" rtf
+
+rtf: $(TCL_SOURCE)/tools/man2help.tcl man2tcl $(DOCS)
+ LD_LIBRARY_PATH=$(TCL_BIN_DIR) \
+ TCL_LIBRARY=$(TCL_SOURCE)/library \
+ $(TCLSH) $(TCL_SOURCE)/tools/man2help.tcl tcl "$(VER)" $(DOCS)
+
+winhelp: tcl.rtf
+
+man2tcl: $(TCL_SOURCE)/tools/man2tcl.c
+ $(CC) $(CFLAGS) -o man2tcl $(TCL_SOURCE)/tools/man2tcl.c
+
+clean:
+ -rm -f man2tcl *.o *.cnt *.rtf
+
+helpfile:
+ hcw /c /e tcl.hpj
diff --git a/tcl/tools/README b/tcl/tools/README
new file mode 100644
index 00000000000..821b2b3e377
--- /dev/null
+++ b/tcl/tools/README
@@ -0,0 +1,28 @@
+This directory contains unsupported tools used to build parts of Tcl
+for distribution.
+
+
+uniParse.tcl -- Script for converting the Unicode character database
+ into a compact table stored in generic/tclUniData.c.
+
+uniClass.tcl -- Script for generating regexp class tables from the Tcl
+ "string is" classes
+
+Generating HTML files.
+The tcl-tk-man-html.tcl script from Robert Critchlow
+generates a nice set of HTML with good cross references.
+Use it like
+ tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl8.2
+This script is very picky about the organization of man pages,
+effectively acting as a style enforcer.
+
+Generating Windows Help Files:
+1) Build tcl in the ../unix directory
+2) On UNIX, (after autoconf and configure), do
+ make
+ this converts the Nroff to RTF files.
+2) On Windows, convert the RTF to a Help doc, do
+ nmake helpfile
+
+Generating Windows binary distribution.
+Update and compile the WYSE tcl.wse configuration.
diff --git a/tcl/tools/checkLibraryDoc.tcl b/tcl/tools/checkLibraryDoc.tcl
new file mode 100644
index 00000000000..3e7169b6ff5
--- /dev/null
+++ b/tcl/tools/checkLibraryDoc.tcl
@@ -0,0 +1,296 @@
+# checkLibraryDoc.tcl --
+#
+# This script attempts to determine what APIs exist in the source base that
+# have not been documented. By grepping through all of the doc/*.3 man
+# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
+# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch])
+# we create six lists:
+# 1) APIs in Source not in Docs.
+# 2) APIs in Docs not in Source.
+# 3) Internal APIs and structs.
+# 4) Misc APIs and structs that we are not documenting.
+# 5) Command APIs (e.g., Tcl_ArrayObjCmd.)
+# 6) Proc pointers (e.g., Tcl_CloseProc.)
+#
+# Note: Each list is "a best guess" approximation. If developers write
+# non-standard code, this script will produce erroneous results. Each
+# list should be carefully checked for accuracy.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+
+lappend auto_path "c:/program\ files/tclpro1.2/win32-ix86/bin"
+#lappend auto_path "/home/surles/cvs/tclx8.0/tcl/unix"
+if {[catch {package require Tclx}]} {
+ puts "error: could not load TclX. Please set TCL_LIBRARY."
+ exit 1
+}
+
+# A list of structs that are known to be undocumented.
+
+set StructList {
+ Tcl_AsyncHandler \
+ Tcl_CallFrame \
+ Tcl_Condition \
+ Tcl_Encoding \
+ Tcl_EncodingState \
+ Tcl_EncodingType \
+ Tcl_EolTranslation \
+ Tcl_HashEntry \
+ Tcl_HashSearch \
+ Tcl_HashTable \
+ Tcl_Mutex \
+ Tcl_Pid \
+ Tcl_QueuePosition \
+ Tcl_ResolvedVarInfo \
+ Tcl_SavedResult \
+ Tcl_ThreadDataKey \
+ Tcl_ThreadId \
+ Tcl_Time \
+ Tcl_TimerToken \
+ Tcl_Token \
+ Tcl_Trace \
+ Tcl_Value \
+ Tcl_ValueType \
+ Tcl_Var \
+ Tk_3DBorder \
+ Tk_ArgvInfo \
+ Tk_BindingTable \
+ Tk_Canvas \
+ Tk_CanvasTextInfo \
+ Tk_ConfigSpec \
+ Tk_ConfigTypes \
+ Tk_Cursor \
+ Tk_CustomOption \
+ Tk_ErrorHandler \
+ Tk_FakeWin \
+ Tk_Font \
+ Tk_FontMetrics \
+ Tk_GeomMgr \
+ Tk_Image \
+ Tk_ImageMaster \
+ Tk_ImageType \
+ Tk_Item \
+ Tk_ItemType \
+ Tk_OptionSpec\
+ Tk_OptionTable \
+ Tk_OptionType \
+ Tk_PhotoHandle \
+ Tk_PhotoImageBlock \
+ Tk_PhotoImageFormat \
+ Tk_PostscriptInfo \
+ Tk_SavedOption \
+ Tk_SavedOptions \
+ Tk_SegType \
+ Tk_TextLayout \
+ Tk_Window \
+}
+
+# Misc junk that appears in the comments of the source. This just
+# allows us to filter comments that "fool" the script.
+
+set CommentList {
+ Tcl_Create\[Obj\]Command \
+ Tcl_DecrRefCount\\n \
+ Tcl_NewObj\\n \
+ Tk_GetXXX \
+}
+
+# Main entry point to this script.
+
+proc main {} {
+ global argv0
+ global argv
+
+ set len [llength $argv]
+ if {($len != 2) && ($len != 3)} {
+ puts "usage: $argv0 pkgName pkgDir \[outFile\]"
+ puts " pkgName == Tcl,Tk"
+ puts " pkgDir == /home/surles/cvs/tcl8.2"
+ exit 1
+ }
+
+ set pkg [lindex $argv 0]
+ set dir [lindex $argv 1]
+ if {[llength $argv] == 3} {
+ set file [open [lindex $argv 2] w]
+ } else {
+ set file stdout
+ }
+
+ foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {}
+ filter $c $d $dir $pkg $file
+
+ if {$file != "stdout"} {
+ close $file
+ }
+ return
+}
+
+# Intersect the two list and write out the sets of APIs in one
+# list that is not in the other.
+
+proc compare {list1 list2} {
+ set inter [intersect3 $list1 $list2]
+ return [list [lindex $inter 0] [lindex $inter 2]]
+}
+
+# Filter the lists into the six lists we report on. Then write
+# the results to the file.
+
+proc filter {code docs dir pkg {outFile stdout}} {
+ set apis {}
+
+ # A list of Tcl command APIs. These are not documented.
+ # This list should just be verified for accuracy.
+
+ set cmds {}
+
+ # A list of proc pointer structs. These are not documented.
+ # This list should just be verified for accuracy.
+
+ set procs {}
+
+ # A list of internal declarations. These are not documented.
+ # This list should just be verified for accuracy.
+
+ set decls [grepDecl $dir $pkg]
+
+ # A list of misc. procedure declarations that are not documented.
+ # This list should just be verified for accuracy.
+
+ set misc [grepMisc $dir $pkg]
+
+ set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
+
+ # A list of APIs in the source, not in the docs.
+ # This list should just be verified for accuracy.
+
+ foreach x $code {
+ if {[string match *Cmd $x]} {
+ if {[string match ${pkg}* $x]} {
+ lappend cmds $x
+ }
+ } elseif {[string match *Proc $x]} {
+ if {[string match ${pkg}* $x]} {
+ lappend procs $x
+ }
+ } elseif {[lsearch -exact $decls $x] >= 0} {
+ # No Op.
+ } elseif {[lsearch -exact $misc $x] >= 0} {
+ # No Op.
+ } else {
+ lappend apis $x
+ }
+ }
+
+ dump $apis "APIs in Source not in Docs." $outFile
+ dump $docs "APIs in Docs not in Source." $outFile
+ dump $decls "Internal APIs and structs." $outFile
+ dump $misc "Misc APIs and structs that we are not documenting." $outFile
+ dump $cmds "Command APIs." $outFile
+ dump $procs "Proc pointers." $outFile
+ return
+}
+
+# Print the list of APIs if the list is not null.
+
+proc dump {list title file} {
+ if {$list != {}} {
+ puts $file ""
+ puts $file $title
+ puts $file "---------------------------------------------------------"
+ foreach x $list {
+ puts $file $x
+ }
+ }
+}
+
+# Grep into "dir/*/*.[ch]" looking for APIs that match $pkg_*.
+# (e.g., Tcl_Exit). Return a list of APIs.
+
+proc grepCode {dir pkg} {
+ set apis [myGrep "${pkg}_\.\*" "${dir}/\*/\*\.\[ch\]"]
+ set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
+
+ foreach a $apis {
+ if {[regexp -- $pat1 $a main n1]} {
+ set result([string trim $n1]) 1
+ }
+ }
+ return [lsort [array names result]]
+}
+
+# Grep into "dir/doc/*.3" looking for APIs that match $pkg_*.
+# (e.g., Tcl_Exit). Return a list of APIs.
+
+proc grepDocs {dir pkg} {
+ set apis [myGrep "\\fB${pkg}_\.\*\\fR" "${dir}/doc/\*\.3"]
+ set pat1 ".*(${pkg}_\[A-z0-9]+)\\\\fR.*$"
+
+ foreach a $apis {
+ if {[regexp -- $pat1 $a main n1]} {
+ set result([string trim $n1]) 1
+ }
+ }
+ return [lsort [array names result]]
+}
+
+# Grep into "generic/pkgIntDecls.h" looking for APIs that match $pkg_*.
+# (e.g., Tcl_Export). Return a list of APIs.
+
+proc grepDecl {dir pkg} {
+ set file [file join $dir generic "[string tolower $pkg]IntDecls.h"]
+ set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_.*" $file]
+ set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
+
+ foreach a $apis {
+ if {[regexp -- $pat1 $a main n1]} {
+ set result([string trim $n1]) 1
+ }
+ }
+ return [lsort [array names result]]
+}
+
+# Grep into "*/*.[ch]" looking for APIs that match $pkg_Db*.
+# (e.g., Tcl_DbCkalloc). Return a list of APIs.
+
+proc grepMisc {dir pkg} {
+ global CommentList
+ global StructList
+
+ set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_Db.*" "${dir}/\*/\*\.\[ch\]"]
+ set pat1 ".*(${pkg}_\[A-z0-9]+).*$"
+
+ foreach a $apis {
+ if {[regexp -- $pat1 $a main n1]} {
+ set dbg([string trim $n1]) 1
+ }
+ }
+
+ set result {}
+ eval {lappend result} $StructList
+ eval {lappend result} [lsort [array names dbg]]
+ eval {lappend result} $CommentList
+ return $result
+}
+
+proc myGrep {searchPat globPat} {
+ set result {}
+ foreach file [glob -nocomplain $globPat] {
+ set file [open $file r]
+ set data [read $file]
+ close $file
+ foreach line [split $data "\n"] {
+ if {[regexp "^.*${searchPat}.*\$" $line]} {
+ lappend result $line
+ }
+ }
+ }
+ return $result
+}
+main
+
diff --git a/tcl/tools/configure b/tcl/tools/configure
new file mode 100755
index 00000000000..c63dbe2f201
--- /dev/null
+++ b/tcl/tools/configure
@@ -0,0 +1,749 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.9
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.1 binaries from DIR"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.9"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set LANG and LC_ALL to C if already set.
+# These must not be set unconditionally because not all systems understand
+# e.g. LANG=C (notably SCO).
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=man2tcl.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+# RCS: @(#) $Id$
+
+# Recover information that Tcl computed with its configure script.
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tcl is; if
+# not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ TCL_BIN_DIR=$withval
+else
+ TCL_BIN_DIR=`cd ../../tcl8.1$TCL_PATCH_LEVEL/unix; pwd`
+fi
+
+if test ! -d $TCL_BIN_DIR; then
+ { echo "configure: error: Tcl directory $TCL_BIN_DIR doesn't exist" 1>&2; exit 1; }
+fi
+if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
+ { echo "configure: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; }
+fi
+
+. $TCL_BIN_DIR/tclConfig.sh
+
+TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
+
+CC=$TCL_CC
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \
+ >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.9"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile tcl.hpj" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@TCL_WIN_VERSION@%$TCL_WIN_VERSION%g
+s%@CC@%$CC%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+
+CEOF
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile tcl.hpj"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust relative srcdir, etc. for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file
+fi; done
+rm -f conftest.subs
+
+
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tcl/tools/configure.in b/tcl/tools/configure.in
new file mode 100644
index 00000000000..7b6d947087e
--- /dev/null
+++ b/tcl/tools/configure.in
@@ -0,0 +1,33 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run to configure the
+dnl Makefile in this directory.
+AC_INIT(man2tcl.c)
+# RCS: @(#) $Id$
+
+# Recover information that Tcl computed with its configure script.
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tcl is; if
+# not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.3 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl8.3$TCL_PATCH_LEVEL/unix; pwd`)
+if test ! -d $TCL_BIN_DIR; then
+ AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
+fi
+if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
+ AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
+fi
+
+. $TCL_BIN_DIR/tclConfig.sh
+
+TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
+AC_SUBST(TCL_WIN_VERSION)
+CC=$TCL_CC
+AC_SUBST(CC)
+AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_PATCH_LEVEL)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_BIN_DIR)
+
+AC_OUTPUT(Makefile tcl.hpj)
diff --git a/tcl/tools/cvtEOL.tcl b/tcl/tools/cvtEOL.tcl
new file mode 100644
index 00000000000..e2df3410217
--- /dev/null
+++ b/tcl/tools/cvtEOL.tcl
@@ -0,0 +1,35 @@
+# cvtEOL.tcl --
+#
+# This file contains a script to parse a Tcl/Tk distribution and
+# convert the EOL from \n to \r on all text files.
+#
+# Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+#
+# SCCS: @(#) cvtEOL.tcl 1.1 97/01/30 11:33:33
+#
+
+#
+# Convert files in the distribution to Mac style
+#
+
+set distDir [lindex $argv 0]
+
+set dirs {unix mac generic win library compat tests unix/dltest \
+ library/demos library/demos/images bitmaps xlib xlib/X11 .}
+set files {*.c *.y *.h *.r *.tcl *.test *.rc *.bc *.vc *.bmp *.html \
+ *.in *.notes *.terms all defs \
+ README ToDo changes tclIndex configure install-sh mkLinks \
+ square widget rmt ixset hello browse rolodex tcolor timer}
+
+foreach x $dirs {
+ if [catch {cd $distDir/$x}] continue
+ puts "Working on $x..."
+ foreach y [eval glob $files] {
+ exec chmod 666 $y
+ exec cp $y $y.tmp
+ exec tr \012 \015 < $y.tmp > $y
+ exec chmod 444 $y
+ exec rm $y.tmp
+ }
+}
+
diff --git a/tcl/tools/genStubs.tcl b/tcl/tools/genStubs.tcl
new file mode 100644
index 00000000000..ee0bfd4d067
--- /dev/null
+++ b/tcl/tools/genStubs.tcl
@@ -0,0 +1,894 @@
+# genStubs.tcl --
+#
+# This script generates a set of stub files for a given
+# interface.
+#
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+namespace eval genStubs {
+ # libraryName --
+ #
+ # The name of the entire library. This value is used to compute
+ # the USE_*_STUB_PROCS macro and the name of the init file.
+
+ variable libraryName "UNKNOWN"
+
+ # interfaces --
+ #
+ # An array indexed by interface name that is used to maintain
+ # the set of valid interfaces. The value is empty.
+
+ array set interfaces {}
+
+ # curName --
+ #
+ # The name of the interface currently being defined.
+
+ variable curName "UNKNOWN"
+
+ # hooks --
+ #
+ # An array indexed by interface name that contains the set of
+ # subinterfaces that should be defined for a given interface.
+
+ array set hooks {}
+
+ # stubs --
+ #
+ # This three dimensional array is indexed first by interface name,
+ # second by platform name, and third by a numeric offset or the
+ # constant "lastNum". The lastNum entry contains the largest
+ # numeric offset used for a given interface/platform combo. Each
+ # numeric offset contains the C function specification that
+ # should be used for the given entry in the stub table. The spec
+ # consists of a list in the form returned by parseDecl.
+
+ array set stubs {}
+
+ # outDir --
+ #
+ # The directory where the generated files should be placed.
+
+ variable outDir .
+}
+
+# genStubs::library --
+#
+# This function is used in the declarations file to set the name
+# of the library that the interfaces are associated with (e.g. "tcl").
+# This value will be used to define the inline conditional macro.
+#
+# Arguments:
+# name The library name.
+#
+# Results:
+# None.
+
+proc genStubs::library {name} {
+ variable libraryName $name
+}
+
+# genStubs::interface --
+#
+# This function is used in the declarations file to set the name
+# of the interface currently being defined.
+#
+# Arguments:
+# name The name of the interface.
+#
+# Results:
+# None.
+
+proc genStubs::interface {name} {
+ variable curName $name
+ variable interfaces
+
+ set interfaces($name) {}
+ return
+}
+
+# genStubs::hooks --
+#
+# This function defines the subinterface hooks for the current
+# interface.
+#
+# Arguments:
+# names The ordered list of interfaces that are reachable through the
+# hook vector.
+#
+# Results:
+# None.
+
+proc genStubs::hooks {names} {
+ variable curName
+ variable hooks
+
+ set hooks($curName) $names
+ return
+}
+
+# genStubs::declare --
+#
+# This function is used in the declarations file to declare a new
+# interface entry.
+#
+# Arguments:
+# index The index number of the interface.
+# platform The platform the interface belongs to. Should be one
+# of generic, win, unix, or mac.
+# decl The C function declaration, or {} for an undefined
+# entry.
+#
+# Results:
+# None.
+
+proc genStubs::declare {args} {
+ variable stubs
+ variable curName
+
+ if {[llength $args] != 3} {
+ puts stderr "wrong # args: declare $args"
+ }
+ lassign $args index platformList decl
+
+ # Check for duplicate declarations, then add the declaration and
+ # bump the lastNum counter if necessary.
+
+ foreach platform $platformList {
+ if {[info exists stubs($curName,$platform,$index)]} {
+ puts stderr "Duplicate entry: declare $args"
+ }
+ }
+ regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
+ set decl [parseDecl $decl]
+
+ foreach platform $platformList {
+ if {$decl != ""} {
+ set stubs($curName,$platform,$index) $decl
+ if {![info exists stubs($curName,$platform,lastNum)] \
+ || ($index > $stubs($curName,$platform,lastNum))} {
+ set stubs($curName,$platform,lastNum) $index
+ }
+ }
+ }
+ return
+}
+
+# genStubs::rewriteFile --
+#
+# This function replaces the machine generated portion of the
+# specified file with new contents. It looks for the !BEGIN! and
+# !END! comments to determine where to place the new text.
+#
+# Arguments:
+# file The name of the file to modify.
+# text The new text to place in the file.
+#
+# Results:
+# None.
+
+proc genStubs::rewriteFile {file text} {
+ if {![file exist $file]} {
+ puts stderr "Cannot find file: $file"
+ return
+ }
+ set in [open ${file} r]
+ set out [open ${file}.new w]
+
+ # Always write out the file with LF termination
+ fconfigure $out -translation lf
+
+ while {![eof $in]} {
+ set line [gets $in]
+ if {[regexp {!BEGIN!} $line]} {
+ break
+ }
+ puts $out $line
+ }
+ puts $out "/* !BEGIN!: Do not edit below this line. */"
+ puts $out $text
+ while {![eof $in]} {
+ set line [gets $in]
+ if {[regexp {!END!} $line]} {
+ break
+ }
+ }
+ puts $out "/* !END!: Do not edit above this line. */"
+ puts -nonewline $out [read $in]
+ close $in
+ close $out
+ file rename -force ${file}.new ${file}
+ return
+}
+
+# genStubs::addPlatformGuard --
+#
+# Wrap a string inside a platform #ifdef.
+#
+# Arguments:
+# plat Platform to test.
+#
+# Results:
+# Returns the original text inside an appropriate #ifdef.
+
+proc genStubs::addPlatformGuard {plat text} {
+ switch $plat {
+ win {
+ return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n"
+ }
+ unix {
+ return "#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */\n${text}#endif /* UNIX */\n"
+ }
+ mac {
+ return "#ifdef MAC_TCL\n${text}#endif /* MAC_TCL */\n"
+ }
+ }
+ return "$text"
+}
+
+# genStubs::emitSlots --
+#
+# Generate the stub table slots for the given interface. If there
+# are no generic slots, then one table is generated for each
+# platform, otherwise one table is generated for all platforms.
+#
+# Arguments:
+# name The name of the interface being emitted.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitSlots {name textVar} {
+ variable stubs
+ upvar $textVar text
+
+ forAllStubs $name makeSlot 1 text {" void *reserved$i;\n"}
+ return
+}
+
+# genStubs::parseDecl --
+#
+# Parse a C function declaration into its component parts.
+#
+# Arguments:
+# decl The function declaration.
+#
+# Results:
+# Returns a list of the form {returnType name args}. The args
+# element consists of a list of type/name pairs, or a single
+# element "void". If the function declaration is malformed
+# then an error is displayed and the return value is {}.
+
+proc genStubs::parseDecl {decl} {
+ if {![regexp {^(.*)\((.*)\)$} $decl all prefix args]} {
+ puts stderr "Malformed declaration: $decl"
+ return
+ }
+ set prefix [string trim $prefix]
+ if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} {
+ puts stderr "Bad return type: $decl"
+ return
+ }
+ set rtype [string trim $rtype]
+ foreach arg [split $args ,] {
+ lappend argList [string trim $arg]
+ }
+ if {![string compare [lindex $argList end] "..."]} {
+ if {[llength $argList] != 2} {
+ puts stderr "Only one argument is allowed in varargs form: $decl"
+ }
+ set arg [parseArg [lindex $argList 0]]
+ if {$arg == "" || ([llength $arg] != 2)} {
+ puts stderr "Bad argument: '[lindex $argList 0]' in '$decl'"
+ return
+ }
+ set args [list TCL_VARARGS $arg]
+ } else {
+ set args {}
+ foreach arg $argList {
+ set argInfo [parseArg $arg]
+ if {![string compare $argInfo "void"]} {
+ lappend args "void"
+ break
+ } elseif {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
+ lappend args $argInfo
+ } else {
+ puts stderr "Bad argument: '$arg' in '$decl'"
+ return
+ }
+ }
+ }
+ return [list $rtype $fname $args]
+}
+
+# genStubs::parseArg --
+#
+# This function parses a function argument into a type and name.
+#
+# Arguments:
+# arg The argument to parse.
+#
+# Results:
+# Returns a list of type and name with an optional third array
+# indicator. If the argument is malformed, returns "".
+
+proc genStubs::parseArg {arg} {
+ if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
+ if {$arg == "void"} {
+ return $arg
+ } else {
+ return
+ }
+ }
+ set result [list [string trim $type] $name]
+ if {$array != ""} {
+ lappend result $array
+ }
+ return $result
+}
+
+# genStubs::makeDecl --
+#
+# Generate the prototype for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted declaration string.
+
+proc genStubs::makeDecl {name decl index} {
+ lassign $decl rtype fname args
+
+ append text "/* $index */\n"
+ set line "EXTERN $rtype"
+ set count [expr {2 - ([string length $line] / 8)}]
+ append line [string range "\t\t\t" 0 $count]
+ set pad [expr {24 - [string length $line]}]
+ if {$pad <= 0} {
+ append line " "
+ set pad 0
+ }
+ append line "$fname _ANSI_ARGS_("
+
+ set arg1 [lindex $args 0]
+ switch -exact $arg1 {
+ void {
+ append line "(void)"
+ }
+ TCL_VARARGS {
+ set arg [lindex $args 1]
+ append line "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
+ }
+ default {
+ set sep "("
+ foreach arg $args {
+ append line $sep
+ set next {}
+ append next [lindex $arg 0] " " [lindex $arg 1] \
+ [lindex $arg 2]
+ if {[string length $line] + [string length $next] \
+ + $pad > 76} {
+ append text $line \n
+ set line "\t\t\t\t"
+ set pad 28
+ }
+ append line $next
+ set sep ", "
+ }
+ append line ")"
+ }
+ }
+ append text $line
+
+ append text ");\n"
+ return $text
+}
+
+# genStubs::makeMacro --
+#
+# Generate the inline macro for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted macro definition.
+
+proc genStubs::makeMacro {name decl index} {
+ lassign $decl rtype fname args
+
+ set lfname [string tolower [string index $fname 0]]
+ append lfname [string range $fname 1 end]
+
+ set text "#ifndef $fname\n#define $fname"
+ set arg1 [lindex $args 0]
+ set argList ""
+ switch -exact $arg1 {
+ void {
+ set argList "()"
+ }
+ TCL_VARARGS {
+ }
+ default {
+ set sep "("
+ foreach arg $args {
+ append argList $sep [lindex $arg 1]
+ set sep ", "
+ }
+ append argList ")"
+ }
+ }
+ append text " \\\n\t(${name}StubsPtr->$lfname)"
+ append text " /* $index */\n#endif\n"
+ return $text
+}
+
+# genStubs::makeStub --
+#
+# Emits a stub function definition.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted stub function definition.
+
+proc genStubs::makeStub {name decl index} {
+ lassign $decl rtype fname args
+
+ set lfname [string tolower [string index $fname 0]]
+ append lfname [string range $fname 1 end]
+
+ append text "/* Slot $index */\n" $rtype "\n" $fname
+
+ set arg1 [lindex $args 0]
+
+ if {![string compare $arg1 "TCL_VARARGS"]} {
+ lassign [lindex $args 1] type argName
+ append text " TCL_VARARGS_DEF($type,$argName)\n\{\n"
+ append text " " $type " var;\n va_list argList;\n"
+ if {[string compare $rtype "void"]} {
+ append text " " $rtype " resultValue;\n"
+ }
+ append text "\n var = (" $type ") TCL_VARARGS_START(" \
+ $type "," $argName ",argList);\n\n "
+ if {[string compare $rtype "void"]} {
+ append text "resultValue = "
+ }
+ append text "(" $name "StubsPtr->" $lfname "VA)(var, argList);\n"
+ append text " va_end(argList);\n"
+ if {[string compare $rtype "void"]} {
+ append text "return resultValue;\n"
+ }
+ append text "\}\n\n"
+ return $text
+ }
+
+ if {![string compare $arg1 "void"]} {
+ set argList "()"
+ set argDecls ""
+ } else {
+ set argList ""
+ set sep "("
+ foreach arg $args {
+ append argList $sep [lindex $arg 1]
+ append argDecls " " [lindex $arg 0] " " \
+ [lindex $arg 1] [lindex $arg 2] ";\n"
+ set sep ", "
+ }
+ append argList ")"
+ }
+ append text $argList "\n" $argDecls "{\n "
+ if {[string compare $rtype "void"]} {
+ append text "return "
+ }
+ append text "(" $name "StubsPtr->" $lfname ")" $argList ";\n}\n\n"
+ return $text
+}
+
+# genStubs::makeSlot --
+#
+# Generate the stub table entry for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted table entry.
+
+proc genStubs::makeSlot {name decl index} {
+ lassign $decl rtype fname args
+
+ set lfname [string tolower [string index $fname 0]]
+ append lfname [string range $fname 1 end]
+
+ set text " "
+ append text $rtype " (*" $lfname ") _ANSI_ARGS_("
+
+ set arg1 [lindex $args 0]
+ switch -exact $arg1 {
+ void {
+ append text "(void)"
+ }
+ TCL_VARARGS {
+ set arg [lindex $args 1]
+ append text "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
+ }
+ default {
+ set sep "("
+ foreach arg $args {
+ append text $sep [lindex $arg 0] " " [lindex $arg 1] \
+ [lindex $arg 2]
+ set sep ", "
+ }
+ append text ")"
+ }
+ }
+
+ append text "); /* $index */\n"
+ return $text
+}
+
+# genStubs::makeInit --
+#
+# Generate the prototype for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted declaration string.
+
+proc genStubs::makeInit {name decl index} {
+ append text " " [lindex $decl 1] ", /* " $index " */\n"
+ return $text
+}
+
+# genStubs::forAllStubs --
+#
+# This function iterates over all of the platforms and invokes
+# a callback for each slot. The result of the callback is then
+# placed inside appropriate platform guards.
+#
+# Arguments:
+# name The interface name.
+# slotProc The proc to invoke to handle the slot. It will
+# have the interface name, the declaration, and
+# the index appended.
+# onAll If 1, emit the skip string even if there are
+# definitions for one or more platforms.
+# textVar The variable to use for output.
+# skipString The string to emit if a slot is skipped. This
+# string will be subst'ed in the loop so "$i" can
+# be used to substitute the index value.
+#
+# Results:
+# None.
+
+proc genStubs::forAllStubs {name slotProc onAll textVar \
+ {skipString {"/* Slot $i is reserved */\n"}}} {
+ variable stubs
+ upvar $textVar text
+
+ set plats [array names stubs $name,*,lastNum]
+ if {[info exists stubs($name,generic,lastNum)]} {
+ # Emit integrated stubs block
+ set lastNum -1
+ foreach plat [array names stubs $name,*,lastNum] {
+ if {$stubs($plat) > $lastNum} {
+ set lastNum $stubs($plat)
+ }
+ }
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ set slots [array names stubs $name,*,$i]
+ set emit 0
+ if {[info exists stubs($name,generic,$i)]} {
+ if {[llength $slots] > 1} {
+ puts stderr "platform entry duplicates generic entry: $i"
+ }
+ append text [$slotProc $name $stubs($name,generic,$i) $i]
+ set emit 1
+ } elseif {[llength $slots] > 0} {
+ foreach plat {unix win mac} {
+ if {[info exists stubs($name,$plat,$i)]} {
+ append text [addPlatformGuard $plat \
+ [$slotProc $name $stubs($name,$plat,$i) $i]]
+ set emit 1
+ } elseif {$onAll} {
+ append text [eval {addPlatformGuard $plat} $skipString]
+ set emit 1
+ }
+ }
+ }
+ if {$emit == 0} {
+ eval {append text} $skipString
+ }
+ }
+
+ } else {
+ # Emit separate stubs blocks per platform
+ foreach plat {unix win mac} {
+ if {[info exists stubs($name,$plat,lastNum)]} {
+ set lastNum $stubs($name,$plat,lastNum)
+ set temp {}
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ if {![info exists stubs($name,$plat,$i)]} {
+ eval {append temp} $skipString
+ } else {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ }
+ }
+ append text [addPlatformGuard $plat $temp]
+ }
+ }
+ }
+
+}
+
+# genStubs::emitDeclarations --
+#
+# This function emits the function declarations for this interface.
+#
+# Arguments:
+# name The interface name.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitDeclarations {name textVar} {
+ variable stubs
+ upvar $textVar text
+
+ append text "\n/*\n * Exported function declarations:\n */\n\n"
+ forAllStubs $name makeDecl 0 text
+ return
+}
+
+# genStubs::emitMacros --
+#
+# This function emits the inline macros for an interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitMacros {name textVar} {
+ variable stubs
+ variable libraryName
+ upvar $textVar text
+
+ set upName [string toupper $libraryName]
+ append text "\n#if defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS)\n"
+ append text "\n/*\n * Inline function declarations:\n */\n\n"
+
+ forAllStubs $name makeMacro 0 text
+
+ append text "\n#endif /* defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS) */\n"
+ return
+}
+
+# genStubs::emitHeader --
+#
+# This function emits the body of the <name>Decls.h file for
+# the specified interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+#
+# Results:
+# None.
+
+proc genStubs::emitHeader {name} {
+ variable outDir
+ variable hooks
+
+ set capName [string toupper [string index $name 0]]
+ append capName [string range $name 1 end]
+
+ emitDeclarations $name text
+
+ if {[info exists hooks($name)]} {
+ append text "\ntypedef struct ${capName}StubHooks {\n"
+ foreach hook $hooks($name) {
+ set capHook [string toupper [string index $hook 0]]
+ append capHook [string range $hook 1 end]
+ append text " struct ${capHook}Stubs *${hook}Stubs;\n"
+ }
+ append text "} ${capName}StubHooks;\n"
+ }
+ append text "\ntypedef struct ${capName}Stubs {\n"
+ append text " int magic;\n"
+ append text " struct ${capName}StubHooks *hooks;\n\n"
+
+ emitSlots $name text
+
+ append text "} ${capName}Stubs;\n"
+
+ append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
+ append text "extern ${capName}Stubs *${name}StubsPtr;\n"
+ append text "#ifdef __cplusplus\n}\n#endif\n"
+
+ emitMacros $name text
+
+ rewriteFile [file join $outDir ${name}Decls.h] $text
+ return
+}
+
+# genStubs::emitStubs --
+#
+# This function emits the body of the <name>Stubs.c file for
+# the specified interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+#
+# Results:
+# None.
+
+proc genStubs::emitStubs {name} {
+ variable outDir
+
+ append text "\n/*\n * Exported stub functions:\n */\n\n"
+ forAllStubs $name makeStub 0 text
+
+ rewriteFile [file join $outDir ${name}Stubs.c] $text
+ return
+}
+
+# genStubs::emitInit --
+#
+# Generate the table initializers for an interface.
+#
+# Arguments:
+# name The name of the interface to initialize.
+# textVar The variable to use for output.
+#
+# Results:
+# Returns the formatted output.
+
+proc genStubs::emitInit {name textVar} {
+ variable stubs
+ variable hooks
+ upvar $textVar text
+
+ set capName [string toupper [string index $name 0]]
+ append capName [string range $name 1 end]
+
+ if {[info exists hooks($name)]} {
+ append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n"
+ set sep " "
+ foreach sub $hooks($name) {
+ append text $sep "&${sub}Stubs"
+ set sep ",\n "
+ }
+ append text "\n\};\n"
+ }
+ append text "\n${capName}Stubs ${name}Stubs = \{\n"
+ append text " TCL_STUB_MAGIC,\n"
+ if {[info exists hooks($name)]} {
+ append text " &${name}StubHooks,\n"
+ } else {
+ append text " NULL,\n"
+ }
+
+ forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"}
+
+ append text "\};\n"
+ return
+}
+
+# genStubs::emitInits --
+#
+# This function emits the body of the <name>StubInit.c file for
+# the specified interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+#
+# Results:
+# None.
+
+proc genStubs::emitInits {} {
+ variable hooks
+ variable outDir
+ variable libraryName
+ variable interfaces
+
+ # Assuming that dependencies only go one level deep, we need to emit
+ # all of the leaves first to avoid needing forward declarations.
+
+ set leaves {}
+ set roots {}
+ foreach name [lsort [array names interfaces]] {
+ if {[info exists hooks($name)]} {
+ lappend roots $name
+ } else {
+ lappend leaves $name
+ }
+ }
+ foreach name $leaves {
+ emitInit $name text
+ }
+ foreach name $roots {
+ emitInit $name text
+ }
+
+ rewriteFile [file join $outDir ${libraryName}StubInit.c] $text
+}
+
+# genStubs::init --
+#
+# This is the main entry point.
+#
+# Arguments:
+# None.
+#
+# Results:
+# None.
+
+proc genStubs::init {} {
+ global argv argv0
+ variable outDir
+ variable interfaces
+
+ if {[llength $argv] < 2} {
+ puts stderr "usage: $argv0 outDir declFile ?declFile...?"
+ exit 1
+ }
+
+ set outDir [lindex $argv 0]
+
+ foreach file [lrange $argv 1 end] {
+ source $file
+ }
+
+ foreach name [lsort [array names interfaces]] {
+ puts "Emitting $name"
+ emitHeader $name
+ }
+
+ emitInits
+}
+
+# lassign --
+#
+# This function emulates the TclX lassign command.
+#
+# Arguments:
+# valueList A list containing the values to be assigned.
+# args The list of variables to be assigned.
+#
+# Results:
+# Returns any values that were not assigned to variables.
+
+proc lassign {valueList args} {
+ if {[llength $args] == 0} {
+ error "wrong # args: lassign list varname ?varname..?"
+ }
+
+ uplevel [list foreach $args $valueList {break}]
+ return [lrange $valueList [llength $args] end]
+}
+
+genStubs::init
diff --git a/tcl/tools/genWinImage.tcl b/tcl/tools/genWinImage.tcl
new file mode 100644
index 00000000000..b49c52a45ab
--- /dev/null
+++ b/tcl/tools/genWinImage.tcl
@@ -0,0 +1,158 @@
+# genWinImage.tcl --
+#
+# This script generates the Windows installer.
+#
+# Copyright (c) 1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+
+# This file is insensitive to the directory from which it is invoked.
+
+namespace eval genWinImage {
+ # toolsDir --
+ #
+ # This variable points to the platform specific tools directory.
+
+ variable toolsDir
+
+ # tclBuildDir --
+ #
+ # This variable points to the directory containing the Tcl built tree.
+
+ variable tclBuildDir
+
+ # tkBuildDir --
+ #
+ # This variable points to the directory containing the Tk built tree.
+
+ variable tkBuildDir
+
+ # our script name at runtime
+ variable script [info script]
+}
+
+# genWinImage::init --
+#
+# This is the main entry point.
+#
+# Arguments:
+# None.
+#
+# Results:
+# None.
+
+proc genWinImage::init {} {
+ global tcl_platform argv argv0
+ variable tclBuildDir
+ variable tkBuildDir
+ variable toolsDir
+ variable script
+
+ puts "\n--- $script started: \
+ [clock format [clock seconds] -format "%Y%m%d-%H:%M"] --\n"
+
+ if {$tcl_platform(platform) != "windows"} {
+ puts stderr "ERROR: Cannot build TCL.EXE on Unix systems"
+ exit 1
+ }
+
+ if {[llength $argv] != 3} {
+ puts stderr "usage: $argv0 <tclBuildDir> <tkBuildDir> <toolsDir>"
+ exit 0
+ }
+
+ set tclBuildDir [lindex $argv 0]
+ set tkBuildDir [lindex $argv 1]
+ set toolsDir [lindex $argv 2]
+
+ generateInstallers
+
+ puts "\n--- $script finished: \
+ [clock format [clock seconds] -format "%Y%m%d-%H:%M"] --\n\n"
+}
+
+# genWinImage::makeTextFile --
+#
+# Convert the input file into a CRLF terminated text file.
+#
+# Arguments:
+# infile The input file to convert.
+# outfile The location where the text file should be stored.
+#
+# Results:
+# None.
+
+proc genWinImage::makeTextFile {infile outfile} {
+ set f [open $infile r]
+ set text [read $f]
+ close $f
+ set f [open $outfile w]
+ fconfigure $f -translation crlf
+ puts -nonewline $f $text
+ close $f
+}
+
+# genWinImage::generateInstallers --
+#
+# Perform substitutions on the pro.wse.in file and then
+# invoke the WSE script twice; once for CD and once for web.
+#
+# Arguments:
+# None.
+#
+# Results:
+# Leaves proweb.exe and procd.exe sitting in the curent directory.
+
+proc genWinImage::generateInstallers {} {
+ variable toolsDir
+ variable tclBuildDir
+ variable tkBuildDir
+
+ # Now read the "pro/srcs/install/pro.wse.in" file, have Tcl make
+ # appropriate substitutions, write out the resulting file in a
+ # current-working-directory. Use this new file to perform installation
+ # image creation. Note that we have to use this technique to set
+ # the value of _WISE_ because wise32 won't use a /d switch for this
+ # variable.
+
+ set __TCLBASEDIR__ [file native $tclBuildDir]
+ set __TKBASEDIR__ [file native $tkBuildDir]
+ set __WISE__ [file native [file join $toolsDir wise]]
+
+ set f [open [file join $__TCLBASEDIR__ generic/tcl.h] r]
+ set s [read $f]
+ close $f
+ regexp {TCL_PATCH_LEVEL\s*\"([^\"]*)\"} $s dummy __TCL_PATCH_LEVEL__
+
+ set f [open tcl.wse.in r]
+ set s [read $f]
+ close $f
+ set s [subst -nocommands -nobackslashes $s]
+ set f [open tcl.wse w]
+ puts $f $s
+ close $f
+
+ # Ensure the text files are CRLF terminated
+
+ makeTextFile [file join $tclBuildDir win/README.binary] \
+ [file join $tclBuildDir win/readme.txt]
+ makeTextFile [file join $tclBuildDir license.terms] \
+ [file join $tclBuildDir license.txt]
+
+ set wise32ProgFilePath [file native [file join $__WISE__ wise32.exe]]
+
+ # Run the Wise installer to create the Windows install images.
+
+ if {[catch {exec [file native $wise32ProgFilePath] /c tcl.wse} errMsg]} {
+ puts stderr "ERROR: $errMsg"
+ } else {
+ puts "\"TCL.EXE\" created."
+ }
+
+ return
+}
+
+genWinImage::init
+
diff --git a/tcl/tools/index.tcl b/tcl/tools/index.tcl
new file mode 100644
index 00000000000..59942d21013
--- /dev/null
+++ b/tcl/tools/index.tcl
@@ -0,0 +1,202 @@
+# index.tcl --
+#
+# This file defines procedures that are used during the first pass of
+# the man page conversion. It is used to extract information used to
+# generate a table of contents and a keyword list.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+#
+
+# Global variables used by these scripts:
+#
+# state - state variable that controls action of text proc.
+#
+# topics - array indexed by (package,section,topic) with value
+# of topic ID.
+#
+# keywords - array indexed by keyword string with value of topic ID.
+#
+# curID - current topic ID, starts at 0 and is incremented for
+# each new topic file.
+#
+# curPkg - current package name (e.g. Tcl).
+#
+# curSect - current section title (e.g. "Tcl Built-In Commands").
+#
+
+# getPackages --
+#
+# Generate a sorted list of package names from the topics array.
+#
+# Arguments:
+# none.
+
+proc getPackages {} {
+ global topics
+ foreach i [array names topics] {
+ regsub {^(.*),.*,.*$} $i {\1} i
+ set temp($i) {}
+ }
+ lsort [array names temp]
+}
+
+# getSections --
+#
+# Generate a sorted list of section titles in the specified package
+# from the topics array.
+#
+# Arguments:
+# pkg - Name of package to search.
+
+proc getSections {pkg} {
+ global topics
+ regsub -all {[][*?\\]} $pkg {\\&} pkg
+ foreach i [array names topics "${pkg},*"] {
+ regsub {^.*,(.*),.*$} $i {\1} i
+ set temp($i) {}
+ }
+ lsort [array names temp]
+}
+
+# getSections --
+#
+# Generate a sorted list of topics in the specified section of the
+# specified package from the topics array.
+#
+# Arguments:
+# pkg - Name of package to search.
+# sect - Name of section to search.
+
+proc getTopics {pkg sect} {
+ global topics
+ regsub -all {[][*?\\]} $pkg {\\&} pkg
+ regsub -all {[][*?\\]} $sect {\\&} sect
+ foreach i [array names topics "${pkg},${sect},*"] {
+ regsub {^.*,.*,(.*)$} $i {\1} i
+ set temp($i) {}
+ }
+ lsort [array names temp]
+}
+
+# text --
+#
+# This procedure adds entries to the hypertext arrays topics and keywords.
+#
+# Arguments:
+# string - Text to index.
+
+
+proc text string {
+ global state curID curPkg curSect topics keywords
+
+ switch $state {
+ NAME {
+ foreach i [split $string ","] {
+ set topic [string trim $i]
+ set index "$curPkg,$curSect,$topic"
+ if {[info exists topics($index)]
+ && [string compare $topics($index) $curID] != 0} {
+ puts stderr "duplicate topic $topic in $curPkg"
+ }
+ set topics($index) $curID
+ lappend keywords($topic) $curID
+ }
+ }
+ KEY {
+ foreach i [split $string ","] {
+ lappend keywords([string trim $i]) $curID
+ }
+ }
+ DT -
+ OFF -
+ DASH {}
+ default {
+ puts stderr "text: unknown state: $state"
+ }
+ }
+}
+
+
+# macro --
+#
+# This procedure is invoked to process macro invocations that start
+# with "." (instead of ').
+#
+# Arguments:
+# name - The name of the macro (without the ".").
+# args - Any additional arguments to the macro.
+
+proc macro {name args} {
+ switch $name {
+ SH {
+ global state
+
+ switch $args {
+ NAME {
+ if {$state == "INIT" } {
+ set state NAME
+ }
+ }
+ DESCRIPTION {set state DT}
+ INTRODUCTION {set state DT}
+ KEYWORDS {set state KEY}
+ default {set state OFF}
+ }
+
+ }
+ TH {
+ global state curID curPkg curSect topics keywords
+ set state INIT
+ if {[llength $args] != 5} {
+ set args [join $args " "]
+ puts stderr "Bad .TH macro: .$name $args"
+ }
+ incr curID
+ set topic [lindex $args 0] ;# Tcl_UpVar
+ set curPkg [lindex $args 3] ;# Tcl
+ set curSect [lindex $args 4] ;# {Tcl Library Procedures}
+ regsub -all {\\ } $curSect { } curSect
+ set index "$curPkg,$curSect,$topic"
+ set topics($index) $curID
+ lappend keywords($topic) $curID
+ }
+ }
+}
+
+
+# dash --
+#
+# This procedure is invoked to handle dash characters ("\-" in
+# troff). It only function in pass1 is to terminate the NAME state.
+#
+# Arguments:
+# None.
+
+proc dash {} {
+ global state
+ if {$state == "NAME"} {
+ set state DASH
+ }
+}
+
+
+
+# initGlobals, tab, font, char, macro2 --
+#
+# These procedures do nothing during the first pass.
+#
+# Arguments:
+# None.
+
+proc initGlobals {} {}
+proc newline {} {}
+proc tab {} {}
+proc font type {}
+proc char name {}
+proc macro2 {name args} {}
+
diff --git a/tcl/tools/man2help.tcl b/tcl/tools/man2help.tcl
new file mode 100644
index 00000000000..6a3ab6517b7
--- /dev/null
+++ b/tcl/tools/man2help.tcl
@@ -0,0 +1,130 @@
+# man2help.tcl --
+#
+# This file defines procedures that work in conjunction with the
+# man2tcl program to generate a Windows help file from Tcl manual
+# entries.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+#
+# RCS: @(#) $Id$
+#
+
+#
+# PASS 1
+#
+
+proc generateContents {basename version files} {
+ global curID topics
+ set curID 0
+ foreach f $files {
+ puts "Pass 1 -- $f"
+ flush stdout
+ doFile $f
+ }
+ set fd [open "$basename$version.cnt" w]
+ fconfigure $fd -translation crlf
+ puts $fd ":Base $basename$version.hlp"
+ foreach package [getPackages] {
+ foreach section [getSections $package] {
+ puts $fd "1 $section"
+ set lastTopic {}
+ foreach topic [getTopics $package $section] {
+ if {[string compare $lastTopic $topic]} {
+ set id $topics($package,$section,$topic)
+ puts $fd "2 $topic=$id"
+ set lastTopic $topic
+ }
+ }
+ }
+ }
+ close $fd
+}
+
+
+#
+# PASS 2
+#
+
+proc generateHelp {basename files} {
+ global curID topics keywords file id_keywords
+ set curID 0
+
+ foreach key [array names keywords] {
+ foreach id $keywords($key) {
+ lappend id_keywords($id) $key
+ }
+ }
+
+ set file [open "$basename.rtf" w]
+ fconfigure $file -translation crlf
+ puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\}"
+ foreach f $files {
+ puts "Pass 2 -- $f"
+ flush stdout
+ initGlobals
+ doFile $f
+ pageBreak
+ }
+ puts $file "\}"
+ close $file
+}
+
+# doFile --
+#
+# Given a file as argument, translate the file to a tcl script and
+# evaluate it.
+#
+# Arguments:
+# file - Name of file to translate.
+
+proc doFile {file} {
+ if {[catch {eval [exec man2tcl [glob $file]]} msg] &&
+ [catch {eval [exec ./man2tcl [glob $file]]} msg]} {
+ global errorInfo
+ puts stderr $msg
+ puts "in"
+ puts $errorInfo
+ exit 1
+ }
+}
+
+# doDir --
+#
+# Given a directory as argument, translate all the man pages in
+# that directory.
+#
+# Arguments:
+# dir - Name of the directory.
+
+proc doDir dir {
+ puts "Generating man pages for $dir..."
+ foreach f [lsort [glob [file join $dir *.\[13n\]]]] {
+ do $f
+ }
+}
+
+# process command line arguments
+
+if {$argc < 3} {
+ puts stderr "usage: $argv0 projectName version manFiles..."
+ exit 1
+}
+
+set baseName [lindex $argv 0]
+set version [lindex $argv 1]
+set files {}
+foreach i [lrange $argv 2 end] {
+ set i [file join $i]
+ if {[file isdir $i]} {
+ foreach f [lsort [glob [file join $i *.\[13n\]]]] {
+ lappend files $f
+ }
+ } elseif {[file exists $i]} {
+ lappend files $i
+ }
+}
+
+source [file join [file dir $argv0] index.tcl]
+generateContents $baseName $version $files
+source [file join [file dir $argv0] man2help2.tcl]
+generateHelp $baseName $files
diff --git a/tcl/tools/man2help2.tcl b/tcl/tools/man2help2.tcl
new file mode 100644
index 00000000000..4ea9d9dd8c4
--- /dev/null
+++ b/tcl/tools/man2help2.tcl
@@ -0,0 +1,970 @@
+# man2help2.tcl --
+#
+# This file defines procedures that are used during the second pass of
+# the man page conversion. It converts the man format input to rtf
+# form suitable for use by the Windows help compiler.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+#
+
+# Global variables used by these scripts:
+#
+# state - state variable that controls action of text proc.
+#
+# topics - array indexed by (package,section,topic) with value
+# of topic ID.
+#
+# keywords - array indexed by keyword string with value of topic ID.
+#
+# curID - current topic ID, starts at 0 and is incremented for
+# each new topic file.
+#
+# curPkg - current package name (e.g. Tcl).
+#
+# curSect - current section title (e.g. "Tcl Built-In Commands").
+#
+
+# initGlobals --
+#
+# This procedure is invoked to set the initial values of all of the
+# global variables, before processing a man page.
+#
+# Arguments:
+# None.
+
+proc initGlobals {} {
+ uplevel \#0 unset state
+ global state chars
+
+ set state(paragraphPending) 0
+ set state(breakPending) 0
+ set state(firstIndent) 0
+ set state(leftIndent) 0
+
+ set state(inTP) 0
+ set state(paragraph) 0
+ set state(textState) 0
+ set state(curFont) ""
+ set state(startCode) "{\\b "
+ set state(startEmphasis) "{\\i "
+ set state(endCode) "}"
+ set state(endEmphasis) "}"
+ set state(noFill) 0
+ set state(charCnt) 0
+ set state(offset) [getTwips 0.5i]
+ set state(leftMargin) [getTwips 0.5i]
+ set state(nestingLevel) 0
+ set state(intl) 0
+ set state(sb) 0
+ setTabs 0.5i
+
+# set up international character table
+
+ array set chars {
+ o^ F4
+ }
+}
+
+
+# beginFont --
+#
+# Arranges for future text to use a special font, rather than
+# the default paragraph font.
+#
+# Arguments:
+# font - Name of new font to use.
+
+proc beginFont {font} {
+ global file state
+
+ textSetup
+ if {[string equal $state(curFont) $font]} {
+ return
+ }
+ endFont
+ puts -nonewline $file $state(start$font)
+ set state(curFont) $font
+}
+
+
+# endFont --
+#
+# Reverts to the default font for the paragraph type.
+#
+# Arguments:
+# None.
+
+proc endFont {} {
+ global state file
+
+ if {[string compare $state(curFont) ""]} {
+ puts -nonewline $file $state(end$state(curFont))
+ set state(curFont) ""
+ }
+}
+
+
+# textSetup --
+#
+# This procedure is called the first time that text is output for a
+# paragraph. It outputs the header information for the paragraph.
+#
+# Arguments:
+# None.
+
+proc textSetup {} {
+ global file state
+
+ if $state(breakPending) {
+ puts $file "\\line"
+ }
+ if $state(paragraphPending) {
+ puts $file [format "\\par\n\\pard\\fi%.0f\\li%.0f" \
+ $state(firstIndent) $state(leftIndent)]
+ foreach tab $state(tabs) {
+ puts $file [format "\\tx%.0f" $tab]
+ }
+ set state(tabs) {}
+ if {$state(sb)} {
+ puts $file "\\sb$state(sb)"
+ set state(sb) 0
+ }
+ }
+ set state(breakPending) 0
+ set state(paragraphPending) 0
+}
+
+
+# text --
+#
+# This procedure adds text to the current state(paragraph). If this is
+# the first text in the state(paragraph) then header information for the
+# state(paragraph) is output before the text.
+#
+# Arguments:
+# string - Text to output in the state(paragraph).
+
+proc text {string} {
+ global file state chars
+
+ textSetup
+ set string [string map [list \
+ "\\" "\\\\" \
+ "\{" "\\\{" \
+ "\}" "\\\}" \
+ "\t" {\tab } \
+ '' "\\rdblquote " \
+ `` "\\ldblquote " \
+ ] $string]
+
+ # Check if this is the beginning of an international character string.
+ # If so, look up the sequence in the chars table and substitute the
+ # appropriate hex value.
+
+ if {$state(intl)} {
+ if {[regexp {^'([^']*)'} $string dummy ch]} {
+ if {[info exists chars($ch)]} {
+ regsub {^'[^']*'} $string "\\\\'$chars($ch)" string
+ } else {
+ puts stderr "Unknown international character '$ch'"
+ }
+ }
+ set state(intl) 0
+ }
+
+ switch $state(textState) {
+ REF {
+ if {$state(inTP) == 0} {
+ set string [insertRef $string]
+ }
+ }
+ SEE {
+ global topics curPkg curSect
+ foreach i [split $string] {
+ if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} {
+ continue
+ }
+ if {![catch {set ref $topics($curPkg,$curSect,$i)} ]} {
+ regsub $i $string [link $i $ref] string
+ }
+ }
+ }
+ KEY {
+ return
+ }
+ }
+ puts -nonewline $file "$string"
+}
+
+
+
+# insertRef --
+#
+# This procedure looks for a string in the cross reference table and
+# generates a hot-link to the appropriate topic. Tries to find the
+# nearest reference in the manual.
+#
+# Arguments:
+# string - Text to output in the state(paragraph).
+
+proc insertRef {string} {
+ global NAME_file curPkg curSect topics curID
+ set path {}
+ set string [string trim $string]
+ set ref {}
+ if {[info exists topics($curPkg,$curSect,$string)]} {
+ set ref $topics($curPkg,$curSect,$string)
+ } else {
+ set sites [array names topics "$curPkg,*,$string"]
+ set count [llength $sites]
+ if {$count > 0} {
+ set ref $topics([lindex $sites 0])
+ } else {
+ set sites [array names topics "*,*,$string"]
+ set count [llength $sites]
+ if {$count > 0} {
+ set ref $topics([lindex $sites 0])
+ }
+ }
+ }
+
+ if {($ref != {}) && ($ref != $curID)} {
+ set string [link $string $ref]
+ }
+ return $string
+}
+
+
+
+# macro --
+#
+# This procedure is invoked to process macro invocations that start
+# with "." (instead of ').
+#
+# Arguments:
+# name - The name of the macro (without the ".").
+# args - Any additional arguments to the macro.
+
+proc macro {name args} {
+ global state file
+ switch $name {
+ AP {
+ if {[llength $args] != 3 && [llength $args] != 2} {
+ puts stderr "Bad .AP macro: .$name [join $args " "]"
+ }
+ newPara 3.75i -3.75i
+ setTabs {1.25i 2.5i 3.75i}
+ font B
+ text [lindex $args 0]
+ tab
+ font I
+ text [lindex $args 1]
+ tab
+ font R
+ if {[llength $args] == 3} {
+ text "([lindex $args 2])"
+ }
+ tab
+ }
+ AS {} ;# next page and previous page
+ br {
+ lineBreak
+ }
+ BS {}
+ BE {}
+ CE {
+ decrNestingLevel
+ set state(noFill) 0
+ set state(breakPending) 0
+ newPara 0i
+ }
+ CS { ;# code section
+ incrNestingLevel
+ set state(noFill) 1
+ newPara 0i
+ }
+ DE {
+ set state(noFill) 0
+ decrNestingLevel
+ newPara 0i
+ }
+ DS {
+ set state(noFill) 1
+ incrNestingLevel
+ newPara 0i
+ }
+ fi {
+ set state(noFill) 0
+ }
+ IP {
+ IPmacro $args
+ }
+ LP {
+ newPara 0i
+ set state(sb) 80
+ }
+ ne {
+ }
+ nf {
+ set state(noFill) 1
+ }
+ OP {
+ if {[llength $args] != 3} {
+ puts stderr "Bad .OP macro: .$name [join $args " "]"
+ }
+ set state(nestingLevel) 0
+ newPara 0i
+ set state(sb) 120
+ setTabs 4c
+ text "Command-Line Name:"
+ tab
+ font B
+ set x [lindex $args 0]
+ regsub -all {\\-} $x - x
+ text $x
+ lineBreak
+ font R
+ text "Database Name:"
+ tab
+ font B
+ text [lindex $args 1]
+ lineBreak
+ font R
+ text "Database Class:"
+ tab
+ font B
+ text [lindex $args 2]
+ font R
+ set state(inTP) 0
+ newPara 0.5i
+ set state(sb) 80
+ }
+ PP {
+ newPara 0i
+ set state(sb) 120
+ }
+ RE {
+ decrNestingLevel
+ }
+ RS {
+ incrNestingLevel
+ }
+ SE {
+ font R
+ set state(noFill) 0
+ set state(nestingLevel) 0
+ newPara 0i
+ text "See the "
+ font B
+ set temp $state(textState)
+ set state(textState) REF
+ text options
+ set state(textState) $temp
+ font R
+ text " manual entry for detailed descriptions of the above options."
+ }
+ SH {
+ SHmacro $args
+ }
+ SO {
+ SHmacro "STANDARD OPTIONS"
+ set state(nestingLevel) 0
+ newPara 0i
+ setTabs {4c 8c 12c}
+ font B
+ set state(noFill) 1
+ }
+ so {
+ if {$args != "man.macros"} {
+ puts stderr "Unknown macro: .$name [join $args " "]"
+ }
+ }
+ sp { ;# needs work
+ if {$args == ""} {
+ set count 1
+ } else {
+ set count [lindex $args 0]
+ }
+ while {$count > 0} {
+ lineBreak
+ incr count -1
+ }
+ }
+ ta {
+ setTabs $args
+ }
+ TH {
+ THmacro $args
+ }
+ TP {
+ TPmacro $args
+ }
+ UL { ;# underline
+ puts -nonewline $file "{\\ul "
+ text [lindex $args 0]
+ puts -nonewline $file "}"
+ if {[llength $args] == 2} {
+ text [lindex $args 1]
+ }
+ }
+ VE {}
+ VS {}
+ default {
+ puts stderr "Unknown macro: .$name [join $args " "]"
+ }
+ }
+}
+
+
+# link --
+#
+# This procedure returns the string for a hot link to a different
+# context location.
+#
+# Arguments:
+# label - String to display in hot-spot.
+# id - Context string to jump to.
+
+proc link {label id} {
+ return "{\\uldb $label}{\\v $id}"
+}
+
+
+# font --
+#
+# This procedure is invoked to handle font changes in the text
+# being output.
+#
+# Arguments:
+# type - Type of font: R, I, B, or S.
+
+proc font {type} {
+ global state
+ switch $type {
+ P -
+ R {
+ endFont
+ if {$state(textState) == "REF"} {
+ set state(textState) INSERT
+ }
+ }
+ C -
+ B {
+ beginFont Code
+ if {$state(textState) == "INSERT"} {
+ set state(textState) REF
+ }
+ }
+ I {
+ beginFont Emphasis
+ }
+ S {
+ }
+ default {
+ puts stderr "Unknown font: $type"
+ }
+ }
+}
+
+
+
+# formattedText --
+#
+# Insert a text string that may also have \fB-style font changes
+# and a few other backslash sequences in it.
+#
+# Arguments:
+# text - Text to insert.
+
+proc formattedText {text} {
+ global chars
+
+ while {$text != ""} {
+ set index [string first \\ $text]
+ if {$index < 0} {
+ text $text
+ return
+ }
+ text [string range $text 0 [expr {$index-1}]]
+ set c [string index $text [expr {$index+1}]]
+ switch -- $c {
+ f {
+ font [string index $text [expr {$index+2}]]
+ set text [string range $text [expr {$index+3}] end]
+ }
+ e {
+ text "\\"
+ set text [string range $text [expr {$index+2}] end]
+ }
+ - {
+ dash
+ set text [string range $text [expr {$index+2}] end]
+ }
+ | {
+ set text [string range $text [expr {$index+2}] end]
+ }
+ o {
+ text "\\'"
+ regexp "'([^']*)'(.*)" $text all ch text
+ text $chars($ch)
+ }
+ default {
+ puts stderr "Unknown sequence: \\$c"
+ set text [string range $text [expr {$index+2}] end]
+ }
+ }
+ }
+}
+
+
+# dash --
+#
+# This procedure is invoked to handle dash characters ("\-" in
+# troff). It outputs a special dash character.
+#
+# Arguments:
+# None.
+
+proc dash {} {
+ global state
+ if {[string equal $state(textState) "NAME"]} {
+ set state(textState) 0
+ }
+ text "-"
+}
+
+
+# tab --
+#
+# This procedure is invoked to handle tabs in the troff input.
+# Right now it does nothing.
+#
+# Arguments:
+# None.
+
+proc tab {} {
+ global file
+
+ textSetup
+ puts -nonewline $file "\\tab "
+}
+
+
+# setTabs --
+#
+# This procedure handles the ".ta" macro, which sets tab stops.
+#
+# Arguments:
+# tabList - List of tab stops, each consisting of a number
+# followed by "i" (inch) or "c" (cm).
+
+proc setTabs {tabList} {
+ global file state
+
+ set state(tabs) {}
+ foreach arg $tabList {
+ set distance [expr {$state(leftMargin) \
+ + ($state(offset) * $state(nestingLevel)) + [getTwips $arg]}]
+ lappend state(tabs) [expr {round($distance)}]
+ }
+}
+
+
+
+# lineBreak --
+#
+# Generates a line break in the HTML output.
+#
+# Arguments:
+# None.
+
+proc lineBreak {} {
+ global state
+ textSetup
+ set state(breakPending) 1
+}
+
+
+
+# newline --
+#
+# This procedure is invoked to handle newlines in the troff input.
+# It outputs either a space character or a newline character, depending
+# on fill mode.
+#
+# Arguments:
+# None.
+
+proc newline {} {
+ global state
+
+ if {$state(inTP)} {
+ set state(inTP) 0
+ lineBreak
+ } elseif {$state(noFill)} {
+ lineBreak
+ } else {
+ text " "
+ }
+}
+
+
+# pageBreak --
+#
+# This procedure is invoked to generate a page break.
+#
+# Arguments:
+# None.
+
+proc pageBreak {} {
+ global file curVer
+ if {[string equal $curVer ""]} {
+ puts $file {\page}
+ } else {
+ puts $file {\par}
+ puts $file {\pard\sb400\qc}
+ puts $file "Last change: $curVer\\page"
+ }
+}
+
+
+# char --
+#
+# This procedure is called to handle a special character.
+#
+# Arguments:
+# name - Special character named in troff \x or \(xx construct.
+
+proc char {name} {
+ global file state
+
+ switch -exact $name {
+ \\o {
+ set state(intl) 1
+ }
+ \\\ {
+ textSetup
+ puts -nonewline $file " "
+ }
+ \\0 {
+ textSetup
+ puts -nonewline $file " \\emspace "
+ }
+ \\\\ {
+ textSetup
+ puts -nonewline $file "\\\\"
+ }
+ \\(+- {
+ textSetup
+ puts -nonewline $file "\\'b1 "
+ }
+ \\% -
+ \\| {
+ }
+ \\(bu {
+ textSetup
+ puts -nonewline $file "·"
+ }
+ default {
+ puts stderr "Unknown character: $name"
+ }
+ }
+}
+
+
+# macro2 --
+#
+# This procedure handles macros that are invoked with a leading "'"
+# character instead of space. Right now it just generates an
+# error diagnostic.
+#
+# Arguments:
+# name - The name of the macro (without the ".").
+# args - Any additional arguments to the macro.
+
+proc macro2 {name args} {
+ puts stderr "Unknown macro: '$name [join $args " "]"
+}
+
+
+
+# SHmacro --
+#
+# Subsection head; handles the .SH macro.
+#
+# Arguments:
+# name - Section name.
+
+proc SHmacro {argList} {
+ global file state
+
+ set args [join $argList " "]
+ if {[llength $argList] < 1} {
+ puts stderr "Bad .SH macro: .$name $args"
+ }
+
+ # control what the text proc does with text
+
+ switch $args {
+ NAME {set state(textState) NAME}
+ DESCRIPTION {set state(textState) INSERT}
+ INTRODUCTION {set state(textState) INSERT}
+ "WIDGET-SPECIFIC OPTIONS" {set state(textState) INSERT}
+ "SEE ALSO" {set state(textState) SEE}
+ KEYWORDS {set state(textState) KEY; return}
+ }
+
+ if {$state(breakPending) != -1} {
+ set state(breakPending) 1
+ } else {
+ set state(breakPending) 0
+ }
+ set state(noFill) 0
+ nextPara 0i
+ font B
+ text $args
+ font R
+ nextPara .5i
+}
+
+
+
+# IPmacro --
+#
+# This procedure is invoked to handle ".IP" macros, which may take any
+# of the following forms:
+#
+# .IP [1] Translate to a "1Step" state(paragraph).
+# .IP [x] (x > 1) Translate to a "Step" state(paragraph).
+# .IP Translate to a "Bullet" state(paragraph).
+# .IP text count Translate to a FirstBody state(paragraph) with special
+# indent and tab stop based on "count", and tab after
+# "text".
+#
+# Arguments:
+# argList - List of arguments to the .IP macro.
+#
+# HTML limitations: 'count' in '.IP text count' is ignored.
+
+proc IPmacro {argList} {
+ global file state
+
+ set length [llength $argList]
+ if {$length == 0} {
+ newPara 0.5i
+ return
+ }
+ if {$length == 1} {
+ newPara 0.5i -0.5i
+ set state(sb) 80
+ setTabs 0.5i
+ formattedText [lindex $argList 0]
+ tab
+ return
+ }
+ if {$length == 2} {
+ set count [lindex $argList 1]
+ set tab [expr $count * 0.1]i
+ newPara $tab -$tab
+ set state(sb) 80
+ setTabs $tab
+ formattedText [lindex $argList 0]
+ tab
+ return
+ }
+ puts stderr "Bad .IP macro: .IP [join $argList " "]"
+}
+
+
+# TPmacro --
+#
+# This procedure is invoked to handle ".TP" macros, which may take any
+# of the following forms:
+#
+# .TP x Translate to an state(indent)ed state(paragraph) with the
+# specified state(indent) (in 100 twip units).
+# .TP Translate to an state(indent)ed state(paragraph) with
+# default state(indent).
+#
+# Arguments:
+# argList - List of arguments to the .IP macro.
+#
+# HTML limitations: 'x' in '.TP x' is ignored.
+
+proc TPmacro {argList} {
+ global state
+ set length [llength $argList]
+ if {$length == 0} {
+ set val 0.5i
+ } else {
+ set val [expr {([lindex $argList 0] * 100.0)/1440}]i
+ }
+ newPara $val -$val
+ setTabs $val
+ set state(inTP) 1
+ set state(sb) 120
+}
+
+
+# THmacro --
+#
+# This procedure handles the .TH macro. It generates the non-scrolling
+# header section for a given man page, and enters information into the
+# table of contents. The .TH macro has the following form:
+#
+# .TH name section date footer header
+#
+# Arguments:
+# argList - List of arguments to the .TH macro.
+
+proc THmacro {argList} {
+ global file curPkg curSect curID id_keywords state curVer
+
+ if {[llength $argList] != 5} {
+ set args [join $argList " "]
+ puts stderr "Bad .TH macro: .$name $args"
+ }
+ incr curID
+ set name [lindex $argList 0] ;# Tcl_UpVar
+ set page [lindex $argList 1] ;# 3
+ set curVer [lindex $argList 2] ;# 7.4
+ set curPkg [lindex $argList 3] ;# Tcl
+ set curSect [lindex $argList 4] ;# {Tcl Library Procedures}
+
+ regsub -all {\\ } $curSect { } curSect ;# Clean up for [incr\ Tcl]
+
+ puts $file "#{\\footnote $curID}" ;# Context string
+ puts $file "\${\\footnote $name}" ;# Topic title
+ set browse "${curSect}${name}"
+ regsub -all {[ _-]} $browse {} browse
+ puts $file "+{\\footnote $browse}" ;# Browse sequence
+
+ # Suppress duplicates
+ foreach i $id_keywords($curID) {
+ set keys($i) 1
+ }
+ foreach i [array names keys] {
+ set i [string trim $i]
+ if {[string length $i] > 0} {
+ puts $file "K{\\footnote $i}" ;# Keyword strings
+ }
+ }
+ unset keys
+ puts $file "\\pard\\tx3000\\sb100\\sa100\\fs24\\keepn"
+ font B
+ text $name
+ tab
+ text $curSect
+ font R
+ puts $file "\\fs20"
+ set state(breakPending) -1
+}
+
+# nextPara --
+#
+# Set the indents for a new paragraph, and start a paragraph break
+#
+# Arguments:
+# leftIndent - The new left margin for body lines.
+# firstIndent - The offset from the left margin for the first line.
+
+proc nextPara {leftIndent {firstIndent 0i}} {
+ global state
+ set state(leftIndent) [getTwips $leftIndent]
+ set state(firstIndent) [getTwips $firstIndent]
+ set state(paragraphPending) 1
+}
+
+
+# newPara --
+#
+# This procedure sets the left and hanging state(indent)s for a line.
+# State(Indent)s are specified in units of inches or centimeters, and are
+# relative to the current nesting level and left margin.
+#
+# Arguments:
+# leftState(Indent) - The new left margin for lines after the first.
+# firstState(Indent) - The new left margin for the first line of a state(paragraph).
+
+proc newPara {leftIndent {firstIndent 0i}} {
+ global state file
+ if $state(paragraph) {
+ puts -nonewline $file "\\line\n"
+ }
+ set state(leftIndent) [expr {$state(leftMargin) \
+ + ($state(offset) * $state(nestingLevel)) +[getTwips $leftIndent]}]
+ set state(firstIndent) [getTwips $firstIndent]
+ set state(paragraphPending) 1
+}
+
+
+# getTwips --
+#
+# This procedure converts a distance in inches or centimeters into
+# twips (1/1440 of an inch).
+#
+# Arguments:
+# arg - A number followed by "i" or "c"
+
+proc getTwips {arg} {
+ if {[scan $arg "%f%s" distance units] != 2} {
+ puts stderr "bad distance \"$arg\""
+ return 0
+ }
+ switch -- $units {
+ c {
+ set distance [expr {$distance * 567}]
+ }
+ i {
+ set distance [expr {$distance * 1440}]
+ }
+ default {
+ puts stderr "bad units in distance \"$arg\""
+ continue
+ }
+ }
+ return $distance
+}
+
+# incrNestingLevel --
+#
+# This procedure does the work of the .RS macro, which increments
+# the number of state(indent)ations that affect things like .PP.
+#
+# Arguments:
+# None.
+
+proc incrNestingLevel {} {
+ global state
+
+ incr state(nestingLevel)
+ set oldp $state(paragraph)
+ set state(paragraph) 0
+ newPara 0i
+ set state(paragraph) $oldp
+}
+
+# decrNestingLevel --
+#
+# This procedure does the work of the .RE macro, which decrements
+# the number of indentations that affect things like .PP.
+#
+# Arguments:
+# None.
+
+proc decrNestingLevel {} {
+ global state
+
+ if {$state(nestingLevel) == 0} {
+ puts stderr "Nesting level decremented below 0"
+ } else {
+ incr state(nestingLevel) -1
+ }
+}
+
+
diff --git a/tcl/tools/man2html.tcl b/tcl/tools/man2html.tcl
new file mode 100644
index 00000000000..cb60887ba65
--- /dev/null
+++ b/tcl/tools/man2html.tcl
@@ -0,0 +1,181 @@
+#!/proj/tcl/install/5.x-sparc/bin/tclsh7.5
+
+if [catch {
+
+# man2html.tcl --
+#
+# This file contains procedures that work in conjunction with the
+# man2tcl program to generate a HTML files from Tcl manual entries.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+#
+# SCCS: @(#) man2html.tcl 1.5 96/04/11 20:21:43
+#
+
+set homeDir /home/rjohnson/Projects/tools/generic
+
+# sarray -
+#
+# Save an array to a file so that it can be sourced.
+#
+# Arguments:
+# file - Name of the output file
+# args - Name of the arrays to save
+#
+proc sarray {file args} {
+ set file [open $file w]
+ foreach a $args {
+ upvar $a array
+ if ![array exists array] {
+ puts "sarray: \"$a\" isn't an array"
+ break
+ }
+
+ foreach name [lsort [array names array]] {
+ regsub -all " " $name "\\ " name1
+ puts $file "set ${a}($name1) \{$array($name)\}"
+ }
+ }
+ close $file
+}
+
+
+
+# footer --
+#
+# Builds footer info for HTML pages
+#
+# Arguments:
+# None
+
+proc footer {packages} {
+ lappend f "<HR>"
+ set h {[}
+ foreach package $packages {
+ lappend h "<A HREF=\"../$package/contents.html\">$package</A>"
+ lappend h "|"
+ }
+ lappend f [join [lreplace $h end end {]} ] " "]
+ lappend f "<HR>"
+ lappend f "<PRE>Copyright &#169; 1989-1994 The Regents of the University of California."
+ lappend f "Copyright &#169; 1994-1996 Sun Microsystems, Inc."
+ lappend f "</PRE>"
+ return [join $f "\n"]
+}
+
+
+
+
+# doDir --
+#
+# Given a directory as argument, translate all the man pages in
+# that directory.
+#
+# Arguments:
+# dir - Name of the directory.
+
+proc doDir dir {
+ foreach f [lsort [glob $dir/*.\[13n\]]] {
+ do $f ;# defined in man2html1.tcl & man2html2.tcl
+ }
+}
+
+
+if {$argc < 2} {
+ puts stderr "usage: $argv0 html_dir tcl_dir packages..."
+ puts stderr "usage: $argv0 -clean html_dir"
+ exit 1
+}
+
+if {[lindex $argv 0] == "-clean"} {
+ set html_dir [lindex $argv 1]
+ puts -nonewline "recursively remove: $html_dir? "
+ flush stdout
+ if {[gets stdin] == "y"} {
+ puts "removing: $html_dir"
+ exec rm -r $html_dir
+ }
+ exit 0
+}
+
+set html_dir [lindex $argv 0]
+set tcl_dir [lindex $argv 1]
+set packages [lrange $argv 2 end]
+
+#### need to add glob capability to packages ####
+
+# make sure there are doc directories for each package
+
+foreach i $packages {
+ if ![file exists $tcl_dir/$i/doc] {
+ puts stderr "Error: doc directory for package $i is missing"
+ exit 1
+ }
+ if ![file isdirectory $tcl_dir/$i/doc] {
+ puts stderr "Error: $tcl_dir/$i/doc is not a directory"
+ exit 1
+ }
+}
+
+
+# we want to start with a clean sheet
+
+if [file exists $html_dir] {
+ puts stderr "Error: HTML directory already exists"
+ exit 1
+} else {
+ exec mkdir $html_dir
+}
+
+set footer [footer $packages]
+
+
+# make the hyperlink arrays and contents.html for all packages
+
+foreach package $packages {
+ global homeDir
+ exec mkdir $html_dir/$package
+
+ # build hyperlink database arrays: NAME_file and KEY_file
+ #
+ puts "\nScanning man pages in $tcl_dir/$package/doc..."
+ source $homeDir/man2html1.tcl
+
+ doDir $tcl_dir/$package/doc
+
+ # clean up the NAME_file and KEY_file database arrays
+ #
+ catch {unset KEY_file()}
+ foreach name [lsort [array names NAME_file]] {
+ set file_name $NAME_file($name)
+ if {[llength $file_name] > 1} {
+ set file_name [lsort $file_name]
+ puts stdout "Warning: '$name' multiply defined in: $file_name; using last"
+ set NAME_file($name) [lindex $file_name end]
+ }
+ }
+# sarray $html_dir/$package/xref.tcl NAME_file KEY_file
+
+ # build the contents file from NAME_file
+ #
+ puts "\nGenerating contents.html for $package"
+ doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl
+
+ # now translate the man pages to HTML pages
+ #
+ source $homeDir/man2html2.tcl
+ puts "\nBuilding html pages from man pages in $tcl_dir/$package/doc..."
+ doDir $tcl_dir/$package/doc
+
+ unset NAME_file
+}
+
+
+
+} result] {
+ global errorInfo
+ puts stderr $result
+ puts stderr "in"
+ puts stderr $errorInfo
+}
+
diff --git a/tcl/tools/man2html1.tcl b/tcl/tools/man2html1.tcl
new file mode 100644
index 00000000000..2e8ba526c39
--- /dev/null
+++ b/tcl/tools/man2html1.tcl
@@ -0,0 +1,269 @@
+# man2html1.tcl --
+#
+# This file defines procedures that are used during the first pass of the
+# man page to html conversion process. It is sourced by h.tcl.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+#
+# SCCS: @(#) man2html1.tcl 1.2 96/03/21 10:48:29
+#
+
+# Global variables used by these scripts:
+#
+# state - state variable that controls action of text proc.
+#
+# curFile - tail of current man page.
+#
+# file - file pointer; for both xref.tcl and contents.html
+#
+# NAME_file - array indexed by NAME and containing file names used
+# for hyperlinks.
+#
+# KEY_file - array indexed by KEYWORD and containing file names used
+# for hyperlinks.
+#
+# lib - contains package name. Used to label section in contents.html
+#
+# inDT - in dictionary term.
+
+
+
+# text --
+#
+# This procedure adds entries to the hypertext arrays NAME_file
+# and KEY_file.
+#
+# DT: might do this: if first word of $dt matches $name and [llength $name==1]
+# and [llength $dt > 1], then add to NAME_file.
+#
+# Arguments:
+# string - Text to index.
+
+
+proc text string {
+ global state curFile NAME_file KEY_file inDT
+
+ switch $state {
+ NAME {
+ foreach i [split $string ","] {
+ lappend NAME_file([string trim $i]) $curFile
+ }
+ }
+ KEY {
+ foreach i [split $string ","] {
+ lappend KEY_file([string trim $i]) $curFile
+ }
+ }
+ DT -
+ OFF -
+ DASH {}
+ default {
+ puts stderr "text: unknown state: $state"
+ }
+ }
+}
+
+
+# macro --
+#
+# This procedure is invoked to process macro invocations that start
+# with "." (instead of ').
+#
+# Arguments:
+# name - The name of the macro (without the ".").
+# args - Any additional arguments to the macro.
+
+proc macro {name args} {
+ switch $name {
+ SH {
+ global state
+
+ switch $args {
+ NAME {
+ if {$state == "INIT" } {
+ set state NAME
+ }
+ }
+ DESCRIPTION {set state DT}
+ INTRODUCTION {set state DT}
+ KEYWORDS {set state KEY}
+ default {set state OFF}
+ }
+
+ }
+ TP {
+ global inDT
+ set inDT 1
+ }
+ TH {
+ global lib state inDT
+ set inDT 0
+ set state INIT
+ if {[llength $args] != 5} {
+ set args [join $args " "]
+ puts stderr "Bad .TH macro: .$name $args"
+ }
+ set lib [lindex $args 3] ;# Tcl or Tk
+ }
+ }
+}
+
+
+
+# dash --
+#
+# This procedure is invoked to handle dash characters ("\-" in
+# troff). It only function in pass1 is to terminate the NAME state.
+#
+# Arguments:
+# None.
+
+proc dash {} {
+ global state
+ if {$state == "NAME"} {
+ set state DASH
+ }
+}
+
+
+
+# newline --
+#
+# This procedure is invoked to handle newlines in the troff input.
+# It's only purpose is to terminate a DT (dictionary term).
+#
+# Arguments:
+# None.
+
+proc newline {} {
+ global inDT
+ set inDT 0
+}
+
+
+
+
+# initGlobals, tab, font, char, macro2 --
+#
+# These procedures do nothing during the first pass.
+#
+# Arguments:
+# None.
+
+proc initGlobals {} {}
+proc tab {} {}
+proc font type {}
+proc char name {}
+proc macro2 {name args} {}
+
+
+# doListing --
+#
+# Writes an ls like list to a file. Searches NAME_file for entries
+# that match the input pattern.
+#
+# Arguments:
+# file - Output file pointer.
+# pattern - glob style match pattern
+
+proc doListing {file pattern} {
+ global NAME_file
+
+ set max_len 0
+ foreach name [lsort [array names NAME_file]] {
+ set ref $NAME_file($name)
+ if [string match $pattern $ref] {
+ lappend type $name
+ if {[string length $name] > $max_len} {
+ set max_len [string length $name]
+ }
+ }
+ }
+ if [catch {llength $type} ] {
+ puts stderr " doListing: no names matched pattern ($pattern)"
+ return
+ }
+ incr max_len
+ set ncols [expr 90/$max_len]
+ set nrows [expr int( ceil( [llength $type] / $ncols. ) ) ]
+
+# ? max_len ncols nrows
+
+ set index 0
+ foreach f $type {
+ lappend row([expr $index % $nrows]) $f
+ incr index
+ }
+
+ puts -nonewline $file "<PRE>"
+ for {set i 0} {$i<$nrows} {incr i} {
+ foreach name $row($i) {
+ set str [format "%-*s" $max_len $name]
+ regsub $name $str "<A HREF=\"$NAME_file($name).html\">$name</A>" str
+ puts -nonewline $file $str
+ }
+ puts $file {}
+ }
+ puts $file "</PRE>"
+}
+
+
+# doContents --
+#
+# Generates a HTML contents file using the NAME_file array
+# as its input database.
+#
+# Arguments:
+# file - name of the contents file.
+# packageName - string used in the title and sub-heads of the HTML page. Normally
+# name of the package without version numbers.
+
+proc doContents {file packageName} {
+ global footer
+
+ set file [open $file w]
+
+ puts $file "<HTML><HEAD><TITLE>$packageName Manual</TITLE></HEAD><BODY>"
+ puts $file "<H3>$packageName</H3>"
+ doListing $file "*.1"
+
+ puts $file "<HR><H3>$packageName Commands</H3>"
+ doListing $file "*.n"
+
+ puts $file "<HR><H3>$packageName Library</H3>"
+ doListing $file "*.3"
+
+ puts $file $footer
+ puts $file "</BODY></HTML>"
+ close $file
+}
+
+
+
+
+# do --
+#
+# This is the toplevel procedure that searches a man page
+# for hypertext links. It builds a data base consisting of
+# two arrays: NAME_file and KEY file. It runs the man2tcl
+# program to turn the man page into a script, then it evals
+# that script.
+#
+# Arguments:
+# fileName - Name of the file to scan.
+
+proc do fileName {
+ global curFile
+ set curFile [file tail $fileName]
+ set file stdout
+ puts " Pass 1 -- $fileName"
+ flush stdout
+ if [catch {eval [exec man2tcl [glob $fileName]]} msg] {
+ global errorInfo
+ puts stderr $msg
+ puts "in"
+ puts $errorInfo
+ exit 1
+ }
+}
+
diff --git a/tcl/tools/man2html2.tcl b/tcl/tools/man2html2.tcl
new file mode 100644
index 00000000000..789b4dbceba
--- /dev/null
+++ b/tcl/tools/man2html2.tcl
@@ -0,0 +1,871 @@
+# man2html2.tcl --
+#
+# This file defines procedures that are used during the second pass of the
+# man page to html conversion process. It is sourced by man2html.tcl.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+#
+# SCCS: @(#) man2html2.tcl 1.2 96/03/21 10:48:30
+#
+
+# Global variables used by these scripts:
+#
+# NAME_file - array indexed by NAME and containing file names used
+# for hyperlinks.
+#
+# textState - state variable defining action of 'text' proc.
+#
+# nestStk - stack oriented list containing currently active
+# HTML tags (UL, OL, DL). Local to 'nest' proc.
+#
+# inDT - set by 'TPmacro', cleared by 'newline'. Used to insert
+# the <DT> tag while in a dictionary list <DL>.
+#
+# curFont - Name of special font that is currently in
+# use. Null means the default paragraph font
+# is being used.
+#
+# file - Where to output the generated HTML.
+#
+# fontStart - Array to map font names to starting sequences.
+#
+# fontEnd - Array to map font names to ending sequences.
+#
+# noFillCount - Non-zero means don't fill the next $noFillCount
+# lines: force a line break at each newline. Zero
+# means filling is enabled, so don't output line
+# breaks for each newline.
+#
+# footer - info inserted at bottom of each page. Normally read
+# from the xref.tcl file
+
+# initGlobals --
+#
+# This procedure is invoked to set the initial values of all of the
+# global variables, before processing a man page.
+#
+# Arguments:
+# None.
+
+proc initGlobals {} {
+ global file noFillCount textState
+ global fontStart fontEnd curFont inPRE charCnt
+
+ nest init
+ set inPRE 0
+ set textState 0
+ set curFont ""
+ set fontStart(Code) "<B>"
+ set fontStart(Emphasis) "<I>"
+ set fontEnd(Code) "</B>"
+ set fontEnd(Emphasis) "</I>"
+ set noFillCount 0
+ set charCnt 0
+ setTabs 0.5i
+}
+
+
+# beginFont --
+#
+# Arranges for future text to use a special font, rather than
+# the default paragraph font.
+#
+# Arguments:
+# font - Name of new font to use.
+
+proc beginFont font {
+ global curFont file fontStart
+
+ if {$curFont == $font} {
+ return
+ }
+ endFont
+ puts -nonewline $file $fontStart($font)
+ set curFont $font
+}
+
+
+# endFont --
+#
+# Reverts to the default font for the paragraph type.
+#
+# Arguments:
+# None.
+
+proc endFont {} {
+ global curFont file fontEnd
+
+ if {$curFont != ""} {
+ puts -nonewline $file $fontEnd($curFont)
+ set curFont ""
+ }
+}
+
+
+
+# text --
+#
+# This procedure adds text to the current paragraph. If this is
+# the first text in the paragraph then header information for the
+# paragraph is output before the text.
+#
+# Arguments:
+# string - Text to output in the paragraph.
+
+proc text string {
+ global file textState inDT charCnt
+
+ set pos [string first "\t" $string]
+ if {$pos >= 0} {
+ text [string range $string 0 [expr $pos-1]]
+ tab
+ text [string range $string [expr $pos+1] end]
+ return
+ }
+ incr charCnt [string length $string]
+ regsub -all {&} $string {\&amp;} string
+ regsub -all {<} $string {\&lt;} string
+ regsub -all {>} $string {\&gt;} string
+ regsub -all {"} $string {\&quot;} string
+ switch $textState {
+ REF {
+ if {$inDT == {}} {
+ set string [insertRef $string]
+ }
+ }
+ SEE {
+ global NAME_file
+ foreach i [split $string] {
+ if ![regexp -nocase {^[a-z_]+} [string trim $i] i ] {
+# puts "Warning: $i in SEE ALSO not found"
+ continue
+ }
+ if ![catch {set ref $NAME_file($i)} ] {
+ regsub $i $string "<A HREF=\"$ref.html\">$i</A>" string
+ }
+ }
+ }
+ }
+ puts -nonewline $file "$string"
+}
+
+
+
+# insertRef --
+#
+#
+# Arguments:
+# string - Text to output in the paragraph.
+
+proc insertRef string {
+ global NAME_file self
+ set path {}
+ if ![catch {set ref $NAME_file([string trim $string])} ] {
+ if {"$ref.html" != $self} {
+ set string "<A HREF=\"${path}$ref.html\">$string</A>"
+# puts "insertRef: $self $ref.html ---$string--"
+ }
+ }
+ return $string
+}
+
+
+
+# macro --
+#
+# This procedure is invoked to process macro invocations that start
+# with "." (instead of ').
+#
+# Arguments:
+# name - The name of the macro (without the ".").
+# args - Any additional arguments to the macro.
+
+proc macro {name args} {
+ switch $name {
+ AP {
+ if {[llength $args] != 3} {
+ puts stderr "Bad .AP macro: .$name [join $args " "]"
+ }
+ setTabs {1.25i 2.5i 3.75i}
+ TPmacro {}
+ font B
+ text "[lindex $args 0] "
+ font I
+ text "[lindex $args 1]"
+ font R
+ text " ([lindex $args 2])"
+ newline
+ }
+ AS {} ;# next page and previous page
+ br {
+ lineBreak
+ }
+ BS {}
+ BE {}
+ CE {
+ global file noFillCount inPRE
+ puts $file </PRE></BLOCKQUOTE>
+ set inPRE 0
+ }
+ CS { ;# code section
+ global file noFillCount inPRE
+ puts -nonewline $file <BLOCKQUOTE><PRE>
+ set inPRE 1
+ }
+ DE {
+ global file noFillCount inPRE
+ puts $file </PRE></BLOCKQUOTE>
+ set inPRE 0
+ set noFillCount 0
+ }
+ DS {
+ global file noFillCount inPRE
+ puts -nonewline $file <BLOCKQUOTE><PRE>
+ set noFillCount 10000000
+ set inPRE 1
+ }
+ fi {
+ global noFillCount
+ set noFillCount 0
+ }
+ IP {
+ IPmacro $args
+ }
+ LP {
+ nest decr
+ nest incr
+ newPara
+ }
+ ne {
+ }
+ nf {
+ global noFillCount
+ set noFillCount 1000000
+ }
+ OP {
+ global inDT file inPRE
+ if {[llength $args] != 3} {
+ puts stderr "Bad .OP macro: .$name [join $args " "]"
+ }
+ nest para DL DT
+ set inPRE 1
+ puts -nonewline $file <PRE>
+ setTabs 4c
+ text "Command-Line Name:"
+ tab
+ font B
+ set x [lindex $args 0]
+ regsub -all {\\-} $x - x
+ text $x
+ newline
+ font R
+ text "Database Name:"
+ tab
+ font B
+ text [lindex $args 1]
+ newline
+ font R
+ text "Database Class:"
+ tab
+ font B
+ text [lindex $args 2]
+ font R
+ puts -nonewline $file </PRE>
+ set inDT "\n<DD>" ;# next newline writes inDT
+ set inPRE 0
+ newline
+ }
+ PP {
+ nest decr
+ nest incr
+ newPara
+ }
+ RE {
+ nest decr
+ }
+ RS {
+ nest incr
+ }
+ SE {
+ global noFillCount textState inPRE file
+
+ font R
+ puts -nonewline $file </PRE>
+ set inPRE 0
+ set noFillCount 0
+ nest reset
+ newPara
+ text "See the "
+ font B
+ set temp $textState
+ set textState REF
+ text options
+ set textState $temp
+ font R
+ text " manual entry for detailed descriptions of the above options."
+ }
+ SH {
+ SHmacro $args
+ }
+ SO {
+ global noFillCount inPRE file
+
+ SHmacro "STANDARD OPTIONS"
+ setTabs {4c 8c 12c}
+ set noFillCount 1000000
+ puts -nonewline $file <PRE>
+ set inPRE 1
+ font B
+ }
+ so {
+ if {$args != "man.macros"} {
+ puts stderr "Unknown macro: .$name [join $args " "]"
+ }
+ }
+ sp { ;# needs work
+ if {$args == ""} {
+ set count 1
+ } else {
+ set count [lindex $args 0]
+ }
+ while {$count > 0} {
+ lineBreak
+ incr count -1
+ }
+ }
+ ta {
+ setTabs $args
+ }
+ TH {
+ THmacro $args
+ }
+ TP {
+ TPmacro $args
+ }
+ UL { ;# underline
+ global file
+ puts -nonewline $file "<B><U>"
+ text [lindex $args 0]
+ puts -nonewline $file "</U></B>"
+ if {[llength $args] == 2} {
+ text [lindex $args 1]
+ }
+ }
+ VE {
+# global file
+# puts -nonewline $file "</FONT>"
+ }
+ VS {
+# global file
+# if {[llength $args] > 0} {
+# puts -nonewline $file "<BR>"
+# }
+# puts -nonewline $file "<FONT COLOR=\"GREEN\">"
+ }
+ default {
+ puts stderr "Unknown macro: .$name [join $args " "]"
+ }
+ }
+
+# global nestStk; puts "$name [format "%-20s" $args] $nestStk"
+# flush stdout; flush stderr
+}
+
+
+# font --
+#
+# This procedure is invoked to handle font changes in the text
+# being output.
+#
+# Arguments:
+# type - Type of font: R, I, B, or S.
+
+proc font type {
+ global textState
+ switch $type {
+ P -
+ R {
+ endFont
+ if {$textState == "REF"} {
+ set textState INSERT
+ }
+ }
+ B {
+ beginFont Code
+ if {$textState == "INSERT"} {
+ set textState REF
+ }
+ }
+ I {
+ beginFont Emphasis
+ }
+ S {
+ }
+ default {
+ puts stderr "Unknown font: $type"
+ }
+ }
+}
+
+
+
+# formattedText --
+#
+# Insert a text string that may also have \fB-style font changes
+# and a few other backslash sequences in it.
+#
+# Arguments:
+# text - Text to insert.
+
+proc formattedText text {
+# puts "formattedText: $text"
+ while {$text != ""} {
+ set index [string first \\ $text]
+ if {$index < 0} {
+ text $text
+ return
+ }
+ text [string range $text 0 [expr $index-1]]
+ set c [string index $text [expr $index+1]]
+ switch -- $c {
+ f {
+ font [string index $text [expr $index+2]]
+ set text [string range $text [expr $index+3] end]
+ }
+ e {
+ text \\
+ set text [string range $text [expr $index+2] end]
+ }
+ - {
+ dash
+ set text [string range $text [expr $index+2] end]
+ }
+ | {
+ set text [string range $text [expr $index+2] end]
+ }
+ default {
+ puts stderr "Unknown sequence: \\$c"
+ set text [string range $text [expr $index+2] end]
+ }
+ }
+ }
+}
+
+
+
+# dash --
+#
+# This procedure is invoked to handle dash characters ("\-" in
+# troff). It outputs a special dash character.
+#
+# Arguments:
+# None.
+
+proc dash {} {
+ global textState charCnt
+ if {$textState == "NAME"} {
+ set textState 0
+ }
+ incr charCnt
+ text "-"
+}
+
+
+# tab --
+#
+# This procedure is invoked to handle tabs in the troff input.
+# Right now it does nothing.
+#
+# Arguments:
+# None.
+
+proc tab {} {
+ global inPRE charCnt tabString
+# ? charCnt
+ if {$inPRE == 1} {
+ set pos [expr $charCnt % [string length $tabString] ]
+ set spaces [string first "1" [string range $tabString $pos end] ]
+ text [format "%*s" [incr spaces] " "]
+ } else {
+# puts "tab: found tab outside of <PRE> block"
+ }
+}
+
+
+# setTabs --
+#
+# This procedure handles the ".ta" macro, which sets tab stops.
+#
+# Arguments:
+# tabList - List of tab stops, each consisting of a number
+# followed by "i" (inch) or "c" (cm).
+
+proc setTabs {tabList} {
+ global file breakPending tabString
+
+# puts "setTabs: --$tabList--"
+ set last 0
+ set tabString {}
+ set charsPerInch 14.
+ set numTabs [llength $tabList]
+ foreach arg $tabList {
+ if {[scan $arg "%f%s" distance units] != 2} {
+ puts stderr "bad distance \"$arg\""
+ return 0
+ }
+ switch -- $units {
+ c {
+ set distance [expr $distance * $charsPerInch / 2.54 ]
+ }
+ i {
+ set distance [expr $distance * $charsPerInch]
+ }
+ default {
+ puts stderr "bad units in distance \"$arg\""
+ continue
+ }
+ }
+# ? distance
+ lappend tabString [format "%*s1" [expr round($distance-$last-1)] " "]
+ set last $distance
+ }
+ set tabString [join $tabString {}]
+# puts "setTabs: --$tabString--"
+}
+
+
+
+# lineBreak --
+#
+# Generates a line break in the HTML output.
+#
+# Arguments:
+# None.
+
+proc lineBreak {} {
+ global file inPRE
+ puts $file "<BR>"
+}
+
+
+
+# newline --
+#
+# This procedure is invoked to handle newlines in the troff input.
+# It outputs either a space character or a newline character, depending
+# on fill mode.
+#
+# Arguments:
+# None.
+
+proc newline {} {
+ global noFillCount file inDT inPRE charCnt
+
+ if {$inDT != {} } {
+ puts $file "\n$inDT"
+ set inDT {}
+ } elseif {$noFillCount == 0 || $inPRE == 1} {
+ puts $file {}
+ } else {
+ lineBreak
+ incr noFillCount -1
+ }
+ set charCnt 0
+}
+
+
+
+# char --
+#
+# This procedure is called to handle a special character.
+#
+# Arguments:
+# name - Special character named in troff \x or \(xx construct.
+
+proc char name {
+ global file charCnt
+
+ incr charCnt
+# puts "char: $name"
+ switch -exact $name {
+ \\0 { ;# \0
+ puts -nonewline $file " "
+ }
+ \\\\ { ;# \
+ puts -nonewline $file "\\"
+ }
+ \\(+- { ;# +/-
+ puts -nonewline $file "&#177;"
+ }
+ \\% {} ;# \%
+ \\| { ;# \|
+ }
+ default {
+ puts stderr "Unknown character: $name"
+ }
+ }
+}
+
+
+# macro2 --
+#
+# This procedure handles macros that are invoked with a leading "'"
+# character instead of space. Right now it just generates an
+# error diagnostic.
+#
+# Arguments:
+# name - The name of the macro (without the ".").
+# args - Any additional arguments to the macro.
+
+proc macro2 {name args} {
+ puts stderr "Unknown macro: '$name [join $args " "]"
+}
+
+
+
+# SHmacro --
+#
+# Subsection head; handles the .SH macro.
+#
+# Arguments:
+# name - Section name.
+
+proc SHmacro argList {
+ global file noFillCount textState charCnt
+
+ set args [join $argList " "]
+ if {[llength $argList] < 1} {
+ puts stderr "Bad .SH macro: .$name $args"
+ }
+
+ set noFillCount 0
+ nest reset
+
+ puts -nonewline $file "<H3>"
+ text $args
+ puts $file "</H3>"
+
+# ? args textState
+
+ # control what the text proc does with text
+
+ switch $args {
+ NAME {set textState NAME}
+ DESCRIPTION {set textState INSERT}
+ INTRODUCTION {set textState INSERT}
+ "WIDGET-SPECIFIC OPTIONS" {set textState INSERT}
+ "SEE ALSO" {set textState SEE}
+ KEYWORDS {set textState 0}
+ }
+ set charCnt 0
+}
+
+
+
+# IPmacro --
+#
+# This procedure is invoked to handle ".IP" macros, which may take any
+# of the following forms:
+#
+# .IP [1] Translate to a "1Step" paragraph.
+# .IP [x] (x > 1) Translate to a "Step" paragraph.
+# .IP Translate to a "Bullet" paragraph.
+# .IP text count Translate to a FirstBody paragraph with special
+# indent and tab stop based on "count", and tab after
+# "text".
+#
+# Arguments:
+# argList - List of arguments to the .IP macro.
+#
+# HTML limitations: 'count' in '.IP text count' is ignored.
+
+proc IPmacro argList {
+ global file
+
+ setTabs 0.5i
+ set length [llength $argList]
+ if {$length == 0} {
+ nest para UL LI
+ return
+ }
+ if {$length == 1} {
+ nest para OL LI
+ return
+ }
+ if {$length > 1} {
+ nest para DL DT
+ formattedText [lindex $argList 0]
+ puts $file "\n<DD>"
+ return
+ }
+ puts stderr "Bad .IP macro: .IP [join $argList " "]"
+}
+
+
+# TPmacro --
+#
+# This procedure is invoked to handle ".TP" macros, which may take any
+# of the following forms:
+#
+# .TP x Translate to an indented paragraph with the
+# specified indent (in 100 twip units).
+# .TP Translate to an indented paragraph with
+# default indent.
+#
+# Arguments:
+# argList - List of arguments to the .IP macro.
+#
+# HTML limitations: 'x' in '.TP x' is ignored.
+
+
+proc TPmacro {argList} {
+ global inDT
+ nest para DL DT
+ set inDT "\n<DD>" ;# next newline writes inDT
+ setTabs 0.5i
+}
+
+
+
+# THmacro --
+#
+# This procedure handles the .TH macro. It generates the non-scrolling
+# header section for a given man page, and enters information into the
+# table of contents. The .TH macro has the following form:
+#
+# .TH name section date footer header
+#
+# Arguments:
+# argList - List of arguments to the .TH macro.
+
+proc THmacro {argList} {
+ global file
+
+ if {[llength $argList] != 5} {
+ set args [join $argList " "]
+ puts stderr "Bad .TH macro: .$name $args"
+ }
+ set name [lindex $argList 0] ;# Tcl_UpVar
+ set page [lindex $argList 1] ;# 3
+ set vers [lindex $argList 2] ;# 7.4
+ set lib [lindex $argList 3] ;# Tcl
+ set pname [lindex $argList 4] ;# {Tcl Library Procedures}
+
+ puts -nonewline $file "<HTML><HEAD><TITLE>"
+ text "$lib - $name ($page)"
+ puts $file "</TITLE></HEAD><BODY>\n"
+
+ puts -nonewline $file "<H1><CENTER>"
+ text $pname
+ puts $file "</CENTER></H1>\n"
+}
+
+
+
+# newPara --
+#
+# This procedure sets the left and hanging indents for a line.
+# Indents are specified in units of inches or centimeters, and are
+# relative to the current nesting level and left margin.
+#
+# Arguments:
+# None
+
+proc newPara {} {
+ global file nestStk
+
+ if {[lindex $nestStk end] != "NEW" } {
+ nest decr
+ }
+ puts -nonewline $file "<P>"
+}
+
+
+
+# nest --
+#
+# This procedure takes care of inserting the tags associated with the
+# IP, TP, RS, RE, LP and PP macros. Only 'nest para' takes arguments.
+#
+# Arguments:
+# op - operation: para, incr, decr, reset, init
+# listStart - begin list tag: OL, UL, DL.
+# listItem - item tag: LI, LI, DT.
+
+proc nest {op {listStart "NEW"} {listItem {} } } {
+ global file nestStk inDT charCnt
+# puts "nest: $op $listStart $listItem"
+ switch $op {
+ para {
+ set top [lindex $nestStk end]
+ if {$top == "NEW" } {
+ set nestStk [lreplace $nestStk end end $listStart]
+ puts $file "<$listStart>"
+ } elseif {$top != $listStart} {
+ puts stderr "nest para: bad stack"
+ exit 1
+ }
+ puts $file "\n<$listItem>"
+ set charCnt 0
+ }
+ incr {
+ lappend nestStk NEW
+ }
+ decr {
+ if {[llength $nestStk] == 0} {
+ puts stderr "nest error: nest length is zero"
+ set nestStk NEW
+ }
+ set tag [lindex $nestStk end]
+ if {$tag != "NEW"} {
+ puts $file "</$tag>"
+ }
+ set nestStk [lreplace $nestStk end end]
+ }
+ reset {
+ while {[llength $nestStk] > 0} {
+ nest decr
+ }
+ set nestStk NEW
+ }
+ init {
+ set nestStk NEW
+ set inDT {}
+ }
+ }
+ set charCnt 0
+}
+
+
+
+# do --
+#
+# This is the toplevel procedure that translates a man page
+# to Frame. It runs the man2tcl program to turn the man page
+# into a script, then it evals that script.
+#
+# Arguments:
+# fileName - Name of the file to translate.
+
+proc do fileName {
+ global file self html_dir package footer
+ set self "[file tail $fileName].html"
+ set file [open "$html_dir/$package/$self" w]
+ puts " Pass 2 -- $fileName"
+ flush stdout
+ initGlobals
+ if [catch {eval [exec man2tcl [glob $fileName]]} msg] {
+ global errorInfo
+ puts stderr $msg
+ puts "in"
+ puts stderr $errorInfo
+ exit 1
+ }
+ nest reset
+ puts $file $footer
+ puts $file "</BODY></HTML>"
+ close $file
+}
+
+
+
diff --git a/tcl/tools/man2tcl.c b/tcl/tools/man2tcl.c
new file mode 100644
index 00000000000..3bb82496826
--- /dev/null
+++ b/tcl/tools/man2tcl.c
@@ -0,0 +1,405 @@
+/*
+ * man2tcl.c --
+ *
+ * This file contains a program that turns a man page of the
+ * form used for Tcl and Tk into a Tcl script that invokes
+ * a Tcl command for each construct in the man page. The
+ * script can then be eval'ed to translate the manual entry
+ * into some other format such as MIF or HTML.
+ *
+ * Usage:
+ *
+ * man2tcl ?fileName?
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+static char sccsid[] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08";
+
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#ifndef NO_ERRNO_H
+#include <errno.h>
+#endif
+
+/*
+ * Imported things that aren't defined in header files:
+ */
+
+extern int errno;
+
+/*
+ * Current line number, used for error messages.
+ */
+
+static int lineNumber;
+
+/*
+ * The variable below is set to 1 if an error occurs anywhere
+ * while reading in the file.
+ */
+
+static int status;
+
+/*
+ * The variable below is set to 1 if output should be generated.
+ * If it's 0, it means we're doing a pre-pass to make sure that
+ * the file can be properly parsed.
+ */
+
+static int writeOutput;
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void DoMacro(char *line);
+static void DoText(char *line);
+static void QuoteText(char *string, int count);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This procedure is the main program, which does all of the work
+ * of the program.
+ *
+ * Results:
+ * None: exits with a 0 return status to indicate success, or
+ * 1 to indicate that there were problems in the translation.
+ *
+ * Side effects:
+ * A Tcl script is output to standard output. Error messages may
+ * be output on standard error.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ FILE *f;
+#define MAX_LINE_SIZE 500
+ char line[MAX_LINE_SIZE];
+ char *p;
+
+ /*
+ * Find the file to read, and open it if it isn't stdin.
+ */
+
+ if (argc == 1) {
+ f = stdin;
+ } else if (argc == 2) {
+ f = fopen(argv[1], "r");
+ if (f == NULL) {
+ fprintf(stderr, "Couldn't read \"%s\": %s\n", argv[1],
+ strerror(errno));
+ exit(1);
+ }
+ } else {
+ fprintf(stderr, "Usage: %s ?fileName?\n", argv[0]);
+ }
+
+ /*
+ * Make two passes over the file. In the first pass, just check
+ * to make sure we can handle everything. If there are problems,
+ * generate output and stop. If everything is OK, make a second
+ * pass to actually generate output.
+ */
+
+ for (writeOutput = 0; writeOutput < 2; writeOutput++) {
+ lineNumber = 0;
+ status = 0;
+ while (fgets(line, MAX_LINE_SIZE, f) != NULL) {
+ for (p = line; *p != 0; p++) {
+ if (*p == '\n') {
+ *p = 0;
+ break;
+ }
+ }
+ lineNumber++;
+
+ if ((line[0] == '\'') && (line[1] == '\\') && (line[2] == '\"')) {
+ /*
+ * This line is a comment. Ignore it.
+ */
+
+ continue;
+ }
+
+ if ((line[0] == '.') || (line[0] == '\'')) {
+ /*
+ * This line is a macro invocation.
+ */
+
+ DoMacro(line);
+ } else {
+ /*
+ * This line is text, possibly with formatting characters
+ * embedded in it.
+ */
+
+ DoText(line);
+ }
+ }
+ if (status != 0) {
+ break;
+ }
+ fseek(f, 0, SEEK_SET);
+ }
+ exit(status);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoMacro --
+ *
+ * This procedure is called to handle a macro invocation.
+ * It parses the arguments to the macro and generates a
+ * Tcl command to handle the invocation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is written to stdout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DoMacro(line)
+ char *line; /* The line of text that contains the
+ * macro invocation. */
+{
+ char *p, *end;
+
+ /*
+ * If there is no macro name, then just skip the whole line.
+ */
+
+ if ((line[1] == 0) || (isspace(line[1]))) {
+ return;
+ }
+
+ if (writeOutput) {
+ printf("macro");
+ }
+ if (*line != '.') {
+ if (writeOutput) {
+ printf("2");
+ }
+ }
+
+ /*
+ * Parse the arguments to the macro (including the name), in order.
+ */
+
+ p = line+1;
+ while (1) {
+ if (writeOutput) {
+ putc(' ', stdout);
+ }
+ if (*p == '"') {
+ /*
+ * The argument is delimited by quotes.
+ */
+
+ for (end = p+1; *end != '"'; end++) {
+ if (*end == 0) {
+ fprintf(stderr,
+ "Unclosed quote in macro call on line %d.\n",
+ lineNumber);
+ status = 1;
+ break;
+ }
+ }
+ QuoteText(p+1, (end-(p+1)));
+ } else {
+ for (end = p+1; (*end != 0) && !isspace(*end); end++) {
+ /* Empty loop body. */
+ }
+ QuoteText(p, end-p);
+ }
+ if (*end == 0) {
+ break;
+ }
+ p = end+1;
+ while (isspace(*p)) {
+ /*
+ * Skip empty space before next argument.
+ */
+
+ p++;
+ }
+ if (*p == 0) {
+ break;
+ }
+ }
+ if (writeOutput) {
+ putc('\n', stdout);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoText --
+ *
+ * This procedure is called to handle a line of troff text.
+ * It parses the text, generating Tcl commands for text and
+ * for formatting stuff such as font changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tcl commands are written to stdout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DoText(line)
+ char *line; /* The line of text. */
+{
+ char *p, *end;
+
+ /*
+ * Divide the line up into pieces consisting of backslash sequences,
+ * tabs, and other text.
+ */
+
+ p = line;
+ while (*p != 0) {
+ if (*p == '\t') {
+ if (writeOutput) {
+ printf("tab\n");
+ }
+ p++;
+ } else if (*p != '\\') {
+ /*
+ * Ordinary text.
+ */
+
+ for (end = p+1; (*end != '\\') && (*end != 0); end++) {
+ /* Empty loop body. */
+ }
+ if (writeOutput) {
+ printf("text ");
+ }
+ QuoteText(p, end-p);
+ if (writeOutput) {
+ putc('\n', stdout);
+ }
+ p = end;
+ } else {
+ /*
+ * A backslash sequence. There are particular ones
+ * that we understand; output an error message for
+ * anything else and just ignore the backslash.
+ */
+
+ p++;
+ if (*p == 'f') {
+ /*
+ * Font change.
+ */
+
+ if (writeOutput) {
+ printf("font %c\n", p[1]);
+ }
+ p += 2;
+ } else if (*p == '-') {
+ if (writeOutput) {
+ printf("dash\n");
+ }
+ p++;
+ } else if (*p == 'e') {
+ if (writeOutput) {
+ printf("text \\\\\n");
+ }
+ p++;
+ } else if (*p == '.') {
+ if (writeOutput) {
+ printf("text .\n");
+ }
+ p++;
+ } else if (*p == '&') {
+ p++;
+ } else if (*p == '(') {
+ if ((p[1] == 0) || (p[2] == 0)) {
+ fprintf(stderr, "Bad \\( sequence on line %d.\n",
+ lineNumber);
+ status = 1;
+ } else {
+ if (writeOutput) {
+ printf("char {\\(%c%c}\n", p[1], p[2]);
+ }
+ p += 3;
+ }
+ } else if (*p != 0) {
+ if (writeOutput) {
+ printf("char {\\%c}\n", *p);
+ }
+ p++;
+ }
+ }
+ }
+ if (writeOutput) {
+ printf("newline\n");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QuoteText --
+ *
+ * Copy the "string" argument to stdout, adding quote characters
+ * around any special Tcl characters so that they'll just be treated
+ * as ordinary text.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Text is written to stdout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+QuoteText(string, count)
+ char *string; /* The line of text. */
+ int count; /* Number of characters to write from string. */
+{
+ if (count == 0) {
+ if (writeOutput) {
+ printf("{}");
+ }
+ return;
+ }
+ for ( ; count > 0; string++, count--) {
+ if ((*string == '$') || (*string == '[') || (*string == '{')
+ || (*string == ' ') || (*string == ';') || (*string == '\\')
+ || (*string == '"') || (*string == '\t')) {
+ if (writeOutput) {
+ putc('\\', stdout);
+ }
+ }
+ if (writeOutput) {
+ putc(*string, stdout);
+ }
+ }
+}
diff --git a/tcl/tools/regexpTestLib.tcl b/tcl/tools/regexpTestLib.tcl
new file mode 100644
index 00000000000..d43cd4ed594
--- /dev/null
+++ b/tcl/tools/regexpTestLib.tcl
@@ -0,0 +1,266 @@
+# regexpTestLib.tcl --
+#
+# This file contains tcl procedures used by spencer2testregexp.tcl and
+# spencer2regexp.tcl, which are programs written to convert Henry
+# Spencer's test suite to tcl test files.
+#
+# Copyright (c) 1996 by Sun Microsystems, Inc.
+#
+# SCCS: @(#) regexpTestLib.tcl 1.4 98/01/22 14:48:34
+#
+
+proc readInputFile {} {
+ global inFileName
+ global lineArray
+
+ set fileId [open $inFileName r]
+
+ set i 0
+ while {[gets $fileId line] >= 0} {
+
+ set len [string length $line]
+
+ if {($len > 0) && ([string index $line [expr $len - 1]] == "\\")} {
+ if {[info exists lineArray(c$i)] == 0} {
+ set lineArray(c$i) 1
+ } else {
+ incr lineArray(c$i)
+ }
+ set line [string range $line 0 [expr $len - 2]]
+ append lineArray($i) $line
+ continue
+ }
+ if {[info exists lineArray(c$i)] == 0} {
+ set lineArray(c$i) 1
+ } else {
+ incr lineArray(c$i)
+ }
+ append lineArray($i) $line
+ incr i
+ }
+
+ close $fileId
+ return $i
+}
+
+#
+# strings with embedded @'s are truncated
+# unpreceeded @'s are replaced by {}
+#
+proc removeAts {ls} {
+ set len [llength $ls]
+ set newLs {}
+ foreach item $ls {
+ regsub @.* $item "" newItem
+ lappend newLs $newItem
+ }
+ return $newLs
+}
+
+proc convertErrCode {code} {
+
+ set errMsg "couldn't compile regular expression pattern:"
+
+ if {[string compare $code "INVARG"] == 0} {
+ return "$errMsg invalid argument to regex routine"
+ } elseif {[string compare $code "BADRPT"] == 0} {
+ return "$errMsg ?+* follows nothing"
+ } elseif {[string compare $code "BADBR"] == 0} {
+ return "$errMsg invalid repetition count(s)"
+ } elseif {[string compare $code "BADOPT"] == 0} {
+ return "$errMsg invalid embedded option"
+ } elseif {[string compare $code "EPAREN"] == 0} {
+ return "$errMsg unmatched ()"
+ } elseif {[string compare $code "EBRACE"] == 0} {
+ return "$errMsg unmatched {}"
+ } elseif {[string compare $code "EBRACK"] == 0} {
+ return "$errMsg unmatched \[\]"
+ } elseif {[string compare $code "ERANGE"] == 0} {
+ return "$errMsg invalid character range"
+ } elseif {[string compare $code "ECTYPE"] == 0} {
+ return "$errMsg invalid character class"
+ } elseif {[string compare $code "ECOLLATE"] == 0} {
+ return "$errMsg invalid collating element"
+ } elseif {[string compare $code "EESCAPE"] == 0} {
+ return "$errMsg invalid escape sequence"
+ } elseif {[string compare $code "BADPAT"] == 0} {
+ return "$errMsg invalid regular expression"
+ } elseif {[string compare $code "ESUBREG"] == 0} {
+ return "$errMsg invalid backreference number"
+ } elseif {[string compare $code "IMPOSS"] == 0} {
+ return "$errMsg can never match"
+ }
+ return "$errMsg $code"
+}
+
+proc writeOutputFile {numLines fcn} {
+ global outFileName
+ global lineArray
+
+ # open output file and write file header info to it.
+
+ set fileId [open $outFileName w]
+
+ puts $fileId "# Commands covered: $fcn"
+ puts $fileId "#"
+ puts $fileId "# This Tcl-generated file contains tests for the $fcn tcl command."
+ puts $fileId "# Sourcing this file into Tcl runs the tests and generates output for"
+ puts $fileId "# errors. No output means no errors were found. Setting VERBOSE to"
+ puts $fileId "# -1 will run tests that are known to fail."
+ puts $fileId "#"
+ puts $fileId "# Copyright (c) 1998 Sun Microsystems, Inc."
+ puts $fileId "#"
+ puts $fileId "# See the file \"license.terms\" for information on usage and redistribution"
+ puts $fileId "# of this file, and for a DISCLAIMER OF ALL WARRANTIES."
+ puts $fileId "#"
+ puts $fileId "\# SCCS: \%Z\% \%M\% \%I\% \%E\% \%U\%"
+ puts $fileId "\nproc print \{arg\} \{puts \$arg\}\n"
+ puts $fileId "if \{\[string compare test \[info procs test\]\] == 1\} \{"
+ puts $fileId " source defs ; set VERBOSE -1\n\}\n"
+ puts $fileId "if \{\$VERBOSE != -1\} \{"
+ puts $fileId " proc print \{arg\} \{\}\n\}\n"
+ puts $fileId "#"
+ puts $fileId "# The remainder of this file is Tcl tests that have been"
+ puts $fileId "# converted from Henry Spencer's regexp test suite."
+ puts $fileId "#\n"
+
+ set lineNum 0
+ set srcLineNum 1
+ while {$lineNum < $numLines} {
+
+ set currentLine $lineArray($lineNum)
+
+ # copy comment string to output file and continue
+
+ if {[string index $currentLine 0] == "#"} {
+ puts $fileId $currentLine
+ incr srcLineNum $lineArray(c$lineNum)
+ incr lineNum
+ continue
+ }
+
+ set len [llength $currentLine]
+
+ # copy empty string to output file and continue
+
+ if {$len == 0} {
+ puts $fileId "\n"
+ incr srcLineNum $lineArray(c$lineNum)
+ incr lineNum
+ continue
+ }
+ if {($len < 3)} {
+ puts "warning: test is too short --\n\t$currentLine"
+ incr srcLineNum $lineArray(c$lineNum)
+ incr lineNum
+ continue
+ }
+
+ puts $fileId [convertTestLine $currentLine $len $lineNum $srcLineNum]
+
+ incr srcLineNum $lineArray(c$lineNum)
+ incr lineNum
+ }
+
+ close $fileId
+}
+
+proc convertTestLine {currentLine len lineNum srcLineNum} {
+
+ regsub -all {(?b)\\} $currentLine {\\\\} currentLine
+ set re [lindex $currentLine 0]
+ set flags [lindex $currentLine 1]
+ set str [lindex $currentLine 2]
+
+ # based on flags, decide whether to skip the test
+
+ if {[findSkipFlag $flags]} {
+ regsub -all {\[|\]|\(|\)|\{|\}|\#} $currentLine {\&} line
+ set msg "\# skipping char mapping test from line $srcLineNum\n"
+ append msg "print \{... skip test from line $srcLineNum: $line\}"
+ return $msg
+ }
+
+ # perform mapping if '=' flag exists
+
+ set noBraces 0
+ if {[regexp {=|>} $flags] == 1} {
+ regsub -all {_} $currentLine {\\ } currentLine
+ regsub -all {A} $currentLine {\\007} currentLine
+ regsub -all {B} $currentLine {\\b} currentLine
+ regsub -all {E} $currentLine {\\033} currentLine
+ regsub -all {F} $currentLine {\\f} currentLine
+ regsub -all {N} $currentLine {\\n} currentLine
+
+ # if and \r substitutions are made, do not wrap re, flags,
+ # str, and result in braces
+
+ set noBraces [regsub -all {R} $currentLine {\\\u000D} currentLine]
+ regsub -all {T} $currentLine {\\t} currentLine
+ regsub -all {V} $currentLine {\\v} currentLine
+ if {[regexp {=} $flags] == 1} {
+ set re [lindex $currentLine 0]
+ }
+ set str [lindex $currentLine 2]
+ }
+ set flags [removeFlags $flags]
+
+ # find the test result
+
+ set numVars [expr $len - 3]
+ set vars {}
+ set vals {}
+ set result 0
+ set v 0
+
+ if {[regsub {\*} "$flags" "" newFlags] == 1} {
+ # an error is expected
+
+ if {[string compare $str "EMPTY"] == 0} {
+ # empty regexp is not an error
+ # skip this test
+
+ return "\# skipping the empty-re test from line $srcLineNum\n"
+ }
+ set flags $newFlags
+ set result "\{1 \{[convertErrCode $str]\}\}"
+ } elseif {$numVars > 0} {
+ # at least 1 match is made
+
+ if {[regexp {s} $flags] == 1} {
+ set result "\{0 1\}"
+ } else {
+ while {$v < $numVars} {
+ append vars " var($v)"
+ append vals " \$var($v)"
+ incr v
+ }
+ set tmp [removeAts [lrange $currentLine 3 $len]]
+ set result "\{0 \{1 $tmp\}\}"
+ if {$noBraces} {
+ set result "\[subst $result\]"
+ }
+ }
+ } else {
+ # no match is made
+
+ set result "\{0 0\}"
+ }
+
+ # set up the test and write it to the output file
+
+ set cmd [prepareCmd $flags $re $str $vars $noBraces]
+ if {$cmd == -1} {
+ return "\# skipping test with metasyntax from line $srcLineNum\n"
+ }
+
+ set test "test regexp-1.$srcLineNum \{converted from line $srcLineNum\} \{\n"
+ append test "\tcatch {unset var}\n"
+ append test "\tlist \[catch \{ \n"
+ append test "\t\tset match \[$cmd\] \n"
+ append test "\t\tlist \$match $vals \n"
+ append test "\t\} msg\] \$msg \n"
+ append test "\} $result \n"
+ return $test
+}
+
diff --git a/tcl/tools/tcl.hpj.in b/tcl/tools/tcl.hpj.in
new file mode 100644
index 00000000000..3400816b9ef
--- /dev/null
+++ b/tcl/tools/tcl.hpj.in
@@ -0,0 +1,19 @@
+; This file is maintained by HCW. Do not modify this file directly.
+
+[OPTIONS]
+HCW=0
+LCID=0x409 0x0 0x0 ;English (United States)
+REPORT=Yes
+TITLE=Tcl/Tk Reference Manual
+CNT=tcl83.cnt
+COPYRIGHT=Copyright © 1999 Scriptics Corporation
+HLP=tcl83.hlp
+
+[FILES]
+tcl.rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,0
+
+[CONFIG]
+BrowseButtons()
diff --git a/tcl/tools/tcl.wse.in b/tcl/tools/tcl.wse.in
new file mode 100644
index 00000000000..9ca4b0f9fc6
--- /dev/null
+++ b/tcl/tools/tcl.wse.in
@@ -0,0 +1,2356 @@
+Document Type: WSE
+item: Global
+ Version=6.01
+ Title=Tcl 8.3 for Windows Installation
+ Flags=00010100
+ Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+ Japanese Font Name=MS Gothic
+ Japanese Font Size=10
+ Start Gradient=0 0 255
+ End Gradient=0 0 0
+ Windows Flags=00000000000000010010110000001000
+ Log Pathname=%MAINDIR%\INSTALL.LOG
+ Message Font=MS Sans Serif
+ Font Size=8
+ Disk Label=tcl8.3.2
+ Disk Filename=setup
+ Patch Flags=0000000000000001
+ Patch Threshold=85
+ Patch Memory=4000
+ Variable Name1=_SYS_
+ Variable Default1=C:\WINDOWS\SYSTEM
+ Variable Flags1=00001000
+ Variable Name2=_ODBC16_
+ Variable Default2=C:\WINDOWS\SYSTEM
+ Variable Flags2=00001000
+ Variable Name3=_WISE_
+ Variable Default3=${__WISE__}
+ Variable Flags3=00001000
+end
+item: Open/Close INSTALL.LOG
+ Flags=00000001
+end
+item: Check if File/Dir Exists
+ Pathname=%SYS%
+ Flags=10000100
+end
+item: Set Variable
+ Variable=SYS
+ Value=%WIN%
+end
+item: End Block
+end
+item: Set Variable
+ Variable=VER
+ Value=8.3
+end
+item: Set Variable
+ Variable=PATCHLEVEL
+ Value=${__TCL_PATCH_LEVEL__}
+end
+item: Set Variable
+ Variable=APPTITLE
+ Value=Tcl/Tk %PATCHLEVEL% for Windows
+end
+item: Set Variable
+ Variable=URL
+ Value=http://dev.scriptics.com/registration/%PATCHLEVEL%.html
+end
+item: Set Variable
+ Variable=GROUP
+ Value=Tcl
+end
+item: Set Variable
+ Variable=DISABLED
+ Value=!
+end
+item: Set Variable
+ Variable=MAINDIR
+ Value=Tcl
+end
+item: Check Configuration
+ Flags=10111011
+end
+item: Get Registry Key Value
+ Variable=PROGRAM_FILES
+ Key=SOFTWARE\Microsoft\Windows\CurrentVersion
+ Default=C:\Program Files
+ Value Name=ProgramFilesDir
+ Flags=00000100
+end
+item: Set Variable
+ Variable=MAINDIR
+ Value=%PROGRAM_FILES%\%MAINDIR%
+end
+item: Set Variable
+ Variable=EXPLORER
+ Value=1
+end
+item: Else Statement
+end
+item: Set Variable
+ Variable=MAINDIR
+ Value=C:\%MAINDIR%
+end
+item: End Block
+end
+item: Set Variable
+ Variable=BACKUP
+ Value=%MAINDIR%\BACKUP
+end
+item: Set Variable
+ Variable=DOBACKUP
+ Value=B
+end
+item: Set Variable
+ Variable=BRANDING
+ Value=0
+end
+remarked item: If/While Statement
+ Variable=BRANDING
+ Value=1
+end
+remarked item: Read INI Value
+ Variable=NAME
+ Pathname=%INST%\CUSTDATA.INI
+ Section=Registration
+ Item=Name
+end
+remarked item: Read INI Value
+ Variable=COMPANY
+ Pathname=%INST%\CUSTDATA.INI
+ Section=Registration
+ Item=Company
+end
+remarked item: If/While Statement
+ Variable=NAME
+end
+remarked item: Set Variable
+ Variable=DOBRAND
+ Value=1
+end
+remarked item: End Block
+end
+remarked item: End Block
+end
+item: Set Variable
+ Variable=TYPE
+ Value=C
+end
+item: Set Variable
+ Variable=COMPONENTS
+ Value=ABC
+end
+item: Wizard Block
+ Direction Variable=DIRECTION
+ Display Variable=DISPLAY
+ X Position=0
+ Y Position=0
+ Filler Color=8421440
+ Flags=00000001
+end
+item: Custom Dialog Set
+ Name=Splash
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Bienvenue
+ Title German=Willkommen
+ Title Portuguese=Bem-vindo
+ Title Spanish=Bienvenido
+ Title Italian=Benvenuto
+ Title Danish=Velkommen
+ Title Dutch=Welkom
+ Title Norwegian=Velkommen
+ Title Swedish=Välkommen
+ Width=273
+ Height=250
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=166 214 208 228
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ end
+ item: Push Button
+ Rectangle=212 214 254 228
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=Cancel
+ end
+ item: Static
+ Rectangle=0 0 268 233
+ Action=2
+ Enabled Color=00000000000000001111111111111111
+ Create Flags=01010000000000000000000000001011
+ Pathname=${__TCLBASEDIR__}\tools\white.bmp
+ end
+ item: Static
+ Rectangle=5 5 268 215
+ Destination Dialog=1
+ Action=2
+ Enabled Color=00000000000000001111111111111111
+ Create Flags=01010000000000000000000000001011
+ Pathname=${__TCLBASEDIR__}\tools\tclSplash.bmp
+ end
+ end
+end
+item: End Block
+end
+item: Wizard Block
+ Direction Variable=DIRECTION
+ Display Variable=DISPLAY
+ Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
+ X Position=9
+ Y Position=10
+ Filler Color=8421440
+ Dialog=Welcome
+ Dialog=Select Destination Directory
+ Dialog=Select Installation Type
+ Dialog=Select Components
+ Dialog=Select Program Manager Group
+ Variable=
+ Variable=
+ Variable=
+ Variable=TYPE
+ Variable=EXPLORER
+ Value=
+ Value=
+ Value=
+ Value=C
+ Value=1
+ Compare=0
+ Compare=0
+ Compare=0
+ Compare=1
+ Compare=0
+ Flags=00000011
+end
+item: Custom Dialog Set
+ Name=Welcome
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Welcome!
+ Text French=Bienvenue !
+ Text German=Willkommen!
+ Text Spanish=¡Bienvenido!
+ Text Italian=Benvenuti!
+ end
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DISABLED
+ Value=!
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=85 41 255 130
+ Create Flags=01010000000000000000000000000000
+ Text=This installation program will install %APPTITLE%.
+ Text=
+ Text=Press the Next button to start the installation. You can press the Exit Setup button now if you do not want to install %APPTITLE% at this time.
+ Text=
+ Text=It is strongly recommended that you exit all Windows programs before running this installation program.
+ Text French=Ce programme d'installation va installer %APPTITLE%.
+ Text French=
+ Text French=Cliquez sur le bouton Suite pour démarrer l'installation. Vous pouvez cliquer sur le bouton Quitter l'installation si vous ne voulez pas installer %APPTITLE% tout de suite.
+ Text German=Mit diesem Installationsprogramm wird %APPTITLE% installiert.
+ Text German=
+ Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Abbrechen", um die Installation von %APPTITLE% abzubrechen.
+ Text Spanish=Este programa de instalación instalará %APPTITLE%.
+ Text Spanish=
+ Text Spanish=Presione el botón Siguiente para iniciar la instalación. Puede presionar el botón Salir de instalación si no desea instalar %APPTITLE% en este momento.
+ Text Italian=Questo programma installerà %APPTITLE%.
+ Text Italian=
+ Text Italian=Per avvviare l'installazione premere il pulsante Avanti. Se non si desidera installare %APPTITLE% ora, premere il pulsante Esci dall'installazione.
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ end
+end
+item: Custom Dialog Set
+ Name=Select Destination Directory
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Flags=0000000000000001
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Select Destination Directory
+ Text French=Sélectionner le répertoire de destination
+ Text German=Zielverzeichnis wählen
+ Text Spanish=Seleccione el directorio de destino
+ Text Italian=Selezionare Directory di destinazione
+ end
+ item: Static
+ Rectangle=86 39 256 114
+ Create Flags=01010000000000000000000000000000
+ Text=Please select the directory where the %APPTITLE% files are to be installed.
+ Text=
+ Text=To install in the default directory below, click Next.
+ Text=
+ Text=To install in a different directory, click Browse and select another directory.
+ Text French=Veuillez sélectionner le répertoire dans lequel les fichiers %APPTITLE% doivent être installés.
+ Text German=Geben Sie an, in welchem Verzeichnis die %APPTITLE%-Dateien installiert werden sollen.
+ Text Spanish=Por favor seleccione el directorio donde desee instalar los archivos de %APPTITLE%.
+ Text Italian=Selezionare la directory dove verranno installati i file %APPTITLE%.
+ end
+ item: Static
+ Rectangle=86 130 256 157
+ Action=1
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Push Button
+ Rectangle=205 138 250 153
+ Variable=MAINDIR_SAVE
+ Value=%MAINDIR%
+ Destination Dialog=1
+ Action=2
+ Create Flags=01010000000000010000000000000000
+ Text=Browse
+ Text French=Parcourir
+ Text German=Durchsuchen
+ Text Spanish=Buscar
+ Text Italian=Sfoglie
+ end
+ item: Static
+ Rectangle=91 140 198 151
+ Create Flags=01010000000000000000000000000000
+ Text=%MAINDIR%
+ Text French=%MAINDIR%
+ Text German=%MAINDIR%
+ Text Spanish=%MAINDIR%
+ Text Italian=%MAINDIR%
+ end
+ end
+ item: Dialog
+ Title=Select Destination Directory
+ Title French=Sélectionner le répertoire de destination
+ Title German=Zielverzeichnis wählen
+ Title Spanish=Seleccione el directorio de destino
+ Title Italian=Selezionare Directory di destinazione
+ Width=221
+ Height=173
+ Font Name=Helv
+ Font Size=8
+ item: Listbox
+ Rectangle=5 5 163 149
+ Variable=MAINDIR
+ Create Flags=01010000100000010000000101000000
+ Flags=0000110000100010
+ Text=%MAINDIR%
+ Text French=%MAINDIR%
+ Text German=%MAINDIR%
+ Text Spanish=%MAINDIR%
+ Text Italian=%MAINDIR%
+ end
+ item: Push Button
+ Rectangle=167 6 212 21
+ Create Flags=01010000000000010000000000000001
+ Text=OK
+ Text French=OK
+ Text German=OK
+ Text Spanish=Aceptar
+ Text Italian=OK
+ end
+ item: Push Button
+ Rectangle=167 25 212 40
+ Variable=MAINDIR
+ Value=%MAINDIR_SAVE%
+ Create Flags=01010000000000010000000000000000
+ Flags=0000000000000001
+ Text=Cancel
+ Text French=Annuler
+ Text German=Abbrechen
+ Text Spanish=Cancelar
+ Text Italian=Annulla
+ end
+ end
+end
+remarked item: Custom Dialog Set
+ Name=Select Installation Type
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Select Installation Type
+ Text French=Sélectionner les composants
+ Text German=Komponenten auswählen
+ Text Spanish=Seleccione componentes
+ Text Italian=Selezionare i componenti
+ end
+ item: Static
+ Rectangle=194 162 242 172
+ Variable=COMPONENTS
+ Value=MAINDIR
+ Create Flags=01010000000000000000000000000010
+ end
+ item: Static
+ Rectangle=194 153 242 162
+ Variable=COMPONENTS
+ Create Flags=01010000000000000000000000000010
+ end
+ item: Static
+ Rectangle=107 153 196 164
+ Create Flags=01010000000000000000000000000000
+ Text=Disk Space Required:
+ Text French=Espace disque requis :
+ Text German=Notwendiger Speicherplatz:
+ Text Spanish=Espacio requerido en el disco:
+ Text Italian=Spazio su disco necessario:
+ end
+ item: Static
+ Rectangle=107 162 196 172
+ Create Flags=01010000000000000000000000000000
+ Text=Disk Space Remaining:
+ Text French=Espace disque disponible :
+ Text German=Verbleibender Speicherplatz:
+ Text Spanish=Espacio en disco disponible:
+ Text Italian=Spazio su disco disponibile:
+ end
+ item: Static
+ Rectangle=86 145 256 175
+ Action=1
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 42 256 61
+ Create Flags=01010000000000000000000000000000
+ Text=Choose which type of installation to perform by selecting one of the buttons below.
+ Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
+ Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
+ Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
+ Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
+ end
+ item: Radio Button
+ Rectangle=86 74 256 128
+ Variable=TYPE
+ Create Flags=01010000000000010000000000001001
+ Text=&Full Installation (Recommended)
+ Text=&Minimal Installation
+ Text=C&ustom Installation
+ Text=
+ end
+ end
+end
+item: Custom Dialog Set
+ Name=Select Components
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Select Components
+ Text French=Sélectionner les composants
+ Text German=Komponenten auswählen
+ Text Spanish=Seleccione componentes
+ Text Italian=Selezionare i componenti
+ end
+ item: Checkbox
+ Rectangle=86 75 256 129
+ Variable=COMPONENTS
+ Create Flags=01010000000000010000000000000011
+ Flags=0000000000000110
+ Text=Tcl Run-Time Files
+ Text=Example Scripts
+ Text=Help Files
+ Text=Header and Library Files
+ Text=
+ Text French=Tcl Run-Time Files
+ Text French=Example Scripts
+ Text French=Help Files
+ Text French=Header and Library Files
+ Text French=
+ Text German=Tcl Run-Time Files
+ Text German=Example Scripts
+ Text German=Help Files
+ Text German=Header and Library Files
+ Text German=
+ Text Spanish=Tcl Run-Time Files
+ Text Spanish=Example Scripts
+ Text Spanish=Help Files
+ Text Spanish=Header and Library Files
+ Text Spanish=
+ Text Italian=Tcl Run-Time Files
+ Text Italian=Example Scripts
+ Text Italian=Help Files
+ Text Italian=Header and Library Files
+ Text Italian=
+ end
+ item: Static
+ Rectangle=194 162 242 172
+ Variable=COMPONENTS
+ Value=MAINDIR
+ Create Flags=01010000000000000000000000000010
+ end
+ item: Static
+ Rectangle=194 153 242 162
+ Variable=COMPONENTS
+ Create Flags=01010000000000000000000000000010
+ end
+ item: Static
+ Rectangle=107 153 196 164
+ Create Flags=01010000000000000000000000000000
+ Text=Disk Space Required:
+ Text French=Espace disque requis :
+ Text German=Notwendiger Speicherplatz:
+ Text Spanish=Espacio requerido en el disco:
+ Text Italian=Spazio su disco necessario:
+ end
+ item: Static
+ Rectangle=107 162 196 172
+ Create Flags=01010000000000000000000000000000
+ Text=Disk Space Remaining:
+ Text French=Espace disque disponible :
+ Text German=Verbleibender Speicherplatz:
+ Text Spanish=Espacio en disco disponible:
+ Text Italian=Spazio su disco disponibile:
+ end
+ item: Static
+ Rectangle=86 145 256 175
+ Action=1
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 42 256 61
+ Create Flags=01010000000000000000000000000000
+ Text=Choose which components to install by checking the boxes below.
+ Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
+ Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
+ Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
+ Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
+ end
+ end
+end
+item: Custom Dialog Set
+ Name=Select Program Manager Group
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Flags=0000000000000001
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Select ProgMan Group
+ Text French=Sélectionner le groupe du Gestionnaire de programme
+ Text German=Bestimmung der Programm-Managergruppe
+ Text Spanish=Seleccione grupo del Administrador de programas
+ Text Italian=Selezionare il gruppo ProgMan
+ end
+ item: Static
+ Rectangle=86 44 256 68
+ Create Flags=01010000000000000000000000000000
+ Text=Enter the name of the Program Manager group to add the %APPTITLE% icons to:
+ Text French=Entrez le nom du groupe du Gestionnaire de programme dans lequel vous souhaitez ajouter les icônes de %APPTITLE% :
+ Text German=Geben Sie den Namen der Programmgruppe ein, der das Symbol %APPTITLE% hinzugefügt werden soll:
+ Text Spanish=Escriba el nombre del grupo del Administrador de programas en el que desea agregar los iconos de %APPTITLE%:
+ Text Italian=Inserire il nome del gruppo Program Manager per aggiungere le icone %APPTITLE% a:
+ end
+ item: Combobox
+ Rectangle=86 69 256 175
+ Variable=GROUP
+ Create Flags=01010000000000010000001000000001
+ Flags=0000000000000001
+ Text=%GROUP%
+ Text French=%GROUP%
+ Text German=%GROUP%
+ Text Spanish=%GROUP%
+ Text Italian=%GROUP%
+ end
+ end
+end
+item: Custom Dialog Set
+ Name=Start Installation
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Ready to Install!
+ Text French=Prêt à installer !
+ Text German=Installationsbereit!
+ Text Spanish=¡Preparado para la instalación!
+ Text Italian=Pronto per l'installazione!
+ end
+ item: Static
+ Rectangle=86 42 256 102
+ Create Flags=01010000000000000000000000000000
+ Text=You are now ready to install %APPTITLE%.
+ Text=
+ Text=Press the Next button to begin the installation or the Back button to reenter the installation information.
+ Text French=Vous êtes maintenant prêt à installer les fichiers %APPTITLE%.
+ Text French=
+ Text French=Cliquez sur le bouton Suite pour commencer l'installation ou sur le bouton Retour pour entrer les informations d'installation à nouveau.
+ Text German=Sie können %APPTITLE% nun installieren.
+ Text German=
+ Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Zurück", um die Installationsinformationen neu einzugeben.
+ Text Spanish=Ya está listo para instalar %APPTITLE%.
+ Text Spanish=
+ Text Spanish=Presione el botón Siguiente para comenzar la instalación o presione Atrás para volver a ingresar la información para la instalación.
+ Text Italian=Ora è possibile installare %APPTITLE%.
+ Text Italian=
+ Text Italian=Premere il pulsante Avanti per avviare l'installazione o il pulsante Indietro per reinserire le informazioni di installazione.
+ end
+ end
+end
+item: If/While Statement
+ Variable=DISPLAY
+ Value=Select Destination Directory
+end
+item: Set Variable
+ Variable=BACKUP
+ Value=%MAINDIR%\BACKUP
+end
+item: End Block
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=TYPE
+ Value=B
+end
+item: Set Variable
+ Variable=COMPONENTS
+ Value=A
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=DOBACKUP
+ Value=A
+end
+item: Set Variable
+ Variable=BACKUPDIR
+ Value=%BACKUP%
+end
+item: End Block
+end
+remarked item: If/While Statement
+ Variable=BRANDING
+ Value=1
+end
+remarked item: If/While Statement
+ Variable=DOBRAND
+ Value=1
+end
+remarked item: Edit INI File
+ Pathname=%INST%\CUSTDATA.INI
+ Settings=[Registration]
+ Settings=NAME=%NAME%
+ Settings=COMPANY=%COMPANY%
+ Settings=
+end
+remarked item: End Block
+end
+remarked item: End Block
+end
+item: Set Variable
+ Variable=MAINDIRSHORT
+ Value=%MAINDIR%
+ Flags=00010100
+end
+item: Open/Close INSTALL.LOG
+end
+item: Check Disk Space
+ Component=COMPONENTS
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\license.txt
+ Destination=%MAINDIR%\license.txt
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\Readme.txt
+ Destination=%MAINDIR%\Readme.txt
+ Flags=0000000000000010
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=D
+ Flags=00001010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\win\release\tk83.lib
+ Destination=%MAINDIR%\lib\tk83.lib
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\win\release\tkstub83.lib
+ Destination=%MAINDIR%\lib\tkstub83.lib
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tcl83.lib
+ Destination=%MAINDIR%\lib\tcl83.lib
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tclstub83.lib
+ Destination=%MAINDIR%\lib\tclstub83.lib
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\Xutil.h
+ Destination=%MAINDIR%\include\X11\Xutil.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\Xlib.h
+ Destination=%MAINDIR%\include\X11\Xlib.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\Xfuncproto.h
+ Destination=%MAINDIR%\include\X11\Xfuncproto.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\Xatom.h
+ Destination=%MAINDIR%\include\X11\Xatom.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\X.h
+ Destination=%MAINDIR%\include\X11\X.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\keysymdef.h
+ Destination=%MAINDIR%\include\X11\keysymdef.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\keysym.h
+ Destination=%MAINDIR%\include\X11\keysym.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\cursorfont.h
+ Destination=%MAINDIR%\include\X11\cursorfont.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\generic\tk.h
+ Destination=%MAINDIR%\include\tk.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\generic\tkDecls.h
+ Destination=%MAINDIR%\include\tkDecls.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\generic\tkIntXlibDecls.h
+ Destination=%MAINDIR%\include\tkIntXlibDecls.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\generic\tcl.h
+ Destination=%MAINDIR%\include\tcl.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\generic\tclDecls.h
+ Destination=%MAINDIR%\include\tclDecls.h
+ Flags=0000000000000010
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\msgcat1.0\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.0\pkgIndex.tcl
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\msgcat1.0\msgcat.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.0\msgcat.tcl
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\tcltest1.0\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\tcltest1.0\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\tcltest1.0\tcltest.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\tcltest1.0\tcltest.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\symbol.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\symbol.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\shiftjis.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\shiftjis.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macUkraine.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macUkraine.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macTurkish.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macTurkish.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macThai.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macThai.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macRomania.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRomania.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macRoman.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRoman.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macJapan.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macJapan.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macIceland.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macIceland.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macGreek.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macGreek.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macDingbats.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macDingbats.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macCyrillic.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCyrillic.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macCroatian.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCroatian.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macCentEuro.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCentEuro.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\ksc5601.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\ksc5601.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\koi8-r.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\koi8-r.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\jis0212.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0212.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\jis0208.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0208.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\jis0201.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0201.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-9.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-9.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-8.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-8.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-7.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-7.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-6.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-6.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-5.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-5.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-4.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-4.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-3.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-3.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-2.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-2.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-1.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-1.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso2022.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso2022-kr.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-kr.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso2022-jp.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-jp.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\gb2312.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb2312.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\gb1988.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb1988.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\gb12345.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb12345.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\euc-cn.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-cn.enc
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\euc-jp.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-jp.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\euc-kr.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-kr.enc
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\dingbats.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\dingbats.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp950.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp950.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp949.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp949.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp936.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp936.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp932.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp932.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp874.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp874.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp869.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp869.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp866.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp866.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp865.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp865.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp864.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp864.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp863.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp863.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp862.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp862.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp861.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp861.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp860.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp860.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp857.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp857.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp855.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp855.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp852.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp852.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp850.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp850.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp775.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp775.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp737.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp737.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp437.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp437.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1258.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1258.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1257.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1257.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1256.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1256.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1255.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1255.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1254.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1254.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1253.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1253.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1252.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1252.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1251.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1251.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1250.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1250.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\ascii.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\ascii.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\big5.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\big5.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\opt0.4\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\opt0.4\optparse.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\http2.3\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\http2.3\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\http2.3\http.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\http2.3\http.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\msgbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\optMenu.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\clrpick.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\entry.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\entry.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\comdlg.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\bgerror.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\obsolete.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\button.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\button.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\xmfbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\console.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\console.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\listbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\menu.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\menu.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\dialog.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\focus.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\focus.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\palette.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\palette.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\tkfbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\tk.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\tk.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\text.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\text.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\tearoff.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\tclIndex
+ Destination=%MAINDIR%\lib\tk%VER%\tclIndex
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\scrlbar.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\scale.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\scale.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\safetk.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\http1.0\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\http1.0\http.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\reg1.0\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tclreg83.dll
+ Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg83.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\dde1.1\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\dde1.1\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tcldde83.dll
+ Destination=%MAINDIR%\lib\tcl%VER%\dde1.1\tcldde83.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=C:\WINNT\SYSTEM32\Msvcrt.dll
+ Destination=%MAINDIR%\bin\msvcrt.dll
+ Flags=0010001000000011
+end
+item: Install File
+ Source=${__TKBASEDIR__}\win\release\wish83.exe
+ Destination=%MAINDIR%\bin\wish83.exe
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tclsh83.exe
+ Destination=%MAINDIR%\bin\tclsh83.exe
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tclpip83.dll
+ Destination=%MAINDIR%\bin\tclpip83.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tcl83.dll
+ Destination=%MAINDIR%\bin\tcl83.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\win\release\tk83.dll
+ Destination=%MAINDIR%\bin\tk83.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\auto.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\auto.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\history.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\history.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\init.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\init.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\package.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\package.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\parray.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\safe.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\tclIndex
+ Destination=%MAINDIR%\lib\tcl%VER%\tclIndex
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\word.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\word.tcl
+ Flags=0000000000000010
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=B
+ Flags=00001010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\tai-ku.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\tai-ku.gif
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\teapot.ppm
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\teapot.ppm
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\tcllogo.gif
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\tcllogo.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\pattern.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\pattern.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\noletter.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\noletter.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\letters.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\letters.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\gray25.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\gray25.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\flagup.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagup.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\flagdown.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagdown.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\face.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\face.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\earthris.gif
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\earthris.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\earth.gif
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\earth.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\vscale.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\vscale.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\twind.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\twind.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\text.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\text.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\style.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\style.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\states.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\states.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\search.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\search.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\sayings.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\sayings.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\ruler.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\ruler.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\radio.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\radio.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\puzzle.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\puzzle.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\plot.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\plot.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\msgbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\msgbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\menubu.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\menubu.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\menu.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\menu.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\label.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\label.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\items.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\items.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\image2.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\image2.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\image1.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\image1.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\icon.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\icon.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\hscale.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\hscale.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\form.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\form.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\ixset
+ Destination=%MAINDIR%\lib\tk%VER%\demos\ixset.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\rolodex
+ Destination=%MAINDIR%\lib\tk%VER%\demos\rolodex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\square
+ Destination=%MAINDIR%\lib\tk%VER%\demos\square.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\Readme
+ Destination=%MAINDIR%\lib\tk%VER%\demos\Readme
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\hello
+ Destination=%MAINDIR%\lib\tk%VER%\demos\hello.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\tclIndex
+ Destination=%MAINDIR%\lib\tk%VER%\demos\tclIndex
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\browse
+ Destination=%MAINDIR%\lib\tk%VER%\demos\browse.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\timer
+ Destination=%MAINDIR%\lib\tk%VER%\demos\timer.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\widget
+ Destination=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\tcolor
+ Destination=%MAINDIR%\lib\tk%VER%\demos\tcolor.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\rmt
+ Destination=%MAINDIR%\lib\tk%VER%\demos\rmt.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\floor.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\floor.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\filebox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\filebox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo75.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo75.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo200.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo200.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo175.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo175.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo150.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo150.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo100.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo100.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\logoMed.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\logoMed.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\logoLarge.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\logoLarge.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\logo64.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\logo64.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\logo100.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\logo100.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\Readme
+ Destination=%MAINDIR%\lib\tk%VER%\images\Readme
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\arrow.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\arrow.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\bind.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\bind.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\bitmap.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\bitmap.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\button.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\button.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\check.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\check.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\clrpick.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\clrpick.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\colors.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\colors.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\cscroll.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\cscroll.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\ctext.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\ctext.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\dialog1.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\dialog1.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\dialog2.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\dialog2.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\entry1.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\entry1.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\entry2.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\entry2.tcl
+ Flags=0000000000000010
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=C
+ Flags=00001010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\tools\tcl83.cnt
+ Destination=%MAINDIR%\doc\tcl83.cnt
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\tools\tcl83.hlp
+ Destination=%MAINDIR%\doc\tcl83.hlp
+ Flags=0000000000000010
+end
+item: End Block
+end
+item: Set Variable
+ Variable=MAINDIR
+ Value=%MAINDIR%
+ Flags=00010100
+end
+item: Include Script
+ Pathname=\\pop\tools\1.2\win32-ix86\wise\INCLUDE\uninstal.wse
+end
+item: Check Configuration
+ Flags=10111011
+end
+item: Get Registry Key Value
+ Variable=GROUPDIR
+ Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders
+ Default=%WIN%\Start Menu\Programs
+ Value Name=Programs
+ Flags=00000010
+end
+item: Set Variable
+ Variable=GROUP
+ Value=%GROUPDIR%\%GROUP%
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Create Shortcut
+ Source=%MAINDIR%\bin\wish83.exe
+ Destination=%GROUP%\Wish.lnk
+ Working Directory=%MAINDIR%
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Create Shortcut
+ Source=%MAINDIR%\bin\tclsh83.exe
+ Destination=%GROUP%\Tclsh.lnk
+ Working Directory=%MAINDIR%
+ Key Type=1536
+ Flags=00000001
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=C
+ Flags=00001010
+end
+item: Create Shortcut
+ Source=%MAINDIR%\doc\tcl83.hlp
+ Destination=%GROUP%\Tcl Help.lnk
+ Working Directory=%MAINDIR%
+end
+item: End Block
+end
+item: Create Shortcut
+ Source=%MAINDIR%\Readme.txt
+ Destination=%GROUP%\Readme.lnk
+ Working Directory=%MAINDIR%
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=B
+ Flags=00001010
+end
+item: Create Shortcut
+ Source=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
+ Destination=%GROUP%\Widget Tour.lnk
+ Working Directory=%MAINDIR%
+ Key Type=1536
+ Flags=00000001
+end
+item: End Block
+end
+item: Else Statement
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=B
+ Flags=00001010
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Widget Tour
+ Command Line=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
+ Icon Pathname=%MAINDIR%\bin\wish83.exe
+ Default Directory=%MAINDIR%
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=C
+ Flags=00001010
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Tcl Help
+ Command Line=%MAINDIR%\doc\tcl83.hlp
+ Default Directory=%MAINDIR%
+end
+item: End Block
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Readme
+ Command Line=%MAINDIR%\Readme.txt
+ Default Directory=%MAINDIR%
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Wish
+ Command Line=%MAINDIR%\bin\wish83.exe
+ Default Directory=%MAINDIR%
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Tclsh
+ Command Line=%MAINDIR%\bin\tclsh83.exe
+ Default Directory=%MAINDIR%
+end
+item: End Block
+end
+item: End Block
+end
+item: Self-Register OCXs/DLLs
+ Description=Updating System Configuration, Please Wait...
+end
+item: Edit Registry
+ Total Keys=1
+ Key=SOFTWARE\Scriptics\Tcl\%VER%
+ New Value=%MAINDIR%
+ Value Name=Root
+ Root=2
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript\DefaultIcon
+ New Value=%MAINDIR%\bin\tk83.dll
+end
+item: Edit Registry
+ Total Keys=1
+ Key=.tcl
+ New Value=TclScript
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript
+ New Value=TclScript
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript\shell\open\command
+ New Value=%MAINDIRSHORT%\bin\wish83.exe "%%1" %%*
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript\shell\edit
+ New Value=&Edit
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript\shell\edit\command
+ New Value=notepad "%%1"
+end
+item: Add Directory to Path
+ Directory=%MAINDIR%\bin
+end
+item: Check Configuration
+ Flags=10111011
+end
+item: Set Variable
+ Variable=TO_SCRIPTICS
+ Value=A
+end
+item: Else Statement
+end
+item: Set Variable
+ Variable=TO_SCRIPTICS
+end
+item: End Block
+end
+item: Wizard Block
+ Direction Variable=DIRECTION
+ Display Variable=DISPLAY
+ Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
+ X Position=9
+ Y Position=10
+ Filler Color=8421440
+ Flags=00000011
+end
+item: Custom Dialog Set
+ Name=Finished
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Finish
+ Text French=&Fin
+ Text German=&Weiter
+ Text Spanish=&Terminar
+ Text Italian=&Fine
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DISABLED
+ Value=!
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Variable=DISABLED
+ Value=!
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Installation Completed!
+ Text French=Installation terminée !
+ Text German=Die Installation ist abgeschlossen!
+ Text Spanish=¡Instalación terminada!
+ Text Italian=Installazione completata!
+ end
+ item: Static
+ Rectangle=86 42 256 153
+ Create Flags=01010000000000000000000000000000
+ Text=%APPTITLE% has been successfully installed.
+ Text=
+ Text=Click the Finish button to exit this installation.
+ Text=
+ Text=You can learn more about Tcl/Tk %VER%, including release notes, updates, tutorials, and more at %URL%. Check the box below to start your web browser and go there now.
+ Text=
+ Text=The installer may ask you to reboot your computer, this is to update your PATH and is not necessary to do immediately.
+ Text French=%APPTITLE% est maintenant installé.
+ Text French=
+ Text French=Cliquez sur le bouton Fin pour quitter l'installation.
+ Text German=%APPTITLE% wurde erfolgreich installiert.
+ Text German=
+ Text German=Klicken Sie auf "Weiter", um die Installation zu beenden.
+ Text Spanish=%APPTITLE% se ha instalado con éxito.
+ Text Spanish=
+ Text Spanish=Presione el botón Terminar para salir de esta instalación.
+ Text Italian=L'installazione %APPTITLE% è stata portata a termine con successo.
+ Text Italian=
+ Text Italian=Premere il pulsante Fine per uscire dall'installazione.
+ end
+ item: Checkbox
+ Rectangle=88 143 245 157
+ Variable=TO_SCRIPTICS
+ Enabled Color=00000000000000001111111111111111
+ Create Flags=01010000000000010000000000000011
+ Text=Show me important information about
+ Text=
+ end
+ item: Static
+ Rectangle=99 156 245 170
+ Enabled Color=00000000000000001111111111111111
+ Create Flags=01010000000000000000000000000000
+ Text=Tcl/Tk %VER% and TclPro
+ end
+ end
+end
+item: End Block
+end
+item: Check Configuration
+ Flags=10111011
+end
+item: If/While Statement
+ Variable=TO_SCRIPTICS
+ Value=A
+ Flags=00000010
+end
+item: Execute Program
+ Command Line=%URL%
+end
+item: End Block
+end
+item: Execute Program
+ Pathname=explorer
+ Command Line=%GROUP%
+end
+item: End Block
+end
diff --git a/tcl/tools/tclSplash.bmp b/tcl/tools/tclSplash.bmp
new file mode 100644
index 00000000000..19e3c4a7c04
--- /dev/null
+++ b/tcl/tools/tclSplash.bmp
Binary files differ
diff --git a/tcl/tools/tcltk-man2html.tcl b/tcl/tools/tcltk-man2html.tcl
new file mode 100755
index 00000000000..3893e55bf75
--- /dev/null
+++ b/tcl/tools/tcltk-man2html.tcl
@@ -0,0 +1,1675 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not tcl \
+exec tclsh8.2 "$0" ${1+"$@"}
+
+package require Tcl 8.2
+
+# Convert Ousterhout format man pages into highly crosslinked
+# hypertext.
+#
+# Along the way detect many unmatched font changes and other odd
+# things.
+#
+# Note well, this program is a hack rather than a piece of software
+# engineering. In that sense it's probably a good example of things
+# that a scripting language, like Tcl, can do well. It is offered as
+# an example of how someone might convert a specific set of man pages
+# into hypertext, not as a general solution to the problem. If you
+# try to use this, you'll be very much on your own.
+#
+# Copyright (c) 1995-1997 Roger E. Critchlow Jr
+#
+# The authors hereby grant permission to use, copy, modify, distribute,
+# and license this software and its documentation for any purpose, provided
+# that existing copyright notices are retained in all copies and that this
+# notice is included verbatim in any distributions. No written agreement,
+# license, or royalty fee is required for any of the authorized uses.
+# Modifications to this software may be copyrighted by their authors
+# and need not follow the licensing terms described here, provided that
+# the new terms are clearly indicated on the first page of each file where
+# they apply.
+#
+# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+#
+# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+# MODIFICATIONS.
+#
+# Revisions:
+# May 15, 1995 - initial release
+# May 16, 1995 - added a back to home link to toplevel table of
+# contents.
+# May 18, 1995 - broke toplevel table of contents into separate
+# pages for each section, and broke long table of contents
+# into a one page for each man page.
+# Mar 10, 1996 - updated for tcl7.5b3/tk4.1b3
+# Apr 14, 1996 - incorporated command line parsing from Tom Tromey,
+# <tromey@creche.cygnus.com> -- thanks Tom.
+# - updated for tcl7.5/tk4.1 final release.
+# - converted to same copyright as the man pages.
+# Sep 14, 1996 - made various modifications for tcl7.6b1/tk4.2b1
+# Oct 18, 1996 - added tcl7.6/tk4.2 to the list of distributions.
+# Oct 22, 1996 - major hacking on indentation code and elsewhere.
+# Mar 4, 1997 -
+# May 28, 1997 - added tcl8.0b1/tk8.0b1 to the list of distributions
+# - cleaned source for tclsh8.0 execution
+# - renamed output files for windoze installation
+# - added spaces to tables
+# Oct 24, 1997 - moved from 8.0b1 to 8.0 release
+#
+
+set Version "0.20"
+
+proc parse_command_line {} {
+ global argv Version
+
+ # These variables determine where the man pages come from and where
+ # the converted pages go to.
+ global tcltkdir tkdir tcldir webdir
+
+ # Set defaults based on original code.
+ set tcltkdir ../..
+ set tkdir {}
+ set tcldir {}
+ set webdir ../html
+
+ # Directory names for Tcl and Tk, in priority order.
+ set tclDirList {tcl8.3 tcl8.2 tcl8.1 tcl8.0 tcl}
+ set tkDirList {tk8.3 tk8.2 tk8.1 tk8.0 tk}
+
+ # Handle arguments a la GNU:
+ # --version
+ # --help
+ # --srcdir=/path
+ # --htmldir=/path
+
+ foreach option $argv {
+ switch -glob -- $option {
+ --version {
+ puts "tcltk-man-html $Version"
+ exit 0
+ }
+
+ --help {
+ puts "usage: tcltk-man-html \[OPTION\] ...\n"
+ puts " --help print this help, then exit"
+ puts " --version print version number, then exit"
+ puts " --srcdir=DIR find tcl and tk source below DIR"
+ puts " --htmldir=DIR put generated HTML in DIR"
+ exit 0
+ }
+
+ --srcdir=* {
+ # length of "--srcdir=" is 9.
+ set tcltkdir [string range $option 9 end]
+ }
+
+ --htmldir=* {
+ # length of "--htmldir=" is 10
+ set webdir [string range $option 10 end]
+ }
+
+ default {
+ puts stderr "tcltk-man-html: unrecognized option -- `$option'"
+ exit 1
+ }
+ }
+ }
+
+ # Find Tcl.
+ foreach dir $tclDirList {
+ if {[file isdirectory $tcltkdir/$dir]} then {
+ set tcldir $dir
+ break
+ }
+ }
+ if {$tcldir == ""} then {
+ puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
+ exit 1
+ }
+
+ # Find Tk.
+ foreach dir $tkDirList {
+ if {[file isdirectory $tcltkdir/$dir]} then {
+ set tkdir $dir
+ break
+ }
+ }
+ if {$tkdir == ""} then {
+ puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
+ exit 1
+ }
+
+ # the title for the man pages overall
+ global overall_title
+ set overall_title "[capitalize $tcldir]/[capitalize $tkdir] Manual"
+}
+
+proc capitalize {string} {
+ return [string toupper $string 0]
+}
+
+##
+##
+##
+set manual(report-level) 1
+
+proc manerror {msg} {
+ global manual
+ set name {}
+ set subj {}
+ if {[info exists manual(name)]} {
+ set name $manual(name)
+ }
+ if {[info exists manual(section)] && [string length $manual(section)]} {
+ puts stderr "$name: $manual(section): $msg"
+ } else {
+ puts stderr "$name: $msg"
+ }
+}
+
+proc manreport {level msg} {
+ global manual
+ if {$level < $manual(report-level)} {
+ manerror $msg
+ }
+}
+
+proc fatal {msg} {
+ global manual
+ manerror $msg
+ exit 1
+}
+##
+## parsing
+##
+proc unquote arg {
+ return [string map [list \" {}] $arg]
+}
+
+proc parse-directive {line codename restname} {
+ upvar $codename code $restname rest
+ return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
+}
+
+proc process-text {text} {
+ global manual
+ # preprocess text
+ set text [string map [list \
+ {\&} "\t" \
+ {&} {&amp;} \
+ {\\} {&#92;} \
+ {\e} {&#92;} \
+ {\ } {&nbsp;} \
+ {\|} {&nbsp;} \
+ {\0} { } \
+ {\%} {} \
+ "\\\n" "\n" \
+ \" {&quot;} \
+ {<} {&lt;} \
+ {>} {&gt;} \
+ {\(+-} {&#177;} \
+ {\fP} {\fR} \
+ {\.} . \
+ ] $text]
+ regsub -all {\\o'o\^'} $text {\&ocirc;} text; # o-circumflex in re_syntax.n
+ regsub -all {\\-\\\|\\-} $text -- text; # two hyphens
+ regsub -all -- {\\-\\\^\\-} $text -- text; # two hyphens
+ regsub -all {\\-} $text - text; # a hyphen
+ regsub -all "\\\\\n" $text "\\&\#92;\n" text; # backslashed newline
+ while {[regexp {\\} $text]} {
+ # C R
+ if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text {\1<TT>\2</TT>\3} text]} continue
+ # B R
+ if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text {\1<B>\2</B>\3} text]} continue
+ # B I
+ if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text {\1<B>\2</B>\\fI\3} text]} continue
+ # I R
+ if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text {\1<I>\2</I>\3} text]} continue
+ # I B
+ if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text {\1<I>\2</I>\\fB\3} text]} continue
+ # B B, I I, R R
+ if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text {\1\\fB\2\3} ntext]
+ || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text {\1\\fI\2\3} ntext]
+ || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text {\1\\fR\2\3} ntext]} {
+ manerror "process-text: impotent font change: $text"
+ set text $ntext
+ continue
+ }
+ # unrecognized
+ manerror "process-text: uncaught backslash: $text"
+ set text [string map [list "\\" "#92;"] $text]
+ }
+ return $text
+}
+##
+## pass 2 text input and matching
+##
+proc open-text {} {
+ global manual
+ set manual(text-length) [llength $manual(text)]
+ set manual(text-pointer) 0
+}
+proc more-text {} {
+ global manual
+ return [expr {$manual(text-pointer) < $manual(text-length)}]
+}
+proc next-text {} {
+ global manual
+ if {[more-text]} {
+ set text [lindex $manual(text) $manual(text-pointer)]
+ incr manual(text-pointer)
+ return $text
+ }
+ manerror "read past end of text"
+ error "fatal"
+}
+proc is-a-directive {line} {
+ return [expr {[string first . $line] == 0}]
+}
+proc split-directive {line opname restname} {
+ upvar $opname op $restname rest
+ set op [string range $line 0 2]
+ set rest [string trim [string range $line 3 end]]
+}
+proc next-op-is {op restname} {
+ global manual
+ upvar $restname rest
+ if {[more-text]} {
+ set text [lindex $manual(text) $manual(text-pointer)]
+ if {[string equal -length 3 $text $op]} {
+ set rest [string range $text 4 end]
+ incr manual(text-pointer)
+ return 1
+ }
+ }
+ return 0
+}
+proc backup-text {n} {
+ global manual
+ if {$manual(text-pointer)-$n >= 0} {
+ incr manual(text-pointer) -$n
+ }
+}
+proc match-text args {
+ global manual
+ set nargs [llength $args]
+ if {$manual(text-pointer) + $nargs > $manual(text-length)} {
+ return 0
+ }
+ set nback 0
+ foreach arg $args {
+ if {![more-text]} {
+ backup-text $nback
+ return 0
+ }
+ set arg [string trim $arg]
+ set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
+ if {[string equal $arg $targ]} {
+ incr nback
+ incr manual(text-pointer)
+ continue
+ }
+ if {[regexp {^@([_a-zA-Z0-9]+)$} $arg all name]} {
+ upvar $name var
+ set var $targ
+ incr nback
+ incr manual(text-pointer)
+ continue
+ }
+ if {[regexp {^(\.[a-zA-Z][a-zA-Z])@([_a-zA-Z0-9]+)$} $arg all op name]\
+ && [string equal $op [lindex $targ 0]]} {
+ upvar $name var
+ set var [lrange $targ 1 end]
+ incr nback
+ incr manual(text-pointer)
+ continue
+ }
+ backup-text $nback
+ return 0
+ }
+ return 1
+}
+proc expand-next-text {n} {
+ global manual
+ return [join [lrange $manual(text) $manual(text-pointer) \
+ [expr {$manual(text-pointer)+$n-1}]] \n\n]
+}
+##
+## pass 2 output
+##
+proc man-puts {text} {
+ global manual
+ lappend manual(output-$manual(wing-file)-$manual(name)) $text
+}
+
+##
+## build hypertext links to tables of contents
+##
+proc long-toc {text} {
+ global manual
+ set here M[incr manual(section-toc-n)]
+ set there L[incr manual(long-toc-n)]
+ lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
+ return "<A NAME=\"$here\">$text</A>"
+}
+proc option-toc {name class switch} {
+ global manual
+ if {[string equal $manual(section) "WIDGET-SPECIFIC OPTIONS"]} {
+ # link the defined option into the long table of contents
+ set link [long-toc "$switch, $name, $class"]
+ regsub -- "$switch, $name, $class" $link "$switch" link
+ return $link
+ } elseif {[string equal $manual(name):$manual(section) \
+ "options:DESCRIPTION"]} {
+ # link the defined standard option to the long table of
+ # contents and make a target for the standard option references
+ # from other man pages.
+ set first [lindex $switch 0]
+ set here M$first
+ set there L[incr manual(long-toc-n)]
+ set manual(standard-option-$first) "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"
+ lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
+ return "<A NAME=\"$here\">$switch</A>"
+ } else {
+ error "option-toc in $manual(name) section $manual(section)"
+ }
+}
+proc std-option-toc {name} {
+ global manual
+ if {[info exists manual(standard-option-$name)]} {
+ lappend manual(section-toc) <DD>$manual(standard-option-$name)
+ return $manual(standard-option-$name)
+ }
+ set here M[incr manual(section-toc-n)]
+ set there L[incr manual(long-toc-n)]
+ set other M$name
+ lappend manual(section-toc) "<DD><A HREF=\"options.htm#$other\">$name</A>"
+ return "<A HREF=\"options.htm#$other\">$name</A>"
+}
+##
+## process the widget option section
+## in widget and options man pages
+##
+proc output-widget-options {rest} {
+ global manual
+ man-puts <DL>
+ lappend manual(section-toc) <DL>
+ backup-text 1
+ set para {}
+ while {[next-op-is .OP rest]} {
+ switch -exact [llength $rest] {
+ 3 {
+ set switch [lindex $rest 0]
+ set name [lindex $rest 1]
+ set class [lindex $rest 2]
+ }
+ 5 {
+ set switch [lrange $rest 0 2]
+ set name [lindex $rest 3]
+ set class [lindex $rest 4]
+ }
+ default {
+ fatal "bad .OP $rest"
+ }
+ }
+ if {![regexp {^(<.>)([-a-zA-Z0-9 ]+)(</.>)$} $switch all oswitch switch cswitch]} {
+ if {![regexp {^(<.>)([-a-zA-Z0-9 ]+) or ([-a-zA-Z0-9 ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} {
+ error "not Switch: $switch"
+ } else {
+ set switch "$switch1$cswitch or $oswitch$switch2"
+ }
+ }
+ if {![regexp {^(<.>)([a-zA-Z0-9]*)(</.>)$} $name all oname name cname]} {
+ error "not Name: $name"
+ }
+ if {![regexp {^(<.>)([a-zA-Z0-9]*)(</.>)$} $class all oclass class cclass]} {
+ error "not Class: $class"
+ }
+ man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
+ man-puts "<DT>Database Name: $oname$name$cname"
+ man-puts "<DT>Database Class: $oclass$class$cclass"
+ man-puts <DD>[next-text]
+ set para <P>
+ }
+ man-puts </DL>
+ lappend manual(section-toc) </DL>
+}
+
+##
+## process .RS lists
+##
+proc output-RS-list {} {
+ global manual
+ if {[next-op-is .IP rest]} {
+ output-IP-list .RS .IP $rest
+ if {[match-text .RE .sp .RS @rest .IP @rest2]} {
+ man-puts <P>$rest
+ output-IP-list .RS .IP $rest2
+ }
+ if {[match-text .RE .sp .RS @rest .RE]} {
+ man-puts <P>$rest
+ return
+ }
+ if {[next-op-is .RE rest]} {
+ return
+ }
+ }
+ man-puts <DL><P><DD>
+ while {[more-text]} {
+ set line [next-text]
+ if {[is-a-directive $line]} {
+ split-directive $line code rest
+ switch -exact $code {
+ .RE {
+ break
+ }
+ .SH {
+ manerror "unbalanced .RS at section end"
+ backup-text 1
+ break
+ }
+ default {
+ output-directive $line
+ }
+ }
+ } else {
+ man-puts $line
+ }
+ }
+ man-puts </DL>
+}
+
+##
+## process .IP lists which may be plain indents,
+## numeric lists, or definition lists
+##
+proc output-IP-list {context code rest} {
+ global manual
+ if {[string equal $rest {}]} {
+ # blank label, plain indent, no contents entry
+ man-puts <DL><P><DD>
+ while {[more-text]} {
+ set line [next-text]
+ if {[is-a-directive $line]} {
+ split-directive $line code rest
+ if {[string equal $code ".IP"] && [string equal $rest {}]} {
+ man-puts "<P>"
+ continue
+ }
+ if {[lsearch {.br .DS .RS} $code] >= 0} {
+ output-directive $line
+ } else {
+ backup-text 1
+ break
+ }
+ } else {
+ man-puts $line
+ }
+ }
+ man-puts </DL>
+ } else {
+ # labelled list, make contents
+ if {[string compare $context ".SH"]} {
+ man-puts <P>
+ }
+ man-puts <DL>
+ lappend manual(section-toc) <DL>
+ backup-text 1
+ set accept_RE 0
+ while {[more-text]} {
+ set line [next-text]
+ if {[is-a-directive $line]} {
+ split-directive $line code rest
+ switch -exact $code {
+ .IP {
+ if {$accept_RE} {
+ output-IP-list .IP $code $rest
+ continue
+ }
+ if {[string equal $manual(section) "ARGUMENTS"] || \
+ [regexp {^\[[0-9]+\]$} $rest]} {
+ man-puts "<P><DT>$rest<DD>"
+ } else {
+ man-puts "<P><DT>[long-toc $rest]<DD>"
+ }
+ if {[string equal $manual(name):$manual(section) \
+ "selection:DESCRIPTION"]} {
+ if {[match-text .RE @rest .RS .RS]} {
+ man-puts <DT>[long-toc $rest]<DD>
+ }
+ }
+ }
+ .sp -
+ .br -
+ .DS -
+ .CS {
+ output-directive $line
+ }
+ .RS {
+ if {[match-text .RS]} {
+ output-directive $line
+ incr accept_RE 1
+ } elseif {[match-text .CS]} {
+ output-directive .CS
+ incr accept_RE 1
+ } elseif {[match-text .PP]} {
+ output-directive .PP
+ incr accept_RE 1
+ } elseif {[match-text .DS]} {
+ output-directive .DS
+ incr accept_RE 1
+ } else {
+ output-directive $line
+ }
+ }
+ .PP {
+ if {[match-text @rest1 .br @rest2 .RS]} {
+ # yet another nroff kludge as above
+ man-puts "<P><DT>[long-toc $rest1]"
+ man-puts "<DT>[long-toc $rest2]<DD>"
+ incr accept_RE 1
+ } elseif {[match-text @rest .RE]} {
+ # gad, this is getting ridiculous
+ if { ! $accept_RE} {
+ man-puts "</DL><P>$rest<DL>"
+ backup-text 1
+ break
+ } else {
+ man-puts "<P>$rest"
+ incr accept_RE -1
+ }
+ } elseif {$accept_RE} {
+ output-directive $line
+ } else {
+ backup-text 1
+ break
+ }
+ }
+ .RE {
+ if { ! $accept_RE} {
+ backup-text 1
+ break
+ }
+ incr accept_RE -1
+ }
+ default {
+ backup-text 1
+ break
+ }
+ }
+ } else {
+ man-puts $line
+ }
+ }
+ man-puts <P></DL>
+ lappend manual(section-toc) </DL>
+ if {$accept_RE} {
+ manerror "missing .RE in output-IP-list"
+ }
+ }
+}
+##
+## handle the NAME section lines
+## there's only one line in the NAME section,
+## consisting of a comma separated list of names,
+## followed by a hyphen and a short description.
+##
+proc output-name {line} {
+ global manual
+ # split name line into pieces
+ regexp {^([^-]+) - (.*)$} $line all head tail
+ # output line to manual page untouched
+ man-puts $line
+ # output line to long table of contents
+ lappend manual(section-toc) <DL><DD>$line</DL>
+ # separate out the names for future reference
+ foreach name [split $head ,] {
+ set name [string trim $name]
+ if {[llength $name] > 1} {
+ manerror "name has a space: {$name}\nfrom: $line"
+ }
+ lappend manual(wing-toc) $name
+ lappend manual(name-$name) $manual(wing-file)/$manual(name)
+ }
+}
+##
+## build a cross-reference link if appropriate
+##
+proc cross-reference {ref} {
+ global manual
+ if {[string match Tcl_* $ref]} {
+ set lref $ref
+ } elseif {[string match Tk_* $ref]} {
+ set lref $ref
+ } elseif {[string equal $ref "Tcl"]} {
+ set lref $ref
+ } else {
+ set lref [string tolower $ref]
+ }
+ ##
+ ## nothing to reference
+ ##
+ if { ! [info exists manual(name-$lref)]} {
+ foreach name {array file history info interp string trace
+ after clipboard grab image option pack place selection tk tkwait update winfo wm} {
+ if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
+ [string compare $manual(tail) "$name.n"]} {
+ return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
+ }
+ }
+ if {[lsearch {stdin stdout stderr end} $lref] >= 0} {
+ # no good place to send these
+ # tcl tokens?
+ # also end
+ }
+ return $ref
+ }
+ ##
+ ## would be a self reference
+ ##
+ foreach name $manual(name-$lref) {
+ if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} {
+ return $ref
+ }
+ }
+ ##
+ ## multiple choices for reference
+ ##
+ if {[llength $manual(name-$lref)] > 1} {
+ set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
+ set tcl_ref [lindex $manual(name-$lref) $tcl_i]
+ set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
+ set tk_ref [lindex $manual(name-$lref) $tk_i]
+ if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} || "$manual(wing-file)" == {TclLib}} {
+ return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
+ }
+ if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} || "$manual(wing-file)" == {TkLib}} {
+ return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
+ }
+ if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} {
+ return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
+ }
+ puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
+ return $ref
+ }
+ ##
+ ## exceptions, sigh, to the rule
+ ##
+ switch $manual(tail) {
+ canvas.n {
+ if {$lref == {focus}} {
+ upvar tail tail
+ set clue [string first command $tail]
+ if {$clue < 0 || $clue > 5} {
+ return $ref
+ }
+ }
+ if {[lsearch {bitmap image text} $lref] >= 0} {
+ return $ref
+ }
+ }
+ checkbutton.n -
+ radiobutton.n {
+ if {[lsearch {image} $lref] >= 0} {
+ return $ref
+ }
+ }
+ menu.n {
+ if {[lsearch {checkbutton radiobutton} $lref] >= 0} {
+ return $ref
+ }
+ }
+ options.n {
+ if {[lsearch {bitmap image set} $lref] >= 0} {
+ return $ref
+ }
+ }
+ regexp.n {
+ if {[lsearch {string} $lref] >= 0} {
+ return $ref
+ }
+ }
+ source.n {
+ if {[lsearch {text} $lref] >= 0} {
+ return $ref
+ }
+ }
+ history.n {
+ if {[lsearch {exec} $lref] >= 0} {
+ return $ref
+ }
+ }
+ return.n {
+ if {[lsearch {error continue break} $lref] >= 0} {
+ return $ref
+ }
+ }
+ scrollbar.n {
+ if {[lsearch {set} $lref] >= 0} {
+ return $ref
+ }
+ }
+ }
+ ##
+ ## return the cross reference
+ ##
+ return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"
+}
+##
+## reference generation errors
+##
+proc reference-error {msg text} {
+ global manual
+ puts stderr "$manual(tail): $msg: {$text}"
+ return $text
+}
+##
+## insert as many cross references into this text string as are appropriate
+##
+proc insert-cross-references {text} {
+ global manual
+ ##
+ ## we identify cross references by:
+ ## ``quotation''
+ ## <B>emboldening</B>
+ ## Tcl_ prefix
+ ## Tk_ prefix
+ ## [a-zA-Z0-9]+ manual entry
+ ## and we avoid messing with already anchored text
+ ##
+ ##
+ ## find where each item lives
+ ##
+ array set offset [list \
+ anchor [string first {<A } $text] \
+ end-anchor [string first {</A>} $text] \
+ quote [string first {``} $text] \
+ end-quote [string first {''} $text] \
+ bold [string first {<B>} $text] \
+ end-bold [string first {</B>} $text] \
+ tcl [string first {Tcl_} $text] \
+ tk [string first {Tk_} $text] \
+ Tcl1 [string first {Tcl manual entry} $text] \
+ Tcl2 [string first {Tcl overview manual entry} $text] \
+ ]
+ ##
+ ## accumulate a list
+ ##
+ foreach name [array names offset] {
+ if {$offset($name) >= 0} {
+ set invert($offset($name)) $name
+ lappend offsets $offset($name)
+ }
+ }
+ ##
+ ## if nothing, then we're done.
+ ##
+ if { ! [info exists offsets]} {
+ return $text
+ }
+ ##
+ ## sort the offsets
+ ##
+ set offsets [lsort -integer $offsets]
+ ##
+ ## see which we want to use
+ ##
+ switch -exact $invert([lindex $offsets 0]) {
+ anchor {
+ if {$offset(end-anchor) < 0} { return [reference-error {Missing end anchor} $text]; }
+ set head [string range $text 0 $offset(end-anchor)]
+ set tail [string range $text [expr $offset(end-anchor)+1] end]
+ return $head[insert-cross-references $tail]
+ }
+ quote {
+ if {$offset(end-quote) < 0} { return [reference-error {Missing end quote} $text]; }
+ if {"$invert([lindex $offsets 1])" == {tk}} { set offsets [lreplace $offsets 1 1]; }
+ if {"$invert([lindex $offsets 1])" == {tcl}} { set offsets [lreplace $offsets 1 1]; }
+ switch -exact $invert([lindex $offsets 1]) {
+ end-quote {
+ set head [string range $text 0 [expr $offset(quote)-1]]
+ set body [string range $text [expr $offset(quote)+2] [expr $offset(end-quote)-1]]
+ set tail [string range $text [expr $offset(end-quote)+2] end]
+ return $head``[cross-reference $body]''[insert-cross-references $tail]
+ }
+ bold -
+ anchor {
+ set head [string range $text 0 [expr $offset(end-quote)+1]]
+ set tail [string range $text [expr $offset(end-quote)+2] end]
+ return $head[insert-cross-references $tail]
+ }
+ }
+ return [reference-error {Uncaught quote case} $text]
+ }
+ bold {
+ if {$offset(end-bold) < 0} { return $text; }
+ if {"$invert([lindex $offsets 1])" == {tk}} { set offsets [lreplace $offsets 1 1]; }
+ if {"$invert([lindex $offsets 1])" == {tcl}} { set offsets [lreplace $offsets 1 1]; }
+ switch -exact $invert([lindex $offsets 1]) {
+ end-bold {
+ set head [string range $text 0 [expr $offset(bold)-1]]
+ set body [string range $text [expr $offset(bold)+3] [expr $offset(end-bold)-1]]
+ set tail [string range $text [expr $offset(end-bold)+4] end]
+ return $head<B>[cross-reference $body]</B>[insert-cross-references $tail]
+ }
+ anchor {
+ set head [string range $text 0 [expr $offset(end-bold)+3]]
+ set tail [string range $text [expr $offset(end-bold)+4] end]
+ return $head[insert-cross-references $tail]
+ }
+ }
+ return [reference-error {Uncaught bold case} $text]
+ }
+ tk {
+ set head [string range $text 0 [expr $offset(tk)-1]]
+ set tail [string range $text $offset(tk) end]
+ if { ! [regexp {^(Tk_[a-zA-Z0-9_]+)(.*)$} $tail all body tail]} { return [reference-error {Tk regexp failed} $text]; }
+ return $head[cross-reference $body][insert-cross-references $tail]
+ }
+ tcl {
+ set head [string range $text 0 [expr $offset(tcl)-1]]
+ set tail [string range $text $offset(tcl) end]
+ if { ! [regexp {^(Tcl_[a-zA-Z0-9_]+)(.*)$} $tail all body tail]} { return [reference-error {Tcl regexp failed} $text]; }
+ return $head[cross-reference $body][insert-cross-references $tail]
+ }
+ Tcl1 -
+ Tcl2 {
+ set off [lindex $offsets 0]
+ set head [string range $text 0 [expr $off-1]]
+ set body Tcl
+ set tail [string range $text [expr $off+3] end]
+ return $head[cross-reference $body][insert-cross-references $tail]
+ }
+ end-anchor -
+ end-bold -
+ end-quote {
+ return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
+ }
+ }
+}
+##
+## process formatting directives
+##
+proc output-directive {line} {
+ global manual
+ # process format directive
+ split-directive $line code rest
+ switch -exact $code {
+ .BS -
+ .BE {
+ # man-puts <HR>
+ }
+ .SH {
+ # drain any open lists
+ # announce the subject
+ set manual(section) $rest
+ # start our own stack of stuff
+ set manual($manual(name)-$manual(section)) {}
+ lappend manual(has-$manual(section)) $manual(name)
+ man-puts "<H3>[long-toc $manual(section)]</H3>"
+ # some sections can simply free wheel their way through the text
+ # some sections can be processed in their own loops
+ switch -exact $manual(section) {
+ NAME {
+ if {[lsearch {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3} $manual(tail)] >= 0} {
+ # these manual pages have two NAME sections
+ if {[info exists manual($manual(tail)-NAME)]} {
+ return
+ }
+ set manual($manual(tail)-NAME) 1
+ }
+ set names {}
+ while {1} {
+ set line [next-text]
+ if {[is-a-directive $line]} {
+ backup-text 1
+ output-name [join $names { }]
+ return
+ } else {
+ lappend names [string trim $line]
+ }
+ }
+ }
+ SYNOPSIS {
+ lappend manual(section-toc) <DL>
+ while {1} {
+ if {[next-op-is .nf rest]
+ || [next-op-is .br rest]
+ || [next-op-is .fi rest]} {
+ continue
+ }
+ if {[next-op-is .SH rest]
+ || [next-op-is .BE rest]
+ || [next-op-is .SO rest]} {
+ backup-text 1
+ break
+ }
+ if {[next-op-is .sp rest]} {
+ #man-puts <P>
+ continue
+ }
+ set more [next-text]
+ if {[is-a-directive $more]} {
+ manerror "in SYNOPSIS found $more"
+ backup-text 1
+ break
+ } else {
+ foreach more [split $more \n] {
+ man-puts $more<BR>
+ if {[lsearch {TclLib TkLib} $manual(wing-file)] < 0} {
+ lappend manual(section-toc) <DD>$more
+ }
+ }
+ }
+ }
+ lappend manual(section-toc) </DL>
+ return
+ }
+ {SEE ALSO} {
+ while {[more-text]} {
+ if {[next-op-is .SH rest]} {
+ backup-text 1
+ return
+ }
+ set more [next-text]
+ if {[is-a-directive $more]} {
+ manerror "$more"
+ backup-text 1
+ return
+ }
+ set nmore {}
+ foreach cr [split $more ,] {
+ set cr [string trim $cr]
+ if { ! [regexp {^<B>.*</B>$} $cr]} {
+ set cr <B>$cr</B>
+ }
+ if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
+ set cr <B>$name</B>
+ }
+ lappend nmore $cr
+ }
+ man-puts [join $nmore {, }]
+ }
+ return
+ }
+ KEYWORDS {
+ while {[more-text]} {
+ if {[next-op-is .SH rest]} {
+ backup-text 1
+ return
+ }
+ set more [next-text]
+ if {[is-a-directive $more]} {
+ manerror "$more"
+ backup-text 1
+ return
+ }
+ set keys {}
+ foreach key [split $more ,] {
+ set key [string trim $key]
+ lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]
+ set initial [string toupper [string index $key 0]]
+ lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
+ }
+ man-puts [join $keys {, }]
+ }
+ return
+ }
+ }
+ if {[next-op-is .IP rest]} {
+ output-IP-list .SH .IP $rest
+ return
+ }
+ if {[next-op-is .PP rest]} {
+ return
+ }
+ return
+ }
+ .SO {
+ if {[match-text @stuff .SE]} {
+ output-directive {.SH STANDARD OPTIONS}
+ set opts {}
+ foreach line [split $stuff \n] {
+ foreach option [split $line \t] {
+ lappend opts $option
+ }
+ }
+ man-puts <DL>
+ lappend manual(section-toc) <DL>
+ foreach option [lsort $opts] {
+ man-puts "<DT><B>[std-option-toc $option]</B>"
+ }
+ man-puts </DL>
+ lappend manual(section-toc) </DL>
+ } else {
+ manerror "unexpected .SO format:\n[expand-next-text 2]"
+ }
+ }
+ .OP {
+ output-widget-options $rest
+ return
+ }
+ .IP {
+ output-IP-list .IP .IP $rest
+ return
+ }
+ .PP {
+ man-puts <P>
+ }
+ .RS {
+ output-RS-list
+ return
+ }
+ .RE {
+ manerror "unexpected .RE"
+ return
+ }
+ .br {
+ man-puts <BR>
+ return
+ }
+ .DE {
+ manerror "unexpected .DE"
+ return
+ }
+ .DS {
+ if {[next-op-is .ta rest]} {
+
+ }
+ if {[match-text @stuff .DE]} {
+ man-puts <PRE>$stuff</PRE>
+ } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} {
+ man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"
+ } else {
+ manerror "unexpected .DS format:\n[expand-next-text 2]"
+ }
+ return
+ }
+ .CS {
+ if {[next-op-is .ta rest]} {
+
+ }
+ if {[match-text @stuff .CE]} {
+ man-puts <PRE>$stuff</PRE>
+ } else {
+ manerror "unexpected .CS format:\n[expand-next-text 2]"
+ }
+ return
+ }
+ .CE {
+ manerror "unexpected .CE"
+ return
+ }
+ .sp {
+ man-puts <P>
+ }
+ .ta {
+ # these are tab stop settings for short tables
+ switch -exact $manual(name):$manual(section) {
+ {bind:MODIFIERS} -
+ {bind:EVENT TYPES} -
+ {bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
+ {expr:OPERANDS} -
+ {expr:MATH FUNCTIONS} -
+ {history:DESCRIPTION} -
+ {history:HISTORY REVISION} -
+ {switch:DESCRIPTION} -
+ {upvar:DESCRIPTION} {
+ return; # fix.me
+ }
+ default {
+ manerror "ignoring $line"
+ }
+ }
+ }
+ .nf {
+ if {[match-text @more .fi]} {
+ foreach more [split $more \n] {
+ man-puts $more<BR>
+ }
+ } elseif {[match-text .RS @more .RE .fi]} {
+ man-puts <DL><DD>
+ foreach more [split $more \n] {
+ man-puts $more<BR>
+ }
+ man-puts </DL>
+ } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
+ man-puts <DL><DD>
+ foreach more [split $more \n] {
+ man-puts $more<BR>
+ }
+ man-puts <DL><DD>
+ foreach more2 [split $more2 \n] {
+ man-puts $more2<BR>
+ }
+ man-puts </DL></DL>
+ } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
+ man-puts <DL><DD>
+ foreach more [split $more \n] {
+ man-puts $more<BR>
+ }
+ man-puts <DL><DD>
+ foreach more2 [split $more2 \n] {
+ man-puts $more2<BR>
+ }
+ man-puts </DL><DD>
+ foreach more3 [split $more3 \n] {
+ man-puts $more3<BR>
+ }
+ man-puts </DL>
+ } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
+ man-puts <P><DL><DD>
+ foreach more [split $more \n] {
+ man-puts $more<BR>
+ }
+ man-puts <DL><DD>
+ foreach more2 [split $more2 \n] {
+ man-puts $more2<BR>
+ }
+ man-puts </DL></DL><P>
+ } elseif {[match-text .RS .sp @more .sp .RE .fi]} {
+ man-puts <P><DL><DD>
+ foreach more [split $more \n] {
+ man-puts $more<BR>
+ }
+ man-puts </DL><P>
+ } else {
+ manerror "ignoring $line"
+ }
+ }
+ .fi {
+ manerror "ignoring $line"
+ }
+ .na -
+ .ad -
+ .UL -
+ .ne {
+ manerror "ignoring $line"
+ }
+ default {
+ manerror "unrecognized format directive: $line"
+ }
+ }
+}
+##
+## merge copyright listings
+##
+proc merge-copyrights {l1 l2} {
+ foreach copyright [concat $l1 $l2] {
+ if {[regexp {^Copyright +\(c\) +([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all date by who]} {
+ lappend dates($who) $date
+ continue
+ }
+ if {[regexp {^Copyright +\(c\) +([0-9]+)-([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all from to by who]} {
+ for {set date $from} {$date <= $to} {incr date} {
+ lappend dates($who) $date
+ }
+ continue
+ }
+ if {[regexp {^Copyright +\(c\) +([0-9]+), *([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all date1 date2 by who]} {
+ lappend dates($who) $date1 $date2
+ continue
+ }
+ puts "oops: $copyright"
+ }
+ foreach who [array names dates] {
+ set list [lsort $dates($who)]
+ if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} {
+ lappend merge "Copyright (c) [lindex $list 0] $who"
+ } else {
+ lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who"
+ }
+ }
+ return [lsort $merge]
+}
+
+proc makedirhier {dir} {
+ if { ! [file isdirectory $dir]} {
+ makedirhier [file dirname $dir]
+ if { ! [file isdirectory $dir]} {
+ if {[catch {exec mkdir $dir} error]} {
+ error "cannot create directory $dir: $error"
+ }
+ }
+ }
+}
+
+##
+## foreach of the man directories specified by args
+## convert manpages into hypertext in the directory
+## specified by html.
+##
+proc make-man-pages {html args} {
+ global env manual overall_title
+ makedirhier $html
+ if { ! [file isdirectory $html]} {
+ exec mkdir $html
+ }
+ set manual(short-toc-n) 1
+ set manual(short-toc-fp) [open $html/contents.htm w]
+ puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>"
+ puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>"
+ set manual(merge-copyrights) {}
+ foreach arg $args {
+ set manual(wing-glob) [lindex $arg 0]
+ set manual(wing-name) [lindex $arg 1]
+ set manual(wing-file) [lindex $arg 2]
+ set manual(wing-description) [lindex $arg 3]
+ set manual(wing-copyrights) {}
+ makedirhier $html/$manual(wing-file)
+ set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w]
+ # whistle
+ puts stderr "scanning section $manual(wing-name)"
+ # put the entry for this section into the short table of contents
+ puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)"
+ # initialize the wing table of contents
+ puts $manual(wing-toc-fp) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>"
+ puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>"
+ # initialize the short table of contents for this section
+ set manual(wing-toc) {}
+ # initialize the man directory for this section
+ makedirhier $html/$manual(wing-file)
+ # initialize the long table of contents for this section
+ set manual(long-toc-n) 1
+ # get the manual pages for this section
+ set manual(pages) [lsort [glob $manual(wing-glob)]]
+ if {[lsearch -glob $manual(pages) */options.n] >= 0} {
+ set n [lsearch $manual(pages) */options.n]
+ set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
+ }
+ # set manual(pages) [lrange $manual(pages) 0 5]
+ foreach manual(page) $manual(pages) {
+ # whistle
+ puts stderr "scanning page $manual(page)"
+ set manual(tail) [file tail $manual(page)]
+ set manual(name) [file root $manual(tail)]
+ set manual(section) {}
+ if {[lsearch {case pack-old menubar} $manual(name)] >= 0} {
+ # obsolete
+ manerror "discarding $manual(name)"
+ continue
+ }
+ set manual(infp) [open "$manual(page)"]
+ set manual(text) {}
+ set manual(partial-text) {}
+ foreach p {.RS .DS .CS .SO} {
+ set manual($p) 0
+ }
+ set manual(stack) {}
+ set manual(section) {}
+ set manual(section-toc) {}
+ set manual(section-toc-n) 1
+ set manual(copyrights) {}
+ lappend manual(all-pages) $manual(wing-file)/$manual(tail)
+ manreport 100 "$manual(name)"
+ while {[gets $manual(infp) line] >= 0} {
+ manreport 100 $line
+ if {[regexp {^[`'][/\\]} $line]} {
+ if {[regexp {Copyright \(c\).*$} $line copyright]} {
+ lappend manual(copyrights) $copyright
+ }
+ # comment
+ continue
+ }
+ if {"$line" == {'}} {
+ # comment
+ continue
+ }
+ if {[parse-directive $line code rest]} {
+ switch -exact $code {
+ .ad -
+ .na -
+ .so -
+ .ne -
+ .AS -
+ .VE -
+ .VS -
+ . {
+ # ignore
+ continue
+ }
+ }
+ if {"$manual(partial-text)" != {}} {
+ lappend manual(text) [process-text $manual(partial-text)]
+ set manual(partial-text) {}
+ }
+ switch -exact $code {
+ .SH {
+ if {[llength $rest] == 0} {
+ gets $manual(infp) rest
+ }
+ lappend manual(text) ".SH [unquote $rest]"
+ }
+ .TH {
+ lappend manual(text) "$code [unquote $rest]"
+ }
+ .HS -
+ .UL -
+ .ta {
+ lappend manual(text) "$code [unquote $rest]"
+ }
+ .BS -
+ .BE -
+ .br -
+ .fi -
+ .sp -
+ .nf {
+ if {"$rest" != {}} {
+ manerror "unexpected argument: $line"
+ }
+ lappend manual(text) $code
+ }
+ .AP {
+ lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
+ }
+ .IP {
+ regexp {^(.*) +[0-9]+$} $rest all rest
+ lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
+ }
+ .TP {
+ set next [gets $manual(infp)]
+ if {"$next" != {'}} {
+ lappend manual(text) ".IP [process-text $next]"
+ }
+ }
+ .OP {
+ lappend manual(text) [concat .OP [process-text \
+ "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
+ }
+ .PP -
+ .LP {
+ lappend manual(text) {.PP}
+ }
+ .RS {
+ incr manual(.RS)
+ lappend manual(text) $code
+ }
+ .RE {
+ incr manual(.RS) -1
+ lappend manual(text) $code
+ }
+ .SO {
+ incr manual(.SO)
+ lappend manual(text) $code
+ }
+ .SE {
+ incr manual(.SO) -1
+ lappend manual(text) $code
+ }
+ .DS {
+ incr manual(.DS)
+ lappend manual(text) $code
+ }
+ .DE {
+ incr manual(.DS) -1
+ lappend manual(text) $code
+ }
+ .CS {
+ incr manual(.CS)
+ lappend manual(text) $code
+ }
+ .CE {
+ incr manual(.CS) -1
+ lappend manual(text) $code
+ }
+ .de {
+ while {[gets $manual(infp) line] >= 0} {
+ if {[regexp {^\.\.} $line]} {
+ break
+ }
+ }
+ }
+ .. {
+ error "found .. outside of .de"
+ }
+ default {
+ manerror "unrecognized format directive: $line"
+ }
+ }
+ } else {
+ if {"$manual(partial-text)" == {}} {
+ set manual(partial-text) $line
+ } else {
+ append manual(partial-text) \n$line
+ }
+ }
+ }
+ if {"$manual(partial-text)" != {}} {
+ lappend manual(text) [process-text $manual(partial-text)]
+ }
+ close $manual(infp)
+ # fixups
+ if {$manual(.RS) != 0} {
+ if {"$manual(name)" != {selection}} {
+ puts "unbalanced .RS .RE"
+ }
+ }
+ if {$manual(.DS) != 0} {
+ puts "unbalanced .DS .DE"
+ }
+ if {$manual(.CS) != 0} {
+ puts "unbalanced .CS .CE"
+ }
+ if {$manual(.SO) != 0} {
+ puts "unbalanced .SO .SE"
+ }
+ # output conversion
+ open-text
+ if {[next-op-is .HS rest]} {
+ set manual($manual(name)-title) "[lrange $rest 1 end] [lindex $rest 0] manual page"
+ while {[more-text]} {
+ set line [next-text]
+ if {[is-a-directive $line]} {
+ output-directive $line
+ } else {
+ man-puts $line
+ }
+ }
+ man-puts <HR><PRE>
+ foreach copyright $manual(copyrights) {
+ man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
+ }
+ man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr.</PRE>"
+ set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
+ } elseif {[next-op-is .TH rest]} {
+ set manual($manual(name)-title) "[lrange $rest 4 end] - [lindex $rest 0] manual page"
+ while {[more-text]} {
+ set line [next-text]
+ if {[is-a-directive $line]} {
+ output-directive $line
+ } else {
+ man-puts $line
+ }
+ }
+ man-puts <HR><PRE>
+ foreach copyright $manual(copyrights) {
+ man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
+ }
+ man-puts "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr.</PRE>"
+ set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
+ } else {
+ manerror "no .HS or .TH record found"
+ }
+ #
+ # make the long table of contents for this page
+ #
+ set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>]
+ }
+
+ #
+ # make the wing table of contents for the section
+ #
+ set width 0
+ foreach name $manual(wing-toc) {
+ if {[string length $name] > $width} {
+ set width [string length $name]
+ }
+ }
+ set perline [expr 120 / $width]
+ set nrows [expr ([llength $manual(wing-toc)]+$perline)/$perline]
+ set n 0
+ catch {unset rows}
+ foreach name [lsort $manual(wing-toc)] {
+ set tail $manual(name-$name)
+ if {[llength $tail] > 1} {
+ manerror "$name is defined in more than one file: $tail"
+ set tail [lindex $tail [expr [llength $tail]-1]]
+ }
+ set tail [file tail $tail]
+ append rows([expr $n%$nrows]) "<td> <a href=\"$tail.htm\">$name</a>"
+ incr n
+ }
+ puts $manual(wing-toc-fp) <table>
+ foreach row [lsort -integer [array names rows]] {
+ puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
+ }
+ puts $manual(wing-toc-fp) </table>
+
+ #
+ # insert wing copyrights
+ #
+ puts $manual(wing-toc-fp) "<HR><PRE>"
+ foreach copyright $manual(wing-copyrights) {
+ puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
+ }
+ puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
+ puts $manual(wing-toc-fp) "</PRE></BODY></HTML>"
+ close $manual(wing-toc-fp)
+ set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
+ }
+
+ ##
+ ## build the keyword index.
+ ##
+ proc strcasecmp {a b} { return [string compare -nocase $a $b] }
+ set keys [lsort -command strcasecmp [array names manual keyword-*]]
+ makedirhier $html/Keywords
+ catch {eval exec rm -f [glob $html/Keywords/*]}
+ puts $manual(short-toc-fp) {<DT><A HREF="Keywords/contents.htm">Keywords</A><DD>The keywords from the Tcl/Tk man pages.}
+ set keyfp [open $html/Keywords/contents.htm w]
+ puts $keyfp "<HTML><HEAD><TITLE>Tcl/Tk Keywords</TITLE></HEAD>"
+ puts $keyfp "<BODY><HR><H3>Tcl/Tk Keywords</H3><HR><H2>"
+ foreach a {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
+ puts $keyfp "<A HREF=\"$a.htm\">$a</A>"
+ set afp [open $html/Keywords/$a.htm w]
+ puts $afp "<HTML><HEAD><TITLE>Tcl/Tk Keywords - $a</TITLE></HEAD>"
+ puts $afp "<BODY><HR><H3>Tcl/Tk Keywords - $a</H3><HR><H2>"
+ foreach b {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
+ puts $afp "<A HREF=\"$b.htm\">$b</A>"
+ }
+ puts $afp "</H2><HR><DL>"
+ foreach k $keys {
+ if {[regexp -nocase -- "^keyword-$a" $k]} {
+ set k [string range $k 8 end]
+ puts $afp "<DT><A NAME=\"$k\">$k</A><DD>"
+ set refs {}
+ foreach man $manual(keyword-$k) {
+ set name [lindex $man 0]
+ set file [lindex $man 1]
+ lappend refs "<A HREF=\"../$file\">$name</A>"
+ }
+ puts $afp [join $refs {, }]
+ }
+ }
+ puts $afp "</DL><HR><PRE>"
+ # insert merged copyrights
+ foreach copyright $manual(merge-copyrights) {
+ puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
+ }
+ puts $afp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
+ puts $afp "</PRE></BODY></HTML>"
+ close $afp
+ }
+ puts $keyfp "</H2><HR><PRE>"
+
+ # insert merged copyrights
+ foreach copyright $manual(merge-copyrights) {
+ puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
+ }
+ puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
+ puts $keyfp </PRE><HR></BODY></HTML>
+ close $keyfp
+
+ ##
+ ## finish off short table of contents
+ ##
+ puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.}
+ puts $manual(short-toc-fp) "</DL><HR><PRE>"
+ # insert merged copyrights
+ foreach copyright $manual(merge-copyrights) {
+ puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> &#169; [lrange $copyright 2 end]"
+ }
+ puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> &#169; 1995-1997 Roger E. Critchlow Jr."
+ puts $manual(short-toc-fp) "</PRE></BODY></HTML>"
+ close $manual(short-toc-fp)
+
+ ##
+ ## output man pages
+ ##
+ unset manual(section)
+ foreach path $manual(all-pages) {
+ set manual(wing-file) [file dirname $path]
+ set manual(tail) [file tail $path]
+ set manual(name) [file root $manual(tail)]
+ set text $manual(output-$manual(wing-file)-$manual(name))
+ set ntext 0
+ foreach item $text {
+ incr ntext [llength [split $item \n]]
+ incr ntext
+ }
+ set toc $manual(toc-$manual(wing-file)-$manual(name))
+ set ntoc 0
+ foreach item $toc {
+ incr ntoc [llength [split $item \n]]
+ incr ntoc
+ }
+ puts stderr "rescanning page $manual(name) $ntoc/$ntext"
+ set manual(outfp) [open $html/$manual(wing-file)/$manual(name).htm w]
+ puts $manual(outfp) "<HTML><HEAD><TITLE>$manual($manual(name)-title)</TITLE></HEAD><BODY>"
+ if {($ntext > 60) && ($ntoc > 32) || [lsearch {
+ Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
+ CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
+ GetJustify GetPixels GetVisual ParseArgv QueueEvent
+ } $manual(tail)] >= 0} {
+ foreach item $toc {
+ puts $manual(outfp) $item
+ }
+ }
+ foreach item $text {
+ puts $manual(outfp) [insert-cross-references $item]
+ }
+ puts $manual(outfp) </BODY></HTML>
+ close $manual(outfp)
+ }
+ return {}
+}
+
+set usercmddesc {The interpreters which implement Tcl and Tk.}
+set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.}
+set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.}
+set tcllibdesc {The C functions which a Tcl extended C program may use.}
+set tklibdesc {The additional C functions which a Tk extended C program may use.}
+
+parse_command_line
+
+if {1} {
+ if {[catch {
+ make-man-pages $webdir \
+ "$tcltkdir/{$tkdir,$tcldir}/doc/*.1 {Tcl/Tk Applications} UserCmd {$usercmddesc}" \
+ "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" \
+ "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" \
+ "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" \
+ "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}"
+ } error]} {
+ puts $error\n$errorInfo
+ }
+}
+
diff --git a/tcl/tools/uniClass.tcl b/tcl/tools/uniClass.tcl
new file mode 100644
index 00000000000..2820ba44193
--- /dev/null
+++ b/tcl/tools/uniClass.tcl
@@ -0,0 +1,61 @@
+proc emitRange {first last} {
+ global ranges numranges chars numchars
+
+ if {$first < ($last-1)} {
+ append ranges [format "{0x%04x, 0x%04x}, " \
+ $first $last]
+ if {[incr numranges] % 4 == 0} {
+ append ranges "\n "
+ }
+ } else {
+ append chars [format "0x%04x, " $first]
+ incr numchars
+ if {$numchars % 9 == 0} {
+ append chars "\n "
+ }
+ if {$first != $last} {
+ append chars [format "0x%04x, " $last]
+ incr numchars
+ if {$numchars % 9 == 0} {
+ append chars "\n "
+ }
+ }
+ }
+}
+
+proc genTable {type} {
+ global first last ranges numranges chars numchars
+ set first -2
+ set last -2
+
+ set ranges " "
+ set numranges 0
+ set chars " "
+ set numchars 0
+
+ for {set i 0} {$i < 0x10000} {incr i} {
+ if {[string is $type [format %c $i]]} {
+ if {$i == ($last + 1)} {
+ set last $i
+ } else {
+ if {$first > 0} {
+ emitRange $first $last
+ }
+ set first $i
+ set last $i
+ }
+ }
+ }
+ emitRange $first $last
+
+ puts "static crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
+ puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n"
+ puts "static chr ${type}CharTable\[\] = {\n$chars\n};\n"
+ puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n"
+}
+
+
+foreach type {alpha digit punct space lower upper graph } {
+ genTable $type
+}
+
diff --git a/tcl/tools/uniParse.tcl b/tcl/tools/uniParse.tcl
new file mode 100644
index 00000000000..4692fd5e29c
--- /dev/null
+++ b/tcl/tools/uniParse.tcl
@@ -0,0 +1,386 @@
+# uniParse.tcl --
+#
+# This program parses the UnicodeData file and generates the
+# corresponding tclUniData.c file with compressed character
+# data tables. The input to this program should be the latest
+# UnicodeData file from:
+# ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData-Latest.txt
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+
+namespace eval uni {
+ set shift 5; # number of bits of data within a page
+ # This value can be adjusted to find the
+ # best split to minimize table size
+
+ variable pMap; # map from page to page index, each entry is
+ # an index into the pages table, indexed by
+ # page number
+ variable pages; # map from page index to page info, each
+ # entry is a list of indices into the groups
+ # table, the list is indexed by the offset
+ variable groups; # list of character info values, indexed by
+ # group number, initialized with the
+ # unassigned character group
+
+ variable categories {
+ Cn Lu Ll Lt Lm Lo Mn Me Mc Nd Nl No Zs Zl Zp
+ Cc Cf Co Cs Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So
+ }; # Ordered list of character categories, must
+ # match the enumeration in the header file.
+
+ variable titleCount 0; # Count of the number of title case
+ # characters. This value is used in the
+ # regular expression code to allocate enough
+ # space for the title case variants.
+}
+
+proc uni::getValue {items index} {
+ variable categories
+ variable titleCount
+
+ # Extract character info
+
+ set category [lindex $items 2]
+ if {[scan [lindex $items 12] %4x toupper] == 1} {
+ set toupper [expr {$index - $toupper}]
+ } else {
+ set toupper {}
+ }
+ if {[scan [lindex $items 13] %4x tolower] == 1} {
+ set tolower [expr {$tolower - $index}]
+ } else {
+ set tolower {}
+ }
+ if {[scan [lindex $items 14] %4x totitle] == 1} {
+ set totitle [expr {$index - $totitle}]
+ } else {
+ set totitle {}
+ }
+
+ set categoryIndex [lsearch -exact $categories $category]
+ if {$categoryIndex < 0} {
+ puts "Unexpected character category: $index($category)"
+ set categoryIndex 0
+ } elseif {$category == "Lt"} {
+ incr titleCount
+ }
+
+ return "$categoryIndex,$toupper,$tolower,$totitle"
+}
+
+proc uni::getGroup {value} {
+ variable groups
+
+ set gIndex [lsearch -exact $groups $value]
+ if {$gIndex == -1} {
+ set gIndex [llength $groups]
+ lappend groups $value
+ }
+ return $gIndex
+}
+
+proc uni::addPage {info} {
+ variable pMap
+ variable pages
+
+ set pIndex [lsearch -exact $pages $info]
+ if {$pIndex == -1} {
+ set pIndex [llength $pages]
+ lappend pages $info
+ }
+ lappend pMap $pIndex
+ return
+}
+
+proc uni::buildTables {data} {
+ variable shift
+
+ variable pMap {}
+ variable pages {}
+ variable groups {{0,,,}}
+ set info {} ;# temporary page info
+
+ set mask [expr {(1 << $shift) - 1}]
+
+ set next 0
+
+ foreach line [split $data \n] {
+ if {$line == ""} {
+ set line "FFFF;;Cn;0;ON;;;;;N;;;;;\n"
+ }
+
+ set items [split $line \;]
+
+ scan [lindex $items 0] %4x index
+ set index [format 0x%0.4x $index]
+
+ set gIndex [getGroup [getValue $items $index]]
+
+ # Since the input table omits unassigned characters, these will
+ # show up as gaps in the index sequence. There are a few special cases
+ # where the gaps correspond to a uniform block of assigned characters.
+ # These are indicated as such in the character name.
+
+ # Enter all unassigned characters up to the current character.
+ if {($index > $next) \
+ && ![regexp "Last>$" [lindex $items 1]]} {
+ for {} {$next < $index} {incr next} {
+ lappend info 0
+ if {($next & $mask) == $mask} {
+ addPage $info
+ set info {}
+ }
+ }
+ }
+
+ # Enter all assigned characters up to the current character
+ for {set i $next} {$i <= $index} {incr i} {
+ # Split character index into offset and page number
+ set offset [expr {$i & $mask}]
+ set page [expr {($i >> $shift)}]
+
+ # Add the group index to the info for the current page
+ lappend info $gIndex
+
+ # If this is the last entry in the page, add the page
+ if {$offset == $mask} {
+ addPage $info
+ set info {}
+ }
+ }
+ set next [expr {$index + 1}]
+ }
+ return
+}
+
+proc uni::main {} {
+ global argc argv0 argv
+ variable pMap
+ variable pages
+ variable groups
+ variable shift
+ variable titleCount
+
+ if {$argc != 2} {
+ puts stderr "\nusage: $argv0 <datafile> <outdir>\n"
+ exit 1
+ }
+ set f [open [lindex $argv 0] r]
+ set data [read $f]
+ close $f
+
+ buildTables $data
+ puts "X = [llength $pMap] Y= [llength $pages] A= [llength $groups]"
+ set size [expr {[llength $pMap] + [llength $pages]*(1<<$shift)}]
+ puts "shift = 6, space = $size"
+ puts "title case count = $titleCount"
+
+ set f [open [file join [lindex $argv 1] tclUniData.c] w]
+ fconfigure $f -translation lf
+ puts $f "/*
+ * tclUtfData.c --
+ *
+ * Declarations of Unicode character information tables. This file is
+ * automatically generated by the tools/uniParse.tcl script. Do not
+ * modify this file by hand.
+ *
+ * Copyright (c) 1998 by Scriptics Corporation.
+ * All rights reserved.
+ *
+ * RCS: @(#) \$Id\$
+ */
+
+/*
+ * A 16-bit Unicode character is split into two parts in order to index
+ * into the following tables. The lower OFFSET_BITS comprise an offset
+ * into a page of characters. The upper bits comprise the page number.
+ */
+
+#define OFFSET_BITS $shift
+
+/*
+ * The pageMap is indexed by page number and returns an alternate page number
+ * that identifies a unique page of characters. Many Unicode characters map
+ * to the same alternate page number.
+ */
+
+static unsigned char pageMap\[\] = {"
+ set line " "
+ set last [expr {[llength $pMap] - 1}]
+ for {set i 0} {$i <= $last} {incr i} {
+ append line [lindex $pMap $i]
+ if {$i != $last} {
+ append line ", "
+ }
+ if {[string length $line] > 70} {
+ puts $f $line
+ set line " "
+ }
+ }
+ puts $f $line
+ puts $f "};
+
+/*
+ * The groupMap is indexed by combining the alternate page number with
+ * the page offset and returns a group number that identifies a unique
+ * set of character attributes.
+ */
+
+static unsigned char groupMap\[\] = {"
+ set line " "
+ set lasti [expr {[llength $pages] - 1}]
+ for {set i 0} {$i <= $lasti} {incr i} {
+ set page [lindex $pages $i]
+ set lastj [expr {[llength $page] - 1}]
+ for {set j 0} {$j <= $lastj} {incr j} {
+ append line [lindex $page $j]
+ if {$j != $lastj || $i != $lasti} {
+ append line ", "
+ }
+ if {[string length $line] > 70} {
+ puts $f $line
+ set line " "
+ }
+ }
+ }
+ puts $f $line
+ puts $f "};
+
+/*
+ * Each group represents a unique set of character attributes. The attributes
+ * are encoded into a 32-bit value as follows:
+ *
+ * Bits 0-4 Character category: see the constants listed below.
+ *
+ * Bits 5-7 Case delta type: 000 = identity
+ * 010 = add delta for lower
+ * 011 = add delta for lower, add 1 for title
+ * 100 = sutract delta for title/upper
+ * 101 = sub delta for upper, sub 1 for title
+ * 110 = sub delta for upper, add delta for lower
+ *
+ * Bits 8-21 Reserved for future use.
+ *
+ * Bits 22-31 Case delta: delta for case conversions. This should be the
+ * highest field so we can easily sign extend.
+ */
+
+static int groups\[\] = {"
+ set line " "
+ set last [expr {[llength $groups] - 1}]
+ for {set i 0} {$i <= $last} {incr i} {
+ foreach {type toupper tolower totitle} [split [lindex $groups $i] ,] {}
+
+ # Compute the case conversion type and delta
+
+ if {$totitle != ""} {
+ if {$totitle == $toupper} {
+ # subtract delta for title or upper
+ set case 4
+ set delta $toupper
+ } elseif {$toupper != ""} {
+ # subtract delta for upper, subtract 1 for title
+ set case 5
+ set delta $toupper
+ } else {
+ # add delta for lower, add 1 for title
+ set case 3
+ set delta $tolower
+ }
+ } elseif {$toupper != ""} {
+ # subtract delta for upper, add delta for lower
+ set case 6
+ set delta $toupper
+ } elseif {$tolower != ""} {
+ # add delta for lower
+ set case 2
+ set delta $tolower
+ } else {
+ # noop
+ set case 0
+ set delta 0
+ }
+
+ set val [expr {($delta << 22) | ($case << 5) | $type}]
+
+ append line [format "%d" $val]
+ if {$i != $last} {
+ append line ", "
+ }
+ if {[string length $line] > 65} {
+ puts $f $line
+ set line " "
+ }
+ }
+ puts $f $line
+ puts $f "};
+
+/*
+ * The following constants are used to determine the category of a
+ * Unicode character.
+ */
+
+#define UNICODE_CATEGORY_MASK 0X1F
+
+enum {
+ UNASSIGNED,
+ UPPERCASE_LETTER,
+ LOWERCASE_LETTER,
+ TITLECASE_LETTER,
+ MODIFIER_LETTER,
+ OTHER_LETTER,
+ NON_SPACING_MARK,
+ ENCLOSING_MARK,
+ COMBINING_SPACING_MARK,
+ DECIMAL_DIGIT_NUMBER,
+ LETTER_NUMBER,
+ OTHER_NUMBER,
+ SPACE_SEPARATOR,
+ LINE_SEPARATOR,
+ PARAGRAPH_SEPARATOR,
+ CONTROL,
+ FORMAT,
+ PRIVATE_USE,
+ SURROGATE,
+ CONNECTOR_PUNCTUATION,
+ DASH_PUNCTUATION,
+ OPEN_PUNCTUATION,
+ CLOSE_PUNCTUATION,
+ INITIAL_QUOTE_PUNCTUATION,
+ FINAL_QUOTE_PUNCTUATION,
+ OTHER_PUNCTUATION,
+ MATH_SYMBOL,
+ CURRENCY_SYMBOL,
+ MODIFIER_SYMBOL,
+ OTHER_SYMBOL
+};
+
+/*
+ * The following macros extract the fields of the character info. The
+ * GetDelta() macro is complicated because we can't rely on the C compiler
+ * to do sign extension on right shifts.
+ */
+
+#define GetCaseType(info) (((info) & 0xE0) >> 5)
+#define GetCategory(info) ((info) & 0x1F)
+#define GetDelta(infO) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
+
+/*
+ * This macro extracts the information about a character from the
+ * Unicode character tables.
+ */
+
+#define GetUniCharInfo(ch) (groups\[groupMap\[(pageMap\[(((int)(ch)) & 0xffff) >> OFFSET_BITS\] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
+"
+
+ close $f
+}
+
+uni::main
+
+return
diff --git a/tcl/tools/white.bmp b/tcl/tools/white.bmp
new file mode 100644
index 00000000000..210bc525c13
--- /dev/null
+++ b/tcl/tools/white.bmp
Binary files differ
diff --git a/tcl/unix/ChangeLog b/tcl/unix/ChangeLog
index 99b6db47f45..6a24f6d2d62 100644
--- a/tcl/unix/ChangeLog
+++ b/tcl/unix/ChangeLog
@@ -1,17 +1,13 @@
-Wed Oct 20 20:15:36 1999 Jeffrey A Law (law@cygnus.com)
-
- * configure.in: Handle hpux11.
- * configure: Rebuilt.
-
Fri Mar 19 09:29:42 1999 Michael Tiemann <tiemann@holodeck.cygnus.com>
* configure.in, configure (IRIX64-6.*): Use -n32 instead of -32
for SHLIB_LD.
-1999-01-30 Brendan Kehoe <brendan@cygnus.com>
+1998-10-28 Ben Elliston <bje@cygnus.com>
- * Makefile.in ($(UNIX_DIR)/configure): Comment out dependency and
- running autoconf to regenerate it.
+ * tclConfig.sh.in (TCL_BUILD_INCLUDES): Remove.
+ * configure.in (TCL_BUILD_INCLUDES): Remove. Do not subst.
+ * configure: Regenerate.
Fri Apr 10 16:52:30 1998 Ian Lance Taylor <ian@cygnus.com>
diff --git a/tcl/unix/Makefile.in b/tcl/unix/Makefile.in
index 8fbb88cbc96..a7dbf51e6bf 100644
--- a/tcl/unix/Makefile.in
+++ b/tcl/unix/Makefile.in
@@ -5,11 +5,9 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# SCCS: @(#) Makefile.in 1.190 97/11/05 10:57:38
+# RCS: @(#) $Id$
-# Current Tcl version; used in various names.
-
-VERSION = @TCL_VERSION@
+VERSION = @TCL_VERSION@
#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
@@ -22,34 +20,36 @@ VERSION = @TCL_VERSION@
# specific files (exec_prefix) and machine-independent files such
# as scripts (prefix). The values specified here may be overridden
# at configure-time with the --exec-prefix and --prefix options
-# to the "configure" script.
+# to the "configure" script. The *dir vars are standard configure
+# substitutions that are based off prefix and exec_prefix.
-prefix = @prefix@
-exec_prefix = @exec_prefix@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+includedir = @includedir@
+mandir = @mandir@
# The following definition can be set to non-null for special systems
# like AFS with replication. It allows the pathnames used for installation
# to be different than those used for actually reference files at
# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
# when installing files.
-INSTALL_ROOT =
+INSTALL_ROOT =
-# Directory from which applications will reference the library of Tcl
-# scripts (note: you can set the TCL_LIBRARY environment variable at
-# run-time to override this value):
TCL_LIBRARY = @datadir@/tcl$(VERSION)
-# Package search path.
-TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@
+# Path to use at runtime to refer to LIB_INSTALL_DIR:
+LIB_RUNTIME_DIR = $(libdir)
-# Path name to use when installing library scripts:
-SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
+# Directory in which to install the program tclsh:
+BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir)
# Directory in which to install libtcl.so or libtcl.a:
LIB_INSTALL_DIR = $(INSTALL_ROOT)@libdir@
-# Path to use at runtime to refer to LIB_INSTALL_DIR:
-LIB_RUNTIME_DIR = @libdir@
+# Path name to use when installing library scripts.
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
# Directory in which to install the program tclsh:
BIN_INSTALL_DIR = $(INSTALL_ROOT)@bindir@
@@ -61,35 +61,53 @@ INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@includedir@
MAN_INSTALL_DIR = $(INSTALL_ROOT)@mandir@
# Directory in which to install manual entry for tclsh:
-MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
# Directory in which to install manual entries for Tcl's C library
# procedures:
-MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
# Directory in which to install manual entries for the built-in
# Tcl commands:
-MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+
+# Package search path.
+TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@
+
+# Libraries built with optimization switches have this additional extension
+TCL_DBGX = @TCL_DBGX@
-# To change the compiler switches, for example to change from -O
-# to -g, change the following line:
-#CFLAGS = -O
+# warning flags
+CFLAGS_WARNING = @CFLAGS_WARNING@
-# CYGNUS LOCAL: Set CFLAGS from configure script.
-CFLAGS = @CFLAGS@
+# The default switches for optimization or debugging
+CFLAGS_DEBUG = @CFLAGS_DEBUG@
+CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
+
+# To change the compiler switches, for example to change from optimization to
+# debugging symbols, change the following line:
+#CFLAGS = $(CFLAGS_DEBUG)
+#CFLAGS = $(CFLAGS_OPTIMIZE)
+#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
+
+# Flags to pass to the linker
+LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
+LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
+LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
# To disable ANSI-C procedure prototypes reverse the comment characters
# on the following lines:
-PROTO_FLAGS =
-#PROTO_FLAGS = -DNO_PROTOTYPE
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
# Mathematical functions like sin and atan2 are enabled for expressions
# by default. To disable them, reverse the comment characters on the
# following pairs of lines:
-MATH_FLAGS =
-#MATH_FLAGS = -DTCL_NO_MATH
-MATH_LIBS = @MATH_LIBS@
-#MATH_LIBS =
+MATH_FLAGS =
+#MATH_FLAGS = -DTCL_NO_MATH
+MATH_LIBS = @MATH_LIBS@
+#MATH_LIBS =
# If you use the setenv, putenv, or unsetenv procedures to modify
# environment variables in your application and you'd like those
@@ -109,7 +127,7 @@ GENERIC_FLAGS =
#GENERIC_FLAGS = -DTCL_GENERIC_ONLY
UNIX_OBJS = tclMtherr.o tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
- tclUnixTime.o tclUnixInit.o
+ tclUnixTime.o tclUnixInit.o tclUnixThrd.o
#UNIX_OBJS =
NOTIFY_OBJS = tclUnixNotfy.o
#NOTIFY_OBJS =
@@ -118,14 +136,28 @@ NOTIFY_OBJS = tclUnixNotfy.o
# lines. Warning: if you enable memory debugging, you must do it
# *everywhere*, including all the code that calls Tcl, and you must use
# ckalloc and ckfree everywhere instead of malloc and free.
-MEM_DEBUG_FLAGS =
-#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# To enable support for stubs in Tcl.
+STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
+
+TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
+#TCL_STUB_LIB_FILE = libtclstub.a
+
+TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@
+#TCL_STUB_LIB_FLAG = -ltclstub
# To enable compilation debugging reverse the comment characters on
# one of the following lines.
-COMPILE_DEBUG_FLAGS =
-#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_STATS
-#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+COMPILE_DEBUG_FLAGS =
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_STATS
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+
+# To compile without backward compatibility and deprecated code
+# uncomment the following
+NO_DEPRECATED_FLAGS =
+#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
# Some versions of make, like SGI's, use the following variable to
# determine which shell to use for executing commands:
@@ -147,13 +179,30 @@ INSTALL_DATA = @INSTALL_DATA@
TCL_SHLIB_CFLAGS = @TCL_SHLIB_CFLAGS@
#TCL_SHLIB_CFLAGS =
+# The following symbol defines additional compiler flags to enable
+# writable strings, since Tcl_Eval2 writes into its arguments. Only
+# applicable for GCC
+
+INSTALL = @srcdir@/install-sh -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+
+# The following specifies which Tcl executable to use for make targets
+# below. This can generally be 'tclsh', meaning all targets will work
+# once we have created the initial executable, but in some cases you
+# may want to use a target without having made tclsh on these sources
+# (like for make genstubs)
+TCL_EXE = tclsh
+
# The symbols below provide support for dynamic loading and shared
# libraries. See configure.in for a description of what the
# symbols mean. The values of the symbols are normally set by the
# configure script. You shouldn't normally need to modify any of
# these definitions by hand.
+STLIB_LD = @STLIB_LD@
SHLIB_LD = @SHLIB_LD@
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
#SHLIB_SUFFIX =
@@ -163,21 +212,24 @@ TCL_UNSHARED_LIB_SUFFIX = @TCL_UNSHARED_LIB_SUFFIX@
TCL_SHARED_LIB_FILE = @TCL_SHARED_LIB_FILE@
TCL_UNSHARED_LIB_FILE = @TCL_UNSHARED_LIB_FILE@
-DLTEST_TARGETS = dltest/pkg5${SHLIB_SUFFIX} dltest/Makefile
+DLTEST_TARGETS = dltest/pkg5${SHLIB_SUFFIX} dltest/Makefile
# The following symbol is defined to "$(DLTEST_TARGETS)" if dynamic
# loading is available; this causes everything in the "dltest"
# subdirectory to be built when making "tcltest. If dynamic loading
# isn't available, configure defines this symbol to an empty string,
# in which case the shared libraries aren't built.
-BUILD_DLTEST = @BUILD_DLTEST@
-#BUILD_DLTEST =
+BUILD_DLTEST = @BUILD_DLTEST@
+#BUILD_DLTEST =
-TCL_LIB_FILE = @TCL_LIB_FILE@
-#TCL_LIB_FILE = libtcl.a
+TCL_LIB_FILE = @TCL_LIB_FILE@
+#TCL_LIB_FILE = libtcl.a
-TCL_LIB_FLAG = @TCL_LIB_FLAG@
-#TCL_LIB_FLAG = -ltcl
+TCL_LIB_FLAG = @TCL_LIB_FLAG@
+#TCL_LIB_FLAG = -ltcl
+
+TCL_EXP_FILE = @TCL_EXP_FILE@
+TCL_BUILD_EXP_FILE = @TCL_BUILD_EXP_FILE@
#----------------------------------------------------------------
# The information below is modified by the configure script when
@@ -185,18 +237,24 @@ TCL_LIB_FLAG = @TCL_LIB_FLAG@
# modify any of this stuff by hand.
#----------------------------------------------------------------
-COMPAT_OBJS = @LIBOBJS@
-
-AC_FLAGS = @DEFS@
-RANLIB = @RANLIB@
-SRC_DIR = @srcdir@
-TOP_DIR = @srcdir@/..
-GENERIC_DIR = $(TOP_DIR)/generic
-COMPAT_DIR = $(TOP_DIR)/compat
-TOOL_DIR = $(TOP_DIR)/tools
-DLTEST_DIR = @srcdir@/dltest
-UNIX_DIR = @srcdir@
-CC = @CC@
+COMPAT_OBJS = @LIBOBJS@
+
+AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
+AR = @AR@
+RANLIB = @RANLIB@
+SRC_DIR = @srcdir@
+TOP_DIR = @srcdir@/..
+GENERIC_DIR = $(TOP_DIR)/generic
+COMPAT_DIR = $(TOP_DIR)/compat
+TOOL_DIR = $(TOP_DIR)/tools
+UNIX_DIR = $(TOP_DIR)/unix
+# Must be absolute because of the cd dltest $(DLTEST_DIR)/configure below.
+DLTEST_DIR = @TCL_SRC_DIR@/unix/dltest
+# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
+TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library
+
+#CC = purify -best-effort @CC@
+CC = @CC@
#----------------------------------------------------------------
# The information below should be usable as is. The configure
@@ -205,48 +263,70 @@ CC = @CC@
#----------------------------------------------------------------
-CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
+CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
+-I${GENERIC_DIR} -I${SRC_DIR} \
+${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
+${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} ${ENV_FLAGS} \
+-DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
+
+STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
-I${GENERIC_DIR} -I${SRC_DIR} \
${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
-LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS) -lc
+LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS) -lc
-DEPEND_SWITCHES = ${CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \
+DEPEND_SWITCHES = ${CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \
${AC_FLAGS} ${MATH_FLAGS} \
${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
-DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
TCLSH_OBJS = tclAppInit.o
-TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o \
- tclTestProcBodyObj.o tclUnixTest.o
+TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
+ tclThreadTest.o tclUnixTest.o
-XTTEST_OBJS = tclTest.o tclTestObj.o tclTestProcBodyObj.o \
- tclUnixTest.o tclXtNotify.o \
- tclXtTest.o xtTestInit.o
+XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
+ tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o
-GENERIC_OBJS = panic.o regexp.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
- tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclCompExpr.o \
- tclCompile.o tclDate.o tclEnv.o tclEvent.o tclExecute.o \
- tclFCmd.o tclFileName.o tclGet.o tclHash.o tclHistory.o \
- tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o tclIOSock.o \
- tclIOUtil.o tclLink.o tclListObj.o tclLoad.o tclMain.o tclNamesp.o \
- tclNotify.o tclObj.o tclParse.o tclPipe.o tclPkg.o tclPosixStr.o \
- tclPreserve.o tclProc.o tclStringObj.o tclTimer.o tclUtil.o tclVar.o \
- tclResolve.o
+GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
+ tclAsync.o tclBasic.o tclBinary.o \
+ tclCkalloc.o tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
+ tclCompCmds.o tclCompExpr.o tclCompile.o tclDate.o tclEncoding.o \
+ tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
+ tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
+ tclIOGT.o tclIOSock.o tclIOUtil.o tclLink.o tclListObj.o \
+ tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
+ tclObj.o tclPanic.o tclParse.o tclParseExpr.o tclPipe.o \
+ tclPkg.o tclPosixStr.o tclPreserve.o tclProc.o tclRegexp.o \
+ tclResolve.o tclResult.o tclScan.o tclStringObj.o tclThread.o \
+ tclStubInit.o tclStubLib.o tclTimer.o tclUtf.o tclUtil.o tclVar.o
+
+STUB_LIB_OBJS = tclStubLib.o ${COMPAT_OBJS}
OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} @DL_OBJS@
+TCL_DECLS = \
+ $(GENERIC_DIR)/tcl.decls \
+ $(GENERIC_DIR)/tclInt.decls
+
GENERIC_HDRS = \
- $(GENERIC_DIR)/tclRegexp.h \
$(GENERIC_DIR)/tcl.h \
+ $(GENERIC_DIR)/tclDecls.h \
$(GENERIC_DIR)/tclInt.h \
+ $(GENERIC_DIR)/tclIntDecls.h \
+ $(GENERIC_DIR)/tclIntPlatDecls.h \
+ $(GENERIC_DIR)/tclPatch.h \
+ $(GENERIC_DIR)/tclPlatDecls.h \
$(GENERIC_DIR)/tclPort.h \
- $(GENERIC_DIR)/tclPatch.h
+ $(GENERIC_DIR)/tclRegexp.h
GENERIC_SRCS = \
- $(GENERIC_DIR)/regexp.c \
+ $(GENERIC_DIR)/regcomp.c \
+ $(GENERIC_DIR)/regexec.c \
+ $(GENERIC_DIR)/regfree.c \
+ $(GENERIC_DIR)/regerror.c \
+ $(GENERIC_DIR)/tclAlloc.c \
$(GENERIC_DIR)/tclAsync.c \
$(GENERIC_DIR)/tclBasic.c \
$(GENERIC_DIR)/tclBinary.c \
@@ -255,9 +335,11 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclCmdAH.c \
$(GENERIC_DIR)/tclCmdIL.c \
$(GENERIC_DIR)/tclCmdMZ.c \
+ $(GENERIC_DIR)/tclCompCmds.c \
$(GENERIC_DIR)/tclCompExpr.c \
$(GENERIC_DIR)/tclCompile.c \
$(GENERIC_DIR)/tclDate.c \
+ $(GENERIC_DIR)/tclEncoding.c \
$(GENERIC_DIR)/tclEnv.c \
$(GENERIC_DIR)/tclEvent.c \
$(GENERIC_DIR)/tclExecute.c \
@@ -270,30 +352,42 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclInterp.c \
$(GENERIC_DIR)/tclIO.c \
$(GENERIC_DIR)/tclIOCmd.c \
+ $(GENERIC_DIR)/tclIOGT.c \
$(GENERIC_DIR)/tclIOSock.c \
$(GENERIC_DIR)/tclIOUtil.c \
$(GENERIC_DIR)/tclLink.c \
$(GENERIC_DIR)/tclListObj.c \
+ $(GENERIC_DIR)/tclLiteral.c \
$(GENERIC_DIR)/tclLoad.c \
$(GENERIC_DIR)/tclMain.c \
$(GENERIC_DIR)/tclNamesp.c \
$(GENERIC_DIR)/tclNotify.c \
$(GENERIC_DIR)/tclObj.c \
$(GENERIC_DIR)/tclParse.c \
+ $(GENERIC_DIR)/tclParseExpr.c \
$(GENERIC_DIR)/tclPipe.c \
$(GENERIC_DIR)/tclPkg.c \
$(GENERIC_DIR)/tclPosixStr.c \
$(GENERIC_DIR)/tclPreserve.c \
$(GENERIC_DIR)/tclProc.c \
- $(GENERIC_DIR)/tclTestProcBodyObj.c \
+ $(GENERIC_DIR)/tclRegexp.c \
$(GENERIC_DIR)/tclResolve.c \
+ $(GENERIC_DIR)/tclResult.c \
+ $(GENERIC_DIR)/tclScan.c \
+ $(GENERIC_DIR)/tclStubInit.c \
+ $(GENERIC_DIR)/tclStubLib.c \
$(GENERIC_DIR)/tclStringObj.c \
$(GENERIC_DIR)/tclTest.c \
$(GENERIC_DIR)/tclTestObj.c \
+ $(GENERIC_DIR)/tclTestProcBodyObj.c \
+ $(GENERIC_DIR)/tclThread.c \
$(GENERIC_DIR)/tclTimer.c \
$(GENERIC_DIR)/tclUtil.c \
$(GENERIC_DIR)/tclVar.c
+STUB_SRCS = \
+ $(GENERIC_DIR)/tclStubLib.c
+
UNIX_HDRS = \
$(UNIX_DIR)/tclUnixPort.h
@@ -308,6 +402,7 @@ UNIX_SRCS = \
$(UNIX_DIR)/tclUnixPipe.c \
$(UNIX_DIR)/tclUnixSock.c \
$(UNIX_DIR)/tclUnixTest.c \
+ $(UNIX_DIR)/tclUnixThrd.c \
$(UNIX_DIR)/tclUnixTime.c \
$(UNIX_DIR)/tclUnixInit.c
@@ -317,6 +412,7 @@ DL_SRCS = \
$(UNIX_DIR)/tclLoadDl.c \
$(UNIX_DIR)/tclLoadDl2.c \
$(UNIX_DIR)/tclLoadDld.c \
+ $(UNIX_DIR)/tclLoadDyld.c \
$(GENERIC_DIR)/tclLoadNone.c \
$(UNIX_DIR)/tclLoadOSF.c \
$(UNIX_DIR)/tclLoadShl.c
@@ -325,25 +421,27 @@ DL_SRCS = \
# compile on the current machine, and they will cause problems for
# things like "make depend".
-SRCS = $(GENERIC_SRCS) $(UNIX_SRCS)
+SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) $(STUB_SRCS)
-all: ${TCL_LIB_FILE} tclsh
+all: binaries libraries doc
-# CYGNUS LOCAL
+binaries: ${TCL_LIB_FILE} $(TCL_STUB_LIB_FILE) $(TCL_BUILD_EXP_FILE) tclsh
-# The shared- and unshared-library cases are separate, so that RANLIB
-# can unconditionally work.
+libraries:
-${TCL_SHARED_LIB_FILE}: ${OBJS}
- rm -f ${TCL_LIB_FILE}
- @MAKE_LIB@
+doc:
-${TCL_UNSHARED_LIB_FILE}: ${OBJS}
+# The following target is configured by autoconf to generate either
+# a shared library or non-shared library for Tcl.
+${TCL_LIB_FILE}: ${OBJS} ${STUB_LIB_FILE}
rm -f ${TCL_LIB_FILE}
@MAKE_LIB@
$(RANLIB) ${TCL_LIB_FILE}
-# END CYGNUS LOCAL
+${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
+ rm -f ${STUB_LIB_FILE}
+ @MAKE_STUB_LIB@
+ $(RANLIB) ${STUB_LIB_FILE}
# Make target which outputs the list of the .o contained in the Tcl lib
# usefull to build a single big shared library containing Tcl and other
@@ -358,19 +456,13 @@ objs: ${OBJS}
tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE}
- ${CC} @LD_FLAGS@ ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+ ${CC} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
@TCL_LD_SEARCH_FLAGS@ -o tclsh
tcltest: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST}
- ${CC} @LD_FLAGS@ ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+ ${CC} ${LDFLAGS} ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
@TCL_LD_SEARCH_FLAGS@ -o tcltest
-xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
- @DL_OBJS@ ${BUILD_DLTEST}
- ${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
- @DL_OBJS@ @TCL_BUILD_LIB_SPEC@ ${LIBS} \
- @TCL_LD_SEARCH_FLAGS@ -lXt -o xttest
-
# Note, in the target below TCL_LIBRARY needs to be set or else
# "make test" won't work in the case where the compilation directory
@@ -378,13 +470,17 @@ xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
test: tcltest
LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
- TCL_LIBRARY=${TOP_DIR}/library; export TCL_LIBRARY; \
- ( echo cd $(TOP_DIR)/tests\; source all ) | ./tcltest
+ LIBPATH=`pwd`:${LIBPATH}; export LIBPATH; \
+ SHLIB_PATH=`pwd`:${SHLIB_PATH}; export SHLIB_PATH; \
+ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
+ ./tcltest $(TOP_DIR)/tests/all.tcl $(TCLTESTARGS)
# Useful target to launch a built tcltest with the proper path,...
-runtest:
+runtest: tcltest
LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
- TCL_LIBRARY=${TOP_DIR}/library; export TCL_LIBRARY; \
+ LIBPATH=`pwd`:${LIBPATH}; export LIBPATH; \
+ SHLIB_PATH=`pwd`:${SHLIB_PATH}; export SHLIB_PATH; \
+ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
./tcltest
# The following target outputs the name of the top-level source directory
@@ -406,9 +502,10 @@ topDirName:
gendate:
yacc -l $(GENERIC_DIR)/tclGetDate.y
sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
- -e 's/SCCSID/%Z\% %M\% %I\% %E\% %U\%/g' \
+ -e 's?SCCSID?RCS: @(#) $$Id$$?' \
-e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
-e '/TclDatenewstate:/d' -e '/#pragma/d' \
+ -e '/#include <inttypes.h>/d' -e 's/const /CONST /g' \
<y.tab.c >$(GENERIC_DIR)/tclDate.c
rm y.tab.c
@@ -431,30 +528,46 @@ dltest/Makefile: $(DLTEST_DIR)/configure $(DLTEST_DIR)/Makefile.in tclConfig.sh
dldir=`cd $(DLTEST_DIR) && pwd`; cd dltest; \
if test -f configure; then ./configure; else $$dldir/configure; fi
-install: install-binaries install-libraries install-man
+install: install-binaries install-libraries install-doc
+
+install-strip:
+ $(MAKE) install INSTALL_PROGRAM="$(INSTALL_PROGRAM) -s"
# Note: before running ranlib below, must cd to target directory because
# some ranlibs write to current directory, and this might not always be
# possible (e.g. if installing as root).
-install-binaries: $(TCL_LIB_FILE) tclsh
+install-binaries: binaries
@for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ mkdir -p $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
- @echo "Installing $(TCL_LIB_FILE)"
+ @if test ! -x $(SRC_DIR)/install-sh; then \
+ chmod +x $(SRC_DIR)/install-sh; \
+ fi
+ @echo "Installing $(TCL_LIB_FILE) to $(LIB_INSTALL_DIR)/"
@$(INSTALL_DATA) $(TCL_LIB_FILE) $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE)
@(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TCL_LIB_FILE))
@chmod 555 $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE)
- @echo "Installing tclsh"
- @$(INSTALL_PROGRAM) tclsh $(BIN_INSTALL_DIR)/tclsh
- @echo "Installing tclConfig.sh"
+ @if test "$(TCL_BUILD_EXP_FILE)" != ""; then \
+ echo "Installing $(TCL_EXP_FILE) to $(LIB_INSTALL_DIR)/"; \
+ $(INSTALL_DATA) $(TCL_BUILD_EXP_FILE) \
+ $(LIB_INSTALL_DIR)/$(TCL_EXP_FILE); \
+ fi
+ @echo "Installing tclsh as $(BIN_INSTALL_DIR)/tclsh$(VERSION)"
+ @$(INSTALL_PROGRAM) tclsh $(BIN_INSTALL_DIR)/tclsh$(VERSION)
+ @echo "Installing tclConfig.sh to $(LIB_INSTALL_DIR)/"
@$(INSTALL_DATA) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
+ @if test "$(TCL_STUB_LIB_FILE)" != "" ; then \
+ echo "Installing $(TCL_STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
+ $(INSTALL_DATA) $(STUB_LIB_FILE) \
+ $(LIB_INSTALL_DIR)/$(TCL_STUB_LIB_FILE); \
+ fi
install-libraries:
@for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
@@ -462,108 +575,89 @@ install-libraries:
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ mkdir -p $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
- @for i in http2.0 http1.0 opt0.1; \
+ @for i in http2.3 http1.0 opt0.4 encoding msgcat1.0 tcltest1.0; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
- mkdir $(SCRIPT_INSTALL_DIR)/$$i; \
+ mkdir -p $(SCRIPT_INSTALL_DIR)/$$i; \
chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \
else true; \
fi; \
done;
- @echo "Installing tcl.h"
- @$(INSTALL_DATA) $(GENERIC_DIR)/tcl.h $(INCLUDE_INSTALL_DIR)/tcl.h
- @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \
- do \
- echo "Installing $$i"; \
- $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
- done;
- @for i in http2.0 http1.0 opt0.1; \
- do \
- for j in $(TOP_DIR)/library/$$i/*.tcl ; \
- do \
- echo "Installing $$j"; \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
- done; \
- done;
-
-# CYGNUS LOCAL: install-minimal target.
-install-minimal:
- @for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
- $(SCRIPT_INSTALL_DIR) ; \
- do \
- if [ ! -d $$i ] ; then \
- echo "Making directory $$i"; \
- mkdir $$i; \
- chmod 755 $$i; \
- else true; \
- fi; \
- done;
- @for i in http2.0 http1.0 opt0.1; \
+ @if test ! -x $(SRC_DIR)/install-sh; then \
+ chmod +x $(SRC_DIR)/install-sh; \
+ fi
+ @echo "Installing header files";
+ @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h ; \
do \
- if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
- echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
- mkdir $(SCRIPT_INSTALL_DIR)/$$i; \
- chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \
- else true; \
- fi; \
+ $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
done;
- @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/ldAix; \
+ @echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
+ @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \
do \
- echo "Installing $$i"; \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
- @for i in http2.0 http1.0 opt0.1; \
+ @for i in http2.3 http1.0 opt0.4 msgcat1.0 tcltest1.0; \
do \
+ echo "Installing library $$i directory"; \
for j in $(TOP_DIR)/library/$$i/*.tcl ; \
do \
- echo "Installing $$j"; \
$(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
done; \
done;
-
-install-man:
- @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) ; \
+ @echo "Installing library encoding directory";
+ @for i in $(TOP_DIR)/library/encoding/*.enc ; do \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/encoding; \
+ done;
+
+install-doc: doc
+ @if test ! -x $(UNIX_DIR)/mkLinks; then \
+ chmod +x $(UNIX_DIR)/mkLinks; \
+ fi
+ @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) $(MANN_INSTALL_DIR) ; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ mkdir -p $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
+ @echo "Installing top-level (.1) docs";
@cd $(TOP_DIR)/doc; for i in *.1; \
do \
- echo "Installing doc/$$i"; \
rm -f $(MAN1_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
$$i > $(MAN1_INSTALL_DIR)/$$i; \
chmod 644 $(MAN1_INSTALL_DIR)/$$i; \
done;
- $(UNIX_DIR)/mkLinks $(MAN1_INSTALL_DIR)
+ @echo "Cross-linking top-level (.1) docs";
+ @$(UNIX_DIR)/mkLinks $(MAN1_INSTALL_DIR)
+ @echo "Installing C API (.3) docs";
@cd $(TOP_DIR)/doc; for i in *.3; \
do \
- echo "Installing doc/$$i"; \
rm -f $(MAN3_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
$$i > $(MAN3_INSTALL_DIR)/$$i; \
chmod 644 $(MAN3_INSTALL_DIR)/$$i; \
done;
+ @echo "Cross-linking C API (.3) docs";
+ @$(UNIX_DIR)/mkLinks $(MAN3_INSTALL_DIR)
+ @echo "Installing command (.n) docs";
@cd $(TOP_DIR)/doc; for i in *.n; \
do \
- echo "Installing doc/$$i"; \
- name=`echo $$i | sed -e 's/n$$/3/'`; \
- rm -f $(MAN3_INSTALL_DIR)/$$name; \
+ rm -f $(MANN_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
- $$i > $(MAN3_INSTALL_DIR)/$$name; \
- chmod 644 $(MAN3_INSTALL_DIR)/$$name; \
+ $$i > $(MAN3_INSTALL_DIR)/$$i; \
+ chmod 644 $(MAN3_INSTALL_DIR)/$$i; \
done;
- $(UNIX_DIR)/mkLinks $(MAN3_INSTALL_DIR)
+ @echo "Cross-linking command (.n) docs";
+ @$(UNIX_DIR)/mkLinks $(MANN_INSTALL_DIR)
Makefile: $(UNIX_DIR)/Makefile.in config.status
$(SHELL) config.status
@@ -579,7 +673,7 @@ clean:
distclean: clean
rm -rf Makefile config.status config.cache config.log tclConfig.sh \
- SUNWtcl.* prototype
+ $(PACKAGE).* prototype
if test -f dltest/Makefile; then cd dltest; $(MAKE) distclean; fi
depend:
@@ -598,7 +692,9 @@ tclTestInit.o: $(UNIX_DIR)/tclAppInit.c
rm -f tclAppInit.sav; \
mv tclAppInit.o tclAppInit.sav; \
fi;
- $(CC) -c $(CC_SWITCHES) -DTCL_TEST $(UNIX_DIR)/tclAppInit.c
+ $(CC) -c $(CC_SWITCHES) \
+ -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
+ -DTCL_TEST $(UNIX_DIR)/tclAppInit.c
rm -f tclTestInit.o
mv tclAppInit.o tclTestInit.o
@if test -f tclAppInit.sav ; then \
@@ -610,8 +706,9 @@ xtTestInit.o: $(UNIX_DIR)/tclAppInit.c
rm -f tclAppInit.sav; \
mv tclAppInit.o tclAppInit.sav; \
fi;
- $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DTCL_XT_TEST \
- $(UNIX_DIR)/tclAppInit.c
+ $(CC) -c $(CC_SWITCHES) \
+ -DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
+ -DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c
rm -f xtTestInit.o
mv tclAppInit.o xtTestInit.o
@if test -f tclAppInit.sav ; then \
@@ -620,15 +717,31 @@ xtTestInit.o: $(UNIX_DIR)/tclAppInit.c
# Object files used on all Unix systems:
-panic.o: $(GENERIC_DIR)/panic.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/panic.c
+REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
+ $(GENERIC_DIR)/regcustom.h
+regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
+ $(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
+ $(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c
+
+regexec.o: $(REGHDRS) $(GENERIC_DIR)/regexec.c $(GENERIC_DIR)/rege_dfa.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regexec.c
+
+regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regfree.c
-regexp.o: $(GENERIC_DIR)/regexp.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regexp.c
+regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c
tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
+# On unix we want to use the normal malloc/free implementation, so we
+# specifically set the USE_TCLALLOC flag.
+
+tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
+ $(CC) -c $(CC_SWITCHES) -DUSE_TCLALLOC=0 $(GENERIC_DIR)/tclAlloc.c
+
tclAsync.o: $(GENERIC_DIR)/tclAsync.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c
@@ -656,12 +769,18 @@ tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c
tclDate.o: $(GENERIC_DIR)/tclDate.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDate.c
+tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmds.c
+
tclCompExpr.o: $(GENERIC_DIR)/tclCompExpr.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompExpr.c
tclCompile.o: $(GENERIC_DIR)/tclCompile.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompile.c
+tclEncoding.o: $(GENERIC_DIR)/tclEncoding.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEncoding.c
+
tclEnv.o: $(GENERIC_DIR)/tclEnv.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c
@@ -698,6 +817,9 @@ tclIO.o: $(GENERIC_DIR)/tclIO.c
tclIOCmd.o: $(GENERIC_DIR)/tclIOCmd.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOCmd.c
+tclIOGT.o: $(GENERIC_DIR)/tclIOGT.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOGT.c
+
tclIOSock.o: $(GENERIC_DIR)/tclIOSock.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOSock.c
@@ -710,6 +832,9 @@ tclLink.o: $(GENERIC_DIR)/tclLink.c
tclListObj.o: $(GENERIC_DIR)/tclListObj.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclListObj.c
+tclLiteral.o: $(GENERIC_DIR)/tclLiteral.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLiteral.c
+
tclObj.o: $(GENERIC_DIR)/tclObj.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c
@@ -731,6 +856,9 @@ tclLoadDl2.o: $(UNIX_DIR)/tclLoadDl2.c
tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c
+tclLoadDyld.o: $(UNIX_DIR)/tclLoadDyld.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDyld.c
+
tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoadNone.c
@@ -755,6 +883,12 @@ tclNotify.o: $(GENERIC_DIR)/tclNotify.c
tclParse.o: $(GENERIC_DIR)/tclParse.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c
+tclParseExpr.o: $(GENERIC_DIR)/tclParseExpr.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParseExpr.c
+
+tclPanic.o: $(GENERIC_DIR)/tclPanic.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPanic.c
+
tclPipe.o: $(GENERIC_DIR)/tclPipe.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPipe.c
@@ -770,15 +904,30 @@ tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
tclProc.o: $(GENERIC_DIR)/tclProc.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c
+tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclRegexp.c
+
tclResolve.o: $(GENERIC_DIR)/tclResolve.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResolve.c
+tclResult.o: $(GENERIC_DIR)/tclResult.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResult.c
+
+tclScan.o: $(GENERIC_DIR)/tclScan.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclScan.c
+
tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c
+tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStubInit.c
+
tclUtil.o: $(GENERIC_DIR)/tclUtil.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
+tclUtf.o: $(GENERIC_DIR)/tclUtf.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtf.c
+
tclVar.o: $(GENERIC_DIR)/tclVar.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c
@@ -794,6 +943,12 @@ tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c
tclTimer.o: $(GENERIC_DIR)/tclTimer.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTimer.c
+tclThread.o: $(GENERIC_DIR)/tclThread.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThread.c
+
+tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c
+
tclUnixChan.o: $(UNIX_DIR)/tclUnixChan.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixChan.c
@@ -818,50 +973,127 @@ tclUnixSock.o: $(UNIX_DIR)/tclUnixSock.c
tclUnixTest.o: $(UNIX_DIR)/tclUnixTest.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTest.c
+tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c
+
tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c
-tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
- $(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \
+# CYGNUS LOCAL
+
+# Don't burn a TCL_LIBRARY path into tclUnixInit.o.
+# We need Tcl to be location independent and a compiled
+# in path just masks problems with the search algo.
+
+# FIXME: The TCL_PACKAGE_PATH is still compiled in,
+# the only effect seems to be that the compiled in
+# dir name appears on the auto_path after the tree
+# has been moved.
+
+# END CYGNUS LOCAL
+
+tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c $(GENERIC_DIR)/tclInitScript.h tclConfig.sh
+ $(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"\" \
-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \
$(UNIX_DIR)/tclUnixInit.c
-# compat binaries
+# The following targets are not completely general. They are provide
+# purely for documentation purposes so people who are interested in
+# the Xt based notifier can modify them to suit their own installation.
+
+xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
+ @DL_OBJS@ ${BUILD_DLTEST}
+ ${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
+ @DL_OBJS@ @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+ @TCL_LD_SEARCH_FLAGS@ -L/usr/openwin/lib -lXt -o xttest
+
+tclXtNotify.o: $(UNIX_DIR)/tclXtNotify.c
+ $(CC) -c $(CC_SWITCHES) -I/usr/openwin/include \
+ $(UNIX_DIR)/tclXtNotify.c
+
+tclXtTest.o: $(UNIX_DIR)/tclXtTest.c
+ $(CC) -c $(CC_SWITCHES) -I/usr/openwin/include \
+ $(UNIX_DIR)/tclXtTest.c
+
+# compat binaries, these must be compiled for use in a shared library
+# even though they may be placed in a static executable or library. Since
+# they are included in both the tcl library and the stub library, they
+# need to be relocatable.
fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c
getcwd.o: $(COMPAT_DIR)/getcwd.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/getcwd.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/getcwd.c
opendir.o: $(COMPAT_DIR)/opendir.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/opendir.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c
+
+memcmp.o: $(COMPAT_DIR)/memcmp.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/memcmp.c
strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c
strstr.o: $(COMPAT_DIR)/strstr.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strstr.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c
strtod.o: $(COMPAT_DIR)/strtod.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtod.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtod.c
strtol.o: $(COMPAT_DIR)/strtol.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtol.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c
strtoul.o: $(COMPAT_DIR)/strtoul.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/strtoul.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c
tmpnam.o: $(COMPAT_DIR)/tmpnam.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/tmpnam.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/tmpnam.c
waitpid.o: $(COMPAT_DIR)/waitpid.c
- $(CC) -c $(CC_SWITCHES) $(COMPAT_DIR)/waitpid.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c
+
+# Stub library binaries, these must be compiled for use in a shared library
+# even though they will be placed in a static archive
+
+
+tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c
.c.o:
$(CC) -c $(CC_SWITCHES) $<
#
+# Target to regenerate header files and stub files from the *.decls tables.
+#
+
+$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
+ $(GENERIC_DIR)/tclInt.decls
+ $(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
+ $(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls
+
+genstubs:
+ $(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
+ $(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls
+
+#
+# Target to check that all exported functions have an entry in the stubs
+# tables.
+#
+
+checkstubs:
+ -@for i in `nm -p $(TCL_LIB_FILE) | awk '$$2 ~ /T/ { print $$3 }' \
+ | sort -n`; do \
+ match=0; \
+ for j in $(TCL_DECLS); do \
+ if [ `grep -c $$i $$j` -gt 0 ]; then \
+ match=1; \
+ fi; \
+ done; \
+ if [ $$match -eq 0 ]; then echo $$i; fi \
+ done
+
+#
# Target to check for proper usage of UCHAR macro.
#
@@ -877,16 +1109,32 @@ checkexports: $(TCL_LIB_FILE)
-nm -p $(TCL_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]cl'
#
+# Target to create a Tcl RPM for Linux. Requires that you be on a Linux
+# system.
+#
+
+rpm: all /bin/rpm
+ rm -f THIS.TCL.SPEC
+ echo "%define _builddir `pwd`" > THIS.TCL.SPEC
+ echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC
+ cat tcl.spec >> THIS.TCL.SPEC
+ mkdir -p RPMS/i386
+ rpm -bb THIS.TCL.SPEC
+ mv RPMS/i386/*.rpm .
+ rm -rf RPMS THIS.TCL.SPEC
+
+#
# Target to create a proper Tcl distribution from information in the
# master source directory. DISTDIR must be defined to indicate where
# to put the distribution.
#
+DISTROOT = /tmp/dist
DISTNAME = tcl@TCL_VERSION@@TCL_PATCH_LEVEL@
ZIPNAME = tcl@TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@@TCL_PATCH_LEVEL@.zip
DISTDIR = $(DISTROOT)/$(DISTNAME)
-#$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in
-# autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure
+$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in
+ autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure
dist: $(UNIX_DIR)/configure
rm -rf $(DISTDIR)
mkdir $(DISTDIR)
@@ -896,30 +1144,34 @@ dist: $(UNIX_DIR)/configure
cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
chmod 664 $(DISTDIR)/unix/Makefile.in
cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \
+ $(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \
$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
- $(UNIX_DIR)/porting.notes $(UNIX_DIR)/porting.old \
- $(UNIX_DIR)/README $(UNIX_DIR)/ldAix \
+ $(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \
$(DISTDIR)/unix
chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
chmod 775 $(DISTDIR)/unix/ldAix
chmod +x $(DISTDIR)/unix/install-sh
- tclsh $(UNIX_DIR)/mkLinks.tcl \
+
+ $(TCL_EXE) $(UNIX_DIR)/mkLinks.tcl \
$(UNIX_DIR)/../doc/*.[13n] > $(DISTDIR)/unix/mkLinks
chmod +x $(DISTDIR)/unix/mkLinks
mkdir $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(DISTDIR)/generic
+ cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
- cp -p $(TOP_DIR)/changes $(TOP_DIR)/README* $(TOP_DIR)/license.terms \
- $(DISTDIR)
+ cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \
+ $(TOP_DIR)/license.terms $(DISTDIR)
mkdir $(DISTDIR)/library
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
- for i in http2.0 http1.0 opt0.1; \
+ for i in http2.3 http1.0 opt0.4 msgcat1.0 reg1.0 dde1.1 tcltest1.0; \
do \
mkdir $(DISTDIR)/library/$$i ;\
cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
done;
+ mkdir $(DISTDIR)/library/encoding
+ cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
mkdir $(DISTDIR)/doc
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
$(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
@@ -930,21 +1182,26 @@ dist: $(UNIX_DIR)/configure
mkdir $(DISTDIR)/tests
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests
cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
- $(TOP_DIR)/tests/all $(TOP_DIR)/tests/*.tcl \
- $(TOP_DIR)/tests/defs $(DISTDIR)/tests
+ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \
+ $(DISTDIR)/tests
+ mkdir $(DISTDIR)/tests/pkg
+ cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests/pkg
+ cp -p $(TOP_DIR)/tests/pkg/*.tcl $(DISTDIR)/tests/pkg
mkdir $(DISTDIR)/win
- cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(TOP_DIR)/win/*.rc \
+ cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win
+ cp $(TOP_DIR)/win/configure.in \
+ $(TOP_DIR)/win/configure \
+ $(TOP_DIR)/win/tclConfig.sh.in \
+ $(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \
$(DISTDIR)/win
+ cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(TOP_DIR)/win/*.rc \
+ $(TOP_DIR)/win/*.ico $(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
- cp -p $(TOP_DIR)/win/pkgIndex.tcl $(DISTDIR)/win
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
mkdir $(DISTDIR)/mac
- sccs edit -s $(TOP_DIR)/mac/tclMacProjects.sea.hqx
- cp -p tclMacProjects.sea.hqx $(DISTDIR)/mac
- sccs unedit $(TOP_DIR)/mac/tclMacProjects.sea.hqx
- rm -f tclMacProjects.sea.hqx
+ cp -p $(TOP_DIR)/mac/tclMacProjects.sea.hqx $(DISTDIR)/mac
cp -p $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
$(DISTDIR)/mac
cp -p $(TOP_DIR)/mac/porting.notes $(TOP_DIR)/mac/README $(DISTDIR)/mac
@@ -957,6 +1214,16 @@ dist: $(UNIX_DIR)/configure
$(DISTDIR)/unix/dltest
cp -p $(UNIX_DIR)/dltest/configure.in $(UNIX_DIR)/dltest/configure \
$(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest
+ mkdir $(DISTDIR)/tools
+ cp -p $(TOP_DIR)/tools/Makefile.in \
+ $(TOP_DIR)/tools/README \
+ $(TOP_DIR)/tools/configure.in \
+ $(TOP_DIR)/tools/*.tcl \
+ $(TOP_DIR)/tools/man2tcl.c \
+ $(TOP_DIR)/tools/tcl.wse.in \
+ $(TOP_DIR)/tools/*.bmp \
+ $(TOP_DIR)/tools/tcl.hpj.in \
+ $(DISTDIR)/tools
#
# The following target can only be used for non-patch releases. Use
@@ -964,12 +1231,12 @@ dist: $(UNIX_DIR)/configure
#
alldist: dist
- rm -f /proj/tcl/dist/$(DISTNAME).tar.Z \
- /proj/tcl/dist/$(DISTNAME).tar.gz \
- /proj/tcl/dist/$(ZIPNAME)
- cd /proj/tcl/dist; tar cf $(DISTNAME).tar $(DISTNAME); \
+ rm -f $(DISTROOT)/$(DISTNAME).tar.Z \
+ $(DISTROOT)/$(DISTNAME).tar.gz \
+ $(DISTROOT)/$(ZIPNAME)
+ cd $(DISTROOT); tar cf $(DISTNAME).tar $(DISTNAME); \
gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
- compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) $(DISTNAME)
+ compress $(DISTNAME).tar; zip -qr8 $(ZIPNAME) $(DISTNAME)
#
# The target below is similar to "alldist" except it works for patch
@@ -992,19 +1259,30 @@ allpatch: dist
mv $(DISTROOT)/old $(DISTROOT)/tcl${VERSION}
#
+# This target creates the HTML folder for Tcl & Tk and places it
+# in DISTDIR/html. It uses the tcltk-man2html.tcl tool from
+# the Tcl group's tool workspace. It depends on the Tcl & Tk being
+# in directories called tcl8.3 & tk8.3 up two directories from the
+# TOOL_DIR.
+#
+
+html:
+ $(TCL_EXE) $(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(DISTDIR)/html \
+ --srcdir=$(TOP_DIR)/..
+
+#
# Target to create a Macintosh version of the distribution. This will
# do a normal distribution and then massage the output to prepare it
# for moving to the Mac platform. This requires a few scripts and
# programs found only in the Tcl group's tool workspace.
#
-macdist: dist
+macdist: dist machtml
+
+machtml:
rm -f $(DISTDIR)/mac/tclMacProjects.sea.hqx
- tclsh $(TOOL_DIR)/man2html.tcl $(DISTDIR)/tmp ../.. tcl$(VERSION)
- mv $(DISTDIR)/tmp/tcl$(VERSION) $(DISTDIR)/html
rm -rf $(DISTDIR)/doc
- rm -rf $(DISTDIR)/tmp
- tclsh $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)
+ $(TCL_EXE) $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)
#
# Targets to build Solaris package of the distribution for the current
@@ -1080,7 +1358,7 @@ package-generate:
$(DISTDIR)/$(PACKAGE)/$(VERSION)/lib=lib \
$(DISTDIR)/$(PACKAGE)/$(VERSION)/man=man \
$(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`=`arch` \
- | tclsh $(UNIX_DIR)/mkProto.tcl \
+ | $(TCL_EXE) $(UNIX_DIR)/mkProto.tcl \
$(VERSION) $(UNIX_DIR) > prototype
pkgmk -o -d . -f prototype -a `arch`
pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE)
diff --git a/tcl/unix/README b/tcl/unix/README
index 8f817e9bee6..4cc02957513 100644
--- a/tcl/unix/README
+++ b/tcl/unix/README
@@ -1,9 +1,19 @@
+Tcl UNIX README
+---------------
+
This is the directory where you configure, compile, test, and install
UNIX versions of Tcl. This directory also contains source files for Tcl
that are specific to UNIX. Some of the files in this directory are
used on the PC or Mac platform too, but they all depend on UNIX
(POSIX/ANSI C) interfaces and some of them only make sense under UNIX.
+Updated forms of the information found in this file is available at:
+ http://dev.scriptics.com/doc/howto/compile.html#unix
+
+For information on platforms where Tcl is known to compile, along
+with any porting notes for getting it to work on those platforms, see:
+ http://dev.scriptics.com/software/tcltk/platforms.html
+
The rest of this file contains instructions on how to do this. The
release should compile and run either "out of the box" or with trivial
changes on any UNIX-like system that approximates POSIX, BSD, or System
@@ -24,7 +34,17 @@ How To Compile And Install Tcl:
platform, or if you have applied patches, type "make distclean" to
discard all the configuration information computed previously.
-(c) Type "./configure". This runs a configuration script created by GNU
+(c) If there is no "configure" script in this directory it is because you
+ are working out of the source repository (i.e., CVS) instead of working
+ from a source distribution. In this case you need to use "autoconf"
+ to generate the configure script. It runs with no arguments.
+ Remember to run it here and down in the dltest directory.
+
+ (in the tcl/unix directory)
+ autoconf
+ cd dltest ; autoconf ; cd ..
+
+(d) Type "./configure". This runs a configuration script created by GNU
autoconf, which configures Tcl for your system and creates a
Makefile. The configure script allows you to customize the Tcl
configuration for your site; for details on how you can do this,
@@ -37,6 +57,8 @@ How To Compile And Install Tcl:
Makefile to use gcc after configure is run;
if you do this, then information related to
dynamic linking will be incorrect.
+ --enable-threads If this switch is set, Tcl will compile
+ itself with multithreading support.
--disable-load If this switch is specified then Tcl will
configure itself not to allow dynamic loading,
even if your system appears to support it.
@@ -45,23 +67,27 @@ How To Compile And Install Tcl:
if your system supports it.
--enable-shared If this switch is specified, Tcl will compile
itself as a shared library if it can figure
- out how to do that on this platform.
+ out how to do that on this platform. This
+ is the default on platforms where we know
+ how to build shared libraries.
+ --disable-shared If this switch is specified, Tcl will compile
+ itself as a static library.
Note: be sure to use only absolute path names (those starting with "/")
in the --prefix and --exec_prefix options.
-(d) Type "make". This will create a library archive called "libtcl.a"
- or "libtcl.so" and an interpreter application called "tclsh" that
- allows you to type Tcl commands interactively or execute script files.
+(e) Type "make". This will create a library archive called
+ "libtcl<version>.a" or "libtcl<version>.so" and an interpreter
+ application called "tclsh" that allows you to type Tcl commands
+ interactively or execute script files.
-(e) If the make fails then you'll have to personalize the Makefile
+(f) If the make fails then you'll have to personalize the Makefile
for your site or possibly modify the distribution in other ways.
- First check the file "porting.notes" to see if there are hints
- for compiling on your system. Then look at the porting Web page
- described later in this file. If you need to modify Makefile, there
+ First check the porting Web page above to see if there are hints
+ for compiling on your system. If you need to modify Makefile,
are comments at the beginning of it that describe the things you
might want to change and how to change them.
-(f) Type "make install" to install Tcl binaries and script files in
+(g) Type "make install" to install Tcl binaries and script files in
standard places. You'll need write permission on the installation
directories to do this. The installation directories are
determined by the "configure" script and may be specified with
@@ -70,27 +96,20 @@ How To Compile And Install Tcl:
can override these choices by modifying the "prefix" and
"exec_prefix" variables in the Makefile.
-(g) At this point you can play with Tcl by invoking the "tclsh"
+(h) At this point you can play with Tcl by invoking the "tclsh"
program and typing Tcl commands. However, if you haven't installed
Tcl then you'll first need to set your TCL_LIBRARY variable to
hold the full path name of the "library" subdirectory. Note that
the installed versions of tclsh, libtcl.a, and libtcl.so have a
- version number in their names, such as "tclsh8.0" or "libtcl8.0.so";
+ version number in their names, such as "tclsh8.3" or "libtcl8.3.so";
to use the installed versions, either specify the version number
- or create a symbolic link (e.g. from "tclsh" to "tclsh8.0").
-
-If you have trouble compiling Tcl, read through the file" porting.notes".
-It contains information that people have provided about changes they had
-to make to compile Tcl in various environments. Or, check out the
-following Web URL:
- http://www.sunlabs.com/cgi-bin/tcl/info.8.0
-This is an on-line database of porting information. We make no guarantees
-that this information is accurate, complete, or up-to-date, but you may
-find it useful. If you get Tcl running on a new configuration, we would
-be happy to receive new information to add to "porting.notes". You can
-also make a new entry into the on-line Web database. We're also interested
-in hearing how to change the configuration setup so that Tcl compiles out
-of the box on more platforms.
+ or create a symbolic link (e.g. from "tclsh" to "tclsh8.3").
+
+If you have trouble compiling Tcl, see the URL noted above about working
+platforms. It contains information that people have provided about changes
+they had to make to compile Tcl in various environments. We're also
+interested in hearing how to change the configuration setup so that Tcl
+compiles on additional platforms "out of the box".
Test suite
----------
@@ -101,10 +120,14 @@ directory. You should then see a printout of the test files processed.
If any errors occur, you'll see a much more substantial printout for
each error. See the README file in the "tests" directory for more
information on the test suite. Note: don't run the tests as superuser:
-this will cause several of them to fail.
+this will cause several of them to fail. If a test is failing
+consistently, please send us a bug report with as much detail as you
+can manage. Please use the online database at
+ http://dev.scriptics.com/ticket/
The Tcl test suite is very sensitive to proper implementation of
ANSI C library procedures such as sprintf and sscanf. If the test
suite generates errors, most likely they are due to non-conformance
of your system's ANSI C library; such problems are unlikely to
affect any real applications so it's probably safe to ignore them.
+
diff --git a/tcl/unix/aclocal.m4 b/tcl/unix/aclocal.m4
index 7bb84600904..005783c4aae 100644
--- a/tcl/unix/aclocal.m4
+++ b/tcl/unix/aclocal.m4
@@ -1,535 +1,2 @@
-dnl written by Rob Savoye <rob@cygnus.com> for Cygnus Support
-dnl CYGNUS LOCAL: This gets the right posix flag for gcc
-AC_DEFUN(CY_AC_TCL_LYNX_POSIX,
-[AC_REQUIRE([AC_PROG_CC])AC_REQUIRE([AC_PROG_CPP])
-AC_MSG_CHECKING([to see if this is LynxOS])
-AC_CACHE_VAL(ac_cv_os_lynx,
-[AC_EGREP_CPP(yes,
-[/*
- * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
- */
-#if defined(__Lynx__) || defined(Lynx)
-yes
-#endif
-], ac_cv_os_lynx=yes, ac_cv_os_lynx=no)])
-#
-if test "$ac_cv_os_lynx" = "yes" ; then
- AC_MSG_RESULT(yes)
- AC_DEFINE(LYNX)
- AC_MSG_CHECKING([whether -mposix or -X is available])
- AC_CACHE_VAL(ac_cv_c_posix_flag,
- [AC_TRY_COMPILE(,[
- /*
- * This flag varies depending on how old the compiler is.
- * -X is for the old "cc" and "gcc" (based on 1.42).
- * -mposix is for the new gcc (at least 2.5.8).
- */
- #if defined(__GNUC__) && __GNUC__ >= 2
- choke me
- #endif
- ], ac_cv_c_posix_flag=" -mposix", ac_cv_c_posix_flag=" -X")])
- CC="$CC $ac_cv_c_posix_flag"
- AC_MSG_RESULT($ac_cv_c_posix_flag)
- else
- AC_MSG_RESULT(no)
-fi
-])
-
-AC_DEFUN(CY_AC_PATH_TCLH, [
-#
-# Ok, lets find the tcl source trees so we can use the headers
-# Warning: transition of version 9 to 10 will break this algorithm
-# because 10 sorts before 9. We also look for just tcl. We have to
-# be careful that we don't match stuff like tclX by accident.
-# the alternative search directory is involked by --with-tclinclude
-#
-no_tcl=true
-AC_MSG_CHECKING(for Tcl private headers)
-AC_ARG_WITH(tclinclude, [ --with-tclinclude directory where tcl private headers are], with_tclinclude=${withval})
-AC_CACHE_VAL(ac_cv_c_tclh,[
-# first check to see if --with-tclinclude was specified
-if test x"${with_tclinclude}" != x ; then
- if test -f ${with_tclinclude}/tclInt.h ; then
- ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)`
- else
- AC_MSG_ERROR([${with_tclinclude} directory doesn't contain private headers])
- fi
-fi
-# next check in private source directory
-#
-# since ls returns lowest version numbers first, reverse its output
-if test x"${ac_cv_c_tclh}" = x ; then
- for i in \
- ${srcdir}/../tcl \
- `ls -dr ${srcdir}/../tcl[[0-9]]* 2>/dev/null` \
- ${srcdir}/../../tcl \
- `ls -dr ${srcdir}/../../tcl[[0-9]]* 2>/dev/null` \
- ${srcdir}/../../../tcl \
- `ls -dr ${srcdir}/../../../tcl[[0-9]]* 2>/dev/null ` ; do
- if test -f $i/tclInt.h ; then
- ac_cv_c_tclh=`(cd $i; pwd)`
- break
- fi
- done
-fi
-# finally check in a few common install locations
-#
-# since ls returns lowest version numbers first, reverse its output
-if test x"${ac_cv_c_tclh}" = x ; then
- for i in \
- `ls -dr /usr/local/src/tcl[[0-9]]* 2>/dev/null` \
- `ls -dr /usr/local/lib/tcl[[0-9]]* 2>/dev/null` \
- /usr/local/src/tcl \
- /usr/local/lib/tcl \
- ${prefix}/include ; do
- if test -f $i/tclInt.h ; then
- ac_cv_c_tclh=`(cd $i; pwd)`
- break
- fi
- done
-fi
-# see if one is installed
-if test x"${ac_cv_c_tclh}" = x ; then
- AC_HEADER_CHECK(tclInt.h, ac_cv_c_tclh=installed, ac_cv_c_tclh="")
-fi
-])
-if test x"${ac_cv_c_tclh}" = x ; then
- TCLHDIR="# no Tcl private headers found"
- AC_MSG_ERROR([Can't find Tcl private headers])
-fi
-if test x"${ac_cv_c_tclh}" != x ; then
- no_tcl=""
- if test x"${ac_cv_c_tkh}" = x"installed" ; then
- AC_MSG_RESULT([is installed])
- TCLHDIR=""
- else
- AC_MSG_RESULT([found in ${ac_cv_c_tclh}])
- # this hack is cause the TCLHDIR won't print if there is a "-I" in it.
- TCLHDIR="-I${ac_cv_c_tclh}"
- fi
-fi
-
-AC_MSG_CHECKING([Tcl version])
-rm -rf tclmajor tclminor
-orig_includes="$CPPFLAGS"
-
-if test x"${TCLHDIR}" != x ; then
- CPPFLAGS="$CPPFLAGS $TCLHDIR"
-fi
-
-AC_TRY_RUN([
-#include <stdio.h>
-#include "tcl.h"
-main() {
- FILE *maj = fopen("tclmajor","w");
- FILE *min = fopen("tclminor","w");
- fprintf(maj,"%d",TCL_MAJOR_VERSION);
- fprintf(min,"%d",TCL_MINOR_VERSION);
- fclose(maj);
- fclose(min);
- return 0;
-}],
- tclmajor=`cat tclmajor`
- tclminor=`cat tclminor`
- tclversion=$tclmajor.$tclminor
- AC_MSG_RESULT($tclversion)
- rm -f tclmajor tclminor
-,
- AC_MSG_RESULT([can't happen])
-,
- AC_MSG_ERROR([can't be cross compiled])
-)
-CPPFLAGS="${orig_includes}"
-
-AC_PROVIDE([$0])
-AC_SUBST(TCLHDIR)
-])
-AC_DEFUN(CY_AC_PATH_TCLLIB, [
-#
-# Ok, lets find the tcl library
-# First, look for one uninstalled.
-# the alternative search directory is invoked by --with-tcllib
-#
-
-if test $tclmajor -ge 7 -a $tclminor -ge 4 ; then
- installedtcllibroot=tcl$tclversion
-else
- installedtcllibroot=tcl
-fi
-
-if test x"${no_tcl}" = x ; then
- # we reset no_tcl incase something fails here
- no_tcl=true
- AC_ARG_WITH(tcllib, [ --with-tcllib directory where the tcl library is],
- with_tcllib=${withval})
- AC_MSG_CHECKING([for Tcl library])
- AC_CACHE_VAL(ac_cv_c_tcllib,[
- # First check to see if --with-tcllib was specified.
- # This requires checking for both the installed and uninstalled name-styles
- # since we have no idea if it's installed or not.
- if test x"${with_tcllib}" != x ; then
- if test -f "${with_tcllib}/lib$installedtcllibroot.so" ; then
- ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/lib$installedtcllibroot.so
- elif test -f "${with_tcllib}/libtcl.so" ; then
- ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/libtcl.so
- # then look for a freshly built statically linked library
- # if Makefile exists we assume its configured and libtcl will be built first.
- elif test -f "${with_tcllib}/lib$installedtcllibroot.a" ; then
- ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/lib$installedtcllibroot.a
- elif test -f "${with_tcllib}/libtcl.a" ; then
- ac_cv_c_tcllib=`(cd ${with_tcllib}; pwd)`/libtcl.a
- else
- AC_MSG_ERROR([${with_tcllib} directory doesn't contain libraries])
- fi
- fi
- # then check for a private Tcl library
- # Since these are uninstalled, use the simple lib name root.
- if test x"${ac_cv_c_tcllib}" = x ; then
- for i in \
- ../tcl \
- `ls -dr ../tcl[[0-9]]* 2>/dev/null` \
- ../../tcl \
- `ls -dr ../../tcl[[0-9]]* 2>/dev/null` \
- ../../../tcl \
- `ls -dr ../../../tcl[[0-9]]* 2>/dev/null` ; do
- # first look for a freshly built dynamically linked library
- if test -f "$i/libtcl.so" ; then
- ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.so
- break
- # then look for a freshly built statically linked library
- # if Makefile exists we assume its configured and libtcl will be built first.
- elif test -f "$i/libtcl.a" -o -f "$i/Makefile" ; then
- ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.a
- break
- fi
- done
- fi
- # check in a few common install locations
- if test x"${ac_cv_c_tcllib}" = x ; then
- for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do
- # first look for a freshly built dynamically linked library
- if test -f "$i/lib$installedtcllibroot.so" ; then
- ac_cv_c_tcllib=`(cd $i; pwd)`/lib$installedtcllibroot.so
- break
- # then look for a freshly built statically linked library
- # if Makefile exists we assume its configured and libtcl will be built first.
- elif test -f "$i/lib$installedtcllibroot.a" -o -f "$i/Makefile" ; then
- ac_cv_c_tcllib=`(cd $i; pwd)`/lib$installedtcllibroot.a
- break
- fi
- done
- fi
- # check in a few other private locations
- if test x"${ac_cv_c_tcllib}" = x ; then
- for i in \
- ${srcdir}/../tcl \
- `ls -dr ${srcdir}/../tcl[[0-9]]* 2>/dev/null` ; do
- # first look for a freshly built dynamically linked library
- if test -f "$i/libtcl.so" ; then
- ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.so
- break
- # then look for a freshly built statically linked library
- # if Makefile exists we assume its configured and libtcl will be built first.
- elif test -f "$i/libtcl.a" -o -f "$i/Makefile" ; then
- ac_cv_c_tcllib=`(cd $i; pwd)`/libtcl.a
- break
- fi
- done
- fi
-
- # see if one is conveniently installed with the compiler
- if test x"${ac_cv_c_tcllib}" = x ; then
- orig_libs="$LIBS"
- LIBS="$LIBS -l$installedtcllibroot -lm"
- AC_TRY_RUN([
- Tcl_AppInit()
- { exit(0); }], ac_cv_c_tcllib="-l$installedtcllibroot", ac_cv_c_tcllib=""
- , ac_cv_c_tclib="-l$installedtcllibroot")
- LIBS="${orig_libs}"
- fi
- ])
- if test x"${ac_cv_c_tcllib}" = x ; then
- TCLLIB="# no Tcl library found"
- AC_MSG_WARN(Can't find Tcl library)
- else
- TCLLIB=${ac_cv_c_tcllib}
- AC_MSG_RESULT(found $TCLLIB)
- no_tcl=
- fi
-fi
-
-AC_PROVIDE([$0])
-AC_SUBST(TCLLIB)
-])
-AC_DEFUN(CY_AC_PATH_TKH, [
-#
-# Ok, lets find the tk source trees so we can use the headers
-# If the directory (presumably symlink) named "tk" exists, use that one
-# in preference to any others. Same logic is used when choosing library
-# and again with Tcl. The search order is the best place to look first, then in
-# decreasing significance. The loop breaks if the trigger file is found.
-# Note the gross little conversion here of srcdir by cd'ing to the found
-# directory. This converts the path from a relative to an absolute, so
-# recursive cache variables for the path will work right. We check all
-# the possible paths in one loop rather than many seperate loops to speed
-# things up.
-# the alternative search directory is invoked by --with-tkinclude
-#
-AC_MSG_CHECKING(for Tk private headers)
-AC_ARG_WITH(tkinclude, [ --with-tkinclude directory where the tk private headers are],
- with_tkinclude=${withval})
-no_tk=true
-AC_CACHE_VAL(ac_cv_c_tkh,[
-# first check to see if --with-tkinclude was specified
-if test x"${with_tkinclude}" != x ; then
- if test -f ${with_tkinclude}/tk.h ; then
- ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)`
- else
- AC_MSG_ERROR([${with_tkinclude} directory doesn't contain private headers])
- fi
-fi
-# next check in private source directory
-#
-# since ls returns lowest version numbers first, reverse the entire list
-# and search for the worst fit, overwriting it with better fits as we find them
-if test x"${ac_cv_c_tkh}" = x ; then
- for i in \
- ${srcdir}/../tk \
- `ls -dr ${srcdir}/../tk[[0-9]]* 2>/dev/null` \
- ${srcdir}/../../tk \
- `ls -dr ${srcdir}/../../tk[[0-9]]* 2>/dev/null` \
- ${srcdir}/../../../tk \
- `ls -dr ${srcdir}/../../../tk[[0-9]]* 2>/dev/null ` ; do
- if test -f $i/tk.h ; then
- ac_cv_c_tkh=`(cd $i; pwd)`
- break
- fi
- done
-fi
-# finally check in a few common install locations
-#
-# since ls returns lowest version numbers first, reverse the entire list
-# and search for the worst fit, overwriting it with better fits as we find them
-if test x"${ac_cv_c_tkh}" = x ; then
- for i in \
- `ls -dr /usr/local/src/tk[[0-9]]* 2>/dev/null` \
- `ls -dr /usr/local/lib/tk[[0-9]]* 2>/dev/null` \
- /usr/local/src/tk \
- /usr/local/lib/tk \
- ${prefix}/include ; do
- if test -f $i/tk.h ; then
- ac_cv_c_tkh=`(cd $i; pwd)`
- break
- fi
- done
-fi
-# see if one is installed
-if test x"${ac_cv_c_tkh}" = x ; then
- AC_HEADER_CHECK(tk.h, ac_cv_c_tkh=installed)
-fi
-])
-if test x"${ac_cv_c_tkh}" != x ; then
- no_tk=""
- if test x"${ac_cv_c_tkh}" = x"installed" ; then
- AC_MSG_RESULT([is installed])
- TKHDIR=""
- else
- AC_MSG_RESULT([found in $ac_cv_c_tkh])
- # this hack is cause the TKHDIR won't print if there is a "-I" in it.
- TKHDIR="-I${ac_cv_c_tkh}"
- fi
-else
- TKHDIR="# no Tk directory found"
- AC_MSG_WARN([Can't find Tk private headers])
- no_tk=true
-fi
-
-# if Tk is installed, extract the major/minor version
-if test x"${no_tk}" = x ; then
-AC_MSG_CHECKING([Tk version])
-rm -rf tkmajor tkminor
-orig_includes="$CPPFLAGS"
-
-if test x"${TCLHDIR}" != x ; then
- CPPFLAGS="$CPPFLAGS $TCLHDIR"
-fi
-if test x"${TKHDIR}" != x ; then
- CPPFLAGS="$CPPFLAGS $TKHDIR"
-fi
-if test x"${x_includes}" != x -a x"${x_includes}" != xNONE ; then
- CPPFLAGS="$CPPFLAGS -I$x_includes"
-fi
-
-AC_TRY_RUN([
-#include <stdio.h>
-#include "tk.h"
- main() {
- FILE *maj = fopen("tkmajor","w");
- FILE *min = fopen("tkminor","w");
- fprintf(maj,"%d",TK_MAJOR_VERSION);
- fprintf(min,"%d",TK_MINOR_VERSION);
- fclose(maj);
- fclose(min);
- return 0;
-}],
- tkmajor=`cat tkmajor`
- tkminor=`cat tkminor`
- tkversion=$tkmajor.$tkminor
- AC_MSG_RESULT($tkversion)
- rm -f tkmajor tkminor
-,
- AC_MSG_ERROR([
-cannot compile a simple X program - suspect your xmkmf is
-misconfigured and is incorrectly reporting the location of your X
-include or libraries - report this to your system admin]) ,
- AC_MSG_ERROR([can't be cross compiled])
-)
-CPPFLAGS="${orig_includes}"
-fi
-
-AC_PROVIDE([$0])
-AC_SUBST(TKHDIR)
-])
-dnl for some reason, AC_REQUIRE() seems to choke autoconf
-AC_DEFUN(CY_AC_PATH_TKLIB, [
-dnl AC_REQUIRE(CY_AC_PATH_TCL)
-#
-# Ok, lets find the tk library
-# First, look for the latest private (uninstalled) copy
-# Notice that the destinations in backwards priority since the tests have
-# no break.
-# Then we look for either .a, .so, or Makefile. A Makefile is acceptable
-# is it indicates the target has been configured and will (probably)
-# soon be built. This allows an entire tree of Tcl software to be
-# configured at once and then built.
-# the alternative search directory is invoked by --with-tklib
-#
-
-if test x"${no_tk}" = x ; then
- # reset no_tk incase something fails here
- no_tk="true"
-
- if test $tkmajor -ge 4 ; then
- installedtklibroot=tk$tkversion
- else
- installedtkllibroot=tk
- fi
-
- AC_ARG_WITH(tklib, [ --with-tklib directory where the tk library is],
- with_tklib=${withval})
- AC_MSG_CHECKING([for Tk library])
- AC_CACHE_VAL(ac_cv_c_tklib,[
- # first check to see if --with-tklib was specified
- # This requires checking for both the installed and uninstalled name-styles
- # since we have no idea if it's installed or not.
- if test x"${with_tklib}" != x ; then
- if test -f "${with_tklib}/lib$installedtklibroot.so" ; then
- ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/lib$installedtklibroot.so
- no_tk=""
- elif test -f "${with_tklib}/libtk.so" ; then
- ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/libtk.so
- no_tk=""
- # then look for a freshly built statically linked library
- # if Makefile exists we assume its configured and libtk will be built
- elif test -f "${with_tklib}/lib$installedtklibroot.a" ; then
- ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/lib$installedtklibroot.a
- no_tk=""
- elif test -f "${with_tklib}/libtk.a" ; then
- ac_cv_c_tklib=`(cd ${with_tklib}; pwd)`/libtk.a
- no_tk=""
- else
- AC_MSG_ERROR([${with_tklib} directory doesn't contain libraries])
- fi
- fi
- # then check for a private Tk library
- # Since these are uninstalled, use the simple lib name root.
- if test x"${ac_cv_c_tklib}" = x ; then
- for i in \
- ../tk \
- `ls -dr ../tk[[0-9]]* 2>/dev/null` \
- ../../tk \
- `ls -dr ../../tk[[0-9]]* 2>/dev/null` \
- ../../../tk \
- `ls -dr ../../../tk[[0-9]]* 2>/dev/null` ; do
- # first look for a freshly built dynamically linked library
- if test -f "$i/libtk.so" ; then
- ac_cv_c_tklib=`(cd $i; pwd)`/libtk.so
- no_tk=
- break
- # then look for a freshly built statically linked library
- # if Makefile exists we assume its configured and libtk will be built
- elif test -f "$i/libtk.a" -o -f "$i/Makefile" ; then
- ac_cv_c_tklib=`(cd $i; pwd)`/libtk.a
- no_tk=""
- break
- fi
- done
- fi
- # finally check in a few common install locations
- if test x"${ac_cv_c_tklib}" = x ; then
- for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do
- # first look for a freshly built dynamically linked library
- if test -f "$i/lib$installedtklibroot.so" ; then
- ac_cv_c_tklib=`(cd $i; pwd)`/lib$installedtklibroot.so
- no_tk=""
- break
- # then look for a freshly built statically linked library
- # if Makefile exists, we assume it's configured and libtcl will be built
- elif test -f "$i/lib$installedtklibroot.a" -o -f "$i/Makefile" ; then
- ac_cv_c_tklib=`(cd $i; pwd)`/lib$installedtklibroot.a
- no_tk=""
- break
- fi
- done
- fi
- # check in a few other private locations
- if test x"${ac_cv_c_tklib}" = x ; then
- for i in \
- ${srcdir}/../tk \
- `ls -dr ${srcdir}/../tk[[0-9]]* 2>/dev/null` ; do
- # first look for a freshly built dynamically linked library
- if test -f "$i/libtk.so" ; then
- ac_cv_c_tklib=`(cd $i; pwd)`/libtk.so
- no_tk=""
- break
- # then look for a freshly built statically linked library
- # if Makefile exists, we assume it's configured and libtcl will be built
- elif test -f "$i/libtk.a" -o -f "$i/Makefile" ; then
- ac_cv_c_tklib=`(cd $i; pwd)`/libtk.a
- no_tk=""
- break
- fi
- done
- fi
- # see if one is conveniently installed with the compiler
- if test x"${ac_cv_c_tklib}" = x ; then
-dnl AC_REQUIRE(AC_PATH_X)
- orig_libs="$LIBS"
- LIBS="$LIBS -l$installedtklibroot $x_libraries $ac_cv_c_tcllib -lm"
- AC_TRY_RUN([
- Tcl_AppInit()
- { exit(0); }], ac_cv_c_tklib="-l$installedtklibroot", ac_cv_c_tklib=""
- , ac_cv_c_tklib="-l$installedtklibroot")
- LIBS="${orig_libs}"
- fi
- ])
- if test x"${ac_cv_c_tklib}" = x ; then
- TKLIB="# no Tk library found"
- AC_MSG_WARN(Can't find Tk library)
- else
- TKLIB=$ac_cv_c_tklib
- AC_MSG_RESULT(found $TKLIB)
- no_tk=
- fi
-fi
-AC_PROVIDE([$0])
-AC_SUBST(TKLIB)
-])
-AC_DEFUN(CY_AC_PATH_TK, [
- CY_AC_PATH_TKH
- CY_AC_PATH_TKLIB
-])
-AC_DEFUN(CY_AC_PATH_TCL, [
- CY_AC_PATH_TCLH
- CY_AC_PATH_TCLLIB
-])
+builtin(include,tcl.m4)
+builtin(include,../cygtcl.m4)
diff --git a/tcl/unix/bp.c b/tcl/unix/bp.c
new file mode 100644
index 00000000000..b8c7a49b2f4
--- /dev/null
+++ b/tcl/unix/bp.c
@@ -0,0 +1,127 @@
+/*
+ * bp.c --
+ *
+ * This file contains the "bp" ("binary patch") program. It is used
+ * to replace configuration strings in Tcl/Tk binaries as part of
+ * installation.
+ *
+ * Usage: bp file search replace
+ *
+ * This program searches file bp for the first occurrence of the
+ * character string given by "search". If it is found, then the
+ * first characters of that string get replaced by the string
+ * given by "replace". The replacement string is NULL-terminated.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ * All rights reserved.
+ * This file is NOT subject to the terms described in "license.terms".
+ *
+ * SCCS: @(#) bp.c 1.2 96/03/12 09:08:26
+ */
+
+#include <stdio.h>
+#include <string.h>
+
+extern int errno;
+
+/*
+ * The array below saves the last few bytes read from the file, so that
+ * they can be compared against a particular string that we're looking
+ * for.
+ */
+
+#define BUFFER_SIZE 200
+char buffer[BUFFER_SIZE];
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ int length, matchChar, fileChar, cur, fileIndex, stringIndex;
+ char *s;
+ FILE *f;
+
+ if (argc != 4) {
+ fprintf(stderr,
+ "Wrong # args: should be \"%s fileName string replace\"\n",
+ argv[0]);
+ exit(1);
+ }
+ f = fopen(argv[1], "r+");
+ if (f == NULL) {
+ fprintf(stderr,
+ "Couldn't open \"%s\" for writing: %s\n",
+ argv[1], strerror(errno));
+ exit(1);
+ }
+
+ for (cur = 0; cur < BUFFER_SIZE; cur++) {
+ buffer[cur] = 0;
+ }
+ s = argv[2];
+ length = strlen(s);
+ if (length > BUFFER_SIZE) {
+ fprintf(stderr,
+ "String \"%s\" too long; must be %d or fewer chars.\n",
+ s, BUFFER_SIZE);
+ exit(1);
+ }
+ matchChar = s[length-1];
+
+ while (1) {
+ fileChar = getc(f);
+ if (fileChar == EOF) {
+ if (ferror(f)) {
+ goto ioError;
+ }
+ fprintf(stderr, "Couldn't find string \"%s\"\n", argv[2]);
+ exit(1);
+ }
+ buffer[cur] = fileChar;
+ if (fileChar == matchChar) {
+ /*
+ * Last character of the string matches the current character
+ * from the file. Search backwards through the buffer to
+ * see if the preceding characters from the file match the
+ * characters from the string.
+ */
+ for (fileIndex = cur-1, stringIndex = length-2;
+ stringIndex >= 0; fileIndex--, stringIndex--) {
+ if (fileIndex < 0) {
+ fileIndex = BUFFER_SIZE-1;
+ }
+ if (buffer[fileIndex] != s[stringIndex]) {
+ goto noMatch;
+ }
+ }
+
+ /*
+ * Matched! Backup to the start of the string, then
+ * overwrite it with the replacement value.
+ */
+
+ if (fseek(f, -length, SEEK_CUR) == -1) {
+ goto ioError;
+ }
+ if (fwrite(argv[3], strlen(argv[3])+1, 1, f) == 0) {
+ goto ioError;
+ }
+ exit(0);
+ }
+
+ /*
+ * No match; go on to next character of file.
+ */
+
+ noMatch:
+ cur++;
+ if (cur >= BUFFER_SIZE) {
+ cur = 0;
+ }
+ }
+
+ ioError:
+ fprintf(stderr, "I/O error: %s\n", strerror(errno));
+ exit(1);
+}
diff --git a/tcl/unix/configure b/tcl/unix/configure
index 4f5601eb879..bfeb216565b 100755
--- a/tcl/unix/configure
+++ b/tcl/unix/configure
@@ -12,9 +12,17 @@ ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
ac_help="$ac_help
+ --enable-threads build with threads"
+ac_help="$ac_help
+ --enable-64bit enable 64bit support (where applicable)"
+ac_help="$ac_help
+ --enable-64bit-vis enable 64bit Sparc VIS support"
+ac_help="$ac_help
--disable-load disallow dynamic loading and "load" command"
ac_help="$ac_help
- --enable-shared build libtcl as a shared library"
+ --enable-symbols build with debugging symbols [--disable-symbols]"
+ac_help="$ac_help
+ --enable-shared build and link with shared libraries [--enable-shared]"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -32,6 +40,7 @@ program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
+sitefile=
srcdir=
target=NONE
verbose=
@@ -146,6 +155,7 @@ Configuration:
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
+ --site-file=FILE use FILE as the site file
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
@@ -316,6 +326,11 @@ EOF
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
+ -site-file | --site-file | --site-fil | --site-fi | --site-f)
+ ac_prev=sitefile ;;
+ -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
+ sitefile="$ac_optarg" ;;
+
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
@@ -481,12 +496,16 @@ fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+if test -z "$sitefile"; then
+ if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
fi
+else
+ CONFIG_SITE="$sitefile"
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
@@ -525,14 +544,18 @@ else
fi
-# SCCS: @(#) configure.in 1.18 98/08/12 17:29:39
+# RCS: @(#) $Id$
-TCL_VERSION=8.0
+TCL_VERSION=8.3
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL=".3"
+TCL_MINOR_VERSION=3
+TCL_PATCH_LEVEL=".2"
VERSION=${TCL_VERSION}
+#------------------------------------------------------------------------
+# Handle the --prefix=... option
+#------------------------------------------------------------------------
+
if test "${prefix}" = "NONE"; then
prefix=/usr/local
fi
@@ -541,40 +564,14 @@ if test "${exec_prefix}" = "NONE"; then
fi
TCL_SRC_DIR=`cd $srcdir/..; pwd`
-# Extract the first word of "ranlib", so it can be a program name with args.
-set dummy ranlib; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:548: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test -n "$RANLIB"; then
- ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_RANLIB="ranlib"
- break
- fi
- done
- IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
-fi
-fi
-RANLIB="$ac_cv_prog_RANLIB"
-if test -n "$RANLIB"; then
- echo "$ac_t""$RANLIB" 1>&6
-else
- echo "$ac_t""no" 1>&6
-fi
+#------------------------------------------------------------------------
+# Standard compiler checks
+#------------------------------------------------------------------------
- # Extract the first word of "gcc", so it can be a program name with args.
+# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:578: checking for $ac_word" >&5
+echo "configure:575: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -604,7 +601,7 @@ if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:608: checking for $ac_word" >&5
+echo "configure:605: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -655,7 +652,7 @@ fi
# Extract the first word of "cl", so it can be a program name with args.
set dummy cl; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:659: checking for $ac_word" >&5
+echo "configure:656: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -687,7 +684,7 @@ fi
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:691: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+echo "configure:688: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
@@ -698,12 +695,12 @@ cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext << EOF
-#line 702 "configure"
+#line 699 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
-if { (eval echo configure:707: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:704: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
ac_cv_prog_cc_works=yes
# If we can't run a trivial program, we are probably using a cross compiler.
if (./conftest; exit) 2>/dev/null; then
@@ -729,12 +726,12 @@ if test $ac_cv_prog_cc_works = no; then
{ echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
-echo "configure:733: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "configure:730: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:738: checking whether we are using GNU C" >&5
+echo "configure:735: checking whether we are using GNU C" >&5
if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -743,7 +740,7 @@ else
yes;
#endif
EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:747: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:744: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
ac_cv_prog_gcc=yes
else
ac_cv_prog_gcc=no
@@ -762,7 +759,7 @@ ac_test_CFLAGS="${CFLAGS+set}"
ac_save_CFLAGS="$CFLAGS"
CFLAGS=
echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
-echo "configure:766: checking whether ${CC-cc} accepts -g" >&5
+echo "configure:763: checking whether ${CC-cc} accepts -g" >&5
if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -793,6 +790,157 @@ else
fi
fi
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:797: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:826: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 841 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:847: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 858 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:864: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 875 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:881: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+for ac_hdr in unistd.h limits.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:909: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 914 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:919: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
# CYGNUS LOCAL
# dje/win32
@@ -829,7 +977,7 @@ ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
# ./install, which can be erroneously created by make from ./install.sh.
echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
-echo "configure:833: checking for a BSD compatible install" >&5
+echo "configure:981: checking for a BSD compatible install" >&5
if test -z "$INSTALL"; then
if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -893,94 +1041,14 @@ test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
# This modifies the value of $CC to have the POSIX flag added
# so everything will configure correctly.
#--------------------------------------------------------------------
-echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:898: checking how to run the C preprocessor" >&5
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
-fi
-if test -z "$CPP"; then
-if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- # This must be in double quotes, not single quotes, because CPP may get
- # substituted into the Makefile and "${CC-cc}" will confuse make.
- CPP="${CC-cc} -E"
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp.
- cat > conftest.$ac_ext <<EOF
-#line 913 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:919: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- :
-else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- CPP="${CC-cc} -E -traditional-cpp"
- cat > conftest.$ac_ext <<EOF
-#line 930 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:936: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- :
-else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- CPP="${CC-cc} -nologo -E"
- cat > conftest.$ac_ext <<EOF
-#line 947 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:953: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- :
-else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- CPP=/lib/cpp
-fi
-rm -f conftest*
-fi
-rm -f conftest*
-fi
-rm -f conftest*
- ac_cv_prog_CPP="$CPP"
-fi
- CPP="$ac_cv_prog_CPP"
-else
- ac_cv_prog_CPP="$CPP"
-fi
-echo "$ac_t""$CPP" 1>&6
-
echo $ac_n "checking to see if this is LynxOS""... $ac_c" 1>&6
-echo "configure:979: checking to see if this is LynxOS" >&5
+echo "configure:1047: checking to see if this is LynxOS" >&5
if eval "test \"`echo '$''{'ac_cv_os_lynx'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 984 "configure"
+#line 1052 "configure"
#include "confdefs.h"
/*
* The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
@@ -1010,12 +1078,12 @@ if test "$ac_cv_os_lynx" = "yes" ; then
EOF
echo $ac_n "checking whether -mposix or -X is available""... $ac_c" 1>&6
-echo "configure:1014: checking whether -mposix or -X is available" >&5
+echo "configure:1082: checking whether -mposix or -X is available" >&5
if eval "test \"`echo '$''{'ac_cv_c_posix_flag'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1019 "configure"
+#line 1087 "configure"
#include "confdefs.h"
int main() {
@@ -1031,7 +1099,7 @@ int main() {
; return 0; }
EOF
-if { (eval echo configure:1035: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1103: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_c_posix_flag=" -mposix"
else
@@ -1050,11 +1118,319 @@ fi
fi
-# set the warning flags depending on whether or not we are using gcc
-if test "${GCC}" = "yes" ; then
- CFLAGS_WARNING="-Wall -Wconversion"
+#------------------------------------------------------------------------
+# Threads support
+#------------------------------------------------------------------------
+
+
+ echo $ac_n "checking for building with threads""... $ac_c" 1>&6
+echo "configure:1128: checking for building with threads" >&5
+ # Check whether --enable-threads or --disable-threads was given.
+if test "${enable_threads+set}" = set; then
+ enableval="$enable_threads"
+ tcl_ok=$enableval
+else
+ tcl_ok=no
+fi
+
+
+ if test "$tcl_ok" = "yes"; then
+ echo "$ac_t""yes" 1>&6
+ TCL_THREADS=1
+ cat >> confdefs.h <<\EOF
+#define TCL_THREADS 1
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define _REENTRANT 1
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define _THREAD_SAFE 1
+EOF
+
+ echo $ac_n "checking for pthread_mutex_init in -lpthread""... $ac_c" 1>&6
+echo "configure:1154: checking for pthread_mutex_init in -lpthread" >&5
+ac_lib_var=`echo pthread'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpthread $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1162 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char pthread_mutex_init();
+
+int main() {
+pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1173: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "no"; then
+ # Check a little harder for __pthread_mutex_init in the same
+ # library, as some systems hide it there until pthread.h is
+ # defined. We could alternatively do an AC_TRY_COMPILE with
+ # pthread.h, but that will work with libpthread really doesn't
+ # exist, like AIX 4.2. [Bug: 4359]
+ echo $ac_n "checking for __pthread_mutex_init in -lpthread""... $ac_c" 1>&6
+echo "configure:1201: checking for __pthread_mutex_init in -lpthread" >&5
+ac_lib_var=`echo pthread'_'__pthread_mutex_init | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpthread $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1209 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char __pthread_mutex_init();
+
+int main() {
+__pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1220: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthread"
+ else
+ echo $ac_n "checking for pthread_mutex_init in -lpthreads""... $ac_c" 1>&6
+echo "configure:1248: checking for pthread_mutex_init in -lpthreads" >&5
+ac_lib_var=`echo pthreads'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpthreads $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1256 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char pthread_mutex_init();
+
+int main() {
+pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1267: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthreads"
+ else
+ echo $ac_n "checking for pthread_mutex_init in -lc""... $ac_c" 1>&6
+echo "configure:1293: checking for pthread_mutex_init in -lc" >&5
+ac_lib_var=`echo c'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lc $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1301 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char pthread_mutex_init();
+
+int main() {
+pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1312: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "no"; then
+ TCL_THREADS=0
+ echo "configure: warning: "Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..."" 1>&2
+ fi
+ fi
+ fi
+
+ # Does the pthread-implementation provide
+ # 'pthread_attr_setstacksize' ?
+
+ for ac_func in pthread_attr_setstacksize
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1346: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1351 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1374: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+ else
+ TCL_THREADS=0
+ echo "$ac_t""no (default)" 1>&6
+ fi
+
+
+#------------------------------------------------------------------------
+# If we're using GCC, see if the compiler understands -pipe. If so, use it.
+# It makes compiling go faster. (This is only a performance feature.)
+#------------------------------------------------------------------------
+
+if test -z "$no_pipe"; then
+if test -n "$GCC"; then
+ echo $ac_n "checking if the compiler understands -pipe""... $ac_c" 1>&6
+echo "configure:1412: checking if the compiler understands -pipe" >&5
+ OLDCC="$CC"
+ CC="$CC -pipe"
+ cat > conftest.$ac_ext <<EOF
+#line 1416 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1423: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6
else
- CFLAGS_WARNING=""
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CC="$OLDCC"
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+fi
fi
#--------------------------------------------------------------------
@@ -1066,12 +1442,12 @@ fi
for ac_func in getcwd
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1070: checking for $ac_func" >&5
+echo "configure:1446: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1075 "configure"
+#line 1451 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1094,7 +1470,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1098: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1474: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@@ -1128,12 +1504,12 @@ done
for ac_func in opendir strstr
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1132: checking for $ac_func" >&5
+echo "configure:1508: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1137 "configure"
+#line 1513 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1156,7 +1532,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1160: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1536: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@@ -1186,12 +1562,12 @@ done
for ac_func in strtol tmpnam waitpid
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1190: checking for $ac_func" >&5
+echo "configure:1566: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1195 "configure"
+#line 1571 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1214,7 +1590,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1218: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1594: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@@ -1241,12 +1617,12 @@ done
echo $ac_n "checking for strerror""... $ac_c" 1>&6
-echo "configure:1245: checking for strerror" >&5
+echo "configure:1621: checking for strerror" >&5
if eval "test \"`echo '$''{'ac_cv_func_strerror'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1250 "configure"
+#line 1626 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strerror(); below. */
@@ -1269,7 +1645,7 @@ strerror();
; return 0; }
EOF
-if { (eval echo configure:1273: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1649: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strerror=yes"
else
@@ -1293,12 +1669,12 @@ EOF
fi
echo $ac_n "checking for getwd""... $ac_c" 1>&6
-echo "configure:1297: checking for getwd" >&5
+echo "configure:1673: checking for getwd" >&5
if eval "test \"`echo '$''{'ac_cv_func_getwd'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1302 "configure"
+#line 1678 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char getwd(); below. */
@@ -1321,7 +1697,7 @@ getwd();
; return 0; }
EOF
-if { (eval echo configure:1325: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1701: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_getwd=yes"
else
@@ -1345,12 +1721,12 @@ EOF
fi
echo $ac_n "checking for wait3""... $ac_c" 1>&6
-echo "configure:1349: checking for wait3" >&5
+echo "configure:1725: checking for wait3" >&5
if eval "test \"`echo '$''{'ac_cv_func_wait3'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1354 "configure"
+#line 1730 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char wait3(); below. */
@@ -1373,7 +1749,7 @@ wait3();
; return 0; }
EOF
-if { (eval echo configure:1377: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1753: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_wait3=yes"
else
@@ -1397,12 +1773,12 @@ EOF
fi
echo $ac_n "checking for uname""... $ac_c" 1>&6
-echo "configure:1401: checking for uname" >&5
+echo "configure:1777: checking for uname" >&5
if eval "test \"`echo '$''{'ac_cv_func_uname'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1406 "configure"
+#line 1782 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char uname(); below. */
@@ -1425,7 +1801,7 @@ uname();
; return 0; }
EOF
-if { (eval echo configure:1429: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1805: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_uname=yes"
else
@@ -1448,153 +1824,58 @@ EOF
fi
-
-#--------------------------------------------------------------------
-# On a few very rare systems, all of the libm.a stuff is
-# already in libc.a. Set compiler flags accordingly.
-# Also, Linux requires the "ieee" library for math to work
-# right (and it must appear before "-lm").
-#--------------------------------------------------------------------
-
-echo $ac_n "checking for sin""... $ac_c" 1>&6
-echo "configure:1461: checking for sin" >&5
-if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
+echo $ac_n "checking for realpath""... $ac_c" 1>&6
+echo "configure:1829: checking for realpath" >&5
+if eval "test \"`echo '$''{'ac_cv_func_realpath'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1466 "configure"
+#line 1834 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char sin(); below. */
+ which can conflict with char realpath(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
-char sin();
+char realpath();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
-#if defined (__stub_sin) || defined (__stub___sin)
+#if defined (__stub_realpath) || defined (__stub___realpath)
choke me
#else
-sin();
+realpath();
#endif
; return 0; }
EOF
-if { (eval echo configure:1489: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1857: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
- eval "ac_cv_func_sin=yes"
+ eval "ac_cv_func_realpath=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- eval "ac_cv_func_sin=no"
+ eval "ac_cv_func_realpath=no"
fi
rm -f conftest*
fi
-if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then
+if eval "test \"`echo '$ac_cv_func_'realpath`\" = yes"; then
echo "$ac_t""yes" 1>&6
- MATH_LIBS=""
-else
- echo "$ac_t""no" 1>&6
-MATH_LIBS="-lm"
-fi
-
-echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
-echo "configure:1510: checking for main in -lieee" >&5
-ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'`
-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- ac_save_LIBS="$LIBS"
-LIBS="-lieee $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 1518 "configure"
-#include "confdefs.h"
-
-int main() {
-main()
-; return 0; }
-EOF
-if { (eval echo configure:1525: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=no"
-fi
-rm -f conftest*
-LIBS="$ac_save_LIBS"
-
-fi
-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- MATH_LIBS="-lieee $MATH_LIBS"
+ :
else
echo "$ac_t""no" 1>&6
-fi
-
-
-#--------------------------------------------------------------------
-# On AIX systems, libbsd.a has to be linked in to support
-# non-blocking file IO. This library has to be linked in after
-# the MATH_LIBS or it breaks the pow() function. The way to
-# insure proper sequencing, is to add it to the tail of MATH_LIBS.
-# This library also supplies gettimeofday.
-#--------------------------------------------------------------------
-libbsd=no
-if test "`uname -s`" = "AIX" ; then
- echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
-echo "configure:1556: checking for gettimeofday in -lbsd" >&5
-ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- ac_save_LIBS="$LIBS"
-LIBS="-lbsd $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 1564 "configure"
-#include "confdefs.h"
-/* Override any gcc2 internal prototype to avoid an error. */
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char gettimeofday();
-
-int main() {
-gettimeofday()
-; return 0; }
+cat >> confdefs.h <<\EOF
+#define NO_REALPATH 1
EOF
-if { (eval echo configure:1575: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=no"
-fi
-rm -f conftest*
-LIBS="$ac_save_LIBS"
fi
-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- libbsd=yes
-else
- echo "$ac_t""no" 1>&6
-fi
- if test $libbsd = yes; then
- MATH_LIBS="$MATH_LIBS -lbsd"
- fi
-fi
#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files. Special
@@ -1605,10 +1886,12 @@ fi
# as strstr
#--------------------------------------------------------------------
-echo $ac_n "checking dirent.h""... $ac_c" 1>&6
-echo "configure:1610: checking dirent.h" >&5
-cat > conftest.$ac_ext <<EOF
-#line 1612 "configure"
+
+
+ echo $ac_n "checking dirent.h""... $ac_c" 1>&6
+echo "configure:1893: checking dirent.h" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 1895 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <dirent.h>
@@ -1634,7 +1917,7 @@ closedir(d);
; return 0; }
EOF
-if { (eval echo configure:1638: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1921: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
tcl_ok=yes
else
@@ -1644,26 +1927,28 @@ else
tcl_ok=no
fi
rm -f conftest*
-if test $tcl_ok = no; then
- cat >> confdefs.h <<\EOF
+
+ if test $tcl_ok = no; then
+ cat >> confdefs.h <<\EOF
#define NO_DIRENT_H 1
EOF
-fi
-echo "$ac_t""$tcl_ok" 1>&6
-ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
+ fi
+
+ echo "$ac_t""$tcl_ok" 1>&6
+ ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for errno.h""... $ac_c" 1>&6
-echo "configure:1657: checking for errno.h" >&5
+echo "configure:1942: checking for errno.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1662 "configure"
+#line 1947 "configure"
#include "confdefs.h"
#include <errno.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1667: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1952: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -1688,19 +1973,19 @@ EOF
fi
-ac_safe=`echo "float.h" | sed 'y%./+-%__p_%'`
+ ac_safe=`echo "float.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for float.h""... $ac_c" 1>&6
-echo "configure:1694: checking for float.h" >&5
+echo "configure:1979: checking for float.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1699 "configure"
+#line 1984 "configure"
#include "confdefs.h"
#include <float.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1704: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1989: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -1725,19 +2010,19 @@ EOF
fi
-ac_safe=`echo "values.h" | sed 'y%./+-%__p_%'`
+ ac_safe=`echo "values.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for values.h""... $ac_c" 1>&6
-echo "configure:1731: checking for values.h" >&5
+echo "configure:2016: checking for values.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1736 "configure"
+#line 2021 "configure"
#include "confdefs.h"
#include <values.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1741: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2026: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -1762,19 +2047,19 @@ EOF
fi
-ac_safe=`echo "limits.h" | sed 'y%./+-%__p_%'`
+ ac_safe=`echo "limits.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for limits.h""... $ac_c" 1>&6
-echo "configure:1768: checking for limits.h" >&5
+echo "configure:2053: checking for limits.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1773 "configure"
+#line 2058 "configure"
#include "confdefs.h"
#include <limits.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1778: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2063: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -1799,19 +2084,19 @@ EOF
fi
-ac_safe=`echo "stdlib.h" | sed 'y%./+-%__p_%'`
+ ac_safe=`echo "stdlib.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for stdlib.h""... $ac_c" 1>&6
-echo "configure:1805: checking for stdlib.h" >&5
+echo "configure:2090: checking for stdlib.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1810 "configure"
+#line 2095 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1815: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2100: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -1833,8 +2118,8 @@ else
tcl_ok=0
fi
-cat > conftest.$ac_ext <<EOF
-#line 1838 "configure"
+ cat > conftest.$ac_ext <<EOF
+#line 2123 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -1847,8 +2132,8 @@ else
fi
rm -f conftest*
-cat > conftest.$ac_ext <<EOF
-#line 1852 "configure"
+ cat > conftest.$ac_ext <<EOF
+#line 2137 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -1861,8 +2146,8 @@ else
fi
rm -f conftest*
-cat > conftest.$ac_ext <<EOF
-#line 1866 "configure"
+ cat > conftest.$ac_ext <<EOF
+#line 2151 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -1875,25 +2160,25 @@ else
fi
rm -f conftest*
-if test $tcl_ok = 0; then
- cat >> confdefs.h <<\EOF
+ if test $tcl_ok = 0; then
+ cat >> confdefs.h <<\EOF
#define NO_STDLIB_H 1
EOF
-fi
-ac_safe=`echo "string.h" | sed 'y%./+-%__p_%'`
+ fi
+ ac_safe=`echo "string.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for string.h""... $ac_c" 1>&6
-echo "configure:1887: checking for string.h" >&5
+echo "configure:2172: checking for string.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1892 "configure"
+#line 2177 "configure"
#include "confdefs.h"
#include <string.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1897: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2182: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -1915,8 +2200,8 @@ else
tcl_ok=0
fi
-cat > conftest.$ac_ext <<EOF
-#line 1920 "configure"
+ cat > conftest.$ac_ext <<EOF
+#line 2205 "configure"
#include "confdefs.h"
#include <string.h>
EOF
@@ -1929,8 +2214,8 @@ else
fi
rm -f conftest*
-cat > conftest.$ac_ext <<EOF
-#line 1934 "configure"
+ cat > conftest.$ac_ext <<EOF
+#line 2219 "configure"
#include "confdefs.h"
#include <string.h>
EOF
@@ -1943,25 +2228,30 @@ else
fi
rm -f conftest*
-if test $tcl_ok = 0; then
- cat >> confdefs.h <<\EOF
+
+ # See also memmove check below for a place where NO_STRING_H can be
+ # set and why.
+
+ if test $tcl_ok = 0; then
+ cat >> confdefs.h <<\EOF
#define NO_STRING_H 1
EOF
-fi
-ac_safe=`echo "sys/wait.h" | sed 'y%./+-%__p_%'`
+ fi
+
+ ac_safe=`echo "sys/wait.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for sys/wait.h""... $ac_c" 1>&6
-echo "configure:1955: checking for sys/wait.h" >&5
+echo "configure:2245: checking for sys/wait.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1960 "configure"
+#line 2250 "configure"
#include "confdefs.h"
#include <sys/wait.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1965: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2255: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -1986,19 +2276,19 @@ EOF
fi
-ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
+ ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
-echo "configure:1992: checking for dlfcn.h" >&5
+echo "configure:2282: checking for dlfcn.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1997 "configure"
+#line 2287 "configure"
#include "confdefs.h"
#include <dlfcn.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2002: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2292: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2023,21 +2313,24 @@ EOF
fi
-for ac_hdr in unistd.h
+
+ # OS/390 lacks sys/param.h (and doesn't need it, by chance).
+
+ for ac_hdr in unistd.h sys/param.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:2031: checking for $ac_hdr" >&5
+echo "configure:2324: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2036 "configure"
+#line 2329 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2041: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2334: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2064,19 +2357,23 @@ fi
done
+
+
#---------------------------------------------------------------------------
# Determine which interface to use to talk to the serial port.
# Note that #include lines must begin in leftmost column for
# some compilers to recognize them as preprocessor directives.
#---------------------------------------------------------------------------
-echo $ac_n "checking termios vs. termio vs. sgtty""... $ac_c" 1>&6
-echo "configure:2075: checking termios vs. termio vs. sgtty" >&5
-if test "$cross_compiling" = yes; then
+
+ echo $ac_n "checking termios vs. termio vs. sgtty""... $ac_c" 1>&6
+echo "configure:2371: checking termios vs. termio vs. sgtty" >&5
+
+ if test "$cross_compiling" = yes; then
tk_ok=no
else
cat > conftest.$ac_ext <<EOF
-#line 2080 "configure"
+#line 2377 "configure"
#include "confdefs.h"
#include <termios.h>
@@ -2092,7 +2389,7 @@ main()
return 1;
}
EOF
-if { (eval echo configure:2096: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:2393: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
tk_ok=termios
else
@@ -2104,17 +2401,18 @@ fi
rm -fr conftest*
fi
-if test $tk_ok = termios; then
- cat >> confdefs.h <<\EOF
+
+ if test $tk_ok = termios; then
+ cat >> confdefs.h <<\EOF
#define USE_TERMIOS 1
EOF
-else
-if test "$cross_compiling" = yes; then
+ else
+ if test "$cross_compiling" = yes; then
tk_ok=no
else
cat > conftest.$ac_ext <<EOF
-#line 2118 "configure"
+#line 2416 "configure"
#include "confdefs.h"
#include <termio.h>
@@ -2127,9 +2425,9 @@ main()
return 0;
}
return 1;
-}
+ }
EOF
-if { (eval echo configure:2133: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:2431: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
tk_ok=termio
else
@@ -2141,17 +2439,18 @@ fi
rm -fr conftest*
fi
-if test $tk_ok = termio; then
- cat >> confdefs.h <<\EOF
+
+ if test $tk_ok = termio; then
+ cat >> confdefs.h <<\EOF
#define USE_TERMIO 1
EOF
-else
-if test "$cross_compiling" = yes; then
+ else
+ if test "$cross_compiling" = yes; then
tk_ok=none
else
cat > conftest.$ac_ext <<EOF
-#line 2155 "configure"
+#line 2454 "configure"
#include "confdefs.h"
#include <sgtty.h>
@@ -2167,7 +2466,7 @@ main()
return 1;
}
EOF
-if { (eval echo configure:2171: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:2470: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
tk_ok=sgtty
else
@@ -2179,15 +2478,16 @@ fi
rm -fr conftest*
fi
-if test $tk_ok = sgtty; then
- cat >> confdefs.h <<\EOF
+ if test $tk_ok = sgtty; then
+ cat >> confdefs.h <<\EOF
#define USE_SGTTY 1
EOF
-fi
-fi
-fi
-echo "$ac_t""$tk_ok" 1>&6
+ fi
+ fi
+ fi
+ echo "$ac_t""$tk_ok" 1>&6
+
#--------------------------------------------------------------------
# Include sys/select.h if it exists and if it supplies things
@@ -2200,16 +2500,16 @@ echo "$ac_t""$tk_ok" 1>&6
#--------------------------------------------------------------------
echo $ac_n "checking fd_set and sys/select""... $ac_c" 1>&6
-echo "configure:2204: checking fd_set and sys/select" >&5
+echo "configure:2504: checking fd_set and sys/select" >&5
cat > conftest.$ac_ext <<EOF
-#line 2206 "configure"
+#line 2506 "configure"
#include "confdefs.h"
#include <sys/types.h>
int main() {
fd_set readMask, writeMask;
; return 0; }
EOF
-if { (eval echo configure:2213: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2513: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tk_ok=yes
else
@@ -2221,7 +2521,7 @@ fi
rm -f conftest*
if test $tk_ok = no; then
cat > conftest.$ac_ext <<EOF
-#line 2225 "configure"
+#line 2525 "configure"
#include "confdefs.h"
#include <sys/select.h>
EOF
@@ -2251,21 +2551,56 @@ fi
# Find out all about time handling differences.
#------------------------------------------------------------------------------
-for ac_hdr in sys/time.h
+echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
+echo "configure:2556: checking whether struct tm is in sys/time.h or time.h" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2561 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <time.h>
+int main() {
+struct tm *tp; tp->tm_sec;
+; return 0; }
+EOF
+if { (eval echo configure:2569: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_struct_tm=time.h
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_struct_tm=sys/time.h
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_tm" 1>&6
+if test $ac_cv_struct_tm = sys/time.h; then
+ cat >> confdefs.h <<\EOF
+#define TM_IN_SYS_TIME 1
+EOF
+
+fi
+
+
+ for ac_hdr in sys/time.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:2259: checking for $ac_hdr" >&5
+echo "configure:2594: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2264 "configure"
+#line 2599 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2269: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2604: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2291,13 +2626,13 @@ else
fi
done
-echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
-echo "configure:2296: checking whether time.h and sys/time.h may both be included" >&5
+ echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
+echo "configure:2631: checking whether time.h and sys/time.h may both be included" >&5
if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2301 "configure"
+#line 2636 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/time.h>
@@ -2306,7 +2641,7 @@ int main() {
struct tm *tp;
; return 0; }
EOF
-if { (eval echo configure:2310: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2645: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_header_time=yes
else
@@ -2326,47 +2661,13 @@ EOF
fi
-echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
-echo "configure:2331: checking whether struct tm is in sys/time.h or time.h" >&5
-if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 2336 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <time.h>
-int main() {
-struct tm *tp; tp->tm_sec;
-; return 0; }
-EOF
-if { (eval echo configure:2344: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_struct_tm=time.h
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_struct_tm=sys/time.h
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_struct_tm" 1>&6
-if test $ac_cv_struct_tm = sys/time.h; then
- cat >> confdefs.h <<\EOF
-#define TM_IN_SYS_TIME 1
-EOF
-
-fi
-
-echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6
-echo "configure:2365: checking for tm_zone in struct tm" >&5
+ echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6
+echo "configure:2666: checking for tm_zone in struct tm" >&5
if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2370 "configure"
+#line 2671 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <$ac_cv_struct_tm>
@@ -2374,7 +2675,7 @@ int main() {
struct tm tm; tm.tm_zone;
; return 0; }
EOF
-if { (eval echo configure:2378: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2679: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_tm_zone=yes
else
@@ -2394,12 +2695,12 @@ EOF
else
echo $ac_n "checking for tzname""... $ac_c" 1>&6
-echo "configure:2398: checking for tzname" >&5
+echo "configure:2699: checking for tzname" >&5
if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2403 "configure"
+#line 2704 "configure"
#include "confdefs.h"
#include <time.h>
#ifndef tzname /* For SGI. */
@@ -2409,7 +2710,7 @@ int main() {
atoi(*tzname);
; return 0; }
EOF
-if { (eval echo configure:2413: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2714: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
ac_cv_var_tzname=yes
else
@@ -2431,23 +2732,23 @@ EOF
fi
-echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6
-echo "configure:2436: checking tm_tzadj in struct tm" >&5
-cat > conftest.$ac_ext <<EOF
-#line 2438 "configure"
+ echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6
+echo "configure:2737: checking tm_tzadj in struct tm" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 2739 "configure"
#include "confdefs.h"
#include <time.h>
int main() {
struct tm tm; tm.tm_tzadj;
; return 0; }
EOF
-if { (eval echo configure:2445: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2746: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
cat >> confdefs.h <<\EOF
#define HAVE_TM_TZADJ 1
EOF
- echo "$ac_t""yes" 1>&6
+ echo "$ac_t""yes" 1>&6
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
@@ -2456,23 +2757,23 @@ else
fi
rm -f conftest*
-echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6
-echo "configure:2461: checking tm_gmtoff in struct tm" >&5
-cat > conftest.$ac_ext <<EOF
-#line 2463 "configure"
+ echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6
+echo "configure:2762: checking tm_gmtoff in struct tm" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 2764 "configure"
#include "confdefs.h"
#include <time.h>
int main() {
struct tm tm; tm.tm_gmtoff;
; return 0; }
EOF
-if { (eval echo configure:2470: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2771: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
cat >> confdefs.h <<\EOF
#define HAVE_TM_GMTOFF 1
EOF
- echo "$ac_t""yes" 1>&6
+ echo "$ac_t""yes" 1>&6
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
@@ -2481,31 +2782,31 @@ else
fi
rm -f conftest*
-#
-# Its important to include time.h in this check, as some systems (like convex)
-# have timezone functions, etc.
-#
-have_timezone=no
-echo $ac_n "checking long timezone variable""... $ac_c" 1>&6
-echo "configure:2491: checking long timezone variable" >&5
-cat > conftest.$ac_ext <<EOF
-#line 2493 "configure"
+ #
+ # Its important to include time.h in this check, as some systems
+ # (like convex) have timezone functions, etc.
+ #
+ have_timezone=no
+ echo $ac_n "checking long timezone variable""... $ac_c" 1>&6
+echo "configure:2792: checking long timezone variable" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 2794 "configure"
#include "confdefs.h"
#include <time.h>
int main() {
extern long timezone;
- timezone += 1;
- exit (0);
+ timezone += 1;
+ exit (0);
; return 0; }
EOF
-if { (eval echo configure:2502: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2803: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
have_timezone=yes
- cat >> confdefs.h <<\EOF
+ cat >> confdefs.h <<\EOF
#define HAVE_TIMEZONE_VAR 1
EOF
- echo "$ac_t""yes" 1>&6
+ echo "$ac_t""yes" 1>&6
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
@@ -2514,30 +2815,29 @@ else
fi
rm -f conftest*
-#
-# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
-#
-if test "$have_timezone" = no; then
- echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6
-echo "configure:2523: checking time_t timezone variable" >&5
- cat > conftest.$ac_ext <<EOF
-#line 2525 "configure"
+ #
+ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ #
+ if test "$have_timezone" = no; then
+ echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6
+echo "configure:2824: checking time_t timezone variable" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 2826 "configure"
#include "confdefs.h"
#include <time.h>
int main() {
extern time_t timezone;
- timezone += 1;
- exit (0);
+ timezone += 1;
+ exit (0);
; return 0; }
EOF
-if { (eval echo configure:2534: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2835: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
- have_timezone=yes
- cat >> confdefs.h <<\EOF
+ cat >> confdefs.h <<\EOF
#define HAVE_TIMEZONE_VAR 1
EOF
- echo "$ac_t""yes" 1>&6
+ echo "$ac_t""yes" 1>&6
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
@@ -2545,21 +2845,21 @@ else
echo "$ac_t""no" 1>&6
fi
rm -f conftest*
-fi
+ fi
-#
-# On some systems (eg Solaris 2.5.1, timezone is not declared in
-# time.h unless you jump through hoops. Instead of that, we just
-# declare it ourselves when necessary.
-#
-if test "$have_timezone" = yes; then
- echo $ac_n "checking for timezone declaration""... $ac_c" 1>&6
-echo "configure:2558: checking for timezone declaration" >&5
-
- tzrx='^[ ]*extern.*timezone'
-
- cat > conftest.$ac_ext <<EOF
-#line 2563 "configure"
+ #
+ # On some systems (eg Solaris 2.5.1), timezone is not declared in
+ # time.h unless you jump through hoops. Instead of that, we just
+ # declare it ourselves when necessary.
+ #
+ if test "$have_timezone" = yes; then
+ echo $ac_n "checking for timezone declaration""... $ac_c" 1>&6
+echo "configure:2858: checking for timezone declaration" >&5
+
+ tzrx='^[ ]*extern.*timezone'
+
+ cat > conftest.$ac_ext <<EOF
+#line 2863 "configure"
#include "confdefs.h"
#include <time.h>
EOF
@@ -2567,43 +2867,87 @@ if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "$tzrx" >/dev/null 2>&1; then
rm -rf conftest*
- cat >> confdefs.h <<\EOF
+ cat >> confdefs.h <<\EOF
#define HAVE_TIMEZONE_DECL 1
EOF
- echo "$ac_t""found" 1>&6
+ echo "$ac_t""found" 1>&6
else
rm -rf conftest*
echo "$ac_t""missing" 1>&6
fi
rm -f conftest*
+ fi
+
+ #
+ # AIX does not have a timezone field in struct tm. When the AIX bsd
+ # library is used, the timezone global and the gettimeofday methods are
+ # to be avoided for timezone deduction instead, we deduce the timezone
+ # by comparing the localtime result on a known GMT value.
+ #
+
+ if test "`uname -s`" = "AIX" ; then
+ echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
+echo "configure:2893: checking for gettimeofday in -lbsd" >&5
+ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lbsd $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2901 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gettimeofday();
+
+int main() {
+gettimeofday()
+; return 0; }
+EOF
+if { (eval echo configure:2912: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
-#
-# AIX does not have a timezone field in struct tm. When the AIX bsd
-# library is used, the timezone global and the gettimeofday methods are
-# to be avoided for timezone deduction instead, we deduce the timezone
-# by comparing the localtime result on a known GMT value.
-#
-if test $libbsd = yes; then
- cat >> confdefs.h <<\EOF
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ libbsd=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $libbsd = yes; then
+ cat >> confdefs.h <<\EOF
#define USE_DELTA_FOR_TZ 1
EOF
-fi
+ fi
+ fi
+
#--------------------------------------------------------------------
# Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
-# in struct stat.
+# in struct stat. But we might be able to use fstatfs instead.
#--------------------------------------------------------------------
echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6
-echo "configure:2602: checking for st_blksize in struct stat" >&5
+echo "configure:2946: checking for st_blksize in struct stat" >&5
if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2607 "configure"
+#line 2951 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/stat.h>
@@ -2611,7 +2955,7 @@ int main() {
struct stat s; s.st_blksize;
; return 0; }
EOF
-if { (eval echo configure:2615: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2959: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_st_blksize=yes
else
@@ -2631,6 +2975,160 @@ EOF
fi
+echo $ac_n "checking for fstatfs""... $ac_c" 1>&6
+echo "configure:2980: checking for fstatfs" >&5
+if eval "test \"`echo '$''{'ac_cv_func_fstatfs'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2985 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char fstatfs(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char fstatfs();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_fstatfs) || defined (__stub___fstatfs)
+choke me
+#else
+fstatfs();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3008: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_fstatfs=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_fstatfs=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'fstatfs`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_FSTATFS 1
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+# Some system have no memcmp or it does not work with 8 bit
+# data, this checks it and add memcmp.o to LIBOBJS if needed
+#--------------------------------------------------------------------
+echo $ac_n "checking for 8-bit clean memcmp""... $ac_c" 1>&6
+echo "configure:3037: checking for 8-bit clean memcmp" >&5
+if eval "test \"`echo '$''{'ac_cv_func_memcmp_clean'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$cross_compiling" = yes; then
+ ac_cv_func_memcmp_clean=no
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3045 "configure"
+#include "confdefs.h"
+
+main()
+{
+ char c0 = 0x40, c1 = 0x80, c2 = 0x81;
+ exit(memcmp(&c0, &c2, 1) < 0 && memcmp(&c1, &c2, 1) < 0 ? 0 : 1);
+}
+
+EOF
+if { (eval echo configure:3055: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_func_memcmp_clean=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_func_memcmp_clean=no
+fi
+rm -fr conftest*
+fi
+
+fi
+
+echo "$ac_t""$ac_cv_func_memcmp_clean" 1>&6
+test $ac_cv_func_memcmp_clean = no && LIBOBJS="$LIBOBJS memcmp.${ac_objext}"
+
+
+#--------------------------------------------------------------------
+# Some system like SunOS 4 and other BSD like systems
+# have no memmove (we assume they have bcopy instead).
+# {The replacement define is in compat/string.h}
+#--------------------------------------------------------------------
+echo $ac_n "checking for memmove""... $ac_c" 1>&6
+echo "configure:3079: checking for memmove" >&5
+if eval "test \"`echo '$''{'ac_cv_func_memmove'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3084 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char memmove(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char memmove();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_memmove) || defined (__stub___memmove)
+choke me
+#else
+memmove();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3107: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_memmove=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_memmove=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'memmove`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_MEMMOVE 1
+EOF
+ cat >> confdefs.h <<\EOF
+#define NO_STRING_H 1
+EOF
+
+fi
+
#--------------------------------------------------------------------
# On some systems strstr is broken: it returns a pointer even
@@ -2638,12 +3136,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking proper strstr implementation""... $ac_c" 1>&6
-echo "configure:2642: checking proper strstr implementation" >&5
+echo "configure:3140: checking proper strstr implementation" >&5
if test "$cross_compiling" = yes; then
tcl_ok=no
else
cat > conftest.$ac_ext <<EOF
-#line 2647 "configure"
+#line 3145 "configure"
#include "confdefs.h"
extern int strstr();
@@ -2653,7 +3151,7 @@ int main()
}
EOF
-if { (eval echo configure:2657: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3155: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
tcl_ok=yes
else
@@ -2679,12 +3177,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for strtoul""... $ac_c" 1>&6
-echo "configure:2683: checking for strtoul" >&5
+echo "configure:3181: checking for strtoul" >&5
if eval "test \"`echo '$''{'ac_cv_func_strtoul'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2688 "configure"
+#line 3186 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtoul(); below. */
@@ -2707,7 +3205,7 @@ strtoul();
; return 0; }
EOF
-if { (eval echo configure:2711: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3209: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strtoul=yes"
else
@@ -2731,7 +3229,7 @@ if test "$cross_compiling" = yes; then
tcl_ok=0
else
cat > conftest.$ac_ext <<EOF
-#line 2735 "configure"
+#line 3233 "configure"
#include "confdefs.h"
extern int strtoul();
@@ -2747,7 +3245,7 @@ int main()
exit(0);
}
EOF
-if { (eval echo configure:2751: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3249: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@@ -2770,12 +3268,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for strtod""... $ac_c" 1>&6
-echo "configure:2774: checking for strtod" >&5
+echo "configure:3272: checking for strtod" >&5
if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2779 "configure"
+#line 3277 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtod(); below. */
@@ -2798,7 +3296,7 @@ strtod();
; return 0; }
EOF
-if { (eval echo configure:2802: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3300: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strtod=yes"
else
@@ -2822,7 +3320,7 @@ if test "$cross_compiling" = yes; then
tcl_ok=0
else
cat > conftest.$ac_ext <<EOF
-#line 2826 "configure"
+#line 3324 "configure"
#include "confdefs.h"
extern double strtod();
@@ -2838,7 +3336,7 @@ int main()
exit(0);
}
EOF
-if { (eval echo configure:2842: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3340: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@@ -2862,13 +3360,14 @@ fi
# "fixstrtod" that corrects the error.
#--------------------------------------------------------------------
-echo $ac_n "checking for strtod""... $ac_c" 1>&6
-echo "configure:2867: checking for strtod" >&5
+
+ echo $ac_n "checking for strtod""... $ac_c" 1>&6
+echo "configure:3366: checking for strtod" >&5
if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2872 "configure"
+#line 3371 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtod(); below. */
@@ -2891,7 +3390,7 @@ strtod();
; return 0; }
EOF
-if { (eval echo configure:2895: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3394: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strtod=yes"
else
@@ -2911,29 +3410,34 @@ else
tcl_strtod=0
fi
-if test "$tcl_strtod" = 1; then
- echo $ac_n "checking for Solaris strtod bug""... $ac_c" 1>&6
-echo "configure:2917: checking for Solaris strtod bug" >&5
- if test "$cross_compiling" = yes; then
+ if test "$tcl_strtod" = 1; then
+ echo $ac_n "checking for Solaris2.4/Tru64 strtod bugs""... $ac_c" 1>&6
+echo "configure:3416: checking for Solaris2.4/Tru64 strtod bugs" >&5
+ if test "$cross_compiling" = yes; then
tcl_ok=0
else
cat > conftest.$ac_ext <<EOF
-#line 2922 "configure"
+#line 3421 "configure"
#include "confdefs.h"
-extern double strtod();
-int main()
-{
- char *string = "NaN";
- char *term;
- strtod(string, &term);
- if ((term != string) && (term[-1] == 0)) {
- exit(1);
- }
- exit(0);
-}
-EOF
-if { (eval echo configure:2937: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN", *spaceString = " ";
+ char *term;
+ double value;
+ value = strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(spaceString, &term);
+ if (term == (spaceString+1)) {
+ exit(1);
+ }
+ exit(0);
+ }
+EOF
+if { (eval echo configure:3441: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
tcl_ok=1
else
@@ -2945,17 +3449,18 @@ fi
rm -fr conftest*
fi
- if test $tcl_ok = 1; then
- echo "$ac_t""ok" 1>&6
- else
- echo "$ac_t""buggy" 1>&6
- LIBOBJS="$LIBOBJS fixstrtod.o"
- cat >> confdefs.h <<\EOF
+ if test "$tcl_ok" = 1; then
+ echo "$ac_t""ok" 1>&6
+ else
+ echo "$ac_t""buggy" 1>&6
+ LIBOBJS="$LIBOBJS fixstrtod.o"
+ cat >> confdefs.h <<\EOF
#define strtod fixstrtod
EOF
+ fi
fi
-fi
+
#--------------------------------------------------------------------
# Check for various typedefs and provide substitutes if
@@ -2963,12 +3468,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
-echo "configure:2967: checking for ANSI C header files" >&5
+echo "configure:3472: checking for ANSI C header files" >&5
if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2972 "configure"
+#line 3477 "configure"
#include "confdefs.h"
#include <stdlib.h>
#include <stdarg.h>
@@ -2976,7 +3481,7 @@ else
#include <float.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2980: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:3485: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2993,7 +3498,7 @@ rm -f conftest*
if test $ac_cv_header_stdc = yes; then
# SunOS 4.x string.h does not declare mem*, contrary to ANSI.
cat > conftest.$ac_ext <<EOF
-#line 2997 "configure"
+#line 3502 "configure"
#include "confdefs.h"
#include <string.h>
EOF
@@ -3011,7 +3516,7 @@ fi
if test $ac_cv_header_stdc = yes; then
# ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
cat > conftest.$ac_ext <<EOF
-#line 3015 "configure"
+#line 3520 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -3032,7 +3537,7 @@ if test "$cross_compiling" = yes; then
:
else
cat > conftest.$ac_ext <<EOF
-#line 3036 "configure"
+#line 3541 "configure"
#include "confdefs.h"
#include <ctype.h>
#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
@@ -3043,7 +3548,7 @@ if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
exit (0); }
EOF
-if { (eval echo configure:3047: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3552: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@@ -3067,12 +3572,12 @@ EOF
fi
echo $ac_n "checking for mode_t""... $ac_c" 1>&6
-echo "configure:3071: checking for mode_t" >&5
+echo "configure:3576: checking for mode_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3076 "configure"
+#line 3581 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -3100,12 +3605,12 @@ EOF
fi
echo $ac_n "checking for pid_t""... $ac_c" 1>&6
-echo "configure:3104: checking for pid_t" >&5
+echo "configure:3609: checking for pid_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3109 "configure"
+#line 3614 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -3133,12 +3638,12 @@ EOF
fi
echo $ac_n "checking for size_t""... $ac_c" 1>&6
-echo "configure:3137: checking for size_t" >&5
+echo "configure:3642: checking for size_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3142 "configure"
+#line 3647 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -3166,12 +3671,12 @@ EOF
fi
echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
-echo "configure:3170: checking for uid_t in sys/types.h" >&5
+echo "configure:3675: checking for uid_t in sys/types.h" >&5
if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3175 "configure"
+#line 3680 "configure"
#include "confdefs.h"
#include <sys/types.h>
EOF
@@ -3208,12 +3713,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for opendir""... $ac_c" 1>&6
-echo "configure:3212: checking for opendir" >&5
+echo "configure:3717: checking for opendir" >&5
if eval "test \"`echo '$''{'ac_cv_func_opendir'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3217 "configure"
+#line 3722 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char opendir(); below. */
@@ -3236,7 +3741,7 @@ opendir();
; return 0; }
EOF
-if { (eval echo configure:3240: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3745: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_opendir=yes"
else
@@ -3269,9 +3774,9 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking union wait""... $ac_c" 1>&6
-echo "configure:3273: checking union wait" >&5
+echo "configure:3778: checking union wait" >&5
cat > conftest.$ac_ext <<EOF
-#line 3275 "configure"
+#line 3780 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/wait.h>
@@ -3283,7 +3788,7 @@ WIFEXITED(x); /* Generates compiler error if WIFEXITED
; return 0; }
EOF
-if { (eval echo configure:3287: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3792: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
tcl_ok=yes
else
@@ -3307,9 +3812,9 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking matherr support""... $ac_c" 1>&6
-echo "configure:3311: checking matherr support" >&5
+echo "configure:3816: checking matherr support" >&5
cat > conftest.$ac_ext <<EOF
-#line 3313 "configure"
+#line 3818 "configure"
#include "confdefs.h"
#include <math.h>
int main() {
@@ -3320,7 +3825,7 @@ x.type = SING;
; return 0; }
EOF
-if { (eval echo configure:3324: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3829: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=yes
else
@@ -3347,12 +3852,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6
-echo "configure:3351: checking return type of signal handlers" >&5
+echo "configure:3856: checking return type of signal handlers" >&5
if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3356 "configure"
+#line 3861 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <signal.h>
@@ -3369,7 +3874,7 @@ int main() {
int i;
; return 0; }
EOF
-if { (eval echo configure:3373: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3878: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_type_signal=void
else
@@ -3388,12 +3893,12 @@ EOF
echo $ac_n "checking for vfork""... $ac_c" 1>&6
-echo "configure:3392: checking for vfork" >&5
+echo "configure:3897: checking for vfork" >&5
if eval "test \"`echo '$''{'ac_cv_func_vfork'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3397 "configure"
+#line 3902 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char vfork(); below. */
@@ -3416,7 +3921,7 @@ vfork();
; return 0; }
EOF
-if { (eval echo configure:3420: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3925: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_vfork=yes"
else
@@ -3438,12 +3943,12 @@ fi
if test "$tcl_ok" = 1; then
echo $ac_n "checking vfork/signal bug""... $ac_c" 1>&6
-echo "configure:3442: checking vfork/signal bug" >&5;
+echo "configure:3947: checking vfork/signal bug" >&5;
if test "$cross_compiling" = yes; then
tcl_ok=0
else
cat > conftest.$ac_ext <<EOF
-#line 3447 "configure"
+#line 3952 "configure"
#include "confdefs.h"
#include <stdio.h>
@@ -3471,7 +3976,7 @@ main()
exit((gotSignal) ? 0 : 1);
}
EOF
-if { (eval echo configure:3475: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3980: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
tcl_ok=1
else
@@ -3504,12 +4009,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for strncasecmp""... $ac_c" 1>&6
-echo "configure:3508: checking for strncasecmp" >&5
+echo "configure:4013: checking for strncasecmp" >&5
if eval "test \"`echo '$''{'ac_cv_func_strncasecmp'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3513 "configure"
+#line 4018 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strncasecmp(); below. */
@@ -3532,7 +4037,7 @@ strncasecmp();
; return 0; }
EOF
-if { (eval echo configure:3536: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4041: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strncasecmp=yes"
else
@@ -3554,7 +4059,7 @@ fi
if test "$tcl_ok" = 0; then
echo $ac_n "checking for strncasecmp in -lsocket""... $ac_c" 1>&6
-echo "configure:3558: checking for strncasecmp in -lsocket" >&5
+echo "configure:4063: checking for strncasecmp in -lsocket" >&5
ac_lib_var=`echo socket'_'strncasecmp | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -3562,7 +4067,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lsocket $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 3566 "configure"
+#line 4071 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -3573,7 +4078,7 @@ int main() {
strncasecmp()
; return 0; }
EOF
-if { (eval echo configure:3577: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4082: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -3597,7 +4102,7 @@ fi
fi
if test "$tcl_ok" = 0; then
echo $ac_n "checking for strncasecmp in -linet""... $ac_c" 1>&6
-echo "configure:3601: checking for strncasecmp in -linet" >&5
+echo "configure:4106: checking for strncasecmp in -linet" >&5
ac_lib_var=`echo inet'_'strncasecmp | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -3605,7 +4110,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-linet $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 3609 "configure"
+#line 4114 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -3616,7 +4121,7 @@ int main() {
strncasecmp()
; return 0; }
EOF
-if { (eval echo configure:3620: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4125: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -3654,12 +4159,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for BSDgettimeofday""... $ac_c" 1>&6
-echo "configure:3658: checking for BSDgettimeofday" >&5
+echo "configure:4163: checking for BSDgettimeofday" >&5
if eval "test \"`echo '$''{'ac_cv_func_BSDgettimeofday'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3663 "configure"
+#line 4168 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char BSDgettimeofday(); below. */
@@ -3682,7 +4187,7 @@ BSDgettimeofday();
; return 0; }
EOF
-if { (eval echo configure:3686: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4191: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_BSDgettimeofday=yes"
else
@@ -3703,12 +4208,12 @@ EOF
else
echo "$ac_t""no" 1>&6
echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6
-echo "configure:3707: checking for gettimeofday" >&5
+echo "configure:4212: checking for gettimeofday" >&5
if eval "test \"`echo '$''{'ac_cv_func_gettimeofday'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3712 "configure"
+#line 4217 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char gettimeofday(); below. */
@@ -3731,7 +4236,7 @@ gettimeofday();
; return 0; }
EOF
-if { (eval echo configure:3735: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4240: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_gettimeofday=yes"
else
@@ -3757,9 +4262,9 @@ fi
fi
echo $ac_n "checking for gettimeofday declaration""... $ac_c" 1>&6
-echo "configure:3761: checking for gettimeofday declaration" >&5
+echo "configure:4266: checking for gettimeofday declaration" >&5
cat > conftest.$ac_ext <<EOF
-#line 3763 "configure"
+#line 4268 "configure"
#include "confdefs.h"
#include <sys/time.h>
EOF
@@ -3781,98 +4286,20 @@ rm -f conftest*
#--------------------------------------------------------------------
-# Interactive UNIX requires -linet instead of -lsocket, plus it
-# needs net/errno.h to define the socket-related error codes.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking for main in -linet""... $ac_c" 1>&6
-echo "configure:3790: checking for main in -linet" >&5
-ac_lib_var=`echo inet'_'main | sed 'y%./+-%__p_%'`
-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- ac_save_LIBS="$LIBS"
-LIBS="-linet $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 3798 "configure"
-#include "confdefs.h"
-
-int main() {
-main()
-; return 0; }
-EOF
-if { (eval echo configure:3805: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=no"
-fi
-rm -f conftest*
-LIBS="$ac_save_LIBS"
-
-fi
-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- LIBS="$LIBS -linet"
-else
- echo "$ac_t""no" 1>&6
-fi
-
-ac_safe=`echo "net/errno.h" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for net/errno.h""... $ac_c" 1>&6
-echo "configure:3827: checking for net/errno.h" >&5
-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3832 "configure"
-#include "confdefs.h"
-#include <net/errno.h>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:3837: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- rm -rf conftest*
- eval "ac_cv_header_$ac_safe=yes"
-else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_header_$ac_safe=no"
-fi
-rm -f conftest*
-fi
-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- cat >> confdefs.h <<\EOF
-#define HAVE_NET_ERRNO_H 1
-EOF
-
-else
- echo "$ac_t""no" 1>&6
-fi
-
-
-#--------------------------------------------------------------------
# The following code checks to see whether it is possible to get
# signed chars on this platform. This is needed in order to
# properly generate sign-extended ints from character values.
#--------------------------------------------------------------------
echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6
-echo "configure:3869: checking whether char is unsigned" >&5
+echo "configure:4296: checking whether char is unsigned" >&5
if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
if test "$GCC" = yes; then
# GCC predefines this symbol on systems where it applies.
cat > conftest.$ac_ext <<EOF
-#line 3876 "configure"
+#line 4303 "configure"
#include "confdefs.h"
#ifdef __CHAR_UNSIGNED__
yes
@@ -3894,7 +4321,7 @@ if test "$cross_compiling" = yes; then
{ echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
else
cat > conftest.$ac_ext <<EOF
-#line 3898 "configure"
+#line 4325 "configure"
#include "confdefs.h"
/* volatile prevents gcc2 from optimizing the test away on sparcs. */
#if !defined(__STDC__) || __STDC__ != 1
@@ -3904,7 +4331,7 @@ main() {
volatile char c = 255; exit(c < 0);
}
EOF
-if { (eval echo configure:3908: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:4335: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
ac_cv_c_char_unsigned=yes
else
@@ -3928,9 +4355,9 @@ EOF
fi
echo $ac_n "checking signed char declarations""... $ac_c" 1>&6
-echo "configure:3932: checking signed char declarations" >&5
+echo "configure:4359: checking signed char declarations" >&5
cat > conftest.$ac_ext <<EOF
-#line 3934 "configure"
+#line 4361 "configure"
#include "confdefs.h"
int main() {
@@ -3940,7 +4367,7 @@ p = 0;
; return 0; }
EOF
-if { (eval echo configure:3944: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:4371: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=yes
else
@@ -3958,41 +4385,274 @@ EOF
fi
+
#--------------------------------------------------------------------
-# Check for the existence of the -lsocket and -lnsl libraries.
-# The order here is important, so that they end up in the right
-# order in the command line generated by make. Here are some
-# special considerations:
-# 1. Use "connect" and "accept" to check for -lsocket, and
-# "gethostbyname" to check for -lnsl.
-# 2. Use each function name only once: can't redo a check because
-# autoconf caches the results of the last check and won't redo it.
-# 3. Use -lnsl and -lsocket only if they supply procedures that
-# aren't already present in the normal libraries. This is because
-# IRIX 5.2 has libraries, but they aren't needed and they're
-# bogus: they goof up name resolution if used.
-# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
-# To get around this problem, check for both libraries together
-# if -lsocket doesn't work by itself.
+# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------
-# CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
-# mess up the cache values of the functions we check for.
-echo $ac_n "checking for socket libraries""... $ac_c" 1>&6
-echo "configure:3983: checking for socket libraries" >&5
+
+ #--------------------------------------------------------------------
+ # On a few very rare systems, all of the libm.a stuff is
+ # already in libc.a. Set compiler flags accordingly.
+ # Also, Linux requires the "ieee" library for math to work
+ # right (and it must appear before "-lm").
+ #--------------------------------------------------------------------
+
+ echo $ac_n "checking for sin""... $ac_c" 1>&6
+echo "configure:4403: checking for sin" >&5
+if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4408 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char sin(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char sin();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_sin) || defined (__stub___sin)
+choke me
+#else
+sin();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:4431: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_sin=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_sin=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ MATH_LIBS=""
+else
+ echo "$ac_t""no" 1>&6
+MATH_LIBS="-lm"
+fi
+
+ echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
+echo "configure:4452: checking for main in -lieee" >&5
+ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lieee $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4460 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:4467: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ MATH_LIBS="-lieee $MATH_LIBS"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ #--------------------------------------------------------------------
+ # On AIX systems, libbsd.a has to be linked in to support
+ # non-blocking file IO. This library has to be linked in after
+ # the MATH_LIBS or it breaks the pow() function. The way to
+ # insure proper sequencing, is to add it to the tail of MATH_LIBS.
+ # This library also supplies gettimeofday.
+ #--------------------------------------------------------------------
+
+ libbsd=no
+ if test "`uname -s`" = "AIX" ; then
+ echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
+echo "configure:4499: checking for gettimeofday in -lbsd" >&5
+ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lbsd $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4507 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gettimeofday();
+
+int main() {
+gettimeofday()
+; return 0; }
+EOF
+if { (eval echo configure:4518: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ libbsd=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $libbsd = yes; then
+ MATH_LIBS="$MATH_LIBS -lbsd"
+ fi
+ fi
+
+
+ #--------------------------------------------------------------------
+ # Interactive UNIX requires -linet instead of -lsocket, plus it
+ # needs net/errno.h to define the socket-related error codes.
+ #--------------------------------------------------------------------
+
+ echo $ac_n "checking for main in -linet""... $ac_c" 1>&6
+echo "configure:4550: checking for main in -linet" >&5
+ac_lib_var=`echo inet'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-linet $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 4558 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:4565: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ LIBS="$LIBS -linet"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ ac_safe=`echo "net/errno.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for net/errno.h""... $ac_c" 1>&6
+echo "configure:4587: checking for net/errno.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4592 "configure"
+#include "confdefs.h"
+#include <net/errno.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:4597: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ cat >> confdefs.h <<\EOF
+#define HAVE_NET_ERRNO_H 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ #--------------------------------------------------------------------
+ # Check for the existence of the -lsocket and -lnsl libraries.
+ # The order here is important, so that they end up in the right
+ # order in the command line generated by make. Here are some
+ # special considerations:
+ # 1. Use "connect" and "accept" to check for -lsocket, and
+ # "gethostbyname" to check for -lnsl.
+ # 2. Use each function name only once: can't redo a check because
+ # autoconf caches the results of the last check and won't redo it.
+ # 3. Use -lnsl and -lsocket only if they supply procedures that
+ # aren't already present in the normal libraries. This is because
+ # IRIX 5.2 has libraries, but they aren't needed and they're
+ # bogus: they goof up name resolution if used.
+ # 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+ # To get around this problem, check for both libraries together
+ # if -lsocket doesn't work by itself.
+ #--------------------------------------------------------------------
+
+ # CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
+ # mess up the cache values of the functions we check for.
+ echo $ac_n "checking for socket libraries""... $ac_c" 1>&6
+echo "configure:4643: checking for socket libraries" >&5
if eval "test \"`echo '$''{'tcl_cv_lib_sockets'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
tcl_cv_lib_sockets=
- tcl_checkBoth=0
- unset ac_cv_func_connect
- echo $ac_n "checking for connect""... $ac_c" 1>&6
-echo "configure:3991: checking for connect" >&5
+ tcl_checkBoth=0
+ unset ac_cv_func_connect
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:4651: checking for connect" >&5
if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3996 "configure"
+#line 4656 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char connect(); below. */
@@ -4015,7 +4675,7 @@ connect();
; return 0; }
EOF
-if { (eval echo configure:4019: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4679: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_connect=yes"
else
@@ -4035,10 +4695,10 @@ else
tcl_checkSocket=1
fi
- if test "$tcl_checkSocket" = 1; then
- unset ac_cv_func_connect
- echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
-echo "configure:4042: checking for main in -lsocket" >&5
+ if test "$tcl_checkSocket" = 1; then
+ unset ac_cv_func_connect
+ echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:4702: checking for main in -lsocket" >&5
ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4046,14 +4706,14 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lsocket $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4050 "configure"
+#line 4710 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:4057: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4717: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4074,18 +4734,18 @@ else
tcl_checkBoth=1
fi
- fi
- if test "$tcl_checkBoth" = 1; then
- tcl_oldLibs=$LIBS
- LIBS="$LIBS -lsocket -lnsl"
- unset ac_cv_func_accept
- echo $ac_n "checking for accept""... $ac_c" 1>&6
-echo "configure:4084: checking for accept" >&5
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tcl_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ unset ac_cv_func_accept
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:4744: checking for accept" >&5
if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4089 "configure"
+#line 4749 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char accept(); below. */
@@ -4108,7 +4768,7 @@ accept();
; return 0; }
EOF
-if { (eval echo configure:4112: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4772: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_accept=yes"
else
@@ -4123,24 +4783,24 @@ fi
if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
echo "$ac_t""yes" 1>&6
tcl_checkNsl=0
- tcl_cv_lib_sockets="-lsocket -lnsl"
+ tcl_cv_lib_sockets="-lsocket -lnsl"
else
echo "$ac_t""no" 1>&6
fi
- unset ac_cv_func_accept
- LIBS=$tcl_oldLibs
- fi
- unset ac_cv_func_gethostbyname
- tcl_oldLibs=$LIBS
- LIBS="$LIBS $tcl_cv_lib_sockets"
- echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
-echo "configure:4139: checking for gethostbyname" >&5
+ unset ac_cv_func_accept
+ LIBS=$tcl_oldLibs
+ fi
+ unset ac_cv_func_gethostbyname
+ tcl_oldLibs=$LIBS
+ LIBS="$LIBS $tcl_cv_lib_sockets"
+ echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:4799: checking for gethostbyname" >&5
if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4144 "configure"
+#line 4804 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char gethostbyname(); below. */
@@ -4163,7 +4823,7 @@ gethostbyname();
; return 0; }
EOF
-if { (eval echo configure:4167: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4827: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_gethostbyname=yes"
else
@@ -4181,7 +4841,7 @@ if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
else
echo "$ac_t""no" 1>&6
echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
-echo "configure:4185: checking for main in -lnsl" >&5
+echo "configure:4845: checking for main in -lnsl" >&5
ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4189,14 +4849,14 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lnsl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4193 "configure"
+#line 4853 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:4200: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4860: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4218,97 +4878,118 @@ fi
fi
- unset ac_cv_func_gethostbyname
- LIBS=$tcl_oldLIBS
-
+ unset ac_cv_func_gethostbyname
+ LIBS=$tcl_oldLIBS
+
fi
echo "$ac_t""$tcl_cv_lib_sockets" 1>&6
-test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+ test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+
+ # Don't perform the eval of the libraries here because DL_LIBS
+ # won't be set until we call SC_CONFIG_CFLAGS
+
+ TCL_LIBS='${DL_LIBS} ${LIBS} ${MATH_LIBS}'
+
+
+
+
+# Add the threads support libraries
+
+LIBS="$LIBS$THREADS_LIBS"
#--------------------------------------------------------------------
-# The statements below define a collection of symbols related to
-# dynamic loading and shared libraries:
-#
-# DL_OBJS - Name of the object file that implements dynamic
-# loading for Tcl on this system.
-# DL_LIBS - Library file(s) to include in tclsh and other base
-# applications in order for the "load" command to work.
-# LD_FLAGS - Flags to pass to the compiler when linking object
-# files into an executable application binary such
-# as tclsh.
-# LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib",
-# that tell the run-time dynamic linker where to look
-# for shared libraries such as libtcl.so. Depends on
-# the variable LIB_RUNTIME_DIR in the Makefile.
-# MAKE_LIB - Command to execute to build the Tcl library;
-# differs depending on whether or not Tcl is being
-# compiled as a shared library.
-# SHLIB_CFLAGS - Flags to pass to cc when compiling the components
-# of a shared library (may request position-independent
-# code, among other things).
-# SHLIB_LD - Base command to use for combining object files
-# into a shared library.
-# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
-# creating shared libraries. This symbol typically
-# goes at the end of the "ld" commands that build
-# shared libraries. The value of the symbol is
-# "${LIBS}" if all of the dependent libraries should
-# be specified when creating a shared library. If
-# dependent libraries should not be specified (as on
-# SunOS 4.x, where they cause the link to fail, or in
-# general if Tcl and Tk aren't themselves shared
-# libraries), then this symbol has an empty string
-# as its value.
-# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable
-# extensions. An empty string means we don't know how
-# to use shared libraries on this platform.
-# TCL_LIB_FILE - Name of the file that contains the Tcl library, such
-# as libtcl7.8.so or libtcl7.8.a.
-# TCL_LIB_SUFFIX -Specifies everything that comes after the "libtcl"
-# in the shared library name, using the $VERSION variable
-# to put the version in the right place. This is used
-# by platforms that need non-standard library names.
-# Examples: ${VERSION}.so.1.1 on NetBSD, since it needs
-# to have a version after the .so, and ${VERSION}.a
-# on AIX, since the Tcl shared library needs to have
-# a .a extension whereas shared objects for loadable
-# extensions have a .so extension. Defaults to
-# ${VERSION}${SHLIB_SUFFIX}.
+# The statements below define a collection of compile flags. This
+# macro depends on the value of SHARED_BUILD, and should be called
+# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------
-# Step 1: set the variable "system" to hold the name and version number
-# for the system. This can usually be done via the "uname" command, but
-# there are a few systems, like Next, where this doesn't work.
-echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6
-echo "configure:4286: checking system version (for dynamic loading)" >&5
-if test -f /usr/lib/NextStep/software_version; then
- system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+
+ # Step 0.a: Enable 64 bit support?
+
+ echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6
+echo "configure:4913: checking if 64bit support is requested" >&5
+ # Check whether --enable-64bit or --disable-64bit was given.
+if test "${enable_64bit+set}" = set; then
+ enableval="$enable_64bit"
+ :
else
- system=`uname -s`-`uname -r`
- if test "$?" -ne 0 ; then
- echo "$ac_t""unknown (can't find uname command)" 1>&6
- system=unknown
+ enableval="no"
+fi
+
+
+ if test "$enableval" = "yes"; then
+ do64bit=yes
else
- # Special check for weird MP-RAS system (uname returns weird
- # results, and the version is kept in special file).
-
- if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
- system=MP-RAS-`awk '{print $3}' /etc/.relid'`
- fi
- if test "`uname -s`" = "AIX" ; then
- system=AIX-`uname -v`.`uname -r`
- fi
- echo "$ac_t""$system" 1>&6
+ do64bit=no
fi
+ echo "$ac_t""$do64bit" 1>&6
+
+ # Step 0.b: Enable Solaris 64 bit VIS support?
+
+ echo $ac_n "checking if 64bit Sparc VIS support is requested""... $ac_c" 1>&6
+echo "configure:4933: checking if 64bit Sparc VIS support is requested" >&5
+ # Check whether --enable-64bit-vis or --disable-64bit-vis was given.
+if test "${enable_64bit_vis+set}" = set; then
+ enableval="$enable_64bit_vis"
+ :
+else
+ enableval="no"
fi
-# Step 2: check for existence of -ldl library. This is needed because
-# Linux can use either -ldl or -ldld for dynamic loading.
-echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
-echo "configure:4312: checking for dlopen in -ldl" >&5
+ if test "$enableval" = "yes"; then
+ # Force 64bit on with VIS
+ do64bit=yes
+ do64bitVIS=yes
+ else
+ do64bitVIS=no
+ fi
+ echo "$ac_t""$do64bitVIS" 1>&6
+
+ # Step 1: set the variable "system" to hold the name and version number
+ # for the system. This can usually be done via the "uname" command, but
+ # there are a few systems, like Next, where this doesn't work.
+
+ echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6
+echo "configure:4957: checking system version (for dynamic loading)" >&5
+ if test -f /usr/lib/NextStep/software_version; then
+ system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+ else
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ echo "$ac_t""unknown (can't find uname command)" 1>&6
+ system=unknown
+ else
+ # Special check for weird MP-RAS system (uname returns weird
+ # results, and the version is kept in special file).
+
+ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+ system=MP-RAS-`awk '{print }' /etc/.relid'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
+ echo "$ac_t""$system" 1>&6
+ fi
+ fi
+
+ echo $ac_n "checking if gcc is being used""... $ac_c" 1>&6
+echo "configure:4980: checking if gcc is being used" >&5
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ using_gcc="yes"
+ else
+ using_gcc="no"
+ fi
+
+ echo "$ac_t""$using_gcc ($CC)" 1>&6
+
+ # Step 2: check for existence of -ldl library. This is needed because
+ # Linux can use either -ldl or -ldld for dynamic loading.
+
+ echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
+echo "configure:4993: checking for dlopen in -ldl" >&5
ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4316,7 +4997,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4320 "configure"
+#line 5001 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -4327,7 +5008,7 @@ int main() {
dlopen()
; return 0; }
EOF
-if { (eval echo configure:4331: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5012: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4349,63 +5030,130 @@ have_dl=no
fi
-# Step 3: set configuration options based on system name and version.
+ # Step 3: set configuration options based on system name and version.
-fullSrcDir=`cd $srcdir; pwd`
-TCL_SHARED_LIB_SUFFIX=""
-TCL_UNSHARED_LIB_SUFFIX=""
-TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
-ECHO_VERSION='`echo ${VERSION}`'
-TCL_LIB_VERSIONS_OK=ok
-case $system in
- AIX-4.[2-9])
- SHLIB_CFLAGS=""
- SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- AIX=yes
- TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
- ;;
- AIX-*)
- SHLIB_CFLAGS=""
- SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o tclLoadAix.o"
- DL_LIBS="-lld"
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
- ;;
- BSD/OS-2.1*|BSD/OS-3*)
- SHLIB_CFLAGS=""
- SHLIB_LD="shlicc -r"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- dgux*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
- # CYGNUS LOCAL: Handle gcc and versions of HP-UX that can't
- # do dynamic linking.
- echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
-echo "configure:4409: checking for shl_load in -ldld" >&5
+ do64bit_ok=no
+ fullSrcDir=`cd $srcdir; pwd`
+ EXTRA_CFLAGS=""
+ TCL_EXPORT_FILE_SUFFIX=""
+ UNSHARED_LIB_SUFFIX=""
+ TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
+ ECHO_VERSION='`echo ${VERSION}`'
+ TCL_LIB_VERSIONS_OK=ok
+ CFLAGS_DEBUG=-g
+ CFLAGS_OPTIMIZE=-O
+ if test "$using_gcc" = "yes" ; then
+ CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
+ else
+ CFLAGS_WARNING=""
+ fi
+ TCL_NEEDS_EXP_FILE=0
+ TCL_BUILD_EXP_FILE=""
+ TCL_EXP_FILE=""
+ # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:5057: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$AR"; then
+ ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_AR="ar"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+AR="$ac_cv_prog_AR"
+if test -n "$AR"; then
+ echo "$ac_t""$AR" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ STLIB_LD='${AR} cr'
+ case $system in
+ AIX-4.[2-9])
+ if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ # AIX requires the _r compiler when gcc isn't being used
+ if test "${CC}" != "cc_r" ; then
+ CC=${CC}_r
+ fi
+ echo "$ac_t""Using $CC for compiling with threads" 1>&6
+ fi
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+ ;;
+ AIX-*)
+ if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ # AIX requires the _r compiler when gcc isn't being used
+ if test "${CC}" != "cc_r" ; then
+ CC=${CC}_r
+ fi
+ echo "$ac_t""Using $CC for compiling with threads" 1>&6
+ fi
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ LIBOBJS="$LIBOBJS tclLoadAix.o"
+ DL_LIBS="-lld"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+ ;;
+ BSD/OS-2.1*|BSD/OS-3*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="shlicc -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ BSD/OS-4.*)
+ SHLIB_CFLAGS="-export-dynamic -fPIC"
+ SHLIB_LD="cc -shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-export-dynamic"
+ LD_SEARCH_FLAGS=""
+ ;;
+ dgux*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
+ SHLIB_SUFFIX=".sl"
+ echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
+echo "configure:5157: checking for shl_load in -ldld" >&5
ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4413,7 +5161,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldld $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4417 "configure"
+#line 5165 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -4424,7 +5172,7 @@ int main() {
shl_load()
; return 0; }
EOF
-if { (eval echo configure:4428: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5176: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4445,114 +5193,92 @@ else
tcl_ok=no
fi
- if test "$tcl_ok" = "yes"; then
- if test "$GCC" = yes; then
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="$CC -shared -fPIC"
- else
- SHLIB_CFLAGS="+z"
- SHLIB_LD="ld -b"
- fi
-
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".sl"
- DL_OBJS="tclLoadShl.o"
- DL_LIBS="-ldld"
-
- # The GNU linker requires the -export-dynamic
- # option to make all symbols visible in the dynamic symbol
- # table. Note that the HP linker will give errors
- # -export-dynamic, but will still exit successfully.
- # Adding a -L option will make it fail.
- hold_ldflags=$LDFLAGS
- echo $ac_n "checking for the ld -export-dynamic flag""... $ac_c" 1>&6
-echo "configure:4470: checking for the ld -export-dynamic flag" >&5
- LDFLAGS="${LDFLAGS} -Wl,-export-dynamic -L`pwd`"
- cat > conftest.$ac_ext <<EOF
-#line 4473 "configure"
-#include "confdefs.h"
-
-int main() {
-int i;
-; return 0; }
-EOF
-if { (eval echo configure:4480: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- found=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- found=no
-fi
-rm -f conftest*
- LDFLAGS=$hold_ldflags
- echo "$ac_t""$found" 1>&6
- if test $found = yes; then
- LD_FLAGS="-Wl,-export-dynamic"
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- else
- LD_FLAGS="-Wl,-E"
- LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
- fi
- fi
- # END CYGNUS LOCAL
- ;;
- IRIX-4.*)
- SHLIB_CFLAGS="-G 0"
- SHLIB_SUFFIX=".a"
- SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
- SHLIB_LD_LIBS='${LIBS}'
- DL_OBJS="tclLoadAout.o"
- DL_LIBS=""
- LD_FLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
- ;;
- IRIX-5.*|IRIX-6.*)
- SHLIB_CFLAGS=""
- SHLIB_LD="ld -shared -rdata_shared"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- ;;
- IRIX64-6.*)
- SHLIB_CFLAGS=""
- SHLIB_LD="ld -n32 -shared -rdata_shared -rpath /usr/local/lib"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- ;;
- Linux*)
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- if test "$have_dl" = yes; then
- SHLIB_LD="${CC} -shared"
+ if test "$tcl_ok" = yes; then
+ SHLIB_CFLAGS="+z"
+ SHLIB_LD="ld -b"
+ SHLIB_LD_LIBS=""
+ DL_OBJS="tclLoadShl.o"
+ DL_LIBS="-ldld"
+ LDFLAGS="-Wl,-E"
+ LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ fi
+ ;;
+ IRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
+ ;;
+ IRIX-5.*|IRIX-6.*|IRIX64-6.5*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -n32 -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS="-rdynamic"
- LD_SEARCH_FLAGS=""
- else
- ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
+ DL_LIBS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "yes" ; then
+ EXTRA_CFLAGS="-mabi=n32"
+ LDFLAGS="-mabi=n32"
+ else
+ case $system in
+ IRIX-6.3)
+ # Use to build 6.2 compatible binaries on 6.3.
+ EXTRA_CFLAGS="-n32 -D_OLD_TERMIOS"
+ ;;
+ *)
+ EXTRA_CFLAGS="-n32"
+ ;;
+ esac
+ LDFLAGS="-n32"
+ fi
+ ;;
+ IRIX64-6.*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -32 -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ ;;
+ Linux*)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+
+ # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
+ # when you inline the string and math operations. Turn this off to
+ # get rid of the warnings.
+
+ CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
+
+ if test "$have_dl" = yes; then
+ SHLIB_LD="${CC} -shared"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-rdynamic"
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ else
+ ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dld.h""... $ac_c" 1>&6
-echo "configure:4546: checking for dld.h" >&5
+echo "configure:5272: checking for dld.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4551 "configure"
+#line 5277 "configure"
#include "confdefs.h"
#include <dld.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:4556: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5282: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -4569,52 +5295,55 @@ fi
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
- SHLIB_LD="ld -shared"
- DL_OBJS="tclLoadDld.o"
- DL_LIBS="-ldld"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
+ SHLIB_LD="ld -shared"
+ DL_OBJS="tclLoadDld.o"
+ DL_LIBS="-ldld"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
else
echo "$ac_t""no" 1>&6
fi
- fi
- ;;
- MP-RAS-02*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- MP-RAS-*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS="-Wl,-Bexport"
- LD_SEARCH_FLAGS=""
- ;;
- NetBSD-*|FreeBSD-*|OpenBSD-*)
- # Not available on all versions: check for include file.
- ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
+ fi
+ if test "`uname -m`" = "alpha" ; then
+ EXTRA_CFLAGS="-mieee"
+ fi
+ ;;
+ MP-RAS-02*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ MP-RAS-*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ NetBSD-*|FreeBSD-[1-2].*|OpenBSD-*)
+ # Not available on all versions: check for include file.
+ ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
-echo "configure:4608: checking for dlfcn.h" >&5
+echo "configure:5337: checking for dlfcn.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4613 "configure"
+#line 5342 "configure"
#include "confdefs.h"
#include <dlfcn.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:4618: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5347: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -4631,259 +5360,284 @@ fi
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
- SHLIB_CFLAGS="-fpic"
+ # NetBSD/SPARC needs -fPIC, -fpic will not do.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ echo $ac_n "checking for ELF""... $ac_c" 1>&6
+echo "configure:5374: checking for ELF" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 5376 "configure"
+#include "confdefs.h"
+
+#ifdef __ELF__
+ yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "yes" >/dev/null 2>&1; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so'
+else
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0'
+
+fi
+rm -f conftest*
+
+
+else
+ echo "$ac_t""no" 1>&6
+
+ SHLIB_CFLAGS=""
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+
+fi
+
+
+ # FreeBSD doesn't handle version numbers with dots.
+
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ FreeBSD-*)
+ # FreeBSD 3.* and greater have ELF.
+ SHLIB_CFLAGS="-fPIC"
SHLIB_LD="ld -Bshareable -x"
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- LD_FLAGS=""
+ LDFLAGS="-export-dynamic"
LD_SEARCH_FLAGS=""
- TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
-
-else
- echo "$ac_t""no" 1>&6
-
+ ;;
+ NEXTSTEP-*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="cc -nostdlib -r"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadNext.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OS/390-*)
+ CFLAGS_OPTIMIZE="" # Optimizer is buggy
+ cat >> confdefs.h <<\EOF
+#define _OE_SOCKETS 1
+EOF
+ # needed in sys/socket.h
+ ;;
+ OSF1-1.0|OSF1-1.1|OSF1-1.2)
+ # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
+ SHLIB_CFLAGS=""
+ # Hack: make package name same as library name
+ SHLIB_LD='ld -R -export :'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadOSF.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-1.*)
+ # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -shared"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-V*)
+ # Digital OSF/1
SHLIB_CFLAGS=""
- SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
+ SHLIB_LD='ld -shared -expect_unresolved "*"'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="-DHAVE_TZSET -std1"
+ fi
+ # see pthread_intro(3) for pthread support on osf1, k.furukawa
+ if test "${TCL_THREADS}" = "1" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -pthread"
+ LDFLAGS="-pthread"
+ else
+ LIBS=`echo $LIBS | sed s/-lpthreads//`
+ LIBS="$LIBS -lpthread -lmach -lexc"
+ fi
+ fi
+
+ ;;
+ RISCos-*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".a"
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
- LD_FLAGS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ ;;
+ SCO_SV-3.2*)
+ # Note, dlopen is available only on SCO 3.2.5 and greater. However,
+ # this test works, since "uname -s" was non-standard in 3.2.4 and
+ # below.
+ if test "$using_gcc" = "yes" ; then
+ SHLIB_CFLAGS="-fPIC -melf"
+ LDFLAGS="-melf -Wl,-Bexport"
+ else
+ SHLIB_CFLAGS="-Kpic -belf"
+ LDFLAGS="-belf -Wl,-Bexport"
+ fi
+ SHLIB_LD="ld -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS="-belf -Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ SINIX*5.4*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ SunOS-4*)
+ SHLIB_CFLAGS="-PIC"
+ SHLIB_LD="ld"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
-
-fi
+ # SunOS can't handle version numbers with dots in them in library
+ # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
+ # requires an extra version number at the end of .so file names.
+ # So, the library has to have a name like libtcl75.so.1.0
- # FreeBSD doesn't handle version numbers with dots.
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0'
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ SunOS-5.[0-6]*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
- TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
- TCL_LIB_VERSIONS_OK=nodots
- ;;
- NEXTSTEP-*)
- SHLIB_CFLAGS=""
- SHLIB_LD="cc -nostdlib -r"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadNext.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- OSF1-1.0|OSF1-1.1|OSF1-1.2)
- # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
- SHLIB_CFLAGS=""
- # Hack: make package name same as library name
- SHLIB_LD='ld -R -export $@:'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadOSF.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- OSF1-1.*)
- # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
- SHLIB_CFLAGS="-fpic"
- SHLIB_LD="ld -shared"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- OSF1-V*)
- # Digital OSF/1
- SHLIB_CFLAGS=""
- SHLIB_LD='ld -shared -expect_unresolved "*"'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- ;;
- RISCos-*)
- SHLIB_CFLAGS="-G 0"
- SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".a"
- DL_OBJS="tclLoadAout.o"
- DL_LIBS=""
- LD_FLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- ;;
- SCO_SV-3.2*)
- # Note, dlopen is available only on SCO 3.2.5 and greater. However,
- # this test works, since "uname -s" was non-standard in 3.2.4 and
- # below.
- SHLIB_CFLAGS="-Kpic -belf"
- SHLIB_LD="ld -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS="-belf -Wl,-Bexport"
- LD_SEARCH_FLAGS=""
- ;;
- SINIX*5.4*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- SunOS-4*)
- # CYGNUS LOCAL: gcc uses a different option than native cc.
- if test "$GCC" = yes; then
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="$CC -shared -fPIC"
- else
- SHLIB_CFLAGS="-PIC"
- SHLIB_LD="ld"
- fi
- # END CYGNUS LOCAL
-
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
-
- # SunOS can't handle version numbers with dots in them in library
- # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
- # requires an extra version number at the end of .so file names.
- # So, the library has to have a name like libtcl75.so.1.0
-
- TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
- TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
- TCL_LIB_VERSIONS_OK=nodots
- ;;
- SunOS-5*)
- # CYGNUS LOCAL: gcc uses a different option than native cc.
- if test "$GCC" = yes; then
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="$CC -shared -fPIC"
- else
- SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="/usr/ccs/bin/ld -G -z text"
- fi
- # END CYGNUS LOCAL
-
- # Note: need the LIBS below, otherwise Tk won't find Tcl's
- # symbols when dynamically loaded into tclsh.
-
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- # CYGNUS LOCAL: The GNU linker requires the -export-dynamic
- # option to make all symbols visible in the dynamic symbol
- # table.
- hold_ldflags=$LDFLAGS
- echo $ac_n "checking for the ld -export-dynamic flag""... $ac_c" 1>&6
-echo "configure:4793: checking for the ld -export-dynamic flag" >&5
- LDFLAGS="${LDFLAGS} -Wl,-export-dynamic"
- cat > conftest.$ac_ext <<EOF
-#line 4796 "configure"
-#include "confdefs.h"
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
-int main() {
-int i;
-; return 0; }
-EOF
-if { (eval echo configure:4803: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- found=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- found=no
-fi
-rm -f conftest*
- LDFLAGS=$hold_ldflags
- echo "$ac_t""$found" 1>&6
- if test $found = yes; then
- LD_FLAGS="-Wl,-export-dynamic"
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- else
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
- fi
- # END CYGNUS LOCAL
- ;;
- ULTRIX-4.*)
- SHLIB_CFLAGS="-G 0"
- SHLIB_SUFFIX=".a"
- SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
- SHLIB_LD_LIBS='${LIBS}'
- DL_OBJS="tclLoadAout.o"
- DL_LIBS=""
- # CYGNUS LOCAL: The GNU linker doesn't accept `-D 08000000'. It
- # doesn't appear to be needed, either.
- hold_ldflags="$LDFLAGS"
- echo $ac_n "checking whether ld accepts -D 08000000""... $ac_c" 1>&6
-echo "configure:4835: checking whether ld accepts -D 08000000" >&5
- LD_FLAGS="-Wl,-D,08000000"
- LDFLAGS="${LDFLAGS} -Wl,-D,08000000"
- cat > conftest.$ac_ext <<EOF
-#line 4839 "configure"
-#include "confdefs.h"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ ;;
+ SunOS-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+ LDFLAGS=""
+
+ do64bit_ok=no
+ if test "$do64bit" = "yes" ; then
+ arch=`isainfo`
+ if test "$arch" = "sparcv9 sparc" ; then
+ if test "$using_gcc" = "no" ; then
+ do64bit_ok=yes
+ if test "$do64bitVIS" = "yes" ; then
+ EXTRA_CFLAGS="-xarch=v9a"
+ LDFLAGS="-xarch=v9a"
+ else
+ EXTRA_CFLAGS="-xarch=v9"
+ LDFLAGS="-xarch=v9"
+ fi
+ else
+ echo "configure: warning: "64bit mode not supported with GCC on $system"" 1>&2
+ fi
+ else
+ echo "configure: warning: "64bit mode only supported sparcv9 system"" 1>&2
+ fi
+ fi
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
-int main() {
-int i;
-; return 0; }
-EOF
-if { (eval echo configure:4846: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- found=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- found=no
-fi
-rm -f conftest*
- LDFLAGS=$hold_ldflags
- echo "$ac_t""$found" 1>&6
- if test $found = yes; then
- LD_FLAGS="-Wl,-D,08000000"
- else
- LD_FLAGS=""
- fi
- # END CYGNUS LOCAL
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- ;;
- UNIX_SV* | UnixWare-5*)
- SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
- # that don't grok the -Bexport option. Test that it does.
- hold_ldflags=$LDFLAGS
- echo $ac_n "checking for ld accepts -Bexport flag""... $ac_c" 1>&6
-echo "configure:4877: checking for ld accepts -Bexport flag" >&5
- LDFLAGS="${LDFLAGS} -Wl,-Bexport"
- cat > conftest.$ac_ext <<EOF
-#line 4880 "configure"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ if test "$using_gcc" = "yes" ; then
+ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ else
+ LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ fi
+ ;;
+ ULTRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="-DHAVE_TZSET -std1"
+ fi
+ ;;
+ UNIX_SV* | UnixWare-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
+ # that don't grok the -Bexport option. Test that it does.
+ hold_ldflags=$LDFLAGS
+ echo $ac_n "checking for ld accepts -Bexport flag""... $ac_c" 1>&6
+echo "configure:5631: checking for ld accepts -Bexport flag" >&5
+ LDFLAGS="${LDFLAGS} -Wl,-Bexport"
+ cat > conftest.$ac_ext <<EOF
+#line 5634 "configure"
#include "confdefs.h"
int main() {
int i;
; return 0; }
EOF
-if { (eval echo configure:4887: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5641: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
found=yes
else
@@ -4893,81 +5647,47 @@ else
found=no
fi
rm -f conftest*
- LDFLAGS=$hold_ldflags
- echo "$ac_t""$found" 1>&6
- if test $found = yes; then
- LD_FLAGS="-Wl,-Bexport"
- else
- LD_FLAGS=""
- fi
- LD_SEARCH_FLAGS=""
- ;;
-esac
-
-# Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic
-# Loading for Tcl -- What Became of It?". Proc. 2nd Tcl/Tk Workshop,
-# New Orleans, LA, Computerized Processes Unlimited, 1994), then we need
-# to determine which of several header files defines the a.out file
-# format (a.out.h, sys/exec.h, or sys/exec_aout.h). At present, we
-# support only a file format that is more or less version-7-compatible.
-# In particular,
-# - a.out files must begin with `struct exec'.
-# - the N_TXTOFF on the `struct exec' must compute the seek address
-# of the text segment
-# - The `struct exec' must contain a_magic, a_text, a_data, a_bss
-# and a_entry fields.
-# The following compilation should succeed if and only if either sys/exec.h
-# or a.out.h is usable for the purpose.
-#
-# Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
-# `struct exec' includes a second header that contains information that
-# duplicates the v7 fields that are needed.
-
-if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
- echo $ac_n "checking sys/exec.h""... $ac_c" 1>&6
-echo "configure:4929: checking sys/exec.h" >&5
- cat > conftest.$ac_ext <<EOF
-#line 4931 "configure"
-#include "confdefs.h"
-#include <sys/exec.h>
-int main() {
-
- struct exec foo;
- unsigned long seek;
- int flag;
-#if defined(__mips) || defined(mips)
- seek = N_TXTOFF (foo.ex_f, foo.ex_o);
-#else
- seek = N_TXTOFF (foo);
-#endif
- flag = (foo.a_magic == OMAGIC);
- return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ LDFLAGS=$hold_ldflags
+ echo "$ac_t""$found" 1>&6
+ if test $found = yes; then
+ LDFLAGS="-Wl,-Bexport"
+ else
+ LDFLAGS=""
+ fi
+ LD_SEARCH_FLAGS=""
+ ;;
+ esac
-; return 0; }
-EOF
-if { (eval echo configure:4949: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_ok=usable
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_ok=unusable
-fi
-rm -f conftest*
- echo "$ac_t""$tcl_ok" 1>&6
- if test $tcl_ok = usable; then
- cat >> confdefs.h <<\EOF
-#define USE_SYS_EXEC_H 1
-EOF
+ if test "$do64bit" = "yes" -a "$do64bit_ok" = "no" ; then
+ echo "configure: warning: "64bit support being disabled -- don\'t know magic for this platform"" 1>&2
+ fi
- else
- echo $ac_n "checking a.out.h""... $ac_c" 1>&6
-echo "configure:4967: checking a.out.h" >&5
+ # Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic
+ # Loading for Tcl -- What Became of It?". Proc. 2nd Tcl/Tk Workshop,
+ # New Orleans, LA, Computerized Processes Unlimited, 1994), then we need
+ # to determine which of several header files defines the a.out file
+ # format (a.out.h, sys/exec.h, or sys/exec_aout.h). At present, we
+ # support only a file format that is more or less version-7-compatible.
+ # In particular,
+ # - a.out files must begin with `struct exec'.
+ # - the N_TXTOFF on the `struct exec' must compute the seek address
+ # of the text segment
+ # - The `struct exec' must contain a_magic, a_text, a_data, a_bss
+ # and a_entry fields.
+ # The following compilation should succeed if and only if either sys/exec.h
+ # or a.out.h is usable for the purpose.
+ #
+ # Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
+ # `struct exec' includes a second header that contains information that
+ # duplicates the v7 fields that are needed.
+
+ if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
+ echo $ac_n "checking sys/exec.h""... $ac_c" 1>&6
+echo "configure:5687: checking sys/exec.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 4969 "configure"
+#line 5689 "configure"
#include "confdefs.h"
-#include <a.out.h>
+#include <sys/exec.h>
int main() {
struct exec foo;
@@ -4980,10 +5700,10 @@ int main() {
#endif
flag = (foo.a_magic == OMAGIC);
return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
-
+
; return 0; }
EOF
-if { (eval echo configure:4987: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:5707: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=usable
else
@@ -4996,16 +5716,16 @@ rm -f conftest*
echo "$ac_t""$tcl_ok" 1>&6
if test $tcl_ok = usable; then
cat >> confdefs.h <<\EOF
-#define USE_A_OUT_H 1
+#define USE_SYS_EXEC_H 1
EOF
else
- echo $ac_n "checking sys/exec_aout.h""... $ac_c" 1>&6
-echo "configure:5005: checking sys/exec_aout.h" >&5
+ echo $ac_n "checking a.out.h""... $ac_c" 1>&6
+echo "configure:5725: checking a.out.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 5007 "configure"
+#line 5727 "configure"
#include "confdefs.h"
-#include <sys/exec_aout.h>
+#include <a.out.h>
int main() {
struct exec foo;
@@ -5016,12 +5736,12 @@ int main() {
#else
seek = N_TXTOFF (foo);
#endif
- flag = (foo.a_midmag == OMAGIC);
+ flag = (foo.a_magic == OMAGIC);
return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
; return 0; }
EOF
-if { (eval echo configure:5025: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:5745: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=usable
else
@@ -5034,19 +5754,57 @@ rm -f conftest*
echo "$ac_t""$tcl_ok" 1>&6
if test $tcl_ok = usable; then
cat >> confdefs.h <<\EOF
-#define USE_SYS_EXEC_AOUT_H 1
+#define USE_A_OUT_H 1
EOF
else
- DL_OBJS=""
+ echo $ac_n "checking sys/exec_aout.h""... $ac_c" 1>&6
+echo "configure:5763: checking sys/exec_aout.h" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 5765 "configure"
+#include "confdefs.h"
+#include <sys/exec_aout.h>
+int main() {
+
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_midmag == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+
+; return 0; }
+EOF
+if { (eval echo configure:5783: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_ok=usable
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_ok=unusable
+fi
+rm -f conftest*
+ echo "$ac_t""$tcl_ok" 1>&6
+ if test $tcl_ok = usable; then
+ cat >> confdefs.h <<\EOF
+#define USE_SYS_EXEC_AOUT_H 1
+EOF
+
+ else
+ DL_OBJS=""
+ fi
fi
fi
fi
-fi
-# Step 5: disable dynamic loading if requested via a command-line switch.
+ # Step 5: disable dynamic loading if requested via a command-line switch.
-# Check whether --enable-load or --disable-load was given.
+ # Check whether --enable-load or --disable-load was given.
if test "${enable_load+set}" = set; then
enableval="$enable_load"
tcl_ok=$enableval
@@ -5054,51 +5812,97 @@ else
tcl_ok=yes
fi
-if test "$tcl_ok" = "no"; then
- DL_OBJS=""
-fi
+ if test "$tcl_ok" = "no"; then
+ DL_OBJS=""
+ fi
-if test "x$DL_OBJS" != "x" ; then
- BUILD_DLTEST="\$(DLTEST_TARGETS)"
-else
- echo "Can't figure out how to do dynamic loading or shared libraries"
- echo "on this system."
- SHLIB_CFLAGS=""
- SHLIB_LD=""
- SHLIB_SUFFIX=""
- DL_OBJS="tclLoadNone.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- BUILD_DLTEST=""
-fi
+ if test "x$DL_OBJS" != "x" ; then
+ BUILD_DLTEST="\$(DLTEST_TARGETS)"
+ else
+ echo "Can't figure out how to do dynamic loading or shared libraries"
+ echo "on this system."
+ SHLIB_CFLAGS=""
+ SHLIB_LD=""
+ SHLIB_SUFFIX=""
+ DL_OBJS="tclLoadNone.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ BUILD_DLTEST=""
+ fi
-# If we're running gcc, then change the C flags for compiling shared
-# libraries to the right flags for gcc, instead of those for the
-# standard manufacturer compiler.
+ # If we're running gcc, then change the C flags for compiling shared
+ # libraries to the right flags for gcc, instead of those for the
+ # standard manufacturer compiler.
+
+ if test "$DL_OBJS" != "tclLoadNone.o" ; then
+ if test "$using_gcc" = "yes" ; then
+ case $system in
+ AIX-*)
+ ;;
+ BSD/OS*)
+ ;;
+ IRIX*)
+ ;;
+ NetBSD-*|FreeBSD-*|OpenBSD-*)
+ ;;
+ RISCos-*)
+ ;;
+ SCO_SV-3.2*)
+ ;;
+ ULTRIX-4.*)
+ ;;
+ *)
+ SHLIB_CFLAGS="-fPIC"
+ ;;
+ esac
+ fi
+ fi
-if test "$DL_OBJS" != "tclLoadNone.o" ; then
- if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
- case $system in
- AIX-*)
- ;;
- BSD/OS*)
- ;;
- IRIX*)
- ;;
- NetBSD-*|FreeBSD-*|OpenBSD-*)
- ;;
- RISCos-*)
- ;;
- ULTRIX-4.*)
- ;;
- *)
- SHLIB_CFLAGS="-fPIC"
- ;;
- esac
+ if test "$SHARED_LIB_SUFFIX" = "" ; then
+ SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}${SHLIB_SUFFIX}'
+ fi
+ if test "$UNSHARED_LIB_SUFFIX" = "" ; then
+ UNSHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
fi
+
+# CYGNUS LOCAL
+ TCL_LIB_SUFFIX=.a
+
+# END CYGNUS LOCAL
+
+
+
+
+
+
+
+
+ echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
+echo "configure:5883: checking for build with symbols" >&5
+ # Check whether --enable-symbols or --disable-symbols was given.
+if test "${enable_symbols+set}" = set; then
+ enableval="$enable_symbols"
+ tcl_ok=$enableval
+else
+ tcl_ok=no
fi
+ if test "$tcl_ok" = "yes"; then
+ CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
+ DBGX=g
+ echo "$ac_t""yes" 1>&6
+ else
+ CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ DBGX=""
+ echo "$ac_t""no" 1>&6
+ fi
+
+
+TCL_DBGX=${DBGX}
+
#--------------------------------------------------------------------
# The statements below check for systems where POSIX-style
# non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented.
@@ -5106,21 +5910,22 @@ fi
# FIONBIO approach instead.
#--------------------------------------------------------------------
-for ac_hdr in sys/ioctl.h
+
+ for ac_hdr in sys/ioctl.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:5114: checking for $ac_hdr" >&5
+echo "configure:5919: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5119 "configure"
+#line 5924 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5124: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5929: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -5146,21 +5951,21 @@ else
fi
done
-for ac_hdr in sys/filio.h
+ for ac_hdr in sys/filio.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:5154: checking for $ac_hdr" >&5
+echo "configure:5959: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5159 "configure"
+#line 5964 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5164: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5969: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -5186,71 +5991,71 @@ else
fi
done
-echo $ac_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O""... $ac_c" 1>&6
-echo "configure:5191: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
-if test -f /usr/lib/NextStep/software_version; then
- system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
-else
- system=`uname -s`-`uname -r`
- if test "$?" -ne 0 ; then
- system=unknown
+ echo $ac_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O""... $ac_c" 1>&6
+echo "configure:5996: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
+ if test -f /usr/lib/NextStep/software_version; then
+ system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
else
- # Special check for weird MP-RAS system (uname returns weird
- # results, and the version is kept in special file).
-
- if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
- system=MP-RAS-`awk '{print $3}' /etc/.relid'`
- fi
- if test "`uname -s`" = "AIX" ; then
- system=AIX-`uname -v`.`uname -r`
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ system=unknown
+ else
+ # Special check for weird MP-RAS system (uname returns weird
+ # results, and the version is kept in special file).
+
+ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+ system=MP-RAS-`awk '{print }' /etc/.relid'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
fi
fi
-fi
-case $system in
- # There used to be code here to use FIONBIO under AIX. However, it
- # was reported that FIONBIO doesn't work under AIX 3.2.5. Since
- # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO
- # code (JO, 5/31/97).
+ case $system in
+ # There used to be code here to use FIONBIO under AIX. However, it
+ # was reported that FIONBIO doesn't work under AIX 3.2.5. Since
+ # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO
+ # code (JO, 5/31/97).
- OSF*)
- cat >> confdefs.h <<\EOF
+ OSF*)
+ cat >> confdefs.h <<\EOF
#define USE_FIONBIO 1
EOF
- echo "$ac_t""FIONBIO" 1>&6
- ;;
- SunOS-4*)
- cat >> confdefs.h <<\EOF
+ echo "$ac_t""FIONBIO" 1>&6
+ ;;
+ SunOS-4*)
+ cat >> confdefs.h <<\EOF
#define USE_FIONBIO 1
EOF
- echo "$ac_t""FIONBIO" 1>&6
- ;;
- ULTRIX-4.*)
- cat >> confdefs.h <<\EOF
+ echo "$ac_t""FIONBIO" 1>&6
+ ;;
+ ULTRIX-4.*)
+ cat >> confdefs.h <<\EOF
#define USE_FIONBIO 1
EOF
- echo "$ac_t""FIONBIO" 1>&6
- ;;
- *)
- echo "$ac_t""O_NONBLOCK" 1>&6
- ;;
-esac
+ echo "$ac_t""FIONBIO" 1>&6
+ ;;
+ *)
+ echo "$ac_t""O_NONBLOCK" 1>&6
+ ;;
+ esac
+
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------
-realRanlib=$RANLIB
-if test "$TCL_SHARED_LIB_SUFFIX" = "" ; then
- TCL_SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
-fi
-if test "$TCL_UNSHARED_LIB_SUFFIX" = "" ; then
- TCL_UNSHARED_LIB_SUFFIX='${VERSION}.a'
-fi
-# Check whether --enable-shared or --disable-shared was given.
+TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
+TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
+
+
+ echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
+echo "configure:6058: checking how to build libraries" >&5
+ # Check whether --enable-shared or --disable-shared was given.
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
tcl_ok=$enableval
@@ -5258,24 +6063,61 @@ else
tcl_ok=no
fi
-# CYGNUS LOCAL: need extra variables for this information.
-TCL_SHARED_LIB_FILE=dummy1
-TCL_UNSHARED_LIB_FILE=dummy2
-# END CYGNUS LOCAL
-if test "$tcl_ok" = "yes" -a "${SHLIB_SUFFIX}" != "" ; then
- TCL_SHARED_BUILD=1
+
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=no
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ echo "$ac_t""shared" 1>&6
+ SHARED_BUILD=1
+ else
+ echo "$ac_t""static" 1>&6
+ SHARED_BUILD=0
+ cat >> confdefs.h <<\EOF
+#define STATIC_BUILD 1
+EOF
+
+ fi
+
+
+if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != "" ; then
TCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
- eval "TCL_LIB_FILE=libtcl${TCL_SHARED_LIB_SUFFIX}"
- TCL_SHARED_LIB_FILE="$TCL_LIB_FILE"
+
+ libname=tcl
+ suffix=${TCL_SHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TCL_LIB_FILE=$long_libname
+
+
+ # FIXME: Why does MAKE_LIB not use a generic LIB_FILE variable
+ # that is replaced with the Makefiles specific stub lib name?
if test "x$DL_OBJS" = "xtclLoadAout.o"; then
- MAKE_LIB="ar cr \${TCL_LIB_FILE} \${OBJS}"
+ MAKE_LIB="\${STLIB_LD} \${TCL_LIB_FILE} \${OBJS}"
else
MAKE_LIB="\${SHLIB_LD} -o \${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
RANLIB=":"
fi
else
- TCL_SHARED_BUILD=0
case $system in
BSD/OS*)
;;
@@ -5288,10 +6130,33 @@ else
;;
esac
TCL_SHLIB_CFLAGS=""
- TCL_LD_SEARCH_FLAGS=""
- eval "TCL_LIB_FILE=libtcl${TCL_UNSHARED_LIB_SUFFIX}"
- TCL_UNSHARED_LIB_FILE="$TCL_LIB_FILE"
- MAKE_LIB="$AR cr ${TCL_LIB_FILE} \${OBJS}"
+ TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
+
+ libname=tcl
+ suffix=${TCL_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TCL_LIB_FILE=$long_libname
+
+ MAKE_LIB="\${STLIB_LD} \${TCL_LIB_FILE} \${OBJS}"
fi
# Note: in the following variable, it's important to use the absolute
@@ -5299,15 +6164,231 @@ fi
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.
-if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
- TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl${VERSION}"
- TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl${VERSION}"
+if test "$SHARED_BUILD" = "0" -o $TCL_NEEDS_EXP_FILE = 0; then
+
+ libname=tcl
+ version=$TCL_VERSION
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ TCL_LIB_FLAG=$short_libname
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="`pwd`/${TCL_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_BUILD_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_BUILD_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_BUILD_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_BUILD_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=`pwd`
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TCL_BUILD_LIB_SPEC="-L${dirname} ${TCL_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
+ ;;
+ esac
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="${exec_prefix}/lib/${TCL_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=${exec_prefix}/lib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TCL_LIB_SPEC="-L${dirname} ${TCL_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TCL_LIB_SPEC="-L${exec_prefix}/lib ${TCL_LIB_FLAG}"
+ ;;
+ esac
+
else
- TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
- TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
+ # FIXME: This if branch needs to be updated with respect
+ # to the library macro changes above!
+ TCL_BUILD_EXP_FILE="lib.exp"
+ eval "TCL_EXP_FILE=libtcl${TCL_EXPORT_FILE_SUFFIX}"
+
+ # Replace DBGX with TCL_DBGX
+ eval "TCL_EXP_FILE=\"${TCL_EXP_FILE}\""
+
+ if test "$using_gcc" = "yes" ; then
+ TCL_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TCL_BUILD_EXP_FILE} -L`pwd`"
+ TCL_LIB_SPEC="-Wl,-bI:${exec_prefix}/lib/${TCL_EXP_FILE} -L`pwd`"
+ else
+ TCL_BUILD_LIB_SPEC="-bI:`pwd`/${TCL_BUILD_EXP_FILE}"
+ TCL_LIB_SPEC="-bI:${exec_prefix}/lib/${TCL_EXP_FILE}"
+ fi
fi
-TCL_LIB_FULL_PATH="`pwd`/${TCL_LIB_FILE}"
+
+ val="`pwd`/${TCL_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_LIB_FULL_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_LIB_FULL_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_LIB_FULL_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_LIB_FULL_PATH=$val
+ ;;
+ esac
+
+
+
+VERSION='${VERSION}'
+eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
+eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
+eval "CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}"
+VERSION=${TCL_VERSION}
#--------------------------------------------------------------------
# The statements below define the symbol TCL_PACKAGE_PATH, which
@@ -5322,6 +6403,302 @@ else
TCL_PACKAGE_PATH="${prefix}/lib"
fi
+#--------------------------------------------------------------------
+# The statements below define various symbols relating to Tcl
+# stub support. Note that the STUB_LIB_FILE variable must
+# be set in the Makefile before running MAKE_STUB_LIB.
+#--------------------------------------------------------------------
+
+MAKE_STUB_LIB="\${STLIB_LD} \${STUB_LIB_FILE} \${STUB_LIB_OBJS}"
+
+
+ libname=tclstub
+ suffix=${TCL_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TCL_STUB_LIB_FILE=$long_libname
+
+
+
+ libname=tclstub
+ version=$TCL_VERSION
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ TCL_STUB_LIB_FLAG=$short_libname
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="`pwd`/${TCL_STUB_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_BUILD_STUB_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_BUILD_STUB_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_BUILD_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_BUILD_STUB_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=`pwd`
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TCL_BUILD_STUB_LIB_SPEC="-L${dirname} ${TCL_STUB_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}"
+ ;;
+ esac
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="${exec_prefix}/lib/${TCL_STUB_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_STUB_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_STUB_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_STUB_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=${exec_prefix}/lib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TCL_STUB_LIB_SPEC="-L${dirname} ${TCL_STUB_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TCL_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TCL_STUB_LIB_FLAG}"
+ ;;
+ esac
+
+
+
+
+ val="`pwd`/${TCL_STUB_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_BUILD_STUB_LIB_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_BUILD_STUB_LIB_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_BUILD_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_BUILD_STUB_LIB_PATH=$val
+ ;;
+ esac
+
+
+
+
+ val="${exec_prefix}/lib/${TCL_STUB_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_STUB_LIB_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_STUB_LIB_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_STUB_LIB_PATH=$val
+ ;;
+ esac
+
+
+
+#------------------------------------------------------------------------
+# tclConfig.sh refers to this by a different name
+#------------------------------------------------------------------------
+
+TCL_SHARED_BUILD=${SHARED_BUILD}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -5349,10 +6726,8 @@ fi
-# CYGNUS LOCAL
-# END CYGNUS LOCAL
trap '' 1 2 15
cat > confcache <<\EOF
@@ -5499,28 +6874,56 @@ s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
-s%@RANLIB@%$RANLIB%g
s%@CC@%$CC%g
+s%@RANLIB@%$RANLIB%g
+s%@CPP@%$CPP%g
s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
s%@INSTALL_DATA@%$INSTALL_DATA%g
-s%@CPP@%$CPP%g
s%@LIBOBJS@%$LIBOBJS%g
-s%@BUILD_DLTEST@%$BUILD_DLTEST%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@MATH_LIBS@%$MATH_LIBS%g
+s%@AR@%$AR%g
+s%@TCL_LIB_SUFFIX@%$TCL_LIB_SUFFIX%g
s%@DL_LIBS@%$DL_LIBS%g
+s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
+s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
+s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g
+s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
+s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
+s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
+s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g
+s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
+s%@TCL_STUB_LIB_PATH@%$TCL_STUB_LIB_PATH%g
+s%@MAKE_STUB_LIB@%$MAKE_STUB_LIB%g
+s%@BUILD_DLTEST@%$BUILD_DLTEST%g
+s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
+s%@CFG_TCL_SHARED_LIB_SUFFIX@%$CFG_TCL_SHARED_LIB_SUFFIX%g
+s%@CFG_TCL_UNSHARED_LIB_SUFFIX@%$CFG_TCL_UNSHARED_LIB_SUFFIX%g
+s%@CFG_TCL_EXPORT_FILE_SUFFIX@%$CFG_TCL_EXPORT_FILE_SUFFIX%g
+s%@TCL_DBGX@%$TCL_DBGX%g
s%@DL_OBJS@%$DL_OBJS%g
-s%@LD_FLAGS@%$LD_FLAGS%g
+s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
+s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
+s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g
+s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g
s%@MAKE_LIB@%$MAKE_LIB%g
-s%@MATH_LIBS@%$MATH_LIBS%g
+s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
s%@SHLIB_LD@%$SHLIB_LD%g
+s%@STLIB_LD@%$STLIB_LD%g
s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@TCL_LDFLAGS_DEBUG@%$TCL_LDFLAGS_DEBUG%g
+s%@TCL_LDFLAGS_OPTIMIZE@%$TCL_LDFLAGS_OPTIMIZE%g
s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
+s%@TCL_NEEDS_EXP_FILE@%$TCL_NEEDS_EXP_FILE%g
+s%@TCL_BUILD_EXP_FILE@%$TCL_BUILD_EXP_FILE%g
+s%@TCL_EXP_FILE@%$TCL_EXP_FILE%g
s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
@@ -5528,13 +6931,12 @@ s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g
-s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g
s%@TCL_VERSION@%$TCL_VERSION%g
-s%@TCL_SHARED_LIB_FILE@%$TCL_SHARED_LIB_FILE%g
-s%@TCL_UNSHARED_LIB_FILE@%$TCL_UNSHARED_LIB_FILE%g
+s%@VENDORPREFIX@%$VENDORPREFIX%g
CEOF
EOF
@@ -5647,3 +7049,4 @@ chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tcl/unix/configure.in b/tcl/unix/configure.in
index a00c889d270..1572528d56a 100755
--- a/tcl/unix/configure.in
+++ b/tcl/unix/configure.in
@@ -1,3 +1,4 @@
+#! /bin/bash -norc
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
@@ -7,14 +8,18 @@ AC_PREREQ(2.5)
# END CYGNUS LOCAL
AC_INIT(../generic/tcl.h)
-# SCCS: @(#) configure.in 1.18 98/08/12 17:29:39
+# RCS: @(#) $Id$
-TCL_VERSION=8.0
+TCL_VERSION=8.3
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL=".3"
+TCL_MINOR_VERSION=3
+TCL_PATCH_LEVEL=".2"
VERSION=${TCL_VERSION}
+#------------------------------------------------------------------------
+# Handle the --prefix=... option
+#------------------------------------------------------------------------
+
if test "${prefix}" = "NONE"; then
prefix=/usr/local
fi
@@ -23,17 +28,14 @@ if test "${exec_prefix}" = "NONE"; then
fi
TCL_SRC_DIR=`cd $srcdir/..; pwd`
+#------------------------------------------------------------------------
+# Standard compiler checks
+#------------------------------------------------------------------------
+
+AC_PROG_CC
AC_PROG_RANLIB
-dnl CYGNUS LOCAL: allow gcc without a special flag
-dnl AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
-dnl [tcl_ok=$enableval], [tcl_ok=no])
-dnl if test "$tcl_ok" = "yes"; then
- AC_PROG_CC
-dnl else
-dnl CC=${CC-cc}
-dnl AC_SUBST(CC)
-dnl fi
-dnl END CYGNUS LOCAL
+
+AC_HAVE_HEADERS(unistd.h limits.h)
# CYGNUS LOCAL
# dje/win32
@@ -54,11 +56,27 @@ AC_PROG_INSTALL
#--------------------------------------------------------------------
CY_AC_TCL_LYNX_POSIX
-# set the warning flags depending on whether or not we are using gcc
-if test "${GCC}" = "yes" ; then
- CFLAGS_WARNING="-Wall -Wconversion"
-else
- CFLAGS_WARNING=""
+#------------------------------------------------------------------------
+# Threads support
+#------------------------------------------------------------------------
+
+SC_ENABLE_THREADS
+
+#------------------------------------------------------------------------
+# If we're using GCC, see if the compiler understands -pipe. If so, use it.
+# It makes compiling go faster. (This is only a performance feature.)
+#------------------------------------------------------------------------
+
+if test -z "$no_pipe"; then
+if test -n "$GCC"; then
+ AC_MSG_CHECKING([if the compiler understands -pipe])
+ OLDCC="$CC"
+ CC="$CC -pipe"
+ AC_TRY_COMPILE(,,
+ AC_MSG_RESULT(yes),
+ CC="$OLDCC"
+ AC_MSG_RESULT(no))
+fi
fi
#--------------------------------------------------------------------
@@ -78,31 +96,7 @@ AC_CHECK_FUNC(strerror, , AC_DEFINE(NO_STRERROR))
AC_CHECK_FUNC(getwd, , AC_DEFINE(NO_GETWD))
AC_CHECK_FUNC(wait3, , AC_DEFINE(NO_WAIT3))
AC_CHECK_FUNC(uname, , AC_DEFINE(NO_UNAME))
-
-#--------------------------------------------------------------------
-# On a few very rare systems, all of the libm.a stuff is
-# already in libc.a. Set compiler flags accordingly.
-# Also, Linux requires the "ieee" library for math to work
-# right (and it must appear before "-lm").
-#--------------------------------------------------------------------
-
-AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
-AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
-
-#--------------------------------------------------------------------
-# On AIX systems, libbsd.a has to be linked in to support
-# non-blocking file IO. This library has to be linked in after
-# the MATH_LIBS or it breaks the pow() function. The way to
-# insure proper sequencing, is to add it to the tail of MATH_LIBS.
-# This library also supplies gettimeofday.
-#--------------------------------------------------------------------
-libbsd=no
-if test "`uname -s`" = "AIX" ; then
- AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
- if test $libbsd = yes; then
- MATH_LIBS="$MATH_LIBS -lbsd"
- fi
-fi
+AC_CHECK_FUNC(realpath, , AC_DEFINE(NO_REALPATH))
#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files. Special
@@ -113,51 +107,7 @@ fi
# as strstr
#--------------------------------------------------------------------
-AC_MSG_CHECKING(dirent.h)
-AC_TRY_LINK([#include <sys/types.h>
-#include <dirent.h>], [
-#ifndef _POSIX_SOURCE
-# ifdef __Lynx__
- /*
- * Generate compilation error to make the test fail: Lynx headers
- * are only valid if really in the POSIX environment.
- */
-
- missing_procedure();
-# endif
-#endif
-DIR *d;
-struct dirent *entryPtr;
-char *p;
-d = opendir("foobar");
-entryPtr = readdir(d);
-p = entryPtr->d_name;
-closedir(d);
-], tcl_ok=yes, tcl_ok=no)
-if test $tcl_ok = no; then
- AC_DEFINE(NO_DIRENT_H)
-fi
-AC_MSG_RESULT($tcl_ok)
-AC_CHECK_HEADER(errno.h, , AC_DEFINE(NO_ERRNO_H))
-AC_CHECK_HEADER(float.h, , AC_DEFINE(NO_FLOAT_H))
-AC_CHECK_HEADER(values.h, , AC_DEFINE(NO_VALUES_H))
-AC_CHECK_HEADER(limits.h, , AC_DEFINE(NO_LIMITS_H))
-AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
-AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
-AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
-AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0)
-if test $tcl_ok = 0; then
- AC_DEFINE(NO_STDLIB_H)
-fi
-AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
-AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
-AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)
-if test $tcl_ok = 0; then
- AC_DEFINE(NO_STRING_H)
-fi
-AC_CHECK_HEADER(sys/wait.h, , AC_DEFINE(NO_SYS_WAIT_H))
-AC_CHECK_HEADER(dlfcn.h, , AC_DEFINE(NO_DLFCN_H))
-AC_HAVE_HEADERS(unistd.h)
+SC_MISSING_POSIX_HEADERS
#---------------------------------------------------------------------------
# Determine which interface to use to talk to the serial port.
@@ -165,57 +115,7 @@ AC_HAVE_HEADERS(unistd.h)
# some compilers to recognize them as preprocessor directives.
#---------------------------------------------------------------------------
-AC_MSG_CHECKING([termios vs. termio vs. sgtty])
-AC_TRY_RUN([
-#include <termios.h>
-
-main()
-{
- struct termios t;
- if (tcgetattr(0, &t) == 0) {
- cfsetospeed(&t, 0);
- t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
- return 0;
- }
- return 1;
-}], tk_ok=termios, tk_ok=no, tk_ok=no)
-if test $tk_ok = termios; then
- AC_DEFINE(USE_TERMIOS)
-else
-AC_TRY_RUN([
-#include <termio.h>
-
-main()
-{
- struct termio t;
- if (ioctl(0, TCGETA, &t) == 0) {
- t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
- return 0;
- }
- return 1;
-}], tk_ok=termio, tk_ok=no, tk_ok=no)
-if test $tk_ok = termio; then
- AC_DEFINE(USE_TERMIO)
-else
-AC_TRY_RUN([
-#include <sgtty.h>
-
-main()
-{
- struct sgttyb t;
- if (ioctl(0, TIOCGETP, &t) == 0) {
- t.sg_ospeed = 0;
- t.sg_flags |= ODDP | EVENP | RAW;
- return 0;
- }
- return 1;
-}], tk_ok=sgtty, tk_ok=none, tk_ok=none)
-if test $tk_ok = sgtty; then
- AC_DEFINE(USE_SGTTY)
-fi
-fi
-fi
-AC_MSG_RESULT($tk_ok)
+SC_SERIAL_PORT
#--------------------------------------------------------------------
# Include sys/select.h if it exists and if it supplies things
@@ -245,82 +145,27 @@ fi
# Find out all about time handling differences.
#------------------------------------------------------------------------------
-AC_CHECK_HEADERS(sys/time.h)
-AC_HEADER_TIME
-AC_STRUCT_TIMEZONE
-
-AC_MSG_CHECKING([tm_tzadj in struct tm])
-AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
- [AC_DEFINE(HAVE_TM_TZADJ)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
-
-AC_MSG_CHECKING([tm_gmtoff in struct tm])
-AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
- [AC_DEFINE(HAVE_TM_GMTOFF)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
-
-#
-# Its important to include time.h in this check, as some systems (like convex)
-# have timezone functions, etc.
-#
-have_timezone=no
-AC_MSG_CHECKING([long timezone variable])
-AC_TRY_COMPILE([#include <time.h>],
- [extern long timezone;
- timezone += 1;
- exit (0);],
- [have_timezone=yes
- AC_DEFINE(HAVE_TIMEZONE_VAR)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
-
-#
-# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
-#
-if test "$have_timezone" = no; then
- AC_MSG_CHECKING([time_t timezone variable])
- AC_TRY_COMPILE([#include <time.h>],
- [extern time_t timezone;
- timezone += 1;
- exit (0);],
- [have_timezone=yes
- AC_DEFINE(HAVE_TIMEZONE_VAR)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
-fi
-
-#
-# On some systems (eg Solaris 2.5.1, timezone is not declared in
-# time.h unless you jump through hoops. Instead of that, we just
-# declare it ourselves when necessary.
-#
-if test "$have_timezone" = yes; then
- AC_MSG_CHECKING(for timezone declaration)
- changequote(<<,>>)
- tzrx='^[ ]*extern.*timezone'
- changequote([,])
- AC_EGREP_HEADER($tzrx, time.h, [
- AC_DEFINE(HAVE_TIMEZONE_DECL)
- AC_MSG_RESULT(found)], AC_MSG_RESULT(missing))
-fi
-
-#
-# AIX does not have a timezone field in struct tm. When the AIX bsd
-# library is used, the timezone global and the gettimeofday methods are
-# to be avoided for timezone deduction instead, we deduce the timezone
-# by comparing the localtime result on a known GMT value.
-#
-if test $libbsd = yes; then
- AC_DEFINE(USE_DELTA_FOR_TZ)
-fi
+SC_TIME_HANDLER
#--------------------------------------------------------------------
# Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
-# in struct stat.
+# in struct stat. But we might be able to use fstatfs instead.
#--------------------------------------------------------------------
AC_STRUCT_ST_BLKSIZE
+AC_CHECK_FUNC(fstatfs, , AC_DEFINE(NO_FSTATFS))
+
+#--------------------------------------------------------------------
+# Some system have no memcmp or it does not work with 8 bit
+# data, this checks it and add memcmp.o to LIBOBJS if needed
+#--------------------------------------------------------------------
+AC_FUNC_MEMCMP
+
+#--------------------------------------------------------------------
+# Some system like SunOS 4 and other BSD like systems
+# have no memmove (we assume they have bcopy instead).
+# {The replacement define is in compat/string.h}
+#--------------------------------------------------------------------
+AC_CHECK_FUNC(memmove, , AC_DEFINE(NO_MEMMOVE) AC_DEFINE(NO_STRING_H))
#--------------------------------------------------------------------
# On some systems strstr is broken: it returns a pointer even
@@ -398,29 +243,7 @@ fi
# "fixstrtod" that corrects the error.
#--------------------------------------------------------------------
-AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
-if test "$tcl_strtod" = 1; then
- AC_MSG_CHECKING([for Solaris strtod bug])
- AC_TRY_RUN([
-extern double strtod();
-int main()
-{
- char *string = "NaN";
- char *term;
- strtod(string, &term);
- if ((term != string) && (term[-1] == 0)) {
- exit(1);
- }
- exit(0);
-}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
- if test $tcl_ok = 1; then
- AC_MSG_RESULT(ok)
- else
- AC_MSG_RESULT(buggy)
- LIBOBJS="$LIBOBJS fixstrtod.o"
- AC_DEFINE(strtod, fixstrtod)
- fi
-fi
+SC_BUGGY_STRTOD
#--------------------------------------------------------------------
# Check for various typedefs and provide substitutes if
@@ -562,14 +385,6 @@ AC_EGREP_HEADER(gettimeofday, sys/time.h, AC_MSG_RESULT(present), [
])
#--------------------------------------------------------------------
-# Interactive UNIX requires -linet instead of -lsocket, plus it
-# needs net/errno.h to define the socket-related error codes.
-#--------------------------------------------------------------------
-
-AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
-AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H))
-
-#--------------------------------------------------------------------
# The following code checks to see whether it is possible to get
# signed chars on this platform. This is needed in order to
# properly generate sign-extended ints from character values.
@@ -586,642 +401,28 @@ if test $tcl_ok = yes; then
AC_DEFINE(HAVE_SIGNED_CHAR)
fi
-#--------------------------------------------------------------------
-# Check for the existence of the -lsocket and -lnsl libraries.
-# The order here is important, so that they end up in the right
-# order in the command line generated by make. Here are some
-# special considerations:
-# 1. Use "connect" and "accept" to check for -lsocket, and
-# "gethostbyname" to check for -lnsl.
-# 2. Use each function name only once: can't redo a check because
-# autoconf caches the results of the last check and won't redo it.
-# 3. Use -lnsl and -lsocket only if they supply procedures that
-# aren't already present in the normal libraries. This is because
-# IRIX 5.2 has libraries, but they aren't needed and they're
-# bogus: they goof up name resolution if used.
-# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
-# To get around this problem, check for both libraries together
-# if -lsocket doesn't work by itself.
-#--------------------------------------------------------------------
-
-# CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
-# mess up the cache values of the functions we check for.
-AC_CACHE_CHECK([for socket libraries], tcl_cv_lib_sockets,
- [tcl_cv_lib_sockets=
- tcl_checkBoth=0
- unset ac_cv_func_connect
- AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
- if test "$tcl_checkSocket" = 1; then
- unset ac_cv_func_connect
- AC_CHECK_LIB(socket, main, tcl_cv_lib_sockets="-lsocket",
- tcl_checkBoth=1)
- fi
- if test "$tcl_checkBoth" = 1; then
- tcl_oldLibs=$LIBS
- LIBS="$LIBS -lsocket -lnsl"
- unset ac_cv_func_accept
- AC_CHECK_FUNC(accept,
- [tcl_checkNsl=0
- tcl_cv_lib_sockets="-lsocket -lnsl"])
- unset ac_cv_func_accept
- LIBS=$tcl_oldLibs
- fi
- unset ac_cv_func_gethostbyname
- tcl_oldLibs=$LIBS
- LIBS="$LIBS $tcl_cv_lib_sockets"
- AC_CHECK_FUNC(gethostbyname, ,
- [AC_CHECK_LIB(nsl, main,
- [tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"])])
- unset ac_cv_func_gethostbyname
- LIBS=$tcl_oldLIBS
-])
-test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
#--------------------------------------------------------------------
-# The statements below define a collection of symbols related to
-# dynamic loading and shared libraries:
-#
-# DL_OBJS - Name of the object file that implements dynamic
-# loading for Tcl on this system.
-# DL_LIBS - Library file(s) to include in tclsh and other base
-# applications in order for the "load" command to work.
-# LD_FLAGS - Flags to pass to the compiler when linking object
-# files into an executable application binary such
-# as tclsh.
-# LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib",
-# that tell the run-time dynamic linker where to look
-# for shared libraries such as libtcl.so. Depends on
-# the variable LIB_RUNTIME_DIR in the Makefile.
-# MAKE_LIB - Command to execute to build the Tcl library;
-# differs depending on whether or not Tcl is being
-# compiled as a shared library.
-# SHLIB_CFLAGS - Flags to pass to cc when compiling the components
-# of a shared library (may request position-independent
-# code, among other things).
-# SHLIB_LD - Base command to use for combining object files
-# into a shared library.
-# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
-# creating shared libraries. This symbol typically
-# goes at the end of the "ld" commands that build
-# shared libraries. The value of the symbol is
-# "${LIBS}" if all of the dependent libraries should
-# be specified when creating a shared library. If
-# dependent libraries should not be specified (as on
-# SunOS 4.x, where they cause the link to fail, or in
-# general if Tcl and Tk aren't themselves shared
-# libraries), then this symbol has an empty string
-# as its value.
-# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable
-# extensions. An empty string means we don't know how
-# to use shared libraries on this platform.
-# TCL_LIB_FILE - Name of the file that contains the Tcl library, such
-# as libtcl7.8.so or libtcl7.8.a.
-# TCL_LIB_SUFFIX -Specifies everything that comes after the "libtcl"
-# in the shared library name, using the $VERSION variable
-# to put the version in the right place. This is used
-# by platforms that need non-standard library names.
-# Examples: ${VERSION}.so.1.1 on NetBSD, since it needs
-# to have a version after the .so, and ${VERSION}.a
-# on AIX, since the Tcl shared library needs to have
-# a .a extension whereas shared objects for loadable
-# extensions have a .so extension. Defaults to
-# ${VERSION}${SHLIB_SUFFIX}.
+# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------
-# Step 1: set the variable "system" to hold the name and version number
-# for the system. This can usually be done via the "uname" command, but
-# there are a few systems, like Next, where this doesn't work.
+SC_TCL_LINK_LIBS
-AC_MSG_CHECKING([system version (for dynamic loading)])
-if test -f /usr/lib/NextStep/software_version; then
- system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
-else
- system=`uname -s`-`uname -r`
- if test "$?" -ne 0 ; then
- AC_MSG_RESULT([unknown (can't find uname command)])
- system=unknown
- else
- # Special check for weird MP-RAS system (uname returns weird
- # results, and the version is kept in special file).
-
- if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
- system=MP-RAS-`awk '{print $3}' /etc/.relid'`
- fi
- if test "`uname -s`" = "AIX" ; then
- system=AIX-`uname -v`.`uname -r`
- fi
- AC_MSG_RESULT($system)
- fi
-fi
+# Add the threads support libraries
-# Step 2: check for existence of -ldl library. This is needed because
-# Linux can use either -ldl or -ldld for dynamic loading.
-
-AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
-
-# Step 3: set configuration options based on system name and version.
-
-fullSrcDir=`cd $srcdir; pwd`
-TCL_SHARED_LIB_SUFFIX=""
-TCL_UNSHARED_LIB_SUFFIX=""
-TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
-ECHO_VERSION='`echo ${VERSION}`'
-TCL_LIB_VERSIONS_OK=ok
-case $system in
- AIX-4.[[2-9]])
- SHLIB_CFLAGS=""
- SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- AIX=yes
- TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
- ;;
- AIX-*)
- SHLIB_CFLAGS=""
- SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o tclLoadAix.o"
- DL_LIBS="-lld"
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
- ;;
- BSD/OS-2.1*|BSD/OS-3*)
- SHLIB_CFLAGS=""
- SHLIB_LD="shlicc -r"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- dgux*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
- # CYGNUS LOCAL: Handle gcc and versions of HP-UX that can't
- # do dynamic linking.
- AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no)
- if test "$tcl_ok" = "yes"; then
- if test "$GCC" = yes; then
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="$CC -shared -fPIC"
- else
- SHLIB_CFLAGS="+z"
- SHLIB_LD="ld -b"
- fi
-
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".sl"
- DL_OBJS="tclLoadShl.o"
- DL_LIBS="-ldld"
-
- # The GNU linker requires the -export-dynamic
- # option to make all symbols visible in the dynamic symbol
- # table. Note that the HP linker will give errors
- # -export-dynamic, but will still exit successfully.
- # Adding a -L option will make it fail.
- hold_ldflags=$LDFLAGS
- AC_MSG_CHECKING(for the ld -export-dynamic flag)
- LDFLAGS="${LDFLAGS} -Wl,-export-dynamic -L`pwd`"
- AC_TRY_LINK(, [int i;], found=yes, found=no)
- LDFLAGS=$hold_ldflags
- AC_MSG_RESULT($found)
- if test $found = yes; then
- LD_FLAGS="-Wl,-export-dynamic"
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- else
- LD_FLAGS="-Wl,-E"
- LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
- fi
- fi
- # END CYGNUS LOCAL
- ;;
- IRIX-4.*)
- SHLIB_CFLAGS="-G 0"
- SHLIB_SUFFIX=".a"
- SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
- SHLIB_LD_LIBS='${LIBS}'
- DL_OBJS="tclLoadAout.o"
- DL_LIBS=""
- LD_FLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
- ;;
- IRIX-5.*|IRIX-6.*)
- SHLIB_CFLAGS=""
- SHLIB_LD="ld -n32 -shared -rdata_shared"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- ;;
- IRIX64-6.*)
- SHLIB_CFLAGS=""
- SHLIB_LD="ld -n32 -shared -rdata_shared -rpath /usr/local/lib"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- ;;
- Linux*)
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- if test "$have_dl" = yes; then
- SHLIB_LD="${CC} -shared"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS="-rdynamic"
- LD_SEARCH_FLAGS=""
- else
- AC_CHECK_HEADER(dld.h, [
- SHLIB_LD="ld -shared"
- DL_OBJS="tclLoadDld.o"
- DL_LIBS="-ldld"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""])
- fi
- ;;
- MP-RAS-02*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- MP-RAS-*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS="-Wl,-Bexport"
- LD_SEARCH_FLAGS=""
- ;;
- NetBSD-*|FreeBSD-*|OpenBSD-*)
- # Not available on all versions: check for include file.
- AC_CHECK_HEADER(dlfcn.h, [
- SHLIB_CFLAGS="-fpic"
- SHLIB_LD="ld -Bshareable -x"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
- ], [
- SHLIB_CFLAGS=""
- SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".a"
- DL_OBJS="tclLoadAout.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
- ])
-
- # FreeBSD doesn't handle version numbers with dots.
-
- TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
- TCL_LIB_VERSIONS_OK=nodots
- ;;
- NEXTSTEP-*)
- SHLIB_CFLAGS=""
- SHLIB_LD="cc -nostdlib -r"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadNext.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- OSF1-1.0|OSF1-1.1|OSF1-1.2)
- # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
- SHLIB_CFLAGS=""
- # Hack: make package name same as library name
- SHLIB_LD='ld -R -export $@:'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadOSF.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- OSF1-1.*)
- # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
- SHLIB_CFLAGS="-fpic"
- SHLIB_LD="ld -shared"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- OSF1-V*)
- # Digital OSF/1
- SHLIB_CFLAGS=""
- SHLIB_LD='ld -shared -expect_unresolved "*"'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- ;;
- RISCos-*)
- SHLIB_CFLAGS="-G 0"
- SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".a"
- DL_OBJS="tclLoadAout.o"
- DL_LIBS=""
- LD_FLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- ;;
- SCO_SV-3.2*)
- # Note, dlopen is available only on SCO 3.2.5 and greater. However,
- # this test works, since "uname -s" was non-standard in 3.2.4 and
- # below.
- SHLIB_CFLAGS="-Kpic -belf"
- SHLIB_LD="ld -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- LD_FLAGS="-belf -Wl,-Bexport"
- LD_SEARCH_FLAGS=""
- ;;
- SINIX*5.4*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- SunOS-4*)
- # CYGNUS LOCAL: gcc uses a different option than native cc.
- if test "$GCC" = yes; then
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="$CC -shared -fPIC"
- else
- SHLIB_CFLAGS="-PIC"
- SHLIB_LD="ld"
- fi
- # END CYGNUS LOCAL
-
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
-
- # SunOS can't handle version numbers with dots in them in library
- # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
- # requires an extra version number at the end of .so file names.
- # So, the library has to have a name like libtcl75.so.1.0
-
- TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
- TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
- TCL_LIB_VERSIONS_OK=nodots
- ;;
- SunOS-5*)
- # CYGNUS LOCAL: gcc uses a different option than native cc.
- if test "$GCC" = yes; then
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="$CC -shared -fPIC"
- else
- SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="/usr/ccs/bin/ld -G -z text"
- fi
- # END CYGNUS LOCAL
-
- # Note: need the LIBS below, otherwise Tk won't find Tcl's
- # symbols when dynamically loaded into tclsh.
-
- SHLIB_LD_LIBS='${LIBS}'
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- # CYGNUS LOCAL: The GNU linker requires the -export-dynamic
- # option to make all symbols visible in the dynamic symbol
- # table.
- hold_ldflags=$LDFLAGS
- AC_MSG_CHECKING(for the ld -export-dynamic flag)
- LDFLAGS="${LDFLAGS} -Wl,-export-dynamic"
- AC_TRY_LINK(, [int i;], found=yes, found=no)
- LDFLAGS=$hold_ldflags
- AC_MSG_RESULT($found)
- if test $found = yes; then
- LD_FLAGS="-Wl,-export-dynamic"
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- else
- LD_FLAGS=""
- LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
- fi
- # END CYGNUS LOCAL
- ;;
- ULTRIX-4.*)
- SHLIB_CFLAGS="-G 0"
- SHLIB_SUFFIX=".a"
- SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
- SHLIB_LD_LIBS='${LIBS}'
- DL_OBJS="tclLoadAout.o"
- DL_LIBS=""
- # CYGNUS LOCAL: The GNU linker doesn't accept `-D 08000000'. It
- # doesn't appear to be needed, either.
- hold_ldflags="$LDFLAGS"
- AC_MSG_CHECKING(whether ld accepts -D 08000000)
- LD_FLAGS="-Wl,-D,08000000"
- LDFLAGS="${LDFLAGS} -Wl,-D,08000000"
- AC_TRY_LINK(, [int i;], found=yes, found=no)
- LDFLAGS=$hold_ldflags
- AC_MSG_RESULT($found)
- if test $found = yes; then
- LD_FLAGS="-Wl,-D,08000000"
- else
- LD_FLAGS=""
- fi
- # END CYGNUS LOCAL
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- ;;
- UNIX_SV* | UnixWare-5*)
- SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="cc -G"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
- # that don't grok the -Bexport option. Test that it does.
- hold_ldflags=$LDFLAGS
- AC_MSG_CHECKING(for ld accepts -Bexport flag)
- LDFLAGS="${LDFLAGS} -Wl,-Bexport"
- AC_TRY_LINK(, [int i;], found=yes, found=no)
- LDFLAGS=$hold_ldflags
- AC_MSG_RESULT($found)
- if test $found = yes; then
- LD_FLAGS="-Wl,-Bexport"
- else
- LD_FLAGS=""
- fi
- LD_SEARCH_FLAGS=""
- ;;
-esac
-
-# Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic
-# Loading for Tcl -- What Became of It?". Proc. 2nd Tcl/Tk Workshop,
-# New Orleans, LA, Computerized Processes Unlimited, 1994), then we need
-# to determine which of several header files defines the a.out file
-# format (a.out.h, sys/exec.h, or sys/exec_aout.h). At present, we
-# support only a file format that is more or less version-7-compatible.
-# In particular,
-# - a.out files must begin with `struct exec'.
-# - the N_TXTOFF on the `struct exec' must compute the seek address
-# of the text segment
-# - The `struct exec' must contain a_magic, a_text, a_data, a_bss
-# and a_entry fields.
-# The following compilation should succeed if and only if either sys/exec.h
-# or a.out.h is usable for the purpose.
-#
-# Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
-# `struct exec' includes a second header that contains information that
-# duplicates the v7 fields that are needed.
-
-if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
- AC_MSG_CHECKING(sys/exec.h)
- AC_TRY_COMPILE([#include <sys/exec.h>],[
- struct exec foo;
- unsigned long seek;
- int flag;
-#if defined(__mips) || defined(mips)
- seek = N_TXTOFF (foo.ex_f, foo.ex_o);
-#else
- seek = N_TXTOFF (foo);
-#endif
- flag = (foo.a_magic == OMAGIC);
- return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
-], tcl_ok=usable, tcl_ok=unusable)
- AC_MSG_RESULT($tcl_ok)
- if test $tcl_ok = usable; then
- AC_DEFINE(USE_SYS_EXEC_H)
- else
- AC_MSG_CHECKING(a.out.h)
- AC_TRY_COMPILE([#include <a.out.h>],[
- struct exec foo;
- unsigned long seek;
- int flag;
-#if defined(__mips) || defined(mips)
- seek = N_TXTOFF (foo.ex_f, foo.ex_o);
-#else
- seek = N_TXTOFF (foo);
-#endif
- flag = (foo.a_magic == OMAGIC);
- return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
- ], tcl_ok=usable, tcl_ok=unusable)
- AC_MSG_RESULT($tcl_ok)
- if test $tcl_ok = usable; then
- AC_DEFINE(USE_A_OUT_H)
- else
- AC_MSG_CHECKING(sys/exec_aout.h)
- AC_TRY_COMPILE([#include <sys/exec_aout.h>],[
- struct exec foo;
- unsigned long seek;
- int flag;
-#if defined(__mips) || defined(mips)
- seek = N_TXTOFF (foo.ex_f, foo.ex_o);
-#else
- seek = N_TXTOFF (foo);
-#endif
- flag = (foo.a_midmag == OMAGIC);
- return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
- ], tcl_ok=usable, tcl_ok=unusable)
- AC_MSG_RESULT($tcl_ok)
- if test $tcl_ok = usable; then
- AC_DEFINE(USE_SYS_EXEC_AOUT_H)
- else
- DL_OBJS=""
- fi
- fi
- fi
-fi
+LIBS="$LIBS$THREADS_LIBS"
-# Step 5: disable dynamic loading if requested via a command-line switch.
+#--------------------------------------------------------------------
+# The statements below define a collection of compile flags. This
+# macro depends on the value of SHARED_BUILD, and should be called
+# after SC_ENABLE_SHARED checks the configure switches.
+#--------------------------------------------------------------------
-AC_ARG_ENABLE(load, [ --disable-load disallow dynamic loading and "load" command],
- [tcl_ok=$enableval], [tcl_ok=yes])
-if test "$tcl_ok" = "no"; then
- DL_OBJS=""
-fi
+SC_CONFIG_CFLAGS
-if test "x$DL_OBJS" != "x" ; then
- BUILD_DLTEST="\$(DLTEST_TARGETS)"
-else
- echo "Can't figure out how to do dynamic loading or shared libraries"
- echo "on this system."
- SHLIB_CFLAGS=""
- SHLIB_LD=""
- SHLIB_SUFFIX=""
- DL_OBJS="tclLoadNone.o"
- DL_LIBS=""
- LD_FLAGS=""
- LD_SEARCH_FLAGS=""
- BUILD_DLTEST=""
-fi
+SC_ENABLE_SYMBOLS
-# If we're running gcc, then change the C flags for compiling shared
-# libraries to the right flags for gcc, instead of those for the
-# standard manufacturer compiler.
-
-if test "$DL_OBJS" != "tclLoadNone.o" ; then
- if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
- case $system in
- AIX-*)
- ;;
- BSD/OS*)
- ;;
- IRIX*)
- ;;
- NetBSD-*|FreeBSD-*|OpenBSD-*)
- ;;
- RISCos-*)
- ;;
- ULTRIX-4.*)
- ;;
- *)
- SHLIB_CFLAGS="-fPIC"
- ;;
- esac
- fi
-fi
+TCL_DBGX=${DBGX}
#--------------------------------------------------------------------
# The statements below check for systems where POSIX-style
@@ -1230,83 +431,32 @@ fi
# FIONBIO approach instead.
#--------------------------------------------------------------------
-AC_CHECK_HEADERS(sys/ioctl.h)
-AC_CHECK_HEADERS(sys/filio.h)
-AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O])
-if test -f /usr/lib/NextStep/software_version; then
- system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
-else
- system=`uname -s`-`uname -r`
- if test "$?" -ne 0 ; then
- system=unknown
- else
- # Special check for weird MP-RAS system (uname returns weird
- # results, and the version is kept in special file).
-
- if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
- system=MP-RAS-`awk '{print $3}' /etc/.relid'`
- fi
- if test "`uname -s`" = "AIX" ; then
- system=AIX-`uname -v`.`uname -r`
- fi
- fi
-fi
-case $system in
- # There used to be code here to use FIONBIO under AIX. However, it
- # was reported that FIONBIO doesn't work under AIX 3.2.5. Since
- # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO
- # code (JO, 5/31/97).
-
- OSF*)
- AC_DEFINE(USE_FIONBIO)
- AC_MSG_RESULT(FIONBIO)
- ;;
- SunOS-4*)
- AC_DEFINE(USE_FIONBIO)
- AC_MSG_RESULT(FIONBIO)
- ;;
- ULTRIX-4.*)
- AC_DEFINE(USE_FIONBIO)
- AC_MSG_RESULT(FIONBIO)
- ;;
- *)
- AC_MSG_RESULT(O_NONBLOCK)
- ;;
-esac
+SC_BLOCKING_STYLE
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------
-realRanlib=$RANLIB
-if test "$TCL_SHARED_LIB_SUFFIX" = "" ; then
- TCL_SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
-fi
-if test "$TCL_UNSHARED_LIB_SUFFIX" = "" ; then
- TCL_UNSHARED_LIB_SUFFIX='${VERSION}.a'
-fi
-AC_ARG_ENABLE(shared,
- [ --enable-shared build libtcl as a shared library],
- [tcl_ok=$enableval], [tcl_ok=no])
-# CYGNUS LOCAL: need extra variables for this information.
-TCL_SHARED_LIB_FILE=dummy1
-TCL_UNSHARED_LIB_FILE=dummy2
-# END CYGNUS LOCAL
-if test "$tcl_ok" = "yes" -a "${SHLIB_SUFFIX}" != "" ; then
- TCL_SHARED_BUILD=1
+TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
+TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
+
+SC_ENABLE_SHARED
+
+if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != "" ; then
TCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
- eval "TCL_LIB_FILE=libtcl${TCL_SHARED_LIB_SUFFIX}"
- TCL_SHARED_LIB_FILE="$TCL_LIB_FILE"
+ TCL_TOOL_SHARED_LIB_LONGNAME(TCL_LIB_FILE, tcl, ${TCL_SHARED_LIB_SUFFIX})
+
+ # FIXME: Why does MAKE_LIB not use a generic LIB_FILE variable
+ # that is replaced with the Makefiles specific stub lib name?
if test "x$DL_OBJS" = "xtclLoadAout.o"; then
- MAKE_LIB="ar cr \${TCL_LIB_FILE} \${OBJS}"
+ MAKE_LIB="\${STLIB_LD} \${TCL_LIB_FILE} \${OBJS}"
else
MAKE_LIB="\${SHLIB_LD} -o \${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
RANLIB=":"
fi
else
- TCL_SHARED_BUILD=0
case $system in
BSD/OS*)
;;
@@ -1319,10 +469,9 @@ else
;;
esac
TCL_SHLIB_CFLAGS=""
- TCL_LD_SEARCH_FLAGS=""
- eval "TCL_LIB_FILE=libtcl${TCL_UNSHARED_LIB_SUFFIX}"
- TCL_UNSHARED_LIB_FILE="$TCL_LIB_FILE"
- MAKE_LIB="$AR cr ${TCL_LIB_FILE} \${OBJS}"
+ TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
+ TCL_TOOL_STATIC_LIB_LONGNAME(TCL_LIB_FILE, tcl, ${TCL_UNSHARED_LIB_SUFFIX})
+ MAKE_LIB="\${STLIB_LD} \${TCL_LIB_FILE} \${OBJS}"
fi
# Note: in the following variable, it's important to use the absolute
@@ -1330,15 +479,34 @@ fi
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.
-if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
- TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl${VERSION}"
- TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl${VERSION}"
+if test "$SHARED_BUILD" = "0" -o $TCL_NEEDS_EXP_FILE = 0; then
+ TCL_TOOL_LIB_SHORTNAME(TCL_LIB_FLAG, tcl, $TCL_VERSION)
+ TCL_TOOL_LIB_SPEC(TCL_BUILD_LIB_SPEC, `pwd`, ${TCL_LIB_FLAG})
+ TCL_TOOL_LIB_SPEC(TCL_LIB_SPEC, ${exec_prefix}/lib, ${TCL_LIB_FLAG})
else
- TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
- TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
+ # FIXME: This if branch needs to be updated with respect
+ # to the library macro changes above!
+ TCL_BUILD_EXP_FILE="lib.exp"
+ eval "TCL_EXP_FILE=libtcl${TCL_EXPORT_FILE_SUFFIX}"
+
+ # Replace DBGX with TCL_DBGX
+ eval "TCL_EXP_FILE=\"${TCL_EXP_FILE}\""
+
+ if test "$using_gcc" = "yes" ; then
+ TCL_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TCL_BUILD_EXP_FILE} -L`pwd`"
+ TCL_LIB_SPEC="-Wl,-bI:${exec_prefix}/lib/${TCL_EXP_FILE} -L`pwd`"
+ else
+ TCL_BUILD_LIB_SPEC="-bI:`pwd`/${TCL_BUILD_EXP_FILE}"
+ TCL_LIB_SPEC="-bI:${exec_prefix}/lib/${TCL_EXP_FILE}"
+ fi
fi
+TCL_TOOL_LIB_PATH(TCL_LIB_FULL_PATH, `pwd`, ${TCL_LIB_FILE})
-TCL_LIB_FULL_PATH="`pwd`/${TCL_LIB_FILE}"
+VERSION='${VERSION}'
+eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
+eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
+eval "CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}"
+VERSION=${TCL_VERSION}
#--------------------------------------------------------------------
# The statements below define the symbol TCL_PACKAGE_PATH, which
@@ -1353,21 +521,67 @@ else
TCL_PACKAGE_PATH="${prefix}/lib"
fi
+#--------------------------------------------------------------------
+# The statements below define various symbols relating to Tcl
+# stub support. Note that the STUB_LIB_FILE variable must
+# be set in the Makefile before running MAKE_STUB_LIB.
+#--------------------------------------------------------------------
+
+MAKE_STUB_LIB="\${STLIB_LD} \${STUB_LIB_FILE} \${STUB_LIB_OBJS}"
+
+TCL_TOOL_STATIC_LIB_LONGNAME(TCL_STUB_LIB_FILE, tclstub, ${TCL_UNSHARED_LIB_SUFFIX})
+
+TCL_TOOL_LIB_SHORTNAME(TCL_STUB_LIB_FLAG, tclstub, $TCL_VERSION)
+TCL_TOOL_LIB_SPEC(TCL_BUILD_STUB_LIB_SPEC, `pwd`, ${TCL_STUB_LIB_FLAG})
+TCL_TOOL_LIB_SPEC(TCL_STUB_LIB_SPEC, ${exec_prefix}/lib, ${TCL_STUB_LIB_FLAG})
+
+TCL_TOOL_LIB_PATH(TCL_BUILD_STUB_LIB_PATH, `pwd`, ${TCL_STUB_LIB_FILE})
+TCL_TOOL_LIB_PATH(TCL_STUB_LIB_PATH, ${exec_prefix}/lib, ${TCL_STUB_LIB_FILE})
+
+#------------------------------------------------------------------------
+# tclConfig.sh refers to this by a different name
+#------------------------------------------------------------------------
+
+TCL_SHARED_BUILD=${SHARED_BUILD}
+
+AC_SUBST(TCL_STUB_LIB_FILE)
+AC_SUBST(TCL_STUB_LIB_FLAG)
+AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TCL_STUB_LIB_SPEC)
+AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
+AC_SUBST(TCL_STUB_LIB_PATH)
+AC_SUBST(MAKE_STUB_LIB)
+
AC_SUBST(BUILD_DLTEST)
-AC_SUBST(DL_LIBS)
+AC_SUBST(CFLAGS_DEFAULT)
+AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
+AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
+AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
+AC_SUBST(TCL_DBGX)
AC_SUBST(DL_OBJS)
-AC_SUBST(LD_FLAGS)
+AC_SUBST(EXTRA_CFLAGS)
+AC_SUBST(LDFLAGS_DEFAULT)
+AC_SUBST(LDFLAGS_DEBUG)
+AC_SUBST(LDFLAGS_OPTIMIZE)
+AC_SUBST(AR)
+AC_SUBST(RANLIB)
AC_SUBST(MAKE_LIB)
-AC_SUBST(MATH_LIBS)
+AC_SUBST(TCL_SHARED_BUILD)
AC_SUBST(SHLIB_CFLAGS)
AC_SUBST(SHLIB_LD)
+AC_SUBST(STLIB_LD)
AC_SUBST(SHLIB_LD_LIBS)
AC_SUBST(SHLIB_SUFFIX)
AC_SUBST(TCL_BUILD_LIB_SPEC)
AC_SUBST(TCL_LD_SEARCH_FLAGS)
+AC_SUBST(TCL_LDFLAGS_DEBUG)
+AC_SUBST(TCL_LDFLAGS_OPTIMIZE)
AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FULL_PATH)
AC_SUBST(TCL_LIB_FLAG)
+AC_SUBST(TCL_NEEDS_EXP_FILE)
+AC_SUBST(TCL_BUILD_EXP_FILE)
+AC_SUBST(TCL_EXP_FILE)
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_MAJOR_VERSION)
@@ -1375,14 +589,12 @@ AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PACKAGE_PATH)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_SHARED_LIB_SUFFIX)
-AC_SUBST(TCL_SHARED_BUILD)
AC_SUBST(TCL_SHLIB_CFLAGS)
AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
AC_SUBST(TCL_VERSION)
-# CYGNUS LOCAL
-AC_SUBST(TCL_SHARED_LIB_FILE)
-AC_SUBST(TCL_UNSHARED_LIB_FILE)
-# END CYGNUS LOCAL
+AC_SUBST(VENDORPREFIX)
AC_OUTPUT(Makefile tclConfig.sh)
+
diff --git a/tcl/unix/dltest/Makefile.in b/tcl/unix/dltest/Makefile.in
index c7b74715e0e..49c9d9f0169 100644
--- a/tcl/unix/dltest/Makefile.in
+++ b/tcl/unix/dltest/Makefile.in
@@ -1,45 +1,51 @@
# This Makefile is used to create several test cases for Tcl's load
# command. It also illustrates how to take advantage of configuration
# exported by Tcl to set up Makefiles for shared libraries.
-# SCCS: @(#) Makefile.in 1.12 97/02/22 14:13:54
+# RCS: @(#) $Id$
+TCL_DBGX = @TCL_DBGX@
CC = @CC@
-LIBS = @TCL_BUILD_LIB_SPEC@ @TCL_LIBS@ -lc
+LIBS = @TCL_BUILD_STUB_LIB_SPEC@ @TCL_LIBS@ -lc
+AC_FLAGS = @EXTRA_CFLAGS@
SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_LD = @SHLIB_LD@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
SHLIB_VERSION = @SHLIB_VERSION@
SRC_DIR = @srcdir@
TCL_VERSION= @TCL_VERSION@
+TCL_CFLAGS= @TCL_CFLAGS@
CFLAGS = -g
+#CC_SWITCHES = $(CFLAGS) ${TCL_CFLAGS} -I${SRC_DIR}/../../generic \
+# -DTCL_MEM_DEBUG ${SHLIB_CFLAGS}
CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
- ${SHLIB_CFLAGS}
+ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}
all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX}
pkga${SHLIB_SUFFIX}: $(SRC_DIR)/pkga.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c
- ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o @SHLIB_LD_LIBS@
+ ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${LIBS}
pkgb${SHLIB_SUFFIX}: $(SRC_DIR)/pkgb.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c
- ${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o @SHLIB_LD_LIBS@
+ ${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${LIBS}
pkgc${SHLIB_SUFFIX}: $(SRC_DIR)/pkgc.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c
- ${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o @SHLIB_LD_LIBS@
+ ${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${LIBS}
pkgd${SHLIB_SUFFIX}: $(SRC_DIR)/pkgd.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c
- ${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o @SHLIB_LD_LIBS@
+ ${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${LIBS}
pkge${SHLIB_SUFFIX}: $(SRC_DIR)/pkge.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c
- ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o @SHLIB_LD_LIBS@
+ ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${LIBS}
clean:
rm -f *.o *${SHLIB_SUFFIX} lib.exp
distclean: clean
rm -f Makefile config.cache config.log config.status
+
diff --git a/tcl/unix/dltest/README b/tcl/unix/dltest/README
index f4e54d4ff42..4b6baedbab4 100644
--- a/tcl/unix/dltest/README
+++ b/tcl/unix/dltest/README
@@ -9,4 +9,5 @@ Tcl before configuring here, since information learned during Tcl's
configure is needed here. Then type "make" to create the shared
libraries.
-sccsid: @(#) README 1.2 95/08/22 08:13:23
+RCS: @(#) $Id$
+
diff --git a/tcl/unix/dltest/configure b/tcl/unix/dltest/configure
index 973f6b5503a..70c5282ba3e 100755
--- a/tcl/unix/dltest/configure
+++ b/tcl/unix/dltest/configure
@@ -1,7 +1,7 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated automatically using autoconf version 2.12.1
+# Generated automatically using autoconf version 2.13
# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
#
# This configure script is free software; the Free Software Foundation
@@ -333,7 +333,7 @@ EOF
verbose=yes ;;
-version | --version | --versio | --versi | --vers)
- echo "configure generated by autoconf version 2.12.1"
+ echo "configure generated by autoconf version 2.13"
exit 0 ;;
-with-* | --with-*)
@@ -503,9 +503,11 @@ ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
cross_compiling=$ac_cv_prog_cc_cross
+ac_exeext=
+ac_objext=o
if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
# Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
@@ -519,7 +521,7 @@ else
fi
-# SCCS: @(#) configure.in 1.9 96/04/15 09:50:20
+# RCS: @(#) $Id$
# Recover information that Tcl computed with its configure script.
@@ -529,6 +531,8 @@ CC=$TCL_CC
SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
+EXTRA_CFLAGS=$TCL_EXTRA_CFLAGS
+
SHLIB_LD=$TCL_SHLIB_LD
SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
@@ -542,6 +546,8 @@ TCL_LIBS=$TCL_LIBS
TCL_VERSION=$TCL_VERSION
+TCL_DBGX=$TCL_DBGX
+
trap '' 1 2 15
cat > confcache <<\EOF
@@ -566,7 +572,7 @@ EOF
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(set) 2>&1 |
- case `(ac_space=' '; set) 2>&1 | grep ac_space` in
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
*ac_space=\ *)
# `set' does not quote correctly, so add quotes (double-quote substitution
# turns \\\\ into \\, and sed turns \\ into \).
@@ -645,7 +651,7 @@ do
echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-version | --version | --versio | --versi | --vers | --ver | --ve | --v)
- echo "$CONFIG_STATUS generated by autoconf version 2.12.1"
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
exit 0 ;;
-help | --help | --hel | --he | --h)
echo "\$ac_cs_usage"; exit 0 ;;
@@ -668,6 +674,7 @@ s%@SHELL@%$SHELL%g
s%@CFLAGS@%$CFLAGS%g
s%@CPPFLAGS@%$CPPFLAGS%g
s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
s%@DEFS@%$DEFS%g
s%@LDFLAGS@%$LDFLAGS%g
s%@LIBS@%$LIBS%g
@@ -688,13 +695,15 @@ s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
s%@CC@%$CC%g
s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
s%@SHLIB_LD@%$SHLIB_LD%g
s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
s%@SHLIB_VERSION@%$SHLIB_VERSION%g
-s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
s%@TCL_LIBS@%$TCL_LIBS%g
s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_DBGX@%$TCL_DBGX%g
CEOF
EOF
diff --git a/tcl/unix/dltest/configure.in b/tcl/unix/dltest/configure.in
index 6356137bbd1..9cd2d085900 100644
--- a/tcl/unix/dltest/configure.in
+++ b/tcl/unix/dltest/configure.in
@@ -7,7 +7,7 @@ AC_PREREQ(2.5)
dnl END CYGNUS LOCAL
AC_INIT(pkga.c)
-# SCCS: @(#) configure.in 1.9 96/04/15 09:50:20
+# RCS: @(#) $Id$
# Recover information that Tcl computed with its configure script.
@@ -17,6 +17,8 @@ CC=$TCL_CC
AC_SUBST(CC)
SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
AC_SUBST(SHLIB_CFLAGS)
+EXTRA_CFLAGS=$TCL_EXTRA_CFLAGS
+AC_SUBST(EXTRA_CFLAGS)
SHLIB_LD=$TCL_SHLIB_LD
AC_SUBST(SHLIB_LD)
SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
@@ -25,10 +27,20 @@ SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
AC_SUBST(SHLIB_SUFFIX)
SHLIB_VERSION=$TCL_SHLIB_VERSION
AC_SUBST(SHLIB_VERSION)
-AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
TCL_LIBS=$TCL_LIBS
AC_SUBST(TCL_LIBS)
TCL_VERSION=$TCL_VERSION
AC_SUBST(TCL_VERSION)
+# Tcl8.1 requires writable strings for gcc
+
+# if test "$GCC" = "yes"; then
+# TCL_CFLAGS=-fwritable-strings
+#else
+# TCL_CFLAGS=
+#fi
+#AC_SUBST(TCL_CFLAGS)
+
AC_OUTPUT(Makefile)
+
diff --git a/tcl/unix/dltest/pkga.c b/tcl/unix/dltest/pkga.c
index ab485229b41..aae4c3a1ae1 100644
--- a/tcl/unix/dltest/pkga.c
+++ b/tcl/unix/dltest/pkga.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) pkga.c 1.4 96/02/15 12:30:35
+ * RCS: @(#) $Id$
*/
#include "tcl.h"
@@ -17,15 +17,15 @@
* Prototypes for procedures defined later in this file:
*/
-static int Pkga_EqCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-static int Pkga_QuoteCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int Pkga_EqObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static int Pkga_QuoteObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
/*
*----------------------------------------------------------------------
*
- * Pkga_EqCmd --
+ * Pkga_EqObjCmd --
*
* This procedure is invoked to process the "pkga_eq" Tcl command.
* It expects two arguments and returns 1 if they are the same,
@@ -41,30 +41,28 @@ static int Pkga_QuoteCmd _ANSI_ARGS_((ClientData clientData,
*/
static int
-Pkga_EqCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+Pkga_EqObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " string1 string2\"", (char *) NULL);
+ int result;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string1 string2");
return TCL_ERROR;
}
- if (strcmp(argv[1], argv[2]) == 0) {
- interp->result = "1";
- } else {
- interp->result = "0";
- }
+ result = !strcmp(Tcl_GetString(objv[1]), Tcl_GetString(objv[2]));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Pkga_quoteCmd --
+ * Pkga_QuoteObjCmd --
*
* This procedure is invoked to process the "pkga_quote" Tcl command.
* It expects one argument, which it returns as result.
@@ -79,18 +77,17 @@ Pkga_EqCmd(dummy, interp, argc, argv)
*/
static int
-Pkga_QuoteCmd(dummy, interp, argc, argv)
+Pkga_QuoteObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument strings. */
{
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " value\"", (char *) NULL);
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
}
- strcpy(interp->result, argv[1]);
+ Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
@@ -118,13 +115,18 @@ Pkga_Init(interp)
{
int code;
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
code = Tcl_PkgProvide(interp, "Pkga", "1.0");
if (code != TCL_OK) {
return code;
}
- Tcl_CreateCommand(interp, "pkga_eq", Pkga_EqCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "pkga_quote", Pkga_QuoteCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
+
+
diff --git a/tcl/unix/dltest/pkgb.c b/tcl/unix/dltest/pkgb.c
index 1da95755cbd..361688f838c 100644
--- a/tcl/unix/dltest/pkgb.c
+++ b/tcl/unix/dltest/pkgb.c
@@ -2,7 +2,7 @@
* pkgb.c --
*
* This file contains a simple Tcl package "pkgb" that is intended
- * for testing the Tcl dynamic loading facilities. It can be used
+ * for testing the Tcl dynamic loading facilities. It can be used
* in both safe and unsafe interpreters.
*
* Copyright (c) 1995 Sun Microsystems, Inc.
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) pkgb.c 1.4 96/02/15 12:30:34
+ * RCS: @(#) $Id$
*/
#include "tcl.h"
@@ -18,15 +18,15 @@
* Prototypes for procedures defined later in this file:
*/
-static int Pkgb_SubCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-static int Pkgb_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int Pkgb_SubObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static int Pkgb_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
/*
*----------------------------------------------------------------------
*
- * Pkgb_SubCmd --
+ * Pkgb_SubObjCmd --
*
* This procedure is invoked to process the "pkgb_sub" Tcl command.
* It expects two arguments and returns their difference.
@@ -41,31 +41,30 @@ static int Pkgb_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
*/
static int
-Pkgb_SubCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+Pkgb_SubObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
int first, second;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " num num\"", (char *) NULL);
- return TCL_ERROR;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "num num");
+ return TCL_ERROR;
}
- if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
- || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
- return TCL_ERROR;
+ if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
+ return TCL_ERROR;
}
- sprintf(interp->result, "%d", first - second);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Pkgb_UnsafeCmd --
+ * Pkgb_UnsafeObjCmd --
*
* This procedure is invoked to process the "pkgb_unsafe" Tcl command.
* It just returns a constant string.
@@ -80,13 +79,13 @@ Pkgb_SubCmd(dummy, interp, argc, argv)
*/
static int
-Pkgb_UnsafeCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+Pkgb_UnsafeObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
- interp->result = "unsafe command invoked";
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
return TCL_OK;
}
@@ -114,14 +113,17 @@ Pkgb_Init(interp)
{
int code;
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
- Tcl_CreateCommand(interp, "pkgb_sub", Pkgb_SubCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "pkgb_unsafe", Pkgb_UnsafeCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
@@ -147,7 +149,18 @@ Pkgb_SafeInit(interp)
Tcl_Interp *interp; /* Interpreter in which the package is
* to be made available. */
{
- Tcl_CreateCommand(interp, "pkgb_sub", Pkgb_SubCmd, (ClientData) 0,
+ int code;
+
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+ code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
+ if (code != TCL_OK) {
+ return code;
+ }
+ Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
+
+
diff --git a/tcl/unix/dltest/pkgc.c b/tcl/unix/dltest/pkgc.c
index c35189a30a6..d6306680348 100644
--- a/tcl/unix/dltest/pkgc.c
+++ b/tcl/unix/dltest/pkgc.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) pkgc.c 1.4 96/02/15 12:30:35
+ * RCS: @(#) $Id$
*/
#include "tcl.h"
@@ -18,15 +18,15 @@
* Prototypes for procedures defined later in this file:
*/
-static int Pkgc_SubCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-static int Pkgc_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int Pkgc_SubObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static int Pkgc_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
/*
*----------------------------------------------------------------------
*
- * Pkgc_SubCmd --
+ * Pkgc_SubObjCmd --
*
* This procedure is invoked to process the "pkgc_sub" Tcl command.
* It expects two arguments and returns their difference.
@@ -41,24 +41,23 @@ static int Pkgc_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
*/
static int
-Pkgc_SubCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+Pkgc_SubObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
int first, second;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " num num\"", (char *) NULL);
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "num num");
return TCL_ERROR;
}
- if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
- || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
+ if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
return TCL_ERROR;
}
- sprintf(interp->result, "%d", first - second);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
return TCL_OK;
}
@@ -80,13 +79,13 @@ Pkgc_SubCmd(dummy, interp, argc, argv)
*/
static int
-Pkgc_UnsafeCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+Pkgc_UnsafeObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
- interp->result = "unsafe command invoked";
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
return TCL_OK;
}
@@ -114,14 +113,17 @@ Pkgc_Init(interp)
{
int code;
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
- Tcl_CreateCommand(interp, "pkgc_sub", Pkgc_SubCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "pkgc_unsafe", Pkgc_UnsafeCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
@@ -147,7 +149,18 @@ Pkgc_SafeInit(interp)
Tcl_Interp *interp; /* Interpreter in which the package is
* to be made available. */
{
- Tcl_CreateCommand(interp, "pkgc_sub", Pkgc_SubCmd, (ClientData) 0,
+ int code;
+
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+ code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
+ if (code != TCL_OK) {
+ return code;
+ }
+ Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
+
+
diff --git a/tcl/unix/dltest/pkgd.c b/tcl/unix/dltest/pkgd.c
index 56821cc30be..57b57c7521d 100644
--- a/tcl/unix/dltest/pkgd.c
+++ b/tcl/unix/dltest/pkgd.c
@@ -2,7 +2,7 @@
* pkgd.c --
*
* This file contains a simple Tcl package "pkgd" that is intended
- * for testing the Tcl dynamic loading facilities. It can be used
+ * for testing the Tcl dynamic loading facilities. It can be used
* in both safe and unsafe interpreters.
*
* Copyright (c) 1995 Sun Microsystems, Inc.
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) pkgd.c 1.4 96/02/15 12:30:32
+ * RCS: @(#) $Id$
*/
#include "tcl.h"
@@ -19,15 +19,15 @@
* Prototypes for procedures defined later in this file:
*/
-static int Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-static int Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int Pkgd_SubObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
+static int Pkgd_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
/*
*----------------------------------------------------------------------
*
- * Pkgd_SubCmd --
+ * Pkgd_SubObjCmd --
*
* This procedure is invoked to process the "pkgd_sub" Tcl command.
* It expects two arguments and returns their difference.
@@ -42,24 +42,23 @@ static int Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
*/
static int
-Pkgd_SubCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+Pkgd_SubObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
int first, second;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " num num\"", (char *) NULL);
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "num num");
return TCL_ERROR;
}
- if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
- || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
+ if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
return TCL_ERROR;
}
- sprintf(interp->result, "%d", first - second);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
return TCL_OK;
}
@@ -81,13 +80,13 @@ Pkgd_SubCmd(dummy, interp, argc, argv)
*/
static int
-Pkgd_UnsafeCmd(dummy, interp, argc, argv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+Pkgd_UnsafeObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
- interp->result = "unsafe command invoked";
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
return TCL_OK;
}
@@ -115,14 +114,17 @@ Pkgd_Init(interp)
{
int code;
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
- Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "pkgd_unsafe", Pkgd_UnsafeCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
@@ -148,7 +150,18 @@ Pkgd_SafeInit(interp)
Tcl_Interp *interp; /* Interpreter in which the package is
* to be made available. */
{
- Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
+ int code;
+
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+ code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
+ if (code != TCL_OK) {
+ return code;
+ }
+ Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
+
+
diff --git a/tcl/unix/dltest/pkge.c b/tcl/unix/dltest/pkge.c
index 1d585cae3da..6a815a975e6 100644
--- a/tcl/unix/dltest/pkge.c
+++ b/tcl/unix/dltest/pkge.c
@@ -10,18 +10,11 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) pkge.c 1.5 96/03/07 09:34:27
+ * RCS: @(#) $Id$
*/
-#include "tcl.h"
-/*
- * Prototypes for procedures defined later in this file:
- */
+#include "tcl.h"
-static int Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-static int Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
/*
*----------------------------------------------------------------------
@@ -45,5 +38,11 @@ Pkge_Init(interp)
Tcl_Interp *interp; /* Interpreter in which the package is
* to be made available. */
{
- return Tcl_Eval(interp, "if 44 {open non_existent}");
+ static char script[] = "if 44 {open non_existent}";
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+ return Tcl_Eval(interp, script);
}
+
+
diff --git a/tcl/unix/dltest/pkgf.c b/tcl/unix/dltest/pkgf.c
index d7c641aeb52..3cfb956bc00 100644
--- a/tcl/unix/dltest/pkgf.c
+++ b/tcl/unix/dltest/pkgf.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) pkgf.c 1.2 96/02/15 12:30:32
+ * RCS: @(#) $Id$
*/
#include "tcl.h"
@@ -45,5 +45,10 @@ Pkgf_Init(interp)
Tcl_Interp *interp; /* Interpreter in which the package is
* to be made available. */
{
- return Tcl_Eval(interp, "if 44 {open non_existent}");
+ static char script[] = "if 44 {open non_existent}";
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+ return Tcl_Eval(interp, script);
}
+
diff --git a/tcl/unix/ldAix b/tcl/unix/ldAix
index 15818eb6082..31b6b222582 100755
--- a/tcl/unix/ldAix
+++ b/tcl/unix/ldAix
@@ -23,6 +23,9 @@ for i do
fi
done
+# Extract the name of the object file that we're linking.
+outputFile=`echo $args | sed -e 's/.*-o \([^ ]*\).*/\1/'`
+
# Create the export file from all of the object files, using nm followed
# by sed editing. Here are some tricky aspects of this:
#
@@ -49,13 +52,12 @@ if test $osver -eq 3; then
nmopts="-e"
fi
rm -f lib.exp
-echo "#! " >lib.exp
+echo "#! $outputFile" >lib.exp
/usr/ccs/bin/nm $nmopts -h $ofiles | sed -e '/:$/d' -e '/ U /d' -e '/[ ]0|extern/d' -e '/unamex/d' -e 's/^\.//' -e 's/[ |].*//' | sort | uniq >>lib.exp
-# Extract the name of the object file that we're linking. If it's a .a
-# file, then link all the objects together into a single file "shr.o"
-# and then put that into the archive. Otherwise link the object files
-# directly into the .a file.
+# If we're linking a .a file, then link all the objects together into a
+# single file "shr.o" and then put that into the archive. Otherwise link
+# the object files directly into the .a file.
outputFile=`echo $args | sed -e 's/.*-o \([^ ]*\).*/\1/'`
noDotA=`echo $outputFile | sed -e '/\.a$/d'`
@@ -70,3 +72,4 @@ if test "$noDotA" = "" ; then
else
eval $args
fi
+
diff --git a/tcl/unix/mkLinks b/tcl/unix/mkLinks
index 23afaabcae1..ba3d9ec32f9 100755
--- a/tcl/unix/mkLinks
+++ b/tcl/unix/mkLinks
@@ -28,984 +28,984 @@ if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then
exit
fi
-if test -r AddErrInfo.3; then
- rm -f Tcl_AddObjErrorInfo.3
- ln AddErrInfo.3 Tcl_AddObjErrorInfo.3
+if test -r Access.3; then
+ rm -f Tcl_Access.3
+ rm -f Tcl_Stat.3
+ cp Access.3 Tcl_Access.3
+ cp Access.3 Tcl_Stat.3
fi
if test -r AddErrInfo.3; then
+ rm -f Tcl_AddObjErrorInfo.3
rm -f Tcl_AddErrorInfo.3
- ln AddErrInfo.3 Tcl_AddErrorInfo.3
-fi
-if test -r AddErrInfo.3; then
+ rm -f Tcl_SetObjErrorCode.3
rm -f Tcl_SetErrorCode.3
- ln AddErrInfo.3 Tcl_SetErrorCode.3
-fi
-if test -r AddErrInfo.3; then
+ rm -f Tcl_SetErrorCodeVA.3
rm -f Tcl_PosixError.3
- ln AddErrInfo.3 Tcl_PosixError.3
+ rm -f Tcl_LogCommandInfo.3
+ cp AddErrInfo.3 Tcl_AddObjErrorInfo.3
+ cp AddErrInfo.3 Tcl_AddErrorInfo.3
+ cp AddErrInfo.3 Tcl_SetObjErrorCode.3
+ cp AddErrInfo.3 Tcl_SetErrorCode.3
+ cp AddErrInfo.3 Tcl_SetErrorCodeVA.3
+ cp AddErrInfo.3 Tcl_PosixError.3
+ cp AddErrInfo.3 Tcl_LogCommandInfo.3
fi
if test -r Alloc.3; then
rm -f Tcl_Alloc.3
- ln Alloc.3 Tcl_Alloc.3
-fi
-if test -r Alloc.3; then
rm -f Tcl_Free.3
- ln Alloc.3 Tcl_Free.3
-fi
-if test -r Alloc.3; then
rm -f Tcl_Realloc.3
- ln Alloc.3 Tcl_Realloc.3
+ cp Alloc.3 Tcl_Alloc.3
+ cp Alloc.3 Tcl_Free.3
+ cp Alloc.3 Tcl_Realloc.3
fi
if test -r AllowExc.3; then
rm -f Tcl_AllowExceptions.3
- ln AllowExc.3 Tcl_AllowExceptions.3
+ cp AllowExc.3 Tcl_AllowExceptions.3
fi
if test -r AppInit.3; then
rm -f Tcl_AppInit.3
- ln AppInit.3 Tcl_AppInit.3
+ cp AppInit.3 Tcl_AppInit.3
fi
if test -r AssocData.3; then
rm -f Tcl_GetAssocData.3
- ln AssocData.3 Tcl_GetAssocData.3
-fi
-if test -r AssocData.3; then
rm -f Tcl_SetAssocData.3
- ln AssocData.3 Tcl_SetAssocData.3
-fi
-if test -r AssocData.3; then
rm -f Tcl_DeleteAssocData.3
- ln AssocData.3 Tcl_DeleteAssocData.3
+ cp AssocData.3 Tcl_GetAssocData.3
+ cp AssocData.3 Tcl_SetAssocData.3
+ cp AssocData.3 Tcl_DeleteAssocData.3
fi
if test -r Async.3; then
rm -f Tcl_AsyncCreate.3
- ln Async.3 Tcl_AsyncCreate.3
-fi
-if test -r Async.3; then
rm -f Tcl_AsyncMark.3
- ln Async.3 Tcl_AsyncMark.3
-fi
-if test -r Async.3; then
rm -f Tcl_AsyncInvoke.3
- ln Async.3 Tcl_AsyncInvoke.3
-fi
-if test -r Async.3; then
rm -f Tcl_AsyncDelete.3
- ln Async.3 Tcl_AsyncDelete.3
+ rm -f Tcl_AsyncReady.3
+ cp Async.3 Tcl_AsyncCreate.3
+ cp Async.3 Tcl_AsyncMark.3
+ cp Async.3 Tcl_AsyncInvoke.3
+ cp Async.3 Tcl_AsyncDelete.3
+ cp Async.3 Tcl_AsyncReady.3
fi
if test -r BackgdErr.3; then
rm -f Tcl_BackgroundError.3
- ln BackgdErr.3 Tcl_BackgroundError.3
+ cp BackgdErr.3 Tcl_BackgroundError.3
fi
if test -r Backslash.3; then
rm -f Tcl_Backslash.3
- ln Backslash.3 Tcl_Backslash.3
+ cp Backslash.3 Tcl_Backslash.3
fi
if test -r BoolObj.3; then
rm -f Tcl_NewBooleanObj.3
- ln BoolObj.3 Tcl_NewBooleanObj.3
-fi
-if test -r BoolObj.3; then
rm -f Tcl_SetBooleanObj.3
- ln BoolObj.3 Tcl_SetBooleanObj.3
-fi
-if test -r BoolObj.3; then
rm -f Tcl_GetBooleanFromObj.3
- ln BoolObj.3 Tcl_GetBooleanFromObj.3
+ cp BoolObj.3 Tcl_NewBooleanObj.3
+ cp BoolObj.3 Tcl_SetBooleanObj.3
+ cp BoolObj.3 Tcl_GetBooleanFromObj.3
+fi
+if test -r ByteArrObj.3; then
+ rm -f Tcl_NewByteArrayObj.3
+ rm -f Tcl_SetByteArrayObj.3
+ rm -f Tcl_GetByteArrayFromObj.3
+ rm -f Tcl_SetByteArrayLength.3
+ cp ByteArrObj.3 Tcl_NewByteArrayObj.3
+ cp ByteArrObj.3 Tcl_SetByteArrayObj.3
+ cp ByteArrObj.3 Tcl_GetByteArrayFromObj.3
+ cp ByteArrObj.3 Tcl_SetByteArrayLength.3
fi
if test -r CallDel.3; then
rm -f Tcl_CallWhenDeleted.3
- ln CallDel.3 Tcl_CallWhenDeleted.3
-fi
-if test -r CallDel.3; then
rm -f Tcl_DontCallWhenDeleted.3
- ln CallDel.3 Tcl_DontCallWhenDeleted.3
+ cp CallDel.3 Tcl_CallWhenDeleted.3
+ cp CallDel.3 Tcl_DontCallWhenDeleted.3
+fi
+if test -r ChnlStack.3; then
+ rm -f Tcl_StackChannel.3
+ rm -f Tcl_UnstackChannel.3
+ rm -f Tcl_GetStackedChannel.3
+ cp ChnlStack.3 Tcl_StackChannel.3
+ cp ChnlStack.3 Tcl_UnstackChannel.3
+ cp ChnlStack.3 Tcl_GetStackedChannel.3
fi
if test -r CmdCmplt.3; then
rm -f Tcl_CommandComplete.3
- ln CmdCmplt.3 Tcl_CommandComplete.3
+ cp CmdCmplt.3 Tcl_CommandComplete.3
fi
if test -r Concat.3; then
rm -f Tcl_Concat.3
- ln Concat.3 Tcl_Concat.3
+ cp Concat.3 Tcl_Concat.3
fi
if test -r CrtChannel.3; then
rm -f Tcl_CreateChannel.3
- ln CrtChannel.3 Tcl_CreateChannel.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_GetChannelInstanceData.3
- ln CrtChannel.3 Tcl_GetChannelInstanceData.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_GetChannelType.3
- ln CrtChannel.3 Tcl_GetChannelType.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_GetChannelName.3
- ln CrtChannel.3 Tcl_GetChannelName.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_GetChannelHandle.3
- ln CrtChannel.3 Tcl_GetChannelHandle.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_GetChannelMode.3
- ln CrtChannel.3 Tcl_GetChannelMode.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_GetChannelBufferSize.3
- ln CrtChannel.3 Tcl_GetChannelBufferSize.3
-fi
-if test -r CrtChannel.3; then
- rm -f Tcl_SetDefaultTranslation.3
- ln CrtChannel.3 Tcl_SetDefaultTranslation.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_SetChannelBufferSize.3
- ln CrtChannel.3 Tcl_SetChannelBufferSize.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_NotifyChannel.3
- ln CrtChannel.3 Tcl_NotifyChannel.3
-fi
-if test -r CrtChannel.3; then
rm -f Tcl_BadChannelOption.3
- ln CrtChannel.3 Tcl_BadChannelOption.3
+ rm -f Tcl_ChannelName.3
+ rm -f Tcl_ChannelVersion.3
+ rm -f Tcl_ChannelBlockModeProc.3
+ rm -f Tcl_ChannelCloseProc.3
+ rm -f Tcl_ChannelClose2Proc.3
+ rm -f Tcl_ChannelInputProc.3
+ rm -f Tcl_ChannelOutputProc.3
+ rm -f Tcl_ChannelSeekProc.3
+ rm -f Tcl_ChannelSetOptionProc.3
+ rm -f Tcl_ChannelGetOptionProc.3
+ rm -f Tcl_ChannelWatchProc.3
+ rm -f Tcl_ChannelGetHandleProc.3
+ rm -f Tcl_ChannelFlushProc.3
+ rm -f Tcl_ChannelHandlerProc.3
+ cp CrtChannel.3 Tcl_CreateChannel.3
+ cp CrtChannel.3 Tcl_GetChannelInstanceData.3
+ cp CrtChannel.3 Tcl_GetChannelType.3
+ cp CrtChannel.3 Tcl_GetChannelName.3
+ cp CrtChannel.3 Tcl_GetChannelHandle.3
+ cp CrtChannel.3 Tcl_GetChannelMode.3
+ cp CrtChannel.3 Tcl_GetChannelBufferSize.3
+ cp CrtChannel.3 Tcl_SetChannelBufferSize.3
+ cp CrtChannel.3 Tcl_NotifyChannel.3
+ cp CrtChannel.3 Tcl_BadChannelOption.3
+ cp CrtChannel.3 Tcl_ChannelName.3
+ cp CrtChannel.3 Tcl_ChannelVersion.3
+ cp CrtChannel.3 Tcl_ChannelBlockModeProc.3
+ cp CrtChannel.3 Tcl_ChannelCloseProc.3
+ cp CrtChannel.3 Tcl_ChannelClose2Proc.3
+ cp CrtChannel.3 Tcl_ChannelInputProc.3
+ cp CrtChannel.3 Tcl_ChannelOutputProc.3
+ cp CrtChannel.3 Tcl_ChannelSeekProc.3
+ cp CrtChannel.3 Tcl_ChannelSetOptionProc.3
+ cp CrtChannel.3 Tcl_ChannelGetOptionProc.3
+ cp CrtChannel.3 Tcl_ChannelWatchProc.3
+ cp CrtChannel.3 Tcl_ChannelGetHandleProc.3
+ cp CrtChannel.3 Tcl_ChannelFlushProc.3
+ cp CrtChannel.3 Tcl_ChannelHandlerProc.3
fi
if test -r CrtChnlHdlr.3; then
rm -f Tcl_CreateChannelHandler.3
- ln CrtChnlHdlr.3 Tcl_CreateChannelHandler.3
-fi
-if test -r CrtChnlHdlr.3; then
rm -f Tcl_DeleteChannelHandler.3
- ln CrtChnlHdlr.3 Tcl_DeleteChannelHandler.3
+ cp CrtChnlHdlr.3 Tcl_CreateChannelHandler.3
+ cp CrtChnlHdlr.3 Tcl_DeleteChannelHandler.3
fi
if test -r CrtCloseHdlr.3; then
rm -f Tcl_CreateCloseHandler.3
- ln CrtCloseHdlr.3 Tcl_CreateCloseHandler.3
-fi
-if test -r CrtCloseHdlr.3; then
rm -f Tcl_DeleteCloseHandler.3
- ln CrtCloseHdlr.3 Tcl_DeleteCloseHandler.3
+ cp CrtCloseHdlr.3 Tcl_CreateCloseHandler.3
+ cp CrtCloseHdlr.3 Tcl_DeleteCloseHandler.3
fi
if test -r CrtCommand.3; then
rm -f Tcl_CreateCommand.3
- ln CrtCommand.3 Tcl_CreateCommand.3
+ cp CrtCommand.3 Tcl_CreateCommand.3
fi
if test -r CrtFileHdlr.3; then
rm -f Tcl_CreateFileHandler.3
- ln CrtFileHdlr.3 Tcl_CreateFileHandler.3
-fi
-if test -r CrtFileHdlr.3; then
rm -f Tcl_DeleteFileHandler.3
- ln CrtFileHdlr.3 Tcl_DeleteFileHandler.3
+ cp CrtFileHdlr.3 Tcl_CreateFileHandler.3
+ cp CrtFileHdlr.3 Tcl_DeleteFileHandler.3
fi
if test -r CrtInterp.3; then
rm -f Tcl_CreateInterp.3
- ln CrtInterp.3 Tcl_CreateInterp.3
-fi
-if test -r CrtInterp.3; then
rm -f Tcl_DeleteInterp.3
- ln CrtInterp.3 Tcl_DeleteInterp.3
-fi
-if test -r CrtInterp.3; then
rm -f Tcl_InterpDeleted.3
- ln CrtInterp.3 Tcl_InterpDeleted.3
+ cp CrtInterp.3 Tcl_CreateInterp.3
+ cp CrtInterp.3 Tcl_DeleteInterp.3
+ cp CrtInterp.3 Tcl_InterpDeleted.3
fi
if test -r CrtMathFnc.3; then
rm -f Tcl_CreateMathFunc.3
- ln CrtMathFnc.3 Tcl_CreateMathFunc.3
+ cp CrtMathFnc.3 Tcl_CreateMathFunc.3
fi
if test -r CrtObjCmd.3; then
rm -f Tcl_CreateObjCommand.3
- ln CrtObjCmd.3 Tcl_CreateObjCommand.3
-fi
-if test -r CrtObjCmd.3; then
rm -f Tcl_DeleteCommand.3
- ln CrtObjCmd.3 Tcl_DeleteCommand.3
-fi
-if test -r CrtObjCmd.3; then
rm -f Tcl_DeleteCommandFromToken.3
- ln CrtObjCmd.3 Tcl_DeleteCommandFromToken.3
-fi
-if test -r CrtObjCmd.3; then
rm -f Tcl_GetCommandInfo.3
- ln CrtObjCmd.3 Tcl_GetCommandInfo.3
-fi
-if test -r CrtObjCmd.3; then
rm -f Tcl_SetCommandInfo.3
- ln CrtObjCmd.3 Tcl_SetCommandInfo.3
-fi
-if test -r CrtObjCmd.3; then
rm -f Tcl_GetCommandName.3
- ln CrtObjCmd.3 Tcl_GetCommandName.3
+ cp CrtObjCmd.3 Tcl_CreateObjCommand.3
+ cp CrtObjCmd.3 Tcl_DeleteCommand.3
+ cp CrtObjCmd.3 Tcl_DeleteCommandFromToken.3
+ cp CrtObjCmd.3 Tcl_GetCommandInfo.3
+ cp CrtObjCmd.3 Tcl_SetCommandInfo.3
+ cp CrtObjCmd.3 Tcl_GetCommandName.3
fi
if test -r CrtSlave.3; then
rm -f Tcl_IsSafe.3
- ln CrtSlave.3 Tcl_IsSafe.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_MakeSafe.3
- ln CrtSlave.3 Tcl_MakeSafe.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_CreateSlave.3
- ln CrtSlave.3 Tcl_CreateSlave.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_GetSlave.3
- ln CrtSlave.3 Tcl_GetSlave.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_GetMaster.3
- ln CrtSlave.3 Tcl_GetMaster.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_GetInterpPath.3
- ln CrtSlave.3 Tcl_GetInterpPath.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_CreateAlias.3
- ln CrtSlave.3 Tcl_CreateAlias.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_CreateAliasObj.3
- ln CrtSlave.3 Tcl_CreateAliasObj.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_GetAlias.3
- ln CrtSlave.3 Tcl_GetAlias.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_GetAliasObj.3
- ln CrtSlave.3 Tcl_GetAliasObj.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_ExposeCommand.3
- ln CrtSlave.3 Tcl_ExposeCommand.3
-fi
-if test -r CrtSlave.3; then
rm -f Tcl_HideCommand.3
- ln CrtSlave.3 Tcl_HideCommand.3
+ cp CrtSlave.3 Tcl_IsSafe.3
+ cp CrtSlave.3 Tcl_MakeSafe.3
+ cp CrtSlave.3 Tcl_CreateSlave.3
+ cp CrtSlave.3 Tcl_GetSlave.3
+ cp CrtSlave.3 Tcl_GetMaster.3
+ cp CrtSlave.3 Tcl_GetInterpPath.3
+ cp CrtSlave.3 Tcl_CreateAlias.3
+ cp CrtSlave.3 Tcl_CreateAliasObj.3
+ cp CrtSlave.3 Tcl_GetAlias.3
+ cp CrtSlave.3 Tcl_GetAliasObj.3
+ cp CrtSlave.3 Tcl_ExposeCommand.3
+ cp CrtSlave.3 Tcl_HideCommand.3
fi
if test -r CrtTimerHdlr.3; then
rm -f Tcl_CreateTimerHandler.3
- ln CrtTimerHdlr.3 Tcl_CreateTimerHandler.3
-fi
-if test -r CrtTimerHdlr.3; then
rm -f Tcl_DeleteTimerHandler.3
- ln CrtTimerHdlr.3 Tcl_DeleteTimerHandler.3
+ cp CrtTimerHdlr.3 Tcl_CreateTimerHandler.3
+ cp CrtTimerHdlr.3 Tcl_DeleteTimerHandler.3
fi
if test -r CrtTrace.3; then
rm -f Tcl_CreateTrace.3
- ln CrtTrace.3 Tcl_CreateTrace.3
-fi
-if test -r CrtTrace.3; then
rm -f Tcl_DeleteTrace.3
- ln CrtTrace.3 Tcl_DeleteTrace.3
+ cp CrtTrace.3 Tcl_CreateTrace.3
+ cp CrtTrace.3 Tcl_DeleteTrace.3
fi
if test -r DString.3; then
rm -f Tcl_DStringInit.3
- ln DString.3 Tcl_DStringInit.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringAppend.3
- ln DString.3 Tcl_DStringAppend.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringAppendElement.3
- ln DString.3 Tcl_DStringAppendElement.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringStartSublist.3
- ln DString.3 Tcl_DStringStartSublist.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringEndSublist.3
- ln DString.3 Tcl_DStringEndSublist.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringLength.3
- ln DString.3 Tcl_DStringLength.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringValue.3
- ln DString.3 Tcl_DStringValue.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringSetLength.3
- ln DString.3 Tcl_DStringSetLength.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringFree.3
- ln DString.3 Tcl_DStringFree.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringResult.3
- ln DString.3 Tcl_DStringResult.3
-fi
-if test -r DString.3; then
rm -f Tcl_DStringGetResult.3
- ln DString.3 Tcl_DStringGetResult.3
+ cp DString.3 Tcl_DStringInit.3
+ cp DString.3 Tcl_DStringAppend.3
+ cp DString.3 Tcl_DStringAppendElement.3
+ cp DString.3 Tcl_DStringStartSublist.3
+ cp DString.3 Tcl_DStringEndSublist.3
+ cp DString.3 Tcl_DStringLength.3
+ cp DString.3 Tcl_DStringValue.3
+ cp DString.3 Tcl_DStringSetLength.3
+ cp DString.3 Tcl_DStringFree.3
+ cp DString.3 Tcl_DStringResult.3
+ cp DString.3 Tcl_DStringGetResult.3
fi
if test -r DetachPids.3; then
rm -f Tcl_DetachPids.3
- ln DetachPids.3 Tcl_DetachPids.3
-fi
-if test -r DetachPids.3; then
rm -f Tcl_ReapDetachedProcs.3
- ln DetachPids.3 Tcl_ReapDetachedProcs.3
+ cp DetachPids.3 Tcl_DetachPids.3
+ cp DetachPids.3 Tcl_ReapDetachedProcs.3
fi
if test -r DoOneEvent.3; then
rm -f Tcl_DoOneEvent.3
- ln DoOneEvent.3 Tcl_DoOneEvent.3
+ cp DoOneEvent.3 Tcl_DoOneEvent.3
fi
if test -r DoWhenIdle.3; then
rm -f Tcl_DoWhenIdle.3
- ln DoWhenIdle.3 Tcl_DoWhenIdle.3
-fi
-if test -r DoWhenIdle.3; then
rm -f Tcl_CancelIdleCall.3
- ln DoWhenIdle.3 Tcl_CancelIdleCall.3
+ cp DoWhenIdle.3 Tcl_DoWhenIdle.3
+ cp DoWhenIdle.3 Tcl_CancelIdleCall.3
fi
if test -r DoubleObj.3; then
rm -f Tcl_NewDoubleObj.3
- ln DoubleObj.3 Tcl_NewDoubleObj.3
-fi
-if test -r DoubleObj.3; then
rm -f Tcl_SetDoubleObj.3
- ln DoubleObj.3 Tcl_SetDoubleObj.3
-fi
-if test -r DoubleObj.3; then
rm -f Tcl_GetDoubleFromObj.3
- ln DoubleObj.3 Tcl_GetDoubleFromObj.3
-fi
-if test -r Eval.3; then
- rm -f Tcl_Eval.3
- ln Eval.3 Tcl_Eval.3
-fi
-if test -r Eval.3; then
- rm -f Tcl_VarEval.3
- ln Eval.3 Tcl_VarEval.3
+ cp DoubleObj.3 Tcl_NewDoubleObj.3
+ cp DoubleObj.3 Tcl_SetDoubleObj.3
+ cp DoubleObj.3 Tcl_GetDoubleFromObj.3
+fi
+if test -r DumpActiveMemory.3; then
+ rm -f Tcl_DumpActiveMemory.3
+ rm -f Tcl_InitMemory.3
+ rm -f Tcl_ValidateAllMemory.3
+ cp DumpActiveMemory.3 Tcl_DumpActiveMemory.3
+ cp DumpActiveMemory.3 Tcl_InitMemory.3
+ cp DumpActiveMemory.3 Tcl_ValidateAllMemory.3
+fi
+if test -r Encoding.3; then
+ rm -f Tcl_GetEncoding.3
+ rm -f Tcl_FreeEncoding.3
+ rm -f Tcl_ExternalToUtfDString.3
+ rm -f Tcl_ExternalToUtf.3
+ rm -f Tcl_UtfToExternalDString.3
+ rm -f Tcl_UtfToExternal.3
+ rm -f Tcl_WinTCharToUtf.3
+ rm -f Tcl_WinUtfToTChar.3
+ rm -f Tcl_GetEncodingName.3
+ rm -f Tcl_SetSystemEncoding.3
+ rm -f Tcl_GetEncodingNames.3
+ rm -f Tcl_CreateEncoding.3
+ rm -f Tcl_GetDefaultEncodingDir.3
+ rm -f Tcl_SetDefaultEncodingDir.3
+ cp Encoding.3 Tcl_GetEncoding.3
+ cp Encoding.3 Tcl_FreeEncoding.3
+ cp Encoding.3 Tcl_ExternalToUtfDString.3
+ cp Encoding.3 Tcl_ExternalToUtf.3
+ cp Encoding.3 Tcl_UtfToExternalDString.3
+ cp Encoding.3 Tcl_UtfToExternal.3
+ cp Encoding.3 Tcl_WinTCharToUtf.3
+ cp Encoding.3 Tcl_WinUtfToTChar.3
+ cp Encoding.3 Tcl_GetEncodingName.3
+ cp Encoding.3 Tcl_SetSystemEncoding.3
+ cp Encoding.3 Tcl_GetEncodingNames.3
+ cp Encoding.3 Tcl_CreateEncoding.3
+ cp Encoding.3 Tcl_GetDefaultEncodingDir.3
+ cp Encoding.3 Tcl_SetDefaultEncodingDir.3
fi
if test -r Eval.3; then
+ rm -f Tcl_EvalObjEx.3
rm -f Tcl_EvalFile.3
- ln Eval.3 Tcl_EvalFile.3
-fi
-if test -r Eval.3; then
+ rm -f Tcl_EvalObjv.3
+ rm -f Tcl_Eval.3
+ rm -f Tcl_EvalEx.3
rm -f Tcl_GlobalEval.3
- ln Eval.3 Tcl_GlobalEval.3
-fi
-if test -r EvalObj.3; then
- rm -f Tcl_EvalObj.3
- ln EvalObj.3 Tcl_EvalObj.3
-fi
-if test -r EvalObj.3; then
rm -f Tcl_GlobalEvalObj.3
- ln EvalObj.3 Tcl_GlobalEvalObj.3
+ rm -f Tcl_VarEval.3
+ rm -f Tcl_VarEvalVA.3
+ cp Eval.3 Tcl_EvalObjEx.3
+ cp Eval.3 Tcl_EvalFile.3
+ cp Eval.3 Tcl_EvalObjv.3
+ cp Eval.3 Tcl_Eval.3
+ cp Eval.3 Tcl_EvalEx.3
+ cp Eval.3 Tcl_GlobalEval.3
+ cp Eval.3 Tcl_GlobalEvalObj.3
+ cp Eval.3 Tcl_VarEval.3
+ cp Eval.3 Tcl_VarEvalVA.3
fi
if test -r Exit.3; then
rm -f Tcl_Exit.3
- ln Exit.3 Tcl_Exit.3
-fi
-if test -r Exit.3; then
rm -f Tcl_Finalize.3
- ln Exit.3 Tcl_Finalize.3
-fi
-if test -r Exit.3; then
rm -f Tcl_CreateExitHandler.3
- ln Exit.3 Tcl_CreateExitHandler.3
-fi
-if test -r Exit.3; then
rm -f Tcl_DeleteExitHandler.3
- ln Exit.3 Tcl_DeleteExitHandler.3
+ rm -f Tcl_ExitThread.3
+ rm -f Tcl_FinalizeThread.3
+ rm -f Tcl_CreateThreadExitHandler.3
+ rm -f Tcl_DeleteThreadExitHandler.3
+ cp Exit.3 Tcl_Exit.3
+ cp Exit.3 Tcl_Finalize.3
+ cp Exit.3 Tcl_CreateExitHandler.3
+ cp Exit.3 Tcl_DeleteExitHandler.3
+ cp Exit.3 Tcl_ExitThread.3
+ cp Exit.3 Tcl_FinalizeThread.3
+ cp Exit.3 Tcl_CreateThreadExitHandler.3
+ cp Exit.3 Tcl_DeleteThreadExitHandler.3
fi
if test -r ExprLong.3; then
rm -f Tcl_ExprLong.3
- ln ExprLong.3 Tcl_ExprLong.3
-fi
-if test -r ExprLong.3; then
rm -f Tcl_ExprDouble.3
- ln ExprLong.3 Tcl_ExprDouble.3
-fi
-if test -r ExprLong.3; then
rm -f Tcl_ExprBoolean.3
- ln ExprLong.3 Tcl_ExprBoolean.3
-fi
-if test -r ExprLong.3; then
rm -f Tcl_ExprString.3
- ln ExprLong.3 Tcl_ExprString.3
+ cp ExprLong.3 Tcl_ExprLong.3
+ cp ExprLong.3 Tcl_ExprDouble.3
+ cp ExprLong.3 Tcl_ExprBoolean.3
+ cp ExprLong.3 Tcl_ExprString.3
fi
if test -r ExprLongObj.3; then
rm -f Tcl_ExprLongObj.3
- ln ExprLongObj.3 Tcl_ExprLongObj.3
-fi
-if test -r ExprLongObj.3; then
rm -f Tcl_ExprDoubleObj.3
- ln ExprLongObj.3 Tcl_ExprDoubleObj.3
-fi
-if test -r ExprLongObj.3; then
rm -f Tcl_ExprBooleanObj.3
- ln ExprLongObj.3 Tcl_ExprBooleanObj.3
-fi
-if test -r ExprLongObj.3; then
rm -f Tcl_ExprObj.3
- ln ExprLongObj.3 Tcl_ExprObj.3
+ cp ExprLongObj.3 Tcl_ExprLongObj.3
+ cp ExprLongObj.3 Tcl_ExprDoubleObj.3
+ cp ExprLongObj.3 Tcl_ExprBooleanObj.3
+ cp ExprLongObj.3 Tcl_ExprObj.3
fi
if test -r FindExec.3; then
rm -f Tcl_FindExecutable.3
- ln FindExec.3 Tcl_FindExecutable.3
-fi
-if test -r FindExec.3; then
rm -f Tcl_GetNameOfExecutable.3
- ln FindExec.3 Tcl_GetNameOfExecutable.3
+ cp FindExec.3 Tcl_FindExecutable.3
+ cp FindExec.3 Tcl_GetNameOfExecutable.3
+fi
+if test -r GetCwd.3; then
+ rm -f Tcl_GetCwd.3
+ rm -f Tcl_Chdir.3
+ cp GetCwd.3 Tcl_GetCwd.3
+ cp GetCwd.3 Tcl_Chdir.3
+fi
+if test -r GetHostName.3; then
+ rm -f Tcl_GetHostName.3
+ cp GetHostName.3 Tcl_GetHostName.3
fi
if test -r GetIndex.3; then
rm -f Tcl_GetIndexFromObj.3
- ln GetIndex.3 Tcl_GetIndexFromObj.3
+ rm -f Tcl_GetIndexFromObjStruct.3
+ cp GetIndex.3 Tcl_GetIndexFromObj.3
+ cp GetIndex.3 Tcl_GetIndexFromObjStruct.3
fi
if test -r GetInt.3; then
rm -f Tcl_GetInt.3
- ln GetInt.3 Tcl_GetInt.3
-fi
-if test -r GetInt.3; then
rm -f Tcl_GetDouble.3
- ln GetInt.3 Tcl_GetDouble.3
-fi
-if test -r GetInt.3; then
rm -f Tcl_GetBoolean.3
- ln GetInt.3 Tcl_GetBoolean.3
+ cp GetInt.3 Tcl_GetInt.3
+ cp GetInt.3 Tcl_GetDouble.3
+ cp GetInt.3 Tcl_GetBoolean.3
fi
if test -r GetOpnFl.3; then
rm -f Tcl_GetOpenFile.3
- ln GetOpnFl.3 Tcl_GetOpenFile.3
+ cp GetOpnFl.3 Tcl_GetOpenFile.3
fi
if test -r GetStdChan.3; then
rm -f Tcl_GetStdChannel.3
- ln GetStdChan.3 Tcl_GetStdChannel.3
-fi
-if test -r GetStdChan.3; then
rm -f Tcl_SetStdChannel.3
- ln GetStdChan.3 Tcl_SetStdChannel.3
+ cp GetStdChan.3 Tcl_GetStdChannel.3
+ cp GetStdChan.3 Tcl_SetStdChannel.3
fi
-if test -r Hash.3; then
- rm -f Tcl_InitHashTable.3
- ln Hash.3 Tcl_InitHashTable.3
+if test -r GetVersion.3; then
+ rm -f Tcl_GetVersion.3
+ cp GetVersion.3 Tcl_GetVersion.3
fi
if test -r Hash.3; then
+ rm -f Tcl_InitHashTable.3
rm -f Tcl_DeleteHashTable.3
- ln Hash.3 Tcl_DeleteHashTable.3
-fi
-if test -r Hash.3; then
rm -f Tcl_CreateHashEntry.3
- ln Hash.3 Tcl_CreateHashEntry.3
-fi
-if test -r Hash.3; then
rm -f Tcl_DeleteHashEntry.3
- ln Hash.3 Tcl_DeleteHashEntry.3
-fi
-if test -r Hash.3; then
rm -f Tcl_FindHashEntry.3
- ln Hash.3 Tcl_FindHashEntry.3
-fi
-if test -r Hash.3; then
rm -f Tcl_GetHashValue.3
- ln Hash.3 Tcl_GetHashValue.3
-fi
-if test -r Hash.3; then
rm -f Tcl_SetHashValue.3
- ln Hash.3 Tcl_SetHashValue.3
-fi
-if test -r Hash.3; then
rm -f Tcl_GetHashKey.3
- ln Hash.3 Tcl_GetHashKey.3
-fi
-if test -r Hash.3; then
rm -f Tcl_FirstHashEntry.3
- ln Hash.3 Tcl_FirstHashEntry.3
-fi
-if test -r Hash.3; then
rm -f Tcl_NextHashEntry.3
- ln Hash.3 Tcl_NextHashEntry.3
-fi
-if test -r Hash.3; then
rm -f Tcl_HashStats.3
- ln Hash.3 Tcl_HashStats.3
+ cp Hash.3 Tcl_InitHashTable.3
+ cp Hash.3 Tcl_DeleteHashTable.3
+ cp Hash.3 Tcl_CreateHashEntry.3
+ cp Hash.3 Tcl_DeleteHashEntry.3
+ cp Hash.3 Tcl_FindHashEntry.3
+ cp Hash.3 Tcl_GetHashValue.3
+ cp Hash.3 Tcl_SetHashValue.3
+ cp Hash.3 Tcl_GetHashKey.3
+ cp Hash.3 Tcl_FirstHashEntry.3
+ cp Hash.3 Tcl_NextHashEntry.3
+ cp Hash.3 Tcl_HashStats.3
+fi
+if test -r Init.3; then
+ rm -f Tcl_Init.3
+ cp Init.3 Tcl_Init.3
+fi
+if test -r InitStubs.3; then
+ rm -f Tcl_InitStubs.3
+ cp InitStubs.3 Tcl_InitStubs.3
fi
if test -r IntObj.3; then
rm -f Tcl_NewIntObj.3
- ln IntObj.3 Tcl_NewIntObj.3
-fi
-if test -r IntObj.3; then
rm -f Tcl_NewLongObj.3
- ln IntObj.3 Tcl_NewLongObj.3
-fi
-if test -r IntObj.3; then
rm -f Tcl_SetIntObj.3
- ln IntObj.3 Tcl_SetIntObj.3
-fi
-if test -r IntObj.3; then
rm -f Tcl_SetLongObj.3
- ln IntObj.3 Tcl_SetLongObj.3
-fi
-if test -r IntObj.3; then
rm -f Tcl_GetIntFromObj.3
- ln IntObj.3 Tcl_GetIntFromObj.3
-fi
-if test -r IntObj.3; then
rm -f Tcl_GetLongFromObj.3
- ln IntObj.3 Tcl_GetLongFromObj.3
+ cp IntObj.3 Tcl_NewIntObj.3
+ cp IntObj.3 Tcl_NewLongObj.3
+ cp IntObj.3 Tcl_SetIntObj.3
+ cp IntObj.3 Tcl_SetLongObj.3
+ cp IntObj.3 Tcl_GetIntFromObj.3
+ cp IntObj.3 Tcl_GetLongFromObj.3
fi
if test -r Interp.3; then
rm -f Tcl_Interp.3
- ln Interp.3 Tcl_Interp.3
+ cp Interp.3 Tcl_Interp.3
fi
if test -r LinkVar.3; then
rm -f Tcl_LinkVar.3
- ln LinkVar.3 Tcl_LinkVar.3
-fi
-if test -r LinkVar.3; then
rm -f Tcl_UnlinkVar.3
- ln LinkVar.3 Tcl_UnlinkVar.3
-fi
-if test -r LinkVar.3; then
rm -f Tcl_UpdateLinkedVar.3
- ln LinkVar.3 Tcl_UpdateLinkedVar.3
+ cp LinkVar.3 Tcl_LinkVar.3
+ cp LinkVar.3 Tcl_UnlinkVar.3
+ cp LinkVar.3 Tcl_UpdateLinkedVar.3
fi
if test -r ListObj.3; then
rm -f Tcl_ListObjAppendList.3
- ln ListObj.3 Tcl_ListObjAppendList.3
-fi
-if test -r ListObj.3; then
rm -f Tcl_ListObjAppendElement.3
- ln ListObj.3 Tcl_ListObjAppendElement.3
-fi
-if test -r ListObj.3; then
rm -f Tcl_NewListObj.3
- ln ListObj.3 Tcl_NewListObj.3
-fi
-if test -r ListObj.3; then
rm -f Tcl_SetListObj.3
- ln ListObj.3 Tcl_SetListObj.3
-fi
-if test -r ListObj.3; then
rm -f Tcl_ListObjGetElements.3
- ln ListObj.3 Tcl_ListObjGetElements.3
-fi
-if test -r ListObj.3; then
rm -f Tcl_ListObjLength.3
- ln ListObj.3 Tcl_ListObjLength.3
-fi
-if test -r ListObj.3; then
rm -f Tcl_ListObjIndex.3
- ln ListObj.3 Tcl_ListObjIndex.3
-fi
-if test -r ListObj.3; then
rm -f Tcl_ListObjReplace.3
- ln ListObj.3 Tcl_ListObjReplace.3
+ cp ListObj.3 Tcl_ListObjAppendList.3
+ cp ListObj.3 Tcl_ListObjAppendElement.3
+ cp ListObj.3 Tcl_NewListObj.3
+ cp ListObj.3 Tcl_SetListObj.3
+ cp ListObj.3 Tcl_ListObjGetElements.3
+ cp ListObj.3 Tcl_ListObjLength.3
+ cp ListObj.3 Tcl_ListObjIndex.3
+ cp ListObj.3 Tcl_ListObjReplace.3
fi
if test -r Notifier.3; then
rm -f Tcl_CreateEventSource.3
- ln Notifier.3 Tcl_CreateEventSource.3
-fi
-if test -r Notifier.3; then
rm -f Tcl_DeleteEventSource.3
- ln Notifier.3 Tcl_DeleteEventSource.3
-fi
-if test -r Notifier.3; then
rm -f Tcl_SetMaxBlockTime.3
- ln Notifier.3 Tcl_SetMaxBlockTime.3
-fi
-if test -r Notifier.3; then
rm -f Tcl_QueueEvent.3
- ln Notifier.3 Tcl_QueueEvent.3
-fi
-if test -r Notifier.3; then
+ rm -f Tcl_ThreadQueueEvent.3
+ rm -f Tcl_ThreadAlert.3
+ rm -f Tcl_GetCurrentThread.3
rm -f Tcl_DeleteEvents.3
- ln Notifier.3 Tcl_DeleteEvents.3
-fi
-if test -r Notifier.3; then
+ rm -f Tcl_InitNotifier.3
+ rm -f Tcl_FinalizeNotifier.3
rm -f Tcl_WaitForEvent.3
- ln Notifier.3 Tcl_WaitForEvent.3
-fi
-if test -r Notifier.3; then
+ rm -f Tcl_AlertNotifier.3
rm -f Tcl_SetTimer.3
- ln Notifier.3 Tcl_SetTimer.3
-fi
-if test -r Notifier.3; then
rm -f Tcl_ServiceAll.3
- ln Notifier.3 Tcl_ServiceAll.3
-fi
-if test -r Notifier.3; then
rm -f Tcl_ServiceEvent.3
- ln Notifier.3 Tcl_ServiceEvent.3
-fi
-if test -r Notifier.3; then
rm -f Tcl_GetServiceMode.3
- ln Notifier.3 Tcl_GetServiceMode.3
-fi
-if test -r Notifier.3; then
rm -f Tcl_SetServiceMode.3
- ln Notifier.3 Tcl_SetServiceMode.3
-fi
-if test -r ObjSetVar.3; then
- rm -f Tcl_ObjSetVar2.3
- ln ObjSetVar.3 Tcl_ObjSetVar2.3
-fi
-if test -r ObjSetVar.3; then
- rm -f Tcl_ObjGetVar2.3
- ln ObjSetVar.3 Tcl_ObjGetVar2.3
+ cp Notifier.3 Tcl_CreateEventSource.3
+ cp Notifier.3 Tcl_DeleteEventSource.3
+ cp Notifier.3 Tcl_SetMaxBlockTime.3
+ cp Notifier.3 Tcl_QueueEvent.3
+ cp Notifier.3 Tcl_ThreadQueueEvent.3
+ cp Notifier.3 Tcl_ThreadAlert.3
+ cp Notifier.3 Tcl_GetCurrentThread.3
+ cp Notifier.3 Tcl_DeleteEvents.3
+ cp Notifier.3 Tcl_InitNotifier.3
+ cp Notifier.3 Tcl_FinalizeNotifier.3
+ cp Notifier.3 Tcl_WaitForEvent.3
+ cp Notifier.3 Tcl_AlertNotifier.3
+ cp Notifier.3 Tcl_SetTimer.3
+ cp Notifier.3 Tcl_ServiceAll.3
+ cp Notifier.3 Tcl_ServiceEvent.3
+ cp Notifier.3 Tcl_GetServiceMode.3
+ cp Notifier.3 Tcl_SetServiceMode.3
fi
if test -r Object.3; then
rm -f Tcl_NewObj.3
- ln Object.3 Tcl_NewObj.3
-fi
-if test -r Object.3; then
rm -f Tcl_DuplicateObj.3
- ln Object.3 Tcl_DuplicateObj.3
-fi
-if test -r Object.3; then
rm -f Tcl_IncrRefCount.3
- ln Object.3 Tcl_IncrRefCount.3
-fi
-if test -r Object.3; then
rm -f Tcl_DecrRefCount.3
- ln Object.3 Tcl_DecrRefCount.3
-fi
-if test -r Object.3; then
rm -f Tcl_IsShared.3
- ln Object.3 Tcl_IsShared.3
+ rm -f Tcl_InvalidateStringRep.3
+ cp Object.3 Tcl_NewObj.3
+ cp Object.3 Tcl_DuplicateObj.3
+ cp Object.3 Tcl_IncrRefCount.3
+ cp Object.3 Tcl_DecrRefCount.3
+ cp Object.3 Tcl_IsShared.3
+ cp Object.3 Tcl_InvalidateStringRep.3
fi
if test -r ObjectType.3; then
rm -f Tcl_RegisterObjType.3
- ln ObjectType.3 Tcl_RegisterObjType.3
-fi
-if test -r ObjectType.3; then
rm -f Tcl_GetObjType.3
- ln ObjectType.3 Tcl_GetObjType.3
-fi
-if test -r ObjectType.3; then
rm -f Tcl_AppendAllObjTypes.3
- ln ObjectType.3 Tcl_AppendAllObjTypes.3
-fi
-if test -r ObjectType.3; then
rm -f Tcl_ConvertToType.3
- ln ObjectType.3 Tcl_ConvertToType.3
+ cp ObjectType.3 Tcl_RegisterObjType.3
+ cp ObjectType.3 Tcl_GetObjType.3
+ cp ObjectType.3 Tcl_AppendAllObjTypes.3
+ cp ObjectType.3 Tcl_ConvertToType.3
fi
if test -r OpenFileChnl.3; then
rm -f Tcl_OpenFileChannel.3
- ln OpenFileChnl.3 Tcl_OpenFileChannel.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_OpenCommandChannel.3
- ln OpenFileChnl.3 Tcl_OpenCommandChannel.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_MakeFileChannel.3
- ln OpenFileChnl.3 Tcl_MakeFileChannel.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_GetChannel.3
- ln OpenFileChnl.3 Tcl_GetChannel.3
-fi
-if test -r OpenFileChnl.3; then
+ rm -f Tcl_GetChannelNames.3
+ rm -f Tcl_GetChannelNamesEx.3
rm -f Tcl_RegisterChannel.3
- ln OpenFileChnl.3 Tcl_RegisterChannel.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_UnregisterChannel.3
- ln OpenFileChnl.3 Tcl_UnregisterChannel.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_Close.3
- ln OpenFileChnl.3 Tcl_Close.3
-fi
-if test -r OpenFileChnl.3; then
+ rm -f Tcl_ReadChars.3
rm -f Tcl_Read.3
- ln OpenFileChnl.3 Tcl_Read.3
-fi
-if test -r OpenFileChnl.3; then
+ rm -f Tcl_GetsObj.3
rm -f Tcl_Gets.3
- ln OpenFileChnl.3 Tcl_Gets.3
-fi
-if test -r OpenFileChnl.3; then
+ rm -f Tcl_WriteObj.3
+ rm -f Tcl_WriteChars.3
rm -f Tcl_Write.3
- ln OpenFileChnl.3 Tcl_Write.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_Flush.3
- ln OpenFileChnl.3 Tcl_Flush.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_Seek.3
- ln OpenFileChnl.3 Tcl_Seek.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_Tell.3
- ln OpenFileChnl.3 Tcl_Tell.3
-fi
-if test -r OpenFileChnl.3; then
+ rm -f Tcl_GetChannelOption.3
+ rm -f Tcl_SetChannelOption.3
rm -f Tcl_Eof.3
- ln OpenFileChnl.3 Tcl_Eof.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_InputBlocked.3
- ln OpenFileChnl.3 Tcl_InputBlocked.3
-fi
-if test -r OpenFileChnl.3; then
rm -f Tcl_InputBuffered.3
- ln OpenFileChnl.3 Tcl_InputBuffered.3
-fi
-if test -r OpenFileChnl.3; then
- rm -f Tcl_GetChannelOption.3
- ln OpenFileChnl.3 Tcl_GetChannelOption.3
-fi
-if test -r OpenFileChnl.3; then
- rm -f Tcl_SetChannelOption.3
- ln OpenFileChnl.3 Tcl_SetChannelOption.3
+ rm -f Tcl_Ungets.3
+ cp OpenFileChnl.3 Tcl_OpenFileChannel.3
+ cp OpenFileChnl.3 Tcl_OpenCommandChannel.3
+ cp OpenFileChnl.3 Tcl_MakeFileChannel.3
+ cp OpenFileChnl.3 Tcl_GetChannel.3
+ cp OpenFileChnl.3 Tcl_GetChannelNames.3
+ cp OpenFileChnl.3 Tcl_GetChannelNamesEx.3
+ cp OpenFileChnl.3 Tcl_RegisterChannel.3
+ cp OpenFileChnl.3 Tcl_UnregisterChannel.3
+ cp OpenFileChnl.3 Tcl_Close.3
+ cp OpenFileChnl.3 Tcl_ReadChars.3
+ cp OpenFileChnl.3 Tcl_Read.3
+ cp OpenFileChnl.3 Tcl_GetsObj.3
+ cp OpenFileChnl.3 Tcl_Gets.3
+ cp OpenFileChnl.3 Tcl_WriteObj.3
+ cp OpenFileChnl.3 Tcl_WriteChars.3
+ cp OpenFileChnl.3 Tcl_Write.3
+ cp OpenFileChnl.3 Tcl_Flush.3
+ cp OpenFileChnl.3 Tcl_Seek.3
+ cp OpenFileChnl.3 Tcl_Tell.3
+ cp OpenFileChnl.3 Tcl_GetChannelOption.3
+ cp OpenFileChnl.3 Tcl_SetChannelOption.3
+ cp OpenFileChnl.3 Tcl_Eof.3
+ cp OpenFileChnl.3 Tcl_InputBlocked.3
+ cp OpenFileChnl.3 Tcl_InputBuffered.3
+ cp OpenFileChnl.3 Tcl_Ungets.3
fi
if test -r OpenTcp.3; then
rm -f Tcl_OpenTcpClient.3
- ln OpenTcp.3 Tcl_OpenTcpClient.3
-fi
-if test -r OpenTcp.3; then
rm -f Tcl_MakeTcpClientChannel.3
- ln OpenTcp.3 Tcl_MakeTcpClientChannel.3
-fi
-if test -r OpenTcp.3; then
rm -f Tcl_OpenTcpServer.3
- ln OpenTcp.3 Tcl_OpenTcpServer.3
+ cp OpenTcp.3 Tcl_OpenTcpClient.3
+ cp OpenTcp.3 Tcl_MakeTcpClientChannel.3
+ cp OpenTcp.3 Tcl_OpenTcpServer.3
+fi
+if test -r ParseCmd.3; then
+ rm -f Tcl_ParseCommand.3
+ rm -f Tcl_ParseExpr.3
+ rm -f Tcl_ParseBraces.3
+ rm -f Tcl_ParseQuotedString.3
+ rm -f Tcl_ParseVarName.3
+ rm -f Tcl_ParseVar.3
+ rm -f Tcl_FreeParse.3
+ rm -f Tcl_EvalTokens.3
+ cp ParseCmd.3 Tcl_ParseCommand.3
+ cp ParseCmd.3 Tcl_ParseExpr.3
+ cp ParseCmd.3 Tcl_ParseBraces.3
+ cp ParseCmd.3 Tcl_ParseQuotedString.3
+ cp ParseCmd.3 Tcl_ParseVarName.3
+ cp ParseCmd.3 Tcl_ParseVar.3
+ cp ParseCmd.3 Tcl_FreeParse.3
+ cp ParseCmd.3 Tcl_EvalTokens.3
fi
if test -r PkgRequire.3; then
rm -f Tcl_PkgRequire.3
- ln PkgRequire.3 Tcl_PkgRequire.3
-fi
-if test -r PkgRequire.3; then
+ rm -f Tcl_PkgRequireEx.3
+ rm -f Tcl_PkgPresent.3
+ rm -f Tcl_PkgPresentEx.3
rm -f Tcl_PkgProvide.3
- ln PkgRequire.3 Tcl_PkgProvide.3
+ rm -f Tcl_PkgProvideEx.3
+ cp PkgRequire.3 Tcl_PkgRequire.3
+ cp PkgRequire.3 Tcl_PkgRequireEx.3
+ cp PkgRequire.3 Tcl_PkgPresent.3
+ cp PkgRequire.3 Tcl_PkgPresentEx.3
+ cp PkgRequire.3 Tcl_PkgProvide.3
+ cp PkgRequire.3 Tcl_PkgProvideEx.3
fi
if test -r Preserve.3; then
rm -f Tcl_Preserve.3
- ln Preserve.3 Tcl_Preserve.3
-fi
-if test -r Preserve.3; then
rm -f Tcl_Release.3
- ln Preserve.3 Tcl_Release.3
-fi
-if test -r Preserve.3; then
rm -f Tcl_EventuallyFree.3
- ln Preserve.3 Tcl_EventuallyFree.3
+ cp Preserve.3 Tcl_Preserve.3
+ cp Preserve.3 Tcl_Release.3
+ cp Preserve.3 Tcl_EventuallyFree.3
fi
if test -r PrintDbl.3; then
rm -f Tcl_PrintDouble.3
- ln PrintDbl.3 Tcl_PrintDouble.3
+ cp PrintDbl.3 Tcl_PrintDouble.3
fi
if test -r RecEvalObj.3; then
rm -f Tcl_RecordAndEvalObj.3
- ln RecEvalObj.3 Tcl_RecordAndEvalObj.3
+ cp RecEvalObj.3 Tcl_RecordAndEvalObj.3
fi
if test -r RecordEval.3; then
rm -f Tcl_RecordAndEval.3
- ln RecordEval.3 Tcl_RecordAndEval.3
+ cp RecordEval.3 Tcl_RecordAndEval.3
fi
if test -r RegExp.3; then
rm -f Tcl_RegExpMatch.3
- ln RegExp.3 Tcl_RegExpMatch.3
-fi
-if test -r RegExp.3; then
rm -f Tcl_RegExpCompile.3
- ln RegExp.3 Tcl_RegExpCompile.3
-fi
-if test -r RegExp.3; then
rm -f Tcl_RegExpExec.3
- ln RegExp.3 Tcl_RegExpExec.3
-fi
-if test -r RegExp.3; then
rm -f Tcl_RegExpRange.3
- ln RegExp.3 Tcl_RegExpRange.3
+ rm -f Tcl_GetRegExpFromObj.3
+ rm -f Tcl_RegExpMatchObj.3
+ rm -f Tcl_RegExpExecObj.3
+ rm -f Tcl_RegExpGetInfo.3
+ cp RegExp.3 Tcl_RegExpMatch.3
+ cp RegExp.3 Tcl_RegExpCompile.3
+ cp RegExp.3 Tcl_RegExpExec.3
+ cp RegExp.3 Tcl_RegExpRange.3
+ cp RegExp.3 Tcl_GetRegExpFromObj.3
+ cp RegExp.3 Tcl_RegExpMatchObj.3
+ cp RegExp.3 Tcl_RegExpExecObj.3
+ cp RegExp.3 Tcl_RegExpGetInfo.3
+fi
+if test -r SaveResult.3; then
+ rm -f Tcl_SaveResult.3
+ rm -f Tcl_RestoreResult.3
+ rm -f Tcl_DiscardResult.3
+ cp SaveResult.3 Tcl_SaveResult.3
+ cp SaveResult.3 Tcl_RestoreResult.3
+ cp SaveResult.3 Tcl_DiscardResult.3
fi
if test -r SetErrno.3; then
rm -f Tcl_SetErrno.3
- ln SetErrno.3 Tcl_SetErrno.3
-fi
-if test -r SetErrno.3; then
rm -f Tcl_GetErrno.3
- ln SetErrno.3 Tcl_GetErrno.3
+ rm -f Tcl_ErrnoId.3
+ rm -f Tcl_ErrnoMsg.3
+ cp SetErrno.3 Tcl_SetErrno.3
+ cp SetErrno.3 Tcl_GetErrno.3
+ cp SetErrno.3 Tcl_ErrnoId.3
+ cp SetErrno.3 Tcl_ErrnoMsg.3
fi
if test -r SetRecLmt.3; then
rm -f Tcl_SetRecursionLimit.3
- ln SetRecLmt.3 Tcl_SetRecursionLimit.3
+ cp SetRecLmt.3 Tcl_SetRecursionLimit.3
fi
if test -r SetResult.3; then
rm -f Tcl_SetObjResult.3
- ln SetResult.3 Tcl_SetObjResult.3
-fi
-if test -r SetResult.3; then
rm -f Tcl_GetObjResult.3
- ln SetResult.3 Tcl_GetObjResult.3
-fi
-if test -r SetResult.3; then
rm -f Tcl_SetResult.3
- ln SetResult.3 Tcl_SetResult.3
-fi
-if test -r SetResult.3; then
rm -f Tcl_GetStringResult.3
- ln SetResult.3 Tcl_GetStringResult.3
-fi
-if test -r SetResult.3; then
rm -f Tcl_AppendResult.3
- ln SetResult.3 Tcl_AppendResult.3
-fi
-if test -r SetResult.3; then
+ rm -f Tcl_AppendResultVA.3
rm -f Tcl_AppendElement.3
- ln SetResult.3 Tcl_AppendElement.3
-fi
-if test -r SetResult.3; then
rm -f Tcl_ResetResult.3
- ln SetResult.3 Tcl_ResetResult.3
+ rm -f Tcl_FreeResult.3
+ cp SetResult.3 Tcl_SetObjResult.3
+ cp SetResult.3 Tcl_GetObjResult.3
+ cp SetResult.3 Tcl_SetResult.3
+ cp SetResult.3 Tcl_GetStringResult.3
+ cp SetResult.3 Tcl_AppendResult.3
+ cp SetResult.3 Tcl_AppendResultVA.3
+ cp SetResult.3 Tcl_AppendElement.3
+ cp SetResult.3 Tcl_ResetResult.3
+ cp SetResult.3 Tcl_FreeResult.3
fi
if test -r SetVar.3; then
+ rm -f Tcl_SetVar2Ex.3
rm -f Tcl_SetVar.3
- ln SetVar.3 Tcl_SetVar.3
-fi
-if test -r SetVar.3; then
rm -f Tcl_SetVar2.3
- ln SetVar.3 Tcl_SetVar2.3
-fi
-if test -r SetVar.3; then
+ rm -f Tcl_ObjSetVar2.3
+ rm -f Tcl_GetVar2Ex.3
rm -f Tcl_GetVar.3
- ln SetVar.3 Tcl_GetVar.3
-fi
-if test -r SetVar.3; then
rm -f Tcl_GetVar2.3
- ln SetVar.3 Tcl_GetVar2.3
-fi
-if test -r SetVar.3; then
+ rm -f Tcl_ObjGetVar2.3
rm -f Tcl_UnsetVar.3
- ln SetVar.3 Tcl_UnsetVar.3
-fi
-if test -r SetVar.3; then
rm -f Tcl_UnsetVar2.3
- ln SetVar.3 Tcl_UnsetVar2.3
+ cp SetVar.3 Tcl_SetVar2Ex.3
+ cp SetVar.3 Tcl_SetVar.3
+ cp SetVar.3 Tcl_SetVar2.3
+ cp SetVar.3 Tcl_ObjSetVar2.3
+ cp SetVar.3 Tcl_GetVar2Ex.3
+ cp SetVar.3 Tcl_GetVar.3
+ cp SetVar.3 Tcl_GetVar2.3
+ cp SetVar.3 Tcl_ObjGetVar2.3
+ cp SetVar.3 Tcl_UnsetVar.3
+ cp SetVar.3 Tcl_UnsetVar2.3
fi
if test -r Sleep.3; then
rm -f Tcl_Sleep.3
- ln Sleep.3 Tcl_Sleep.3
+ cp Sleep.3 Tcl_Sleep.3
fi
-if test -r SplitList.3; then
- rm -f Tcl_SplitList.3
- ln SplitList.3 Tcl_SplitList.3
+if test -r SourceRCFile.3; then
+ rm -f Tcl_SourceRCFile.3
+ cp SourceRCFile.3 Tcl_SourceRCFile.3
fi
if test -r SplitList.3; then
+ rm -f Tcl_SplitList.3
rm -f Tcl_Merge.3
- ln SplitList.3 Tcl_Merge.3
-fi
-if test -r SplitList.3; then
rm -f Tcl_ScanElement.3
- ln SplitList.3 Tcl_ScanElement.3
-fi
-if test -r SplitList.3; then
rm -f Tcl_ConvertElement.3
- ln SplitList.3 Tcl_ConvertElement.3
+ rm -f Tcl_ScanCountedElement.3
+ rm -f Tcl_ConvertCountedElement.3
+ cp SplitList.3 Tcl_SplitList.3
+ cp SplitList.3 Tcl_Merge.3
+ cp SplitList.3 Tcl_ScanElement.3
+ cp SplitList.3 Tcl_ConvertElement.3
+ cp SplitList.3 Tcl_ScanCountedElement.3
+ cp SplitList.3 Tcl_ConvertCountedElement.3
fi
if test -r SplitPath.3; then
rm -f Tcl_SplitPath.3
- ln SplitPath.3 Tcl_SplitPath.3
-fi
-if test -r SplitPath.3; then
rm -f Tcl_JoinPath.3
- ln SplitPath.3 Tcl_JoinPath.3
-fi
-if test -r SplitPath.3; then
rm -f Tcl_GetPathType.3
- ln SplitPath.3 Tcl_GetPathType.3
+ cp SplitPath.3 Tcl_SplitPath.3
+ cp SplitPath.3 Tcl_JoinPath.3
+ cp SplitPath.3 Tcl_GetPathType.3
fi
if test -r StaticPkg.3; then
rm -f Tcl_StaticPackage.3
- ln StaticPkg.3 Tcl_StaticPackage.3
+ cp StaticPkg.3 Tcl_StaticPackage.3
fi
if test -r StrMatch.3; then
rm -f Tcl_StringMatch.3
- ln StrMatch.3 Tcl_StringMatch.3
+ rm -f Tcl_StringCaseMatch.3
+ cp StrMatch.3 Tcl_StringMatch.3
+ cp StrMatch.3 Tcl_StringCaseMatch.3
fi
if test -r StringObj.3; then
rm -f Tcl_NewStringObj.3
- ln StringObj.3 Tcl_NewStringObj.3
-fi
-if test -r StringObj.3; then
+ rm -f Tcl_NewUnicodeObj.3
rm -f Tcl_SetStringObj.3
- ln StringObj.3 Tcl_SetStringObj.3
-fi
-if test -r StringObj.3; then
+ rm -f Tcl_SetUnicodeObj.3
rm -f Tcl_GetStringFromObj.3
- ln StringObj.3 Tcl_GetStringFromObj.3
-fi
-if test -r StringObj.3; then
+ rm -f Tcl_GetString.3
+ rm -f Tcl_GetUnicode.3
+ rm -f Tcl_GetUniChar.3
+ rm -f Tcl_GetCharLength.3
+ rm -f Tcl_GetRange.3
rm -f Tcl_AppendToObj.3
- ln StringObj.3 Tcl_AppendToObj.3
-fi
-if test -r StringObj.3; then
+ rm -f Tcl_AppendUnicodeToObj.3
rm -f Tcl_AppendStringsToObj.3
- ln StringObj.3 Tcl_AppendStringsToObj.3
-fi
-if test -r StringObj.3; then
+ rm -f Tcl_AppendStringsToObjVA.3
+ rm -f Tcl_AppendObjToObj.3
rm -f Tcl_SetObjLength.3
- ln StringObj.3 Tcl_SetObjLength.3
-fi
-if test -r StringObj.3; then
- rm -f TclConcatObj.3
- ln StringObj.3 TclConcatObj.3
+ rm -f Tcl_ConcatObj.3
+ cp StringObj.3 Tcl_NewStringObj.3
+ cp StringObj.3 Tcl_NewUnicodeObj.3
+ cp StringObj.3 Tcl_SetStringObj.3
+ cp StringObj.3 Tcl_SetUnicodeObj.3
+ cp StringObj.3 Tcl_GetStringFromObj.3
+ cp StringObj.3 Tcl_GetString.3
+ cp StringObj.3 Tcl_GetUnicode.3
+ cp StringObj.3 Tcl_GetUniChar.3
+ cp StringObj.3 Tcl_GetCharLength.3
+ cp StringObj.3 Tcl_GetRange.3
+ cp StringObj.3 Tcl_AppendToObj.3
+ cp StringObj.3 Tcl_AppendUnicodeToObj.3
+ cp StringObj.3 Tcl_AppendStringsToObj.3
+ cp StringObj.3 Tcl_AppendStringsToObjVA.3
+ cp StringObj.3 Tcl_AppendObjToObj.3
+ cp StringObj.3 Tcl_SetObjLength.3
+ cp StringObj.3 Tcl_ConcatObj.3
+fi
+if test -r Thread.3; then
+ rm -f Tcl_ConditionNotify.3
+ rm -f Tcl_ConditionWait.3
+ rm -f Tcl_ConditionFinalize.3
+ rm -f Tcl_GetThreadData.3
+ rm -f Tcl_MutexLock.3
+ rm -f Tcl_MutexUnlock.3
+ rm -f Tcl_MutexFinalize.3
+ rm -f Tcl_CreateThread.3
+ cp Thread.3 Tcl_ConditionNotify.3
+ cp Thread.3 Tcl_ConditionWait.3
+ cp Thread.3 Tcl_ConditionFinalize.3
+ cp Thread.3 Tcl_GetThreadData.3
+ cp Thread.3 Tcl_MutexLock.3
+ cp Thread.3 Tcl_MutexUnlock.3
+ cp Thread.3 Tcl_MutexFinalize.3
+ cp Thread.3 Tcl_CreateThread.3
+fi
+if test -r ToUpper.3; then
+ rm -f Tcl_UniCharToUpper.3
+ rm -f Tcl_UniCharToLower.3
+ rm -f Tcl_UniCharToTitle.3
+ rm -f Tcl_UtfToUpper.3
+ rm -f Tcl_UtfToLower.3
+ rm -f Tcl_UtfToTitle.3
+ cp ToUpper.3 Tcl_UniCharToUpper.3
+ cp ToUpper.3 Tcl_UniCharToLower.3
+ cp ToUpper.3 Tcl_UniCharToTitle.3
+ cp ToUpper.3 Tcl_UtfToUpper.3
+ cp ToUpper.3 Tcl_UtfToLower.3
+ cp ToUpper.3 Tcl_UtfToTitle.3
fi
if test -r TraceVar.3; then
rm -f Tcl_TraceVar.3
- ln TraceVar.3 Tcl_TraceVar.3
-fi
-if test -r TraceVar.3; then
rm -f Tcl_TraceVar2.3
- ln TraceVar.3 Tcl_TraceVar2.3
-fi
-if test -r TraceVar.3; then
rm -f Tcl_UntraceVar.3
- ln TraceVar.3 Tcl_UntraceVar.3
-fi
-if test -r TraceVar.3; then
rm -f Tcl_UntraceVar2.3
- ln TraceVar.3 Tcl_UntraceVar2.3
-fi
-if test -r TraceVar.3; then
rm -f Tcl_VarTraceInfo.3
- ln TraceVar.3 Tcl_VarTraceInfo.3
-fi
-if test -r TraceVar.3; then
rm -f Tcl_VarTraceInfo2.3
- ln TraceVar.3 Tcl_VarTraceInfo2.3
+ cp TraceVar.3 Tcl_TraceVar.3
+ cp TraceVar.3 Tcl_TraceVar2.3
+ cp TraceVar.3 Tcl_UntraceVar.3
+ cp TraceVar.3 Tcl_UntraceVar2.3
+ cp TraceVar.3 Tcl_VarTraceInfo.3
+ cp TraceVar.3 Tcl_VarTraceInfo2.3
fi
if test -r Translate.3; then
rm -f Tcl_TranslateFileName.3
- ln Translate.3 Tcl_TranslateFileName.3
+ cp Translate.3 Tcl_TranslateFileName.3
fi
if test -r UpVar.3; then
rm -f Tcl_UpVar.3
- ln UpVar.3 Tcl_UpVar.3
-fi
-if test -r UpVar.3; then
rm -f Tcl_UpVar2.3
- ln UpVar.3 Tcl_UpVar2.3
+ cp UpVar.3 Tcl_UpVar.3
+ cp UpVar.3 Tcl_UpVar2.3
+fi
+if test -r Utf.3; then
+ rm -f Tcl_UniChar.3
+ rm -f Tcl_UniCharToUtf.3
+ rm -f Tcl_UtfToUniChar.3
+ rm -f Tcl_UniCharToUtfDString.3
+ rm -f Tcl_UtfToUniCharDString.3
+ rm -f Tcl_UniCharLen.3
+ rm -f Tcl_UniCharNcmp.3
+ rm -f Tcl_UtfCharComplete.3
+ rm -f Tcl_NumUtfChars.3
+ rm -f Tcl_UtfFindFirst.3
+ rm -f Tcl_UtfFindLast.3
+ rm -f Tcl_UtfNext.3
+ rm -f Tcl_UtfPrev.3
+ rm -f Tcl_UniCharAtIndex.3
+ rm -f Tcl_UtfAtIndex.3
+ rm -f Tcl_UtfBackslash.3
+ cp Utf.3 Tcl_UniChar.3
+ cp Utf.3 Tcl_UniCharToUtf.3
+ cp Utf.3 Tcl_UtfToUniChar.3
+ cp Utf.3 Tcl_UniCharToUtfDString.3
+ cp Utf.3 Tcl_UtfToUniCharDString.3
+ cp Utf.3 Tcl_UniCharLen.3
+ cp Utf.3 Tcl_UniCharNcmp.3
+ cp Utf.3 Tcl_UtfCharComplete.3
+ cp Utf.3 Tcl_NumUtfChars.3
+ cp Utf.3 Tcl_UtfFindFirst.3
+ cp Utf.3 Tcl_UtfFindLast.3
+ cp Utf.3 Tcl_UtfNext.3
+ cp Utf.3 Tcl_UtfPrev.3
+ cp Utf.3 Tcl_UniCharAtIndex.3
+ cp Utf.3 Tcl_UtfAtIndex.3
+ cp Utf.3 Tcl_UtfBackslash.3
fi
if test -r WrongNumArgs.3; then
rm -f Tcl_WrongNumArgs.3
- ln WrongNumArgs.3 Tcl_WrongNumArgs.3
+ cp WrongNumArgs.3 Tcl_WrongNumArgs.3
fi
if test -r http.n; then
rm -f Http.n
- ln http.n Http.n
+ cp http.n Http.n
+fi
+if test -r library.n; then
+ rm -f auto_execok.n
+ rm -f auto_import.n
+ rm -f auto_load.n
+ rm -f auto_mkindex.n
+ rm -f auto_mkindex_old.n
+ rm -f auto_qualify.n
+ rm -f auto_reset.n
+ rm -f tcl_findLibrary.n
+ rm -f parray.n
+ rm -f tcl_endOfWord.n
+ rm -f tcl_startOfNextWord.n
+ rm -f tcl_startOfPreviousWord.n
+ rm -f tcl_wordBreakAfter.n
+ rm -f tcl_wordBreakBefore.n
+ cp library.n auto_execok.n
+ cp library.n auto_import.n
+ cp library.n auto_load.n
+ cp library.n auto_mkindex.n
+ cp library.n auto_mkindex_old.n
+ cp library.n auto_qualify.n
+ cp library.n auto_reset.n
+ cp library.n tcl_findLibrary.n
+ cp library.n parray.n
+ cp library.n tcl_endOfWord.n
+ cp library.n tcl_startOfNextWord.n
+ cp library.n tcl_startOfPreviousWord.n
+ cp library.n tcl_wordBreakAfter.n
+ cp library.n tcl_wordBreakBefore.n
+fi
+if test -r packagens.n; then
+ rm -f pkg::create.n
+ cp packagens.n pkg::create.n
fi
if test -r pkgMkIndex.n; then
rm -f pkg_mkIndex.n
- ln pkgMkIndex.n pkg_mkIndex.n
+ cp pkgMkIndex.n pkg_mkIndex.n
fi
if test -r safe.n; then
rm -f SafeBase.n
- ln safe.n SafeBase.n
+ cp safe.n SafeBase.n
+fi
+if test -r tcltest.n; then
+ rm -f Tcltest.n
+ cp tcltest.n Tcltest.n
fi
exit 0
diff --git a/tcl/unix/porting.old b/tcl/unix/porting.old
new file mode 100644
index 00000000000..e312de0a4a7
--- /dev/null
+++ b/tcl/unix/porting.old
@@ -0,0 +1,384 @@
+This is an old version of the file "porting.notes". It contains
+porting information that people submitted for Tcl releases numbered
+7.3 and earlier. You may find information in this file useful if
+there is no information available for your machine in the current
+version of "porting.notes".
+
+I don't have personal access to any of these machines, so I make
+no guarantees that the notes are correct, complete, or up-to-date.
+If you see the word "I" in any explanations, it refers to the person
+who contributed the information, not to me; this means that I
+probably can't answer any questions about any of this stuff. In
+some cases, a person has volunteered to act as a contact point for
+questions about porting Tcl to a particular machine; in these
+cases the person's name and e-mail address are listed.
+
+sccsid = SCCS: @(#) porting.old 1.3 96/02/16 08:56:07
+
+---------------------------------------------
+Cray machines running UNICOS:
+Contact: John Freeman (jlf@cray.com)
+---------------------------------------------
+
+1. There is an error in the strstr function in UNICOS such that if the
+string to be searched is empty (""), the search will continue past the
+end of the string. Because of this, the history substitution loop
+will sometimes run past the end of its target string and trash
+malloc's free list, resulting in a core dump some time later. (As you
+can probably guess, this took a while to diagnose.) I've submitted a
+problem report to the C library maintainers, but in the meantime here
+is a workaround.
+
+-----------------------------------------------------------------
+diff -c1 -r1.1 tclHistory.c
+*** 1.1 1991/11/12 16:01:58
+--- tclHistory.c 1991/11/12 16:14:22
+***************
+*** 23,24 ****
+--- 23,29 ----
+ #include "tclInt.h"
++
++ #ifdef _CRAY
++ /* There is a bug in strstr in UNICOS; this works around it. */
++ #define strstr(s1,s2) ((s1)?(*(s1)?strstr((s1),(s2)):0):0)
++ #endif _CRAY
+
+---------------------------------------------
+MIPS systems runing EP/IX:
+---------------------------------------------
+
+1. Need to add a line "#include <bsd/sys/time.h>" in tclUnix.h.
+
+2. Need to add "-lbsd" into the line that makes tclTest:
+
+ ${CC} ${CFLAGS} tclTest.o libtcl.a -lbsd -o tclTest
+
+---------------------------------------------
+IBM RS/6000 systems running AIX:
+---------------------------------------------
+
+1. The system version of strtoul is buggy, at least under some
+versions of AIX. If the expression tests fail, try forcing Tcl
+to use its own version of strtoul instead of the system version.
+To do this, first copy strtoul.c from the compat subdirectory up
+to the main Tcl directory. Then modify the Makefile so that
+the definition for COMPAT_OBJS includes "strtoul.o". Note: the
+"config" script should now detect the buggy strtoul and substitute
+Tcl's version automatically.
+
+2. You may have to comment out the declaration of open in tclUnix.h.
+
+3. You may need to add "-D_BSD -lbsd" to the CFLAGS definition. This
+causes the system include files to look like BSD include files and
+causes C library routines to act like bsd library routines. Without
+this, the system may choke on "struct wait".
+
+---------------------------------------------
+AT&T 4.03 OS:
+---------------------------------------------
+
+Machine: i386/33Mhz i387 32k Cache 16MByte
+OS: AT&T SYSV Release 4 Version 3
+X: X11R5 fixlevel 9
+Xserver: X386 1.2
+
+1. Change the Tk Makefile as follows:
+XLIB = -lX11
+ should be changed to:
+XLIB = -lX11 -lsocket -lnsl
+
+-------------------------------------------------------
+Silicon Graphics systems:
+-------------------------------------------------------
+
+1. Change the CC variable in the Makefile to:
+
+CC = cc -xansi -D__STDC__ -signed
+
+2. In Irix releases 4.0.1 or earlier the C compiler has a buggy optimizer.
+ If Tcl fails its test suite or generates inexplicable errors,
+ compile tclVar.c with -O0 instead of -O.
+
+3. For IRIX 5.1 or later, comments 1 and 2 are no longer relevant,
+but you must add -D_BSD_SIGNALS to CFLAGS to get the proper signal
+routines.
+
+4. Add a "-lsun" switch in the targets for tclsh and tcltest,
+just before ${MATH_LIBS}.
+
+5. Rumor has it that you also need to add the "-lmalloc" library switch
+in the targets for tclsh and tcltest.
+
+6. In IRIX 5.2 you'll have to modify Makefile to fix the following problems:
+ - The "-c" option is illegal with this version of install, but
+ the "-F" switch is needed instead. Change this in the "INSTALL ="
+ definition line.
+ - The order of file and directory have to be changed in all the
+ invocations of INSTALL_DATA or INSTALL_PROGRAM.
+
+---------------------------------------------
+NeXT machines running NeXTStep 3.1:
+---------------------------------------------
+
+1. Run configure with predefined CPP:
+ CPP='cc -E' ./configure
+ (If your shell is [t]csh, do a "setenv CPP 'cc -E' ")
+
+2. Edit Makefile:
+ -add tmpnam.o to COMPAT_OBJS:
+ COMPAT_OBJS = getcwd.o waitpid.o strtod.o tmpnam.o
+ -add the following to AC_FLAGS:
+ -Dstrtod=tcl_strtod
+
+3. Edit compat/tmpnam.c and replace "/usr/tmp" with "/tmp"
+
+After this, tcl7.0 will be build fine on NeXT (ignore linker warning)
+and run all the tests. There are some formatting problems in printf() or
+scanf() which come from NeXT's lacking POSIX conformance. Ignore those
+errors, they don't matter much.
+
+4. Additional information that may apply to NeXTStep 3.2 only:
+
+ The problem on NEXTSTEP 3.2 is that the configure script makes some
+ bad assumptions about the uid_t and gid_t types. Actually, the may
+ have been valid for NEXTSTEP 3.0, or it may be NEXTSTEP's rudimentary
+ attempt at POSIX support under 3.2, but no matter what the reason, the
+ configure script sets up the Makefile with CFLAGS '-Duid_t=int' and
+ '-Dgid_t=int', which are, unfortunately, incorrect, since they shoudl
+ actually be (I think) unsigned shorts. This causes problems when the
+ 'stat' structure is included, since it throws off the field offsets
+ from what the 'fstat' function thinks they should be.
+
+ Anyway, the quick fix is to run configure and then edit the Makefile
+ to remove the uid_t and gid_t defines. This will allow tcl and Tk to
+ compile and run. There are some other problems on NEXTSTEP,
+ specifically with %g in the printf family of functions, but making the
+ uid_t and gid_t change will get it up and running.
+
+---------------------------------------------
+NeXT machines running NeXTStep 3.2:
+---------------------------------------------
+
+1. Run configure with predefined CPP:
+ CPP='cc -E' ./configure
+ (If your shell is [t]csh, do a "setenv CPP 'cc -E' ")
+
+2. Edit Makefile:
+ -add tmpnam.o to COMPAT_OBJS:
+ COMPAT_OBJS = getcwd.o waitpid.o strtod.o tmpnam.o
+ -add the following to AC_FLAGS:
+ -Dstrtod=tcl_strtod
+ -add '-m' to MATH_LIBS:
+ MATH_LIBS = -m -lm
+ -add '-O2 -arch m68k -arch i386' to CFLAGS:
+ CFLAGS = -O2 -arch m68k -arch i386
+
+-------------------------------------------------
+ISC 2.2 UNIX (using standard ATT SYSV compiler):
+-------------------------------------------------
+
+In Makefile, change
+
+CFLAGS = -g -I. -DTCL_LIBRARY=\"${TCL_LIBRARY}\"
+
+to
+
+CFLAGS = -g -I. -DPOSIX_JC -DTCL_LIBRARY=\"${TCL_LIBRARY}\"
+
+This brings in the typedef for pid_t, which is needed for
+/usr/include/sys/wait.h in tclUnix.h.
+
+---------------------------------------------
+DEC Alphas:
+---------------------------------------------
+
+1. There appears to be a compiler/library bug that causes core-dumps
+unless you compile tclVar.c without optimization (remove the -O compiler
+switch). The problem appears to have been fixed in the 1.3-4 version
+of the compiler.
+
+---------------------------------------------
+CDC 4680MP, EP/IX 1.4.3:
+---------------------------------------------
+
+The installation was done in the System V environment (-systype sysv)
+with the BSD extensions available (-I/usr/include/bsd and -lbsd). It was
+built with the 2.20 level C compiler. The 2.11 level should not be used
+because it has a problem with detecting NaN values in lines like:
+ if (x != x) ...
+which appear in the TCL code.
+
+To make the configure script find the BSD extensions, I set environment
+variable DEFS to "-I/usr/include/bsd" and LIBS to "-lbsd" before
+running it. I would have also set CC to "cc2.20", but that compiler
+driver has a bug that loader errors (e.g. not finding a library routine,
+which the script uses to tell what is available) do not cause an error
+status to be returned to the shell (but see the comments about "-non_shared"
+below in the 2.1.1 notes).
+
+There is a bug in the <sys/wait.h> include file that mis-defines the
+structure fields and causes WIFEXITED and WIFSIGNALED to return incorrect
+values. My solution was to create a subdirectory "sys" of the main TCL
+source directory and put a corrected wait.h in it. The "-I." already on
+all the compile lines causes it to be used instead of the system version.
+To fix this, compare the structure definition in /usr/include/bsd/sys/wait.h
+with /bsd43/include/sys/wait.h (or mail to John Jackson, jrj@cc.purdue.edu,
+and he'll send you a context diff).
+
+After running configure, I made the following changes to Makefile:
+
+ 1) In AC_FLAGS, change:
+ -DNO_WAIT3=1
+ to
+ -DNO_WAIT3=0 -Dwait3=wait2
+ EP/IX (in the System V environment) provides a wait2() system
+ call with what TCL needs (the WNOHANG flag). The extra parameter
+ TCL passes to what it thinks is wait3() (the resources used by
+ the child process) is always zero and will be safely ignored.
+
+ 2) Change:
+ CC=cc
+ to
+ CC=cc2.20
+ because of the NaN problem mentioned earlier. Skip this if the
+ default compiler is already 2.20 (or later).
+
+ 3) Add "-lbsd" to the commands that create tclsh and tcltest
+ (look for "-o").
+
+---------------------------------------------
+CDC 4680MP, EP/IX 2.1.1:
+---------------------------------------------
+
+The installation was done in the System V environment (-systype sysv)
+with the BSD extensions available (-I/usr/include/bsd and -lbsd). It was
+built with the 3.11 level C compiler. The 2.11 level should not be used
+because it has a problem with detecting NaN values in lines like:
+ if (x != x) ...
+which appear in the TCL code. The 2.20 compiler does not have this
+problem.
+
+To make the configure script find the BSD extensions, I set environment
+variable DEFS to:
+
+ "-I/usr/include/bsd -D__STDC__=0 -non_shared"
+
+and LIBS to:
+
+ "-lbsd"
+
+before running it. The "-non_shared" is needed because with shared
+libraries, the compiler (actually, the loader) does not report an
+error for "missing" routines. The configuration script depends on this
+error to know what routines are available. This is the real problem
+I reported above for EP/IX 1.4.3 that I incorrectly attributed to a
+compiler driver bug. I don't have 1.4.3 available any more, but it's
+possible using "-non_shared" on it would have solved the problem.
+
+The same <sys/wait.h> bug exists at 2.1.1 (yes, I have reported it to
+CDC), and the same fix as described in the 1.4.3 porting notes works.
+
+In addition to the three Makefile changes described in the 1.4.3 notes,
+you can remove the "-non_shared" flag from AC_FLAGS. It is only needed
+for the configuration step, not the build.
+
+You will get duplicate definition compilation warnings of:
+
+ DBL_MIN
+ DBL_MAX
+ FLT_MIN
+ FLT_MAX
+
+during tclExpr.c. These can be ignored.
+
+During expr.test, you will get a failure for one of the "fmod" tests
+unless you have CDC patch CC40038311 installed.
+
+---------------------------------------------
+Convex systems, OS 10.1 and 10.2:
+Contact: Lennart Sorth (ls@dmi.min.dk)
+---------------------------------------------
+
+1. tcl7.0b2 compiles on Convex systems (OS 10.1 and 10.2) by just running
+ configure, typing make, except tclUnixUtil.c needs to be compiled
+ with option "-pcc" (portable cc, =!ANSI) due to:
+ cc: Error on line 1111 of tclUnixUtil.c: 'waitpid' redeclared:
+ incompatible types.
+
+-------------------------------------------------
+Pyramid, OSx 5.1a (UCB universe, GCC installed):
+-------------------------------------------------
+
+1. The procedures memcpy, strchr, fmod, and strrchr are all missing,
+so you'll need to provide substitutes for them. After you do that
+everything should compile fine. There will be one error in a scan
+test, but it's an obscure one because of a non-ANSI implementation
+of sscanf on the machine; you can ignore it.
+
+2. You may also have to add "tmpnam.o" to COMPAT_OBJS in Makefile:
+the system version appears to be bad.
+
+-------------------------------------------------
+Encore 91, UMAX V 3.0.9.3:
+-------------------------------------------------
+
+1. Modify the CFLAGS assignment in file Makefile.in to include the
+-DENCORE flag in Makefile:
+
+ CFLAGS = -O -DENCORE
+
+2. "mkdir" does not by default create the parent directories. The mkdir
+directives should be modified to "midir -p".
+
+-------------------------------------------------
+Sequent machines running Dynix:
+Contact: Andrew Swan (aswan@soda.berkeley.edu)
+-------------------------------------------------
+
+1. Use gcc instead of the cc distributed by Sequent
+
+2. The distributed math library does not include the fmod
+ function. Source for fmod can be retrieved from a BSD
+ source archive (such as ftp.uu.net) and included in the
+ compat directory. Add fmod.o to the COMPAT_OBJS variable
+ in the Makefile. You may need to comment out references
+ to 'isnan' and 'finite' in fmod.c
+
+3. If the linker complains that there are two copies of the
+ 'tanh' function, use the ar command to extract the objects
+ from the math library and build a new one without tanh.o
+
+4. The *scanf functions in the Sequent libraries are apparently
+ broken, which will cause the scanning tests to fail. The
+ cases that fail are fairly obscure. Using GNU libc apparently
+ solves this problem.
+
+-------------------------------------------------
+Systems running Interactive 4.0:
+-------------------------------------------------
+
+1. Add "-posix -D_SYSV3" to CFLAGS in Makefile (or Makefile.in).
+
+-------------------------------------------------
+Systems running FreeBSD 1.1.5.1:
+-------------------------------------------------
+
+The following changes comprise the entire porting effort of tcl7.3 to
+FreeBSD (i.e. these were the changes to tclTest.c) and should probably
+be made part of the tcl distribution. The changes only effect the way that
+floating point exceptions are reported. I've choosen to move the changes
+out of tclTest.c and into tclBasic.c.
+
+in tclBasic.c at top-of-file:
+
+#ifdef BSD_NET2
+#include <floatingpoint.h>
+#endif
+
+in tclBasic.c in Tcl_Init():
+
+#ifdef BSD_NET2
+ fpsetround(FP_RN);
+ fpsetmask(0L);
+#endif
+
diff --git a/tcl/unix/tcl.m4 b/tcl/unix/tcl.m4
new file mode 100644
index 00000000000..6ebd6a4b805
--- /dev/null
+++ b/tcl/unix/tcl.m4
@@ -0,0 +1,1882 @@
+#------------------------------------------------------------------------
+# SC_PATH_TCLCONFIG --
+#
+# Locate the tclConfig.sh file and perform a sanity check on
+# the Tcl compile flags
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tcl=...
+#
+# Defines the following vars:
+# TCL_BIN_DIR Full path to the directory containing
+# the tclConfig.sh file
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_TCLCONFIG, [
+ #
+ # Ok, lets find the tcl configuration
+ # First, look for one uninstalled.
+ # the alternative search directory is invoked by --with-tcl
+ #
+
+ if test x"${no_tcl}" = x ; then
+ # we reset no_tcl in case something fails here
+ no_tcl=true
+ AC_ARG_WITH(tcl, [ --with-tcl directory containing tcl configuration (tclConfig.sh)], with_tclconfig=${withval})
+ AC_MSG_CHECKING([for Tcl configuration])
+ AC_CACHE_VAL(ac_cv_c_tclconfig,[
+
+ # First check to see if --with-tclconfig was specified.
+ if test x"${with_tclconfig}" != x ; then
+ if test -f "${with_tclconfig}/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
+ else
+ AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh])
+ fi
+ fi
+
+ # then check for a private Tcl installation
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ../tcl \
+ `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \
+ ../../tcl \
+ `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \
+ ../../../tcl \
+ `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ if test -f "$i/win/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+
+ # check in a few common install locations
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in `ls -d ${prefix}/lib 2>/dev/null` \
+ `ls -d /usr/local/lib 2>/dev/null` ; do
+ if test -f "$i/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i; pwd)`
+ break
+ fi
+ done
+ fi
+
+ # check in a few other private locations
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ${srcdir}/../tcl \
+ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ if test -f "$i/win/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+ ])
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCL_BIN_DIR="# no Tcl configs found"
+ AC_MSG_ERROR(Can't find Tcl configuration definitions)
+ exit 0
+ else
+ no_tcl=
+ TCL_BIN_DIR=${ac_cv_c_tclconfig}
+ AC_MSG_RESULT(found $TCL_BIN_DIR/tclConfig.sh)
+ fi
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_PATH_TKCONFIG --
+#
+# Locate the tkConfig.sh file
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tk=...
+#
+# Defines the following vars:
+# TK_BIN_DIR Full path to the directory containing
+# the tkConfig.sh file
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_TKCONFIG, [
+ #
+ # Ok, lets find the tk configuration
+ # First, look for one uninstalled.
+ # the alternative search directory is invoked by --with-tk
+ #
+
+ if test x"${no_tk}" = x ; then
+ # we reset no_tk in case something fails here
+ no_tk=true
+ AC_ARG_WITH(tk, [ --with-tk directory containing tk configuration (tkConfig.sh)], with_tkconfig=${withval})
+ AC_MSG_CHECKING([for Tk configuration])
+ AC_CACHE_VAL(ac_cv_c_tkconfig,[
+
+ # First check to see if --with-tkconfig was specified.
+ if test x"${with_tkconfig}" != x ; then
+ if test -f "${with_tkconfig}/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)`
+ else
+ AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh])
+ fi
+ fi
+
+ # then check for a private Tk library
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in \
+ ../tk \
+ `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \
+ ../../tk \
+ `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \
+ ../../../tk \
+ `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ if test -f "$i/win/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+ # check in a few common install locations
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in `ls -d ${prefix}/lib 2>/dev/null` \
+ `ls -d /usr/local/lib 2>/dev/null` ; do
+ if test -f "$i/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i; pwd)`
+ break
+ fi
+ done
+ fi
+ # check in a few other private locations
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in \
+ ${srcdir}/../tk \
+ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ if test -f "$i/win/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+ ])
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ TK_BIN_DIR="# no Tk configs found"
+ AC_MSG_ERROR(Can't find Tk configuration definitions)
+ exit 0
+ else
+ no_tk=
+ TK_BIN_DIR=${ac_cv_c_tkconfig}
+ AC_MSG_RESULT(found $TK_BIN_DIR/tkConfig.sh)
+ fi
+ fi
+
+])
+
+#------------------------------------------------------------------------
+# SC_LOAD_TCLCONFIG --
+#
+# Load the tclConfig.sh file
+#
+# Arguments:
+#
+# Requires the following vars to be set:
+# TCL_BIN_DIR
+#
+# Results:
+#
+# Subst the following vars:
+# TCL_BIN_DIR
+# TCL_SRC_DIR
+# TCL_LIB_FILE
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_LOAD_TCLCONFIG, [
+ AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh])
+
+ if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then
+ AC_MSG_RESULT([loading])
+ . $TCL_BIN_DIR/tclConfig.sh
+ else
+ AC_MSG_RESULT([file not found])
+ fi
+
+ #
+ # The eval is required to do the TCL_DBGX substitution in the
+ # TCL_LIB_FILE variable
+ #
+
+ eval TCL_LIB_FILE=${TCL_LIB_FILE}
+ eval TCL_LIB_FLAG=${TCL_LIB_FLAG}
+
+ AC_SUBST(TCL_BIN_DIR)
+ AC_SUBST(TCL_SRC_DIR)
+ AC_SUBST(TCL_LIB_FILE)
+])
+
+#------------------------------------------------------------------------
+# SC_LOAD_TKCONFIG --
+#
+# Load the tkConfig.sh file
+#
+# Arguments:
+#
+# Requires the following vars to be set:
+# TK_BIN_DIR
+#
+# Results:
+#
+# Sets the following vars that should be in tkConfig.sh:
+# TK_BIN_DIR
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_LOAD_TKCONFIG, [
+ AC_MSG_CHECKING([for existence of $TCLCONFIG])
+
+ if test -f "$TK_BIN_DIR/tkConfig.sh" ; then
+ AC_MSG_CHECKING([loading $TK_BIN_DIR/tkConfig.sh])
+ . $TK_BIN_DIR/tkConfig.sh
+ else
+ AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh])
+ fi
+
+ AC_SUBST(TK_BIN_DIR)
+ AC_SUBST(TK_SRC_DIR)
+ AC_SUBST(TK_LIB_FILE)
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_SHARED --
+#
+# Allows the building of shared libraries
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-shared=yes|no
+#
+# Defines the following vars:
+# STATIC_BUILD Used for building import/export libraries
+# on Windows.
+#
+# Sets the following vars:
+# SHARED_BUILD Value of 1 or 0
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_SHARED, [
+ AC_MSG_CHECKING([how to build libraries])
+ AC_ARG_ENABLE(shared,
+ [ --enable-shared build and link with shared libraries [--enable-shared]],
+ [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=no
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ AC_MSG_RESULT([shared])
+ SHARED_BUILD=1
+ else
+ AC_MSG_RESULT([static])
+ SHARED_BUILD=0
+ AC_DEFINE(STATIC_BUILD)
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_THREADS --
+#
+# Specify if thread support should be enabled
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-threads
+#
+# Sets the following vars:
+# THREADS_LIBS Thread library(s)
+#
+# Defines the following vars:
+# TCL_THREADS
+# _REENTRANT
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_THREADS, [
+ AC_MSG_CHECKING(for building with threads)
+ AC_ARG_ENABLE(threads, [ --enable-threads build with threads],
+ [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "$tcl_ok" = "yes"; then
+ AC_MSG_RESULT(yes)
+ TCL_THREADS=1
+ AC_DEFINE(TCL_THREADS)
+ AC_DEFINE(_REENTRANT)
+ AC_DEFINE(_THREAD_SAFE)
+ AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ if test "$tcl_ok" = "no"; then
+ # Check a little harder for __pthread_mutex_init in the same
+ # library, as some systems hide it there until pthread.h is
+ # defined. We could alternatively do an AC_TRY_COMPILE with
+ # pthread.h, but that will work with libpthread really doesn't
+ # exist, like AIX 4.2. [Bug: 4359]
+ AC_CHECK_LIB(pthread,__pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthread"
+ else
+ AC_CHECK_LIB(pthreads,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthreads"
+ else
+ AC_CHECK_LIB(c,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ if test "$tcl_ok" = "no"; then
+ TCL_THREADS=0
+ AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...")
+ fi
+ fi
+ fi
+
+ # Does the pthread-implementation provide
+ # 'pthread_attr_setstacksize' ?
+
+ AC_CHECK_FUNCS(pthread_attr_setstacksize)
+ else
+ TCL_THREADS=0
+ AC_MSG_RESULT(no (default))
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_SYMBOLS --
+#
+# Specify if debugging symbols should be used
+#
+# Arguments:
+# none
+#
+# Requires the following vars to be set in the Makefile:
+# CFLAGS_DEBUG
+# CFLAGS_OPTIMIZE
+# LDFLAGS_DEBUG
+# LDFLAGS_OPTIMIZE
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-symbols
+#
+# Defines the following vars:
+# CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true
+# Sets to $(CFLAGS_OPTIMIZE) if false
+# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true
+# Sets to $(LDFLAGS_OPTIMIZE) if false
+# DBGX Debug library extension
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_SYMBOLS, [
+ AC_MSG_CHECKING([for build with symbols])
+ AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no])
+ if test "$tcl_ok" = "yes"; then
+ CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
+ DBGX=g
+ AC_MSG_RESULT([yes])
+ else
+ CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ DBGX=""
+ AC_MSG_RESULT([no])
+ fi
+])
+
+#--------------------------------------------------------------------
+# SC_CONFIG_CFLAGS
+#
+# Try to determine the proper flags to pass to the compiler
+# for building shared libraries and other such nonsense.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines the following vars:
+#
+# DL_OBJS - Name of the object file that implements dynamic
+# loading for Tcl on this system.
+# DL_LIBS - Library file(s) to include in tclsh and other base
+# applications in order for the "load" command to work.
+# LDFLAGS - Flags to pass to the compiler when linking object
+# files into an executable application binary such
+# as tclsh.
+# LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib",
+# that tell the run-time dynamic linker where to look
+# for shared libraries such as libtcl.so. Depends on
+# the variable LIB_RUNTIME_DIR in the Makefile.
+# MAKE_LIB - Command to execute to build the Tcl library;
+# differs depending on whether or not Tcl is being
+# compiled as a shared library.
+# STLIB_LD - Base command to use for combining object files
+# into a static library.
+# SHLIB_CFLAGS - Flags to pass to cc when compiling the components
+# of a shared library (may request position-independent
+# code, among other things).
+# SHLIB_LD - Base command to use for combining object files
+# into a shared library.
+# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
+# creating shared libraries. This symbol typically
+# goes at the end of the "ld" commands that build
+# shared libraries. The value of the symbol is
+# "${LIBS}" if all of the dependent libraries should
+# be specified when creating a shared library. If
+# dependent libraries should not be specified (as on
+# SunOS 4.x, where they cause the link to fail, or in
+# general if Tcl and Tk aren't themselves shared
+# libraries), then this symbol has an empty string
+# as its value.
+# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable
+# extensions. An empty string means we don't know how
+# to use shared libraries on this platform.
+# TCL_LIB_FILE - Name of the file that contains the Tcl library, such
+# as libtcl7.8.so or libtcl7.8.a.
+# TCL_LIB_SUFFIX -Specifies everything that comes after the "libtcl"
+# in the shared library name, using the $VERSION variable
+# to put the version in the right place. This is used
+# by platforms that need non-standard library names.
+# Examples: ${VERSION}.so.1.1 on NetBSD, since it needs
+# to have a version after the .so, and ${VERSION}.a
+# on AIX, since the Tcl shared library needs to have
+# a .a extension whereas shared objects for loadable
+# extensions have a .so extension. Defaults to
+# ${VERSION}${SHLIB_SUFFIX}.
+# TCL_NEEDS_EXP_FILE -
+# 1 means that an export file is needed to link to a
+# shared library.
+# TCL_EXP_FILE - The name of the installed export / import file which
+# should be used to link to the Tcl shared library.
+# Empty if Tcl is unshared.
+# TCL_BUILD_EXP_FILE -
+# The name of the built export / import file which
+# should be used to link to the Tcl shared library.
+# Empty if Tcl is unshared.
+# CFLAGS_DEBUG -
+# Flags used when running the compiler in debug mode
+# CFLAGS_OPTIMIZE -
+# Flags used when running the compiler in optimize mode
+#
+# EXTRA_CFLAGS
+#
+# Subst's the following vars:
+# DL_LIBS
+# CFLAGS_DEBUG
+# CFLAGS_OPTIMIZE
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_CONFIG_CFLAGS, [
+
+ # Step 0.a: Enable 64 bit support?
+
+ AC_MSG_CHECKING([if 64bit support is requested])
+ AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)],,enableval="no")
+
+ if test "$enableval" = "yes"; then
+ do64bit=yes
+ else
+ do64bit=no
+ fi
+ AC_MSG_RESULT($do64bit)
+
+ # Step 0.b: Enable Solaris 64 bit VIS support?
+
+ AC_MSG_CHECKING([if 64bit Sparc VIS support is requested])
+ AC_ARG_ENABLE(64bit-vis,[ --enable-64bit-vis enable 64bit Sparc VIS support],,enableval="no")
+
+ if test "$enableval" = "yes"; then
+ # Force 64bit on with VIS
+ do64bit=yes
+ do64bitVIS=yes
+ else
+ do64bitVIS=no
+ fi
+ AC_MSG_RESULT($do64bitVIS)
+
+ # Step 1: set the variable "system" to hold the name and version number
+ # for the system. This can usually be done via the "uname" command, but
+ # there are a few systems, like Next, where this doesn't work.
+
+ AC_MSG_CHECKING([system version (for dynamic loading)])
+ if test -f /usr/lib/NextStep/software_version; then
+ system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+ else
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ AC_MSG_RESULT([unknown (can't find uname command)])
+ system=unknown
+ else
+ # Special check for weird MP-RAS system (uname returns weird
+ # results, and the version is kept in special file).
+
+ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+ system=MP-RAS-`awk '{print $3}' /etc/.relid'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
+ AC_MSG_RESULT($system)
+ fi
+ fi
+
+ AC_MSG_CHECKING([if gcc is being used])
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ using_gcc="yes"
+ else
+ using_gcc="no"
+ fi
+
+ AC_MSG_RESULT([$using_gcc ($CC)])
+
+ # Step 2: check for existence of -ldl library. This is needed because
+ # Linux can use either -ldl or -ldld for dynamic loading.
+
+ AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
+
+ # Step 3: set configuration options based on system name and version.
+
+ do64bit_ok=no
+ fullSrcDir=`cd $srcdir; pwd`
+ EXTRA_CFLAGS=""
+ TCL_EXPORT_FILE_SUFFIX=""
+ UNSHARED_LIB_SUFFIX=""
+ TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
+ ECHO_VERSION='`echo ${VERSION}`'
+ TCL_LIB_VERSIONS_OK=ok
+ CFLAGS_DEBUG=-g
+ CFLAGS_OPTIMIZE=-O
+ if test "$using_gcc" = "yes" ; then
+ CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
+ else
+ CFLAGS_WARNING=""
+ fi
+ TCL_NEEDS_EXP_FILE=0
+ TCL_BUILD_EXP_FILE=""
+ TCL_EXP_FILE=""
+dnl FIXME: Replace AC_CHECK_PROG with AC_CHECK_TOOL once cross compiling is fixed.
+dnl AC_CHECK_TOOL(AR, ar, :)
+ AC_CHECK_PROG(AR, ar, ar)
+ STLIB_LD='${AR} cr'
+ case $system in
+ AIX-4.[[2-9]])
+ if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ # AIX requires the _r compiler when gcc isn't being used
+ if test "${CC}" != "cc_r" ; then
+ CC=${CC}_r
+ fi
+ AC_MSG_RESULT(Using $CC for compiling with threads)
+ fi
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+ ;;
+ AIX-*)
+ if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ # AIX requires the _r compiler when gcc isn't being used
+ if test "${CC}" != "cc_r" ; then
+ CC=${CC}_r
+ fi
+ AC_MSG_RESULT(Using $CC for compiling with threads)
+ fi
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ LIBOBJS="$LIBOBJS tclLoadAix.o"
+ DL_LIBS="-lld"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+ ;;
+ BSD/OS-2.1*|BSD/OS-3*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="shlicc -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ BSD/OS-4.*)
+ SHLIB_CFLAGS="-export-dynamic -fPIC"
+ SHLIB_LD="cc -shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-export-dynamic"
+ LD_SEARCH_FLAGS=""
+ ;;
+ dgux*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
+ SHLIB_SUFFIX=".sl"
+ AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no)
+ if test "$tcl_ok" = yes; then
+ SHLIB_CFLAGS="+z"
+ SHLIB_LD="ld -b"
+ SHLIB_LD_LIBS=""
+ DL_OBJS="tclLoadShl.o"
+ DL_LIBS="-ldld"
+ LDFLAGS="-Wl,-E"
+ LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ fi
+ ;;
+ IRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
+ ;;
+ IRIX-5.*|IRIX-6.*|IRIX64-6.5*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -n32 -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "yes" ; then
+ EXTRA_CFLAGS="-mabi=n32"
+ LDFLAGS="-mabi=n32"
+ else
+ case $system in
+ IRIX-6.3)
+ # Use to build 6.2 compatible binaries on 6.3.
+ EXTRA_CFLAGS="-n32 -D_OLD_TERMIOS"
+ ;;
+ *)
+ EXTRA_CFLAGS="-n32"
+ ;;
+ esac
+ LDFLAGS="-n32"
+ fi
+ ;;
+ IRIX64-6.*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -32 -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ ;;
+ Linux*)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+
+ # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
+ # when you inline the string and math operations. Turn this off to
+ # get rid of the warnings.
+
+ CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
+
+ if test "$have_dl" = yes; then
+ SHLIB_LD="${CC} -shared"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-rdynamic"
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ else
+ AC_CHECK_HEADER(dld.h, [
+ SHLIB_LD="ld -shared"
+ DL_OBJS="tclLoadDld.o"
+ DL_LIBS="-ldld"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""])
+ fi
+ if test "`uname -m`" = "alpha" ; then
+ EXTRA_CFLAGS="-mieee"
+ fi
+ ;;
+ MP-RAS-02*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ MP-RAS-*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ NetBSD-*|FreeBSD-[[1-2]].*|OpenBSD-*)
+ # Not available on all versions: check for include file.
+ AC_CHECK_HEADER(dlfcn.h, [
+ # NetBSD/SPARC needs -fPIC, -fpic will not do.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ AC_MSG_CHECKING(for ELF)
+ AC_EGREP_CPP(yes, [
+#ifdef __ELF__
+ yes
+#endif
+ ],
+ AC_MSG_RESULT(yes)
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so',
+ AC_MSG_RESULT(no)
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0'
+ )
+ ], [
+ SHLIB_CFLAGS=""
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ ])
+
+ # FreeBSD doesn't handle version numbers with dots.
+
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ FreeBSD-*)
+ # FreeBSD 3.* and greater have ELF.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS="-export-dynamic"
+ LD_SEARCH_FLAGS=""
+ ;;
+ NEXTSTEP-*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="cc -nostdlib -r"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadNext.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OS/390-*)
+ CFLAGS_OPTIMIZE="" # Optimizer is buggy
+ AC_DEFINE(_OE_SOCKETS) # needed in sys/socket.h
+ ;;
+ OSF1-1.0|OSF1-1.1|OSF1-1.2)
+ # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
+ SHLIB_CFLAGS=""
+ # Hack: make package name same as library name
+ SHLIB_LD='ld -R -export $@:'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadOSF.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-1.*)
+ # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -shared"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-V*)
+ # Digital OSF/1
+ SHLIB_CFLAGS=""
+ SHLIB_LD='ld -shared -expect_unresolved "*"'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="-DHAVE_TZSET -std1"
+ fi
+ # see pthread_intro(3) for pthread support on osf1, k.furukawa
+ if test "${TCL_THREADS}" = "1" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -pthread"
+ LDFLAGS="-pthread"
+ else
+ LIBS=`echo $LIBS | sed s/-lpthreads//`
+ LIBS="$LIBS -lpthread -lmach -lexc"
+ fi
+ fi
+
+ ;;
+ RISCos-*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ ;;
+ SCO_SV-3.2*)
+ # Note, dlopen is available only on SCO 3.2.5 and greater. However,
+ # this test works, since "uname -s" was non-standard in 3.2.4 and
+ # below.
+ if test "$using_gcc" = "yes" ; then
+ SHLIB_CFLAGS="-fPIC -melf"
+ LDFLAGS="-melf -Wl,-Bexport"
+ else
+ SHLIB_CFLAGS="-Kpic -belf"
+ LDFLAGS="-belf -Wl,-Bexport"
+ fi
+ SHLIB_LD="ld -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS="-belf -Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ SINIX*5.4*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ SunOS-4*)
+ SHLIB_CFLAGS="-PIC"
+ SHLIB_LD="ld"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+
+ # SunOS can't handle version numbers with dots in them in library
+ # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
+ # requires an extra version number at the end of .so file names.
+ # So, the library has to have a name like libtcl75.so.1.0
+
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0'
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ SunOS-5.[[0-6]]*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ ;;
+ SunOS-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+ LDFLAGS=""
+
+ do64bit_ok=no
+ if test "$do64bit" = "yes" ; then
+ arch=`isainfo`
+ if test "$arch" = "sparcv9 sparc" ; then
+ if test "$using_gcc" = "no" ; then
+ do64bit_ok=yes
+ if test "$do64bitVIS" = "yes" ; then
+ EXTRA_CFLAGS="-xarch=v9a"
+ LDFLAGS="-xarch=v9a"
+ else
+ EXTRA_CFLAGS="-xarch=v9"
+ LDFLAGS="-xarch=v9"
+ fi
+ else
+ AC_MSG_WARN("64bit mode not supported with GCC on $system")
+ fi
+ else
+ AC_MSG_WARN("64bit mode only supported sparcv9 system")
+ fi
+ fi
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ if test "$using_gcc" = "yes" ; then
+ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ else
+ LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ fi
+ ;;
+ ULTRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="-DHAVE_TZSET -std1"
+ fi
+ ;;
+ UNIX_SV* | UnixWare-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
+ # that don't grok the -Bexport option. Test that it does.
+ hold_ldflags=$LDFLAGS
+ AC_MSG_CHECKING(for ld accepts -Bexport flag)
+ LDFLAGS="${LDFLAGS} -Wl,-Bexport"
+ AC_TRY_LINK(, [int i;], found=yes, found=no)
+ LDFLAGS=$hold_ldflags
+ AC_MSG_RESULT($found)
+ if test $found = yes; then
+ LDFLAGS="-Wl,-Bexport"
+ else
+ LDFLAGS=""
+ fi
+ LD_SEARCH_FLAGS=""
+ ;;
+ esac
+
+ if test "$do64bit" = "yes" -a "$do64bit_ok" = "no" ; then
+ AC_MSG_WARN("64bit support being disabled -- don\'t know magic for this platform")
+ fi
+
+ # Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic
+ # Loading for Tcl -- What Became of It?". Proc. 2nd Tcl/Tk Workshop,
+ # New Orleans, LA, Computerized Processes Unlimited, 1994), then we need
+ # to determine which of several header files defines the a.out file
+ # format (a.out.h, sys/exec.h, or sys/exec_aout.h). At present, we
+ # support only a file format that is more or less version-7-compatible.
+ # In particular,
+ # - a.out files must begin with `struct exec'.
+ # - the N_TXTOFF on the `struct exec' must compute the seek address
+ # of the text segment
+ # - The `struct exec' must contain a_magic, a_text, a_data, a_bss
+ # and a_entry fields.
+ # The following compilation should succeed if and only if either sys/exec.h
+ # or a.out.h is usable for the purpose.
+ #
+ # Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
+ # `struct exec' includes a second header that contains information that
+ # duplicates the v7 fields that are needed.
+
+ if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
+ AC_MSG_CHECKING(sys/exec.h)
+ AC_TRY_COMPILE([#include <sys/exec.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_magic == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ ], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_SYS_EXEC_H)
+ else
+ AC_MSG_CHECKING(a.out.h)
+ AC_TRY_COMPILE([#include <a.out.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_magic == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ ], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_A_OUT_H)
+ else
+ AC_MSG_CHECKING(sys/exec_aout.h)
+ AC_TRY_COMPILE([#include <sys/exec_aout.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_midmag == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ ], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_SYS_EXEC_AOUT_H)
+ else
+ DL_OBJS=""
+ fi
+ fi
+ fi
+ fi
+
+ # Step 5: disable dynamic loading if requested via a command-line switch.
+
+ AC_ARG_ENABLE(load, [ --disable-load disallow dynamic loading and "load" command],
+ [tcl_ok=$enableval], [tcl_ok=yes])
+ if test "$tcl_ok" = "no"; then
+ DL_OBJS=""
+ fi
+
+ if test "x$DL_OBJS" != "x" ; then
+ BUILD_DLTEST="\$(DLTEST_TARGETS)"
+ else
+ echo "Can't figure out how to do dynamic loading or shared libraries"
+ echo "on this system."
+ SHLIB_CFLAGS=""
+ SHLIB_LD=""
+ SHLIB_SUFFIX=""
+ DL_OBJS="tclLoadNone.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ BUILD_DLTEST=""
+ fi
+
+ # If we're running gcc, then change the C flags for compiling shared
+ # libraries to the right flags for gcc, instead of those for the
+ # standard manufacturer compiler.
+
+ if test "$DL_OBJS" != "tclLoadNone.o" ; then
+ if test "$using_gcc" = "yes" ; then
+ case $system in
+ AIX-*)
+ ;;
+ BSD/OS*)
+ ;;
+ IRIX*)
+ ;;
+ NetBSD-*|FreeBSD-*|OpenBSD-*)
+ ;;
+ RISCos-*)
+ ;;
+ SCO_SV-3.2*)
+ ;;
+ ULTRIX-4.*)
+ ;;
+ *)
+ SHLIB_CFLAGS="-fPIC"
+ ;;
+ esac
+ fi
+ fi
+
+ if test "$SHARED_LIB_SUFFIX" = "" ; then
+ SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}${SHLIB_SUFFIX}'
+ fi
+ if test "$UNSHARED_LIB_SUFFIX" = "" ; then
+ UNSHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
+ fi
+
+# CYGNUS LOCAL
+ TCL_LIB_SUFFIX=.a
+ AC_SUBST(TCL_LIB_SUFFIX)
+# END CYGNUS LOCAL
+
+ AC_SUBST(DL_LIBS)
+ AC_SUBST(CFLAGS_DEBUG)
+ AC_SUBST(CFLAGS_OPTIMIZE)
+ AC_SUBST(CFLAGS_WARNING)
+])
+
+#--------------------------------------------------------------------
+# SC_SERIAL_PORT
+#
+# Determine which interface to use to talk to the serial port.
+# Note that #include lines must begin in leftmost column for
+# some compilers to recognize them as preprocessor directives.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines only one of the following vars:
+# USE_TERMIOS
+# USE_TERMIO
+# USE_SGTTY
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_SERIAL_PORT, [
+ AC_MSG_CHECKING([termios vs. termio vs. sgtty])
+
+ AC_TRY_RUN([
+#include <termios.h>
+
+main()
+{
+ struct termios t;
+ if (tcgetattr(0, &t) == 0) {
+ cfsetospeed(&t, 0);
+ t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+}], tk_ok=termios, tk_ok=no, tk_ok=no)
+
+ if test $tk_ok = termios; then
+ AC_DEFINE(USE_TERMIOS)
+ else
+ AC_TRY_RUN([
+#include <termio.h>
+
+main()
+{
+ struct termio t;
+ if (ioctl(0, TCGETA, &t) == 0) {
+ t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+ }], tk_ok=termio, tk_ok=no, tk_ok=no)
+
+ if test $tk_ok = termio; then
+ AC_DEFINE(USE_TERMIO)
+ else
+ AC_TRY_RUN([
+#include <sgtty.h>
+
+main()
+{
+ struct sgttyb t;
+ if (ioctl(0, TIOCGETP, &t) == 0) {
+ t.sg_ospeed = 0;
+ t.sg_flags |= ODDP | EVENP | RAW;
+ return 0;
+ }
+ return 1;
+}], tk_ok=sgtty, tk_ok=none, tk_ok=none)
+ if test $tk_ok = sgtty; then
+ AC_DEFINE(USE_SGTTY)
+ fi
+ fi
+ fi
+ AC_MSG_RESULT($tk_ok)
+])
+
+#--------------------------------------------------------------------
+# SC_MISSING_POSIX_HEADERS
+#
+# Supply substitutes for missing POSIX header files. Special
+# notes:
+# - stdlib.h doesn't define strtol, strtoul, or
+# strtod insome versions of SunOS
+# - some versions of string.h don't declare procedures such
+# as strstr
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# NO_DIRENT_H
+# NO_ERRNO_H
+# NO_VALUES_H
+# NO_LIMITS_H
+# NO_STDLIB_H
+# NO_STRING_H
+# NO_SYS_WAIT_H
+# NO_DLFCN_H
+# HAVE_UNISTD_H
+# HAVE_SYS_PARAM_H
+#
+# HAVE_STRING_H ?
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_MISSING_POSIX_HEADERS, [
+
+ AC_MSG_CHECKING(dirent.h)
+ AC_TRY_LINK([#include <sys/types.h>
+#include <dirent.h>], [
+#ifndef _POSIX_SOURCE
+# ifdef __Lynx__
+ /*
+ * Generate compilation error to make the test fail: Lynx headers
+ * are only valid if really in the POSIX environment.
+ */
+
+ missing_procedure();
+# endif
+#endif
+DIR *d;
+struct dirent *entryPtr;
+char *p;
+d = opendir("foobar");
+entryPtr = readdir(d);
+p = entryPtr->d_name;
+closedir(d);
+], tcl_ok=yes, tcl_ok=no)
+
+ if test $tcl_ok = no; then
+ AC_DEFINE(NO_DIRENT_H)
+ fi
+
+ AC_MSG_RESULT($tcl_ok)
+ AC_CHECK_HEADER(errno.h, , AC_DEFINE(NO_ERRNO_H))
+ AC_CHECK_HEADER(float.h, , AC_DEFINE(NO_FLOAT_H))
+ AC_CHECK_HEADER(values.h, , AC_DEFINE(NO_VALUES_H))
+ AC_CHECK_HEADER(limits.h, , AC_DEFINE(NO_LIMITS_H))
+ AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
+ AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
+ AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
+ AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0)
+ if test $tcl_ok = 0; then
+ AC_DEFINE(NO_STDLIB_H)
+ fi
+ AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
+ AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
+ AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)
+
+ # See also memmove check below for a place where NO_STRING_H can be
+ # set and why.
+
+ if test $tcl_ok = 0; then
+ AC_DEFINE(NO_STRING_H)
+ fi
+
+ AC_CHECK_HEADER(sys/wait.h, , AC_DEFINE(NO_SYS_WAIT_H))
+ AC_CHECK_HEADER(dlfcn.h, , AC_DEFINE(NO_DLFCN_H))
+
+ # OS/390 lacks sys/param.h (and doesn't need it, by chance).
+
+ AC_HAVE_HEADERS(unistd.h sys/param.h)
+
+])
+
+#--------------------------------------------------------------------
+# SC_PATH_X
+#
+# Locate the X11 header files and the X11 library archive. Try
+# the ac_path_x macro first, but if it doesn't find the X stuff
+# (e.g. because there's no xmkmf program) then check through
+# a list of possible directories. Under some conditions the
+# autoconf macro will return an include directory that contains
+# no include files, so double-check its result just to be safe.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Sets the the following vars:
+# XINCLUDES
+# XLIBSW
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_X, [
+ AC_PATH_X
+ not_really_there=""
+ if test "$no_x" = ""; then
+ if test "$x_includes" = ""; then
+ AC_TRY_CPP([#include <X11/XIntrinsic.h>], , not_really_there="yes")
+ else
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
+ fi
+ fi
+ fi
+ if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
+ AC_MSG_CHECKING(for X11 header files)
+ XINCLUDES="# no special path needed"
+ AC_TRY_CPP([#include <X11/Intrinsic.h>], , XINCLUDES="nope")
+ if test "$XINCLUDES" = nope; then
+ dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
+ for i in $dirs ; do
+ if test -r $i/X11/Intrinsic.h; then
+ AC_MSG_RESULT($i)
+ XINCLUDES=" -I$i"
+ break
+ fi
+ done
+ fi
+ else
+ if test "$x_includes" != ""; then
+ XINCLUDES=-I$x_includes
+ else
+ XINCLUDES="# no special path needed"
+ fi
+ fi
+ if test "$XINCLUDES" = nope; then
+ AC_MSG_RESULT(couldn't find any!)
+ XINCLUDES="# no include files found"
+ fi
+
+ if test "$no_x" = yes; then
+ AC_MSG_CHECKING(for X11 libraries)
+ XLIBSW=nope
+ dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
+ for i in $dirs ; do
+ if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl; then
+ AC_MSG_RESULT($i)
+ XLIBSW="-L$i -lX11"
+ x_libraries="$i"
+ break
+ fi
+ done
+ else
+ if test "$x_libraries" = ""; then
+ XLIBSW=-lX11
+ else
+ XLIBSW="-L$x_libraries -lX11"
+ fi
+ fi
+ if test "$XLIBSW" = nope ; then
+ AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow)
+ fi
+ if test "$XLIBSW" = nope ; then
+ AC_MSG_RESULT(couldn't find any! Using -lX11.)
+ XLIBSW=-lX11
+ fi
+])
+#--------------------------------------------------------------------
+# SC_BLOCKING_STYLE
+#
+# The statements below check for systems where POSIX-style
+# non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented.
+# On these systems (mostly older ones), use the old BSD-style
+# FIONBIO approach instead.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# HAVE_SYS_IOCTL_H
+# HAVE_SYS_FILIO_H
+# USE_FIONBIO
+# O_NONBLOCK
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_BLOCKING_STYLE, [
+ AC_CHECK_HEADERS(sys/ioctl.h)
+ AC_CHECK_HEADERS(sys/filio.h)
+ AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O])
+ if test -f /usr/lib/NextStep/software_version; then
+ system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+ else
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ system=unknown
+ else
+ # Special check for weird MP-RAS system (uname returns weird
+ # results, and the version is kept in special file).
+
+ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+ system=MP-RAS-`awk '{print $3}' /etc/.relid'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
+ fi
+ fi
+ case $system in
+ # There used to be code here to use FIONBIO under AIX. However, it
+ # was reported that FIONBIO doesn't work under AIX 3.2.5. Since
+ # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO
+ # code (JO, 5/31/97).
+
+ OSF*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ SunOS-4*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ ULTRIX-4.*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ *)
+ AC_MSG_RESULT(O_NONBLOCK)
+ ;;
+ esac
+])
+
+#--------------------------------------------------------------------
+# SC_HAVE_VFORK
+#
+# Check to see whether the system provides a vfork kernel call.
+# If not, then use fork instead. Also, check for a problem with
+# vforks and signals that can cause core dumps if a vforked child
+# resets a signal handler. If the problem exists, then use fork
+# instead of vfork.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# vfork (=fork)
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_HAVE_VFORK, [
+ AC_TYPE_SIGNAL()
+ AC_CHECK_FUNC(vfork, tcl_ok=1, tcl_ok=0)
+ if test "$tcl_ok" = 1; then
+ AC_MSG_CHECKING([vfork/signal bug]);
+ AC_TRY_RUN([
+#include <stdio.h>
+#include <signal.h>
+#include <sys/wait.h>
+int gotSignal = 0;
+sigProc(sig)
+ int sig;
+{
+ gotSignal = 1;
+}
+main()
+{
+ int pid, sts;
+ (void) signal(SIGCHLD, sigProc);
+ pid = vfork();
+ if (pid < 0) {
+ exit(1);
+ } else if (pid == 0) {
+ (void) signal(SIGCHLD, SIG_DFL);
+ _exit(0);
+ } else {
+ (void) wait(&sts);
+ }
+ exit((gotSignal) ? 0 : 1);
+}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
+
+ if test "$tcl_ok" = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT([buggy, using fork instead])
+ fi
+ fi
+ rm -f core
+ if test "$tcl_ok" = 0; then
+ AC_DEFINE(vfork, fork)
+ fi
+])
+
+#--------------------------------------------------------------------
+# SC_TIME_HANLDER
+#
+# Checks how the system deals with time.h, what time structures
+# are used on the system, and what fields the structures have.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# USE_DELTA_FOR_TZ
+# HAVE_TM_GMTOFF
+# HAVE_TM_TZADJ
+# HAVE_TIMEZONE_VAR
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_TIME_HANDLER, [
+ AC_CHECK_HEADERS(sys/time.h)
+ AC_HEADER_TIME
+ AC_STRUCT_TIMEZONE
+
+ AC_MSG_CHECKING([tm_tzadj in struct tm])
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
+ [AC_DEFINE(HAVE_TM_TZADJ)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ AC_MSG_CHECKING([tm_gmtoff in struct tm])
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
+ [AC_DEFINE(HAVE_TM_GMTOFF)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ #
+ # Its important to include time.h in this check, as some systems
+ # (like convex) have timezone functions, etc.
+ #
+ have_timezone=no
+ AC_MSG_CHECKING([long timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern long timezone;
+ timezone += 1;
+ exit (0);],
+ [have_timezone=yes
+ AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ #
+ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ #
+ if test "$have_timezone" = no; then
+ AC_MSG_CHECKING([time_t timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern time_t timezone;
+ timezone += 1;
+ exit (0);],
+ [AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+ fi
+
+ #
+ # On some systems (eg Solaris 2.5.1), timezone is not declared in
+ # time.h unless you jump through hoops. Instead of that, we just
+ # declare it ourselves when necessary.
+ #
+ if test "$have_timezone" = yes; then
+ AC_MSG_CHECKING(for timezone declaration)
+ changequote(<<,>>)
+ tzrx='^[ ]*extern.*timezone'
+ changequote([,])
+ AC_EGREP_HEADER($tzrx, time.h, [
+ AC_DEFINE(HAVE_TIMEZONE_DECL)
+ AC_MSG_RESULT(found)], AC_MSG_RESULT(missing))
+ fi
+
+ #
+ # AIX does not have a timezone field in struct tm. When the AIX bsd
+ # library is used, the timezone global and the gettimeofday methods are
+ # to be avoided for timezone deduction instead, we deduce the timezone
+ # by comparing the localtime result on a known GMT value.
+ #
+
+ if test "`uname -s`" = "AIX" ; then
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ if test $libbsd = yes; then
+ AC_DEFINE(USE_DELTA_FOR_TZ)
+ fi
+ fi
+])
+
+#--------------------------------------------------------------------
+# SC_BUGGY_STRTOD
+#
+# Under Solaris 2.4, strtod returns the wrong value for the
+# terminating character under some conditions. Check for this
+# and if the problem exists use a substitute procedure
+# "fixstrtod" (provided by Tcl) that corrects the error.
+# Also, on Compaq's Tru64 Unix 5.0,
+# strtod(" ") returns 0.0 instead of a failure to convert.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Might defines some of the following vars:
+# strtod (=fixstrtod)
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_BUGGY_STRTOD, [
+ AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
+ if test "$tcl_strtod" = 1; then
+ AC_MSG_CHECKING([for Solaris2.4/Tru64 strtod bugs])
+ AC_TRY_RUN([
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN", *spaceString = " ";
+ char *term;
+ double value;
+ value = strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(spaceString, &term);
+ if (term == (spaceString+1)) {
+ exit(1);
+ }
+ exit(0);
+ }], tcl_ok=1, tcl_ok=0, tcl_ok=0)
+ if test "$tcl_ok" = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT(buggy)
+ LIBOBJS="$LIBOBJS fixstrtod.o"
+ AC_DEFINE(strtod, fixstrtod)
+ fi
+ fi
+])
+
+#--------------------------------------------------------------------
+# SC_TCL_LINK_LIBS
+#
+# Search for the libraries needed to link the Tcl shell.
+# Things like the math library (-lm) and socket stuff (-lsocket vs.
+# -lnsl) are dealt with here.
+#
+# Arguments:
+# Requires the following vars to be set in the Makefile:
+# DL_LIBS
+# LIBS
+# MATH_LIBS
+#
+# Results:
+#
+# Subst's the following var:
+# TCL_LIBS
+# MATH_LIBS
+#
+# Might append to the following vars:
+# LIBS
+#
+# Might define the following vars:
+# HAVE_NET_ERRNO_H
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_TCL_LINK_LIBS, [
+ #--------------------------------------------------------------------
+ # On a few very rare systems, all of the libm.a stuff is
+ # already in libc.a. Set compiler flags accordingly.
+ # Also, Linux requires the "ieee" library for math to work
+ # right (and it must appear before "-lm").
+ #--------------------------------------------------------------------
+
+ AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
+ AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
+
+ #--------------------------------------------------------------------
+ # On AIX systems, libbsd.a has to be linked in to support
+ # non-blocking file IO. This library has to be linked in after
+ # the MATH_LIBS or it breaks the pow() function. The way to
+ # insure proper sequencing, is to add it to the tail of MATH_LIBS.
+ # This library also supplies gettimeofday.
+ #--------------------------------------------------------------------
+
+ libbsd=no
+ if test "`uname -s`" = "AIX" ; then
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ if test $libbsd = yes; then
+ MATH_LIBS="$MATH_LIBS -lbsd"
+ fi
+ fi
+
+
+ #--------------------------------------------------------------------
+ # Interactive UNIX requires -linet instead of -lsocket, plus it
+ # needs net/errno.h to define the socket-related error codes.
+ #--------------------------------------------------------------------
+
+ AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
+ AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H))
+
+ #--------------------------------------------------------------------
+ # Check for the existence of the -lsocket and -lnsl libraries.
+ # The order here is important, so that they end up in the right
+ # order in the command line generated by make. Here are some
+ # special considerations:
+ # 1. Use "connect" and "accept" to check for -lsocket, and
+ # "gethostbyname" to check for -lnsl.
+ # 2. Use each function name only once: can't redo a check because
+ # autoconf caches the results of the last check and won't redo it.
+ # 3. Use -lnsl and -lsocket only if they supply procedures that
+ # aren't already present in the normal libraries. This is because
+ # IRIX 5.2 has libraries, but they aren't needed and they're
+ # bogus: they goof up name resolution if used.
+ # 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+ # To get around this problem, check for both libraries together
+ # if -lsocket doesn't work by itself.
+ #--------------------------------------------------------------------
+
+ # CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
+ # mess up the cache values of the functions we check for.
+ AC_CACHE_CHECK([for socket libraries], tcl_cv_lib_sockets,
+ [tcl_cv_lib_sockets=
+ tcl_checkBoth=0
+ unset ac_cv_func_connect
+ AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+ if test "$tcl_checkSocket" = 1; then
+ unset ac_cv_func_connect
+ AC_CHECK_LIB(socket, main, tcl_cv_lib_sockets="-lsocket",
+ tcl_checkBoth=1)
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tcl_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ unset ac_cv_func_accept
+ AC_CHECK_FUNC(accept,
+ [tcl_checkNsl=0
+ tcl_cv_lib_sockets="-lsocket -lnsl"])
+ unset ac_cv_func_accept
+ LIBS=$tcl_oldLibs
+ fi
+ unset ac_cv_func_gethostbyname
+ tcl_oldLibs=$LIBS
+ LIBS="$LIBS $tcl_cv_lib_sockets"
+ AC_CHECK_FUNC(gethostbyname, ,
+ [AC_CHECK_LIB(nsl, main,
+ [tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"])])
+ unset ac_cv_func_gethostbyname
+ LIBS=$tcl_oldLIBS
+ ])
+ test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+
+ # Don't perform the eval of the libraries here because DL_LIBS
+ # won't be set until we call SC_CONFIG_CFLAGS
+
+ TCL_LIBS='${DL_LIBS} ${LIBS} ${MATH_LIBS}'
+ AC_SUBST(TCL_LIBS)
+ AC_SUBST(MATH_LIBS)
+])
+
+dnl CYGNUS LOCAL: This gets the right posix flag for gcc
+
+AC_DEFUN(CY_AC_TCL_LYNX_POSIX,
+[AC_REQUIRE([AC_PROG_CC])AC_REQUIRE([AC_PROG_CPP])
+AC_MSG_CHECKING([to see if this is LynxOS])
+AC_CACHE_VAL(ac_cv_os_lynx,
+[AC_EGREP_CPP(yes,
+[/*
+ * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
+ */
+#if defined(__Lynx__) || defined(Lynx)
+yes
+#endif
+], ac_cv_os_lynx=yes, ac_cv_os_lynx=no)])
+#
+if test "$ac_cv_os_lynx" = "yes" ; then
+ AC_MSG_RESULT(yes)
+ AC_DEFINE(LYNX)
+ AC_MSG_CHECKING([whether -mposix or -X is available])
+ AC_CACHE_VAL(ac_cv_c_posix_flag,
+ [AC_TRY_COMPILE(,[
+ /*
+ * This flag varies depending on how old the compiler is.
+ * -X is for the old "cc" and "gcc" (based on 1.42).
+ * -mposix is for the new gcc (at least 2.5.8).
+ */
+ #if defined(__GNUC__) && __GNUC__ >= 2
+ choke me
+ #endif
+ ], ac_cv_c_posix_flag=" -mposix", ac_cv_c_posix_flag=" -X")])
+ CC="$CC $ac_cv_c_posix_flag"
+ AC_MSG_RESULT($ac_cv_c_posix_flag)
+ else
+ AC_MSG_RESULT(no)
+fi
+])
diff --git a/tcl/unix/tcl.spec b/tcl/unix/tcl.spec
new file mode 100644
index 00000000000..d2ce7dff7b7
--- /dev/null
+++ b/tcl/unix/tcl.spec
@@ -0,0 +1,53 @@
+# $Id$
+# This file is the basis for a binary Tcl RPM for Linux.
+
+%define version 8.3.2
+%define directory /usr/local
+
+Summary: Tcl scripting language development environment
+Name: tcl
+Version: %{version}
+Release: 1
+Copyright: BSD
+Group: Development/Languages
+Source: ftp://ftp.scriptics.com/pub/tcl/tcl8_3/tcl%{version}.tar.gz
+URL: http://dev.scriptics.com/
+Packager: Scriptics Corporation
+Buildroot: /var/tmp/%{name}%{version}
+
+%description
+The Tcl (Tool Command Language) provides a powerful platform for
+creating integration applications that tie together diverse
+applications, protocols, devices, and frameworks. When paired with
+the Tk toolkit, Tcl provides the fastest and most powerful way to
+create GUI applications that run on PCs, Unix, and the Macintosh. Tcl
+can also be used for a variety of web-related tasks and for creating
+powerful command languages for applications.
+
+%prep
+
+%build
+./configure --prefix %{directory} --exec-prefix %{directory}
+make CFLAGS=$RPM_OPT_FLAGS
+
+%install
+rm -rf $RPM_BUILD_ROOT
+make INSTALL_ROOT=$RPM_BUILD_ROOT install
+
+%clean
+rm -rf $RPM_BUILD_ROOT
+
+# to create the tcl files list, comment out tk in the install section above,
+# then run "rpm -bi" then do a find from the build root directory,
+# and remove the files in specific directories which suffice by themselves,
+# then to create the files list for tk, uncomment tk, comment out tcl,
+# then rm -rf $RPM_BUILD_ROOT then rpm --short-circuit -bi then redo a find,
+# and remove the files in specific directories which suffice by themselves.
+%files
+%defattr(-,root,root)
+%{directory}/lib
+%{directory}/bin
+%{directory}/include
+%{directory}/man/man1
+%{directory}/man/man3
+%{directory}/man/mann
diff --git a/tcl/unix/tclAppInit.c b/tcl/unix/tclAppInit.c
index 99abc5eb4f2..dac0d66aa2e 100644
--- a/tcl/unix/tclAppInit.c
+++ b/tcl/unix/tclAppInit.c
@@ -6,6 +6,7 @@
*
* Copyright (c) 1993 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -13,10 +14,6 @@
* RCS: @(#) $Id$
*/
-#ifdef TCL_XT_TEST
-#include <X11/Intrinsic.h>
-#endif
-
#include "tcl.h"
/*
@@ -29,13 +26,22 @@ int *tclDummyMathPtr = (int *) matherr;
#ifdef TCL_TEST
-EXTERN int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+
+#include "tclInt.h"
+
+extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#ifdef TCL_THREADS
+extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif
+
#endif /* TCL_TEST */
+
#ifdef TCL_XT_TEST
-EXTERN int Tclxttest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern void XtToolkitInitialize _ANSI_ARGS_((void));
+extern int Tclxttest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif
/*
@@ -60,10 +66,38 @@ main(argc, argv)
int argc; /* Number of command-line arguments. */
char **argv; /* Values of command-line arguments. */
{
+ /*
+ * The following #if block allows you to change the AppInit
+ * function by using a #define of TCL_LOCAL_APPINIT instead
+ * of rewriting this entire file. The #if checks for that
+ * #define and uses Tcl_AppInit if it doesn't exist.
+ */
+
+#ifndef TCL_LOCAL_APPINIT
+#define TCL_LOCAL_APPINIT Tcl_AppInit
+#endif
+ extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+
+ /*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tcl_Main()
+ */
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+ extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+#endif
+
#ifdef TCL_XT_TEST
XtToolkitInitialize();
#endif
- Tcl_Main(argc, argv, Tcl_AppInit);
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+ TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
+ Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
+
return 0; /* Needed only to prevent compiler warning. */
}
@@ -78,7 +112,7 @@ main(argc, argv)
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -108,6 +142,11 @@ Tcl_AppInit(interp)
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
+#ifdef TCL_THREADS
+ if (TclThread_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#endif
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -141,3 +180,5 @@ Tcl_AppInit(interp)
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
+
+
diff --git a/tcl/unix/tclConfig.sh.in b/tcl/unix/tclConfig.sh.in
index c005c2e9995..05e0949dc37 100644
--- a/tcl/unix/tclConfig.sh.in
+++ b/tcl/unix/tclConfig.sh.in
@@ -23,6 +23,10 @@ TCL_CC='@CC@'
# -D flags for use with the C compiler.
TCL_DEFS='@DEFS@'
+# Extensions written in gcc need -fwritable-strings. Use TCL_CFLAGS for
+# any other flags required for extensions.
+TCL_CFLAGS='@CFLAGS@'
+
# If TCL was built with debugging symbols, generated libraries contain
# this string at the end of the library name (before the extension).
TCL_DBGX=@TCL_DBGX@
@@ -31,6 +35,10 @@ TCL_DBGX=@TCL_DBGX@
TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@'
+# Default linker flags used in an optimized and debuggable build, respectively.
+TCL_LDFLAGS_DEBUG='@LDFLAGS_DEBUG@'
+TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'
+
# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
@@ -40,6 +48,15 @@ TCL_LIB_FILE='@TCL_LIB_FILE@'
# The fullpath of the Tcl library (used for dependency checking)
TCL_LIB_FULL_PATH='@TCL_LIB_FULL_PATH@'
+# Flag to indicate whether shared libraries need export files.
+TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@
+
+# String that can be evaluated to generate the part of the export file
+# name that comes after the "libxxx" (includes version number, if any,
+# extension, and anything else needed). May depend on the variables
+# VERSION. On most UNIX systems this is ${VERSION}.exp.
+TCL_EXPORT_FILE_SUFFIX='@CFG_TCL_EXPORT_FILE_SUFFIX@'
+
# Additional libraries to use when linking Tcl.
TCL_LIBS='@DL_LIBS@ @LIBS@ @MATH_LIBS@'
@@ -54,12 +71,18 @@ TCL_EXEC_PREFIX='@exec_prefix@'
# Flags to pass to cc when compiling the components of a shared library:
TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@'
+# Flags to pass to cc to get warning messages
+TCL_CFLAGS_WARNING='@CFLAGS_WARNING@'
+
# Extra flags to pass to cc:
TCL_EXTRA_CFLAGS='@EXTRA_CFLAGS@'
# Base command to use for combining object files into a shared library:
TCL_SHLIB_LD='@SHLIB_LD@'
+# Base command to use for combining object files into a shared library:
+TCL_STLIB_LD='@STLIB_LD@'
+
# Either '$LIBS' (if dependent libraries should be included when linking
# shared libraries) or an empty string. See Tcl's configure.in for more
# explanation.
@@ -68,13 +91,17 @@ TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'
# Suffix to use for the name of a shared library.
TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'
+# Suffix to use in the name of an unshared library.
+# FIXME: Comments in tcl.m4 about this var are incorrect!
+TCL_LIB_SUFFIX='@TCL_LIB_SUFFIX@'
+
# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
TCL_DL_LIBS='@DL_LIBS@'
# Flags to pass to the compiler when linking object files into
# an executable tclsh or tcltest binary.
-TCL_LD_FLAGS='@LD_FLAGS@'
+TCL_LD_FLAGS='@LDFLAGS@'
# Flags to pass to ld, such as "-R /usr/local/tcl/lib", that tell the
# run-time dynamic linker where to look for shared libraries such as
@@ -111,13 +138,13 @@ TCL_LIB_VERSIONS_OK='@TCL_LIB_VERSIONS_OK@'
# extension, and anything else needed). May depend on the variables
# VERSION and SHLIB_SUFFIX. On most UNIX systems this is
# ${VERSION}${SHLIB_SUFFIX}.
-TCL_SHARED_LIB_SUFFIX='@TCL_SHARED_LIB_SUFFIX@'
+TCL_SHARED_LIB_SUFFIX='@CFG_TCL_SHARED_LIB_SUFFIX@'
# String that can be evaluated to generate the part of an unshared library
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed). May depend on the variable
# VERSION. On most UNIX systems this is ${VERSION}.a.
-TCL_UNSHARED_LIB_SUFFIX='@TCL_UNSHARED_LIB_SUFFIX@'
+TCL_UNSHARED_LIB_SUFFIX='@CFG_TCL_UNSHARED_LIB_SUFFIX@'
# Location of the top-level source directory from which Tcl was built.
# This is the directory that contains a README file as well as
@@ -131,3 +158,29 @@ TCL_SRC_DIR='@TCL_SRC_DIR@'
# "package require" commands. Contains the "prefix" directory plus also
# the "exec_prefix" directory, if it is different.
TCL_PACKAGE_PATH='@TCL_PACKAGE_PATH@'
+
+# Tcl supports stub.
+TCL_SUPPORTS_STUBS=1
+
+# The name of the Tcl stub library (.a):
+TCL_STUB_LIB_FILE='@TCL_STUB_LIB_FILE@'
+
+# -l flag to pass to the linker to pick up the Tcl stub library
+TCL_STUB_LIB_FLAG='@TCL_STUB_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tcl stub library from its
+# build directory.
+TCL_BUILD_STUB_LIB_SPEC='@TCL_BUILD_STUB_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tcl stub library from its
+# installed directory.
+TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'
+
+# Path to the Tcl stub library in the build directory.
+TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'
+
+# Path to the Tcl stub library in the install directory.
+TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'
+
+# Vendor prefix to be added to lib names
+TCL_VENDOR_PREFIX=@VENDORPREFIX@
diff --git a/tcl/unix/tclLoadAix.c b/tcl/unix/tclLoadAix.c
index 5d55f5a474e..c46424132a4 100644
--- a/tcl/unix/tclLoadAix.c
+++ b/tcl/unix/tclLoadAix.c
@@ -213,7 +213,7 @@ static void caterr(char *s)
while (*p >= '0' && *p <= '9')
p++;
- switch(atoi(s)) {
+ switch(atoi(s)) { /* INTL: "C", UTF safe. */
case L_ERROR_TOOMANY:
strcat(errbuf, "to many errors");
break;
@@ -234,7 +234,7 @@ static void caterr(char *s)
strcat(errbuf, p);
break;
case L_ERROR_ERRNO:
- strcat(errbuf, strerror(atoi(++p)));
+ strcat(errbuf, strerror(atoi(++p))); /* INTL: "C", UTF safe. */
break;
default:
strcat(errbuf, s);
@@ -547,3 +547,4 @@ static void * findMain(void)
return ret;
}
+
diff --git a/tcl/unix/tclLoadAout.c b/tcl/unix/tclLoadAout.c
index b10b3394f13..5e5f1f75dfb 100644
--- a/tcl/unix/tclLoadAout.c
+++ b/tcl/unix/tclLoadAout.c
@@ -97,7 +97,7 @@ static void UnlinkSymbolTable _ANSI_ARGS_((void));
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpLoadFile --
*
* Dynamically loads a binary code file into memory and returns
* the addresses of two procedures within that file, if they
@@ -105,7 +105,7 @@ static void UnlinkSymbolTable _ANSI_ARGS_((void));
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * message is left in the interp's result. *proc1Ptr and *proc2Ptr
* are filled in with the addresses of the symbols given by
* *sym1 and *sym2, or NULL if those symbols can't be found.
*
@@ -136,15 +136,18 @@ static void UnlinkSymbolTable _ANSI_ARGS_((void));
*/
int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
- * code. */
+ * code (UTF-8). */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
char * inputSymbolTable; /* Name of the file containing the
* symbol table from the last link. */
@@ -163,6 +166,8 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
int status; /* Status return from Tcl_ calls */
char * p;
+ *clientDataPtr = NULL;
+
/* Find the file that contains the symbols for the run-time link. */
if (SymbolTableFile != NULL) {
@@ -257,10 +262,10 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
#if defined(__mips) || defined(mips)
status = lseek (relocatedFd,
- N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
- SEEK_SET);
+ (off_t) N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
+ SEEK_SET);
#else
- status = lseek (relocatedFd, N_TXTOFF (relocatedHead), SEEK_SET);
+ status = lseek (relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET);
#endif
if (status < 0) {
goto ioError;
@@ -313,8 +318,8 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
*
* Results:
* A standard Tcl completion code. If an error occurs,
- * an error message is left in interp->result. The -l and -L flags
- * are concatenated onto the dynamic string `buf'.
+ * an error message is left in the interp's result. The -l and -L
+ * flags are concatenated onto the dynamic string `buf'.
*
*------------------------------------------------------------------------
*/
@@ -328,10 +333,16 @@ FindLibraries (interp, fileName, buf)
FILE * f; /* The load module */
int c; /* Byte from the load module */
char * p;
+ Tcl_DString ds;
+ CONST char *native;
/* Open the load module */
- if ((f = fopen (fileName, "rb")) == NULL) {
+ native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ f = fopen(native, "rb"); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ if (f == NULL) {
Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ",
Tcl_PosixError (interp), (char *) NULL);
return TCL_ERROR;
@@ -407,6 +418,33 @@ UnlinkSymbolTable ()
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Does nothing. Can anything be done?
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
@@ -432,6 +470,7 @@ TclGuessPackageName(fileName, bufPtr)
* package name to this if possible. */
{
char *p, *q, *r;
+ int srcOff, dstOff;
if (q = strrchr(fileName,'/')) {
q++;
@@ -457,14 +496,14 @@ TclGuessPackageName(fileName, bufPtr)
r = Tcl_DStringValue(bufPtr);
r += strlen(r) - (p-q);
- if (islower(UCHAR(*r))) {
- *r = (char) toupper(UCHAR(*r));
- }
- while (*(++r)) {
- if (isupper(UCHAR(*r))) {
- *r = (char) tolower(UCHAR(*r));
- }
- }
+ /*
+ * Capitalize the string and then recompute the length.
+ */
+
+ Tcl_UtfToTitle(r);
+ Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
return 1;
}
+
+
diff --git a/tcl/unix/tclLoadDl.c b/tcl/unix/tclLoadDl.c
index af6cc57f4f0..a03e8c3ef5c 100644
--- a/tcl/unix/tclLoadDl.c
+++ b/tcl/unix/tclLoadDl.c
@@ -5,7 +5,7 @@
* works with the "dlopen" and "dlsym" library procedures for
* dynamic loading.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -36,9 +36,9 @@
#endif
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpLoadFile --
*
* Dynamically loads a binary code file into memory and returns
* the addresses of two procedures within that file, if they
@@ -46,18 +46,18 @@
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * message is left in the interp's result. *proc1Ptr and *proc2Ptr
* are filled in with the addresses of the symbols given by
* *sym1 and *sym2, or NULL if those symbols can't be found.
*
* Side effects:
* New code suddenly appears in memory.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
* code. */
@@ -66,11 +66,20 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
VOID *handle;
- Tcl_DString newName;
+ Tcl_DString newName, ds;
+ char *native;
- handle = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);
+ native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ *clientDataPtr = (ClientData) handle;
+
if (handle == NULL) {
Tcl_AppendResult(interp, "couldn't load file \"", fileName,
"\": ", dlerror(), (char *) NULL);
@@ -83,30 +92,69 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
* with the underscore.
*/
- *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym1);
+ native = Tcl_UtfToExternalDString(NULL, sym1, -1, &ds);
+ *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
+ native);
if (*proc1Ptr == NULL) {
Tcl_DStringInit(&newName);
Tcl_DStringAppend(&newName, "_", 1);
- Tcl_DStringAppend(&newName, sym1, -1);
- *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle,
- Tcl_DStringValue(&newName));
+ native = Tcl_DStringAppend(&newName, native, -1);
+ *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
+ native);
Tcl_DStringFree(&newName);
}
- *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym2);
+ Tcl_DStringFree(&ds);
+
+ native = Tcl_UtfToExternalDString(NULL, sym2, -1, &ds);
+ *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
+ native);
if (*proc2Ptr == NULL) {
Tcl_DStringInit(&newName);
Tcl_DStringAppend(&newName, "_", 1);
- Tcl_DStringAppend(&newName, sym2, -1);
- *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle,
- Tcl_DStringValue(&newName));
+ native = Tcl_DStringAppend(&newName, native, -1);
+ *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
+ native);
Tcl_DStringFree(&newName);
}
+ Tcl_DStringFree(&ds);
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Code removed from memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+ VOID *handle;
+
+ handle = (VOID *) clientData;
+ dlclose(handle);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
@@ -133,3 +181,4 @@ TclGuessPackageName(fileName, bufPtr)
{
return 0;
}
+
diff --git a/tcl/unix/tclLoadDl2.c b/tcl/unix/tclLoadDl2.c
new file mode 100644
index 00000000000..ad18537f144
--- /dev/null
+++ b/tcl/unix/tclLoadDl2.c
@@ -0,0 +1,113 @@
+/*
+ * tclLoadDl2.c --
+ *
+ * This procedure provides a version of the TclLoadFile that
+ * works with the "dlopen" and "dlsym" library procedures for
+ * dynamic loading. It is identical to tclLoadDl.c except that
+ * it adds a "_" character to symbol names before looking them
+ * up.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclLoadDl2.c 1.3 96/02/15 11:58:45
+ */
+
+#include "tcl.h"
+#include "dlfcn.h"
+
+/*
+ * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
+ * and this argument to dlopen must always be 1.
+ */
+
+#ifndef RTLD_NOW
+# define RTLD_NOW 1
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLoadFile --
+ *
+ * Dynamically loads a binary code file into memory and returns
+ * the addresses of two procedures within that file, if they
+ * are defined.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error
+ * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * are filled in with the addresses of the symbols given by
+ * *sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+{
+ VOID *handle;
+ Tcl_DString newName;
+
+ handle = dlopen(fileName, RTLD_NOW);
+ if (handle == NULL) {
+ Tcl_AppendResult(interp, "couldn't load file \"", fileName,
+ "\": ", dlerror(), (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&newName);
+ Tcl_DStringAppend(&newName, "_", 1);
+ Tcl_DStringAppend(&newName, sym1, -1);
+ *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle,
+ Tcl_DStringValue(&newName));
+ Tcl_DStringSetLength(&newName, 0);
+ Tcl_DStringAppend(&newName, "_", 1);
+ Tcl_DStringAppend(&newName, sym2, -1);
+ *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle,
+ Tcl_DStringValue(&newName));
+ Tcl_DStringFree(&newName);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ * If the "load" command is invoked without providing a package
+ * name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ * Always returns 0 to indicate that we couldn't figure out a
+ * package name; generic code will then try to guess the package
+ * from the file name. A return value of 1 would have meant that
+ * we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+ char *fileName; /* Name of file containing package (already
+ * translated to local form if needed). */
+ Tcl_DString *bufPtr; /* Initialized empty dstring. Append
+ * package name to this if possible. */
+{
+ return 0;
+}
diff --git a/tcl/unix/tclLoadDld.c b/tcl/unix/tclLoadDld.c
index 584e07ed11d..ebb5d6bced2 100644
--- a/tcl/unix/tclLoadDld.c
+++ b/tcl/unix/tclLoadDld.c
@@ -7,7 +7,7 @@
* dld-3.2.7. This file probably isn't needed anymore, since it
* makes more sense to use "dl_open" etc.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -30,7 +30,7 @@
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpLoadFile --
*
* Dynamically loads a binary code file into memory and returns
* the addresses of two procedures within that file, if they
@@ -38,7 +38,7 @@
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * message is left in the interp's result. *proc1Ptr and *proc2Ptr
* are filled in with the addresses of the symbols given by
* *sym1 and *sym2, or NULL if those symbols can't be found.
*
@@ -49,7 +49,7 @@
*/
int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
* code. */
@@ -58,6 +58,9 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
static int firstTime = 1;
int returnCode;
@@ -91,12 +94,46 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
}
*proc1Ptr = (Tcl_PackageInitProc *) dld_get_func(sym1);
*proc2Ptr = (Tcl_PackageInitProc *) dld_get_func(sym2);
+ *clientDataPtr = strcpy(
+ (char *) ckalloc((unsigned) (strlen(fileName) + 1)), fileName);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Code removed from memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+ char *fileName;
+
+ handle = (char *) clientData;
+ dld_unlink_by_file(handle, 0);
+ ckfree(handle);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
@@ -123,3 +160,4 @@ TclGuessPackageName(fileName, bufPtr)
{
return 0;
}
+
diff --git a/tcl/unix/tclLoadDyld.c b/tcl/unix/tclLoadDyld.c
new file mode 100644
index 00000000000..6b029f91294
--- /dev/null
+++ b/tcl/unix/tclLoadDyld.c
@@ -0,0 +1,171 @@
+/*
+ * tclLoadDyld.c --
+ *
+ * This procedure provides a version of the TclLoadFile that
+ * works with NeXT/Apple's dyld dynamic loading. This file
+ * provided by Wilfredo Sanchez (wsanchez@apple.com).
+ * The works on Mac OS X and Mac OS X Server.
+ * It should work with OpenStep, but it's not been tried.
+ *
+ * Copyright (c) 1995 Apple Computer, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include <mach-o/dyld.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpLoadFile --
+ *
+ * Dynamically loads a binary code file into memory and returns
+ * the addresses of two procedures within that file, if they
+ * are defined.
+ *
+ * Results:
+ * A standard Tcl completion code. If an error occurs, an error
+ * message is left in the interpreter's result. *proc1Ptr and *proc2Ptr
+ * are filled in with the addresses of the symbols given by
+ * *sym1 and *sym2, or NULL if those symbols can't be found.
+ *
+ * Side effects:
+ * New code suddenly appears in memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *fileName; /* Name of the file containing the desired
+ * code. */
+ char *sym1, *sym2; /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
+{
+ NSObjectFileImageReturnCode err;
+ NSObjectFileImage image;
+ NSModule module;
+ NSSymbol symbol;
+ char *name;
+
+ err = NSCreateObjectFileImageFromFile(fileName, &image);
+ if (err != NSObjectFileImageSuccess) {
+ switch (err) {
+ case NSObjectFileImageFailure:
+ Tcl_SetResult(interp, "dyld: general failure", TCL_STATIC);
+ break;
+ case NSObjectFileImageInappropriateFile:
+ Tcl_SetResult(interp, "dyld: inappropriate Mach-O file",
+ TCL_STATIC);
+ break;
+ case NSObjectFileImageArch:
+ Tcl_SetResult(interp,
+ "dyld: inappropriate Mach-O architecture", TCL_STATIC);
+ break;
+ case NSObjectFileImageFormat:
+ Tcl_SetResult(interp, "dyld: invalid Mach-O file format",
+ TCL_STATIC);
+ break;
+ case NSObjectFileImageAccess:
+ Tcl_SetResult(interp, "dyld: permission denied", TCL_STATIC);
+ break;
+ default:
+ Tcl_SetResult(interp, "dyld: unknown failure", TCL_STATIC);
+ break;
+ }
+ return TCL_ERROR;
+ }
+
+ module = NSLinkModule(image, fileName, TRUE);
+
+ if (module == NULL) {
+ Tcl_SetResult(interp, "dyld: falied to link module", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ name = (char*)malloc(sizeof(char)*(strlen(sym1)+2));
+ sprintf(name, "_%s", sym1);
+ symbol = NSLookupAndBindSymbol(name);
+ free(name);
+ *proc1Ptr = NSAddressOfSymbol(symbol);
+
+ name = (char*)malloc(sizeof(char)*(strlen(sym2)+2));
+ sprintf(name, "_%s", sym2);
+ symbol = NSLookupAndBindSymbol(name);
+ free(name);
+ *proc2Ptr = NSAddressOfSymbol(symbol);
+
+ *clientDataPtr = module;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Code dissapears from memory.
+ * Note that this is a no-op on older (OpenStep) versions of dyld.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+ NSUnLinkModule(clientData, FALSE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGuessPackageName --
+ *
+ * If the "load" command is invoked without providing a package
+ * name, this procedure is invoked to try to figure it out.
+ *
+ * Results:
+ * Always returns 0 to indicate that we couldn't figure out a
+ * package name; generic code will then try to guess the package
+ * from the file name. A return value of 1 would have meant that
+ * we figured out the package name and put it in bufPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGuessPackageName(fileName, bufPtr)
+ char *fileName; /* Name of file containing package (already
+ * translated to local form if needed). */
+ Tcl_DString *bufPtr; /* Initialized empty dstring. Append
+ * package name to this if possible. */
+{
+ return 0;
+}
diff --git a/tcl/unix/tclLoadNext.c b/tcl/unix/tclLoadNext.c
index fb7fa8b8601..41069413a56 100644
--- a/tcl/unix/tclLoadNext.c
+++ b/tcl/unix/tclLoadNext.c
@@ -5,7 +5,7 @@
* works with NeXTs rld_* dynamic loading. This file provided
* by Pedja Bogdanovich.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -20,7 +20,7 @@
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpLoadFile --
*
* Dynamically loads a binary code file into memory and returns
* the addresses of two procedures within that file, if they
@@ -28,7 +28,7 @@
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * message is left in the interp's result. *proc1Ptr and *proc2Ptr
* are filled in with the addresses of the symbols given by
* *sym1 and *sym2, or NULL if those symbols can't be found.
*
@@ -39,7 +39,7 @@
*/
int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
* code. */
@@ -48,6 +48,9 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
struct mach_header *header;
char *data;
@@ -76,6 +79,7 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
sym[0]='_'; sym[1]=0; strcat(sym,sym2);
rld_lookup(NULL,sym,(unsigned long *)proc2Ptr);
}
+ *clientDataPtr = NULL;
return TCL_OK;
}
@@ -83,6 +87,33 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Does nothing. Can anything be done?
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
@@ -109,3 +140,4 @@ TclGuessPackageName(fileName, bufPtr)
{
return 0;
}
+
diff --git a/tcl/unix/tclLoadOSF.c b/tcl/unix/tclLoadOSF.c
index 91be3f693bf..f4bc7551a80 100644
--- a/tcl/unix/tclLoadOSF.c
+++ b/tcl/unix/tclLoadOSF.c
@@ -26,7 +26,7 @@
*
* John Robert LoVerso <loverso@freebsd.osf.org>
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -41,7 +41,7 @@
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpLoadFile --
*
* Dynamically loads a binary code file into memory and returns
* the addresses of two procedures within that file, if they
@@ -49,7 +49,7 @@
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * message is left in the interp's result. *proc1Ptr and *proc2Ptr
* are filled in with the addresses of the symbols given by
* *sym1 and *sym2, or NULL if those symbols can't be found.
*
@@ -60,7 +60,7 @@
*/
int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
* code. */
@@ -69,6 +69,9 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
ldr_module_t lm;
char *pkg;
@@ -80,6 +83,8 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
return TCL_ERROR;
}
+ *clientDataPtr = NULL;
+
/*
* My convention is to use a [OSF loader] package name the same as shlib,
* since the idiots never implemented ldr_lookup() and it is otherwise
@@ -100,6 +105,33 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Does nothing. Can anything be done?
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
@@ -126,3 +158,4 @@ TclGuessPackageName(fileName, bufPtr)
{
return 0;
}
+
diff --git a/tcl/unix/tclLoadShl.c b/tcl/unix/tclLoadShl.c
index ba527df3ba4..620367bd21f 100644
--- a/tcl/unix/tclLoadShl.c
+++ b/tcl/unix/tclLoadShl.c
@@ -5,7 +5,7 @@
* with the "shl_load" and "shl_findsym" library procedures for
* dynamic loading (e.g. for HP machines).
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -28,7 +28,7 @@
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpLoadFile --
*
* Dynamically loads a binary code file into memory and returns
* the addresses of two procedures within that file, if they
@@ -36,7 +36,7 @@
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in interp->result. *proc1Ptr and *proc2Ptr
+ * message is left in the interp's result. *proc1Ptr and *proc2Ptr
* are filled in with the addresses of the symbols given by
* *sym1 and *sym2, or NULL if those symbols can't be found.
*
@@ -47,7 +47,7 @@
*/
int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
* code. */
@@ -56,16 +56,30 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
shl_t handle;
Tcl_DString newName;
- handle = shl_load(fileName, BIND_IMMEDIATE, 0L);
+ /*
+ * The flags below used to be BIND_IMMEDIATE; they were changed at
+ * the suggestion of Wolfgang Kechel (wolfgang@prs.de): "This
+ * enables verbosity for missing symbols when loading a shared lib
+ * and allows to load libtk8.0.sl into tclsh8.0 without problems.
+ * In general, this delays resolving symbols until they are actually
+ * needed. Shared libs do no longer need all libraries linked in
+ * when they are build."
+ */
+
+ handle = shl_load(fileName, BIND_DEFERRED|BIND_VERBOSE, 0L);
if (handle == NULL) {
Tcl_AppendResult(interp, "couldn't load file \"", fileName,
"\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
+ *clientDataPtr = (ClientData) handle;
/*
* Some versions of the HP system software still use "_" at the
@@ -101,6 +115,37 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Code removed from memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+ shl_t handle;
+
+ handle = (shl_t) clientData;
+ shl_unload(handle);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
@@ -127,3 +172,4 @@ TclGuessPackageName(fileName, bufPtr)
{
return 0;
}
+
diff --git a/tcl/unix/tclMtherr.c b/tcl/unix/tclMtherr.c
index 77c2d88685d..2932010f18b 100644
--- a/tcl/unix/tclMtherr.c
+++ b/tcl/unix/tclMtherr.c
@@ -29,15 +29,6 @@ extern int errno; /* Use errno from tclExecute.c. */
#endif
/*
- * The following variable is secretly shared with Tcl so we can
- * tell if expression evaluation is in progress. If not, matherr
- * just emulates the default behavior, which includes printing
- * a message.
- */
-
-extern int tcl_MathInProgress;
-
-/*
* The following definitions allow matherr to compile on systems
* that don't really support it. The compiled procedure is bogus,
* but it will never be executed on these systems anyway.
@@ -74,7 +65,7 @@ int
matherr(xPtr)
struct exception *xPtr; /* Describes error that occurred. */
{
- if (!tcl_MathInProgress) {
+ if (TclMathInProgress()) {
return 0;
}
if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
@@ -84,3 +75,4 @@ matherr(xPtr)
}
return 1;
}
+
diff --git a/tcl/unix/tclUnixChan.c b/tcl/unix/tclUnixChan.c
index 410c199f987..4558fa41d83 100644
--- a/tcl/unix/tclUnixChan.c
+++ b/tcl/unix/tclUnixChan.c
@@ -5,6 +5,7 @@
* pipes and TCP sockets.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -40,31 +41,32 @@
#undef FLUSHO
#undef PENDIN
+#define SUPPORTS_TTY
+
#ifdef USE_TERMIOS
# include <termios.h>
+# define IOSTATE struct termios
+# define GETIOSTATE(fd, statePtr) tcgetattr((fd), (statePtr))
+# define SETIOSTATE(fd, statePtr) tcsetattr((fd), TCSADRAIN, (statePtr))
#else /* !USE_TERMIOS */
#ifdef USE_TERMIO
# include <termio.h>
+# define IOSTATE struct termio
+# define GETIOSTATE(fd, statePtr) ioctl((fd), TCGETA, (statePtr))
+# define SETIOSTATE(fd, statePtr) ioctl((fd), TCSETAW, (statePtr))
#else /* !USE_TERMIO */
#ifdef USE_SGTTY
# include <sgtty.h>
-#endif /* USE_SGTTY */
+# define IOSTATE struct sgttyb
+# define GETIOSTATE(fd, statePtr) ioctl((fd), TIOCGETP, (statePtr))
+# define SETIOSTATE(fd, statePtr) ioctl((fd), TIOCSETP, (statePtr))
+#else /* !USE_SGTTY */
+# undef SUPPORTS_TTY
+#endif /* !USE_SGTTY */
#endif /* !USE_TERMIO */
#endif /* !USE_TERMIOS */
/*
- * The following structure is used to set or get the serial port
- * attributes in a platform-independant manner.
- */
-
-typedef struct TtyAttrs {
- int baud;
- int parity;
- int data;
- int stop;
-} TtyAttrs;
-
-/*
* This structure describes per-instance state of a file based channel.
*/
@@ -78,11 +80,44 @@ typedef struct FileState {
* file channels. */
} FileState;
+#ifdef SUPPORTS_TTY
+
/*
- * List of all file channels currently open.
+ * The following structure describes per-instance state of a tty-based
+ * channel.
*/
-static FileState *firstFilePtr = NULL;
+typedef struct TtyState {
+ FileState fs; /* Per-instance state of the file
+ * descriptor. Must be the first field. */
+ IOSTATE savedState; /* Initial state of device. Used to reset
+ * state when device closed. */
+} TtyState;
+
+/*
+ * The following structure is used to set or get the serial port
+ * attributes in a platform-independant manner.
+ */
+
+typedef struct TtyAttrs {
+ int baud;
+ int parity;
+ int data;
+ int stop;
+} TtyAttrs;
+
+#endif /* !SUPPORTS_TTY */
+
+typedef struct ThreadSpecificData {
+ /*
+ * List of all file channels currently open. This is per thread and is
+ * used to match up fd's to channels, which rarely occurs.
+ */
+
+ FileState *firstFilePtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
/*
* This structure describes per-instance state of a tcp based channel.
@@ -170,20 +205,24 @@ static int TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toWrite, int *errorCode));
static void TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
-static int TtyParseMode _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *mode, int *speedPtr, int *parityPtr,
- int *dataPtr, int *stopPtr));
+#ifdef SUPPORTS_TTY
+static int TtyCloseProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
static void TtyGetAttributes _ANSI_ARGS_((int fd,
TtyAttrs *ttyPtr));
static int TtyGetOptionProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp, char *optionName,
Tcl_DString *dsPtr));
-static void TtyInit _ANSI_ARGS_((int fd));
+static FileState * TtyInit _ANSI_ARGS_((int fd));
+static int TtyParseMode _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *mode, int *speedPtr, int *parityPtr,
+ int *dataPtr, int *stopPtr));
static void TtySetAttributes _ANSI_ARGS_((int fd,
TtyAttrs *ttyPtr));
static int TtySetOptionProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp, char *optionName,
char *value));
+#endif /* SUPPORTS_TTY */
static int WaitForConnect _ANSI_ARGS_((TcpState *statePtr,
int *errorCodePtr));
@@ -204,6 +243,7 @@ static Tcl_ChannelType fileChannelType = {
FileGetHandleProc, /* Get OS handles out of channel. */
};
+#ifdef SUPPORTS_TTY
/*
* This structure describes the channel type structure for serial IO.
* Note that this type is a subclass of the "file" type.
@@ -212,7 +252,7 @@ static Tcl_ChannelType fileChannelType = {
static Tcl_ChannelType ttyChannelType = {
"tty", /* Type name. */
FileBlockModeProc, /* Set blocking/nonblocking mode.*/
- FileCloseProc, /* Close proc. */
+ TtyCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -221,6 +261,7 @@ static Tcl_ChannelType ttyChannelType = {
FileWatchProc, /* Initialize notifier. */
FileGetHandleProc, /* Get OS handles out of channel. */
};
+#endif /* SUPPORTS_TTY */
/*
* This structure describes the channel type structure for TCP socket
@@ -403,15 +444,21 @@ FileCloseProc(instanceData, interp)
FileState *fsPtr = (FileState *) instanceData;
FileState **nextPtrPtr;
int errorCode = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_DeleteFileHandler(fsPtr->fd);
+
+ /*
+ * Do not close standard channels while in thread-exit.
+ */
+
if (!TclInExit()
|| ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
if (close(fsPtr->fd) < 0) {
errorCode = errno;
}
}
- for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
+ for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == fsPtr) {
(*nextPtrPtr) = fsPtr->nextPtr;
@@ -455,7 +502,7 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr)
FileState *fsPtr = (FileState *) instanceData;
int newLoc;
- newLoc = lseek(fsPtr->fd, offset, mode);
+ newLoc = lseek(fsPtr->fd, (off_t) offset, mode);
*errorCodePtr = (newLoc == -1) ? errno : 0;
return newLoc;
@@ -508,7 +555,7 @@ FileWatchProc(instanceData, mask)
*
* FileGetHandleProc --
*
- * Called from Tcl_GetChannelFile to retrieve OS handles from
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from
* a file based channel.
*
* Results:
@@ -536,6 +583,37 @@ FileGetHandleProc(instanceData, direction, handlePtr)
return TCL_ERROR;
}
}
+
+#ifdef SUPPORTS_TTY
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtyCloseProc --
+ *
+ * This procedure is called from the generic IO level to perform
+ * channel-type-specific cleanup when a tty based channel is closed.
+ *
+ * Results:
+ * 0 if successful, errno if failed.
+ *
+ * Side effects:
+ * Restores the settings and closes the device of the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TtyCloseProc(instanceData, interp)
+ ClientData instanceData; /* Tty state. */
+ Tcl_Interp *interp; /* For error reporting - unused. */
+{
+ TtyState *ttyPtr;
+
+ ttyPtr = (TtyState *) instanceData;
+ SETIOSTATE(ttyPtr->fs.fd, &ttyPtr->savedState);
+ return FileCloseProc(instanceData, interp);
+}
/*
*----------------------------------------------------------------------
@@ -545,7 +623,7 @@ FileGetHandleProc(instanceData, direction, handlePtr)
* Sets an option on a channel.
*
* Results:
- * A standard Tcl result. Also sets interp->result on error if
+ * A standard Tcl result. Also sets the interp's result on error if
* interp is not NULL.
*
* Side effects:
@@ -614,7 +692,7 @@ TtyGetOptionProc(instanceData, interp, optionName, dsPtr)
{
FileState *fsPtr = (FileState *) instanceData;
unsigned int len;
- char buf[32];
+ char buf[3 * TCL_INTEGER_SPACE + 16];
TtyAttrs tty;
if (optionName == NULL) {
@@ -820,65 +898,6 @@ TtyGetBaud(speed)
/*
*---------------------------------------------------------------------------
*
- * TtyInit --
- *
- * Given file descriptor that refers to a serial port,
- * initialize the serial port to a set of sane values so that
- * Tcl can talk to a device located on the serial port.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Serial device initialized.
- *
- *---------------------------------------------------------------------------
- */
-
-static void
-TtyInit(fd)
- int fd; /* Open file descriptor for serial port to
- * be initialized. */
-{
-#ifdef USE_TERMIOS
- struct termios termios;
-
- tcgetattr(fd, &termios);
- termios.c_iflag = IGNBRK;
- termios.c_oflag = 0;
- termios.c_lflag = 0;
- termios.c_cflag |= CREAD;
- termios.c_cc[VMIN] = 60;
- termios.c_cc[VTIME] = 2;
- tcsetattr(fd, TCSANOW, &termios);
-#else /* !USE_TERMIOS */
-#ifdef USE_TERMIO
- struct termio termio;
-
- ioctl(fd, TCGETA, &termio);
- termio.c_iflag = IGNBRK;
- termio.c_oflag = 0;
- termio.c_lflag = 0;
- termio.c_cflag |= CREAD;
- termio.c_cc[VMIN] = 60;
- termio.c_cc[VTIME] = 2;
- ioctl(fd, TCSETAW, &termio);
-#else /* !USE_TERMIO */
-#ifdef USE_SGTTY
- struct sgttyb sgttyb;
-
- ioctl(fd, TIOCGETP, &sgttyb);
- sgttyb.sg_flags &= (EVENP | ODDP);
- sgttyb.sg_flags |= RAW;
- ioctl(fd, TIOCSETP, &sgttyb);
-#endif /* USE_SGTTY */
-#endif /* !USE_TERMIO */
-#endif /* !USE_TERMIOS */
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* TtyGetAttributes --
*
* Get the current attributes of the specified serial device.
@@ -899,79 +918,71 @@ TtyGetAttributes(fd, ttyPtr)
TtyAttrs *ttyPtr; /* Buffer filled with serial port
* attributes. */
{
-#ifdef USE_TERMIOS
- int parity, data;
- struct termios termios;
+ IOSTATE iostate;
+ int baud, parity, data, stop;
+
+ GETIOSTATE(fd, &iostate);
- tcgetattr(fd, &termios);
- ttyPtr->baud = TtyGetBaud(cfgetospeed(&termios));
+#ifdef USE_TERMIOS
+ baud = TtyGetBaud(cfgetospeed(&iostate));
parity = 'n';
#ifdef PAREXT
- switch ((int) (termios.c_cflag & (PARENB | PARODD | PAREXT))) {
+ switch ((int) (iostate.c_cflag & (PARENB | PARODD | PAREXT))) {
case PARENB : parity = 'e'; break;
case PARENB | PARODD : parity = 'o'; break;
case PARENB | PAREXT : parity = 's'; break;
case PARENB | PARODD | PAREXT : parity = 'm'; break;
}
#else /* !PAREXT */
- switch ((int) (termios.c_cflag & (PARENB | PARODD))) {
+ switch ((int) (iostate.c_cflag & (PARENB | PARODD))) {
case PARENB : parity = 'e'; break;
case PARENB | PARODD : parity = 'o'; break;
}
#endif /* !PAREXT */
- ttyPtr->parity = parity;
- data = termios.c_cflag & CSIZE;
- ttyPtr->data = (data == CS5) ? 5 : (data == CS6) ? 6 :
- (data == CS7) ? 7 : 8;
+ data = iostate.c_cflag & CSIZE;
+ data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;
+
+ stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
+#endif /* USE_TERMIOS */
- ttyPtr->stop = (termios.c_cflag & CSTOPB) ? 2 : 1;
-#else /* !USE_TERMIOS */
#ifdef USE_TERMIO
- int parity, data;
- struct termio termio;
+ baud = TtyGetBaud(iostate.c_cflag & CBAUD);
- ioctl(fd, TCGETA, &termio);
- ttyPtr->baud = TtyGetBaud(termio.c_cflag & CBAUD);
parity = 'n';
- switch (termio.c_cflag & (PARENB | PARODD | PAREXT)) {
+ switch (iostate.c_cflag & (PARENB | PARODD | PAREXT)) {
case PARENB : parity = 'e'; break;
case PARENB | PARODD : parity = 'o'; break;
case PARENB | PAREXT : parity = 's'; break;
case PARENB | PARODD | PAREXT : parity = 'm'; break;
}
- ttyPtr->parity = parity;
- data = termio.c_cflag & CSIZE;
- ttyPtr->data = (data == CS5) ? 5 : (data == CS6) ? 6 :
- (data == CS7) ? 7 : 8;
+ data = iostate.c_cflag & CSIZE;
+ data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;
+
+ stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
+#endif /* USE_TERMIO */
- ttyPtr->stop = (termio.c_cflag & CSTOPB) ? 2 : 1;
-#else /* !USE_TERMIO */
#ifdef USE_SGTTY
- int parity;
- struct sgttyb sgttyb;
+ baud = TtyGetBaud(iostate.sg_ospeed);
- ioctl(fd, TIOCGETP, &sgttyb);
- ttyPtr->baud = TtyGetBaud(sgttyb.sg_ospeed);
parity = 'n';
- if (sgttyb.sg_flags & EVENP) {
+ if (iostate.sg_flags & EVENP) {
parity = 'e';
- } else if (sgttyb.sg_flags & ODDP) {
+ } else if (iostate.sg_flags & ODDP) {
parity = 'o';
}
- ttyPtr->parity = parity;
- ttyPtr->data = (sgttyb.sg_flags & (EVENP | ODDP)) ? 7 : 8;
- ttyPtr->stop = 1;
-#else /* !USE_SGTTY */
- ttyPtr->baud = 0;
- ttyPtr->parity = 'n';
- ttyPtr->data = 0;
- ttyPtr->stop = 0;
-#endif /* !USE_SGTTY */
-#endif /* !USE_TERMIO */
-#endif /* !USE_TERMIOS */
+
+ data = (iostate.sg_flags & (EVENP | ODDP)) ? 7 : 8;
+
+ stop = 1;
+#endif /* USE_SGTTY */
+
+ ttyPtr->baud = baud;
+ ttyPtr->parity = parity;
+ ttyPtr->data = data;
+ ttyPtr->stop = stop;
}
/*
@@ -997,20 +1008,21 @@ TtySetAttributes(fd, ttyPtr)
TtyAttrs *ttyPtr; /* Buffer containing new attributes for
* serial port. */
{
+ IOSTATE iostate;
+
#ifdef USE_TERMIOS
int parity, data, flag;
- struct termios termios;
- tcgetattr(fd, &termios);
- cfsetospeed(&termios, TtyGetSpeed(ttyPtr->baud));
- cfsetispeed(&termios, TtyGetSpeed(ttyPtr->baud));
+ GETIOSTATE(fd, &iostate);
+ cfsetospeed(&iostate, TtyGetSpeed(ttyPtr->baud));
+ cfsetispeed(&iostate, TtyGetSpeed(ttyPtr->baud));
flag = 0;
parity = ttyPtr->parity;
if (parity != 'n') {
flag |= PARENB;
#ifdef PAREXT
- termios.c_cflag &= ~PAREXT;
+ iostate.c_cflag &= ~PAREXT;
if ((parity == 'm') || (parity == 's')) {
flag |= PAREXT;
}
@@ -1025,18 +1037,17 @@ TtySetAttributes(fd, ttyPtr)
flag |= CSTOPB;
}
- termios.c_cflag &= ~(PARENB | PARODD | CSIZE | CSTOPB);
- termios.c_cflag |= flag;
- tcsetattr(fd, TCSANOW, &termios);
+ iostate.c_cflag &= ~(PARENB | PARODD | CSIZE | CSTOPB);
+ iostate.c_cflag |= flag;
+
+#endif /* USE_TERMIOS */
-#else /* !USE_TERMIOS */
#ifdef USE_TERMIO
int parity, data, flag;
- struct termio termio;
- ioctl(fd, TCGETA, &termio);
- termio.c_cflag &= ~CBAUD;
- termio.c_cflag |= TtyGetSpeed(ttyPtr->baud);
+ GETIOSTATE(fd, &iostate);
+ iostate.c_cflag &= ~CBAUD;
+ iostate.c_cflag |= TtyGetSpeed(ttyPtr->baud);
flag = 0;
parity = ttyPtr->parity;
@@ -1055,31 +1066,29 @@ TtySetAttributes(fd, ttyPtr)
flag |= CSTOPB;
}
- termio.c_cflag &= ~(PARENB | PARODD | PAREXT | CSIZE | CSTOPB);
- termio.c_cflag |= flag;
- ioctl(fd, TCSETAW, &termio);
+ iostate.c_cflag &= ~(PARENB | PARODD | PAREXT | CSIZE | CSTOPB);
+ iostate.c_cflag |= flag;
+
+#endif /* USE_TERMIO */
-#else /* !USE_TERMIO */
#ifdef USE_SGTTY
int parity;
- struct sgttyb sgttyb;
- ioctl(fd, TIOCGETP, &sgttyb);
- sgttyb.sg_ospeed = TtyGetSpeed(ttyPtr->baud);
- sgttyb.sg_ispeed = TtyGetSpeed(ttyPtr->baud);
+ GETIOSTATE(fd, &iostate);
+ iostate.sg_ospeed = TtyGetSpeed(ttyPtr->baud);
+ iostate.sg_ispeed = TtyGetSpeed(ttyPtr->baud);
parity = ttyPtr->parity;
if (parity == 'e') {
- sgttyb.sg_flags &= ~ODDP;
- sgttyb.sg_flags |= EVENP;
+ iostate.sg_flags &= ~ODDP;
+ iostate.sg_flags |= EVENP;
} else if (parity == 'o') {
- sgttyb.sg_flags &= ~EVENP;
- sgttyb.sg_flags |= ODDP;
+ iostate.sg_flags &= ~EVENP;
+ iostate.sg_flags |= ODDP;
}
- ioctl(fd, TIOCSETP, &sgttyb);
#endif /* USE_SGTTY */
-#endif /* !USE_TERMIO */
-#endif /* !USE_TERMIOS */
+
+ SETIOSTATE(fd, &iostate);
}
/*
@@ -1093,7 +1102,7 @@ TtySetAttributes(fd, ttyPtr)
* Results:
* The return value is TCL_OK if the argument was successfully
* parsed, TCL_ERROR otherwise. If TCL_ERROR is returned, an
- * error message is left in interp->result (if interp is non-NULL).
+ * error message is left in the interp's result (if interp is non-NULL).
*
* Side effects:
* None.
@@ -1123,10 +1132,26 @@ TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
}
return TCL_ERROR;
}
- if (strchr("noems", parity) == NULL) {
+ /*
+ * Only allow setting mark/space parity on platforms that support it
+ * Make sure to allow for the case where strchr is a macro.
+ * [Bug: 5089]
+ */
+ if (
+#if defined(PAREXT) || defined(USE_TERMIO)
+ strchr("noems", parity) == NULL
+#else
+ strchr("noe", parity) == NULL
+#endif
+ ) {
if (interp != NULL) {
Tcl_AppendResult(interp, bad,
- " parity: should be n, o, e, m, or s", NULL);
+#if defined(PAREXT) || defined(USE_TERMIO)
+ " parity: should be n, o, e, m, or s",
+#else
+ " parity: should be n, o, or e",
+#endif
+ NULL);
}
return TCL_ERROR;
}
@@ -1148,6 +1173,67 @@ TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TtyInit --
+ *
+ * Given file descriptor that refers to a serial port,
+ * initialize the serial port to a set of sane values so that
+ * Tcl can talk to a device located on the serial port.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Serial device initialized to non-blocking raw mode, similar to
+ * sockets. All other modes can be simulated on top of this in Tcl.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static FileState *
+TtyInit(fd)
+ int fd; /* Open file descriptor for serial port to
+ * be initialized. */
+{
+ IOSTATE iostate;
+ TtyState *ttyPtr;
+
+ ttyPtr = (TtyState *) ckalloc((unsigned) sizeof(TtyState));
+ GETIOSTATE(fd, &ttyPtr->savedState);
+
+ iostate = ttyPtr->savedState;
+
+#ifdef USE_TERMIOS
+ iostate.c_iflag = IGNBRK;
+ iostate.c_oflag = 0;
+ iostate.c_lflag = 0;
+ iostate.c_cflag |= CREAD;
+ iostate.c_cc[VMIN] = 1;
+ iostate.c_cc[VTIME] = 0;
+#endif /* USE_TERMIOS */
+
+#ifdef USE_TERMIO
+ iostate.c_iflag = IGNBRK;
+ iostate.c_oflag = 0;
+ iostate.c_lflag = 0;
+ iostate.c_cflag |= CREAD;
+ iostate.c_cc[VMIN] = 1;
+ iostate.c_cc[VTIME] = 0;
+#endif /* USE_TERMIO */
+
+#ifdef USE_SGTTY
+ iostate.sg_flags &= (EVENP | ODDP);
+ iostate.sg_flags |= RAW;
+#endif /* USE_SGTTY */
+
+ SETIOSTATE(fd, &iostate);
+
+ return &ttyPtr->fs;
+}
+#endif /* SUPPORTS_TTY */
+
+/*
*----------------------------------------------------------------------
*
* TclpOpenFileChannel --
@@ -1157,7 +1243,7 @@ TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
* Results:
* The new channel or NULL. If NULL, the output argument
* errorCodePtr is set to a POSIX error and an error message is
- * left in interp->result if interp is not NULL.
+ * left in the interp's result if interp is not NULL.
*
* Side effects:
* May open the channel and may cause creation of a file on the
@@ -1179,9 +1265,11 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
{
int fd, seekFlag, mode, channelPermissions;
FileState *fsPtr;
- char *nativeName, channelName[20];
- Tcl_DString buffer;
+ char *native, *translation;
+ char channelName[16 + TCL_INTEGER_SPACE];
+ Tcl_DString ds, buffer;
Tcl_ChannelType *channelTypePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
mode = TclGetOpenMode(interp, modeString, &seekFlag);
if (mode == -1) {
@@ -1205,17 +1293,13 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
return NULL;
}
- nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (nativeName == NULL) {
+ native = Tcl_TranslateFileName(interp, fileName, &buffer);
+ if (native == NULL) {
return NULL;
}
- fd = open(nativeName, mode, permissions);
-
- /*
- * If nativeName is not NULL, the buffer is valid and we must free
- * the storage.
- */
-
+ native = Tcl_UtfToExternalDString(NULL, native, -1, &ds);
+ fd = open(native, mode, permissions); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&buffer);
if (fd < 0) {
@@ -1235,12 +1319,7 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
sprintf(channelName, "file%d", fd);
- fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
- fsPtr->nextPtr = firstFilePtr;
- firstFilePtr = fsPtr;
- fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
- fsPtr->fd = fd;
-
+#ifdef SUPPORTS_TTY
if (isatty(fd)) {
/*
* Initialize the serial port to a set of sane parameters.
@@ -1250,12 +1329,22 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
* then the serial driver would echo it back to the device, etc.
*/
- TtyInit(fd);
+ translation = "auto crlf";
channelTypePtr = &ttyChannelType;
- } else {
+ fsPtr = TtyInit(fd);
+ } else
+#endif /* SUPPORTS_TTY */
+ {
+ translation = NULL;
channelTypePtr = &fileChannelType;
+ fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
}
+ fsPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = fsPtr;
+ fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
+ fsPtr->fd = fd;
+
fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
(ClientData) fsPtr, channelPermissions);
@@ -1270,7 +1359,7 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
}
}
- if (channelTypePtr == &ttyChannelType) {
+ if (translation != NULL) {
/*
* Gotcha. Most modems need a "\r" at the end of the command
* sequence. If you just send "at\n", the modem will not respond
@@ -1280,7 +1369,7 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
*/
if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation",
- "auto crlf") != TCL_OK) {
+ translation) != TCL_OK) {
Tcl_Close(NULL, fsPtr->channel);
return NULL;
}
@@ -1312,8 +1401,9 @@ Tcl_MakeFileChannel(handle, mode)
* TCL_WRITABLE to indicate file mode. */
{
FileState *fsPtr;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
int fd = (int) handle;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (mode == 0) {
return NULL;
@@ -1326,15 +1416,17 @@ Tcl_MakeFileChannel(handle, mode)
* If the fd is used, but the mode doesn't match, return NULL.
*/
- for (fsPtr = firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) {
+ for (fsPtr = tsdPtr->firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) {
if (fsPtr->fd == fd) {
- return (mode == fsPtr->validMask) ? fsPtr->channel : NULL;
+ return ((mode|TCL_EXCEPTION) == fsPtr->validMask) ?
+ fsPtr->channel : NULL;
}
}
fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
- fsPtr->nextPtr = firstFilePtr;
- firstFilePtr = fsPtr;
+ fsPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = fsPtr;
+
fsPtr->fd = fd;
fsPtr->validMask = mode | TCL_EXCEPTION;
fsPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
@@ -1508,7 +1600,7 @@ TcpInputProc(instanceData, buf, bufSize, errorCodePtr)
if (state != 0) {
return -1;
}
- bytesRead = recv(statePtr->fd, buf, bufSize, 0);
+ bytesRead = recv(statePtr->fd, buf, (size_t) bufSize, 0);
if (bytesRead > -1) {
return bytesRead;
}
@@ -1561,7 +1653,7 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
if (state != 0) {
return -1;
}
- written = send(statePtr->fd, buf, toWrite, 0);
+ written = send(statePtr->fd, buf, (size_t) toWrite, 0);
if (written > -1) {
return written;
}
@@ -1604,7 +1696,7 @@ TcpCloseProc(instanceData, interp)
* closing code that called this function, so we do not have to
* delete them here.
*/
-
+
Tcl_DeleteFileHandler(statePtr->fd);
if (close(statePtr->fd) < 0) {
@@ -1653,30 +1745,51 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
struct hostent *hostEntPtr;
int size = sizeof(struct sockaddr_in);
size_t len = 0;
- char buf[128];
+ char buf[TCL_INTEGER_SPACE];
if (optionName != (char *) NULL) {
len = strlen(optionName);
}
+ if ((len > 1) && (optionName[1] == 'e') &&
+ (strncmp(optionName, "-error", len) == 0)) {
+ int optlen;
+ int err, ret;
+
+ optlen = sizeof(int);
+ ret = getsockopt(statePtr->fd, SOL_SOCKET, SO_ERROR,
+ (char *)&err, &optlen);
+ if (ret < 0) {
+ err = errno;
+ }
+ if (err != 0) {
+ Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(err), -1);
+ }
+ return TCL_OK;
+ }
+
if ((len == 0) ||
((len > 1) && (optionName[1] == 'p') &&
(strncmp(optionName, "-peername", len) == 0))) {
- if (getpeername(statePtr->fd, (struct sockaddr *) &peername, &size)
- >= 0) {
+ if (getpeername(statePtr->fd, (struct sockaddr *) &peername,
+ &size) >= 0) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-peername");
Tcl_DStringStartSublist(dsPtr);
}
Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
- hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
- sizeof(peername.sin_addr), AF_INET);
- if (hostEntPtr != (struct hostent *) NULL) {
- Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+ hostEntPtr = gethostbyaddr( /* INTL: Native. */
+ (char *) &peername.sin_addr,
+ sizeof(peername.sin_addr), AF_INET);
+ if (hostEntPtr != NULL) {
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
+ Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
} else {
Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
}
- sprintf(buf, "%d", ntohs(peername.sin_port));
+ TclFormatInt(buf, ntohs(peername.sin_port));
Tcl_DStringAppendElement(dsPtr, buf);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
@@ -1712,14 +1825,18 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
Tcl_DStringStartSublist(dsPtr);
}
Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
- hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
+ hostEntPtr = gethostbyaddr( /* INTL: Native. */
+ (char *) &sockname.sin_addr,
sizeof(sockname.sin_addr), AF_INET);
if (hostEntPtr != (struct hostent *) NULL) {
- Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
+ Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
} else {
Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
}
- sprintf(buf, "%d", ntohs(sockname.sin_port));
+ TclFormatInt(buf, ntohs(sockname.sin_port));
Tcl_DStringAppendElement(dsPtr, buf);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
@@ -1791,7 +1908,7 @@ TcpWatchProc(instanceData, mask)
*
* TcpGetHandleProc --
*
- * Called from Tcl_GetChannelFile to retrieve OS handles from inside
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from inside
* a TCP socket based channel.
*
* Results:
@@ -1826,8 +1943,8 @@ TcpGetHandleProc(instanceData, direction, handlePtr)
* and initializes the TcpState structure.
*
* Results:
- * Returns a new TcpState, or NULL with an error in interp->result,
- * if interp is not NULL.
+ * Returns a new TcpState, or NULL with an error in the interp's
+ * result, if interp is not NULL.
*
* Side effects:
* Opens a socket.
@@ -1940,7 +2057,27 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
asyncConnect = 1;
status = 0;
}
- }
+ } else {
+ /*
+ * Here we are if the connect succeeds. In case of an
+ * asynchronous connect we have to reset the channel to
+ * blocking mode. This appears to happen not very often,
+ * but e.g. on a HP 9000/800 under HP-UX B.11.00 we enter
+ * this stage. [Bug: 4388]
+ */
+ if (async) {
+#ifndef USE_FIONBIO
+ origState = fcntl(sock, F_GETFL);
+ curState = origState & ~(O_NONBLOCK);
+ status = fcntl(sock, F_SETFL, curState);
+#endif
+
+#ifdef USE_FIONBIO
+ curState = 0;
+ status = ioctl(sock, FIONBIO, &curState);
+#endif
+ }
+ }
}
}
@@ -1966,7 +2103,7 @@ bindError:
statePtr->flags = TCP_ASYNC_CONNECT;
}
statePtr->fd = sock;
-
+
return statePtr;
addressError:
@@ -2012,9 +2149,21 @@ CreateSocketAddress(sockaddrPtr, host, port)
if (host == NULL) {
addr.s_addr = INADDR_ANY;
} else {
- addr.s_addr = inet_addr(host);
- if (addr.s_addr == -1) {
- hostent = gethostbyname(host);
+ Tcl_DString ds;
+ CONST char *native;
+
+ if (host == NULL) {
+ native = NULL;
+ } else {
+ native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
+ }
+ addr.s_addr = inet_addr(native); /* INTL: Native. */
+ /*
+ * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1
+ * on either 32 or 64 bits systems.
+ */
+ if (addr.s_addr == 0xFFFFFFFF) {
+ hostent = gethostbyname(native); /* INTL: Native. */
if (hostent != NULL) {
memcpy((VOID *) &addr,
(VOID *) hostent->h_addr_list[0],
@@ -2027,9 +2176,15 @@ CreateSocketAddress(sockaddrPtr, host, port)
errno = ENXIO;
#endif
#endif
+ if (native != NULL) {
+ Tcl_DStringFree(&ds);
+ }
return 0; /* error */
}
}
+ if (native != NULL) {
+ Tcl_DStringFree(&ds);
+ }
}
/*
@@ -2072,7 +2227,7 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
* we do a blocking connect. */
{
TcpState *statePtr;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
/*
* Create a new client socket and wrap it in a channel.
@@ -2119,7 +2274,7 @@ Tcl_MakeTcpClientChannel(sock)
ClientData sock; /* The socket to wrap up into a channel. */
{
TcpState *statePtr;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
statePtr->fd = (int) sock;
@@ -2147,7 +2302,7 @@ Tcl_MakeTcpClientChannel(sock)
*
* Results:
* The channel or NULL if failed. If an error occurred, an
- * error message is left in interp->result if interp is
+ * error message is left in the interp's result if interp is
* not NULL.
*
* Side effects:
@@ -2167,7 +2322,7 @@ Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
ClientData acceptProcData; /* Data for the callback. */
{
TcpState *statePtr;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
/*
* Create a new client socket and wrap it in a channel.
@@ -2221,12 +2376,12 @@ TcpAccept(data, mask)
TcpState *newSockState; /* State for new socket. */
struct sockaddr_in addr; /* The remote address */
int len; /* For accept interface */
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
sockState = (TcpState *) data;
len = sizeof(struct sockaddr_in);
- newsock = accept(sockState->fd, (struct sockaddr *)&addr, &len);
+ newsock = accept(sockState->fd, (struct sockaddr *) &addr, &len);
if (newsock < 0) {
return;
}
@@ -2242,18 +2397,18 @@ TcpAccept(data, mask)
newSockState->flags = 0;
newSockState->fd = newsock;
- newSockState->acceptProc = (Tcl_TcpAcceptProc *) NULL;
- newSockState->acceptProcData = (ClientData) NULL;
+ newSockState->acceptProc = NULL;
+ newSockState->acceptProcData = NULL;
sprintf(channelName, "sock%d", newsock);
newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));
- Tcl_SetChannelOption((Tcl_Interp *) NULL, newSockState->channel,
- "-translation", "auto crlf");
+ Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
+ "auto crlf");
- if (sockState->acceptProc != (Tcl_TcpAcceptProc *) NULL) {
- (sockState->acceptProc) (sockState->acceptProcData,
+ if (sockState->acceptProc != NULL) {
+ (*sockState->acceptProc)(sockState->acceptProcData,
newSockState->channel, inet_ntoa(addr.sin_addr),
ntohs(addr.sin_port));
}
@@ -2262,7 +2417,7 @@ TcpAccept(data, mask)
/*
*----------------------------------------------------------------------
*
- * TclGetDefaultStdChannel --
+ * TclpGetDefaultStdChannel --
*
* Creates channels for standard input, standard output or standard
* error output if they do not already exist.
@@ -2278,7 +2433,7 @@ TcpAccept(data, mask)
*/
Tcl_Channel
-TclGetDefaultStdChannel(type)
+TclpGetDefaultStdChannel(type)
int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel = NULL;
@@ -2320,6 +2475,9 @@ TclGetDefaultStdChannel(type)
}
channel = Tcl_MakeFileChannel((ClientData) fd, mode);
+ if (channel == NULL) {
+ return NULL;
+ }
/*
* Set up the normal channel options for stdio handles.
@@ -2344,7 +2502,7 @@ TclGetDefaultStdChannel(type)
* it is open for the requested mode, then the output parameter
* filePtr is set to a FILE * for the underlying file. On error, the
* filePtr is not set, TCL_ERROR is returned and an error message is
- * left in interp->result.
+ * left in the interp's result.
*
* Side effects:
* May invoke fdopen to create the FILE * for the requested file.
@@ -2393,7 +2551,11 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
*/
chanTypePtr = Tcl_GetChannelType(chan);
- if ((chanTypePtr == &fileChannelType) || (chanTypePtr == &tcpChannelType)
+ if ((chanTypePtr == &fileChannelType)
+#ifdef SUPPORTS_TTY
+ || (chanTypePtr == &ttyChannelType)
+#endif /* SUPPORTS_TTY */
+ || (chanTypePtr == &tcpChannelType)
|| (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
if (Tcl_GetChannelHandle(chan,
(forWriting ? TCL_WRITABLE : TCL_READABLE),
@@ -2461,7 +2623,7 @@ TclUnixWaitForFile(fd, mask, timeout)
Tcl_Time abortTime, now;
struct timeval blockTime, *timeoutPtr;
int index, bit, numFound, result = 0;
- static fd_mask readyMasks[3*MASK_SIZE];
+ fd_mask readyMasks[3*MASK_SIZE];
/* This array reflects the readable/writable
* conditions that were found to exist by the
* last call to select. */
@@ -2571,3 +2733,5 @@ TclUnixWaitForFile(fd, mask, timeout)
}
return result;
}
+
+
diff --git a/tcl/unix/tclUnixEvent.c b/tcl/unix/tclUnixEvent.c
index 2a2a67bab2d..02bd91d7190 100644
--- a/tcl/unix/tclUnixEvent.c
+++ b/tcl/unix/tclUnixEvent.c
@@ -34,7 +34,7 @@ void
Tcl_Sleep(ms)
int ms; /* Number of milliseconds to sleep. */
{
- static struct timeval delay;
+ struct timeval delay;
Tcl_Time before, after;
/*
@@ -74,3 +74,4 @@ Tcl_Sleep(ms)
TclpGetTime(&before);
}
}
+
diff --git a/tcl/unix/tclUnixFCmd.c b/tcl/unix/tclUnixFCmd.c
index a58ac031bff..3b1b02ce0af 100644
--- a/tcl/unix/tclUnixFCmd.c
+++ b/tcl/unix/tclUnixFCmd.c
@@ -5,7 +5,7 @@
* subcommands of the "file" command. All filename arguments should
* already be translated to native format.
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -51,6 +51,11 @@
#include "tclPort.h"
#include <utime.h>
#include <grp.h>
+#ifndef HAVE_ST_BLKSIZE
+#ifndef NO_FSTATFS
+#include <sys/statfs.h>
+#endif
+#endif
/*
* The following constants specify the type of callback when
@@ -66,30 +71,34 @@
*/
static int GetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **attributePtrPtr));
static int GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **attributePtrPtr));
static int GetPermissionsAttribute _ANSI_ARGS_((
- Tcl_Interp *interp, int objIndex, char *fileName,
- Tcl_Obj **attributePtrPtr));
+ Tcl_Interp *interp, int objIndex,
+ CONST char *fileName, Tcl_Obj **attributePtrPtr));
static int SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj *attributePtr));
static int SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj *attributePtr));
static int SetPermissionsAttribute _ANSI_ARGS_((
- Tcl_Interp *interp, int objIndex, char *fileName,
- Tcl_Obj *attributePtr));
-
+ Tcl_Interp *interp, int objIndex,
+ CONST char *fileName, Tcl_Obj *attributePtr));
+static int GetModeFromPermString _ANSI_ARGS_((
+ Tcl_Interp *interp, char *modeStringPtr,
+ mode_t *modePtr));
+
/*
* Prototype for the TraverseUnixTree callback function.
*/
-typedef int (TraversalProc) _ANSI_ARGS_((char *src, char *dst,
- struct stat *sb, int type, Tcl_DString *errorPtr));
+typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr,
+ Tcl_DString *dstPtr, CONST struct stat *statBufPtr, int type,
+ Tcl_DString *errorPtr));
/*
* Constants and variables necessary for file attributes subcommand.
@@ -101,36 +110,50 @@ enum {
UNIX_PERMISSIONS_ATTRIBUTE
};
-char *tclpFileAttrStrings[] = {"-group", "-owner", "-permissions",
- (char *) NULL};
+char *tclpFileAttrStrings[] = {
+ "-group",
+ "-owner",
+ "-permissions",
+ (char *) NULL
+};
+
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
- {GetGroupAttribute, SetGroupAttribute},
- {GetOwnerAttribute, SetOwnerAttribute},
- {GetPermissionsAttribute, SetPermissionsAttribute}};
+ {GetGroupAttribute, SetGroupAttribute},
+ {GetOwnerAttribute, SetOwnerAttribute},
+ {GetPermissionsAttribute, SetPermissionsAttribute}
+};
/*
* Declarations for local procedures defined in this file:
*/
-static int CopyFile _ANSI_ARGS_((char *src, char *dst,
- struct stat *srcStatBufPtr));
-static int CopyFileAtts _ANSI_ARGS_((char *src, char *dst,
- struct stat *srcStatBufPtr));
-static int TraversalCopy _ANSI_ARGS_((char *src, char *dst,
- struct stat *sbPtr, int type,
- Tcl_DString *errorPtr));
-static int TraversalDelete _ANSI_ARGS_((char *src, char *dst,
- struct stat *sbPtr, int type,
- Tcl_DString *errorPtr));
+static int CopyFile _ANSI_ARGS_((CONST char *src,
+ CONST char *dst, CONST struct stat *statBufPtr));
+static int CopyFileAtts _ANSI_ARGS_((CONST char *src,
+ CONST char *dst, CONST struct stat *statBufPtr));
+static int DoCopyFile _ANSI_ARGS_((Tcl_DString *srcPtr,
+ Tcl_DString *dstPtr));
+static int DoCreateDirectory _ANSI_ARGS_((Tcl_DString *pathPtr));
+static int DoDeleteFile _ANSI_ARGS_((Tcl_DString *pathPtr));
+static int DoRemoveDirectory _ANSI_ARGS_((Tcl_DString *pathPtr,
+ int recursive, Tcl_DString *errorPtr));
+static int DoRenameFile _ANSI_ARGS_((CONST char *src,
+ CONST char *dst));
+static int TraversalCopy _ANSI_ARGS_((Tcl_DString *srcPtr,
+ Tcl_DString *dstPtr, CONST struct stat *statBufPtr,
+ int type, Tcl_DString *errorPtr));
+static int TraversalDelete _ANSI_ARGS_((Tcl_DString *srcPtr,
+ Tcl_DString *dstPtr, CONST struct stat *statBufPtr,
+ int type, Tcl_DString *errorPtr));
static int TraverseUnixTree _ANSI_ARGS_((
TraversalProc *traversalProc,
- Tcl_DString *sourcePath, Tcl_DString *destPath,
+ Tcl_DString *sourcePtr, Tcl_DString *destPtr,
Tcl_DString *errorPtr));
/*
*---------------------------------------------------------------------------
*
- * TclpRenameFile --
+ * TclpRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
@@ -164,22 +187,53 @@ static int TraverseUnixTree _ANSI_ARGS_((
int
TclpRenameFile(src, dst)
- char *src; /* Pathname of file or dir to be renamed. */
- char *dst; /* New pathname of file or directory. */
+ CONST char *src; /* Pathname of file or dir to be renamed
+ * (UTF-8). */
+ CONST char *dst; /* New pathname of file or directory
+ * (UTF-8). */
+{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ result = DoRenameFile(Tcl_DStringValue(&srcString),
+ Tcl_DStringValue(&dstString));
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoRenameFile(src, dst)
+ CONST char *src; /* Pathname of file or dir to be renamed
+ * (native). */
+ CONST char *dst; /* New pathname of file or directory
+ * (native). */
{
- if (rename(src, dst) == 0) {
+ if (rename(src, dst) == 0) { /* INTL: Native. */
return TCL_OK;
}
if (errno == ENOTEMPTY) {
errno = EEXIST;
}
-#ifdef sparc
+ /*
+ * IRIX returns EIO when you attept to move a directory into
+ * itself. We just map EIO to EINVAL get the right message on SGI.
+ * Most platforms don't return EIO except in really strange cases.
+ */
+
+ if (errno == EIO) {
+ errno = EINVAL;
+ }
+
+#ifndef NO_REALPATH
/*
* SunOS 4.1.4 reports overwriting a non-empty directory with a
* directory as EINVAL instead of EEXIST (first rule out the correct
* EINVAL result code for moving a directory into itself). Must be
- * conditionally compiled because realpath() is only defined on SunOS.
+ * conditionally compiled because realpath() not defined on all systems.
*/
if (errno == EINVAL) {
@@ -187,12 +241,16 @@ TclpRenameFile(src, dst)
DIR *dirPtr;
struct dirent *dirEntPtr;
- if ((realpath(src, srcPath) != NULL)
- && (realpath(dst, dstPath) != NULL)
+ if ((realpath((char *) src, srcPath) != NULL) /* INTL: Native. */
+ && (realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */
&& (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
- dirPtr = opendir(dst);
+ dirPtr = opendir(dst); /* INTL: Native. */
if (dirPtr != NULL) {
- while ((dirEntPtr = readdir(dirPtr)) != NULL) {
+ while (1) {
+ dirEntPtr = readdir(dirPtr); /* INTL: Native. */
+ if (dirEntPtr == NULL) {
+ break;
+ }
if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
(strcmp(dirEntPtr->d_name, "..") != 0)) {
errno = EEXIST;
@@ -205,7 +263,7 @@ TclpRenameFile(src, dst)
}
errno = EINVAL;
}
-#endif /* sparc */
+#endif /* !NO_REALPATH */
if (strcmp(src, "/") == 0) {
/*
@@ -230,7 +288,7 @@ TclpRenameFile(src, dst)
/*
*---------------------------------------------------------------------------
*
- * TclpCopyFile --
+ * TclpCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
@@ -256,18 +314,36 @@ TclpRenameFile(src, dst)
int
TclpCopyFile(src, dst)
- char *src; /* Pathname of file to be copied. */
- char *dst; /* Pathname of file to copy to. */
+ CONST char *src; /* Pathname of file to be copied (UTF-8). */
+ CONST char *dst; /* Pathname of file to copy to (UTF-8). */
+{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ result = DoCopyFile(&srcString, &dstString);
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoCopyFile(srcPtr, dstPtr)
+ Tcl_DString *srcPtr; /* Pathname of file to be copied (native). */
+ Tcl_DString *dstPtr; /* Pathname of file to copy to (native). */
{
struct stat srcStatBuf, dstStatBuf;
- char link[MAXPATHLEN];
- int length;
+ CONST char *src, *dst;
+
+ src = Tcl_DStringValue(srcPtr);
+ dst = Tcl_DStringValue(dstPtr);
/*
* Have to do a stat() to determine the filetype.
*/
- if (lstat(src, &srcStatBuf) != 0) {
+ if (lstat(src, &srcStatBuf) != 0) { /* INTL: Native. */
return TCL_ERROR;
}
if (S_ISDIR(srcStatBuf.st_mode)) {
@@ -280,49 +356,51 @@ TclpCopyFile(src, dst)
* exists, so we remove it first
*/
- if (lstat(dst, &dstStatBuf) == 0) {
+ if (lstat(dst, &dstStatBuf) == 0) { /* INTL: Native. */
if (S_ISDIR(dstStatBuf.st_mode)) {
errno = EISDIR;
return TCL_ERROR;
}
}
- if (unlink(dst) != 0) {
+ if (unlink(dst) != 0) { /* INTL: Native. */
if (errno != ENOENT) {
return TCL_ERROR;
}
}
switch ((int) (srcStatBuf.st_mode & S_IFMT)) {
- case S_IFLNK:
- length = readlink(src, link, sizeof(link));
+ case S_IFLNK: {
+ char link[MAXPATHLEN];
+ int length;
+
+ length = readlink(src, link, sizeof(link)); /* INTL: Native. */
if (length == -1) {
return TCL_ERROR;
}
link[length] = '\0';
- if (symlink(link, dst) < 0) {
+ if (symlink(link, dst) < 0) { /* INTL: Native. */
return TCL_ERROR;
}
break;
-
+ }
case S_IFBLK:
- case S_IFCHR:
- if (mknod(dst, srcStatBuf.st_mode, srcStatBuf.st_rdev) < 0) {
+ case S_IFCHR: {
+ if (mknod(dst, srcStatBuf.st_mode, /* INTL: Native. */
+ srcStatBuf.st_rdev) < 0) {
return TCL_ERROR;
}
return CopyFileAtts(src, dst, &srcStatBuf);
-
-#ifndef __CYGWIN__
- case S_IFIFO:
- if (mkfifo(dst, srcStatBuf.st_mode) < 0) {
+ }
+ case S_IFIFO: {
+ if (mkfifo(dst, srcStatBuf.st_mode) < 0) { /* INTL: Native. */
return TCL_ERROR;
}
return CopyFileAtts(src, dst, &srcStatBuf);
-#endif
-
- default:
+ }
+ default: {
return CopyFile(src, dst, &srcStatBuf);
+ }
}
-
return TCL_OK;
}
@@ -344,10 +422,12 @@ TclpCopyFile(src, dst)
*/
static int
-CopyFile(src, dst, srcStatBufPtr)
- char *src; /* Pathname of file to copy. */
- char *dst; /* Pathname of file to create/overwrite. */
- struct stat *srcStatBufPtr; /* Used to determine mode and blocksize */
+CopyFile(src, dst, statBufPtr)
+ CONST char *src; /* Pathname of file to copy (native). */
+ CONST char *dst; /* Pathname of file to create/overwrite
+ * (native). */
+ CONST struct stat *statBufPtr;
+ /* Used to determine mode and blocksize. */
{
int srcFd;
int dstFd;
@@ -355,21 +435,33 @@ CopyFile(src, dst, srcStatBufPtr)
char *buffer; /* Data buffer for copy */
size_t nread;
- if ((srcFd = open(src, O_RDONLY, 0)) < 0) {
+ if ((srcFd = open(src, O_RDONLY, 0)) < 0) { /* INTL: Native. */
return TCL_ERROR;
}
- dstFd = open(dst, O_CREAT | O_TRUNC | O_WRONLY, srcStatBufPtr->st_mode);
+ dstFd = open(dst, O_CREAT | O_TRUNC | O_WRONLY, /* INTL: Native. */
+ statBufPtr->st_mode);
if (dstFd < 0) {
close(srcFd);
return TCL_ERROR;
}
-#if HAVE_ST_BLKSIZE
- blockSize = srcStatBufPtr->st_blksize;
+#ifdef HAVE_ST_BLKSIZE
+ blockSize = statBufPtr->st_blksize;
#else
+#ifndef NO_FSTATFS
+ {
+ struct statfs fs;
+ if (fstatfs(srcFd, &fs, sizeof(fs), 0) == 0) {
+ blockSize = fs.f_bsize;
+ } else {
+ blockSize = 4096;
+ }
+ }
+#else
blockSize = 4096;
#endif
+#endif
buffer = ckalloc(blockSize);
while (1) {
@@ -386,17 +478,17 @@ CopyFile(src, dst, srcStatBufPtr)
ckfree(buffer);
close(srcFd);
if ((close(dstFd) != 0) || (nread == -1)) {
- unlink(dst);
+ unlink(dst); /* INTL: Native. */
return TCL_ERROR;
}
- if (CopyFileAtts(src, dst, srcStatBufPtr) == TCL_ERROR) {
+ if (CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
/*
* The copy succeeded, but setting the permissions failed, so be in
* a consistent state, we remove the file that was created by the
* copy.
*/
- unlink(dst);
+ unlink(dst); /* INTL: Native. */
return TCL_ERROR;
}
return TCL_OK;
@@ -405,7 +497,7 @@ CopyFile(src, dst, srcStatBufPtr)
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile --
+ * TclpDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -426,9 +518,25 @@ CopyFile(src, dst, srcStatBufPtr)
int
TclpDeleteFile(path)
- char *path; /* Pathname of file to be removed. */
+ CONST char *path; /* Pathname of file to be removed (UTF-8). */
{
- if (unlink(path) != 0) {
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoDeleteFile(&pathString);
+ Tcl_DStringFree(&pathString);
+ return result;
+}
+
+static int
+DoDeleteFile(pathPtr)
+ Tcl_DString *pathPtr; /* Pathname of file to be removed (native). */
+{
+ CONST char *path;
+
+ path = Tcl_DStringValue(pathPtr);
+ if (unlink(path) != 0) { /* INTL: Native. */
return TCL_ERROR;
}
return TCL_OK;
@@ -437,7 +545,7 @@ TclpDeleteFile(path)
/*
*---------------------------------------------------------------------------
*
- * TclpCreateDirectory --
+ * TclpCreateDirectory, DoCreateDirectory --
*
* Creates the specified directory. All parent directories of the
* specified directory must already exist. The directory is
@@ -462,9 +570,25 @@ TclpDeleteFile(path)
int
TclpCreateDirectory(path)
- char *path; /* Pathname of directory to create. */
+ CONST char *path; /* Pathname of directory to create (UTF-8). */
+{
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoCreateDirectory(&pathString);
+ Tcl_DStringFree(&pathString);
+ return result;
+}
+
+static int
+DoCreateDirectory(pathPtr)
+ Tcl_DString *pathPtr; /* Pathname of directory to create (native). */
{
mode_t mode;
+ CONST char *path;
+
+ path = Tcl_DStringValue(pathPtr);
mode = umask(0);
umask(mode);
@@ -472,10 +596,10 @@ TclpCreateDirectory(path)
/*
* umask return value is actually the inverse of the permissions.
*/
-
- mode = (0777 & ~mode);
- if (mkdir(path, mode | S_IRUSR | S_IWUSR | S_IXUSR) != 0) {
+ mode = (0777 & ~mode) | S_IRUSR | S_IWUSR | S_IXUSR;
+
+ if (mkdir(path, mode) != 0) { /* INTL: Native. */
return TCL_ERROR;
}
return TCL_OK;
@@ -509,30 +633,30 @@ TclpCreateDirectory(path)
int
TclpCopyDirectory(src, dst, errorPtr)
- char *src; /* Pathname of directory to be copied. */
- char *dst; /* Pathname of target directory. */
- Tcl_DString *errorPtr; /* If non-NULL, initialized DString for
- * error reporting. */
+ CONST char *src; /* Pathname of directory to be copied
+ * (UTF-8). */
+ CONST char *dst; /* Pathname of target directory (UTF-8). */
+ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
+ Tcl_DString srcString, dstString;
int result;
- Tcl_DString srcBuffer;
- Tcl_DString dstBuffer;
-
- Tcl_DStringInit(&srcBuffer);
- Tcl_DStringInit(&dstBuffer);
- Tcl_DStringAppend(&srcBuffer, src, -1);
- Tcl_DStringAppend(&dstBuffer, dst, -1);
- result = TraverseUnixTree(TraversalCopy, &srcBuffer, &dstBuffer,
- errorPtr);
- Tcl_DStringFree(&srcBuffer);
- Tcl_DStringFree(&dstBuffer);
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+
+ result = TraverseUnixTree(TraversalCopy, &srcString, &dstString, errorPtr);
+
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
return result;
}
/*
*---------------------------------------------------------------------------
*
- * TclpRemoveDirectory --
+ * TclpRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
@@ -557,17 +681,40 @@ TclpCopyDirectory(src, dst, errorPtr)
int
TclpRemoveDirectory(path, recursive, errorPtr)
- char *path; /* Pathname of directory to be removed. */
+ CONST char *path; /* Pathname of directory to be removed
+ * (UTF-8). */
int recursive; /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
- Tcl_DString *errorPtr; /* If non-NULL, initialized DString for
- * error reporting. */
+ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
int result;
- Tcl_DString buffer;
+ Tcl_DString pathString;
- if (rmdir(path) == 0) {
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoRemoveDirectory(&pathString, recursive, errorPtr);
+ Tcl_DStringFree(&pathString);
+
+ return result;
+}
+
+static int
+DoRemoveDirectory(pathPtr, recursive, errorPtr)
+ Tcl_DString *pathPtr; /* Pathname of directory to be removed
+ * (native). */
+ int recursive; /* If non-zero, removes directories that
+ * are nonempty. Otherwise, will only remove
+ * empty directories. */
+ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ CONST char *path;
+
+ path = Tcl_DStringValue(pathPtr);
+ if (rmdir(path) == 0) { /* INTL: Native. */
return TCL_OK;
}
if (errno == ENOTEMPTY) {
@@ -575,7 +722,7 @@ TclpRemoveDirectory(path, recursive, errorPtr)
}
if ((errno != EEXIST) || (recursive == 0)) {
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, path, -1);
+ Tcl_ExternalToUtfDString(NULL, path, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -585,11 +732,7 @@ TclpRemoveDirectory(path, recursive, errorPtr)
* specified, so we recursively remove all the files in the directory.
*/
- Tcl_DStringInit(&buffer);
- Tcl_DStringAppend(&buffer, path, -1);
- result = TraverseUnixTree(TraversalDelete, &buffer, NULL, errorPtr);
- Tcl_DStringFree(&buffer);
- return result;
+ return TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr);
}
/*
@@ -619,43 +762,39 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
TraversalProc *traverseProc;/* Function to call for every file and
* directory in source hierarchy. */
Tcl_DString *sourcePtr; /* Pathname of source directory to be
- * traversed. */
+ * traversed (native). */
Tcl_DString *targetPtr; /* Pathname of directory to traverse in
- * parallel with source directory. */
- Tcl_DString *errorPtr; /* If non-NULL, an initialized DString for
- * error reporting. */
+ * parallel with source directory (native). */
+ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
- struct stat statbuf;
- char *source, *target, *errfile;
+ struct stat statBuf;
+ CONST char *source, *errfile;
int result, sourceLen;
- int targetLen = 0; /* Initialization needed only to prevent
- * warning in gcc. */
- struct dirent *dirp;
- DIR *dp;
+ int targetLen;
+ struct dirent *dirEntPtr;
+ DIR *dirPtr;
+ errfile = NULL;
result = TCL_OK;
- source = Tcl_DStringValue(sourcePtr);
- if (targetPtr != NULL) {
- target = Tcl_DStringValue(targetPtr);
- } else {
- target = NULL;
- }
+ targetLen = 0; /* lint. */
- errfile = NULL;
- if (lstat(source, &statbuf) != 0) {
+ source = Tcl_DStringValue(sourcePtr);
+ if (lstat(source, &statBuf) != 0) { /* INTL: Native. */
errfile = source;
goto end;
}
- if (!S_ISDIR(statbuf.st_mode)) {
+ if (!S_ISDIR(statBuf.st_mode)) {
/*
* Process the regular file
*/
- return (*traverseProc)(source, target, &statbuf, DOTREE_F, errorPtr);
+ return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F,
+ errorPtr);
}
-
- dp = opendir(source);
- if (dp == NULL) {
+ dirPtr = opendir(source); /* INTL: Native. */
+ if (dirPtr == NULL) {
/*
* Can't read directory
*/
@@ -663,25 +802,24 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
errfile = source;
goto end;
}
- result = (*traverseProc)(source, target, &statbuf, DOTREE_PRED, errorPtr);
+ result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,
+ errorPtr);
if (result != TCL_OK) {
- closedir(dp);
+ closedir(dirPtr);
return result;
}
Tcl_DStringAppend(sourcePtr, "/", 1);
- source = Tcl_DStringValue(sourcePtr);
sourceLen = Tcl_DStringLength(sourcePtr);
if (targetPtr != NULL) {
Tcl_DStringAppend(targetPtr, "/", 1);
- target = Tcl_DStringValue(targetPtr);
targetLen = Tcl_DStringLength(targetPtr);
}
- while ((dirp = readdir(dp)) != NULL) {
- if ((strcmp(dirp->d_name, ".") == 0)
- || (strcmp(dirp->d_name, "..") == 0)) {
+ while ((dirEntPtr = readdir(dirPtr)) != NULL) { /* INTL: Native. */
+ if ((strcmp(dirEntPtr->d_name, ".") == 0)
+ || (strcmp(dirEntPtr->d_name, "..") == 0)) {
continue;
}
@@ -689,9 +827,9 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
* Append name after slash, and recurse on the file.
*/
- Tcl_DStringAppend(sourcePtr, dirp->d_name, -1);
+ Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1);
if (targetPtr != NULL) {
- Tcl_DStringAppend(targetPtr, dirp->d_name, -1);
+ Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1);
}
result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
errorPtr);
@@ -708,17 +846,15 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
Tcl_DStringSetLength(targetPtr, targetLen);
}
}
- closedir(dp);
+ closedir(dirPtr);
/*
* Strip off the trailing slash we added
*/
Tcl_DStringSetLength(sourcePtr, sourceLen - 1);
- source = Tcl_DStringValue(sourcePtr);
if (targetPtr != NULL) {
Tcl_DStringSetLength(targetPtr, targetLen - 1);
- target = Tcl_DStringValue(targetPtr);
}
if (result == TCL_OK) {
@@ -727,13 +863,13 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
* files in that directory.
*/
- result = (*traverseProc)(source, target, &statbuf, DOTREE_POSTD,
+ result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD,
errorPtr);
}
end:
if (errfile != NULL) {
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, errfile, -1);
+ Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr);
}
result = TCL_ERROR;
}
@@ -760,29 +896,32 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
*/
static int
-TraversalCopy(src, dst, sbPtr, type, errorPtr)
- char *src; /* Source pathname to copy. */
- char *dst; /* Destination pathname of copy. */
- struct stat *sbPtr; /* Stat info for file specified by src. */
+TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr)
+ Tcl_DString *srcPtr; /* Source pathname to copy (native). */
+ Tcl_DString *dstPtr; /* Destination pathname of copy (native). */
+ CONST struct stat *statBufPtr;
+ /* Stat info for file specified by srcPtr. */
int type; /* Reason for call - see TraverseUnixTree(). */
- Tcl_DString *errorPtr; /* If non-NULL, initialized DString for
- * error return. */
+ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
switch (type) {
case DOTREE_F:
- if (TclpCopyFile(src, dst) == TCL_OK) {
+ if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {
return TCL_OK;
}
break;
case DOTREE_PRED:
- if (TclpCreateDirectory(dst) == TCL_OK) {
+ if (DoCreateDirectory(dstPtr) == TCL_OK) {
return TCL_OK;
}
break;
case DOTREE_POSTD:
- if (CopyFileAtts(src, dst, sbPtr) == TCL_OK) {
+ if (CopyFileAtts(Tcl_DStringValue(srcPtr),
+ Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) {
return TCL_OK;
}
break;
@@ -790,12 +929,13 @@ TraversalCopy(src, dst, sbPtr, type, errorPtr)
}
/*
- * There shouldn't be a problem with src, because we already
- * checked it to get here.
+ * There shouldn't be a problem with src, because we already checked it
+ * to get here.
*/
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, dst, -1);
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(dstPtr),
+ Tcl_DStringLength(dstPtr), errorPtr);
}
return TCL_ERROR;
}
@@ -820,62 +960,65 @@ TraversalCopy(src, dst, sbPtr, type, errorPtr)
*/
static int
-TraversalDelete(src, ignore, sbPtr, type, errorPtr)
- char *src; /* Source pathname. */
- char *ignore; /* Destination pathname (not used). */
- struct stat *sbPtr; /* Stat info for file specified by src. */
+TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr)
+ Tcl_DString *srcPtr; /* Source pathname (native). */
+ Tcl_DString *ignore; /* Destination pathname (not used). */
+ CONST struct stat *statBufPtr;
+ /* Stat info for file specified by srcPtr. */
int type; /* Reason for call - see TraverseUnixTree(). */
- Tcl_DString *errorPtr; /* If non-NULL, initialized DString for
- * error return. */
+ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
switch (type) {
- case DOTREE_F:
- if (unlink(src) == 0) {
+ case DOTREE_F: {
+ if (DoDeleteFile(srcPtr) == 0) {
return TCL_OK;
}
break;
-
- case DOTREE_PRED:
+ }
+ case DOTREE_PRED: {
return TCL_OK;
-
- case DOTREE_POSTD:
- if (rmdir(src) == 0) {
+ }
+ case DOTREE_POSTD: {
+ if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) {
return TCL_OK;
}
break;
-
+ }
}
-
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, src, -1);
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr),
+ Tcl_DStringLength(srcPtr), errorPtr);
}
return TCL_ERROR;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * CopyFileAtts
+ * CopyFileAtts --
*
- * Copy the file attributes such as owner, group, permissions, and
- * modification date from one file to another.
+ * Copy the file attributes such as owner, group, permissions,
+ * and modification date from one file to another.
*
* Results:
- * Standard Tcl result.
+ * Standard Tcl result.
*
* Side effects:
- * user id, group id, permission bits, last modification time, and
- * last access time are updated in the new file to reflect the old
- * file.
- *
- *----------------------------------------------------------------------
+ * user id, group id, permission bits, last modification time, and
+ * last access time are updated in the new file to reflect the
+ * old file.
+ *
+ *---------------------------------------------------------------------------
*/
static int
CopyFileAtts(src, dst, statBufPtr)
- char *src; /* Path name of source file */
- char *dst; /* Path name of target file */
- struct stat *statBufPtr; /* ptr to stat info for source file */
+ CONST char *src; /* Path name of source file (native). */
+ CONST char *dst; /* Path name of target file (native). */
+ CONST struct stat *statBufPtr;
+ /* Stat info for source file */
{
struct utimbuf tval;
mode_t newMode;
@@ -892,9 +1035,9 @@ CopyFileAtts(src, dst, statBufPtr)
* It would require another lstat(), or getuid().
*/
- if (chmod(dst, newMode)) {
+ if (chmod(dst, newMode)) { /* INTL: Native. */
newMode &= ~(S_ISUID | S_ISGID);
- if (chmod(dst, newMode)) {
+ if (chmod(dst, newMode)) { /* INTL: Native. */
return TCL_ERROR;
}
}
@@ -902,11 +1045,12 @@ CopyFileAtts(src, dst, statBufPtr)
tval.actime = statBufPtr->st_atime;
tval.modtime = statBufPtr->st_mtime;
- if (utime(dst, &tval)) {
+ if (utime(dst, &tval)) { /* INTL: Native. */
return TCL_ERROR;
}
return TCL_OK;
}
+
/*
*----------------------------------------------------------------------
@@ -929,24 +1073,31 @@ static int
GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr)
Tcl_Interp *interp; /* The interp we are using for errors. */
int objIndex; /* The index of the attribute. */
- char *fileName; /* The name of the file. */
+ CONST char *fileName; /* The name of the file (UTF-8). */
Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
{
struct stat statBuf;
struct group *groupPtr;
+ int result;
- if (TclStat(fileName, &statBuf) != 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not stat file \"", fileName, "\": ",
+ result = TclStat(fileName, &statBuf);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
- groupPtr = getgrgid(statBuf.st_gid);
+ groupPtr = getgrgid(statBuf.st_gid); /* INTL: Native. */
if (groupPtr == NULL) {
*attributePtrPtr = Tcl_NewIntObj(statBuf.st_gid);
} else {
- *attributePtrPtr = Tcl_NewStringObj(groupPtr->gr_name, -1);
+ Tcl_DString ds;
+ CONST char *utf;
+
+ utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds);
+ *attributePtrPtr = Tcl_NewStringObj(utf, -1);
+ Tcl_DStringFree(&ds);
}
endgrent();
return TCL_OK;
@@ -973,24 +1124,31 @@ static int
GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr)
Tcl_Interp *interp; /* The interp we are using for errors. */
int objIndex; /* The index of the attribute. */
- char *fileName; /* The name of the file. */
+ CONST char *fileName; /* The name of the file (UTF-8). */
Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
{
struct stat statBuf;
struct passwd *pwPtr;
+ int result;
- if (TclStat(fileName, &statBuf) != 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not stat file \"", fileName, "\": ",
+ result = TclStat(fileName, &statBuf);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
- pwPtr = getpwuid(statBuf.st_uid);
+ pwPtr = getpwuid(statBuf.st_uid); /* INTL: Native. */
if (pwPtr == NULL) {
*attributePtrPtr = Tcl_NewIntObj(statBuf.st_uid);
} else {
- *attributePtrPtr = Tcl_NewStringObj(pwPtr->pw_name, -1);
+ Tcl_DString ds;
+ CONST char *utf;
+
+ utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
+ *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
}
endpwent();
return TCL_OK;
@@ -1017,15 +1175,17 @@ static int
GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
Tcl_Interp *interp; /* The interp we are using for errors. */
int objIndex; /* The index of the attribute. */
- char *fileName; /* The name of the file. */
+ CONST char *fileName; /* The name of the file (UTF-8). */
Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
{
struct stat statBuf;
- char returnString[6];
+ char returnString[7];
+ int result;
- if (TclStat(fileName, &statBuf) != 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not stat file \"", fileName, "\": ",
+ result = TclStat(fileName, &statBuf);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1038,155 +1198,191 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * SetGroupAttribute
+ * SetGroupAttribute --
*
- * Sets the file to the given group.
+ * Sets the group of the file to the specified group.
*
* Results:
* Standard TCL result.
*
* Side effects:
- * The group of the file is changed.
+ * As above.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
static int
SetGroupAttribute(interp, objIndex, fileName, attributePtr)
- Tcl_Interp *interp; /* The interp we are using for errors. */
+ Tcl_Interp *interp; /* The interp for error reporting. */
int objIndex; /* The index of the attribute. */
- char *fileName; /* The name of the file. */
- Tcl_Obj *attributePtr; /* The attribute to set. */
+ CONST char *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj *attributePtr; /* New group for file. */
{
- gid_t groupNumber;
- long placeHolder;
+ long gid;
+ int result;
+ Tcl_DString ds;
+ CONST char *native;
- if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
+ if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
struct group *groupPtr;
- char *groupString = Tcl_GetStringFromObj(attributePtr, NULL);
+ CONST char *string;
+ int length;
+
+ string = Tcl_GetStringFromObj(attributePtr, &length);
+
+ native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
+ groupPtr = getgrnam(native); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
- Tcl_ResetResult(interp);
- groupPtr = getgrnam(groupString);
if (groupPtr == NULL) {
endgrent();
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not set group for file \"", fileName,
- "\": group \"", groupString, "\" does not exist",
+ Tcl_AppendResult(interp, "could not set group for file \"",
+ fileName, "\": group \"", string, "\" does not exist",
(char *) NULL);
return TCL_ERROR;
}
- groupNumber = groupPtr->gr_gid;
- } else {
- groupNumber = (gid_t) placeHolder;
+ gid = groupPtr->gr_gid;
}
- if (chown(fileName, -1, groupNumber) != 0) {
- endgrent();
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not set group for file \"", fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ endgrent();
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not set group for file \"",
+ fileName, "\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
- endgrent();
return TCL_OK;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * SetOwnerAttribute
+ * SetOwnerAttribute --
*
- * Sets the file to the given owner.
+ * Sets the owner of the file to the specified owner.
*
* Results:
* Standard TCL result.
*
* Side effects:
- * The group of the file is changed.
+ * As above.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
static int
SetOwnerAttribute(interp, objIndex, fileName, attributePtr)
- Tcl_Interp *interp; /* The interp we are using for errors. */
+ Tcl_Interp *interp; /* The interp for error reporting. */
int objIndex; /* The index of the attribute. */
- char *fileName; /* The name of the file. */
- Tcl_Obj *attributePtr; /* The attribute to set. */
+ CONST char *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj *attributePtr; /* New owner for file. */
{
- uid_t userNumber;
- long placeHolder;
+ long uid;
+ int result;
+ Tcl_DString ds;
+ CONST char *native;
- if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
+ if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
struct passwd *pwPtr;
- char *ownerString = Tcl_GetStringFromObj(attributePtr, NULL);
+ CONST char *string;
+ int length;
+
+ string = Tcl_GetStringFromObj(attributePtr, &length);
+
+ native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
+ pwPtr = getpwnam(native); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
- Tcl_ResetResult(interp);
- pwPtr = getpwnam(ownerString);
if (pwPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not set owner for file \"", fileName,
- "\": user \"", ownerString, "\" does not exist",
+ Tcl_AppendResult(interp, "could not set owner for file \"",
+ fileName, "\": user \"", string, "\" does not exist",
(char *) NULL);
return TCL_ERROR;
}
- userNumber = pwPtr->pw_uid;
- } else {
- userNumber = (uid_t) placeHolder;
+ uid = pwPtr->pw_uid;
}
- if (chown(fileName, userNumber, -1) != 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not set owner for file \"", fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not set owner for file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
- }
-
+ }
return TCL_OK;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* SetPermissionsAttribute
*
- * Sets the file to the given group.
+ * Sets the file to the given permission.
*
* Results:
* Standard TCL result.
*
* Side effects:
- * The group of the file is changed.
+ * The permission of the file is changed.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
static int
SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
Tcl_Interp *interp; /* The interp we are using for errors. */
int objIndex; /* The index of the attribute. */
- char *fileName; /* The name of the file. */
+ CONST char *fileName; /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr; /* The attribute to set. */
{
- long modeInt;
+ long mode;
mode_t newMode;
+ int result;
+ CONST char *native;
+ Tcl_DString ds;
/*
- * mode_t is a long under SPARC; an int under SunOS. Since we do not
- * know how big it really is, we get the long and then cast it
- * down to a mode_t.
+ * First try if the string is a number
*/
-
- if (Tcl_GetLongFromObj(interp, attributePtr, &modeInt)
- != TCL_OK) {
- return TCL_ERROR;
- }
+ if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
+ newMode = (mode_t) (mode & 0x00007FFF);
+ } else {
+ struct stat buf;
+ char *modeStringPtr = Tcl_GetString(attributePtr);
- newMode = (mode_t) modeInt;
+ /*
+ * Try the forms "rwxrwxrwx" and "ugo=rwx"
+ *
+ * We get the current mode of the file, in order to allow for
+ * ug+-=rwx style chmod strings.
+ */
+ result = TclStat(fileName, &buf);
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ newMode = (mode_t) (buf.st_mode & 0x00007FFF);
- if (chmod(fileName, newMode) != 0) {
+ if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown permission string format \"",
+ modeStringPtr, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ result = chmod(native, newMode); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+ if (result != 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not set permissions for file \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
@@ -1194,6 +1390,7 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
}
return TCL_OK;
}
+
/*
*---------------------------------------------------------------------------
*
@@ -1223,4 +1420,194 @@ TclpListVolumes(interp)
Tcl_SetStringObj(resultPtr, "/", 1);
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetModeFromPermString --
+ *
+ * This procedure is invoked to process the "file permissions"
+ * Tcl command, to check for a "rwxrwxrwx" or "ugoa+-=rwxst" string.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetModeFromPermString(interp, modeStringPtr, modePtr)
+ Tcl_Interp *interp; /* The interp we are using for errors. */
+ char *modeStringPtr; /* Permissions string */
+ mode_t *modePtr; /* pointer to the mode value */
+{
+ mode_t newMode;
+ mode_t oldMode; /* Storage for the value of the old mode
+ * (that is passed in), to allow for the
+ * chmod style manipulation */
+ int i,n, who, op, what, op_found, who_found;
+
+ /*
+ * We start off checking for an "rwxrwxrwx" style permissions string
+ */
+ if (strlen(modeStringPtr) != 9) {
+ goto chmodStyleCheck;
+ }
+
+ newMode = 0;
+ for (i = 0; i < 9; i++) {
+ switch (*(modeStringPtr+i)) {
+ case 'r':
+ if ((i%3) != 0) {
+ goto chmodStyleCheck;
+ }
+ newMode |= (1<<(8-i));
+ break;
+ case 'w':
+ if ((i%3) != 1) {
+ goto chmodStyleCheck;
+ }
+ newMode |= (1<<(8-i));
+ break;
+ case 'x':
+ if ((i%3) != 2) {
+ goto chmodStyleCheck;
+ }
+ newMode |= (1<<(8-i));
+ break;
+ case 's':
+ if (((i%3) != 2) || (i > 5)) {
+ goto chmodStyleCheck;
+ }
+ newMode |= (1<<(8-i));
+ newMode |= (1<<(11-(i/3)));
+ break;
+ case 'S':
+ if (((i%3) != 2) || (i > 5)) {
+ goto chmodStyleCheck;
+ }
+ newMode |= (1<<(11-(i/3)));
+ break;
+ case 't':
+ if (i != 8) {
+ goto chmodStyleCheck;
+ }
+ newMode |= (1<<(8-i));
+ newMode |= (1<<9);
+ break;
+ case 'T':
+ if (i != 8) {
+ goto chmodStyleCheck;
+ }
+ newMode |= (1<<9);
+ break;
+ case '-':
+ break;
+ default:
+ /*
+ * Oops, not what we thought it was, so go on
+ */
+ goto chmodStyleCheck;
+ }
+ }
+ *modePtr = newMode;
+ return TCL_OK;
+
+ chmodStyleCheck:
+ /*
+ * We now check for an "ugoa+-=rwxst" style permissions string
+ */
+
+ for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) {
+ oldMode = *modePtr;
+ who = op = what = op_found = who_found = 0;
+ for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) {
+ if (!who_found) {
+ /* who */
+ switch (*(modeStringPtr+n+i)) {
+ case 'u' :
+ who |= 0x9c0;
+ continue;
+ case 'g' :
+ who |= 0x438;
+ continue;
+ case 'o' :
+ who |= 0x207;
+ continue;
+ case 'a' :
+ who |= 0xfff;
+ continue;
+ }
+ }
+ who_found = 1;
+ if (who == 0) {
+ who = 0xfff;
+ }
+ if (!op_found) {
+ /* op */
+ switch (*(modeStringPtr+n+i)) {
+ case '+' :
+ op = 1;
+ op_found = 1;
+ continue;
+ case '-' :
+ op = 2;
+ op_found = 1;
+ continue;
+ case '=' :
+ op = 3;
+ op_found = 1;
+ continue;
+ default :
+ return TCL_ERROR;
+ break;
+ }
+ }
+ /* what */
+ switch (*(modeStringPtr+n+i)) {
+ case 'r' :
+ what |= 0x124;
+ continue;
+ case 'w' :
+ what |= 0x92;
+ continue;
+ case 'x' :
+ what |= 0x49;
+ continue;
+ case 's' :
+ what |= 0xc00;
+ continue;
+ case 't' :
+ what |= 0x200;
+ continue;
+ case ',' :
+ break;
+ default :
+ return TCL_ERROR;
+ break;
+ }
+ if (*(modeStringPtr+n+i) == ',') {
+ i++;
+ break;
+ }
+ }
+ switch (op) {
+ case 1 :
+ *modePtr = oldMode | (who & what);
+ continue;
+ case 2 :
+ *modePtr = oldMode & ~(who & what);
+ continue;
+ case 3 :
+ *modePtr = (oldMode & ~who) | (who & what);
+ continue;
+ }
+ }
+ return TCL_OK;
+}
+
diff --git a/tcl/unix/tclUnixFile.c b/tcl/unix/tclUnixFile.c
index d563f696127..3354644c87a 100644
--- a/tcl/unix/tclUnixFile.c
+++ b/tcl/unix/tclUnixFile.c
@@ -4,7 +4,7 @@
* This file contains wrappers around UNIX file handling functions.
* These wrappers mask differences between Windows and UNIX.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -15,227 +15,52 @@
#include "tclInt.h"
#include "tclPort.h"
-/*
- * The variable below caches the name of the current working directory
- * in order to avoid repeated calls to getcwd. The string is malloc-ed.
- * NULL means the cache needs to be refreshed.
- */
-
-static char *currentDir = NULL;
-static int currentDirExitHandlerSet = 0;
-
-/*
- * The variable below is set if the exit routine for deleting the string
- * containing the executable name has been registered.
- */
-
-static int executableNameExitHandlerSet = 0;
-
-extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
-
-/*
- * Static routines for this file:
- */
-
-static void FreeCurrentDir _ANSI_ARGS_((ClientData clientData));
-static void FreeExecutableName _ANSI_ARGS_((ClientData clientData));
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeCurrentDir --
- *
- * Frees the string stored in the currentDir variable. This routine
- * is registered as an exit handler and will be called during shutdown.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Frees the memory occuppied by the currentDir value.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static void
-FreeCurrentDir(clientData)
- ClientData clientData; /* Not used. */
-{
- if (currentDir != (char *) NULL) {
- ckfree(currentDir);
- currentDir = (char *) NULL;
- currentDirExitHandlerSet = 0;
- }
-}
/*
- *----------------------------------------------------------------------
- *
- * FreeExecutableName --
- *
- * Frees the string stored in the tclExecutableName variable. This
- * routine is registered as an exit handler and will be called
- * during shutdown.
+ *---------------------------------------------------------------------------
*
- * Results:
- * None.
- *
- * Side effects:
- * Frees the memory occuppied by the tclExecutableName value.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static void
-FreeExecutableName(clientData)
- ClientData clientData; /* Not used. */
-{
- if (tclExecutableName != (char *) NULL) {
- ckfree(tclExecutableName);
- tclExecutableName = (char *) NULL;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclChdir --
- *
- * Change the current working directory.
- *
- * Results:
- * The result is a standard Tcl result. If an error occurs and
- * interp isn't NULL, an error message is left in interp->result.
- *
- * Side effects:
- * The working directory for this application is changed. Also
- * the cache maintained used by TclGetCwd is deallocated and
- * set to NULL.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclChdir(interp, dirName)
- Tcl_Interp *interp; /* If non NULL, used for error reporting. */
- char *dirName; /* Path to new working directory. */
-{
- if (currentDir != NULL) {
- ckfree(currentDir);
- currentDir = NULL;
- }
- if (chdir(dirName) != 0) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
- }
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetCwd --
- *
- * Return the path name of the current working directory.
- *
- * Results:
- * The result is the full path name of the current working
- * directory, or NULL if an error occurred while figuring it out.
- * The returned string is owned by the TclGetCwd routine and must
- * not be freed by the caller. If an error occurs and interp
- * isn't NULL, an error message is left in interp->result.
- *
- * Side effects:
- * The path name is cached to avoid having to recompute it
- * on future calls; if it is already cached, the cached
- * value is returned.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-TclGetCwd(interp)
- Tcl_Interp *interp; /* If non NULL, used for error reporting. */
-{
- char buffer[MAXPATHLEN+1];
-
- if (currentDir == NULL) {
- if (!currentDirExitHandlerSet) {
- currentDirExitHandlerSet = 1;
- Tcl_CreateExitHandler(FreeCurrentDir, (ClientData) NULL);
- }
-#ifdef USEGETWD
- if ((int)getwd(buffer) == (int)NULL) {
- if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- buffer, (char *)NULL);
- }
- return NULL;
- }
-#else
- if (getcwd(buffer, MAXPATHLEN+1) == NULL) {
- if (interp != NULL) {
- if (errno == ERANGE) {
- Tcl_SetResult(interp,
- "working directory name is too long",
- TCL_STATIC);
- } else {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- }
- return NULL;
- }
-#endif
- currentDir = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
- strcpy(currentDir, buffer);
- }
- return currentDir;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FindExecutable --
+ * TclpFindExecutable --
*
* This procedure computes the absolute path name of the current
* application, given its argv[0] value.
*
* Results:
- * None.
+ * A dirty UTF string that is the path to the executable. At this
+ * point we may not know the system encoding. Convert the native
+ * string value to UTF using the default encoding. The assumption
+ * is that we will still be able to parse the path given the path
+ * name contains ASCII string and '/' chars do not conflict with
+ * other UTF chars.
*
* Side effects:
- * The variable tclExecutableName gets filled in with the file
+ * The variable tclNativeExecutableName gets filled in with the file
* name for the application, if we figured it out. If we couldn't
- * figure it out, Tcl_FindExecutable is set to NULL.
+ * figure it out, tclNativeExecutableName is set to NULL.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-void
-Tcl_FindExecutable(argv0)
- char *argv0; /* The value of the application's argv[0]. */
+char *
+TclpFindExecutable(argv0)
+ CONST char *argv0; /* The value of the application's argv[0]
+ * (native). */
{
- char *name, *p, *cwd;
- Tcl_DString buffer;
- int length;
+ CONST char *name, *p;
struct stat statBuf;
+ int length;
+ Tcl_DString buffer, nameString;
- Tcl_DStringInit(&buffer);
- if (tclExecutableName != NULL) {
- ckfree(tclExecutableName);
- tclExecutableName = NULL;
+ if (argv0 == NULL) {
+ return NULL;
+ }
+ if (tclNativeExecutableName != NULL) {
+ return tclNativeExecutableName;
}
+ Tcl_DStringInit(&buffer);
+
name = argv0;
- for (p = name; *p != 0; p++) {
+ for (p = name; *p != '\0'; p++) {
if (*p == '/') {
/*
* The name contains a slash, so use the name directly
@@ -246,7 +71,7 @@ Tcl_FindExecutable(argv0)
}
}
- p = getenv("PATH");
+ p = getenv("PATH"); /* INTL: Native. */
if (p == NULL) {
/*
* There's no PATH environment variable; use the default that
@@ -268,8 +93,8 @@ Tcl_FindExecutable(argv0)
* name.
*/
- while (*p != 0) {
- while (isspace(UCHAR(*p))) {
+ while (1) {
+ while (isspace(UCHAR(*p))) { /* INTL: BUG */
p++;
}
name = p;
@@ -278,19 +103,25 @@ Tcl_FindExecutable(argv0)
}
Tcl_DStringSetLength(&buffer, 0);
if (p != name) {
- Tcl_DStringAppend(&buffer, name, p-name);
+ Tcl_DStringAppend(&buffer, name, p - name);
if (p[-1] != '/') {
Tcl_DStringAppend(&buffer, "/", 1);
}
}
- Tcl_DStringAppend(&buffer, argv0, -1);
- if ((TclAccess(Tcl_DStringValue(&buffer), X_OK) == 0)
- && (TclStat(Tcl_DStringValue(&buffer), &statBuf) == 0)
+ name = Tcl_DStringAppend(&buffer, argv0, -1);
+
+ /*
+ * INTL: The following calls to access() and stat() should not be
+ * converted to Tclp routines because they need to operate on native
+ * strings directly.
+ */
+
+ if ((access(name, X_OK) == 0) /* INTL: Native. */
+ && (stat(name, &statBuf) == 0) /* INTL: Native. */
&& S_ISREG(statBuf.st_mode)) {
- name = Tcl_DStringValue(&buffer);
goto gotName;
}
- if (*p == 0) {
+ if (*p == '\0') {
break;
} else if (*(p+1) == 0) {
p = "./";
@@ -306,8 +137,11 @@ Tcl_FindExecutable(argv0)
gotName:
if (name[0] == '/') {
- tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1));
- strcpy(tclExecutableName, name);
+ Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
+ tclNativeExecutableName = (char *)
+ ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
+ strcpy(tclNativeExecutableName, Tcl_DStringValue(&nameString));
+ Tcl_DStringFree(&nameString);
goto done;
}
@@ -320,79 +154,36 @@ Tcl_FindExecutable(argv0)
if ((name[0] == '.') && (name[1] == '/')) {
name += 2;
}
- cwd = TclGetCwd((Tcl_Interp *) NULL);
- if (cwd == NULL) {
- tclExecutableName = NULL;
- goto done;
- }
- length = strlen(cwd);
- tclExecutableName = (char *) ckalloc((unsigned)
- (length + strlen(name) + 2));
- strcpy(tclExecutableName, cwd);
- tclExecutableName[length] = '/';
- strcpy(tclExecutableName + length + 1, name);
+ Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
+
+ Tcl_DStringFree(&buffer);
+ TclpGetCwd(NULL, &buffer);
+
+ length = Tcl_DStringLength(&buffer) + Tcl_DStringLength(&nameString) + 2;
+ tclNativeExecutableName = (char *) ckalloc((unsigned) length);
+ strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer));
+ tclNativeExecutableName[Tcl_DStringLength(&buffer)] = '/';
+ strcpy(tclNativeExecutableName + Tcl_DStringLength(&buffer) + 1,
+ Tcl_DStringValue(&nameString));
+ Tcl_DStringFree(&nameString);
+
done:
Tcl_DStringFree(&buffer);
-
- if (!executableNameExitHandlerSet) {
- executableNameExitHandlerSet = 1;
- Tcl_CreateExitHandler(FreeExecutableName, (ClientData) NULL);
- }
+ return tclNativeExecutableName;
}
/*
*----------------------------------------------------------------------
*
- * TclGetUserHome --
- *
- * This function takes the passed in user name and finds the
- * corresponding home directory specified in the password file.
- *
- * Results:
- * The result is a pointer to a static string containing
- * the new name. If there was an error in processing the
- * user name then the return value is NULL. Otherwise the
- * result is stored in bufferPtr, and the caller must call
- * Tcl_DStringFree(bufferPtr) to free the result.
- *
- * Side effects:
- * Information may be left in bufferPtr.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-TclGetUserHome(name, bufferPtr)
- char *name; /* User name to use to find home directory. */
- Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold
- * anything at the time of the call, and need
- * not even be initialized. */
-{
- struct passwd *pwPtr;
-
- pwPtr = getpwnam(name);
- if (pwPtr == NULL) {
- endpwent();
- return NULL;
- }
- Tcl_DStringInit(bufferPtr);
- Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);
- endpwent();
- return bufferPtr->string;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclMatchFiles --
+ * TclpMatchFilesTypes --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
* If the tail argument is NULL, then the matching files are
- * added to the interp->result. Otherwise, TclDoGlob is called
+ * added to the the interp's result. Otherwise, TclDoGlob is called
* recursively for each matching subdirectory. The return value
* is a standard Tcl result indicating whether an error occurred
* in globbing.
@@ -404,22 +195,26 @@ TclGetUserHome(name, bufferPtr)
*/
int
-TclMatchFiles(interp, separators, dirPtr, pattern, tail)
+TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types)
Tcl_Interp *interp; /* Interpreter to receive results. */
- char *separators; /* Path separators to pass to TclDoGlob. */
+ char *separators; /* Directory separators to pass to TclDoGlob */
Tcl_DString *dirPtr; /* Contains path to directory to search. */
char *pattern; /* Pattern to match against. */
- char *tail; /* Pointer to end of pattern. */
+ char *tail; /* Pointer to end of pattern. Tail must
+ * point to a location in pattern and must
+ * not be static. */
+ GlobTypeData *types; /* Object containing list of acceptable types.
+ * May be NULL. */
{
- char *dirName, *patternEnd = tail;
- char savedChar = 0; /* Initialization needed only to prevent
- * compiler warning from gcc. */
+ char *native, *fname, *dirName, *patternEnd = tail;
+ char savedChar = 0; /* lint. */
DIR *d;
+ Tcl_DString ds;
struct stat statBuf;
- struct dirent *entryPtr;
int matchHidden;
int result = TCL_OK;
int baseLength = Tcl_DStringLength(dirPtr);
+ Tcl_Obj *resultPtr;
/*
* Make sure that the directory part of the name really is a
@@ -429,12 +224,14 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* otherwise "glob foo.c" would return "./foo.c".
*/
- if (dirPtr->string[0] == '\0') {
+ if (Tcl_DStringLength(dirPtr) == 0) {
dirName = ".";
} else {
- dirName = dirPtr->string;
+ dirName = Tcl_DStringValue(dirPtr);
}
- if ((TclStat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
+
+ if ((TclpStat(dirName, &statBuf) != 0) /* INTL: UTF-8. */
+ || !S_ISDIR(statBuf.st_mode)) {
return TCL_OK;
}
@@ -453,7 +250,9 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* Now open the directory for reading and iterate over the contents.
*/
- d = opendir(dirName);
+ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
+ d = opendir(native); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
if (d == NULL) {
Tcl_ResetResult(interp);
@@ -462,15 +261,16 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
*/
if (baseLength > 0) {
- savedChar = dirPtr->string[baseLength-1];
+ savedChar = (Tcl_DStringValue(dirPtr))[baseLength-1];
if (savedChar == '/') {
- dirPtr->string[baseLength-1] = '\0';
+ (Tcl_DStringValue(dirPtr))[baseLength-1] = '\0';
}
}
Tcl_AppendResult(interp, "couldn't read directory \"",
- dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_DStringValue(dirPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
if (baseLength > 0) {
- dirPtr->string[baseLength-1] = savedChar;
+ (Tcl_DStringValue(dirPtr))[baseLength-1] = savedChar;
}
return TCL_ERROR;
}
@@ -493,18 +293,29 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
savedChar = *patternEnd;
*patternEnd = '\0';
+ resultPtr = Tcl_GetObjResult(interp);
while (1) {
- entryPtr = readdir(d);
+ char *utf;
+ struct dirent *entryPtr;
+
+ entryPtr = readdir(d); /* INTL: Native. */
if (entryPtr == NULL) {
break;
}
- /*
- * Don't match names starting with "." unless the "." is
- * present in the pattern.
- */
-
- if (!matchHidden && (*entryPtr->d_name == '.')) {
+ if (types != NULL && (types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ /*
+ * We explicitly asked for hidden files, so turn around
+ * and ignore any file which isn't hidden.
+ */
+ if (*entryPtr->d_name != '.') {
+ continue;
+ }
+ } else if (!matchHidden && (*entryPtr->d_name == '.')) {
+ /*
+ * Don't match names starting with "." unless the "." is
+ * present in the pattern.
+ */
continue;
}
@@ -515,23 +326,372 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* the file to the result.
*/
- if (Tcl_StringMatch(entryPtr->d_name, pattern)) {
+ utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &ds);
+ if (Tcl_StringMatch(utf, pattern) != 0) {
Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, entryPtr->d_name, -1);
+ Tcl_DStringAppend(dirPtr, utf, -1);
+ fname = Tcl_DStringValue(dirPtr);
if (tail == NULL) {
- Tcl_AppendElement(interp, dirPtr->string);
- } else if ((TclStat(dirPtr->string, &statBuf) == 0)
+ int typeOk = 1;
+ if (types != NULL) {
+ if (types->perm != 0) {
+ struct stat buf;
+
+ if (TclpStat(fname, &buf) != 0) {
+ panic("stat failed on known file");
+ }
+ /*
+ * readonly means that there are NO write permissions
+ * (even for user), but execute is OK for anybody
+ */
+ if (
+ ((types->perm & TCL_GLOB_PERM_RONLY) &&
+ (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (TclpAccess(fname, R_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (TclpAccess(fname, W_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (TclpAccess(fname, X_OK) != 0))
+ ) {
+ typeOk = 0;
+ }
+ }
+ if (typeOk && (types->type != 0)) {
+ struct stat buf;
+ /*
+ * We must match at least one flag to be listed
+ */
+ typeOk = 0;
+ if (TclpLstat(fname, &buf) >= 0) {
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
+ if (
+ ((types->type & TCL_GLOB_TYPE_BLOCK) &&
+ S_ISBLK(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_CHAR) &&
+ S_ISCHR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_DIR) &&
+ S_ISDIR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_PIPE) &&
+ S_ISFIFO(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_FILE) &&
+ S_ISREG(buf.st_mode))
+#ifdef S_ISLNK
+ || ((types->type & TCL_GLOB_TYPE_LINK) &&
+ S_ISLNK(buf.st_mode))
+#endif
+#ifdef S_ISSOCK
+ || ((types->type & TCL_GLOB_TYPE_SOCK) &&
+ S_ISSOCK(buf.st_mode))
+#endif
+ ) {
+ typeOk = 1;
+ }
+ } else {
+ /* Posix error occurred */
+ }
+ }
+ }
+ if (typeOk) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fname,
+ Tcl_DStringLength(dirPtr)));
+ }
+ } else if ((TclpStat(fname, &statBuf) == 0)
&& S_ISDIR(statBuf.st_mode)) {
Tcl_DStringAppend(dirPtr, "/", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail);
+ result = TclDoGlob(interp, separators, dirPtr, tail, types);
if (result != TCL_OK) {
+ Tcl_DStringFree(&ds);
break;
}
}
}
+ Tcl_DStringFree(&ds);
}
*patternEnd = savedChar;
closedir(d);
return result;
}
+
+/*
+ * TclpMatchFiles --
+ *
+ * This function is now obsolete. Call the above function
+ * 'TclpMatchFilesTypes' instead.
+ */
+int
+TclpMatchFiles(interp, separators, dirPtr, pattern, tail)
+ Tcl_Interp *interp; /* Interpreter to receive results. */
+ char *separators; /* Directory separators to pass to TclDoGlob */
+ Tcl_DString *dirPtr; /* Contains path to directory to search. */
+ char *pattern; /* Pattern to match against. */
+ char *tail; /* Pointer to end of pattern. Tail must
+ * point to a location in pattern and must
+ * not be static. */
+{
+ return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpGetUserHome --
+ *
+ * This function takes the specified user name and finds their
+ * home directory.
+ *
+ * Results:
+ * The result is a pointer to a string specifying the user's home
+ * directory, or NULL if the user's home directory could not be
+ * determined. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetUserHome(name, bufferPtr)
+ CONST char *name; /* User name for desired home directory. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name of user's home directory. */
+{
+ struct passwd *pwPtr;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
+ pwPtr = getpwnam(native); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ if (pwPtr == NULL) {
+ endpwent();
+ return NULL;
+ }
+ Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
+ endpwent();
+ return Tcl_DStringValue(bufferPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpAccess --
+ *
+ * This function replaces the library version of access().
+ *
+ * Results:
+ * See access() documentation.
+ *
+ * Side effects:
+ * See access() documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpAccess(path, mode)
+ CONST char *path; /* Path of file to access (UTF-8). */
+ int mode; /* Permission setting. */
+{
+ int result;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ result = access(native, mode); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpChdir --
+ *
+ * This function replaces the library version of chdir().
+ *
+ * Results:
+ * See chdir() documentation.
+ *
+ * Side effects:
+ * See chdir() documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpChdir(dirName)
+ CONST char *dirName; /* Path to new working directory (UTF-8). */
+{
+ int result;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
+ result = chdir(native); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpLstat --
+ *
+ * This function replaces the library version of lstat().
+ *
+ * Results:
+ * See lstat() documentation.
+ *
+ * Side effects:
+ * See lstat() documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpLstat(path, bufPtr)
+ CONST char *path; /* Path of file to stat (UTF-8). */
+ struct stat *bufPtr; /* Filled with results of stat call. */
+{
+ int result;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ result = lstat(native, bufPtr); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpGetCwd --
+ *
+ * This function replaces the library version of getcwd().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the current
+ * directory, or NULL if the current directory could not be
+ * determined. If NULL is returned, an error message is left in the
+ * interp's result. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetCwd(interp, bufferPtr)
+ Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name of current directory. */
+{
+ char buffer[MAXPATHLEN+1];
+
+#ifdef USEGETWD
+ if (getwd(buffer) == NULL) { /* INTL: Native. */
+#else
+ if (getcwd(buffer, MAXPATHLEN + 1) == NULL) { /* INTL: Native. */
+#endif
+ if (interp != NULL) {
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return NULL;
+ }
+ return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpReadlink --
+ *
+ * This function replaces the library version of readlink().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the contents
+ * of the symbolic link given by 'path', or NULL if the symbolic
+ * link could not be read. Storage for the result string is
+ * allocated in bufferPtr; the caller must call Tcl_DStringFree()
+ * when the result is no longer needed.
+ *
+ * Side effects:
+ * See readlink() documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclpReadlink(path, linkPtr)
+ CONST char *path; /* Path of file to readlink (UTF-8). */
+ Tcl_DString *linkPtr; /* Uninitialized or free DString filled
+ * with contents of link (UTF-8). */
+{
+ char link[MAXPATHLEN];
+ int length;
+ char *native;
+ Tcl_DString ds;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ length = readlink(native, link, sizeof(link)); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ if (length < 0) {
+ return NULL;
+ }
+
+ Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
+ return Tcl_DStringValue(linkPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpStat --
+ *
+ * This function replaces the library version of stat().
+ *
+ * Results:
+ * See stat() documentation.
+ *
+ * Side effects:
+ * See stat() documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpStat(path, bufPtr)
+ CONST char *path; /* Path of file to stat (in UTF-8). */
+ struct stat *bufPtr; /* Filled with results of stat call. */
+{
+ int result;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ result = stat(native, bufPtr); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ return result;
+}
+
+
diff --git a/tcl/unix/tclUnixInit.c b/tcl/unix/tclUnixInit.c
index 81217250d38..e1d89af4e05 100644
--- a/tcl/unix/tclUnixInit.c
+++ b/tcl/unix/tclUnixInit.c
@@ -3,16 +3,16 @@
*
* Contains the Unix-specific interpreter initialization functions.
*
- * 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.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ * All rights reserved.
*
* RCS: @(#) $Id$
*/
#include "tclInt.h"
#include "tclPort.h"
+#include <locale.h>
#if defined(__FreeBSD__)
# include <floatingpoint.h>
#endif
@@ -24,6 +24,13 @@
#endif
/*
+ * The Init script (common to Windows and Unix platforms) is
+ * defined in tkInitScript.h
+ */
+#include "tclInitScript.h"
+
+
+/*
* Default directory in which to look for Tcl library scripts. The
* symbol is defined by Makefile.
*/
@@ -39,87 +46,508 @@ static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY;
static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
/*
- * Is this module initialized?
+ * The following table is used to map from Unix locale strings to
+ * encoding files.
*/
-static int initialized = 0;
+typedef struct LocaleTable {
+ CONST char *lang;
+ CONST char *encoding;
+} LocaleTable;
+static CONST LocaleTable localeTable[] = {
+ {"ja_JP.SJIS", "shiftjis"},
+ {"ja_JP.EUC", "euc-jp"},
+ {"ja_JP.JIS", "iso2022-jp"},
+ {"ja_JP.mscode", "shiftjis"},
+ {"ja_JP.ujis", "euc-jp"},
+ {"ja_JP", "euc-jp"},
+ {"Ja_JP", "shiftjis"},
+ {"Jp_JP", "shiftjis"},
+ {"japan", "euc-jp"},
+#ifdef hpux
+ {"japanese", "shiftjis"},
+ {"ja", "shiftjis"},
+#else
+ {"japanese", "euc-jp"},
+ {"ja", "euc-jp"},
+#endif
+ {"japanese.sjis", "shiftjis"},
+ {"japanese.euc", "euc-jp"},
+ {"japanese-sjis", "shiftjis"},
+ {"japanese-ujis", "euc-jp"},
+
+ {"ko", "euc-kr"},
+ {"ko_KR", "euc-kr"},
+ {"ko_KR.EUC", "euc-kr"},
+ {"ko_KR.euc", "euc-kr"},
+ {"ko_KR.eucKR", "euc-kr"},
+ {"korean", "euc-kr"},
+
+ {"ru", "iso8859-5"},
+ {"ru_RU", "iso8859-5"},
+ {"ru_SU", "iso8859-5"},
+
+ {"zh", "cp936"},
+
+ {NULL, NULL}
+};
+
/*
- * The Init script, tclPreInitScript variable, and the routine
- * TclSetPreInitScript (common to Windows and Unix platforms) are defined
- * in generic/tclInitScript.h.
+ *---------------------------------------------------------------------------
+ *
+ * TclpInitPlatform --
+ *
+ * Initialize all the platform-dependant things like signals and
+ * floating-point error handling.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
*/
-#include "tclInitScript.h"
+void
+TclpInitPlatform()
+{
+ tclPlatform = TCL_PLATFORM_UNIX;
+ /*
+ * The code below causes SIGPIPE (broken pipe) errors to
+ * be ignored. This is needed so that Tcl processes don't
+ * die if they create child processes (e.g. using "exec" or
+ * "open") that terminate prematurely. The signal handler
+ * is only set up when the first interpreter is created;
+ * after this the application can override the handler with
+ * a different one of its own, if it wants.
+ */
+
+#ifdef SIGPIPE
+ (void) signal(SIGPIPE, SIG_IGN);
+#endif /* SIGPIPE */
+
+#ifdef __FreeBSD__
+ fpsetround(FP_RN);
+ fpsetmask(0L);
+#endif
+
+#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
+ /*
+ * Find local symbols. Don't report an error if we fail.
+ */
+ (void) dlopen (NULL, RTLD_NOW); /* INTL: Native. */
+#endif
+}
+
/*
- * Static routines in this file:
+ *---------------------------------------------------------------------------
+ *
+ * TclpInitLibraryPath --
+ *
+ * Initialize the library path at startup. We have a minor
+ * metacircular problem that we don't know the encoding of the
+ * operating system but we may need to talk to operating system
+ * to find the library directories so that we know how to talk to
+ * the operating system.
+ *
+ * We do not know the encoding of the operating system.
+ * We do know that the encoding is some multibyte encoding.
+ * In that multibyte encoding, the characters 0..127 are equivalent
+ * to ascii.
+ *
+ * So although we don't know the encoding, it's safe:
+ * to look for the last slash character in a path in the encoding.
+ * to append an ascii string to a path.
+ * to pass those strings back to the operating system.
+ *
+ * But any strings that we remembered before we knew the encoding of
+ * the operating system must be translated to UTF-8 once we know the
+ * encoding so that the rest of Tcl can use those strings.
+ *
+ * This call sets the library path to strings in the unknown native
+ * encoding. TclpSetInitialEncodings() will translate the library
+ * path from the native encoding to UTF-8 as soon as it determines
+ * what the native encoding actually is.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
*/
-static void PlatformInitExitHandler _ANSI_ARGS_((ClientData clientData));
+void
+TclpInitLibraryPath(path)
+CONST char *path; /* Path to the executable in native
+ * multi-byte encoding. */
+{
+#define LIBRARY_SIZE 32
+ Tcl_Obj *pathPtr, *objPtr;
+ char *str;
+ Tcl_DString buffer, ds;
+ int pathc;
+ char **pathv;
+ char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
+
+ Tcl_DStringInit(&ds);
+ pathPtr = Tcl_NewObj();
+
+ /*
+ * Initialize the substrings used when locating an executable. The
+ * installLib variable computes the path as though the executable
+ * is installed. The developLib computes the path as though the
+ * executable is run from a develpment directory.
+ */
+
+ /* CYGNUS LOCAL */
+ sprintf(installLib, "share/tcl%s", TCL_VERSION);
+ /* END CYGNUS LOCAL */
+ sprintf(developLib, "tcl%s/library",
+ ((TCL_RELEASE_LEVEL < 2) ? TCL_PATCH_LEVEL : TCL_VERSION));
+
+ /*
+ * Look for the library relative to default encoding dir.
+ */
+
+ str = Tcl_GetDefaultEncodingDir();
+ if ((str != NULL) && (str[0] != '\0')) {
+ objPtr = Tcl_NewStringObj(str, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ }
+
+ /*
+ * Look for the library relative to the TCL_LIBRARY env variable.
+ * If the last dirname in the TCL_LIBRARY path does not match the
+ * last dirname in the installLib variable, use the last dir name
+ * of installLib in addition to the orginal TCL_LIBRARY path.
+ */
+
+ str = getenv("TCL_LIBRARY"); /* INTL: Native. */
+ Tcl_ExternalToUtfDString(NULL, str, -1, &buffer);
+ str = Tcl_DStringValue(&buffer);
+
+ if ((str != NULL) && (str[0] != '\0')) {
+ /*
+ * If TCL_LIBRARY is set, search there.
+ */
+
+ objPtr = Tcl_NewStringObj(str, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+
+ Tcl_SplitPath(str, &pathc, &pathv);
+ if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
+ /*
+ * If TCL_LIBRARY is set but refers to a different tcl
+ * installation than the current version, try fiddling with the
+ * specified directory to make it refer to this installation by
+ * removing the old "tclX.Y" and substituting the current
+ * version string.
+ */
+
+ pathv[pathc - 1] = installLib + 4;
+ str = Tcl_JoinPath(pathc, pathv, &ds);
+ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ ckfree((char *) pathv);
+ }
+
+ /*
+ * Look for the library relative to the executable. This algorithm
+ * should be the same as the one in the tcl_findLibrary procedure.
+ *
+ * This code looks in the following directories:
+ *
+ * <bindir>/../<installLib>
+ * (e.g. /usr/local/bin/../lib/tcl8.2)
+ * <bindir>/../../<installLib>
+ * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.2)
+ * <bindir>/../library
+ * (e.g. /usr/src/tcl8.2/unix/../library)
+ * <bindir>/../../library
+ * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../library)
+ * <bindir>/../../<developLib>
+ * (e.g. /usr/src/tcl8.2/unix/../../tcl8.2/library)
+ * <bindir>/../../../<devlopLib>
+ * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library)
+ */
+
+ if (path != NULL) {
+ Tcl_SplitPath(path, &pathc, &pathv);
+ if (pathc > 1) {
+ pathv[pathc - 2] = installLib;
+ path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 2) {
+ pathv[pathc - 3] = installLib;
+ path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 1) {
+ pathv[pathc - 2] = "library";
+ path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 2) {
+ pathv[pathc - 3] = "library";
+ path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 1) {
+ pathv[pathc - 3] = developLib;
+ path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 3) {
+ pathv[pathc - 4] = developLib;
+ path = Tcl_JoinPath(pathc - 3, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ ckfree((char *) pathv);
+ }
+
+ /*
+ * Finally, look for the library relative to the compiled-in path.
+ * This is needed when users install Tcl with an exec-prefix that
+ * is different from the prtefix.
+ */
+
+ str = defaultLibraryDir;
+ if (str[0] != '\0') {
+ objPtr = Tcl_NewStringObj(str, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ }
+
+ TclSetLibraryPath(pathPtr);
+ Tcl_DStringFree(&buffer);
+}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
+ *
+ * TclpSetInitialEncodings --
*
- * PlatformInitExitHandler --
+ * Based on the locale, determine the encoding of the operating
+ * system and the default encoding for newly opened files.
*
- * Uninitializes all values on unload, so that this module can
- * be later reinitialized.
+ * Called at process initialization time.
*
* Results:
* None.
*
* Side effects:
- * Returns the module to uninitialized state.
+ * The Tcl library path is converted from native encoding to UTF-8.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-static void
-PlatformInitExitHandler(clientData)
- ClientData clientData; /* Unused. */
+void
+TclpSetInitialEncodings()
{
- initialized = 0;
+ CONST char *encoding;
+ int i;
+ Tcl_Obj *pathPtr;
+ char *langEnv;
+
+ /*
+ * Determine the current encoding from the LC_* or LANG environment
+ * variables. We previously used setlocale() to determine the locale,
+ * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
+ */
+
+ langEnv = getenv("LC_ALL");
+
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = getenv("LC_CTYPE");
+ }
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = getenv("LANG");
+ }
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = NULL;
+ }
+
+ encoding = NULL;
+ if (langEnv != NULL) {
+ for (i = 0; localeTable[i].lang != NULL; i++) {
+ if (strcmp(localeTable[i].lang, langEnv) == 0) {
+ encoding = localeTable[i].encoding;
+ break;
+ }
+ }
+ /*
+ * There was no mapping in the locale table. If there is an
+ * encoding subfield, we can try to guess from that.
+ */
+
+ if (encoding == NULL) {
+ char *p;
+ for (p = langEnv; *p != '\0'; p++) {
+ if (*p == '.') {
+ p++;
+ break;
+ }
+ }
+ if (*p != '\0') {
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, p, -1);
+
+ encoding = Tcl_DStringValue(&ds);
+ Tcl_UtfToLower(Tcl_DStringValue(&ds));
+ if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) {
+ Tcl_DStringFree(&ds);
+ goto resetPath;
+ }
+ Tcl_DStringFree(&ds);
+ encoding = NULL;
+ }
+ }
+ }
+ if (encoding == NULL) {
+ encoding = "iso8859-1";
+ }
+
+ Tcl_SetSystemEncoding(NULL, encoding);
+
+ resetPath:
+ /*
+ * Initialize the C library's locale subsystem. This is required
+ * for input methods to work properly on X11. We only do this for
+ * LC_CTYPE because that's the necessary one, and we don't want to
+ * affect LC_TIME here. The side effect of setting the default locale
+ * should be to load any locale specific modules that are needed by X.
+ * [BUG: 5422 3345 4236 2522 2521].
+ */
+
+ setlocale(LC_CTYPE, "");
+
+ /*
+ * In case the initial locale is not "C", ensure that the numeric
+ * processing is done in "C" locale regardless. This is needed because
+ * Tcl relies on routines like strtod, but should not have locale
+ * dependent behavior.
+ */
+
+ setlocale(LC_NUMERIC, "C");
+
+ /*
+ * Until the system encoding was actually set, the library path was
+ * actually in the native multi-byte encoding, and not really UTF-8
+ * as advertised. We cheated as follows:
+ *
+ * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
+ * append the ASCII chars that make up the encoding's filename to
+ * the names (in the native encoding) of directories in the library
+ * path, since all Unix multi-byte encodings have ASCII in the
+ * beginning.
+ *
+ * 2. To open the encoding file, the native bytes in the file name
+ * were passed to the OS, without translating from UTF-8 to native,
+ * because the name was already in the native encoding.
+ *
+ * Now that the system encoding was actually successfully set,
+ * translate all the names in the library path to UTF-8. That way,
+ * next time we search the library path, we'll translate the names
+ * from UTF-8 to the system encoding which will be the native
+ * encoding.
+ */
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int objc;
+ Tcl_Obj **objv;
+
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ for (i = 0; i < objc; i++) {
+ int length;
+ char *string;
+ Tcl_DString ds;
+
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ }
+
+ /*
+ * Keep the iso8859-1 encoding preloaded. The IO package uses it for
+ * gets on a binary channel.
+ */
+
+ Tcl_GetEncoding(NULL, "iso8859-1");
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclPlatformInit --
+ * TclpSetVariables --
*
- * Performs Unix-specific interpreter initialization related to the
- * tcl_library and tcl_platform variables, and other platform-
+ * Performs platform-specific interpreter initialization related to
+ * the tcl_library and tcl_platform variables, and other platform-
* specific things.
*
* Results:
* None.
*
* Side effects:
- * Sets "tcl_library" and "tcl_platform" Tcl variables.
+ * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl
+ * variables.
*
*----------------------------------------------------------------------
*/
void
-TclPlatformInit(interp)
+TclpSetVariables(interp)
Tcl_Interp *interp;
{
#ifndef NO_UNAME
struct utsname name;
#endif
int unameOK;
+ char *user;
+ Tcl_DString ds;
- tclPlatform = TCL_PLATFORM_UNIX;
- Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir,
- TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
unameOK = 0;
#ifndef NO_UNAME
if (uname(&name) >= 0) {
+ char *native;
+
unameOK = 1;
- Tcl_SetVar2(interp, "tcl_platform", "os", name.sysname,
- TCL_GLOBAL_ONLY);
+
+ native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds);
+ Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&ds);
+
/*
* The following code is a special hack to handle differences in
* the way version information is returned by uname. On most
@@ -129,7 +557,7 @@ TclPlatformInit(interp)
*/
if ((strchr(name.release, '.') != NULL)
- || !isdigit(UCHAR(name.version[0]))) {
+ || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
TCL_GLOBAL_ONLY);
} else {
@@ -150,42 +578,79 @@ TclPlatformInit(interp)
Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
}
- if (!initialized) {
+ /*
+ * Copy USER or LOGNAME environment variable into tcl_platform(user)
+ */
- /*
- * Create an exit handler so that uninitialization will be done
- * on unload.
- */
-
- Tcl_CreateExitHandler(PlatformInitExitHandler, NULL);
-
- /*
- * The code below causes SIGPIPE (broken pipe) errors to
- * be ignored. This is needed so that Tcl processes don't
- * die if they create child processes (e.g. using "exec" or
- * "open") that terminate prematurely. The signal handler
- * is only set up when the first interpreter is created;
- * after this the application can override the handler with
- * a different one of its own, if it wants.
- */
-
-#ifdef SIGPIPE
- (void) signal(SIGPIPE, SIG_IGN);
-#endif /* SIGPIPE */
+ Tcl_DStringInit(&ds);
+ user = TclGetEnv("USER", &ds);
+ if (user == NULL) {
+ user = TclGetEnv("LOGNAME", &ds);
+ if (user == NULL) {
+ user = "";
+ }
+ }
+ Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&ds);
-#ifdef __FreeBSD__
- fpsetround(FP_RN);
- fpsetmask(0L);
-#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFindVariable --
+ *
+ * Locate the entry in environ for a given name. On Unix this
+ * routine is case sensetive, on Windows this matches mixed case.
+ *
+ * Results:
+ * The return value is the index in environ of an entry with the
+ * name "name", or -1 if there is no such entry. The integer at
+ * *lengthPtr is filled in with the length of name (if a matching
+ * entry is found) or the length of the environ array (if no matching
+ * entry is found).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
-#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
- /*
- * Find local symbols. Don't report an error if we fail.
- */
- (void) dlopen (NULL, RTLD_NOW);
-#endif
- initialized = 1;
+int
+TclpFindVariable(name, lengthPtr)
+ CONST char *name; /* Name of desired environment variable
+ * (native). */
+ int *lengthPtr; /* Used to return length of name (for
+ * successful searches) or number of non-NULL
+ * entries in environ (for unsuccessful
+ * searches). */
+{
+ int i, result = -1;
+ register CONST char *env, *p1, *p2;
+ Tcl_DString envString;
+
+ Tcl_DStringInit(&envString);
+ for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
+ p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
+ p2 = name;
+
+ for (; *p2 == *p1; p1++, p2++) {
+ /* NULL loop body. */
+ }
+ if ((*p1 == '=') && (*p2 == '\0')) {
+ *lengthPtr = p2 - name;
+ result = i;
+ goto done;
+ }
+
+ Tcl_DStringFree(&envString);
}
+
+ *lengthPtr = i;
+
+ done:
+ Tcl_DStringFree(&envString);
+ return result;
}
/*
@@ -194,12 +659,12 @@ TclPlatformInit(interp)
* Tcl_Init --
*
* This procedure is typically invoked by Tcl_AppInit procedures
- * to perform additional initialization for a Tcl interpreter,
- * such as sourcing the "init.tcl" script.
+ * to find and source the "init.tcl" script, which should exist
+ * somewhere on the Tcl library path.
*
* Results:
- * Returns a standard Tcl completion code and sets interp->result
- * if there is an error.
+ * Returns a standard Tcl completion code and sets the interp's
+ * result if there is an error.
*
* Side effects:
* Depends on what's in the init.tcl script.
@@ -211,12 +676,20 @@ int
Tcl_Init(interp)
Tcl_Interp *interp; /* Interpreter to initialize. */
{
+ Tcl_Obj *pathPtr;
+
if (tclPreInitScript != NULL) {
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
return (TCL_ERROR);
};
}
- return(Tcl_Eval(interp, initScript));
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr == NULL) {
+ pathPtr = Tcl_NewObj();
+ }
+ Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
+ return Tcl_Eval(interp, initScript);
}
/*
@@ -271,8 +744,8 @@ Tcl_SourceRCFile(interp)
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
}
}
@@ -280,3 +753,31 @@ Tcl_SourceRCFile(interp)
Tcl_DStringFree(&temp);
}
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCheckStackSpace --
+ *
+ * Detect if we are about to blow the stack. Called before an
+ * evaluation can happen when nesting depth is checked.
+ *
+ * Results:
+ * 1 if there is enough stack space to continue; 0 if not.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpCheckStackSpace()
+{
+ /*
+ * This function is unimplemented on Unix platforms.
+ */
+
+ return 1;
+}
+
diff --git a/tcl/unix/tclUnixNotfy.c b/tcl/unix/tclUnixNotfy.c
index b2f163cb01f..38ca5f4d067 100644
--- a/tcl/unix/tclUnixNotfy.c
+++ b/tcl/unix/tclUnixNotfy.c
@@ -18,6 +18,8 @@
#include "tclPort.h"
#include <signal.h>
+extern TclStubs tclStubs;
+
/*
* This structure is used to keep track of the notifier info for a
* a registered file.
@@ -53,10 +55,11 @@ typedef struct FileHandlerEvent {
/*
* The following static structure contains the state information for the
- * select based implementation of the Tcl notifier.
+ * select based implementation of the Tcl notifier. One of these structures
+ * is created for each thread that is using the notifier.
*/
-static struct {
+typedef struct ThreadSpecificData {
FileHandler *firstFileHandlerPtr;
/* Pointer to head of file handler list. */
fd_mask checkMasks[3*MASK_SIZE];
@@ -71,70 +74,255 @@ static struct {
int numFdBits; /* Number of valid bits in checkMasks
* (one more than highest fd for which
* Tcl_WatchFile has been called). */
-} notifier;
+#ifdef TCL_THREADS
+ int onList; /* True if it is in this list */
+ unsigned int pollState; /* pollState is used to implement a polling
+ * handshake between each thread and the
+ * notifier thread. Bits defined below. */
+ struct ThreadSpecificData *nextPtr, *prevPtr;
+ /* All threads that are currently waiting on
+ * an event have their ThreadSpecificData
+ * structure on a doubly-linked listed formed
+ * from these pointers. You must hold the
+ * notifierMutex lock before accessing these
+ * fields. */
+ Tcl_Condition waitCV; /* Any other thread alerts a notifier
+ * that an event is ready to be processed
+ * by signaling this condition variable. */
+ int eventReady; /* True if an event is ready to be processed.
+ * Used as condition flag together with
+ * waitCV above. */
+#endif
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+#ifdef TCL_THREADS
+/*
+ * The following static indicates the number of threads that have
+ * initialized notifiers.
+ *
+ * You must hold the notifierMutex lock before accessing this variable.
+ */
+
+static int notifierCount = 0;
+
+/*
+ * The following variable points to the head of a doubly-linked list of
+ * of ThreadSpecificData structures for all threads that are currently
+ * waiting on an event.
+ *
+ * You must hold the notifierMutex lock before accessing this list.
+ */
+
+static ThreadSpecificData *waitingListPtr = NULL;
+
+/*
+ * The notifier thread spends all its time in select() waiting for a
+ * file descriptor associated with one of the threads on the waitingListPtr
+ * list to do something interesting. But if the contents of the
+ * waitingListPtr list ever changes, we need to wake up and restart
+ * the select() system call. You can wake up the notifier thread by
+ * writing a single byte to the file descriptor defined below. This
+ * file descriptor is the input-end of a pipe and the notifier thread is
+ * listening for data on the output-end of the same pipe. Hence writing
+ * to this file descriptor will cause the select() system call to return
+ * and wake up the notifier thread.
+ *
+ * You must hold the notifierMutex lock before accessing this list.
+ */
+
+static int triggerPipe = -1;
+
+/*
+ * The notifierMutex locks access to all of the global notifier state.
+ */
+
+TCL_DECLARE_MUTEX(notifierMutex)
+
+/*
+ * The notifier thread signals the notifierCV when it has finished
+ * initializing the triggerPipe and right before the notifier
+ * thread terminates.
+ */
+
+static Tcl_Condition notifierCV;
/*
- * The following static indicates whether this module has been initialized.
+ * The pollState bits
+ * POLL_WANT is set by each thread before it waits on its condition
+ * variable. It is checked by the notifier before it does
+ * select.
+ * POLL_DONE is set by the notifier if it goes into select after
+ * seeing POLL_WANT. The idea is to ensure it tries a select
+ * with the same bits the initial thread had set.
*/
+#define POLL_WANT 0x1
+#define POLL_DONE 0x2
-static int initialized = 0;
+/*
+ * This is the thread ID of the notifier thread that does select.
+ */
+static Tcl_ThreadId notifierThread;
+
+#endif
/*
* Static routines defined in this file.
*/
-static void InitNotifier _ANSI_ARGS_((void));
-static void NotifierExitHandler _ANSI_ARGS_((
- ClientData clientData));
-static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
- int flags));
+#ifdef TCL_THREADS
+static void NotifierThreadProc _ANSI_ARGS_((ClientData clientData));
+#endif
+static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
/*
*----------------------------------------------------------------------
*
- * InitNotifier --
+ * Tcl_InitNotifier --
*
- * Initializes the notifier state.
+ * Initializes the platform specific notifier state.
*
* Results:
- * None.
+ * Returns a handle to the notifier state for this thread..
*
* Side effects:
- * Creates a new exit handler.
+ * None.
*
*----------------------------------------------------------------------
*/
-static void
-InitNotifier()
+ClientData
+Tcl_InitNotifier()
{
- initialized = 1;
- memset(&notifier, 0, sizeof(notifier));
- Tcl_CreateExitHandler(NotifierExitHandler, NULL);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+#ifdef TCL_THREADS
+ tsdPtr->eventReady = 0;
+
+ /*
+ * Start the Notifier thread if necessary.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ if (notifierCount == 0) {
+ if (Tcl_CreateThread(&notifierThread, NotifierThreadProc, NULL,
+ TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) {
+ panic("Tcl_InitNotifier: unable to start notifier thread");
+ }
+ }
+ notifierCount++;
+
+ /*
+ * Wait for the notifier pipe to be created.
+ */
+
+ while (triggerPipe < 0) {
+ Tcl_ConditionWait(&notifierCV, &notifierMutex, NULL);
+ }
+
+ Tcl_MutexUnlock(&notifierMutex);
+#endif
+ return (ClientData) tsdPtr;
}
/*
*----------------------------------------------------------------------
*
- * NotifierExitHandler --
+ * Tcl_FinalizeNotifier --
*
* This function is called to cleanup the notifier state before
- * Tcl is unloaded.
+ * a thread is terminated.
*
* Results:
* None.
*
* Side effects:
- * Destroys the notifier window.
+ * May terminate the background notifier thread if this is the
+ * last notifier instance.
*
*----------------------------------------------------------------------
*/
-static void
-NotifierExitHandler(clientData)
+void
+Tcl_FinalizeNotifier(clientData)
ClientData clientData; /* Not used. */
{
- initialized = 0;
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ Tcl_MutexLock(&notifierMutex);
+ notifierCount--;
+
+ /*
+ * If this is the last thread to use the notifier, close the notifier
+ * pipe and wait for the background thread to terminate.
+ */
+
+ if (notifierCount == 0) {
+ if (triggerPipe < 0) {
+ panic("Tcl_FinalizeNotifier: notifier pipe not initialized");
+ }
+
+ /*
+ * Send "q" message to the notifier thread so that it will
+ * terminate. The notifier will return from its call to select()
+ * and notice that a "q" message has arrived, it will then close
+ * its side of the pipe and terminate its thread. Note the we can
+ * not just close the pipe and check for EOF in the notifier
+ * thread because if a background child process was created with
+ * exec, select() would not register the EOF on the pipe until the
+ * child processes had terminated. [Bug: 4139]
+ */
+ write(triggerPipe, "q", 1);
+ close(triggerPipe);
+
+ Tcl_ConditionWait(&notifierCV, &notifierMutex, NULL);
+ }
+
+ /*
+ * Clean up any synchronization objects in the thread local storage.
+ */
+
+ Tcl_ConditionFinalize(&(tsdPtr->waitCV));
+
+ Tcl_MutexUnlock(&notifierMutex);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AlertNotifier --
+ *
+ * Wake up the specified notifier from any thread. This routine
+ * is called by the platform independent notifier code whenever
+ * the Tcl_ThreadAlert routine is called. This routine is
+ * guaranteed not to be called on a given notifier after
+ * Tcl_FinalizeNotifier is called for that notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Signals the notifier condition variable for the specified
+ * notifier.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AlertNotifier(clientData)
+ ClientData clientData;
+{
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+ Tcl_MutexLock(&notifierMutex);
+ tsdPtr->eventReady = 1;
+ Tcl_ConditionNotify(&tsdPtr->waitCV);
+ Tcl_MutexUnlock(&notifierMutex);
+#endif
}
/*
@@ -164,6 +352,33 @@ Tcl_SetTimer(timePtr)
* because the only event loop is via Tcl_DoOneEvent, which passes
* timeout values to Tcl_WaitForEvent.
*/
+
+ if (tclStubs.tcl_SetTimer != Tcl_SetTimer) {
+ tclStubs.tcl_SetTimer(timePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ServiceModeHook --
+ *
+ * This function is invoked whenever the service mode changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ServiceModeHook(mode)
+ int mode; /* Either TCL_SERVICE_ALL, or
+ * TCL_SERVICE_NONE. */
+{
}
/*
@@ -171,14 +386,13 @@ Tcl_SetTimer(timePtr)
*
* Tcl_CreateFileHandler --
*
- * This procedure registers a file handler with the Xt notifier.
+ * This procedure registers a file handler with the select notifier.
*
* Results:
* None.
*
* Side effects:
- * Creates a new file handler structure and registers one or more
- * input procedures with Xt.
+ * Creates a new file handler structure.
*
*----------------------------------------------------------------------
*/
@@ -194,25 +408,27 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData)
* selected event. */
ClientData clientData; /* Arbitrary data to pass to proc. */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr;
int index, bit;
-
- if (!initialized) {
- InitNotifier();
+
+ if (tclStubs.tcl_CreateFileHandler != Tcl_CreateFileHandler) {
+ tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData);
+ return;
}
- for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
- filePtr = filePtr->nextPtr) {
+ for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
if (filePtr->fd == fd) {
break;
}
}
if (filePtr == NULL) {
- filePtr = (FileHandler*) ckalloc(sizeof(FileHandler)); /* MLK */
+ filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
- filePtr->nextPtr = notifier.firstFileHandlerPtr;
- notifier.firstFileHandlerPtr = filePtr;
+ filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
+ tsdPtr->firstFileHandlerPtr = filePtr;
}
filePtr->proc = proc;
filePtr->clientData = clientData;
@@ -225,22 +441,22 @@ Tcl_CreateFileHandler(fd, mask, proc, clientData)
index = fd/(NBBY*sizeof(fd_mask));
bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
if (mask & TCL_READABLE) {
- notifier.checkMasks[index] |= bit;
+ tsdPtr->checkMasks[index] |= bit;
} else {
- notifier.checkMasks[index] &= ~bit;
+ tsdPtr->checkMasks[index] &= ~bit;
}
if (mask & TCL_WRITABLE) {
- (notifier.checkMasks+MASK_SIZE)[index] |= bit;
+ (tsdPtr->checkMasks+MASK_SIZE)[index] |= bit;
} else {
- (notifier.checkMasks+MASK_SIZE)[index] &= ~bit;
+ (tsdPtr->checkMasks+MASK_SIZE)[index] &= ~bit;
}
if (mask & TCL_EXCEPTION) {
- (notifier.checkMasks+2*(MASK_SIZE))[index] |= bit;
+ (tsdPtr->checkMasks+2*(MASK_SIZE))[index] |= bit;
} else {
- (notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit;
+ (tsdPtr->checkMasks+2*(MASK_SIZE))[index] &= ~bit;
}
- if (notifier.numFdBits <= fd) {
- notifier.numFdBits = fd+1;
+ if (tsdPtr->numFdBits <= fd) {
+ tsdPtr->numFdBits = fd+1;
}
}
@@ -268,18 +484,19 @@ Tcl_DeleteFileHandler(fd)
FileHandler *filePtr, *prevPtr;
int index, bit, i;
unsigned long flags;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!initialized) {
- InitNotifier();
+ if (tclStubs.tcl_DeleteFileHandler != Tcl_DeleteFileHandler) {
+ tclStubs.tcl_DeleteFileHandler(fd);
+ return;
}
/*
- * Find the entry for the given file (and return if there
- * isn't one).
+ * Find the entry for the given file (and return if there isn't one).
*/
- for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
- prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return;
}
@@ -296,31 +513,31 @@ Tcl_DeleteFileHandler(fd)
bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
if (filePtr->mask & TCL_READABLE) {
- notifier.checkMasks[index] &= ~bit;
+ tsdPtr->checkMasks[index] &= ~bit;
}
if (filePtr->mask & TCL_WRITABLE) {
- (notifier.checkMasks+MASK_SIZE)[index] &= ~bit;
+ (tsdPtr->checkMasks+MASK_SIZE)[index] &= ~bit;
}
if (filePtr->mask & TCL_EXCEPTION) {
- (notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit;
+ (tsdPtr->checkMasks+2*(MASK_SIZE))[index] &= ~bit;
}
/*
* Find current max fd.
*/
- if (fd+1 == notifier.numFdBits) {
- for (notifier.numFdBits = 0; index >= 0; index--) {
- flags = notifier.checkMasks[index]
- | (notifier.checkMasks+MASK_SIZE)[index]
- | (notifier.checkMasks+2*(MASK_SIZE))[index];
+ if (fd+1 == tsdPtr->numFdBits) {
+ for (tsdPtr->numFdBits = 0; index >= 0; index--) {
+ flags = tsdPtr->checkMasks[index]
+ | (tsdPtr->checkMasks+MASK_SIZE)[index]
+ | (tsdPtr->checkMasks+2*(MASK_SIZE))[index];
if (flags) {
for (i = (NBBY*sizeof(fd_mask)); i > 0; i--) {
if (flags & (((unsigned long)1) << (i-1))) {
break;
}
}
- notifier.numFdBits = index * (NBBY*sizeof(fd_mask)) + i;
+ tsdPtr->numFdBits = index * (NBBY*sizeof(fd_mask)) + i;
break;
}
}
@@ -331,7 +548,7 @@ Tcl_DeleteFileHandler(fd)
*/
if (prevPtr == NULL) {
- notifier.firstFileHandlerPtr = filePtr->nextPtr;
+ tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
} else {
prevPtr->nextPtr = filePtr->nextPtr;
}
@@ -366,9 +583,10 @@ FileHandlerEventProc(evPtr, flags)
int flags; /* Flags that indicate what events to
* handle, such as TCL_FILE_EVENTS. */
{
+ int mask;
FileHandler *filePtr;
FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
- int mask;
+ ThreadSpecificData *tsdPtr;
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -381,8 +599,9 @@ FileHandlerEventProc(evPtr, flags)
* while the event is queued without leaving a dangling pointer.
*/
- for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
- filePtr = filePtr->nextPtr) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
if (filePtr->fd != fileEvPtr->fd) {
continue;
}
@@ -435,10 +654,16 @@ Tcl_WaitForEvent(timePtr)
FileHandler *filePtr;
FileHandlerEvent *fileEvPtr;
struct timeval timeout, *timeoutPtr;
- int bit, index, mask, numFound;
+ int bit, index, mask;
+#ifdef TCL_THREADS
+ int waitForFiles;
+#else
+ int numFound;
+#endif
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!initialized) {
- InitNotifier();
+ if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) {
+ return tclStubs.tcl_WaitForEvent(timePtr);
}
/*
@@ -451,18 +676,102 @@ Tcl_WaitForEvent(timePtr)
timeout.tv_sec = timePtr->sec;
timeout.tv_usec = timePtr->usec;
timeoutPtr = &timeout;
- } else if (notifier.numFdBits == 0) {
+#ifndef TCL_THREADS
+ } else if (tsdPtr->numFdBits == 0) {
+ /*
+ * If there are no threads, no timeout, and no fds registered,
+ * then there are no events possible and we must avoid deadlock.
+ * Note that this is not entirely correct because there might
+ * be a signal that could interrupt the select call, but we
+ * don't handle that case if we aren't using threads.
+ */
+
return -1;
+#endif
} else {
timeoutPtr = NULL;
}
- memcpy((VOID *) notifier.readyMasks, (VOID *) notifier.checkMasks,
+#ifdef TCL_THREADS
+ /*
+ * Place this thread on the list of interested threads, signal the
+ * notifier thread, and wait for a response or a timeout.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+
+ waitForFiles = (tsdPtr->numFdBits > 0);
+ if (timePtr != NULL && timePtr->sec == 0 && timePtr->usec == 0) {
+ /*
+ * Cannot emulate a polling select with a polling condition variable.
+ * Instead, pretend to wait for files and tell the notifier
+ * thread what we are doing. The notifier thread makes sure
+ * it goes through select with its select mask in the same state
+ * as ours currently is. We block until that happens.
+ */
+
+ waitForFiles = 1;
+ tsdPtr->pollState = POLL_WANT;
+ timePtr = NULL;
+ } else {
+ tsdPtr->pollState = 0;
+ }
+
+ if (waitForFiles) {
+ /*
+ * Add the ThreadSpecificData structure of this thread to the list
+ * of ThreadSpecificData structures of all threads that are waiting
+ * on file events.
+ */
+
+
+ tsdPtr->nextPtr = waitingListPtr;
+ if (waitingListPtr) {
+ waitingListPtr->prevPtr = tsdPtr;
+ }
+ tsdPtr->prevPtr = 0;
+ waitingListPtr = tsdPtr;
+ tsdPtr->onList = 1;
+
+ write(triggerPipe, "", 1);
+ }
+
+ memset((VOID *) tsdPtr->readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+
+ if (!tsdPtr->eventReady) {
+ Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
+ }
+ tsdPtr->eventReady = 0;
+
+ if (waitForFiles && tsdPtr->onList) {
+ /*
+ * Remove the ThreadSpecificData structure of this thread from the
+ * waiting list. Alert the notifier thread to recompute its select
+ * masks - skipping this caused a hang when trying to close a pipe
+ * which the notifier thread was still doing a select on.
+ */
+
+ if (tsdPtr->prevPtr) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ } else {
+ waitingListPtr = tsdPtr->nextPtr;
+ }
+ if (tsdPtr->nextPtr) {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
+ tsdPtr->onList = 0;
+ write(triggerPipe, "", 1);
+ }
+
+
+#else
+ memcpy((VOID *) tsdPtr->readyMasks, (VOID *) tsdPtr->checkMasks,
3*MASK_SIZE*sizeof(fd_mask));
- numFound = select(notifier.numFdBits,
- (SELECT_MASK *) &notifier.readyMasks[0],
- (SELECT_MASK *) &notifier.readyMasks[MASK_SIZE],
- (SELECT_MASK *) &notifier.readyMasks[2*MASK_SIZE], timeoutPtr);
+ numFound = select(tsdPtr->numFdBits,
+ (SELECT_MASK *) &tsdPtr->readyMasks[0],
+ (SELECT_MASK *) &tsdPtr->readyMasks[MASK_SIZE],
+ (SELECT_MASK *) &tsdPtr->readyMasks[2*MASK_SIZE], timeoutPtr);
/*
* Some systems don't clear the masks after an error, so
@@ -470,34 +779,32 @@ Tcl_WaitForEvent(timePtr)
*/
if (numFound == -1) {
- memset((VOID *) notifier.readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+ memset((VOID *) tsdPtr->readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
}
+#endif
/*
* Queue all detected file events before returning.
*/
- for (filePtr = notifier.firstFileHandlerPtr;
- (filePtr != NULL) && (numFound > 0);
- filePtr = filePtr->nextPtr) {
+ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
+ filePtr = filePtr->nextPtr) {
index = filePtr->fd / (NBBY*sizeof(fd_mask));
bit = 1 << (filePtr->fd % (NBBY*sizeof(fd_mask)));
mask = 0;
- if (notifier.readyMasks[index] & bit) {
+ if (tsdPtr->readyMasks[index] & bit) {
mask |= TCL_READABLE;
}
- if ((notifier.readyMasks+MASK_SIZE)[index] & bit) {
+ if ((tsdPtr->readyMasks+MASK_SIZE)[index] & bit) {
mask |= TCL_WRITABLE;
}
- if ((notifier.readyMasks+2*(MASK_SIZE))[index] & bit) {
+ if ((tsdPtr->readyMasks+2*(MASK_SIZE))[index] & bit) {
mask |= TCL_EXCEPTION;
}
if (!mask) {
continue;
- } else {
- numFound--;
}
/*
@@ -514,5 +821,215 @@ Tcl_WaitForEvent(timePtr)
}
filePtr->readyMask = mask;
}
+#ifdef TCL_THREADS
+ Tcl_MutexUnlock(&notifierMutex);
+#endif
return 0;
}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierThreadProc --
+ *
+ * This routine is the initial (and only) function executed by the
+ * special notifier thread. Its job is to wait for file descriptors
+ * to become readable or writable or to have an exception condition
+ * and then to notify other threads who are interested in this
+ * information by signalling a condition variable. Other threads
+ * can signal this notifier thread of a change in their interests
+ * by writing a single byte to a special pipe that the notifier
+ * thread is monitoring.
+ *
+ * Result:
+ * None. Once started, this routine never exits. It dies with
+ * the overall process.
+ *
+ * Side effects:
+ * The trigger pipe used to signal the notifier thread is created
+ * when the notifier thread first starts.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NotifierThreadProc(clientData)
+ ClientData clientData; /* Not used. */
+{
+ ThreadSpecificData *tsdPtr;
+ fd_mask masks[3*MASK_SIZE];
+ long *maskPtr = (long *)masks; /* masks[] cast to type long[] */
+ int fds[2];
+ int i, status, index, bit, numFdBits, found, receivePipe, word;
+ struct timeval poll = {0., 0.}, *timePtr;
+ int maskSize = 3 * ((MASK_SIZE) / sizeof(long)) * sizeof(fd_mask);
+ char buf[2];
+
+ if (pipe(fds) != 0) {
+ panic("NotifierThreadProc: could not create trigger pipe.");
+ }
+
+ receivePipe = fds[0];
+
+#ifndef USE_FIONBIO
+ status = fcntl(receivePipe, F_GETFL);
+ status |= O_NONBLOCK;
+ if (fcntl(receivePipe, F_SETFL, status) < 0) {
+ panic("NotifierThreadProc: could not make receive pipe non blocking.");
+ }
+ status = fcntl(fds[1], F_GETFL);
+ status |= O_NONBLOCK;
+ if (fcntl(fds[1], F_SETFL, status) < 0) {
+ panic("NotifierThreadProc: could not make trigger pipe non blocking.");
+ }
+#else
+ if (ioctl(receivePipe, (int) FIONBIO, &status) < 0) {
+ panic("NotifierThreadProc: could not make receive pipe non blocking.");
+ }
+ if (ioctl(fds[1], (int) FIONBIO, &status) < 0) {
+ panic("NotifierThreadProc: could not make trigger pipe non blocking.");
+ }
+#endif
+
+ /*
+ * Install the write end of the pipe into the global variable.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ triggerPipe = fds[1];
+
+ /*
+ * Signal any threads that are waiting.
+ */
+
+ Tcl_ConditionNotify(&notifierCV);
+ Tcl_MutexUnlock(&notifierMutex);
+
+ /*
+ * Look for file events and report them to interested threads.
+ */
+
+ while (1) {
+ /*
+ * Set up the select mask to include the receive pipe.
+ */
+
+ memset((VOID *)masks, 0, 3*MASK_SIZE*sizeof(fd_mask));
+ numFdBits = receivePipe + 1;
+ index = receivePipe / (NBBY*sizeof(fd_mask));
+ bit = 1 << (receivePipe % (NBBY*sizeof(fd_mask)));
+ masks[index] |= bit;
+
+ /*
+ * Add in the check masks from all of the waiting notifiers.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ timePtr = NULL;
+ for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
+ for (i = 0; i < maskSize; i++) {
+ maskPtr[i] |= ((long*)tsdPtr->checkMasks)[i];
+ }
+ if (tsdPtr->numFdBits > numFdBits) {
+ numFdBits = tsdPtr->numFdBits;
+ }
+ if (tsdPtr->pollState & POLL_WANT) {
+ /*
+ * Here we make sure we go through select() with the same
+ * mask bits that were present when the thread tried to poll.
+ */
+
+ tsdPtr->pollState |= POLL_DONE;
+ timePtr = &poll;
+ }
+ }
+ Tcl_MutexUnlock(&notifierMutex);
+
+ maskSize = 3 * ((MASK_SIZE) / sizeof(long)) * sizeof(fd_mask);
+
+ if (select(numFdBits, (SELECT_MASK *) &masks[0],
+ (SELECT_MASK *) &masks[MASK_SIZE],
+ (SELECT_MASK *) &masks[2*MASK_SIZE], timePtr) == -1) {
+ /*
+ * Try again immediately on an error.
+ */
+
+ continue;
+ }
+
+ /*
+ * Alert any threads that are waiting on a ready file descriptor.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
+ found = 0;
+
+ for (i = 0; i < maskSize; i++) {
+ word = maskPtr[i] & ((long*)tsdPtr->checkMasks)[i];
+ found |= word;
+ (((long*)(tsdPtr->readyMasks))[i]) = word;
+ }
+ if (found || (tsdPtr->pollState & POLL_DONE)) {
+ tsdPtr->eventReady = 1;
+ Tcl_ConditionNotify(&tsdPtr->waitCV);
+ if (tsdPtr->onList) {
+ /*
+ * Remove the ThreadSpecificData structure of this
+ * thread from the waiting list. This prevents us from
+ * continuously spining on select until the other
+ * threads runs and services the file event.
+ */
+
+ if (tsdPtr->prevPtr) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ } else {
+ waitingListPtr = tsdPtr->nextPtr;
+ }
+ if (tsdPtr->nextPtr) {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
+ tsdPtr->onList = 0;
+ tsdPtr->pollState = 0;
+ }
+ }
+ }
+ Tcl_MutexUnlock(&notifierMutex);
+
+ /*
+ * Consume the next byte from the notifier pipe if the pipe was
+ * readable. Note that there may be multiple bytes pending, but
+ * to avoid a race condition we only read one at a time.
+ */
+
+ if (masks[index] & bit) {
+ i = read(receivePipe, buf, 1);
+
+ if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) {
+ /*
+ * Someone closed the write end of the pipe or sent us a
+ * Quit message [Bug: 4139] and then closed the write end
+ * of the pipe so we need to shut down the notifier thread.
+ */
+
+ break;
+ }
+ }
+ }
+
+ /*
+ * Clean up the read end of the pipe and signal any threads waiting on
+ * termination of the notifier thread.
+ */
+
+ close(receivePipe);
+ Tcl_MutexLock(&notifierMutex);
+ triggerPipe = -1;
+ Tcl_ConditionNotify(&notifierCV);
+ Tcl_MutexUnlock(&notifierMutex);
+}
+#endif
+
+
diff --git a/tcl/unix/tclUnixPipe.c b/tcl/unix/tclUnixPipe.c
index 2b71b9e51f6..78254b49e68 100644
--- a/tcl/unix/tclUnixPipe.c
+++ b/tcl/unix/tclUnixPipe.c
@@ -128,12 +128,16 @@ TclpMakeFile(channel, direction)
TclFile
TclpOpenFile(fname, mode)
- char *fname; /* The name of the file to open. */
- int mode; /* In what mode to open the file? */
+ CONST char *fname; /* The name of the file to open. */
+ int mode; /* In what mode to open the file? */
{
int fd;
+ char *native;
+ Tcl_DString ds;
- fd = open(fname, mode, 0666);
+ native = Tcl_UtfToExternalDString(NULL, fname, -1, &ds);
+ fd = open(native, mode, 0666); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
if (fd != -1) {
fcntl(fd, F_SETFD, FD_CLOEXEC);
@@ -143,7 +147,7 @@ TclpOpenFile(fname, mode)
*/
if (mode & O_WRONLY) {
- lseek(fd, 0, SEEK_END);
+ lseek(fd, (off_t) 0, SEEK_END);
}
/*
@@ -175,36 +179,34 @@ TclpOpenFile(fname, mode)
*/
TclFile
-TclpCreateTempFile(contents, namePtr)
- char *contents; /* String to write into temp file, or NULL. */
- Tcl_DString *namePtr; /* If non-NULL, pointer to initialized
- * DString that is filled with the name of
- * the temp file that was created. */
+TclpCreateTempFile(contents)
+ CONST char *contents; /* String to write into temp file, or NULL. */
{
- char fileName[L_tmpnam];
- TclFile file;
- size_t length = (contents == NULL) ? 0 : strlen(contents);
-
- tmpnam(fileName);
- file = TclpOpenFile(fileName, O_RDWR|O_CREAT|O_TRUNC);
- unlink(fileName);
-
- if ((file != NULL) && (length > 0)) {
- int fd = GetFd(file);
- while (1) {
- if (write(fd, contents, length) != -1) {
- break;
- } else if (errno != EINTR) {
- close(fd);
- return NULL;
- }
- }
- lseek(fd, 0, SEEK_SET);
+ char fileName[L_tmpnam], *native;
+ Tcl_DString dstring;
+ int fd;
+
+ if (tmpnam(fileName) == NULL) { /* INTL: Native. */
+ return NULL;
+ }
+ fd = open(fileName, O_RDWR|O_CREAT|O_TRUNC, 0666); /* INTL: Native. */
+ if (fd == -1) {
+ return NULL;
}
- if (namePtr != NULL) {
- Tcl_DStringAppend(namePtr, fileName, -1);
+ fcntl(fd, F_SETFD, FD_CLOEXEC);
+ unlink(fileName); /* INTL: Native. */
+
+ if (contents != NULL) {
+ native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
+ if (write(fd, native, strlen(native)) == -1) {
+ close(fd);
+ Tcl_DStringFree(&dstring);
+ return NULL;
+ }
+ Tcl_DStringFree(&dstring);
+ lseek(fd, (off_t) 0, SEEK_SET);
}
- return file;
+ return MakeFile(fd);
}
/*
@@ -279,7 +281,7 @@ TclpCloseFile(file)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TclpCreateProcess --
*
@@ -292,14 +294,14 @@ TclpCloseFile(file)
*
* Results:
* The return value is TCL_ERROR and an error message is left in
- * interp->result if there was a problem creating the child
+ * the interp's result if there was a problem creating the child
* process. Otherwise, the return value is TCL_OK and *pidPtr is
* filled with the process id of the child process.
*
* Side effects:
* A process is created.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
/* ARGSUSED */
@@ -311,11 +313,11 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
* Error messages from the child process
* itself are sent to errorFile. */
int argc; /* Number of arguments in following array. */
- char **argv; /* Array of argument strings. argv[0]
- * contains the name of the executable
- * converted to native format (using the
- * Tcl_TranslateFileName call). Additional
- * arguments have not been converted. */
+ char **argv; /* Array of argument strings in UTF-8.
+ * argv[0] contains the name of the executable
+ * translated using Tcl_TranslateFileName
+ * call). Additional arguments have not been
+ * converted. */
TclFile inputFile; /* If non-NULL, gives the file to use as
* input for the child process. If inputFile
* file is not readable or is NULL, the child
@@ -336,8 +338,10 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
{
TclFile errPipeIn, errPipeOut;
int joinThisError, count, status, fd;
- char errSpace[200];
- int pid;
+ char errSpace[200 + TCL_INTEGER_SPACE];
+ Tcl_DString *dsArray;
+ char **newArgv;
+ int pid, i;
errPipeIn = NULL;
errPipeOut = NULL;
@@ -354,8 +358,19 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
goto error;
}
+ /*
+ * We need to allocate and convert this before the fork
+ * so it is properly deallocated later
+ */
+ dsArray = (Tcl_DString *) ckalloc(argc * sizeof(Tcl_DString));
+ newArgv = (char **) ckalloc((argc+1) * sizeof(char *));
+ newArgv[argc] = NULL;
+ for (i = 0; i < argc; i++) {
+ newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
+ }
+
joinThisError = (errorFile == outputFile);
- pid = vfork();
+ pid = fork();
if (pid == 0) {
fd = GetFd(errPipeOut);
@@ -370,8 +385,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
((dup2(1,2) == -1) ||
(fcntl(2, F_SETFD, 0) != 0)))) {
sprintf(errSpace,
- "%dforked process couldn't set up input/output: ",
- errno);
+ "%dforked process couldn't set up input/output: ", errno);
write(fd, errSpace, (size_t) strlen(errSpace));
_exit(1);
}
@@ -381,12 +395,21 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
*/
RestoreSignals();
- execvp(argv[0], &argv[0]);
- sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno,
- argv[0]);
+ execvp(newArgv[0], newArgv); /* INTL: Native. */
+ sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno, argv[0]);
write(fd, errSpace, (size_t) strlen(errSpace));
_exit(1);
}
+
+ /*
+ * Free the mem we used for the fork
+ */
+ for (i = 0; i < argc; i++) {
+ Tcl_DStringFree(&dsArray[i]);
+ }
+ ckfree((char *) dsArray);
+ ckfree((char *) newArgv);
+
if (pid == -1) {
Tcl_AppendResult(interp, "couldn't fork child process: ",
Tcl_PosixError(interp), (char *) NULL);
@@ -621,7 +644,7 @@ TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
* the channel is closed or the processes
* are detached (in a background exec). */
{
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
int channelId;
PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
int mode;
@@ -676,13 +699,13 @@ TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
* This procedure is invoked in the generic implementation of a
* background "exec" (An exec when invoked with a terminating "&")
* to store a list of the PIDs for processes in a command pipeline
- * in interp->result and to detach the processes.
+ * in the interp's result and to detach the processes.
*
* Results:
* None.
*
* Side effects:
- * Modifies interp->result. Detaches processes.
+ * Modifies the interp's result. Detaches processes.
*
*----------------------------------------------------------------------
*/
@@ -695,7 +718,7 @@ TclGetAndDetachPids(interp, chan)
PipeState *pipePtr;
Tcl_ChannelType *chanTypePtr;
int i;
- char buf[20];
+ char buf[TCL_INTEGER_SPACE];
/*
* Punt if the channel is not a command channel.
@@ -708,7 +731,7 @@ TclGetAndDetachPids(interp, chan)
pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
for (i = 0; i < pipePtr->numPids; i++) {
- sprintf(buf, "%ld", TclpGetPid(pipePtr->pidPtr[i]));
+ TclFormatInt(buf, (long) TclpGetPid(pipePtr->pidPtr[i]));
Tcl_AppendElement(interp, buf);
Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
}
@@ -759,7 +782,6 @@ PipeBlockModeProc(instanceData, mode)
if (fcntl(fd, F_SETFL, curStatus) < 0) {
return errno;
}
- curStatus = fcntl(fd, F_GETFL);
}
if (psPtr->outFile) {
fd = GetFd(psPtr->outFile);
@@ -799,7 +821,9 @@ PipeBlockModeProc(instanceData, mode)
}
}
#endif /* USE_FIONBIO */
-
+
+ psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING);
+
return 0;
}
@@ -1129,8 +1153,7 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
if (objc == 1) {
Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) getpid());
} else {
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
- NULL);
+ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
@@ -1147,3 +1170,5 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
}
return TCL_OK;
}
+
+
diff --git a/tcl/unix/tclUnixPort.h b/tcl/unix/tclUnixPort.h
index fb9152f3e13..b84ef03f2a2 100644
--- a/tcl/unix/tclUnixPort.h
+++ b/tcl/unix/tclUnixPort.h
@@ -14,7 +14,7 @@
* by Karl Lehenbauer, Mark Diekhans and Peter da Silva.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -28,6 +28,14 @@
#ifndef _TCLINT
# include "tclInt.h"
#endif
+
+/*
+ *---------------------------------------------------------------------------
+ * The following sets of #includes and #ifdefs are required to get Tcl to
+ * compile under the various flavors of unix.
+ *---------------------------------------------------------------------------
+ */
+
#include <errno.h>
#include <fcntl.h>
#ifdef HAVE_NET_ERRNO_H
@@ -35,16 +43,18 @@
#endif
#include <pwd.h>
#include <signal.h>
-#include <sys/param.h>
+#ifdef HAVE_SYS_PARAM_H
+# include <sys/param.h>
+#endif
#include <sys/types.h>
#ifdef USE_DIRENT2_H
# include "../compat/dirent2.h"
#else
-# ifdef NO_DIRENT_H
-# include "../compat/dirent.h"
-# else
-# include <dirent.h>
-# endif
+#ifdef NO_DIRENT_H
+# include "../compat/dirent.h"
+#else
+# include <dirent.h>
+#endif
#endif
#include <sys/file.h>
#ifdef HAVE_SYS_SELECT_H
@@ -55,11 +65,11 @@
# include <sys/time.h>
# include <time.h>
#else
-# if HAVE_SYS_TIME_H
-# include <sys/time.h>
-# else
-# include <time.h>
-# endif
+#if HAVE_SYS_TIME_H
+# include <sys/time.h>
+#else
+# include <time.h>
+#endif
#endif
#ifndef NO_SYS_WAIT_H
# include <sys/wait.h>
@@ -70,7 +80,6 @@
# include "../compat/unistd.h"
#endif
#ifdef USE_FIONBIO
-
/*
* Not using the Posix fcntl(...,O_NONBLOCK,...) interface, instead
* we are using ioctl(..,FIONBIO,..).
@@ -84,6 +93,7 @@
# include <sys/ioctl.h> /* For FIONBIO. */
# endif
#endif /* USE_FIONBIO */
+#include <utime.h>
/*
* Socket support stuff: This likely needs more work to parameterize for
@@ -105,11 +115,11 @@
*/
#ifndef NO_FLOAT_H
-#include <float.h>
+# include <float.h>
#else
-# ifndef NO_VALUES_H
-# include <values.h>
-# endif
+#ifndef NO_VALUES_H
+# include <values.h>
+#endif
#endif
#ifndef FLT_MAX
@@ -148,30 +158,6 @@
#endif
/*
- * The following defines denote malloc and free as the system calls
- * used to allocate new memory. These defines are only used in the
- * file tclCkalloc.c.
- */
-
-#define TclpAlloc(size) malloc(size)
-#define TclpFree(ptr) free(ptr)
-#define TclpRealloc(ptr, size) realloc(ptr, size)
-
-/*
- * The default platform eol translation on Unix is TCL_TRANSLATE_LF:
- */
-
-#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_LF
-
-/*
- * Not all systems declare the errno variable in errno.h. so this
- * file does it explicitly. The list of system error messages also
- * isn't generally declared in a header file anywhere.
- */
-
-extern int errno;
-
-/*
* The type of the status returned by wait varies from UNIX system
* to UNIX system. The macro below defines it:
*/
@@ -235,21 +221,18 @@ extern int errno;
#ifndef SEEK_SET
# define SEEK_SET 0
#endif
-
#ifndef SEEK_CUR
# define SEEK_CUR 1
#endif
-
#ifndef SEEK_END
# define SEEK_END 2
#endif
/*
- * The stuff below is needed by the "time" command. If this
- * system has no gettimeofday call, then must use times and the
- * CLK_TCK #define (from sys/param.h) to compute elapsed time.
- * Unfortunately, some systems only have HZ and no CLK_TCK, and
- * some might not even have HZ.
+ * The stuff below is needed by the "time" command. If this system has no
+ * gettimeofday call, then must use times and the CLK_TCK #define (from
+ * sys/param.h) to compute elapsed time. Unfortunately, some systems only
+ * have HZ and no CLK_TCK, and some might not even have HZ.
*/
#ifdef NO_GETTOD
@@ -300,21 +283,12 @@ EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
#endif
/*
- * On UNIX, there's no platform specific implementation of "TclpStat(...)"
- * or "TclpAccess(...)". Simply call "stat(...)' and "access(...)"
- * respectively.
- */
-
-#define TclpStat stat
-#define TclpAccess access
-
-/*
* On systems without symbolic links (i.e. S_IFLNK isn't defined)
* define "lstat" to use "stat" instead.
*/
#ifndef S_IFLNK
-# define lstat stat
+# define lstat stat
#endif
/*
@@ -438,22 +412,19 @@ EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
/*
- * The following implements the Unix method for exiting the process.
- */
-#define TclPlatformExit(status) exit(status)
-
-/*
- * The following functions always succeeds under Unix.
+ * Not all systems declare the errno variable in errno.h. so this
+ * file does it explicitly. The list of system error messages also
+ * isn't generally declared in a header file anywhere.
*/
-#define TclHasSockets(interp) (TCL_OK)
+extern int errno;
/*
* Variables provided by the C library:
*/
-#if defined(_sgi) || defined(__sgi)
-#define environ _environ
+#if defined(_sgi) || defined(__sgi) || (defined(__APPLE__) && defined(__DYNAMIC__))
+# define environ _environ
#endif
extern char **environ;
@@ -468,27 +439,77 @@ extern char **environ;
extern double strtod();
/*
- * The following macros define time related functions in terms of
- * standard Unix routines.
+ *---------------------------------------------------------------------------
+ * The following macros and declarations represent the interface between
+ * generic and unix-specific parts of Tcl. Some of the macros may override
+ * functions declared in tclInt.h.
+ *---------------------------------------------------------------------------
*/
-#define TclpGetDate(t,u) ((u) ? gmtime((t)) : localtime((t)))
-#define TclStrftime(s,m,f,t) (strftime((s),(m),(f),(t)))
-#define TclpGetPid(pid) ((unsigned long) (pid))
+/*
+ * The default platform eol translation on Unix is TCL_TRANSLATE_LF.
+ */
-#define TclpReleaseFile(file)
+#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_LF
+
+/*
+ * The following macros have trivial definitions, allowing generic code to
+ * address platform-specific issues.
+ */
+
+#define TclpAsyncMark(async)
+#define TclpGetPid(pid) ((unsigned long) (pid))
+#define TclpReleaseFile(file) /* Nothing. */
+
+/*
+ * The following defines wrap the system memory allocation routines for
+ * use by tclAlloc.c. By default off unused on Unix.
+ */
+
+#if USE_TCLALLOC
+# define TclpSysAlloc(size, isBin) malloc((size_t)size)
+# define TclpSysFree(ptr) free((char*)ptr)
+# define TclpSysRealloc(ptr, size) realloc((char*)ptr, (size_t)size)
+#endif
/*
- * TclpFinalize is a noop on Unix systems.
+ * The following macros and declaration wrap the C runtime library
+ * functions.
*/
-#define TclpFinalize()
+#define TclpExit exit
+
+#ifdef TclpStat
+#undef TclpStat
+#endif
+
+EXTERN int TclpLstat _ANSI_ARGS_((CONST char *path,
+ struct stat *buf));
+EXTERN int TclpStat _ANSI_ARGS_((CONST char *path,
+ struct stat *buf));
/*
- * The following routine is only exported for testing purposes.
+ * Platform specific mutex definition used by memory allocators.
+ * These mutexes are statically allocated and explicitly initialized.
+ * Most modules do not use this, but instead use Tcl_Mutex types and
+ * Tcl_MutexLock and Tcl_MutexUnlock that are self-initializing.
*/
-EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
- int timeout));
+#ifdef TCL_THREADS
+#include <pthread.h>
+typedef pthread_mutex_t TclpMutex;
+EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr));
+EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr));
+EXTERN void TclpMutexUnlock _ANSI_ARGS_((TclpMutex *mPtr));
+#else
+typedef int TclpMutex;
+#define TclpMutexInit(a)
+#define TclpMutexLock(a)
+#define TclpMutexUnlock(a)
+#endif /* TCL_THREADS */
+
+#include "tclPlatDecls.h"
+#include "tclIntPlatDecls.h"
#endif /* _TCLUNIXPORT */
+
diff --git a/tcl/unix/tclUnixSock.c b/tcl/unix/tclUnixSock.c
index 7f9597905d9..0b63f84f6b7 100644
--- a/tcl/unix/tclUnixSock.c
+++ b/tcl/unix/tclUnixSock.c
@@ -41,6 +41,8 @@
static char hostname[TCL_HOSTNAME_LEN + 1];
static int hostnameInited = 0;
+TCL_DECLARE_MUTEX(hostMutex)
+
/*
*----------------------------------------------------------------------
@@ -66,35 +68,69 @@ Tcl_GetHostName()
#ifndef NO_UNAME
struct utsname u;
struct hostent *hp;
+#else
+ char buffer[sizeof(hostname)];
#endif
+ CONST char *native;
+ Tcl_MutexLock(&hostMutex);
if (hostnameInited) {
+ Tcl_MutexUnlock(&hostMutex);
return hostname;
}
+ native = NULL;
#ifndef NO_UNAME
(VOID *) memset((VOID *) &u, (int) 0, sizeof(struct utsname));
- if (uname(&u) > -1) {
- hp = gethostbyname(u.nodename);
+ if (uname(&u) > -1) { /* INTL: Native. */
+ hp = gethostbyname(u.nodename); /* INTL: Native. */
if (hp != NULL) {
- strcpy(hostname, hp->h_name);
+ native = hp->h_name;
} else {
- strcpy(hostname, u.nodename);
+ native = u.nodename;
}
- hostnameInited = 1;
- return hostname;
}
#else
/*
* Uname doesn't exist; try gethostname instead.
*/
- if (gethostname(hostname, sizeof(hostname)) > -1) {
- hostnameInited = 1;
- return hostname;
+ if (gethostname(buffer, sizeof(buffer)) > -1) { /* INTL: Native. */
+ native = buffer;
}
#endif
- hostname[0] = 0;
+ if (native == NULL) {
+ hostname[0] = 0;
+ } else {
+ Tcl_ExternalToUtf(NULL, NULL, native, -1, 0, NULL, hostname,
+ sizeof(hostname), NULL, NULL, NULL);
+ }
+ hostnameInited = 1;
+ Tcl_MutexUnlock(&hostMutex);
return hostname;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpHasSockets --
+ *
+ * Detect if sockets are available on this platform.
+ *
+ * Results:
+ * Returns TCL_OK.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpHasSockets(interp)
+ Tcl_Interp *interp; /* Not used. */
+{
+ return TCL_OK;
+}
+
diff --git a/tcl/unix/tclUnixTest.c b/tcl/unix/tclUnixTest.c
index d731e5530ee..6680dc91769 100644
--- a/tcl/unix/tclUnixTest.c
+++ b/tcl/unix/tclUnixTest.c
@@ -3,7 +3,7 @@
*
* Contains platform specific test commands for the Unix platform.
*
- * Copyright (c) 1996 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
* Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
@@ -73,6 +73,10 @@ static int TestfindexecutableCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
+static int TestgetdefencdirCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestsetdefencdirCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int TestalarmCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
@@ -109,6 +113,10 @@ TclplatformtestInit(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
@@ -193,7 +201,7 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
}
pipePtr->readCount = pipePtr->writeCount = 0;
} else if (strcmp(argv[1], "counts") == 0) {
- char buf[30];
+ char buf[TCL_INTEGER_SPACE * 2];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
@@ -275,7 +283,7 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
/* Empty loop body. */
}
} else if (strcmp(argv[1], "fillpartial") == 0) {
- char buf[30];
+ char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
@@ -284,7 +292,7 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
}
memset((VOID *) buffer, 'b', 10);
- sprintf(buf, "%d", write(GetFd(pipePtr->writeFile), buffer, 10));
+ TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (strcmp(argv[1], "oneevent") == 0) {
Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
@@ -438,20 +446,32 @@ TestfindexecutableCmd(clientData, interp, argc, argv)
char **argv; /* Argument strings. */
{
char *oldName;
+ char *oldNativeName;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" argv0\"", (char *) NULL);
return TCL_ERROR;
}
- oldName = tclExecutableName;
- tclExecutableName = NULL;
+
+ oldName = tclExecutableName;
+ oldNativeName = tclNativeExecutableName;
+
+ tclExecutableName = NULL;
+ tclNativeExecutableName = NULL;
+
Tcl_FindExecutable(argv[1]);
if (tclExecutableName != NULL) {
Tcl_SetResult(interp, tclExecutableName, TCL_VOLATILE);
ckfree(tclExecutableName);
}
- tclExecutableName = oldName;
+ if (tclNativeExecutableName != NULL) {
+ ckfree(tclNativeExecutableName);
+ }
+
+ tclExecutableName = oldName;
+ tclNativeExecutableName = oldNativeName;
+
return TCL_OK;
}
@@ -502,6 +522,87 @@ TestgetopenfileCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
+ *
+ * TestsetdefencdirCmd --
+ *
+ * This procedure implements the "testsetdefenc" command. It is
+ * used to set the value of tclDefaultEncodingDir.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestsetdefencdirCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ if (argc != 2) {
+ Tcl_AppendResult(interp,
+ "wrong # args: should be \"", argv[0],
+ " defaultDir\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (tclDefaultEncodingDir != NULL) {
+ ckfree(tclDefaultEncodingDir);
+ tclDefaultEncodingDir = NULL;
+ }
+ if (*argv[1] != '\0') {
+ tclDefaultEncodingDir = (char *)
+ ckalloc((unsigned) strlen(argv[1]) + 1);
+ strcpy(tclDefaultEncodingDir, argv[1]);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestgetdefencdirCmd --
+ *
+ * This procedure implements the "testgetdefenc" command. It is
+ * used to get the value of tclDefaultEncodingDir.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetdefencdirCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ if (argc != 1) {
+ Tcl_AppendResult(interp,
+ "wrong # args: should be \"", argv[0],
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (tclDefaultEncodingDir != NULL) {
+ Tcl_AppendResult(interp, tclDefaultEncodingDir, (char *) NULL);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
* TestalarmCmd --
*
* Test that EINTR is handled correctly by generating and
@@ -605,3 +706,4 @@ TestgotsigCmd(clientData, interp, argc, argv)
gotsig = "0";
return TCL_OK;
}
+
diff --git a/tcl/unix/tclUnixThrd.c b/tcl/unix/tclUnixThrd.c
new file mode 100644
index 00000000000..2e8e8a4faff
--- /dev/null
+++ b/tcl/unix/tclUnixThrd.c
@@ -0,0 +1,726 @@
+/*
+ * tclUnixThrd.c --
+ *
+ * This file implements the UNIX-specific thread support.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclUnixThrd.c 1.18 98/02/19 14:24:12
+ */
+
+#include "tclInt.h"
+
+#ifdef TCL_THREADS
+
+#include "tclPort.h"
+#include "pthread.h"
+
+/*
+ * masterLock is used to serialize creation of mutexes, condition
+ * variables, and thread local storage.
+ * This is the only place that can count on the ability to statically
+ * initialize the mutex.
+ */
+
+static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER;
+
+/*
+ * initLock is used to serialize initialization and finalization
+ * of Tcl. It cannot use any dyamically allocated storage.
+ */
+
+static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;
+
+/*
+ * allocLock is used by Tcl's version of malloc for synchronization.
+ * For obvious reasons, cannot use any dyamically allocated storage.
+ */
+
+static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
+static pthread_mutex_t *allocLockPtr = &allocLock;
+
+/*
+ * These are for the critical sections inside this file.
+ */
+
+#define MASTER_LOCK pthread_mutex_lock(&masterLock)
+#define MASTER_UNLOCK pthread_mutex_unlock(&masterLock)
+
+#endif /* TCL_THREADS */
+
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateThread --
+ *
+ * This procedure creates a new thread.
+ *
+ * Results:
+ * TCL_OK if the thread could be created. The thread ID is
+ * returned in a parameter.
+ *
+ * Side effects:
+ * A new thread is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
+ Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc proc; /* Main() function of the thread */
+ ClientData clientData; /* The one argument to Main() */
+ int stackSize; /* Size of stack for the new thread */
+ int flags; /* Flags controlling behaviour of
+ * the new thread */
+{
+#ifdef TCL_THREADS
+ pthread_attr_t attr;
+ int result;
+
+ pthread_attr_init(&attr);
+ pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
+
+#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
+ if (stackSize != TCL_THREAD_STACK_DEFAULT) {
+ pthread_attr_setstacksize(&attr, (size_t) stackSize);
+#ifdef TCL_THREAD_STACK_MIN
+ } else {
+ /*
+ * Certain systems define a thread stack size that by default is
+ * too small for many operations. The user has the option of
+ * defining TCL_THREAD_STACK_MIN to a value large enough to work
+ * for their needs. This would look like (for 128K min stack):
+ * make MEM_DEBUG_FLAGS=-DTCL_THREAD_STACK_MIN=131072L
+ *
+ * This solution is not optimal, as we should allow the user to
+ * specify a size at runtime, but we don't want to slow this function
+ * down, and that would still leave the main thread at the default.
+ */
+
+ size_t size;
+ result = pthread_attr_getstacksize(&attr, &size);
+ if (!result && (size < TCL_THREAD_STACK_MIN)) {
+ pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
+ }
+#endif
+ }
+#endif
+ if (! (flags & TCL_THREAD_JOINABLE)) {
+ pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED);
+ }
+
+
+ if (pthread_create((pthread_t *)idPtr, &attr,
+ (void * (*)())proc, (void *)clientData) &&
+ pthread_create((pthread_t *)idPtr, NULL,
+ (void * (*)())proc, (void *)clientData)) {
+ result = TCL_ERROR;
+ } else {
+ result = TCL_OK;
+ }
+ pthread_attr_destroy(&attr);
+ return result;
+#else
+ return TCL_ERROR;
+#endif /* TCL_THREADS */
+}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadExit --
+ *
+ * This procedure terminates the current thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This procedure terminates the current thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadExit(status)
+ int status;
+{
+ pthread_exit((VOID *)status);
+}
+#endif /* TCL_THREADS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCurrentThread --
+ *
+ * This procedure returns the ID of the currently running thread.
+ *
+ * Results:
+ * A thread ID.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ThreadId
+Tcl_GetCurrentThread()
+{
+#ifdef TCL_THREADS
+ return (Tcl_ThreadId) pthread_self();
+#else
+ return (Tcl_ThreadId) 0;
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitLock
+ *
+ * This procedure is used to grab a lock that serializes initialization
+ * and finalization of Tcl. On some platforms this may also initialize
+ * the mutex used to serialize creation of more mutexes and thread
+ * local storage keys.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitLock()
+{
+#ifdef TCL_THREADS
+ pthread_mutex_lock(&initLock);
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitUnlock
+ *
+ * This procedure is used to release a lock that serializes initialization
+ * and finalization of Tcl.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitUnlock()
+{
+#ifdef TCL_THREADS
+ pthread_mutex_unlock(&initLock);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterLock
+ *
+ * This procedure is used to grab a lock that serializes creation
+ * and finalization of serialization objects. This interface is
+ * only needed in finalization; it is hidden during
+ * creation of the objects.
+ *
+ * This lock must be different than the initLock because the
+ * initLock is held during creation of syncronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterLock()
+{
+#ifdef TCL_THREADS
+ pthread_mutex_lock(&masterLock);
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterUnlock
+ *
+ * This procedure is used to release a lock that serializes creation
+ * and finalization of synchronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterUnlock()
+{
+#ifdef TCL_THREADS
+ pthread_mutex_unlock(&masterLock);
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetAllocMutex
+ *
+ * This procedure returns a pointer to a statically initialized
+ * mutex for use by the memory allocator. The alloctor must
+ * use this lock, because all other locks are allocated...
+ *
+ * Results:
+ * A pointer to a mutex that is suitable for passing to
+ * Tcl_MutexLock and Tcl_MutexUnlock.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Mutex *
+Tcl_GetAllocMutex()
+{
+#ifdef TCL_THREADS
+ return (Tcl_Mutex *)&allocLockPtr;
+#else
+ return NULL;
+#endif
+}
+
+#ifdef TCL_THREADS
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexLock --
+ *
+ * This procedure is invoked to lock a mutex. This procedure
+ * handles initializing the mutex, if necessary. The caller
+ * can rely on the fact that Tcl_Mutex is an opaque pointer.
+ * This routine will change that pointer from NULL after first use.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May block the current thread. The mutex is aquired when
+ * this returns. Will allocate memory for a pthread_mutex_t
+ * and initialize this the first time this Tcl_Mutex is used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexLock(mutexPtr)
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+{
+ pthread_mutex_t *pmutexPtr;
+ if (*mutexPtr == NULL) {
+ MASTER_LOCK;
+ if (*mutexPtr == NULL) {
+ /*
+ * Double inside master lock check to avoid a race condition.
+ */
+
+ pmutexPtr = (pthread_mutex_t *)ckalloc(sizeof(pthread_mutex_t));
+ pthread_mutex_init(pmutexPtr, NULL);
+ *mutexPtr = (Tcl_Mutex)pmutexPtr;
+ TclRememberMutex(mutexPtr);
+ }
+ MASTER_UNLOCK;
+ }
+ pmutexPtr = *((pthread_mutex_t **)mutexPtr);
+ pthread_mutex_lock(pmutexPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexUnlock --
+ *
+ * This procedure is invoked to unlock a mutex. The mutex must
+ * have been locked by Tcl_MutexLock.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex is released when this returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexUnlock(mutexPtr)
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+{
+ pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **)mutexPtr;
+ pthread_mutex_unlock(pmutexPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeMutex --
+ *
+ * This procedure is invoked to clean up one mutex. This is only
+ * safe to call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex list is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeMutex(mutexPtr)
+ Tcl_Mutex *mutexPtr;
+{
+ pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **)mutexPtr;
+ if (pmutexPtr != NULL) {
+ ckfree((char *)pmutexPtr);
+ *mutexPtr = NULL;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyInit --
+ *
+ * This procedure initializes a thread specific data block key.
+ * Each thread has table of pointers to thread specific data.
+ * all threads agree on which table entry is used by each module.
+ * this is remembered in a "data key", that is just an index into
+ * this table. To allow self initialization, the interface
+ * passes a pointer to this key and the first thread to use
+ * the key fills in the pointer to the key. The key should be
+ * a process-wide static.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Will allocate memory the first time this process calls for
+ * this key. In this case it modifies its argument
+ * to hold the pointer to information about the key.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeyInit(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+{
+ pthread_key_t *pkeyPtr;
+
+ MASTER_LOCK;
+ if (*keyPtr == NULL) {
+ pkeyPtr = (pthread_key_t *)ckalloc(sizeof(pthread_key_t));
+ pthread_key_create(pkeyPtr, NULL);
+ *keyPtr = (Tcl_ThreadDataKey)pkeyPtr;
+ TclRememberDataKey(keyPtr);
+ }
+ MASTER_UNLOCK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyGet --
+ *
+ * This procedure returns a pointer to a block of thread local storage.
+ *
+ * Results:
+ * A thread-specific pointer to the data structure, or NULL
+ * if the memory has not been assigned to this key for this thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID *
+TclpThreadDataKeyGet(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+{
+ pthread_key_t *pkeyPtr = *(pthread_key_t **)keyPtr;
+ if (pkeyPtr == NULL) {
+ return NULL;
+ } else {
+ return (VOID *)pthread_getspecific(*pkeyPtr);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeySet --
+ *
+ * This procedure sets the pointer to a block of thread local storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up the thread so future calls to TclpThreadDataKeyGet with
+ * this key will return the data pointer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeySet(keyPtr, data)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+ VOID *data; /* Thread local storage */
+{
+ pthread_key_t *pkeyPtr = *(pthread_key_t **)keyPtr;
+ pthread_setspecific(*pkeyPtr, data);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadData --
+ *
+ * This procedure cleans up the thread-local storage. This is
+ * called once for each thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up all thread local storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadData(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ VOID *result;
+ pthread_key_t *pkeyPtr;
+
+ if (*keyPtr != NULL) {
+ pkeyPtr = *(pthread_key_t **)keyPtr;
+ result = (VOID *)pthread_getspecific(*pkeyPtr);
+ if (result != NULL) {
+ ckfree((char *)result);
+ pthread_setspecific(*pkeyPtr, (void *)NULL);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadDataKey --
+ *
+ * This procedure is invoked to clean up one key. This is a
+ * process-wide storage identifier. The thread finalization code
+ * cleans up the thread local storage itself.
+ *
+ * This assumes the master lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The key is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadDataKey(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ pthread_key_t *pkeyPtr;
+ if (*keyPtr != NULL) {
+ pkeyPtr = *(pthread_key_t **)keyPtr;
+ pthread_key_delete(*pkeyPtr);
+ ckfree((char *)pkeyPtr);
+ *keyPtr = NULL;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionWait --
+ *
+ * This procedure is invoked to wait on a condition variable.
+ * The mutex is automically released as part of the wait, and
+ * automatically grabbed when the condition is signaled.
+ *
+ * The mutex must be held when this procedure is called.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May block the current thread. The mutex is aquired when
+ * this returns. Will allocate memory for a pthread_mutex_t
+ * and initialize this the first time this Tcl_Mutex is used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+ Tcl_Condition *condPtr; /* Really (pthread_cond_t **) */
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+ Tcl_Time *timePtr; /* Timeout on waiting period */
+{
+ pthread_cond_t *pcondPtr;
+ pthread_mutex_t *pmutexPtr;
+ struct timespec ptime;
+
+ if (*condPtr == NULL) {
+ MASTER_LOCK;
+
+ /*
+ * Double check inside mutex to avoid race,
+ * then initialize condition variable if necessary.
+ */
+
+ if (*condPtr == NULL) {
+ pcondPtr = (pthread_cond_t *)ckalloc(sizeof(pthread_cond_t));
+ pthread_cond_init(pcondPtr, NULL);
+ *condPtr = (Tcl_Condition)pcondPtr;
+ TclRememberCondition(condPtr);
+ }
+ MASTER_UNLOCK;
+ }
+ pmutexPtr = *((pthread_mutex_t **)mutexPtr);
+ pcondPtr = *((pthread_cond_t **)condPtr);
+ if (timePtr == NULL) {
+ pthread_cond_wait(pcondPtr, pmutexPtr);
+ } else {
+ ptime.tv_sec = timePtr->sec + TclpGetSeconds();
+ ptime.tv_nsec = 1000 * timePtr->usec;
+ pthread_cond_timedwait(pcondPtr, pmutexPtr, &ptime);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionNotify --
+ *
+ * This procedure is invoked to signal a condition variable.
+ *
+ * The mutex must be held during this call to avoid races,
+ * but this interface does not enforce that.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May unblock another thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionNotify(condPtr)
+ Tcl_Condition *condPtr;
+{
+ pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr);
+ if (pcondPtr != NULL) {
+ pthread_cond_broadcast(pcondPtr);
+ } else {
+ /*
+ * Noone has used the condition variable, so there are no waiters.
+ */
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeCondition --
+ *
+ * This procedure is invoked to clean up a condition variable.
+ * This is only safe to call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The condition variable is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeCondition(condPtr)
+ Tcl_Condition *condPtr;
+{
+ pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;
+ if (pcondPtr != NULL) {
+ pthread_cond_destroy(pcondPtr);
+ ckfree((char *)pcondPtr);
+ *condPtr = NULL;
+ }
+}
+
+
+
+#endif /* TCL_THREADS */
+
diff --git a/tcl/unix/tclUnixThrd.h b/tcl/unix/tclUnixThrd.h
new file mode 100644
index 00000000000..a4f6fc669ae
--- /dev/null
+++ b/tcl/unix/tclUnixThrd.h
@@ -0,0 +1,21 @@
+/*
+ * tclUnixThrd.h --
+ *
+ * This header file defines things for thread support.
+ *
+ * Copyright (c) 1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#)
+ */
+
+#ifndef _TCLUNIXTHRD
+#define _TCLUNIXTHRD
+
+#ifdef TCL_THREADS
+
+
+#endif /* TCL_THREADS */
+#endif /* _TCLUNIXTHRD */
diff --git a/tcl/unix/tclUnixTime.c b/tcl/unix/tclUnixTime.c
index 17ceba1cde9..e1bc43808a2 100644
--- a/tcl/unix/tclUnixTime.c
+++ b/tcl/unix/tclUnixTime.c
@@ -14,6 +14,8 @@
#include "tclInt.h"
#include "tclPort.h"
+#define TM_YEAR_BASE 1900
+#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
/*
*-----------------------------------------------------------------------------
@@ -165,12 +167,17 @@ TclpGetTimeZone (currentTime)
#if defined(HAVE_TIMEZONE_VAR) && !defined (TCL_GOT_TIMEZONE)
# define TCL_GOT_TIMEZONE
static int setTZ = 0;
+#ifdef TCL_THREADS
+ static Tcl_Mutex tzMutex;
+#endif
int timeZone;
+ Tcl_MutexLock(&tzMutex);
if (!setTZ) {
tzset();
setTZ = 1;
}
+ Tcl_MutexUnlock(&tzMutex);
/*
* Note: this is not a typo in "timezone" below! See tzset
@@ -234,3 +241,70 @@ TclpGetTime(timePtr)
timePtr->sec = tv.tv_sec;
timePtr->usec = tv.tv_usec;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetDate --
+ *
+ * This function converts between seconds and struct tm. If
+ * useGMT is true, then the returned date will be in Greenwich
+ * Mean Time (GMT). Otherwise, it will be in the local time zone.
+ *
+ * Results:
+ * Returns a static tm structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+struct tm *
+TclpGetDate(time, useGMT)
+ TclpTime_t time;
+ int useGMT;
+{
+ CONST time_t *tp = (CONST time_t *)time;
+
+ if (useGMT) {
+ return gmtime(tp);
+ } else {
+ return localtime(tp);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpStrftime --
+ *
+ * On Unix, we can safely call the native strftime implementation.
+ *
+ * Results:
+ * The normal strftime result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+size_t
+TclpStrftime(s, maxsize, format, t)
+ char *s;
+ size_t maxsize;
+ CONST char *format;
+ CONST struct tm *t;
+{
+ if (format[0] == '%' && format[1] == 'Q') {
+ /* Format as a stardate */
+ sprintf(s, "Stardate %2d%03d.%01d",
+ (((t->tm_year + TM_YEAR_BASE) + 377) - 2323),
+ (((t->tm_yday + 1) * 1000) /
+ (365 + IsLeapYear((t->tm_year + TM_YEAR_BASE)))),
+ (((t->tm_hour * 60) + t->tm_min)/144));
+ return(strlen(s));
+ }
+ return strftime(s, maxsize, format, t);
+}
diff --git a/tcl/unix/tclXtNotify.c b/tcl/unix/tclXtNotify.c
index 4730cdd104f..8859e5bf0d7 100644
--- a/tcl/unix/tclXtNotify.c
+++ b/tcl/unix/tclXtNotify.c
@@ -1,656 +1,668 @@
-/*
- * tclXtNotify.c --
- *
- * This file contains the notifier driver implementation for the
- * Xt intrinsics.
- *
- * Copyright (c) 1997 by Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
+/*
+ * tclXtNotify.c --
+ *
+ * This file contains the notifier driver implementation for the
+ * Xt intrinsics.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
* RCS: @(#) $Id$
- */
-
-#include <X11/Intrinsic.h>
-#include <tclInt.h>
-
-/*
- * This structure is used to keep track of the notifier info for a
- * a registered file.
- */
-
-typedef struct FileHandler {
- int fd;
- int mask; /* Mask of desired events: TCL_READABLE, etc. */
- int readyMask; /* Events that have been seen since the
- last time FileHandlerEventProc was called
- for this file. */
- XtInputId read; /* Xt read callback handle. */
- XtInputId write; /* Xt write callback handle. */
- XtInputId except; /* Xt exception callback handle. */
- Tcl_FileProc *proc; /* Procedure to call, in the style of
- * Tcl_CreateFileHandler. */
- ClientData clientData; /* Argument to pass to proc. */
- struct FileHandler *nextPtr;/* Next in list of all files we care about. */
-} FileHandler;
-
-/*
- * The following structure is what is added to the Tcl event queue when
- * file handlers are ready to fire.
- */
-
-typedef struct FileHandlerEvent {
- Tcl_Event header; /* Information that is standard for
- * all events. */
- int fd; /* File descriptor that is ready. Used
- * to find the FileHandler structure for
- * the file (can't point directly to the
- * FileHandler structure because it could
- * go away while the event is queued). */
-} FileHandlerEvent;
-
-/*
- * The following static structure contains the state information for the
- * Xt based implementation of the Tcl notifier.
- */
-
-static struct NotifierState {
- XtAppContext appContext; /* The context used by the Xt
- * notifier. Can be set with
- * TclSetAppContext. */
- int appContextCreated; /* Was it created by us? */
- XtIntervalId currentTimeout; /* Handle of current timer. */
- FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler
- * list. */
-} notifier;
-
-/*
- * The following static indicates whether this module has been initialized.
- */
-
-static int initialized = 0;
-
-/*
- * Static routines defined in this file.
- */
-
-static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
- int flags));
-static void FileProc _ANSI_ARGS_((caddr_t clientData,
- int *source, XtInputId *id));
-static void InitNotifier _ANSI_ARGS_((void));
-static void NotifierExitHandler _ANSI_ARGS_((
- ClientData clientData));
-static void TimerProc _ANSI_ARGS_((caddr_t clientData,
- XtIntervalId *id));
-
-/*
- * Functions defined in this file for use by users of the Xt Notifier:
- */
-
-EXTERN XtAppContext TclSetAppContext _ANSI_ARGS_((XtAppContext ctx));
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetAppContext --
- *
- * Set the notifier application context.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets the application context used by the notifier. Panics if
- * the context is already set when called.
- *
- *----------------------------------------------------------------------
- */
-
-XtAppContext
-TclSetAppContext(appContext)
- XtAppContext appContext;
-{
- if (!initialized) {
- InitNotifier();
- }
-
- /*
- * If we already have a context we check whether we were asked to set a
- * new context. If so, we panic because we try to prevent switching
- * contexts by mistake. Otherwise, we return the one we have.
- */
-
- if (notifier.appContext != NULL) {
- if (appContext != NULL) {
-
- /*
- * We already have a context. We do not allow switching contexts
- * after initialization, so we panic.
- */
-
- panic("TclSetAppContext: multiple application contexts");
-
- }
- } else {
-
- /*
- * If we get here we have not yet gotten a context, so either create
- * one or use the one supplied by our caller.
- */
-
- if (appContext == NULL) {
-
- /*
- * We must create a new context and tell our caller what it is, so
- * she can use it too.
- */
-
- notifier.appContext = XtCreateApplicationContext();
- notifier.appContextCreated = 1;
- } else {
-
- /*
- * Otherwise we remember the context that our caller gave us
- * and use it.
- */
-
- notifier.appContextCreated = 0;
- notifier.appContext = appContext;
- }
- }
-
- return notifier.appContext;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InitNotifier --
- *
- * Initializes the notifier state.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Creates a new exit handler.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-InitNotifier(void)
-{
- /*
- * Only reinitialize if we are not in exit handling. The notifier
- * can get reinitialized after its own exit handler has run, because
- * of exit handlers for the I/O and timer sub-systems (order dependency).
- */
-
- if (TclInExit()) {
- return;
- }
-
- /*
- * DO NOT create the application context yet; doing so would prevent
- * external applications from setting it for us to their own ones.
- */
-
- initialized = 1;
- memset(&notifier, 0, sizeof(notifier));
- Tcl_CreateExitHandler(NotifierExitHandler, NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * NotifierExitHandler --
- *
- * This function is called to cleanup the notifier state before
- * Tcl is unloaded.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Destroys the notifier window.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-NotifierExitHandler(
- ClientData clientData) /* Not used. */
-{
- if (notifier.currentTimeout != 0) {
- XtRemoveTimeOut(notifier.currentTimeout);
- }
- for (; notifier.firstFileHandlerPtr != NULL; ) {
- Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
- }
- if (notifier.appContextCreated) {
- XtDestroyApplicationContext(notifier.appContext);
- notifier.appContextCreated = 0;
- notifier.appContext = NULL;
- }
- initialized = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetTimer --
- *
- * This procedure sets the current notifier timeout value.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Replaces any previous timer.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetTimer(timePtr)
- Tcl_Time *timePtr; /* Timeout value, may be NULL. */
-{
- long timeout;
-
- if (!initialized) {
- InitNotifier();
- }
-
- TclSetAppContext(NULL);
- if (notifier.currentTimeout != 0) {
- XtRemoveTimeOut(notifier.currentTimeout);
- }
- if (timePtr) {
- timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
- notifier.currentTimeout =
- XtAppAddTimeOut(notifier.appContext, (unsigned long) timeout,
- TimerProc, NULL);
- } else {
- notifier.currentTimeout = 0;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TimerProc --
- *
- * This procedure is the XtTimerCallbackProc used to handle
- * timeouts.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Processes all queued events.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TimerProc(data, id)
- caddr_t data; /* Not used. */
- XtIntervalId *id;
-{
- if (*id != notifier.currentTimeout) {
- return;
- }
- notifier.currentTimeout = 0;
-
- Tcl_ServiceAll();
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateFileHandler --
- *
- * This procedure registers a file handler with the Xt notifier.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Creates a new file handler structure and registers one or more
- * input procedures with Xt.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_CreateFileHandler(fd, mask, proc, clientData)
- int fd; /* Handle of stream to watch. */
- int mask; /* OR'ed combination of TCL_READABLE,
- * TCL_WRITABLE, and TCL_EXCEPTION:
- * indicates conditions under which
- * proc should be called. */
- Tcl_FileProc *proc; /* Procedure to call for each
- * selected event. */
- ClientData clientData; /* Arbitrary data to pass to proc. */
-{
- FileHandler *filePtr;
-
- if (!initialized) {
- InitNotifier();
- }
-
- TclSetAppContext(NULL);
-
- for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
- filePtr = filePtr->nextPtr) {
- if (filePtr->fd == fd) {
- break;
- }
- }
- if (filePtr == NULL) {
- filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
- filePtr->fd = fd;
- filePtr->read = 0;
- filePtr->write = 0;
- filePtr->except = 0;
- filePtr->readyMask = 0;
- filePtr->mask = 0;
- filePtr->nextPtr = notifier.firstFileHandlerPtr;
- notifier.firstFileHandlerPtr = filePtr;
- }
- filePtr->proc = proc;
- filePtr->clientData = clientData;
-
- /*
- * Register the file with the Xt notifier, if it hasn't been done yet.
- */
-
- if (mask & TCL_READABLE) {
- if (!(filePtr->mask & TCL_READABLE)) {
- filePtr->read =
- XtAppAddInput(notifier.appContext, fd, XtInputReadMask,
- FileProc, filePtr);
- }
- } else {
- if (filePtr->mask & TCL_READABLE) {
- XtRemoveInput(filePtr->read);
- }
- }
- if (mask & TCL_WRITABLE) {
- if (!(filePtr->mask & TCL_WRITABLE)) {
- filePtr->write =
- XtAppAddInput(notifier.appContext, fd, XtInputWriteMask,
- FileProc, filePtr);
- }
- } else {
- if (filePtr->mask & TCL_WRITABLE) {
- XtRemoveInput(filePtr->write);
- }
- }
- if (mask & TCL_EXCEPTION) {
- if (!(filePtr->mask & TCL_EXCEPTION)) {
- filePtr->except =
- XtAppAddInput(notifier.appContext, fd, XtInputExceptMask,
- FileProc, filePtr);
- }
- } else {
- if (filePtr->mask & TCL_EXCEPTION) {
- XtRemoveInput(filePtr->except);
- }
- }
- filePtr->mask = mask;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteFileHandler --
- *
- * Cancel a previously-arranged callback arrangement for
- * a file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * If a callback was previously registered on file, remove it.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DeleteFileHandler(fd)
- int fd; /* Stream id for which to remove
- * callback procedure. */
-{
- FileHandler *filePtr, *prevPtr;
-
- if (!initialized) {
- InitNotifier();
- }
-
- TclSetAppContext(NULL);
-
- /*
- * Find the entry for the given file (and return if there
- * isn't one).
- */
-
- for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
- prevPtr = filePtr, filePtr = filePtr->nextPtr) {
- if (filePtr == NULL) {
- return;
- }
- if (filePtr->fd == fd) {
- break;
- }
- }
-
- /*
- * Clean up information in the callback record.
- */
-
- if (prevPtr == NULL) {
- notifier.firstFileHandlerPtr = filePtr->nextPtr;
- } else {
- prevPtr->nextPtr = filePtr->nextPtr;
- }
- if (filePtr->mask & TCL_READABLE) {
- XtRemoveInput(filePtr->read);
- }
- if (filePtr->mask & TCL_WRITABLE) {
- XtRemoveInput(filePtr->write);
- }
- if (filePtr->mask & TCL_EXCEPTION) {
- XtRemoveInput(filePtr->except);
- }
- ckfree((char *) filePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileProc --
- *
- * These procedures are called by Xt when a file becomes readable,
- * writable, or has an exception.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Makes an entry on the Tcl event queue if the event is
- * interesting.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FileProc(clientData, fd, id)
- caddr_t clientData;
- int *fd;
- XtInputId *id;
-{
- FileHandler *filePtr = (FileHandler *)clientData;
- FileHandlerEvent *fileEvPtr;
- int mask = 0;
-
- /*
- * Determine which event happened.
- */
-
- if (*id == filePtr->read) {
- mask = TCL_READABLE;
- } else if (*id == filePtr->write) {
- mask = TCL_WRITABLE;
- } else if (*id == filePtr->except) {
- mask = TCL_EXCEPTION;
- }
-
- /*
- * Ignore unwanted or duplicate events.
- */
-
- if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) {
- return;
- }
-
- /*
- * This is an interesting event, so put it onto the event queue.
- */
-
- filePtr->readyMask |= mask;
- fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
- fileEvPtr->header.proc = FileHandlerEventProc;
- fileEvPtr->fd = filePtr->fd;
- Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
-
- /*
- * Process events on the Tcl event queue before returning to Xt.
- */
-
- Tcl_ServiceAll();
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileHandlerEventProc --
- *
- * This procedure is called by Tcl_ServiceEvent when a file event
- * reaches the front of the event queue. This procedure is
- * responsible for actually handling the event by invoking the
- * callback for the file handler.
- *
- * Results:
- * Returns 1 if the event was handled, meaning it should be removed
- * from the queue. Returns 0 if the event was not handled, meaning
- * it should stay on the queue. The only time the event isn't
- * handled is if the TCL_FILE_EVENTS flag bit isn't set.
- *
- * Side effects:
- * Whatever the file handler's callback procedure does.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileHandlerEventProc(evPtr, flags)
- Tcl_Event *evPtr; /* Event to service. */
- int flags; /* Flags that indicate what events to
- * handle, such as TCL_FILE_EVENTS. */
-{
- FileHandler *filePtr;
- FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
- int mask;
-
- if (!(flags & TCL_FILE_EVENTS)) {
- return 0;
- }
-
- /*
- * Search through the file handlers to find the one whose handle matches
- * the event. We do this rather than keeping a pointer to the file
- * handler directly in the event, so that the handler can be deleted
- * while the event is queued without leaving a dangling pointer.
- */
-
- for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
- filePtr = filePtr->nextPtr) {
- if (filePtr->fd != fileEvPtr->fd) {
- continue;
- }
-
- /*
- * The code is tricky for two reasons:
- * 1. The file handler's desired events could have changed
- * since the time when the event was queued, so AND the
- * ready mask with the desired mask.
- * 2. The file could have been closed and re-opened since
- * the time when the event was queued. This is why the
- * ready mask is stored in the file handler rather than
- * the queued event: it will be zeroed when a new
- * file handler is created for the newly opened file.
- */
-
- mask = filePtr->readyMask & filePtr->mask;
- filePtr->readyMask = 0;
- if (mask != 0) {
- (*filePtr->proc)(filePtr->clientData, mask);
- }
- break;
- }
- return 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_WaitForEvent --
- *
- * This function is called by Tcl_DoOneEvent to wait for new
- * events on the message queue. If the block time is 0, then
- * Tcl_WaitForEvent just polls without blocking.
- *
- * Results:
- * Returns 1 if an event was found, else 0. This ensures that
- * Tcl_DoOneEvent will return 1, even if the event is handled
- * by non-Tcl code.
- *
- * Side effects:
- * Queues file events that are detected by the select.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_WaitForEvent(
- Tcl_Time *timePtr) /* Maximum block time, or NULL. */
-{
- int timeout;
-
- if (!initialized) {
- InitNotifier();
- }
-
- TclSetAppContext(NULL);
-
- if (timePtr) {
- timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
- if (timeout == 0) {
- if (XtAppPending(notifier.appContext)) {
- goto process;
- } else {
- return 0;
- }
- } else {
- Tcl_SetTimer(timePtr);
- }
- }
-process:
- XtAppProcessEvent(notifier.appContext, XtIMAll);
- return 1;
-}
+ */
+
+#include <X11/Intrinsic.h>
+#include <tclInt.h>
+
+/*
+ * This structure is used to keep track of the notifier info for a
+ * a registered file.
+ */
+
+typedef struct FileHandler {
+ int fd;
+ int mask; /* Mask of desired events: TCL_READABLE, etc. */
+ int readyMask; /* Events that have been seen since the
+ last time FileHandlerEventProc was called
+ for this file. */
+ XtInputId read; /* Xt read callback handle. */
+ XtInputId write; /* Xt write callback handle. */
+ XtInputId except; /* Xt exception callback handle. */
+ Tcl_FileProc *proc; /* Procedure to call, in the style of
+ * Tcl_CreateFileHandler. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct FileHandler *nextPtr;/* Next in list of all files we care about. */
+} FileHandler;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * file handlers are ready to fire.
+ */
+
+typedef struct FileHandlerEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ int fd; /* File descriptor that is ready. Used
+ * to find the FileHandler structure for
+ * the file (can't point directly to the
+ * FileHandler structure because it could
+ * go away while the event is queued). */
+} FileHandlerEvent;
+
+/*
+ * The following static structure contains the state information for the
+ * Xt based implementation of the Tcl notifier.
+ */
+
+static struct NotifierState {
+ XtAppContext appContext; /* The context used by the Xt
+ * notifier. Can be set with
+ * TclSetAppContext. */
+ int appContextCreated; /* Was it created by us? */
+ XtIntervalId currentTimeout; /* Handle of current timer. */
+ FileHandler *firstFileHandlerPtr; /* Pointer to head of file handler
+ * list. */
+} notifier;
+
+/*
+ * The following static indicates whether this module has been initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * Static routines defined in this file.
+ */
+
+static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static void FileProc _ANSI_ARGS_((caddr_t clientData,
+ int *source, XtInputId *id));
+void InitNotifier _ANSI_ARGS_((void));
+static void NotifierExitHandler _ANSI_ARGS_((
+ ClientData clientData));
+static void TimerProc _ANSI_ARGS_((caddr_t clientData,
+ XtIntervalId *id));
+static void CreateFileHandler _ANSI_ARGS_((int fd, int mask,
+ Tcl_FileProc * proc, ClientData clientData));
+static void DeleteFileHandler _ANSI_ARGS_((int fd));
+static void SetTimer _ANSI_ARGS_((Tcl_Time * timePtr));
+static int WaitForEvent _ANSI_ARGS_((Tcl_Time * timePtr));
+
+/*
+ * Functions defined in this file for use by users of the Xt Notifier:
+ */
+
+EXTERN XtAppContext TclSetAppContext _ANSI_ARGS_((XtAppContext ctx));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetAppContext --
+ *
+ * Set the notifier application context.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the application context used by the notifier. Panics if
+ * the context is already set when called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XtAppContext
+TclSetAppContext(appContext)
+ XtAppContext appContext;
+{
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ /*
+ * If we already have a context we check whether we were asked to set a
+ * new context. If so, we panic because we try to prevent switching
+ * contexts by mistake. Otherwise, we return the one we have.
+ */
+
+ if (notifier.appContext != NULL) {
+ if (appContext != NULL) {
+
+ /*
+ * We already have a context. We do not allow switching contexts
+ * after initialization, so we panic.
+ */
+
+ panic("TclSetAppContext: multiple application contexts");
+
+ }
+ } else {
+
+ /*
+ * If we get here we have not yet gotten a context, so either create
+ * one or use the one supplied by our caller.
+ */
+
+ if (appContext == NULL) {
+
+ /*
+ * We must create a new context and tell our caller what it is, so
+ * she can use it too.
+ */
+
+ notifier.appContext = XtCreateApplicationContext();
+ notifier.appContextCreated = 1;
+ } else {
+
+ /*
+ * Otherwise we remember the context that our caller gave us
+ * and use it.
+ */
+
+ notifier.appContextCreated = 0;
+ notifier.appContext = appContext;
+ }
+ }
+
+ return notifier.appContext;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitNotifier --
+ *
+ * Initializes the notifier state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new exit handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+InitNotifier()
+{
+ Tcl_NotifierProcs notifier;
+ /*
+ * Only reinitialize if we are not in exit handling. The notifier
+ * can get reinitialized after its own exit handler has run, because
+ * of exit handlers for the I/O and timer sub-systems (order dependency).
+ */
+
+ if (TclInExit()) {
+ return;
+ }
+
+ notifier.createFileHandlerProc = CreateFileHandler;
+ notifier.deleteFileHandlerProc = DeleteFileHandler;
+ notifier.setTimerProc = SetTimer;
+ notifier.waitForEventProc = WaitForEvent;
+ Tcl_SetNotifier(&notifier);
+
+ /*
+ * DO NOT create the application context yet; doing so would prevent
+ * external applications from setting it for us to their own ones.
+ */
+
+ initialized = 1;
+ memset(&notifier, 0, sizeof(notifier));
+ Tcl_CreateExitHandler(NotifierExitHandler, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierExitHandler --
+ *
+ * This function is called to cleanup the notifier state before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys the notifier window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NotifierExitHandler(
+ ClientData clientData) /* Not used. */
+{
+ if (notifier.currentTimeout != 0) {
+ XtRemoveTimeOut(notifier.currentTimeout);
+ }
+ for (; notifier.firstFileHandlerPtr != NULL; ) {
+ Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
+ }
+ if (notifier.appContextCreated) {
+ XtDestroyApplicationContext(notifier.appContext);
+ notifier.appContextCreated = 0;
+ notifier.appContext = NULL;
+ }
+ initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetTimer --
+ *
+ * This procedure sets the current notifier timeout value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Replaces any previous timer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetTimer(timePtr)
+ Tcl_Time *timePtr; /* Timeout value, may be NULL. */
+{
+ long timeout;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ TclSetAppContext(NULL);
+ if (notifier.currentTimeout != 0) {
+ XtRemoveTimeOut(notifier.currentTimeout);
+ }
+ if (timePtr) {
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ notifier.currentTimeout =
+ XtAppAddTimeOut(notifier.appContext, (unsigned long) timeout,
+ TimerProc, NULL);
+ } else {
+ notifier.currentTimeout = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerProc --
+ *
+ * This procedure is the XtTimerCallbackProc used to handle
+ * timeouts.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Processes all queued events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerProc(data, id)
+ caddr_t data; /* Not used. */
+ XtIntervalId *id;
+{
+ if (*id != notifier.currentTimeout) {
+ return;
+ }
+ notifier.currentTimeout = 0;
+
+ Tcl_ServiceAll();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateFileHandler --
+ *
+ * This procedure registers a file handler with the Xt notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new file handler structure and registers one or more
+ * input procedures with Xt.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CreateFileHandler(fd, mask, proc, clientData)
+ int fd; /* Handle of stream to watch. */
+ int mask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION:
+ * indicates conditions under which
+ * proc should be called. */
+ Tcl_FileProc *proc; /* Procedure to call for each
+ * selected event. */
+ ClientData clientData; /* Arbitrary data to pass to proc. */
+{
+ FileHandler *filePtr;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ TclSetAppContext(NULL);
+
+ for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+ if (filePtr == NULL) {
+ filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
+ filePtr->fd = fd;
+ filePtr->read = 0;
+ filePtr->write = 0;
+ filePtr->except = 0;
+ filePtr->readyMask = 0;
+ filePtr->mask = 0;
+ filePtr->nextPtr = notifier.firstFileHandlerPtr;
+ notifier.firstFileHandlerPtr = filePtr;
+ }
+ filePtr->proc = proc;
+ filePtr->clientData = clientData;
+
+ /*
+ * Register the file with the Xt notifier, if it hasn't been done yet.
+ */
+
+ if (mask & TCL_READABLE) {
+ if (!(filePtr->mask & TCL_READABLE)) {
+ filePtr->read =
+ XtAppAddInput(notifier.appContext, fd, XtInputReadMask,
+ FileProc, filePtr);
+ }
+ } else {
+ if (filePtr->mask & TCL_READABLE) {
+ XtRemoveInput(filePtr->read);
+ }
+ }
+ if (mask & TCL_WRITABLE) {
+ if (!(filePtr->mask & TCL_WRITABLE)) {
+ filePtr->write =
+ XtAppAddInput(notifier.appContext, fd, XtInputWriteMask,
+ FileProc, filePtr);
+ }
+ } else {
+ if (filePtr->mask & TCL_WRITABLE) {
+ XtRemoveInput(filePtr->write);
+ }
+ }
+ if (mask & TCL_EXCEPTION) {
+ if (!(filePtr->mask & TCL_EXCEPTION)) {
+ filePtr->except =
+ XtAppAddInput(notifier.appContext, fd, XtInputExceptMask,
+ FileProc, filePtr);
+ }
+ } else {
+ if (filePtr->mask & TCL_EXCEPTION) {
+ XtRemoveInput(filePtr->except);
+ }
+ }
+ filePtr->mask = mask;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteFileHandler --
+ *
+ * Cancel a previously-arranged callback arrangement for
+ * a file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a callback was previously registered on file, remove it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteFileHandler(fd)
+ int fd; /* Stream id for which to remove
+ * callback procedure. */
+{
+ FileHandler *filePtr, *prevPtr;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ TclSetAppContext(NULL);
+
+ /*
+ * Find the entry for the given file (and return if there
+ * isn't one).
+ */
+
+ for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ if (filePtr == NULL) {
+ return;
+ }
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+
+ /*
+ * Clean up information in the callback record.
+ */
+
+ if (prevPtr == NULL) {
+ notifier.firstFileHandlerPtr = filePtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = filePtr->nextPtr;
+ }
+ if (filePtr->mask & TCL_READABLE) {
+ XtRemoveInput(filePtr->read);
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ XtRemoveInput(filePtr->write);
+ }
+ if (filePtr->mask & TCL_EXCEPTION) {
+ XtRemoveInput(filePtr->except);
+ }
+ ckfree((char *) filePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileProc --
+ *
+ * These procedures are called by Xt when a file becomes readable,
+ * writable, or has an exception.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Makes an entry on the Tcl event queue if the event is
+ * interesting.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileProc(clientData, fd, id)
+ caddr_t clientData;
+ int *fd;
+ XtInputId *id;
+{
+ FileHandler *filePtr = (FileHandler *)clientData;
+ FileHandlerEvent *fileEvPtr;
+ int mask = 0;
+
+ /*
+ * Determine which event happened.
+ */
+
+ if (*id == filePtr->read) {
+ mask = TCL_READABLE;
+ } else if (*id == filePtr->write) {
+ mask = TCL_WRITABLE;
+ } else if (*id == filePtr->except) {
+ mask = TCL_EXCEPTION;
+ }
+
+ /*
+ * Ignore unwanted or duplicate events.
+ */
+
+ if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) {
+ return;
+ }
+
+ /*
+ * This is an interesting event, so put it onto the event queue.
+ */
+
+ filePtr->readyMask |= mask;
+ fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+
+ /*
+ * Process events on the Tcl event queue before returning to Xt.
+ */
+
+ Tcl_ServiceAll();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileHandlerEventProc --
+ *
+ * This procedure is called by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure is
+ * responsible for actually handling the event by invoking the
+ * callback for the file handler.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the file handler's callback procedure does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileHandlerEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event to service. */
+ int flags; /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+{
+ FileHandler *filePtr;
+ FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
+ int mask;
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /*
+ * Search through the file handlers to find the one whose handle matches
+ * the event. We do this rather than keeping a pointer to the file
+ * handler directly in the event, so that the handler can be deleted
+ * while the event is queued without leaving a dangling pointer.
+ */
+
+ for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd != fileEvPtr->fd) {
+ continue;
+ }
+
+ /*
+ * The code is tricky for two reasons:
+ * 1. The file handler's desired events could have changed
+ * since the time when the event was queued, so AND the
+ * ready mask with the desired mask.
+ * 2. The file could have been closed and re-opened since
+ * the time when the event was queued. This is why the
+ * ready mask is stored in the file handler rather than
+ * the queued event: it will be zeroed when a new
+ * file handler is created for the newly opened file.
+ */
+
+ mask = filePtr->readyMask & filePtr->mask;
+ filePtr->readyMask = 0;
+ if (mask != 0) {
+ (*filePtr->proc)(filePtr->clientData, mask);
+ }
+ break;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForEvent --
+ *
+ * This function is called by Tcl_DoOneEvent to wait for new
+ * events on the message queue. If the block time is 0, then
+ * Tcl_WaitForEvent just polls without blocking.
+ *
+ * Results:
+ * Returns 1 if an event was found, else 0. This ensures that
+ * Tcl_DoOneEvent will return 1, even if the event is handled
+ * by non-Tcl code.
+ *
+ * Side effects:
+ * Queues file events that are detected by the select.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForEvent(
+ Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+{
+ int timeout;
+
+ if (!initialized) {
+ InitNotifier();
+ }
+
+ TclSetAppContext(NULL);
+
+ if (timePtr) {
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ if (timeout == 0) {
+ if (XtAppPending(notifier.appContext)) {
+ goto process;
+ } else {
+ return 0;
+ }
+ } else {
+ Tcl_SetTimer(timePtr);
+ }
+ }
+process:
+ XtAppProcessEvent(notifier.appContext, XtIMAll);
+ return 1;
+}
diff --git a/tcl/unix/tclXtTest.c b/tcl/unix/tclXtTest.c
index bc6046f8473..25e4bc32848 100644
--- a/tcl/unix/tclXtTest.c
+++ b/tcl/unix/tclXtTest.c
@@ -16,6 +16,8 @@
static int TesteventloopCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
+extern void InitNotifier _ANSI_ARGS_((void));
+
/*
*----------------------------------------------------------------------
@@ -28,7 +30,7 @@ static int TesteventloopCmd _ANSI_ARGS_((ClientData clientData,
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -40,6 +42,11 @@ int
Tclxttest_Init(interp)
Tcl_Interp *interp; /* Interpreter for application. */
{
+ if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ return TCL_ERROR;
+ }
+ XtToolkitInitialize();
+ InitNotifier();
Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
@@ -111,3 +118,4 @@ TesteventloopCmd(clientData, interp, argc, argv)
}
return TCL_OK;
}
+
diff --git a/tcl/win/Makefile.in b/tcl/win/Makefile.in
index d3f6d191e59..f43ed26fb00 100644
--- a/tcl/win/Makefile.in
+++ b/tcl/win/Makefile.in
@@ -1,626 +1,558 @@
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-
-# This file is CYGNUS LOCAL. It is a copy of makefile.vc from the
-# standard tcl distribution, modified to work with cygwin and an
-# autoconf configure script. I have chosen to minimize the number of
-# changes, so the comments continue to refer to Visual C++ and the
-# like. This should make it easier to merge in a new version if that
-# is necessary.
-
-prefix = @prefix@
-exec_prefix = @exec_prefix@
-VPATH = @srcdir@:@srcdir@/../generic:@srcdir@/../compat
-srcdir = @srcdir@
-
-INSTALL = @INSTALL@
-INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
-
-CC = @CC@
-CFLAGS = @CFLAGS@
-NM = @NM@
-AS = @AS@
-LD = @LD@
-DLLTOOL = @DLLTOOL@
-WINDRES = @WINDRES@
-
-DLL_LDFLAGS = @DLL_LDFLAGS@
-DLL_LDLIBS = @DLL_LDLIBS@
-TCL_ALLOC_OBJ = @TCL_ALLOC_OBJ@
-
-OBJEXT=@OBJEXT@
-
-# Current Tcl version; used in various names.
-
-DIRVERSION = @TCL_VERSION@
+#
+# This file is a Makefile for Tcl. If it has the name "Makefile.in"
+# then it is a template for a Makefile; to generate the actual Makefile,
+# run "./configure", which is a configuration script generated by the
+# "autoconf" program (constructs like "@foo@" will get replaced in the
+# actual Makefile.
+#
+# RCS: @(#) $Id$
+
+VERSION = @TCL_VERSION@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+includedir = @includedir@
+mandir = @mandir@
# The following definition can be set to non-null for special systems
# like AFS with replication. It allows the pathnames used for installation
# to be different than those used for actually reference files at
# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
# when installing files.
-INSTALL_ROOT =
+INSTALL_ROOT =
-# Directory from which applications will reference the library of Tcl
+# Directory from which applications will reference the libary of Tcl
# scripts (note: you can set the TCL_LIBRARY environment variable at
# run-time to override this value):
-TCL_LIBRARY = @datadir@/tcl$(DIRVERSION)
-
-# Path name to use when installing library scripts:
-SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
+TCL_LIBRARY = @datadir@/tcl$(VERSION)
-# Directory in which to install libtcl.so or libtcl.a:
-LIB_INSTALL_DIR = $(INSTALL_ROOT)@libdir@
+# Path to use at runtime to refer to LIB_INSTALL_DIR:
+LIB_RUNTIME_DIR = $(libdir)
# Directory in which to install the program tclsh:
-BIN_INSTALL_DIR = $(INSTALL_ROOT)@bindir@
+BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir)
+
+# Directory in which to install the .a or .so binary for the Tcl library:
+LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
+
+# Path name to use when installing library scripts.
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
# Directory in which to install the include file tcl.h:
-INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@includedir@
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
+
+# Top-level directory in which to install manual entries:
+MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir)
+
+# Directory in which to install manual entry for tclsh:
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+
+# Directory in which to install manual entries for Tcl's C library
+# procedures:
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tcl commands:
+MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+
+# Libraries built with optimization switches have this additional extension
+TCL_DBGX = @TCL_DBGX@
+
+# warning flags
+CFLAGS_WARNING = @CFLAGS_WARNING@
+
+# The default switches for optimization or debugging
+CFLAGS_DEBUG = @CFLAGS_DEBUG@
+CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
+
+# To enable compilation debugging reverse the comment characters on
+# one of the following lines.
+COMPILE_DEBUG_FLAGS =
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+
+# The default switches for optimization or debugging
+LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
+LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
+
+# To change the compiler switches, for example to change from optimization to
+# debugging symbols, change the following line:
+#CFLAGS = $(CFLAGS_DEBUG)
+#CFLAGS = $(CFLAGS_OPTIMIZE)
+#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
+
+# Special compiler flags to use when building man2tcl on Windows.
+MAN2TCLFLAGS = @MAN2TCLFLAGS@
+
+SRC_DIR = @srcdir@
+ROOT_DIR = @srcdir@/..
+GENERIC_DIR = @srcdir@/../generic
+WIN_DIR = @srcdir@
+COMPAT_DIR = @srcdir@/../compat
+
+# This converts a POSIX path to a Windows native path
+CYGPATH = @CYGPATH@
+
+GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)')
+WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)')
+ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)')
+
+LIBRARY_DIR = $(shell echo '$(ROOT_DIR_NATIVE)/library' | sed 's/\\/\//g' )
+
+VENDORPREFIX = @VENDORPREFIX@
+DLLSUFFIX = @DLLSUFFIX@
+LIBSUFFIX = @LIBSUFFIX@
+EXESUFFIX = @EXESUFFIX@
+LIBPREFIX = @LIBPREFIX@
+
+TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
+TCL_DLL_FILE = @TCL_DLL_FILE@
+TCL_LIB_FILE = @TCL_LIB_FILE@
+GNU_TCL_LIB_FILE = @GNU_TCL_LIB_FILE@
+MSVC_TCL_LIB_FILE = @MSVC_TCL_LIB_FILE@
+DDE_DLL_FILE = @DDE_DLL_FILE@
+DDE_LIB_FILE = @DDE_LIB_FILE@
+REG_DLL_FILE = @REG_DLL_FILE@
+REG_LIB_FILE = @REG_LIB_FILE@
+PIPE_DLL_FILE = @PIPE_DLL_FILE@
+
+SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \
+ $(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE)
+STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE)
+
+TCLSH = tclsh$(VER)${EXESUFFIX}
+TCLTEST = tcltest${EXEEXT}
+CAT32 = cat32$(EXEEXT)
+MAN2TCL = man2tcl$(EXEEXT)
+
+SET_MAKE=@SET_MAKE@
+
+# Setting the VPATH variable to a list of paths will cause the
+# makefile to look into these paths when resolving .c to .obj
+# dependencies.
+
+VPATH = $(GENERIC_DIR):$(WIN_DIR):$(COMPAT_DIR)
+
+AR = @AR@
+RANLIB = @RANLIB@
+CC = @CC@
+RC = @RC@
+RES = @RES@
+AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
+LDFLAGS_CONSOLE = @LDFLAGS_CONSOLE@
+LDFLAGS_WINDOW = @LDFLAGS_WINDOW@
+EXEEXT = @EXEEXT@
+OBJEXT = @OBJEXT@
+STLIB_LD = @STLIB_LD@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(LIBS)
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
+DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
+LIBS = @LIBS@
+
+RMDIR = rm -rf
+MKDIR = mkdir -p
+SHELL = @SHELL@
+RM = rm -f
+COPY = cp
+
+CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
+-I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
+${COMPILE_DEBUG_FLAGS}
+
+CC_OBJNAME = @CC_OBJNAME@
+CC_EXENAME = @CC_EXENAME@
+
+STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
+-I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
+${COMPILE_DEBUG_FLAGS}
+
+TCLTEST_OBJS = \
+ tclTest.$(OBJEXT) \
+ tclTestObj.$(OBJEXT) \
+ tclTestProcBodyObj.$(OBJEXT) \
+ tclThreadTest.$(OBJEXT) \
+ tclWinTest.$(OBJEXT) \
+ testMain.$(OBJEXT)
+
+GENERIC_OBJS = \
+ regcomp.$(OBJEXT) \
+ regexec.$(OBJEXT) \
+ regfree.$(OBJEXT) \
+ regerror.$(OBJEXT) \
+ tclAlloc.$(OBJEXT) \
+ tclAsync.$(OBJEXT) \
+ tclBasic.$(OBJEXT) \
+ tclBinary.$(OBJEXT) \
+ tclCkalloc.$(OBJEXT) \
+ tclClock.$(OBJEXT) \
+ tclCmdAH.$(OBJEXT) \
+ tclCmdIL.$(OBJEXT) \
+ tclCmdMZ.$(OBJEXT) \
+ tclCompCmds.$(OBJEXT) \
+ tclCompExpr.$(OBJEXT) \
+ tclCompile.$(OBJEXT) \
+ tclDate.$(OBJEXT) \
+ tclEncoding.$(OBJEXT) \
+ tclEnv.$(OBJEXT) \
+ tclEvent.$(OBJEXT) \
+ tclExecute.$(OBJEXT) \
+ tclFCmd.$(OBJEXT) \
+ tclFileName.$(OBJEXT) \
+ tclGet.$(OBJEXT) \
+ tclHash.$(OBJEXT) \
+ tclHistory.$(OBJEXT) \
+ tclIndexObj.$(OBJEXT) \
+ tclInterp.$(OBJEXT) \
+ tclIO.$(OBJEXT) \
+ tclIOCmd.$(OBJEXT) \
+ tclIOGT.$(OBJEXT) \
+ tclIOSock.$(OBJEXT) \
+ tclIOUtil.$(OBJEXT) \
+ tclLink.$(OBJEXT) \
+ tclLiteral.$(OBJEXT) \
+ tclListObj.$(OBJEXT) \
+ tclLoad.$(OBJEXT) \
+ tclMain.$(OBJEXT) \
+ tclNamesp.$(OBJEXT) \
+ tclNotify.$(OBJEXT) \
+ tclObj.$(OBJEXT) \
+ tclPanic.$(OBJEXT) \
+ tclParse.$(OBJEXT) \
+ tclParseExpr.$(OBJEXT) \
+ tclPipe.$(OBJEXT) \
+ tclPkg.$(OBJEXT) \
+ tclPosixStr.$(OBJEXT) \
+ tclPreserve.$(OBJEXT) \
+ tclProc.$(OBJEXT) \
+ tclRegexp.$(OBJEXT) \
+ tclResolve.$(OBJEXT) \
+ tclResult.$(OBJEXT) \
+ tclScan.$(OBJEXT) \
+ tclStringObj.$(OBJEXT) \
+ tclStubInit.$(OBJEXT) \
+ tclStubLib.$(OBJEXT) \
+ tclThread.$(OBJEXT) \
+ tclTimer.$(OBJEXT) \
+ tclUtf.$(OBJEXT) \
+ tclUtil.$(OBJEXT) \
+ tclVar.$(OBJEXT)
+
+WIN_OBJS = \
+ tclWin32Dll.$(OBJEXT) \
+ tclWinChan.$(OBJEXT) \
+ tclWinConsole.$(OBJEXT) \
+ tclWinSerial.$(OBJEXT) \
+ tclWinError.$(OBJEXT) \
+ tclWinFCmd.$(OBJEXT) \
+ tclWinFile.$(OBJEXT) \
+ tclWinInit.$(OBJEXT) \
+ tclWinLoad.$(OBJEXT) \
+ tclWinMtherr.$(OBJEXT) \
+ tclWinNotify.$(OBJEXT) \
+ tclWinPipe.$(OBJEXT) \
+ tclWinSock.$(OBJEXT) \
+ tclWinThrd.$(OBJEXT) \
+ tclWinTime.$(OBJEXT)
+
+COMPAT_OBJS = \
+ strftime.$(OBJEXT)
+
+PIPE_OBJS = stub16.$(OBJEXT)
+
+DDE_OBJS = tclWinDde.$(OBJEXT)
+
+REG_OBJS = tclWinReg.$(OBJEXT)
+
+STUB_OBJS = tclStubLib.$(OBJEXT)
+
+TCLSH_OBJS = tclAppInit.$(OBJEXT)
+
+TCL_OBJS = ${GENERIC_OBJS} ${WIN_OBJS} ${COMPAT_OBJS}
+
+TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
+
+all: binaries libraries doc
+
+tcltest: $(TCLTEST)
+
+binaries: @LIBRARIES@ $(TCLSH)
+
+libraries:
+
+doc:
+
+winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL)
+ TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
+ ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS)
+ hcw /c /e tcl.hpj
+
+$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c
+ $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c
+
+$(TCLSH): $(TCL_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES)
+ $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \
+ tclsh.$(RES) $(CC_EXENAME)
+
+$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES)
+ $(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \
+ tclsh.$(RES) $(CC_EXENAME)
-#
-# Visual C++ 2.x and 4.0 makefile
-#
-# Does not depend on the presence of any environment variables in
-# order to compile tcl; all needed information is derived from
-# location of the compiler directories.
+cat32.$(OBJEXT): cat.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-#
-# Project directories
-#
-# ROOT = top of source tree
-#
-# TMPDIR = location where .obj files should be stored during build
-#
-# TOOLS32 = location of VC++ 32-bit development tools. Note that the
-# VC++ 2.0 header files are broken, so you need to use the
-# ones that come with the developer network CD's, or later
-# versions of VC++.
-#
-# TOOLS16 = location of VC++ 1.5 16-bit tools, needed to build thunking
-# library. This information is optional; if the 16-bit compiler
-# is not available, then the 16-bit code will not be built.
-# Tcl will still run without the 16-bit code, but...
-# A. Under Windows 3.X you will any calls to the exec command
-# will return an error.
-# B. A 16-bit program to test the behavior of the exec
-# command under NT and 95 will not be built.
-#
+$(CAT32): cat32.$(OBJEXT)
+ $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
-ROOT = $(srcdir)/..
-TMPDIR = .
-TOOLS32 = c:\msdev
-TOOLS16 = c:\msvc
-
-# Set this to the appropriate value of /MACHINE: for your platform
-MACHINE = IX86
-
-# Comment the following line to compile with symbols
-NODEBUG=1
-
-# uncomment one of the following lines to compile with TCL_MEM_DEBUG,
-# TCL_MEM_DEBUG, or TCL_COMPILE_DEBUG
-#DEBUGDEFINES = -DTCL_MEM_DEBUG
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_STATS
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-
-######################################################################
-# Do not modify below this line
-######################################################################
-
-VERSION = 80
-
-TCLLIB = libtcl$(VERSION).a
-TCLDLL = cygtcl$(VERSION).dll
-TCLPLUGINLIB = libtcl$(VERSION)p.a
-TCLPLUGINDLL = cygtcl$(VERSION)p.dll
-TCL16DLL = # tcl16$(VERSION).dll
-TCLSH = cygtclsh$(VERSION).exe
-TCLSHP = cygtclshp$(VERSION).exe
-TCLTEST = tcltest.exe
-DUMPEXTS = # $(TMPDIR)\dumpexts.exe
-TCLPIPEDLL = cygtclpip$(VERSION).dll
-TCLREGDLL = cygtclreg$(VERSION).dll
-CAT16 = # cat16.exe
-CAT32 = cat32.exe
-
-ifeq ($(OBJEXT),obj)
-
-TCL_ALLOC_OBJ=$(TMPDIR)/tclAlloc.$(OBJEXT)
-
-endif
-
-TCLSHOBJS = \
- $(TMPDIR)/tclAppInit.$(OBJEXT)
-
-TCLTESTOBJS = \
- $(TMPDIR)/tclTest.$(OBJEXT) \
- $(TMPDIR)/tclTestObj.$(OBJEXT) \
- $(TMPDIR)/tclTestProcBodyObj.$(OBJEXT) \
- $(TMPDIR)/tclWinTest.$(OBJEXT) \
- $(TMPDIR)/testMain.$(OBJEXT)
-
-TCLOBJS = \
- $(TMPDIR)/panic.$(OBJEXT) \
- $(TMPDIR)/regexp.$(OBJEXT) \
- $(TMPDIR)/strftime.$(OBJEXT) \
- $(TCL_ALLOC_OBJ) \
- $(TMPDIR)/tclAsync.o \
- $(TMPDIR)/tclBasic.o \
- $(TMPDIR)/tclBinary.o \
- $(TMPDIR)/tclCkalloc.o \
- $(TMPDIR)/tclClock.o \
- $(TMPDIR)/tclCmdAH.o \
- $(TMPDIR)/tclCmdIL.o \
- $(TMPDIR)/tclCmdMZ.o \
- $(TMPDIR)/tclCompExpr.o \
- $(TMPDIR)/tclCompile.o \
- $(TMPDIR)/tclDate.o \
- $(TMPDIR)/tclEnv.o \
- $(TMPDIR)/tclEvent.o \
- $(TMPDIR)/tclExecute.o \
- $(TMPDIR)/tclFCmd.o \
- $(TMPDIR)/tclFileName.o \
- $(TMPDIR)/tclGet.o \
- $(TMPDIR)/tclHash.o \
- $(TMPDIR)/tclHistory.o \
- $(TMPDIR)/tclIndexObj.o \
- $(TMPDIR)/tclInterp.o \
- $(TMPDIR)/tclIO.o \
- $(TMPDIR)/tclIOCmd.o \
- $(TMPDIR)/tclIOSock.o \
- $(TMPDIR)/tclIOUtil.o \
- $(TMPDIR)/tclLink.o \
- $(TMPDIR)/tclListObj.o \
- $(TMPDIR)/tclLoad.o \
- $(TMPDIR)/tclMain.o \
- $(TMPDIR)/tclNamesp.o \
- $(TMPDIR)/tclNotify.o \
- $(TMPDIR)/tclObj.o \
- $(TMPDIR)/tclParse.o \
- $(TMPDIR)/tclPipe.o \
- $(TMPDIR)/tclPkg.o \
- $(TMPDIR)/tclPosixStr.o \
- $(TMPDIR)/tclPreserve.o \
- $(TMPDIR)/tclProc.o \
- $(TMPDIR)/tclResolve.o \
- $(TMPDIR)/tclStringObj.o \
- $(TMPDIR)/tclTimer.o \
- $(TMPDIR)/tclUtil.o \
- $(TMPDIR)/tclVar.o \
- $(TMPDIR)/tclWin32Dll.o \
- $(TMPDIR)/tclWinChan.o \
- $(TMPDIR)/tclWinError.o \
- $(TMPDIR)/tclWinFCmd.o \
- $(TMPDIR)/tclWinFile.o \
- $(TMPDIR)/tclWinInit.o \
- $(TMPDIR)/tclWinLoad.o \
- $(TMPDIR)/tclWinMtherr.o \
- $(TMPDIR)/tclWinNotify.o \
- $(TMPDIR)/tclWinPipe.o \
- $(TMPDIR)/tclWinSock.o \
- $(TMPDIR)/tclWinTime.o
-
-cc32 = $(TOOLS32)\bin\cl.exe
-link32 = $(TOOLS32)\bin\link.exe
-rc32 = $(TOOLS32)\bin\rc.exe
-include32 = -I$(TOOLS32)\include
-
-cc16 = $(TOOLS16)\bin\cl.exe
-link16 = $(TOOLS16)\bin\link.exe
-rc16 = $(TOOLS16)\bin\rc.exe
-include16 = -I$(TOOLS16)\include
-
-WINDIR = $(ROOT)/win
-GENERICDIR = $(ROOT)/generic
-
-TCL_INCLUDES = -I$(WINDIR) -I$(GENERICDIR)
-TCL_DEFINES = -D__WIN32__ $(DEBUGDEFINES)
-
-TCL_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) \
- $(TCL_INCLUDES) $(TCL_DEFINES) $(CFLAGS)
-CON_CFLAGS = $(cdebug) $(cflags) $(cvars) -DCONSOLE
-DOS_CFLAGS = $(cdebug) $(cflags) $(include16) -AL
-DLL16_CFLAGS = $(cdebug) $(cflags) $(include16) -ALw
-
-linkdebug =
-conlflags = -Wl,--subsystem,console -mwindows
-conlibsdll =
-
-######################################################################
-# Link flags
-######################################################################
-
-#!IFDEF NODEBUG
-#ldebug = /RELEASE
-#!ELSE
-#ldebug = -debug:full -debugtype:cv
-#!ENDIF
-
-# declarations common to all linker options
-lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
-
-# declarations for use on Intel i386, i486, and Pentium systems
-#!IF "$(MACHINE)" == "IX86"
-#DLLENTRY = @12
-#lflags = $(lcommon) -align:0x1000 /MACHINE:$(MACHINE)
-#!ELSE
-#lflags = $(lcommon) /MACHINE:$(MACHINE)
-#!ENDIF
-
-conlflags = -Wl,--subsystem,console -mwindows
-guilflags = -mwindows
-dlllflags =
-
-#!IF "$(MACHINE)" == "PPC"
-#libc = libc.lib
-#libcdll = crtdll.lib
-#!ELSE
-#libc = libc.lib oldnames.lib
-#libcdll = msvcrt.lib oldnames.lib
-#!ENDIF
-
-ifeq ($(OBJEXT),o)
-
-baselibs = -lkernel32 $(optlibs) -ladvapi32 -luser32
-winlibs = $(baselibs) -lgdi32 -lcomdlg32 -lwinspool
-
-else
-
-baselibs = kernel32.lib $(optlibs) advapi32.lib user32.lib
-winlibs = $(baselibs) gdi32.lib comdlg32.lib winspool.lib
-libcdll = msvcrt.lib oldnames.lib
-
-endif
-
-guilibs = $(libc) $(winlibs)
-conlibs = $(libc) $(baselibs)
-guilibsdll = $(libcdll) $(winlibs)
-conlibsdll = $(libcdll) $(baselibs)
-
-######################################################################
-# Compile flags
-######################################################################
-
-#!IFDEF NODEBUG
-#cdebug = -Ox
-#!ELSE
-#cdebug = -Z7 -Od -WX
-#!ENDIF
-
-# declarations common to all compiler options
-ccommon = -c -W3 -nologo -YX -Dtry=__try -Dexcept=__except
-
-#!IF "$(MACHINE)" == "IX86"
-#cflags = $(ccommon) -D_X86_=1
-#!ELSE
-#!IF "$(MACHINE)" == "MIPS"
-#cflags = $(ccommon) -D_MIPS_=1
-#!ELSE
-#!IF "$(MACHINE)" == "PPC"
-#cflags = $(ccommon) -D_PPC_=1
-#!ELSE
-#!IF "$(MACHINE)" == "ALPHA"
-#cflags = $(ccommon) -D_ALPHA_=1
-#!ENDIF
-#!ENDIF
-#!ENDIF
-#!ENDIF
-
-cvars = -DWIN32 -D_WIN32
-cvarsmt = $(cvars) -D_MT
-cvarsdll = $(cvarsmt) -D_DLL
-
-######################################################################
-# Project specific targets
-######################################################################
-
-release: $(TCLSH) dlls $(TCLLIB)
-dlls: $(TCLDLL) $(TCLPIPEDLL) $(TCLREGDLL)
-all: $(TCLSH) dlls $(CAT16) $(CAT32) $(TCLLIB)
-tcltest: $(TCLTEST) dlls $(CAT16) $(CAT32)
-plugin: $(TCLPLUGINDLL) $(TCLSHP)
-test: $(TCLTEST) dlls $(CAT16) $(CAT32)
- ( echo cd $(ROOT)/tests\; source all ) | $(TCLTEST)
-
-install: install-binaries install-libraries
-
-install-binaries: $(TCLDLL) $(TCLLIB) $(TCLSH) $(TCLPIPEDLL)
- @for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
- do \
- if [ ! -d $$i ] ; then \
- echo "Making directory $$i"; \
- mkdir $$i; \
- chmod 755 $$i; \
- else true; \
- fi; \
- done;
- @echo "Installing $(TCLLIB)"
- @$(INSTALL_DATA) $(TCLLIB) $(LIB_INSTALL_DIR)/$(TCLLIB)
- @chmod 555 $(LIB_INSTALL_DIR)/$(TCLLIB)
- @echo "Installing tclsh"
- @$(INSTALL_PROGRAM) $(TCLSH) $(BIN_INSTALL_DIR)/$(TCLSH)
- @echo "Installing tclConfig.sh"
- @$(INSTALL_DATA) ../unix/tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
+# The following targets are configured by autoconf to generate either
+# a shared library or static library
-install-libraries:
- @echo "Installing DLL"
- @$(INSTALL_DATA) $(TCLDLL) $(BIN_INSTALL_DIR)/$(TCLDLL)
- @$(INSTALL_DATA) $(TCLPIPEDLL) $(BIN_INSTALL_DIR)/$(TCLPIPEDLL)
- @$(INSTALL_DATA) $(TCLREGDLL) $(BIN_INSTALL_DIR)/$(TCLREGDLL)
- @for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
- $(SCRIPT_INSTALL_DIR) ; \
- do \
- if [ ! -d $$i ] ; then \
- echo "Making directory $$i"; \
- mkdir $$i; \
- chmod 755 $$i; \
- else true; \
- fi; \
- done;
- @for i in http2.0 http1.0 opt0.1 ; \
+${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
+ @$(RM) ${TCL_STUB_LIB_FILE}
+ @MAKE_LIB@ ${STUB_OBJS}
+ @POST_MAKE_LIB@
+
+${GNU_TCL_LIB_FILE}: ${TCL_DLL_FILE}
+
+${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES)
+ @$(RM) ${TCL_DLL_FILE}
+ @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
+
+${MSVC_TCL_LIB_FILE}: ${TCL_OBJS} ${TCL_DLL_FILE}
+ @$(RM) ${TCL_LIB_FILE}
+ @MAKE_LIB@ ${TCL_OBJS}
+ @POST_MAKE_LIB@
+
+${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE}
+ @$(RM) ${DDE_DLL_FILE}
+ @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
+
+${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE}
+ @$(RM) ${DDE_LIB_FILE}
+ @MAKE_LIB@ ${DDE_OBJS} ${TCL_LIB_FILE}
+
+${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE}
+ @$(RM) ${REG_DLL_FILE}
+ @MAKE_DLL@ ${REG_OBJS} ${TCL_STUB_LIB_FILE} $(SHLIB_LD_LIBS)
+
+${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE}
+ @$(RM) ${REG_LIB_FILE}
+ @MAKE_LIB@ ${REG_OBJS} ${TCL_LIB_FILE}
+
+# PIPE_DLL_FILE is actually an executable, don't build it
+# like a DLL.
+
+${PIPE_DLL_FILE}: ${PIPE_OBJS}
+ @$(RM) ${PIPE_DLL_FILE}
+ @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS)
+
+# Add the object extension to the implicit rules. By default .obj is not
+# automatically added.
+
+.SUFFIXES: .${OBJEXT}
+.SUFFIXES: .$(RES)
+.SUFFIXES: .rc
+
+# Special case object targets
+
+tclWinInit.${OBJEXT}: tclWinInit.c
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
+
+testMain.${OBJEXT}: tclAppInit.c
+ $(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)
+
+tclTest.${OBJEXT}: tclTest.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+tclTestObj.${OBJEXT}: tclTestObj.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+tclWinTest.${OBJEXT}: tclWinTest.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+tclAppInit.${OBJEXT} : tclAppInit.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+
+# The following objects should be built using the stub interfaces
+
+tclWinReg.${OBJEXT} : tclWinReg.c
+ $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME)
+
+tclWinDde.${OBJEXT} : tclWinDde.c
+ $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME)
+
+# The following objects are part of the stub library and should not
+# be built as DLL objects but none of the symbols should be exported
+
+tclStubLib.${OBJEXT}: tclStubLib.c
+ $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+
+
+# Implicit rule for all object files that will end up in the Tcl library
+
+.c.${OBJEXT}:
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)
+
+.rc.$(RES):
+ $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@
+
+install: all install-binaries install-libraries install-doc
+
+install-binaries:
+ @$(MKDIR) -p "$(BIN_INSTALL_DIR)"
+ @$(MKDIR) -p "$(LIB_INSTALL_DIR)"
+ $(COPY) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
+ @for i in dde1.1 reg1.0; \
do \
- if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
- echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
- mkdir $(SCRIPT_INSTALL_DIR)/$$i; \
- chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \
+ if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
+ echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
+ $(MKDIR) $(LIB_INSTALL_DIR)/$$i; \
else true; \
fi; \
done;
- @echo "Installing tcl.h"
- @$(INSTALL_DATA) $(GENERICDIR)/tcl.h $(INCLUDE_INSTALL_DIR)/tcl.h
- @for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex $(WINDIR)/tclAppInit.c; \
+ @for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \
do \
- echo "Installing $$i"; \
- $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
- done;
- @for i in http2.0 http1.0 opt0.1 ; \
+ if [ -f $$i ]; then \
+ echo "Installing $$i"; \
+ $(COPY) $$i "$(BIN_INSTALL_DIR)"; \
+ fi; \
+ done
+ @for i in $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
do \
- for j in $(ROOT)/library/$$i/*.tcl ; \
- do \
- echo "Installing $$j"; \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
- done; \
- done;
+ if [ -f $$i ]; then \
+ echo "Installing $$i"; \
+ $(COPY) $$i "$(LIB_INSTALL_DIR)"; \
+ fi; \
+ done
+ @if [ -f $(DDE_DLL_FILE) ]; then \
+ echo installing $(DDE_DLL_FILE); \
+ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.1; \
+ $(COPY) $(ROOT_DIR)/library/dde1.1/pkgIndex.tcl $(LIB_INSTALL_DIR)/dde1.1; \
+ fi
+ @if [ -f $(DDE_LIB_FILE) ]; then \
+ echo installing $(DDE_LIB_FILE); \
+ $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.1; \
+ fi
+ @if [ -f $(REG_DLL_FILE) ]; then \
+ echo installing $(REG_DLL_FILE); \
+ $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.0; \
+ $(COPY) $(ROOT_DIR)/library/reg1.0/pkgIndex.tcl $(LIB_INSTALL_DIR)/reg1.0; \
+ fi
+ @if [ -f $(REG_LIB_FILE) ]; then \
+ echo installing $(REG_LIB_FILE); \
+ $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.0; \
+ fi
-install-minimal:
- @echo "Installing DLL"
- @$(INSTALL_DATA) $(TCLDLL) $(BIN_INSTALL_DIR)/$(TCLDLL)
- @$(INSTALL_DATA) $(TCLPIPEDLL) $(BIN_INSTALL_DIR)/$(TCLPIPEDLL)
- @$(INSTALL_DATA) $(TCLREGDLL) $(BIN_INSTALL_DIR)/$(TCLREGDLL)
- @for i in $(INSTALL_ROOT)@datadir@ $(SCRIPT_INSTALL_DIR) ; \
+install-libraries:
+ @for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR); \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
- chmod 755 $$i; \
+ $(MKDIR) $$i; \
else true; \
fi; \
done;
- @for i in http2.0 http1.0 opt0.1 ; \
+ @for i in http1.0 http2.3 opt0.4 encoding msgcat1.0 tcltest1.0; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
- mkdir $(SCRIPT_INSTALL_DIR)/$$i; \
- chmod 755 $(SCRIPT_INSTALL_DIR)/$$i; \
+ $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
else true; \
fi; \
done;
- @for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex; \
+ @echo "Installing header files";
+ @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" ; \
+ do \
+ $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
+ done;
+ @echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
+ @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
do \
- echo "Installing $$i"; \
- $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
done;
- @for i in http2.0 http1.0 opt0.1 ; \
+ @for i in http2.3 http1.0 opt0.4 msgcat1.0 tcltest1.0; \
do \
- for j in $(ROOT)/library/$$i/*.tcl ; \
+ echo "Installing library $$i directory"; \
+ for j in $(ROOT_DIR)/library/$$i/*.tcl; \
do \
- echo "Installing $$j"; \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
+ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/$$i"; \
done; \
done;
+ @echo "Installing encodings"
+ @for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
+ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
+ done;
-# $(DUMPEXTS): $(WINDIR)/winDumpExts.c
-# $(CC) -c $(CON_CFLAGS) $?
-# $(CC) $(linkdebug) $(conlflags) -o $@ $(TMPDIR)/winDumpExts.$(OBJEXT)bj $(guilibs)
-
-
-ifeq ($(OBJEXT),o)
-
-$(TCLDLL): $(TCLOBJS) tclres.$(OBJEXT) $(TMPDIR)/tclcyg.def
- $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tcl.base -o $(TCLDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66000000
- $(DLLTOOL) --as=$(AS) --dllname $(TCLDLL) --def $(TMPDIR)/tclcyg.def --base-file tcl.base --output-exp tcl.exp
- $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tcl.base,tcl.exp -o $(TCLDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66000000
- $(DLLTOOL) --as=$(AS) --dllname $(TCLDLL) --def $(TMPDIR)/tclcyg.def --base-file tcl.base --output-exp tcl.exp
- $(CC) $(DLL_LDFLAGS) -Wl,tcl.exp -o $(TCLDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66000000
-
-else
-
-$(TCLDLL): $(TCLOBJS) $(TMPDIR)/tclcyg.def tclres.$(OBJEXT)
- link.exe $(ldebug) $(dlllflags) -dll -def:$(TMPDIR)/tclcyg.def -NODEFAULTLIB \
- -out:$(TCLDLL) tclres.$(OBJEXT) $(guilibsdll) $(TCLOBJS) \
- -entry:_DllMainCRTStartup@12
- mv cygtcl80.lib $(TCLLIB)
-endif
-
-
-ifeq ($(OBJEXT),o)
-
-$(TCLLIB): $(TMPDIR)/tclcyg.def
- $(DLLTOOL) --as=$(AS) --dllname $(TCLDLL) --def $(TMPDIR)/tclcyg.def --output-lib $(TCLLIB)
-
-else
-
-$(TCLLIB): $(TCLDLL)
-
-endif
-
-$(TCLPLUGINLIB): $(TMPDIR)/plugin.def
- $(DLLTOOL) --as=$(AS) --dllname $(TCLPLUGINDLL) --def $(TMPDIR)/plugin.def --output-lib $(TCLPLUGINLIB)
-
-$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)/plugin.def tclres.$(OBJEXT)
- $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tclplugin.base -o $(TCLPLUGINDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
- $(DLLTOOL) --as=$(AS) --dllname $(TCLPLUGINDLL) --def $(TMPDIR)/plugin.def --base-file tclplugin.base --output-exp tcl.exp
- $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tclplugin.base -Wl,tcl.exp -o $(TCLPLUGINDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
- $(DLLTOOL) --as=$(AS) --dllname $(TCLPLUGINDLL) --def $(TMPDIR)/plugin.def --base-file tclplugin.base --output-exp tcl.exp
- $(CC) $(DLL_LDFLAGS) -Wl,tcl.exp -o $(TCLPLUGINDLL) $(TCLOBJS) tclres.$(OBJEXT) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
-
-ifeq ($(OBJEXT),o)
-
-$(TCLSH): $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLLIB)
- $(CC) $(linkdebug) $(conlflags) -Wl,--stack=0x2300000 \
- -o $@ $(conlibsdll) $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLLIB)
-
-else
-
-$(TCLSH): $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLLIB)
- link $(linkdebug) $(conlflags) $(tclsh_flags) -NODEFAULTLIB -subsystem:console -entry:mainCRTStartup \
- -out:$@ $(conlibsdll) $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLLIB)
-
-endif
-
-$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) tclshres.$(OBJEXT)
- $(CC) $(linkdebug) $(conlflags) -Wl,--stack=0x2300000 \
- -o $@ $(conlibsdll) $(TCLSHOBJS) tclshres.$(OBJEXT) $(TCLPLUGINLIB)
-
-$(TCLTEST): $(TCLTESTOBJS) tclshres.$(OBJEXT) $(TCLLIB)
- $(CC) $(linkdebug) $(conlflags) -Wl,--stack=0x2300000 \
- -o $@ $(conlibsdll) $(TCLTESTOBJS) tclshres.$(OBJEXT) $(TCLLIB)
-
-# $(TCL16DLL): $(WINDIR)\tcl16.rc $(WINDIR)\tclWin16.c
-# if exist $(cc16) $(cc16) @<<
-# $(DLL16_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\tclWin16.c
-# <<
-# @copy << $(TMPDIR)\tclWin16.def > nul
-# LIBRARY $(@B);dll
-# EXETYPE WINDOWS
-# CODE PRELOAD MOVEABLE DISCARDABLE
-# DATA PRELOAD MOVEABLE SINGLE
-# HEAPSIZE 1024
-# EXPORTS
-# WEP @1 RESIDENTNAME
-# UTPROC @2
-# <<
-# if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOE @<<
-# $(TMPDIR)\tclWin16.obj
-# $@
-# nul
-# $(TOOLS16)\lib\ ldllcew oldnames libw toolhelp
-# $(TMPDIR)\tclWin16.def
-# <<
-# if exist $(cc16) $(rc16) -i $(GENERICDIR) $(TCL_DEFINES) $(WINDIR)\tcl16.rc $@
-
-ifeq ($(OBJEXT),o)
-
-$(TCLPIPEDLL): $(WINDIR)/stub16.c
- $(CC) -c $(CON_CFLAGS) $(WINDIR)/stub16.c
- $(CC) $(linkdebug) $(conlflags) -o $@ $(TMPDIR)/stub16.$(OBJEXT) $(guilibs)
-else
-
-$(TCLPIPEDLL): $(WINDIR)/stub16.c
- $(CC) -c $(CON_CFLAGS) -Fo$(TMPDIR)/ $(WINDIR)/stub16.c
- link $(ldebug) $(conlflags) -out:$@ $(TMPDIR)/stub16.obj $(guilibsdll)
-endif
-
-ifeq ($(OBJEXT),o)
-
-$(TCLREGDLL): $(TMPDIR)/tclWinReg.$(OBJEXT) $(TCLLIB)
- echo EXPORTS > $(TMPDIR)/tclreg.def
- echo Registry_Init >> $(TMPDIR)/tclreg.def
- $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tclreg.base -o $(TCLREGDLL) $(TMPDIR)/tclWinReg.$(OBJEXT) $(TCLLIB) $(DLL_LDLIBS) -ladvapi32 -mwindows -Wl,-e,_DllEntryPoint@12 -Wl,--image-base,0x66200000
- $(DLLTOOL) --as=$(AS) --dllname $(TCLREGDLL) --def $(TMPDIR)/tclreg.def --base-file tclreg.base --output-exp tclreg.exp
- $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tclreg.base -Wl,tclreg.exp -o $(TCLREGDLL) $(TMPDIR)/tclWinReg.$(OBJEXT) $(TCLLIB) $(DLL_LDLIBS) -ladvapi32 -mwindows -Wl,-e,_DllEntryPoint@12 -Wl,--image-base,0x66200000
- $(DLLTOOL) --as=$(AS) --dllname $(TCLREGDLL) --def $(TMPDIR)/tclreg.def --base-file tclreg.base --output-exp tclreg.exp
- $(CC) $(DLL_LDFLAGS) -Wl,tclreg.exp -o $(TCLREGDLL) $(TMPDIR)/tclWinReg.$(OBJEXT) $(TCLLIB) $(DLL_LDLIBS) -ladvapi32 -mwindows -Wl,-e,_DllEntryPoint@12 -Wl,--image-base,0x66200000
- rm -f $(TMPDIR)/tclreg.def
-else
-$(TCLREGDLL): $(TMPDIR)/tclWinReg.obj
- link $(ldebug) $(dlllflags) -out:$@ $(TMPDIR)/tclWinReg.obj \
- $(conlibsdll) $(TCLLIB) -entry:_DllMainCRTStartup@12
-endif
-
-ifeq ($(OBJEXT),o)
-
-$(CAT32): $(WINDIR)/cat.c
- $(CC) -c $(CON_CFLAGS) $?
- $(CC) -o $@ -Wl,-stack,16384 $(TMPDIR)/cat.$(OBJEXT) $(conlibs)
-
-else
-
-$(CAT32): $(WINDIR)/cat.c
- $(CC) $(CON_CFLAGS) -Fo$(TMPDIR)/ $(WINDIR)/cat.c
- link -subsystem:console -entry:mainCRTStartup -out:$@ -stack:16384 $(TMPDIR)/cat.obj $(conlibs)
-endif
-
-# $(CAT16): $(WINDIR)\cat.c
-# if exist $(cc16) $(cc16) $(DOS_CFLAGS) -Fo$(TMPDIR)\ $?
-# set LIB=$(TOOLS16)\lib
-# if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOI /STACK:16384 \
-# $(TMPDIR)\cat.obj,$@,nul,llibce.lib,nul
-
-$(TMPDIR)/tclcyg.def: $(DUMPEXTS) $(TCLOBJS)
- echo 'EXPORTS' > tmp.def
- -for o in $(TCLOBJS); do \
- $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
- done
- mv tmp.def $(TMPDIR)/tclcyg.def
-
-$(TMPDIR)/plugin.def: $(DUMPEXTS) $(TCLOBJS)
- echo 'EXPORTS' > tmp.def
- -for o in $(TCLOBJS); do \
- $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
- done
- mv tmp.def $(TMPDIR)/plugin.def
-
-#
-# Special case object file targets
-#
-
-$(TMPDIR)/testMain.$(OBJEXT): $(WINDIR)/tclAppInit.c
- $(CC) -c -o $(TMPDIR)/testMain.$(OBJEXT) $(TCL_CFLAGS) -DTCL_TEST $?
-
-#
-# Implicit rules
-#
-
-.SUFFIXES: .S .c .o .obj .s
-ifeq ($(OBJEXT),o)
-.c.$(OBJEXT):
- $(CC) -c $(TCL_CFLAGS) $<
-else
-.c.$(OBJEXT):
- $(CC) -c $(TCL_CFLAGS) -Dtry=__try -Dexcept=__except $<
-endif
+install-doc:
-ifeq ($(OBJEXT),o)
+test: binaries $(TCLTEST)
+ TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
+ ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
+ | ./$(CAT32)
-tclres.$(OBJEXT): $(srcdir)/tcl.rc
- $(WINDRES) --include $(GENERICDIR) --include $(WINDIR) --define __WIN32__ --define VS_VERSION_INFO=1 $(srcdir)/tcl.rc tclres.$(OBJEXT)
+# Useful target to launch a built tcltest with the proper path,...
+runtest: tcltest
+ @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
+ ./tcltest
-tclshres.$(OBJEXT): $(srcdir)/tclsh.rc
- $(WINDRES) --include $(GENERICDIR) --include $(WINDIR) --define __WIN32__ --define VS_VERSION_INFO=1 $(srcdir)/tclsh.rc tclshres.$(OBJEXT)
+depend:
-else
-
-tclres.$(OBJEXT): $(srcdir)/tcl.rc
- rc -i$(GENERICDIR) -i$(WINDIR) -d__WIN32__ -dVS_VERSION_INFO=1 -fotclres.$(OBJEXT) $(srcdir)/tcl.rc
+Makefile: $(SRC_DIR)/Makefile.in config.status
+ $(SHELL) config.status
-tclshres.$(OBJEXT): $(srcdir)/tclsh.rc
- rc -i$(GENERICDIR) -i$(WINDIR) -d__WIN32__ -dVS_VERSION_INFO=1 -fotclshres.$(OBJEXT) $(srcdir)/tclsh.rc
+config.status: $(WIN_DIR)/configure
+ $(SHELL) config.status --recheck
-endif
+cleanhelp:
+ $(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe
-#{$(WINDIR)}.rc{$(TMPDIR)}.res:
-# $(rc32) -fo $@ -r -i $(GENERICDIR) -i $(WINDIR) -D__WIN32__ \
-# $(TCL_DEFINES) $<
+clean: cleanhelp
+ $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
+ $(RM) $(TCLSH) $(TCLTEST) $(CAT32)
+ $(RM) *.pch *.ilk *.pdb
-clean:
- rm -f *.exp *.a *.dll *.exe $(TMPDIR)/*.$(OBJEXT) *.res *.def
- rm -f tcl.base tclreg.base tclplugin.base
+distclean: clean
+ $(RM) Makefile config.status config.cache config.log tclConfig.sh \
+ tcl.hpj
-Makefile: $(WINDIR)/Makefile.in config.status
- $(SHELL) config.status
+#
+# Regenerate the stubs files.
+#
-config.status: $(WINDIR)/configure
- ./config.status --recheck
+# FIXME: We can't depend on TCLSH here since it is not yet built!
+
+$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
+ $(GENERIC_DIR)/tclInt.decls
+ @TCL_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+ $(TCLSH) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ "$(GENERIC_DIR_NATIVE)" \
+ "$(GENERIC_DIR_NATIVE)\tcl.decls" \
+ "$(GENERIC_DIR_NATIVE)\tclInt.decls"
+
+genstubs:
+ @TCL_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+ $(TCLSH) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ "$(GENERIC_DIR_NATIVE)" \
+ "$(GENERIC_DIR_NATIVE)\tcl.decls" \
+ "$(GENERIC_DIR_NATIVE)\tclInt.decls"
diff --git a/tcl/win/README b/tcl/win/README
index 156743ea7e9..f382774470a 100644
--- a/tcl/win/README
+++ b/tcl/win/README
@@ -1,4 +1,4 @@
-Tcl 8.0.4 for Windows
+Tcl 8.3 for Windows
by Scott Stanton
Scriptics Corporation
@@ -11,182 +11,64 @@ RCS: @(#) $Id$
This is the directory where you configure and compile the Windows
version of Tcl. This directory also contains source files for Tcl
-that are specific to Microsoft Windows. The rest of this file
-contains information specific to the Windows version of Tcl.
+that are specific to Microsoft Windows.
-2. Distribution notes
----------------------
+The information in this file is maintained on the web at:
+ http://dev.scriptics.com/doc/howto/compile.html#win
-Tcl 8.0 for Windows is distributed in binary form in addition to the
-common source release. The binary distribution is a self-extracting
-archive with a built-in installation script.
-
-Look for the binary release in the same location as the source release
-(ftp.scriptics.com:/pub/tcl or any of the mirror sites). For most users,
-the binary release will be much easier to install and use. You only
-need the source release if you plan to modify the core of Tcl, or if
-you need to compile with a different compiler. With the addition of
-the dynamic loading interface, it is no longer necessary to have the
-source distribution in order to build and use extensions.
-
-3. Compiling Tcl
+2. Compiling Tcl
----------------
In order to compile Tcl for Windows, you need the following items:
- Tcl 8.0 Source Distribution (plus any patches)
+ Tcl 8.3 Source Distribution (plus any patches)
- Borland C++ 4.52 (both 16-bit and 32-bit compilers)
- or
Visual C++ 2.x/4.x/5.x
- Visual C++ 1.5 (to build tcl1680.dll for Win32s support of exec)
-In practice, the 8.0.4 release is built with Visual C++ 5.0
+In practice, this release is built with Visual C++ 5.0
-In the "win" subdirectory of the source release, you will find two
-files called "makefile.bc" and "makefile.vc". These are the makefiles
-for the Borland and Visual C++ compilers respectively. You should
-copy the appropriate one to "makefile" and update the paths at the
-top of the file to reflect your system configuration. Now you can use
-"make" (or "nmake" for VC++) to build the tcl libraries and the tclsh
-executable.
+In the "win" subdirectory of the source release, you will find
+"makefile.vc". This is the makefile Visual C++ compiler. You should
+update the paths at the top of the file to reflect your system
+configuration. Now you can use "make" (or "nmake" for VC++) to build
+the tcl libraries and the tclsh executable.
In order to use the binaries generated by these makefiles, you will
need to place the Tcl script library files someplace where Tcl can
-find them. Tcl looks in one of three places for the library files:
+find them. Tcl looks in one of following places for the library files:
1) The path specified in the environment variable "TCL_LIBRARY".
- 2) In the lib\tcl8.0 directory under the installation directory
+ 2) In the lib\tcl8.3 directory under the installation directory
as specified in the registry:
- For Windows NT & 95:
- HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.0
-
- For Win32s:
- HKEY_CLASSES_ROOT\SOFTWARE\Scriptics\Tcl\8.0\
+ HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.3
3) Relative to the directory containing the current .exe.
- Tcl will look for a directory "..\lib\tcl8.0" relative to the
+ Tcl will look for a directory "..\lib\tcl8.3" relative to the
directory containing the currently running .exe.
-Note that in order to run tclsh80.exe, you must ensure that tcl80.dll
-and tclpip80.dll (plus tcl1680.dll under Win32s) are on your path, in
-the system directory, or in the directory containing tclsh80.exe.
-
-4. Building Extensions
-----------------------
-
-With the Windows compilers you have to worry about how you export symbols
-from DLLs. tcl.h defines a few macros to help solve this problem:
-EXTERN - all Tcl_ function prototypes use this macro, which implies
- they are exported. You'll see this used in tcl.h and tk.h.
- You should use this in your exported procedures.
- However, this is not the whole story.
-TCL_STORAGE_CLASS - this is really an import/export flag, depending on if you are
- importing symbols from a DLL (i.e., a user of the DLL), or if
- you are exporting symbols from the DLL (i.e., you are building it.)
- The EXTERN macro includes TCL_STORAGE_CLASS.
- TCL_STORAGE_CLASS is defined to be either DLLIMPORT or DLLEXPORT as
- described below.
-STATIC_BUILD - define this if you are *not* building a DLL
- (e.g., a main program)
-DLL_BUILD - define this if you *are* building a DLL
-DLLIMPORT - If STATIC_BUILD is defined, this becomes nothing.
- (On UNIX, DLLIMPORT is defined to be empty)
- Otherwise, this this expands to __declspec(dllimport)
-DLLEXPORT - If STATIC_BUILD is defined, this becomes nothing.
- (On UNIX, DLLEXPORT is defined to be empty)
- Otherwise, this this expands to __declspec(dllexport)
-
-EXPORT(type, func)
- For the Borland compiler, you need to export functions differently.
- The DLLEXPORT macro is empty, and instead you need to use
- EXPORT because they had a different order. Your declaration will
- look like
- EXTERN EXPORT(int, Foo_Init)(Tcl_Interp *interp);
-We have not defined EXPORT anywhere. You can paste this into your C file:
-#ifndef STATIC_BUILD
-#if defined(_MSC_VER)
-# define EXPORT(a,b) __declspec(dllexport) a b
-# define DllEntryPoint DllMain
-#else
-# if defined(__BORLANDC__)
-# define EXPORT(a,b) a _export b
-# else
-# define EXPORT(a,b) a b
-# endif
-#endif
-#endif
-
-
-How to use these:
-
-Assume your extension is named Foo. In its Makefile, define
-BUILD_Foo so that you know you are building Foo and not using it.
-Then, in your main header file, foo.h, conditionally define
-EXPORT to be either DLLIMPORT or DLLEXPORT based on the
-presense of BUILD_Foo, like this:
-
-#ifndef _FOO
-#define _FOO
-#include "tcl.h"
-/* Additional includes go here */
-/*
- * if the BUILD_foo macro is defined, the assumption is that we are
- * building the dynamic library.
- */
-#ifdef BUILD_Foo
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif
-/*
- * Function prototypes for this module.
- */
-EXTERN int Foo_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Foo_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
-/* Additional prototypes go here */
-/*
- * end of foo.h
- * reset TCL_STORAGE_CLASS to DLLIMPORT.
- */
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
-#endif /* _FOO */
-
-In your C file, put EXTERN before then functions you need to export.
-If you use Borland, you'll need to use the old EXPORT macro, too.
-
-5. Test suite
+Note that in order to run tclsh83.exe, you must ensure that tcl83.dll
+and tclpip83.dll are on your path, in the system directory, or in the
+directory containing tclsh83.exe.
+
+Note: Tcl no longer provides support for Win32s.
+
+This page includes a lengthy discussion of compiler macros necessary
+when compiling Tcl extensions that will be dynamically loaded.
+
+3. Test suite
-------------
This distribution contains an extensive test suite for Tcl. Some of
the tests are timing dependent and will fail from time to time. If a
test is failing consistently, please send us a bug report with as much
-detail as you can manage.
+detail as you can manage. Please use the online database at
+ http://dev.scriptics.com/ticket/
In order to run the test suite, you build the "test" target using the
appropriate makefile for your compiler.
-6. Known Bugs
--------------
-
-Here is the current list of known bugs/missing features for the
-Windows version of Tcl:
-
-- Blocking "after" commands (e.g. "after 3000") don't work on Win32s.
-- Clock command fails to handle daylight savings time boundaries for
- things like "last week".
-- Background processes aren't properly detached on NT.
-- File events only work on sockets.
-- Pipes/files/console/serial ports don't support nonblocking I/O.
-- The library cannot be used by two processes at the same time under
- Win32s.
-
-If you have comments or bug reports for the Windows version of Tcl,
-please direct them to:
-<bugs@scriptics.com>
-or post them to the comp.lang.tcl newsgroup.
diff --git a/tcl/win/aclocal.m4 b/tcl/win/aclocal.m4
new file mode 100644
index 00000000000..005783c4aae
--- /dev/null
+++ b/tcl/win/aclocal.m4
@@ -0,0 +1,2 @@
+builtin(include,tcl.m4)
+builtin(include,../cygtcl.m4)
diff --git a/tcl/win/cat.c b/tcl/win/cat.c
index ff57a0e569f..ea088e2df2a 100644
--- a/tcl/win/cat.c
+++ b/tcl/win/cat.c
@@ -35,3 +35,5 @@ main()
return 0;
}
+
+
diff --git a/tcl/win/configure b/tcl/win/configure
index 1cbdab3be0f..89ae3c9debc 100755
--- a/tcl/win/configure
+++ b/tcl/win/configure
@@ -11,6 +11,12 @@
ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
+ac_help="$ac_help
+ --enable-threads build with threads"
+ac_help="$ac_help
+ --enable-shared build and link with shared libraries [--enable-shared]"
+ac_help="$ac_help
+ --enable-symbols build with debugging symbols [--disable-symbols]"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -533,6 +539,12 @@ fi
+TCL_VERSION=8.3
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=3
+TCL_PATCH_LEVEL=".2"
+VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
+
if test "${prefix}" = "NONE"; then
prefix=/usr/local
fi
@@ -540,57 +552,14 @@ if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
-ac_aux_dir=
-for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
- if test -f $ac_dir/install-sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install-sh -c"
- break
- elif test -f $ac_dir/install.sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install.sh -c"
- break
- fi
-done
-if test -z "$ac_aux_dir"; then
- { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
-fi
-ac_config_guess=$ac_aux_dir/config.guess
-ac_config_sub=$ac_aux_dir/config.sub
-ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
-
-
-# Make sure we can run config.sub.
-if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
-else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
-fi
-
-echo $ac_n "checking host system type""... $ac_c" 1>&6
-echo "configure:570: checking host system type" >&5
-
-host_alias=$host
-case "$host_alias" in
-NONE)
- case $nonopt in
- NONE)
- if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
- else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
- fi ;;
- *) host_alias=$nonopt ;;
- esac ;;
-esac
-
-host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
-host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-echo "$ac_t""$host" 1>&6
-
+#------------------------------------------------------------------------
+# Standard compiler checks
+#------------------------------------------------------------------------
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:594: checking for $ac_word" >&5
+echo "configure:563: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -620,7 +589,7 @@ if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:624: checking for $ac_word" >&5
+echo "configure:593: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -671,7 +640,7 @@ fi
# Extract the first word of "cl", so it can be a program name with args.
set dummy cl; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:675: checking for $ac_word" >&5
+echo "configure:644: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -703,7 +672,7 @@ fi
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:707: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+echo "configure:676: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
@@ -714,12 +683,12 @@ cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext << EOF
-#line 718 "configure"
+#line 687 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
-if { (eval echo configure:723: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:692: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
ac_cv_prog_cc_works=yes
# If we can't run a trivial program, we are probably using a cross compiler.
if (./conftest; exit) 2>/dev/null; then
@@ -745,12 +714,12 @@ if test $ac_cv_prog_cc_works = no; then
{ echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
-echo "configure:749: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "configure:718: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:754: checking whether we are using GNU C" >&5
+echo "configure:723: checking whether we are using GNU C" >&5
if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -759,7 +728,7 @@ else
yes;
#endif
EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:763: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:732: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
ac_cv_prog_gcc=yes
else
ac_cv_prog_gcc=no
@@ -778,7 +747,7 @@ ac_test_CFLAGS="${CFLAGS+set}"
ac_save_CFLAGS="$CFLAGS"
CFLAGS=
echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
-echo "configure:782: checking whether ${CC-cc} accepts -g" >&5
+echo "configure:751: checking whether ${CC-cc} accepts -g" >&5
if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -809,32 +778,55 @@ else
fi
fi
-echo $ac_n "checking for object suffix""... $ac_c" 1>&6
-echo "configure:814: checking for object suffix" >&5
-if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- rm -f conftest*
-echo 'int i = 1;' > conftest.$ac_ext
-if { (eval echo configure:820: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- for ac_file in conftest.*; do
- case $ac_file in
- *.c) ;;
- *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
- esac
- done
-else
- { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
fi
-rm -f conftest*
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
fi
-echo "$ac_t""$ac_cv_objext" 1>&6
-OBJEXT=$ac_cv_objext
-ac_objext=$ac_cv_objext
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:809: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
echo $ac_n "checking build system type""... $ac_c" 1>&6
-echo "configure:838: checking build system type" >&5
+echo "configure:830: checking build system type" >&5
build_alias=$build
case "$build_alias" in
@@ -857,490 +849,1940 @@ else
ac_tool_prefix=
fi
-# Extract the first word of "${ac_tool_prefix}nm", so it can be a program name with args.
-set dummy ${ac_tool_prefix}nm; ac_word=$2
+# Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:864: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_NM'+set}'`\" = set"; then
+echo "configure:856: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$NM"; then
- ac_cv_prog_NM="$NM" # Let the user override the test.
+ if test -n "$AR"; then
+ ac_cv_prog_AR="$AR" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
- ac_cv_prog_NM="${ac_tool_prefix}nm"
+ ac_cv_prog_AR="${ac_tool_prefix}ar"
break
fi
done
IFS="$ac_save_ifs"
fi
fi
-NM="$ac_cv_prog_NM"
-if test -n "$NM"; then
- echo "$ac_t""$NM" 1>&6
+AR="$ac_cv_prog_AR"
+if test -n "$AR"; then
+ echo "$ac_t""$AR" 1>&6
else
echo "$ac_t""no" 1>&6
fi
-if test -z "$ac_cv_prog_NM"; then
+if test -z "$ac_cv_prog_AR"; then
if test -n "$ac_tool_prefix"; then
- # Extract the first word of "nm", so it can be a program name with args.
-set dummy nm; ac_word=$2
+ # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:896: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_NM'+set}'`\" = set"; then
+echo "configure:888: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$NM"; then
- ac_cv_prog_NM="$NM" # Let the user override the test.
+ if test -n "$AR"; then
+ ac_cv_prog_AR="$AR" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
- ac_cv_prog_NM="nm"
+ ac_cv_prog_AR="ar"
break
fi
done
IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_NM" && ac_cv_prog_NM="nm"
+ test -z "$ac_cv_prog_AR" && ac_cv_prog_AR=":"
fi
fi
-NM="$ac_cv_prog_NM"
-if test -n "$NM"; then
- echo "$ac_t""$NM" 1>&6
+AR="$ac_cv_prog_AR"
+if test -n "$AR"; then
+ echo "$ac_t""$AR" 1>&6
else
echo "$ac_t""no" 1>&6
fi
else
- NM="nm"
+ AR=":"
fi
fi
-
-# Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args.
-set dummy ${ac_tool_prefix}as; ac_word=$2
+# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:932: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_AS'+set}'`\" = set"; then
+echo "configure:923: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$AS"; then
- ac_cv_prog_AS="$AS" # Let the user override the test.
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
- ac_cv_prog_AS="${ac_tool_prefix}as"
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
break
fi
done
IFS="$ac_save_ifs"
fi
fi
-AS="$ac_cv_prog_AS"
-if test -n "$AS"; then
- echo "$ac_t""$AS" 1>&6
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
else
echo "$ac_t""no" 1>&6
fi
-if test -z "$ac_cv_prog_AS"; then
+if test -z "$ac_cv_prog_RANLIB"; then
if test -n "$ac_tool_prefix"; then
- # Extract the first word of "as", so it can be a program name with args.
-set dummy as; ac_word=$2
+ # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:964: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_AS'+set}'`\" = set"; then
+echo "configure:955: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$AS"; then
- ac_cv_prog_AS="$AS" # Let the user override the test.
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
- ac_cv_prog_AS="as"
+ ac_cv_prog_RANLIB="ranlib"
break
fi
done
IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_AS" && ac_cv_prog_AS="as"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
fi
fi
-AS="$ac_cv_prog_AS"
-if test -n "$AS"; then
- echo "$ac_t""$AS" 1>&6
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
else
echo "$ac_t""no" 1>&6
fi
else
- AS="as"
+ RANLIB=":"
fi
fi
-
-# Extract the first word of "${ac_tool_prefix}ld", so it can be a program name with args.
-set dummy ${ac_tool_prefix}ld; ac_word=$2
+# Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
+set dummy ${ac_tool_prefix}windres; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1000: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_LD'+set}'`\" = set"; then
+echo "configure:990: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$LD"; then
- ac_cv_prog_LD="$LD" # Let the user override the test.
+ if test -n "$RC"; then
+ ac_cv_prog_RC="$RC" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
- ac_cv_prog_LD="${ac_tool_prefix}ld"
+ ac_cv_prog_RC="${ac_tool_prefix}windres"
break
fi
done
IFS="$ac_save_ifs"
fi
fi
-LD="$ac_cv_prog_LD"
-if test -n "$LD"; then
- echo "$ac_t""$LD" 1>&6
+RC="$ac_cv_prog_RC"
+if test -n "$RC"; then
+ echo "$ac_t""$RC" 1>&6
else
echo "$ac_t""no" 1>&6
fi
-if test -z "$ac_cv_prog_LD"; then
+if test -z "$ac_cv_prog_RC"; then
if test -n "$ac_tool_prefix"; then
- # Extract the first word of "ld", so it can be a program name with args.
-set dummy ld; ac_word=$2
+ # Extract the first word of "windres", so it can be a program name with args.
+set dummy windres; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1032: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_LD'+set}'`\" = set"; then
+echo "configure:1022: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$LD"; then
- ac_cv_prog_LD="$LD" # Let the user override the test.
+ if test -n "$RC"; then
+ ac_cv_prog_RC="$RC" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
- ac_cv_prog_LD="ld"
+ ac_cv_prog_RC="windres"
break
fi
done
IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_LD" && ac_cv_prog_LD="ld"
+ test -z "$ac_cv_prog_RC" && ac_cv_prog_RC=":"
fi
fi
-LD="$ac_cv_prog_LD"
-if test -n "$LD"; then
- echo "$ac_t""$LD" 1>&6
+RC="$ac_cv_prog_RC"
+if test -n "$RC"; then
+ echo "$ac_t""$RC" 1>&6
else
echo "$ac_t""no" 1>&6
fi
else
- LD="ld"
+ RC=":"
fi
fi
-# Extract the first word of "ranlib", so it can be a program name with args.
-set dummy ranlib; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1068: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+#--------------------------------------------------------------------
+# Checks to see if the make progeam sets the $MAKE variable.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:1060: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$RANLIB"; then
- ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_RANLIB="ranlib"
- break
- fi
- done
- IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+ eval ac_cv_prog_make_${ac_make}_set=no
fi
+rm -f conftestmake
fi
-RANLIB="$ac_cv_prog_RANLIB"
-if test -n "$RANLIB"; then
- echo "$ac_t""$RANLIB" 1>&6
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
else
echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
fi
-# Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args.
-set dummy ${ac_tool_prefix}dlltool; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1098: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_DLLTOOL'+set}'`\" = set"; then
+
+#--------------------------------------------------------------------
+# These two macros perform additinal compiler test.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6
+echo "configure:1092: checking for Cygwin environment" >&5
+if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$DLLTOOL"; then
- ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
+ cat > conftest.$ac_ext <<EOF
+#line 1097 "configure"
+#include "confdefs.h"
+
+int main() {
+
+#ifndef __CYGWIN__
+#define __CYGWIN__ __CYGWIN32__
+#endif
+return __CYGWIN__;
+; return 0; }
+EOF
+if { (eval echo configure:1108: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_cygwin=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_cygwin=no
+fi
+rm -f conftest*
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_cygwin" 1>&6
+CYGWIN=
+test "$ac_cv_cygwin" = yes && CYGWIN=yes
+
+#--------------------------------------------------------------------
+# Determines the correct binary file extension (.o, .obj, .exe etc.)
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for object suffix""... $ac_c" 1>&6
+echo "configure:1130: checking for object suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool"
- break
- fi
+ rm -f conftest*
+echo 'int i = 1;' > conftest.$ac_ext
+if { (eval echo configure:1136: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ for ac_file in conftest.*; do
+ case $ac_file in
+ *.c) ;;
+ *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
+ esac
done
- IFS="$ac_save_ifs"
+else
+ { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
fi
+rm -f conftest*
fi
-DLLTOOL="$ac_cv_prog_DLLTOOL"
-if test -n "$DLLTOOL"; then
- echo "$ac_t""$DLLTOOL" 1>&6
+
+echo "$ac_t""$ac_cv_objext" 1>&6
+OBJEXT=$ac_cv_objext
+ac_objext=$ac_cv_objext
+
+echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6
+echo "configure:1154: checking for mingw32 environment" >&5
+if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
else
- echo "$ac_t""no" 1>&6
+ cat > conftest.$ac_ext <<EOF
+#line 1159 "configure"
+#include "confdefs.h"
+
+int main() {
+return __MINGW32__;
+; return 0; }
+EOF
+if { (eval echo configure:1166: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_mingw32=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_mingw32=no
+fi
+rm -f conftest*
+rm -f conftest*
fi
+echo "$ac_t""$ac_cv_mingw32" 1>&6
+MINGW32=
+test "$ac_cv_mingw32" = yes && MINGW32=yes
-if test -z "$ac_cv_prog_DLLTOOL"; then
-if test -n "$ac_tool_prefix"; then
- # Extract the first word of "dlltool", so it can be a program name with args.
-set dummy dlltool; ac_word=$2
+
+echo $ac_n "checking for executable suffix""... $ac_c" 1>&6
+echo "configure:1185: checking for executable suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$CYGWIN" = yes || test "$MINGW32" = yes; then
+ ac_cv_exeext=.exe
+else
+ rm -f conftest*
+ echo 'int main () { return 0; }' > conftest.$ac_ext
+ ac_cv_exeext=
+ if { (eval echo configure:1195: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+ for file in conftest.*; do
+ case $file in
+ *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;;
+ esac
+ done
+ else
+ { echo "configure: error: installation or configuration problem: compiler cannot create executables." 1>&2; exit 1; }
+ fi
+ rm -f conftest*
+ test x"${ac_cv_exeext}" = x && ac_cv_exeext=no
+fi
+fi
+
+EXEEXT=""
+test x"${ac_cv_exeext}" != xno && EXEEXT=${ac_cv_exeext}
+echo "$ac_t""${ac_cv_exeext}" 1>&6
+ac_exeext=$EXEEXT
+
+
+#--------------------------------------------------------------------
+# Check whether --enable-threads or --disable-threads was given.
+#--------------------------------------------------------------------
+
+
+ echo $ac_n "checking for building with threads""... $ac_c" 1>&6
+echo "configure:1222: checking for building with threads" >&5
+ # Check whether --enable-threads or --disable-threads was given.
+if test "${enable_threads+set}" = set; then
+ enableval="$enable_threads"
+ tcl_ok=$enableval
+else
+ tcl_ok=no
+fi
+
+
+ if test "$tcl_ok" = "yes"; then
+ echo "$ac_t""yes" 1>&6
+ TCL_THREADS=1
+ cat >> confdefs.h <<\EOF
+#define TCL_THREADS 1
+EOF
+
+ else
+ TCL_THREADS=0
+ echo "$ac_t""no (default)" 1>&6
+ fi
+
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libtcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+
+ echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
+echo "configure:1252: checking how to build libraries" >&5
+ # Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+else
+ tcl_ok=yes
+fi
+
+
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=yes
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ echo "$ac_t""shared" 1>&6
+ SHARED_BUILD=1
+ else
+ echo "$ac_t""static" 1>&6
+ SHARED_BUILD=0
+ cat >> confdefs.h <<\EOF
+#define STATIC_BUILD 1
+EOF
+
+ fi
+
+
+#--------------------------------------------------------------------
+# The statements below define a collection of compile flags. This
+# macro depends on the value of SHARED_BUILD, and should be called
+# after SC_ENABLE_SHARED checks the configure switches.
+#--------------------------------------------------------------------
+
+
+ TCL_LIB_VERSIONS_OK=nodots
+
+ # Extract the first word of "cygpath", so it can be a program name with args.
+set dummy cygpath; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1130: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_DLLTOOL'+set}'`\" = set"; then
+echo "configure:1294: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CYGPATH'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$DLLTOOL"; then
- ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
+ if test -n "$CYGPATH"; then
+ ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
- ac_cv_prog_DLLTOOL="dlltool"
+ ac_cv_prog_CYGPATH="cygpath -w"
break
fi
done
IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_DLLTOOL" && ac_cv_prog_DLLTOOL="dlltool"
+ test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
fi
fi
-DLLTOOL="$ac_cv_prog_DLLTOOL"
-if test -n "$DLLTOOL"; then
- echo "$ac_t""$DLLTOOL" 1>&6
+CYGPATH="$ac_cv_prog_CYGPATH"
+if test -n "$CYGPATH"; then
+ echo "$ac_t""$CYGPATH" 1>&6
else
echo "$ac_t""no" 1>&6
fi
+
+ # Check for a bug in gcc's windres that causes the
+ # compile to fail when a Windows native path is
+ # passed into windres. The mingw toolchain requires
+ # Windows native paths while Cygwin should work
+ # with both. Avoid the bug by passing a POSIX
+ # path when using the Cygwin toolchain.
+
+ if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
+ conftest=/tmp/conftest.rc
+ echo "STRINGTABLE BEGIN" > $conftest
+ echo "101 \"name\"" >> $conftest
+ echo "END" >> $conftest
+
+ echo $ac_n "checking for Windows native path bug in windres""... $ac_c" 1>&6
+echo "configure:1336: checking for Windows native path bug in windres" >&5
+ cyg_conftest=`$CYGPATH $conftest`
+ if { ac_try='$RC -o conftest.res.o $cyg_conftest'; { (eval echo configure:1338: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } ; then
+ echo "$ac_t""no" 1>&6
+ else
+ echo "$ac_t""yes" 1>&6
+ CYGPATH=echo
+ fi
+ conftest=
+ cyg_conftest=
+ fi
+
+ if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
+ DEPARG='"$<"'
+ else
+ DEPARG='"$(shell $(CYGPATH) $<)"'
+ fi
+
+ # CYGNUS LOCAL
+ VENDORPREFIX="rh"
+ # END CYGNUS LOCAL
+
+ # set various compiler flags depending on whether we are using gcc or cl
+
+ echo $ac_n "checking compiler flags""... $ac_c" 1>&6
+echo "configure:1361: checking compiler flags" >&5
+ if test "${GCC}" = "yes" ; then
+
+ # CYGNUS LOCAL
+ if test "$ac_cv_cygwin" = "yes" ; then
+ VENDORPREFIX="cyg"
+ fi
+ # END CYGNUS LOCAL
+
+ SHLIB_LD=""
+ SHLIB_LD_LIBS=""
+ LIBS=""
+ LIBS_GUI="-lgdi32 -lcomdlg32"
+ STLIB_LD="${AR} cr"
+ RC_OUT=-o
+ RC_TYPE=
+ RC_INCLUDE=--include
+ RES=res.o
+ MAKE_LIB="\${STLIB_LD} \$@"
+ POST_MAKE_LIB="\${RANLIB} \$@"
+ MAKE_EXE="\${CC} -o \$@"
+ LIBPREFIX="lib${VENDORPREFIX}"
+
+ if test "${SHARED_BUILD}" = "0" ; then
+ # static
+ echo "$ac_t""using static flags" 1>&6
+ runtime=
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.a"
+ LIBRARIES="\${STATIC_LIBRARIES}"
+ EXESUFFIX="s\${DBGX}.exe"
+ DLLSUFFIX=""
+ else
+ # dynamic
+ echo "$ac_t""using shared flags" 1>&6
+
+ # ad-hoc check to see if CC supports -shared.
+ if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
+ { echo "configure: error: ${CC} does not support the -shared option.
+ You will need to upgrade to a newer version of the toolchain." 1>&2; exit 1; }
+ fi
+
+ runtime=
+ # Link with gcc since ld does not link to default libs like
+ # -luser32 and -lmsvcrt. We also need to add CFLAGS so important
+ # flags like -mno-cygwin get passed in to CC.
+ SHLIB_LD='${CC} -shared ${CFLAGS}'
+ # Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
+ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
+
+ LIBSUFFIX="\${DBGX}.a"
+ DLLSUFFIX="\${DBGX}.dll"
+ EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ fi
+
+ CFLAGS_DEBUG=-g
+ CFLAGS_OPTIMIZE=-O
+ CFLAGS_WARNING="-Wall -Wconversion"
+ LDFLAGS_DEBUG=
+ LDFLAGS_OPTIMIZE=
+
+ # Specify the CC output file names based on the target name
+ CC_OBJNAME="-o \$@"
+ CC_EXENAME="-o \$@"
+
+ # Specify linker flags depending on the type of app being
+ # built -- Console vs. Window.
+ #
+ # We need to pass -e _WinMain@16 so that ld will use
+ # WinMain() instead of main() as the entry point. We can't
+ # use autoconf to check for this case since it would need
+ # to run an executable and that does not work when
+ # cross compiling. Remove this -e workaround once we
+ # require a gcc that does not have this bug.
+ LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
+ LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
+ else
+ SHLIB_LD="link -dll -nologo"
+ SHLIB_LD_LIBS="user32.lib advapi32.lib"
+ LIBS="user32.lib advapi32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib"
+ STLIB_LD="lib -nologo"
+ RC="rc"
+ RC_OUT=-fo
+ RC_TYPE=-r
+ RC_INCLUDE=-i
+ RES=res
+ MAKE_LIB="\${STLIB_LD} -out:\$@"
+ POST_MAKE_LIB=
+ MAKE_EXE="\${CC} -Fe\$@"
+ LIBPREFIX=${VENDORPREFIX}
+
+ if test "${SHARED_BUILD}" = "0" ; then
+ # static
+ echo "$ac_t""using static flags" 1>&6
+ runtime=-MT
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.lib"
+ LIBRARIES="\${STATIC_LIBRARIES}"
+ EXESUFFIX="s\${DBGX}.exe"
+ DLLSUFFIX=""
+ else
+ # dynamic
+ echo "$ac_t""using shared flags" 1>&6
+ runtime=-MD
+ # Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
+ LIBSUFFIX="\${DBGX}.lib"
+ DLLSUFFIX="\${DBGX}.dll"
+ EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ fi
+
+ EXTRA_CFLAGS="-YX"
+ CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
+# CFLAGS_OPTIMIZE="-nologo -O2 -Gs -GD ${runtime}"
+ CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}"
+ CFLAGS_WARNING="-W3"
+ LDFLAGS_DEBUG="-debug:full -debugtype:cv"
+ LDFLAGS_OPTIMIZE="-release"
+
+ # Specify the CC output file names based on the target name
+ CC_OBJNAME="-Fo\$@"
+ CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\""
+
+ # Specify linker flags depending on the type of app being
+ # built -- Console vs. Window.
+ LDFLAGS_CONSOLE="-link -subsystem:console"
+ LDFLAGS_WINDOW="-link -subsystem:windows"
+ fi
+
+ # Define the same variables as used in tclConfig.sh so that macros
+ # that depend on these variables work for both Tcl and extensions.
+ TCL_LIB_SUFFIX=$LIBSUFFIX
+ TCL_VENDOR_PREFIX=$VENDORPREFIX
+
+
+#--------------------------------------------------------------------
+# Set the default compiler switches based on the --enable-symbols
+# option. This macro depends on C flags, and should be called
+# after SC_CONFIG_CFLAGS macro is called.
+#--------------------------------------------------------------------
+
+
+ echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
+echo "configure:1508: checking for build with symbols" >&5
+ # Check whether --enable-symbols or --disable-symbols was given.
+if test "${enable_symbols+set}" = set; then
+ enableval="$enable_symbols"
+ tcl_ok=$enableval
else
- DLLTOOL="dlltool"
-fi
+ tcl_ok=no
fi
-# Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
-set dummy ${ac_tool_prefix}windres; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1166: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_WINDRES'+set}'`\" = set"; then
+ if test "$tcl_ok" = "yes"; then
+ CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
+ DBGX=d
+ echo "$ac_t""yes" 1>&6
+ else
+ CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ DBGX=""
+ echo "$ac_t""no" 1>&6
+ fi
+
+
+#------------------------------------------------------------------------------
+# Find out all about time handling differences.
+#------------------------------------------------------------------------------
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1536: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$WINDRES"; then
- ac_cv_prog_WINDRES="$WINDRES" # Let the user override the test.
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1551 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1557: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_WINDRES="${ac_tool_prefix}windres"
- break
- fi
- done
- IFS="$ac_save_ifs"
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1568 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1574: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1585 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1591: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
+echo "configure:1616: checking whether struct tm is in sys/time.h or time.h" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1621 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <time.h>
+int main() {
+struct tm *tp; tp->tm_sec;
+; return 0; }
+EOF
+if { (eval echo configure:1629: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_struct_tm=time.h
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_struct_tm=sys/time.h
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_struct_tm" 1>&6
+if test $ac_cv_struct_tm = sys/time.h; then
+ cat >> confdefs.h <<\EOF
+#define TM_IN_SYS_TIME 1
+EOF
+
fi
-WINDRES="$ac_cv_prog_WINDRES"
-if test -n "$WINDRES"; then
- echo "$ac_t""$WINDRES" 1>&6
+
+
+ for ac_hdr in sys/time.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1654: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1659 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1664: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
else
echo "$ac_t""no" 1>&6
fi
+done
+ echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
+echo "configure:1691: checking whether time.h and sys/time.h may both be included" >&5
+if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1696 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+int main() {
+struct tm *tp;
+; return 0; }
+EOF
+if { (eval echo configure:1705: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_header_time=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_time=no
+fi
+rm -f conftest*
+fi
-if test -z "$ac_cv_prog_WINDRES"; then
-if test -n "$ac_tool_prefix"; then
- # Extract the first word of "windres", so it can be a program name with args.
-set dummy windres; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1198: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_WINDRES'+set}'`\" = set"; then
+echo "$ac_t""$ac_cv_header_time" 1>&6
+if test $ac_cv_header_time = yes; then
+ cat >> confdefs.h <<\EOF
+#define TIME_WITH_SYS_TIME 1
+EOF
+
+fi
+
+ echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6
+echo "configure:1726: checking for tm_zone in struct tm" >&5
+if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- if test -n "$WINDRES"; then
- ac_cv_prog_WINDRES="$WINDRES" # Let the user override the test.
+ cat > conftest.$ac_ext <<EOF
+#line 1731 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <$ac_cv_struct_tm>
+int main() {
+struct tm tm; tm.tm_zone;
+; return 0; }
+EOF
+if { (eval echo configure:1739: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_struct_tm_zone=yes
else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_WINDRES="windres"
- break
- fi
- done
- IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_WINDRES" && ac_cv_prog_WINDRES="windres"
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_struct_tm_zone=no
fi
+rm -f conftest*
fi
-WINDRES="$ac_cv_prog_WINDRES"
-if test -n "$WINDRES"; then
- echo "$ac_t""$WINDRES" 1>&6
+
+echo "$ac_t""$ac_cv_struct_tm_zone" 1>&6
+if test "$ac_cv_struct_tm_zone" = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_TM_ZONE 1
+EOF
+
+else
+ echo $ac_n "checking for tzname""... $ac_c" 1>&6
+echo "configure:1759: checking for tzname" >&5
+if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
else
+ cat > conftest.$ac_ext <<EOF
+#line 1764 "configure"
+#include "confdefs.h"
+#include <time.h>
+#ifndef tzname /* For SGI. */
+extern char *tzname[]; /* RS6000 and others reject char **tzname. */
+#endif
+int main() {
+atoi(*tzname);
+; return 0; }
+EOF
+if { (eval echo configure:1774: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_cv_var_tzname=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_var_tzname=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_var_tzname" 1>&6
+ if test $ac_cv_var_tzname = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_TZNAME 1
+EOF
+
+ fi
+fi
+
+
+ echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6
+echo "configure:1797: checking tm_tzadj in struct tm" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 1799 "configure"
+#include "confdefs.h"
+#include <time.h>
+int main() {
+struct tm tm; tm.tm_tzadj;
+; return 0; }
+EOF
+if { (eval echo configure:1806: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ cat >> confdefs.h <<\EOF
+#define HAVE_TM_TZADJ 1
+EOF
+
+ echo "$ac_t""yes" 1>&6
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
echo "$ac_t""no" 1>&6
fi
+rm -f conftest*
+
+ echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6
+echo "configure:1822: checking tm_gmtoff in struct tm" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 1824 "configure"
+#include "confdefs.h"
+#include <time.h>
+int main() {
+struct tm tm; tm.tm_gmtoff;
+; return 0; }
+EOF
+if { (eval echo configure:1831: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ cat >> confdefs.h <<\EOF
+#define HAVE_TM_GMTOFF 1
+EOF
+ echo "$ac_t""yes" 1>&6
else
- WINDRES="windres"
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
fi
+rm -f conftest*
+
+ #
+ # Its important to include time.h in this check, as some systems
+ # (like convex) have timezone functions, etc.
+ #
+ have_timezone=no
+ echo $ac_n "checking long timezone variable""... $ac_c" 1>&6
+echo "configure:1852: checking long timezone variable" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 1854 "configure"
+#include "confdefs.h"
+#include <time.h>
+int main() {
+extern long timezone;
+ timezone += 1;
+ exit (0);
+; return 0; }
+EOF
+if { (eval echo configure:1863: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ have_timezone=yes
+ cat >> confdefs.h <<\EOF
+#define HAVE_TIMEZONE_VAR 1
+EOF
+
+ echo "$ac_t""yes" 1>&6
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+ #
+ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ #
+ if test "$have_timezone" = no; then
+ echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6
+echo "configure:1884: checking time_t timezone variable" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 1886 "configure"
+#include "confdefs.h"
+#include <time.h>
+int main() {
+extern time_t timezone;
+ timezone += 1;
+ exit (0);
+; return 0; }
+EOF
+if { (eval echo configure:1895: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ cat >> confdefs.h <<\EOF
+#define HAVE_TIMEZONE_VAR 1
+EOF
+
+ echo "$ac_t""yes" 1>&6
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
fi
+rm -f conftest*
+ fi
+ #
+ # On some systems (eg Solaris 2.5.1), timezone is not declared in
+ # time.h unless you jump through hoops. Instead of that, we just
+ # declare it ourselves when necessary.
+ #
+ if test "$have_timezone" = yes; then
+ echo $ac_n "checking for timezone declaration""... $ac_c" 1>&6
+echo "configure:1918: checking for timezone declaration" >&5
+
+ tzrx='^[ ]*extern.*timezone'
+
+ cat > conftest.$ac_ext <<EOF
+#line 1923 "configure"
+#include "confdefs.h"
+#include <time.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "$tzrx" >/dev/null 2>&1; then
+ rm -rf conftest*
+
+ cat >> confdefs.h <<\EOF
+#define HAVE_TIMEZONE_DECL 1
+EOF
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# ./install, which can be erroneously created by make from ./install.sh.
-echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
-echo "configure:1243: checking for a BSD compatible install" >&5
-if test -z "$INSTALL"; then
-if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo "$ac_t""found" 1>&6
+else
+ rm -rf conftest*
+ echo "$ac_t""missing" 1>&6
+fi
+rm -f conftest*
+
+ fi
+
+ #
+ # AIX does not have a timezone field in struct tm. When the AIX bsd
+ # library is used, the timezone global and the gettimeofday methods are
+ # to be avoided for timezone deduction instead, we deduce the timezone
+ # by comparing the localtime result on a known GMT value.
+ #
+
+ if test "`uname -s`" = "AIX" ; then
+ echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
+echo "configure:1953: checking for gettimeofday in -lbsd" >&5
+ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
- for ac_dir in $PATH; do
- # Account for people who put trailing slashes in PATH elements.
- case "$ac_dir/" in
- /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- # Don't use installbsd from OSF since it installs stuff as root
- # by default.
- for ac_prog in ginstall scoinst install; do
- if test -f $ac_dir/$ac_prog; then
- if test $ac_prog = install &&
- grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- :
- else
- ac_cv_path_install="$ac_dir/$ac_prog -c"
- break 2
- fi
+ ac_save_LIBS="$LIBS"
+LIBS="-lbsd $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1961 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gettimeofday();
+
+int main() {
+gettimeofday()
+; return 0; }
+EOF
+if { (eval echo configure:1972: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ libbsd=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $libbsd = yes; then
+ cat >> confdefs.h <<\EOF
+#define USE_DELTA_FOR_TZ 1
+EOF
+
fi
- done
- ;;
- esac
- done
- IFS="$ac_save_IFS"
+ fi
+
+TCL_DBGX=${DBGX}
+
+#--------------------------------------------------------------------
+# man2tcl needs this so that it can use errno.h
+#--------------------------------------------------------------------
+
+ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for errno.h""... $ac_c" 1>&6
+echo "configure:2009: checking for errno.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2014 "configure"
+#include "confdefs.h"
+#include <errno.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2019: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
fi
- if test "${ac_cv_path_install+set}" = set; then
- INSTALL="$ac_cv_path_install"
- else
- # As a last resort, use the slow shell script. We don't cache a
- # path for INSTALL within a source directory, because that will
- # break other packages using the cache if that directory is
- # removed, or if the path is relative.
- INSTALL="$ac_install_sh"
- fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+MAN2TCLFLAGS="-DNO_ERRNO_H"
fi
-echo "$ac_t""$INSTALL" 1>&6
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+#------------------------------------------------------------------------
+# tclConfig.sh refers to this by a different name
+#------------------------------------------------------------------------
+TCL_SHARED_BUILD=${SHARED_BUILD}
-# needed for the subtle differences between cygwin and mingw32
-case "${host}" in
-*-*-cygwin*)
- TCL_ALLOC_OBJ=
- DLL_LDLIBS=-lcygwin
- DLL_LDFLAGS='-nostartfiles -Wl,--dll'
- ;;
-*-*-mingw32*)
- TCL_ALLOC_OBJ='$(TMPDIR)/tclAlloc.o'
- DLL_LDLIBS=
- DLL_LDFLAGS='-mdll'
- ;;
-esac
+#--------------------------------------------------------------------
+# Perform final evaluations of variables with possible substitutions.
+#--------------------------------------------------------------------
+NODOT_VERSION=${VER}
+TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
+TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+ val="`cd $srcdir/..; pwd`"
-# The following variables are just for tclConfig.sh, not for Makefile.
-LIBOBJS=
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_SRC_DIR" 1>&2; exit 1; }
+ fi
-TCL_VERSION=8.0
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL=p2
-VERSION=${TCL_VERSION}
-DL_LIBS=
-MATH_LIBS=-lm
-SHLIB_CFLAGS=
-SHLIB_LD=
-SHLIB_LD_LIBS=
-SHLIB_SUFFIX=
-LD_FLAGS=
-TCL_LD_SEARCH_FLAGS=
-TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
-TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
-TCL_LIB_VERSIONS_OK=nodots
-TCL_SHARED_LIB_SUFFIX=
-TCL_UNSHARED_LIB_SUFFIX="`echo ${VERSION} | tr -d .`.a"
-eval "TCL_LIB_FILE=libtcl${TCL_UNSHARED_LIB_SUFFIX}"
-TCL_SRC_DIR=`cd $srcdir/..; pwd`
-if test "$prefix" != "$exec_prefix"; then
- TCL_PACKAGE_PATH="${exec_prefix}/lib ${prefix}/lib"
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_SRC_DIR=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_SRC_DIR="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_SRC_DIR=$val
+ ;;
+ esac
+
+
+
+
+ libname=tcl
+ suffix=${TCL_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TCL_LIB_FILE=$long_libname
+
+
+ libname=tcl
+ suffix=${TCL_SHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TCL_DLL_FILE=$long_libname
+
+
+if test "$GCC" = "yes"; then
+ GNU_TCL_LIB_FILE=${TCL_LIB_FILE}
+ MSVC_TCL_LIB_FILE=
else
- TCL_PACKAGE_PATH="${prefix}/lib"
+ GNU_TCL_LIB_FILE=
+ MSVC_TCL_LIB_FILE=${TCL_LIB_FILE}
fi
+ libname=tcl
+ version=$TCL_VERSION
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ TCL_LIB_FLAG=$short_libname
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="`pwd`/${TCL_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_BUILD_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_BUILD_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_BUILD_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_BUILD_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=`pwd`
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TCL_BUILD_LIB_SPEC="-L${dirname} ${TCL_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
+ ;;
+ esac
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="${exec_prefix}/lib/${TCL_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=${exec_prefix}/lib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TCL_LIB_SPEC="-L${dirname} ${TCL_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TCL_LIB_SPEC="-L${exec_prefix}/lib ${TCL_LIB_FLAG}"
+ ;;
+ esac
+
+
+
+ val="`pwd`/${TCL_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_LIB_FULL_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_LIB_FULL_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_LIB_FULL_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_LIB_FULL_PATH=$val
+ ;;
+ esac
+
+
+
+
+
+ libname=tclstub
+ suffix=${TCL_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TCL_STUB_LIB_FILE=$long_libname
+
+
+ libname=tclstub
+ version=$TCL_VERSION
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ TCL_STUB_LIB_FLAG=$short_libname
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="`pwd`/${TCL_STUB_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_BUILD_STUB_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_BUILD_STUB_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_BUILD_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_BUILD_STUB_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=`pwd`
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TCL_BUILD_STUB_LIB_SPEC="-L${dirname} ${TCL_STUB_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}"
+ ;;
+ esac
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="${exec_prefix}/lib/${TCL_STUB_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_STUB_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_STUB_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_STUB_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=${exec_prefix}/lib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TCL_STUB_LIB_SPEC="-L${dirname} ${TCL_STUB_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TCL_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TCL_STUB_LIB_FLAG}"
+ ;;
+ esac
+
+
+
+ val="`pwd`/${TCL_STUB_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_BUILD_STUB_LIB_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_BUILD_STUB_LIB_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_BUILD_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_BUILD_STUB_LIB_PATH=$val
+ ;;
+ esac
+
+
+
+
+ val="${exec_prefix}/lib/${TCL_STUB_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TCL_STUB_LIB_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TCL_STUB_LIB_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TCL_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TCL_STUB_LIB_PATH=$val
+ ;;
+ esac
+
+
+
+
+
+ libname=tcldde
+ suffix=${TCL_SHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ DDE_DLL_FILE=$long_libname
+
+
+ libname=tcldde
+ suffix=${TCL_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ DDE_LIB_FILE=$long_libname
+
+
+
+ libname=tclreg
+ suffix=${TCL_SHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ REG_DLL_FILE=$long_libname
+
+
+ libname=tclreg
+ suffix=${TCL_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ REG_LIB_FILE=$long_libname
+
+
+
+ libname=tclpip
+ suffix=${TCL_SHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ PIPE_DLL_FILE=$long_libname
+
+
+
+eval "DLLSUFFIX=${DLLSUFFIX}"
+eval "LIBPREFIX=${LIBPREFIX}"
+eval "LIBSUFFIX=${LIBSUFFIX}"
+eval "EXESUFFIX=${EXESUFFIX}"
+
+CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
+CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
+CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -1472,9 +2914,8 @@ do
done
ac_given_srcdir=$srcdir
-ac_given_INSTALL="$INSTALL"
-trap 'rm -fr `echo "Makefile ../unix/tclConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+trap 'rm -fr `echo "Makefile tclConfig.sh tcl.hpj" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
@@ -1506,52 +2947,90 @@ s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
+s%@CC@%$CC%g
s%@host@%$host%g
s%@host_alias@%$host_alias%g
s%@host_cpu@%$host_cpu%g
s%@host_vendor@%$host_vendor%g
s%@host_os@%$host_os%g
-s%@CC@%$CC%g
-s%@OBJEXT@%$OBJEXT%g
s%@build@%$build%g
s%@build_alias@%$build_alias%g
s%@build_cpu@%$build_cpu%g
s%@build_vendor@%$build_vendor%g
s%@build_os@%$build_os%g
-s%@NM@%$NM%g
-s%@AS@%$AS%g
-s%@LD@%$LD%g
+s%@AR@%$AR%g
s%@RANLIB@%$RANLIB%g
-s%@DLLTOOL@%$DLLTOOL%g
-s%@WINDRES@%$WINDRES%g
-s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
-s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
-s%@INSTALL_DATA@%$INSTALL_DATA%g
-s%@TCL_ALLOC_OBJ@%$TCL_ALLOC_OBJ%g
-s%@DLL_LDFLAGS@%$DLL_LDFLAGS%g
-s%@DLL_LDLIBS@%$DLL_LDLIBS%g
-s%@LIBOBJS@%$LIBOBJS%g
-s%@DL_LIBS@%$DL_LIBS%g
-s%@LD_FLAGS@%$LD_FLAGS%g
-s%@MATH_LIBS@%$MATH_LIBS%g
-s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
-s%@SHLIB_LD@%$SHLIB_LD%g
-s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
-s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
-s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
-s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
-s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
-s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
-s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
+s%@RC@%$RC%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@OBJEXT@%$OBJEXT%g
+s%@EXEEXT@%$EXEEXT%g
+s%@CYGPATH@%$CYGPATH%g
+s%@CPP@%$CPP%g
+s%@MAN2TCLFLAGS@%$MAN2TCLFLAGS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
-s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
+s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
-s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g
-s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@GNU_TCL_LIB_FILE@%$GNU_TCL_LIB_FILE%g
+s%@MSVC_TCL_LIB_FILE@%$MSVC_TCL_LIB_FILE%g
+s%@TCL_DLL_FILE@%$TCL_DLL_FILE%g
+s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
+s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
+s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
+s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g
+s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
+s%@TCL_STUB_LIB_PATH@%$TCL_STUB_LIB_PATH%g
+s%@DDE_DLL_FILE@%$DDE_DLL_FILE%g
+s%@DDE_LIB_FILE@%$DDE_LIB_FILE%g
+s%@REG_DLL_FILE@%$REG_DLL_FILE%g
+s%@REG_LIB_FILE@%$REG_LIB_FILE%g
+s%@PIPE_DLL_FILE@%$PIPE_DLL_FILE%g
s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
-s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g
-s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_DBGX@%$TCL_DBGX%g
+s%@CFG_TCL_SHARED_LIB_SUFFIX@%$CFG_TCL_SHARED_LIB_SUFFIX%g
+s%@CFG_TCL_UNSHARED_LIB_SUFFIX@%$CFG_TCL_UNSHARED_LIB_SUFFIX%g
+s%@CFG_TCL_EXPORT_FILE_SUFFIX@%$CFG_TCL_EXPORT_FILE_SUFFIX%g
+s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
+s%@DEPARG@%$DEPARG%g
+s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
+s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
+s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
+s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g
+s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
+s%@STLIB_LD@%$STLIB_LD%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@CC_OBJNAME@%$CC_OBJNAME%g
+s%@CC_EXENAME@%$CC_EXENAME%g
+s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
+s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g
+s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g
+s%@LDFLAGS_CONSOLE@%$LDFLAGS_CONSOLE%g
+s%@LDFLAGS_WINDOW@%$LDFLAGS_WINDOW%g
+s%@RC_OUT@%$RC_OUT%g
+s%@RC_TYPE@%$RC_TYPE%g
+s%@RC_INCLUDE@%$RC_INCLUDE%g
+s%@RES@%$RES%g
+s%@LIBS_GUI@%$LIBS_GUI%g
+s%@DLLSUFFIX@%$DLLSUFFIX%g
+s%@VENDORPREFIX@%$VENDORPREFIX%g
+s%@LIBPREFIX@%$LIBPREFIX%g
+s%@LIBSUFFIX@%$LIBSUFFIX%g
+s%@EXESUFFIX@%$EXESUFFIX%g
+s%@LIBRARIES@%$LIBRARIES%g
+s%@MAKE_LIB@%$MAKE_LIB%g
+s%@POST_MAKE_LIB@%$POST_MAKE_LIB%g
+s%@MAKE_DLL@%$MAKE_DLL%g
+s%@MAKE_EXE@%$MAKE_EXE%g
CEOF
EOF
@@ -1593,7 +3072,7 @@ EOF
cat >> $CONFIG_STATUS <<EOF
-CONFIG_FILES=\${CONFIG_FILES-"Makefile ../unix/tclConfig.sh"}
+CONFIG_FILES=\${CONFIG_FILES-"Makefile tclConfig.sh tcl.hpj"}
EOF
cat >> $CONFIG_STATUS <<\EOF
for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
@@ -1628,10 +3107,6 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
- case "$ac_given_INSTALL" in
- [/$]*) INSTALL="$ac_given_INSTALL" ;;
- *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
- esac
echo creating "$ac_file"
rm -f "$ac_file"
@@ -1647,7 +3122,6 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
-s%@INSTALL@%$INSTALL%g
" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
fi; done
rm -f conftest.s*
@@ -1664,3 +3138,4 @@ chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tcl/win/configure.in b/tcl/win/configure.in
index d7d94737fb8..a926e615033 100755
--- a/tcl/win/configure.in
+++ b/tcl/win/configure.in
@@ -1,13 +1,17 @@
-dnl The file is CYGNUS LOCAL. It is used for cygwin.
-
-dnl This file is an input file used by the GNU "autoconf" program to
-dnl generate the file "configure", which is run during Tcl installation
-dnl to configure the system for the local environment.
-
-AC_PREREQ(2.5)
+# This file is an input file used by the GNU "autoconf" program to
+# generate the file "configure", which is run during Tcl installation
+# to configure the system for the local environment.
+#
+# RCS: @(#) $Id$
AC_INIT(../generic/tcl.h)
+TCL_VERSION=8.3
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=3
+TCL_PATCH_LEVEL=".2"
+VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
+
if test "${prefix}" = "NONE"; then
prefix=/usr/local
fi
@@ -15,90 +19,215 @@ if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
-AC_CANONICAL_HOST
+#------------------------------------------------------------------------
+# Standard compiler checks
+#------------------------------------------------------------------------
AC_PROG_CC
+
+AC_CHECK_TOOL(AR, ar, :)
+AC_CHECK_TOOL(RANLIB, ranlib, :)
+AC_CHECK_TOOL(RC, windres, :)
+
+#--------------------------------------------------------------------
+# Checks to see if the make progeam sets the $MAKE variable.
+#--------------------------------------------------------------------
+
+AC_PROG_MAKE_SET
+
+#--------------------------------------------------------------------
+# These two macros perform additinal compiler test.
+#--------------------------------------------------------------------
+
+AC_CYGWIN
+
+#--------------------------------------------------------------------
+# Determines the correct binary file extension (.o, .obj, .exe etc.)
+#--------------------------------------------------------------------
+
AC_OBJEXT
-AC_CHECK_TOOL(NM, nm, nm)
-AC_SUBST(NM)
-AC_CHECK_TOOL(AS, as, as)
-AC_SUBST(AS)
-AC_CHECK_TOOL(LD, ld, ld)
-AC_SUBST(LD)
-AC_PROG_RANLIB
-AC_CHECK_TOOL(DLLTOOL, dlltool, dlltool)
-AC_SUBST(DLLTOOL)
-AC_CHECK_TOOL(WINDRES, windres, windres)
-AC_SUBST(WINDRES)
-AC_PROG_INSTALL
-
-# needed for the subtle differences between cygwin and mingw32
-case "${host}" in
-*-*-cygwin*)
- TCL_ALLOC_OBJ=
- DLL_LDLIBS=-lcygwin
- DLL_LDFLAGS='-nostartfiles -Wl,--dll'
- ;;
-*-*-mingw32*)
- TCL_ALLOC_OBJ='$(TMPDIR)/tclAlloc.o'
- DLL_LDLIBS=
- DLL_LDFLAGS='-mdll'
- ;;
-esac
-
-AC_SUBST(TCL_ALLOC_OBJ)
-AC_SUBST(DLL_LDFLAGS)
-AC_SUBST(DLL_LDLIBS)
-
-# The following variables are just for tclConfig.sh, not for Makefile.
-LIBOBJS=
-AC_SUBST(LIBOBJS)
-TCL_VERSION=8.0
-TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL=p2
-VERSION=${TCL_VERSION}
-DL_LIBS=
-MATH_LIBS=-lm
-SHLIB_CFLAGS=
-SHLIB_LD=
-SHLIB_LD_LIBS=
-SHLIB_SUFFIX=
-LD_FLAGS=
-TCL_LD_SEARCH_FLAGS=
-TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
-TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
-TCL_LIB_VERSIONS_OK=nodots
-TCL_SHARED_LIB_SUFFIX=
-TCL_UNSHARED_LIB_SUFFIX="`echo ${VERSION} | tr -d .`.a"
-eval "TCL_LIB_FILE=libtcl${TCL_UNSHARED_LIB_SUFFIX}"
-TCL_SRC_DIR=`cd $srcdir/..; pwd`
-if test "$prefix" != "$exec_prefix"; then
- TCL_PACKAGE_PATH="${exec_prefix}/lib ${prefix}/lib"
+AC_EXEEXT
+
+#--------------------------------------------------------------------
+# Check whether --enable-threads or --disable-threads was given.
+#--------------------------------------------------------------------
+
+SC_ENABLE_THREADS
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libtcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+SC_ENABLE_SHARED
+
+#--------------------------------------------------------------------
+# The statements below define a collection of compile flags. This
+# macro depends on the value of SHARED_BUILD, and should be called
+# after SC_ENABLE_SHARED checks the configure switches.
+#--------------------------------------------------------------------
+
+SC_CONFIG_CFLAGS
+
+#--------------------------------------------------------------------
+# Set the default compiler switches based on the --enable-symbols
+# option. This macro depends on C flags, and should be called
+# after SC_CONFIG_CFLAGS macro is called.
+#--------------------------------------------------------------------
+
+SC_ENABLE_SYMBOLS
+
+#------------------------------------------------------------------------------
+# Find out all about time handling differences.
+#------------------------------------------------------------------------------
+
+SC_TIME_HANDLER
+
+TCL_DBGX=${DBGX}
+
+#--------------------------------------------------------------------
+# man2tcl needs this so that it can use errno.h
+#--------------------------------------------------------------------
+
+AC_CHECK_HEADER(errno.h, , MAN2TCLFLAGS="-DNO_ERRNO_H")
+AC_SUBST(MAN2TCLFLAGS)
+
+#------------------------------------------------------------------------
+# tclConfig.sh refers to this by a different name
+#------------------------------------------------------------------------
+
+TCL_SHARED_BUILD=${SHARED_BUILD}
+
+#--------------------------------------------------------------------
+# Perform final evaluations of variables with possible substitutions.
+#--------------------------------------------------------------------
+
+NODOT_VERSION=${VER}
+
+TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
+TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+
+TCL_TOOL_PATH(TCL_SRC_DIR, "`cd $srcdir/..; pwd`")
+
+dnl CYGNUS LOCAL - Can't conflict with installed tcl package
+
+TCL_TOOL_STATIC_LIB_LONGNAME(TCL_LIB_FILE, tcl, ${TCL_UNSHARED_LIB_SUFFIX})
+TCL_TOOL_SHARED_LIB_LONGNAME(TCL_DLL_FILE, tcl, ${TCL_SHARED_LIB_SUFFIX})
+
+if test "$GCC" = "yes"; then
+ GNU_TCL_LIB_FILE=${TCL_LIB_FILE}
+ MSVC_TCL_LIB_FILE=
else
- TCL_PACKAGE_PATH="${prefix}/lib"
+ GNU_TCL_LIB_FILE=
+ MSVC_TCL_LIB_FILE=${TCL_LIB_FILE}
fi
-AC_SUBST(DL_LIBS)
-AC_SUBST(LD_FLAGS)
-AC_SUBST(MATH_LIBS)
-AC_SUBST(SHLIB_CFLAGS)
-AC_SUBST(SHLIB_LD)
-AC_SUBST(SHLIB_LD_LIBS)
-AC_SUBST(SHLIB_SUFFIX)
-AC_SUBST(TCL_BUILD_LIB_SPEC)
-AC_SUBST(TCL_LD_SEARCH_FLAGS)
-AC_SUBST(TCL_LIB_FILE)
-AC_SUBST(TCL_LIB_SPEC)
-AC_SUBST(TCL_LIB_VERSIONS_OK)
+
+TCL_TOOL_LIB_SHORTNAME(TCL_LIB_FLAG, tcl, $TCL_VERSION)
+TCL_TOOL_LIB_SPEC(TCL_BUILD_LIB_SPEC, `pwd`, ${TCL_LIB_FLAG})
+TCL_TOOL_LIB_SPEC(TCL_LIB_SPEC, ${exec_prefix}/lib, ${TCL_LIB_FLAG})
+TCL_TOOL_LIB_PATH(TCL_LIB_FULL_PATH, `pwd`, ${TCL_LIB_FILE})
+
+
+TCL_TOOL_STATIC_LIB_LONGNAME(TCL_STUB_LIB_FILE, tclstub, ${TCL_UNSHARED_LIB_SUFFIX})
+TCL_TOOL_LIB_SHORTNAME(TCL_STUB_LIB_FLAG, tclstub, $TCL_VERSION)
+TCL_TOOL_LIB_SPEC(TCL_BUILD_STUB_LIB_SPEC, `pwd`, ${TCL_STUB_LIB_FLAG})
+TCL_TOOL_LIB_SPEC(TCL_STUB_LIB_SPEC, ${exec_prefix}/lib, ${TCL_STUB_LIB_FLAG})
+TCL_TOOL_LIB_PATH(TCL_BUILD_STUB_LIB_PATH, `pwd`, ${TCL_STUB_LIB_FILE})
+TCL_TOOL_LIB_PATH(TCL_STUB_LIB_PATH, ${exec_prefix}/lib, ${TCL_STUB_LIB_FILE})
+
+
+TCL_TOOL_SHARED_LIB_LONGNAME(DDE_DLL_FILE, tcldde, ${TCL_SHARED_LIB_SUFFIX})
+TCL_TOOL_STATIC_LIB_LONGNAME(DDE_LIB_FILE, tcldde, ${TCL_UNSHARED_LIB_SUFFIX})
+
+TCL_TOOL_SHARED_LIB_LONGNAME(REG_DLL_FILE, tclreg, ${TCL_SHARED_LIB_SUFFIX})
+TCL_TOOL_STATIC_LIB_LONGNAME(REG_LIB_FILE, tclreg, ${TCL_UNSHARED_LIB_SUFFIX})
+
+TCL_TOOL_SHARED_LIB_LONGNAME(PIPE_DLL_FILE, tclpip, ${TCL_SHARED_LIB_SUFFIX})
+
+
+eval "DLLSUFFIX=${DLLSUFFIX}"
+eval "LIBPREFIX=${LIBPREFIX}"
+eval "LIBSUFFIX=${LIBSUFFIX}"
+eval "EXESUFFIX=${EXESUFFIX}"
+
+CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
+CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
+CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+
+AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
-AC_SUBST(TCL_PACKAGE_PATH)
+AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_PATCH_LEVEL)
-AC_SUBST(TCL_SHARED_LIB_SUFFIX)
-AC_SUBST(TCL_SHLIB_CFLAGS)
+AC_SUBST(TCL_LIB_FILE)
+AC_SUBST(GNU_TCL_LIB_FILE)
+AC_SUBST(MSVC_TCL_LIB_FILE)
+AC_SUBST(TCL_DLL_FILE)
+AC_SUBST(TCL_LIB_FLAG)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LIB_SPEC)
+AC_SUBST(TCL_LIB_FULL_PATH)
+AC_SUBST(TCL_STUB_LIB_FILE)
+AC_SUBST(TCL_STUB_LIB_FLAG)
+AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TCL_STUB_LIB_SPEC)
+AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
+AC_SUBST(TCL_STUB_LIB_PATH)
+
+AC_SUBST(DDE_DLL_FILE)
+AC_SUBST(DDE_LIB_FILE)
+AC_SUBST(REG_DLL_FILE)
+AC_SUBST(REG_LIB_FILE)
+AC_SUBST(PIPE_DLL_FILE)
+
AC_SUBST(TCL_SRC_DIR)
-AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
-AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_BIN_DIR)
+AC_SUBST(TCL_DBGX)
+AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
+AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
+AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
+AC_SUBST(TCL_SHARED_BUILD)
+
+AC_SUBST(CYGPATH)
+AC_SUBST(DEPARG)
+AC_SUBST(CFLAGS_DEFAULT)
+AC_SUBST(CFLAGS_DEBUG)
+AC_SUBST(CFLAGS_OPTIMIZE)
+AC_SUBST(CFLAGS_WARNING)
+AC_SUBST(EXTRA_CFLAGS)
+AC_SUBST(STLIB_LD)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(CC_OBJNAME)
+AC_SUBST(CC_EXENAME)
+AC_SUBST(TCL_LD_SEARCH_FLAGS)
+AC_SUBST(LDFLAGS_DEFAULT)
+AC_SUBST(LDFLAGS_DEBUG)
+AC_SUBST(LDFLAGS_OPTIMIZE)
+AC_SUBST(LDFLAGS_CONSOLE)
+AC_SUBST(LDFLAGS_WINDOW)
+AC_SUBST(AR)
+AC_SUBST(RANLIB)
+AC_SUBST(RC)
+AC_SUBST(RC_OUT)
+AC_SUBST(RC_TYPE)
+AC_SUBST(RC_INCLUDE)
+AC_SUBST(RES)
+AC_SUBST(LIBS)
+AC_SUBST(LIBS_GUI)
+AC_SUBST(DLLSUFFIX)
+AC_SUBST(VENDORPREFIX)
+AC_SUBST(LIBPREFIX)
+AC_SUBST(LIBSUFFIX)
+AC_SUBST(EXESUFFIX)
+AC_SUBST(LIBRARIES)
+AC_SUBST(MAKE_LIB)
+AC_SUBST(POST_MAKE_LIB)
+AC_SUBST(MAKE_DLL)
+AC_SUBST(MAKE_EXE)
+
+AC_OUTPUT(Makefile tclConfig.sh tcl.hpj)
-AC_OUTPUT(Makefile ../unix/tclConfig.sh)
diff --git a/tcl/win/license.terms b/tcl/win/license.terms
index 9df3e600352..fd2572c083a 100644
--- a/tcl/win/license.terms
+++ b/tcl/win/license.terms
@@ -37,3 +37,5 @@ Government shall have only "Restricted Rights" as defined in Clause
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license.
+
+
diff --git a/tcl/win/makefile.vc b/tcl/win/makefile.vc
index 50ab3631e64..3fc7e2cca66 100644
--- a/tcl/win/makefile.vc
+++ b/tcl/win/makefile.vc
@@ -4,6 +4,8 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
# RCS: @(#) $Id$
# Does not depend on the presence of any environment variables in
@@ -13,54 +15,58 @@
#
# Project directories
#
-# ROOT = top of source tree
-#
-# TMPDIR = location where .obj files should be stored during build
+# ROOT = top of source tree
#
# TOOLS32 = location of VC++ 32-bit development tools. Note that the
# VC++ 2.0 header files are broken, so you need to use the
# ones that come with the developer network CD's, or later
# versions of VC++.
#
-# TOOLS16 = location of VC++ 1.5 16-bit tools, needed to build thunking
-# library. This information is optional; if the 16-bit compiler
-# is not available, then the 16-bit code will not be built.
-# Tcl will still run without the 16-bit code, but...
-# A. Under Windows 3.X you will any calls to the exec command
-# will return an error.
-# B. A 16-bit program to test the behavior of the exec
-# command under NT and 95 will not be built.
# INSTALLDIR = where the install- targets should copy the binaries and
# support files
#
+# Set this to the appropriate value of /MACHINE: for your platform
+MACHINE = IX86
+
ROOT = ..
-TOOLS32 = c:\progra~1\devstudio\vc
-TOOLS32_rc = c:\progra~1\devstudio\sharedide
-TOOLS16 = c:\msvc
+INSTALLDIR = c:\Progra~1\Tcl
-INSTALLDIR = c:\progra~1\Tcl
+!IF "$(MACHINE)" == "IA64"
+TOOLS32 = c:\ia64sdk17
+TOOLS32_rc = c:\ia64sdk17
+!ELSE
+TOOLS32 = c:\Progra~1\devstudio\vc
+TOOLS32_rc = c:\Progra~1\devstudio\sharedide
+!ENDIF
-# Set this to the appropriate value of /MACHINE: for your platform
-MACHINE = IX86
+# Uncomment the following line to compile with thread support
+#THREADDEFINES = -DTCL_THREADS=1
# Set NODEBUG to 0 to compile with symbols
NODEBUG = 1
-# uncomment one of the following lines to compile with TCL_MEM_DEBUG,
-# TCL_MEM_DEBUG, or TCL_COMPILE_DEBUG
-#DEBUGDEFINES = -DTCL_MEM_DEBUG
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_STATS
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+# The following defines can be used to control the amount of debugging
+# code that is added to the compilation.
+#
+# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
+# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
+# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
+# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor
+# of the native malloc implementation. This is
+# needed when using Purify.
+#
+#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+#DEBUGDEFINES = -DUSE_TCLALLOC=0
######################################################################
# Do not modify below this line
######################################################################
NAMEPREFIX = tcl
-DOTVERSION = 8.0
-VERSION = 80
+STUBPREFIX = $(NAMEPREFIX)stub
+DOTVERSION = 8.3
+VERSION = 83
BINROOT = .
!IF "$(NODEBUG)" == "1"
@@ -77,20 +83,26 @@ OUTDIR = $(TMPDIR)
TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll
TCLDLL = $(OUTDIR)\$(TCLDLLNAME)
+
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION)$(DBGX).lib
+TCLSTUBLIB = $(OUTDIR)\$(TCLSTUBLIBNAME)
+
TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
TCLPLUGINDLLNAME= $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
-TCL16DLL = $(OUTDIR)\$(NAMEPREFIX)16$(VERSION)$(DBGX).dll
TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME)
TCLREGDLLNAME = $(NAMEPREFIX)reg$(VERSION)$(DBGX).dll
TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
+TCLDDEDLLNAME = $(NAMEPREFIX)dde$(VERSION)$(DBGX).dll
+TCLDDEDLL = $(OUTDIR)\$(TCLDDEDLLNAME)
TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe
-DUMPEXTS = $(TMPDIR)\dumpexts.exe
-CAT16 = $(TMPDIR)\cat16.exe
CAT32 = $(TMPDIR)\cat32.exe
+RMDIR = .\rmd.bat
+MKDIR = .\mkd.bat
+RM = del
LIB_INSTALL_DIR = $(INSTALLDIR)\lib
BIN_INSTALL_DIR = $(INSTALLDIR)\bin
@@ -104,12 +116,15 @@ TCLTESTOBJS = \
$(TMPDIR)\tclTest.obj \
$(TMPDIR)\tclTestObj.obj \
$(TMPDIR)\tclTestProcBodyObj.obj \
+ $(TMPDIR)\tclThreadTest.obj \
$(TMPDIR)\tclWinTest.obj \
$(TMPDIR)\testMain.obj
TCLOBJS = \
- $(TMPDIR)\panic.obj \
- $(TMPDIR)\regexp.obj \
+ $(TMPDIR)\regcomp.obj \
+ $(TMPDIR)\regexec.obj \
+ $(TMPDIR)\regfree.obj \
+ $(TMPDIR)\regerror.obj \
$(TMPDIR)\strftime.obj \
$(TMPDIR)\tclAlloc.obj \
$(TMPDIR)\tclAsync.obj \
@@ -120,9 +135,11 @@ TCLOBJS = \
$(TMPDIR)\tclCmdAH.obj \
$(TMPDIR)\tclCmdIL.obj \
$(TMPDIR)\tclCmdMZ.obj \
+ $(TMPDIR)\tclCompCmds.obj \
$(TMPDIR)\tclCompExpr.obj \
$(TMPDIR)\tclCompile.obj \
$(TMPDIR)\tclDate.obj \
+ $(TMPDIR)\tclEncoding.obj \
$(TMPDIR)\tclEnv.obj \
$(TMPDIR)\tclEvent.obj \
$(TMPDIR)\tclExecute.obj \
@@ -135,28 +152,41 @@ TCLOBJS = \
$(TMPDIR)\tclInterp.obj \
$(TMPDIR)\tclIO.obj \
$(TMPDIR)\tclIOCmd.obj \
+ $(TMPDIR)\tclIOGT.obj \
$(TMPDIR)\tclIOSock.obj \
$(TMPDIR)\tclIOUtil.obj \
$(TMPDIR)\tclLink.obj \
+ $(TMPDIR)\tclLiteral.obj \
$(TMPDIR)\tclListObj.obj \
$(TMPDIR)\tclLoad.obj \
$(TMPDIR)\tclMain.obj \
$(TMPDIR)\tclNamesp.obj \
$(TMPDIR)\tclNotify.obj \
$(TMPDIR)\tclObj.obj \
+ $(TMPDIR)\tclPanic.obj \
$(TMPDIR)\tclParse.obj \
+ $(TMPDIR)\tclParseExpr.obj \
$(TMPDIR)\tclPipe.obj \
$(TMPDIR)\tclPkg.obj \
$(TMPDIR)\tclPosixStr.obj \
$(TMPDIR)\tclPreserve.obj \
- $(TMPDIR)\tclResolve.obj \
$(TMPDIR)\tclProc.obj \
+ $(TMPDIR)\tclRegexp.obj \
+ $(TMPDIR)\tclResolve.obj \
+ $(TMPDIR)\tclResult.obj \
+ $(TMPDIR)\tclScan.obj \
$(TMPDIR)\tclStringObj.obj \
+ $(TMPDIR)\tclStubInit.obj \
+ $(TMPDIR)\tclStubLib.obj \
+ $(TMPDIR)\tclThread.obj \
$(TMPDIR)\tclTimer.obj \
+ $(TMPDIR)\tclUtf.obj \
$(TMPDIR)\tclUtil.obj \
$(TMPDIR)\tclVar.obj \
$(TMPDIR)\tclWin32Dll.obj \
$(TMPDIR)\tclWinChan.obj \
+ $(TMPDIR)\tclWinConsole.obj \
+ $(TMPDIR)\tclWinSerial.obj \
$(TMPDIR)\tclWinError.obj \
$(TMPDIR)\tclWinFCmd.obj \
$(TMPDIR)\tclWinFile.obj \
@@ -166,54 +196,75 @@ TCLOBJS = \
$(TMPDIR)\tclWinNotify.obj \
$(TMPDIR)\tclWinPipe.obj \
$(TMPDIR)\tclWinSock.obj \
+ $(TMPDIR)\tclWinThrd.obj \
$(TMPDIR)\tclWinTime.obj
-cc32 = $(TOOLS32)\bin\cl.exe
-link32 = $(TOOLS32)\bin\link.exe
-rc32 = $(TOOLS32_rc)\bin\rc.exe
-include32 = -I$(TOOLS32)\include
+TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj \
-cc16 = $(TOOLS16)\bin\cl.exe
-link16 = $(TOOLS16)\bin\link.exe
-rc16 = $(TOOLS16)\bin\rc.exe
-include16 = -I$(TOOLS16)\include
+cc32 = "$(TOOLS32)\bin\cl.exe"
+link32 = "$(TOOLS32)\bin\link.exe"
+rc32 = "$(TOOLS32_rc)\bin\rc.exe"
+include32 = -I"$(TOOLS32)\include"
+libpath32 = /LIBPATH:"$(TOOLS32)\lib"
+lib32 = "$(TOOLS32)\bin\lib.exe"
-WINDIR = $(ROOT)\win
+WINDIR = $(ROOT)\win
GENERICDIR = $(ROOT)\generic
-TCL_INCLUDES = -I$(WINDIR) -I$(GENERICDIR)
-TCL_DEFINES = -D__WIN32__ $(DEBUGDEFINES)
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
+TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES)
+
+######################################################################
+# Compile flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+# This cranks the optimization level to maximize speed
+cdebug = -O2 -Gs -GD
+!ELSE
+!IF "$(MACHINE)" == "IA64"
+cdebug = -Od -Zi
+!ELSE
+cdebug = -Z7 -Od -WX
+!ENDIF
+!ENDIF
+
+# declarations common to all compiler options
+cflags = -c -W3 -nologo -Fp$(TMPDIR)\ -YX
+cvarsdll = -MD$(DBGX)
TCL_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \
$(TCL_INCLUDES) $(TCL_DEFINES)
-CON_CFLAGS = $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE
-DOS_CFLAGS = $(cdebug) $(cflags) $(include16) -AL
-DLL16_CFLAGS = $(cdebug) $(cflags) $(include16) -ALw
+CON_CFLAGS = $(cdebug) $(cflags) $(include32) -DCONSOLE
######################################################################
# Link flags
######################################################################
!IF "$(NODEBUG)" == "1"
-ldebug = /RELEASE
+ldebug = /RELEASE
!ELSE
-ldebug = -debug:full -debugtype:cv
+ldebug = -debug:full -debugtype:cv
!ENDIF
# declarations common to all linker options
-lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
+lflags = /NODEFAULTLIB /NOLOGO /MACHINE:$(MACHINE) $(libpath32)
# declarations for use on Intel i386, i486, and Pentium systems
!IF "$(MACHINE)" == "IX86"
DLLENTRY = @12
-lflags = $(lcommon) /MACHINE:$(MACHINE)
+dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
!ELSE
-lflags = $(lcommon) /MACHINE:$(MACHINE)
+!IF "$(MACHINE)" == "IA64"
+DLLENTRY = @12
+dlllflags = $(lflags) -dll
+!ELSE
+dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
+!ENDIF
!ENDIF
conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
-dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
!IF "$(MACHINE)" == "PPC"
libc = libc$(DBGX).lib
@@ -224,7 +275,7 @@ libcdll = msvcrt$(DBGX).lib oldnames.lib
!ENDIF
baselibs = kernel32.lib $(optlibs) advapi32.lib user32.lib
-winlibs = $(baselibs) gdi32.lib comdlg32.lib winspool.lib
+winlibs = $(baselibs) gdi32.lib comdlg32.lib winspool.lib
guilibs = $(libc) $(winlibs)
conlibs = $(libc) $(baselibs)
@@ -232,207 +283,167 @@ guilibsdll = $(libcdll) $(winlibs)
conlibsdll = $(libcdll) $(baselibs)
######################################################################
-# Compile flags
-######################################################################
-
-!IF "$(NODEBUG)" == "1"
-!IF "$(MACHINE)" == "ALPHA"
-# MSVC on Alpha doesn't understand -Ot
-cdebug = -O2i -Gs -GD
-!ELSE
-#cdebug = -Oti -Gs -GD
-# This cranks the optimization level to maximize speed
-cdebug = -O2 -Gs -GD
-!ENDIF
-!ELSE
-cdebug = -Z7 -Od -WX
-!ENDIF
-
-# declarations common to all compiler options
-ccommon = -c -W3 -nologo -YX -Fp$(TMPDIR)\ -Dtry=__try -Dexcept=__except
-
-!IF "$(MACHINE)" == "IX86"
-cflags = $(ccommon) -D_X86_=1
-!ELSE
-!IF "$(MACHINE)" == "MIPS"
-cflags = $(ccommon) -D_MIPS_=1
-!ELSE
-!IF "$(MACHINE)" == "PPC"
-cflags = $(ccommon) -D_PPC_=1
-!ELSE
-!IF "$(MACHINE)" == "ALPHA"
-cflags = $(ccommon) -D_ALPHA_=1
-!ENDIF
-!ENDIF
-!ENDIF
-!ENDIF
-
-cvars = -DWIN32 -D_WIN32
-cvarsmt = $(cvars) -D_MT
-cvarsdll = $(cvarsmt) -D_DLL
-
-!IF "$(NODEBUG)" == "1"
-cvarsdll = $(cvars) -MD
-!ELSE
-cvarsdll = $(cvars) -MDd
-!ENDIF
-
-######################################################################
# Project specific targets
######################################################################
release: setup $(TCLSH) dlls
-dlls: setup $(TCL16DLL) $(TCLPIPEDLL) $(TCLREGDLL)
-all: setup $(TCLSH) dlls $(CAT16) $(CAT32)
-tcltest: setup $(TCLTEST) dlls $(CAT16) $(CAT32)
+dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
+all: setup $(TCLSH) dlls $(CAT32)
+tcltest: setup $(TCLTEST) dlls $(CAT32)
plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
install: install-binaries install-libraries
-test: setup $(TCLTEST) dlls $(CAT16) $(CAT32)
- copy $(WINDIR)\pkgIndex.tcl $(OUTDIR)
+test: setup $(TCLTEST) dlls $(CAT32)
set TCL_LIBRARY=$(ROOT)/library
- $(TCLTEST) <<
- cd ../tests
- source all
-<<
+ $(TCLTEST) $(ROOT)/tests/all.tcl
setup:
- @mkd $(TMPDIR)
- @mkd $(OUTDIR)
-
-$(DUMPEXTS): $(WINDIR)\winDumpExts.c
- $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
- set LIB=$(TOOLS32)\lib
- $(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
- $(TMPDIR)\winDumpExts.obj
+ @$(MKDIR) $(TMPDIR)
+ @$(MKDIR) $(OUTDIR)
$(TCLLIB): $(TCLDLL)
-$(TCLDLL): $(TCLOBJS) $(TMPDIR)\tcl.def $(TMPDIR)\tcl.res
- set LIB=$(TOOLS32)\lib
- $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\tcl.def \
+$(TCLDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
+ $(link32) $(ldebug) $(dlllflags) \
-out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @<<
$(TCLOBJS)
<<
+$(TCLSTUBLIB): $(TCLSTUBOBJS)
+ $(lib32) /out:$@ $(TCLSTUBOBJS)
+
$(TCLPLUGINLIB): $(TCLPLUGINDLL)
-$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\plugin.def $(TMPDIR)\tcl.res
- set LIB=$(TOOLS32)\lib
- $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\plugin.def \
+$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
+ $(link32) $(ldebug) $(dlllflags) \
-out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @<<
$(TCLOBJS)
<<
$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
- set LIB=$(TOOLS32)\lib
$(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
-out:$@ $(conlibsdll) $(TCLLIB) $(TCLSHOBJS)
$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
- set LIB=$(TOOLS32)\lib
$(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
-out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)
$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
- set LIB=$(TOOLS32)\lib
$(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
-out:$@ $(conlibsdll) $(TCLLIB) $(TCLTESTOBJS)
-$(TCL16DLL): $(WINDIR)\tcl16.rc $(WINDIR)\tclWin16.c
- if exist $(cc16) $(cc16) @<<
-$(DLL16_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\tclWin16.c
-<<
- @copy << $(TMPDIR)\tclWin16.def > nul
-LIBRARY $(@B);dll
-EXETYPE WINDOWS
-CODE PRELOAD MOVEABLE DISCARDABLE
-DATA PRELOAD MOVEABLE SINGLE
-HEAPSIZE 1024
-EXPORTS
- WEP @1 RESIDENTNAME
- UTPROC @2
-<<
- if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOE @<<
-$(TMPDIR)\tclWin16.obj
-$@
-nul
-$(TOOLS16)\lib\ ldllcew oldnames libw toolhelp
-$(TMPDIR)\tclWin16.def
-<<
- if exist $(cc16) $(rc16) -i $(GENERICDIR) $(TCL_DEFINES) $(WINDIR)\tcl16.rc $@
-
$(TCLPIPEDLL): $(WINDIR)\stub16.c
$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\stub16.c
- set LIB=$(TOOLS32)\lib
$(link32) $(ldebug) $(conlflags) -out:$@ $(TMPDIR)\stub16.obj $(guilibs)
-$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj
- set LIB=$(TOOLS32)\lib
+$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
+ $(link32) $(ldebug) $(dlllflags) -out:$@ $(TMPDIR)\tclWinDde.obj \
+ $(conlibsdll) $(TCLSTUBLIB)
+
+$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
$(link32) $(ldebug) $(dlllflags) -out:$@ $(TMPDIR)\tclWinReg.obj \
- $(conlibsdll) $(TCLLIB)
+ $(conlibsdll) $(TCLSTUBLIB)
$(CAT32): $(WINDIR)\cat.c
$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
- set LIB=$(TOOLS32)\lib
$(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs)
-$(CAT16): $(WINDIR)\cat.c
- if exist $(cc16) $(cc16) $(DOS_CFLAGS) -Fo$(TMPDIR)\ $?
- set LIB=$(TOOLS16)\lib
- if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOI /STACK:16384 \
- $(TMPDIR)\cat.obj,$@,nul,llibce.lib,nul
-
-$(TMPDIR)\tcl.def: $(DUMPEXTS) $(TCLOBJS)
- $(DUMPEXTS) -o $@ $(TCLDLLNAME) @<<
-$(TCLOBJS)
-<<
-
-$(TMPDIR)\plugin.def: $(DUMPEXTS) $(TCLOBJS)
- $(DUMPEXTS) -o $@ $(TCLPLUGINDLLNAME) @<<
-$(TCLOBJS)
-<<
-
install-binaries: $(TCLSH)
- @mkd $(BIN_INSTALL_DIR)
- @mkd $(LIB_INSTALL_DIR)
+ $(MKDIR) "$(BIN_INSTALL_DIR)"
+ $(MKDIR) "$(LIB_INSTALL_DIR)"
@echo installing $(TCLDLLNAME)
- @copy $(TCLDLL) $(BIN_INSTALL_DIR)
- @echo installing $(TCLSH)
- @copy $(TCLSH) $(BIN_INSTALL_DIR)
+ @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
+ @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
+ @echo installing "$(TCLSH)"
+ @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
+ @echo installing $(TCLPIPEDLLNAME)
+ @copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)"
+ @echo installing $(TCLSTUBLIBNAME)
+ @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
install-libraries:
- -@mkd $(LIB_INSTALL_DIR)
- -@mkd $(INCLUDE_INSTALL_DIR)
- -@mkd $(SCRIPT_INSTALL_DIR)
- -@mkd $(SCRIPT_INSTALL_DIR)\http1.0
- -@copy $(ROOT)\library\http1.0\http.tcl $(SCRIPT_INSTALL_DIR)\http1.0
- -@copy $(ROOT)\library\http1.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http1.0
- -@mkd $(SCRIPT_INSTALL_DIR)\http2.0
- -@copy $(ROOT)\library\http2.0\http.tcl $(SCRIPT_INSTALL_DIR)\http2.0
- -@copy $(ROOT)\library\http2.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http2.0
- -@mkd $(SCRIPT_INSTALL_DIR)\opt0.1
- -@copy $(ROOT)\library\opt0.1\optparse.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
- -@copy $(ROOT)\library\opt0.1\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
- -@copy $(GENERICDIR)\tcl.h $(INCLUDE_INSTALL_DIR)
- -@copy $(ROOT)\library\history.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\init.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\ldAout.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\parray.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\safe.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\tclIndex $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\word.tcl $(SCRIPT_INSTALL_DIR)
+ -@$(MKDIR) "$(LIB_INSTALL_DIR)"
+ -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @echo installing http1.0
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
+ -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
+ -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
+ @echo installing http2.3
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.3"
+ -@copy "$(ROOT)\library\http2.3\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.3"
+ -@copy "$(ROOT)\library\http2.3\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.3"
+ @echo installing opt0.4
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ -@copy "$(ROOT)\library\opt0.4\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ -@copy "$(ROOT)\library\opt0.4\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ @echo installing msgcat1.0
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.0"
+ -@copy "$(ROOT)\library\msgcat1.0\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.0"
+ -@copy "$(ROOT)\library\msgcat1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.0"
+ @echo installing $(TCLDDEDLLNAME)
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.1"
+ -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.1"
+ -@copy "$(ROOT)\library\dde1.1\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.1"
+ @echo installing $(TCLREGDLLNAME)
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.0"
+ -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.0"
+ -@copy "$(ROOT)\library\reg1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.0"
+ @echo installing encoding files
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
+ -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
+ @echo installing library files
+ -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)"
+
+#
+# Regenerate the stubs files.
+#
+
+genstubs:
+ tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls
+
+#
+# Regenerate the windows help files.
+#
+
+TCLTOOLS = $(ROOT)/tools
+MAN2TCL = $(TCLTOOLS)/man2tcl
+TCLRTF = $(TCLTOOLS)/tcl.rtf
+TCLHPJ = $(TCLTOOLS)/tcl.hpj
+MAN2HELP = $(TCLTOOLS)/man2help.tcl
+HCRTF = $(TOOLS32)/bin/hcrtf.exe
+
+winhelp: $(TCLRTF)
+ cd $(TCLTOOLS)
+ start /wait $(HCRTF) -xn $(TCLHPJ)
+
+$(MAN2TCL).exe: $(MAN2TCL).obj
+ cd $(TCLTOOLS)
+ $(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c
+
+$(TCLRTF): $(MAN2TCL).exe $(TCLSH)
+ cd $(TCLTOOLS)
+ ..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc
#
# Special case object file targets
#
$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
- $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) $(EXTFLAGS) \
- -Fo$(TMPDIR)\ $?
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) $(EXTFLAGS) -Fo$(TMPDIR)\ $?
$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -DTCL_TEST \
- -Fo$(TMPDIR)\testMain.obj $?
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST -Fo$(TMPDIR)\testMain.obj $?
$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
$(cc32) $(TCL_CFLAGS) -Fo$@ $?
@@ -444,35 +455,73 @@ $(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
$(cc32) $(TCL_CFLAGS) -Fo$@ $?
$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+# The following objects should be built using the stub interfaces
+
+$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
+ $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -Fo$@ $?
+
+$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
+ $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -Fo$@ $?
+
+# The following objects are part of the stub library and should not
+# be built as DLL objects but none of the symbols should be exported
+
+$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -Fo$@ $?
+
+# Dedependency rules
+
+$(GENERICDIR)\regcomp.c: \
+ $(GENERICDIR)\regguts.h \
+ $(GENERICDIR)\regc_lex.c \
+ $(GENERICDIR)\regc_color.c \
+ $(GENERICDIR)\regc_nfa.c \
+ $(GENERICDIR)\regc_cvec.c \
+ $(GENERICDIR)\regc_locale.c
+$(GENERICDIR)\regcustom.h: \
+ $(GENERICDIR)\tclInt.h \
+ $(GENERICDIR)\tclPort.h \
+ $(GENERICDIR)\regex.h
+$(GENERICDIR)\regexec.c: \
+ $(GENERICDIR)\rege_dfa.c \
+ $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
+
#
# Implicit rules
#
{$(WINDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
- $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
{$(WINDIR)}.rc{$(TMPDIR)}.res:
$(rc32) -fo $@ -r -i $(GENERICDIR) -i $(WINDIR) -D__WIN32__ \
$(TCL_DEFINES) $<
clean:
- -@del $(OUTDIR)\*.exp
- -@del $(OUTDIR)\*.lib
- -@del $(OUTDIR)\*.dll
- -@del $(OUTDIR)\*.exe
- -@del $(OUTDIR)\*.pdb
- -@del $(TMPDIR)\*.pch
- -@del $(TMPDIR)\*.obj
- -@del $(TMPDIR)\*.res
- -@del $(TMPDIR)\*.def
- -@del $(TMPDIR)\*.exe
- -@rmd $(OUTDIR)
- -@rmd $(TMPDIR)
+ -@$(RM) $(OUTDIR)\*.exp
+ -@$(RM) $(OUTDIR)\*.lib
+ -@$(RM) $(OUTDIR)\*.dll
+ -@$(RM) $(OUTDIR)\*.exe
+ -@$(RM) $(OUTDIR)\*.pdb
+ -@$(RM) $(TMPDIR)\*.pch
+ -@$(RM) $(TMPDIR)\*.obj
+ -@$(RM) $(TMPDIR)\*.res
+ -@$(RM) $(TMPDIR)\*.exe
+ -@$(RMDIR) $(OUTDIR)
+ -@$(RMDIR) $(TMPDIR)
+
+
+
diff --git a/tcl/win/mkd.bat b/tcl/win/mkd.bat
index 2bd2388394f..c7598eb9fe6 100644
--- a/tcl/win/mkd.bat
+++ b/tcl/win/mkd.bat
@@ -1,7 +1,7 @@
@echo off
rem RCS: @(#) $Id$
-if exist %1\tag.txt goto end
+if exist %1\. goto end
if "%OS%" == "Windows_NT" goto winnt
@@ -15,7 +15,8 @@ md %1
if errorlevel 1 goto end
:success
-echo TAG >%1\tag.txt
echo created directory %1
:end
+
+
diff --git a/tcl/win/rmd.bat b/tcl/win/rmd.bat
index 15fd8c1fabc..721ba4f96fc 100644
--- a/tcl/win/rmd.bat
+++ b/tcl/win/rmd.bat
@@ -1,7 +1,7 @@
@echo off
rem RCS: @(#) $Id$
-if not exist %1\tag.txt goto end
+if not exist %1\. goto end
echo Removing directory %1
@@ -23,3 +23,5 @@ if errorlevel 1 goto end
echo deleted directory %1
:end
+
+
diff --git a/tcl/win/stub16.c b/tcl/win/stub16.c
index 2138d508017..91016d86eac 100644
--- a/tcl/win/stub16.c
+++ b/tcl/win/stub16.c
@@ -16,6 +16,7 @@
#include <windows.h>
#include <stdio.h>
+#include <string.h>
static HANDLE CreateTempFile(void);
@@ -132,9 +133,9 @@ main()
WaitForInputIdle(pi.hProcess, 5000);
WaitForSingleObject(pi.hProcess, INFINITE);
+ GetExitCodeProcess(pi.hProcess, &result);
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
- result = 0;
if (hFileOutput != INVALID_HANDLE_VALUE) {
SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN);
@@ -196,3 +197,5 @@ CreateTempFile()
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE,
NULL);
}
+
+
diff --git a/tcl/win/tcl.m4 b/tcl/win/tcl.m4
new file mode 100644
index 00000000000..d2188de98f2
--- /dev/null
+++ b/tcl/win/tcl.m4
@@ -0,0 +1,637 @@
+#------------------------------------------------------------------------
+# SC_PATH_TCLCONFIG --
+#
+# Locate the tclConfig.sh file and perform a sanity check on
+# the Tcl compile flags
+# Currently a no-op for Windows
+#
+# Arguments:
+# PATCH_LEVEL The patch level for Tcl if any.
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tcl=...
+#
+# Sets the following vars:
+# TCL_BIN_DIR Full path to the tclConfig.sh file
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_TCLCONFIG, [
+ AC_MSG_CHECKING([the location of tclConfig.sh])
+
+# CYGNUS LOCAL
+ if test -d ../../tcl8.1/win; then
+ TCL_BIN_DIR_DEFAULT=../../tcl8.1/win
+ else
+ TCL_BIN_DIR_DEFAULT=../../tcl/win
+ fi
+# END CYGNUS LOCAL
+
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.3 binaries from DIR],
+ TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`)
+ if test ! -d $TCL_BIN_DIR; then
+ AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
+ fi
+ if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
+ AC_MSG_ERROR(There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
+ fi
+ AC_MSG_RESULT($TCL_BIN_DIR/tclConfig.sh)
+])
+
+#------------------------------------------------------------------------
+# SC_PATH_TKCONFIG --
+#
+# Locate the tkConfig.sh file
+# Currently a no-op for Windows
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tk=...
+#
+# Sets the following vars:
+# TK_BIN_DIR Full path to the tkConfig.sh file
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_TKCONFIG, [
+ AC_MSG_CHECKING([the location of tkConfig.sh])
+
+ if test -d ../../tk8.3$1/win; then
+ TK_BIN_DIR_DEFAULT=../../tk8.3$1/win
+ else
+ TK_BIN_DIR_DEFAULT=../../tk8.3/win
+ fi
+
+ AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.3 binaries from DIR],
+ TK_BIN_DIR=$withval, TK_BIN_DIR=`cd $TK_BIN_DIR_DEFAULT; pwd`)
+ if test ! -d $TK_BIN_DIR; then
+ AC_MSG_ERROR(Tk directory $TK_BIN_DIR does not exist)
+ fi
+ if test ! -f $TK_BIN_DIR/tkConfig.sh; then
+ AC_MSG_ERROR(There is no tkConfig.sh in $TK_BIN_DIR: perhaps you did not specify the Tk *build* directory (not the toplevel Tk directory) or you forgot to configure Tk?)
+ fi
+
+ AC_MSG_RESULT([$TK_BIN_DIR/tkConfig.sh])
+])
+
+#------------------------------------------------------------------------
+# SC_LOAD_TCLCONFIG --
+#
+# Load the tclConfig.sh file
+# Currently a no-op for Windows
+#
+# Arguments:
+#
+# Requires the following vars to be set:
+# TCL_BIN_DIR
+#
+# Results:
+#
+# Subst the following vars:
+# TCL_BIN_DIR
+# TCL_SRC_DIR
+# TCL_LIB_FILE
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_LOAD_TCLCONFIG, [
+ AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh])
+
+ if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then
+ AC_MSG_RESULT([loading])
+ . $TCL_BIN_DIR/tclConfig.sh
+ else
+ AC_MSG_RESULT([file not found])
+ fi
+
+ # The eval is required to do the TCL_DBGX substitution in the
+ # TCL_LIB_FILE variable.
+
+ eval TCL_LIB_FILE=${TCL_LIB_FILE}
+ eval TCL_LIB_FLAG=${TCL_LIB_FLAG}
+
+ AC_SUBST(TCL_BIN_DIR)
+ AC_SUBST(TCL_SRC_DIR)
+ AC_SUBST(TCL_LIB_FILE)
+])
+
+#------------------------------------------------------------------------
+# SC_LOAD_TKCONFIG --
+#
+# Load the tkConfig.sh file
+# Currently a no-op for Windows
+#
+# Arguments:
+#
+# Requires the following vars to be set:
+# TK_BIN_DIR
+#
+# Results:
+#
+# Sets the following vars that should be in tkConfig.sh:
+# TK_BIN_DIR
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_LOAD_TKCONFIG, [
+ AC_MSG_CHECKING([for existence of $TCLCONFIG])
+
+ if test -f "$TK_BIN_DIR/tkConfig.sh" ; then
+ AC_MSG_CHECKING([loading $TK_BIN_DIR/tkConfig.sh])
+ . $TK_BIN_DIR/tkConfig.sh
+ else
+ AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh])
+ fi
+
+
+ AC_SUBST(TK_BIN_DIR)
+ AC_SUBST(TK_SRC_DIR)
+ AC_SUBST(TK_LIB_FILE)
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_SHARED --
+#
+# Allows the building of shared libraries
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-shared=yes|no
+#
+# Defines the following vars:
+# STATIC_BUILD Used for building import/export libraries
+# on Windows.
+#
+# Sets the following vars:
+# SHARED_BUILD Value of 1 or 0
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_SHARED, [
+ AC_MSG_CHECKING([how to build libraries])
+ AC_ARG_ENABLE(shared,
+ [ --enable-shared build and link with shared libraries [--enable-shared]],
+ [tcl_ok=$enableval], [tcl_ok=yes])
+
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=yes
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ AC_MSG_RESULT([shared])
+ SHARED_BUILD=1
+ else
+ AC_MSG_RESULT([static])
+ SHARED_BUILD=0
+ AC_DEFINE(STATIC_BUILD)
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_THREADS --
+#
+# Specify if thread support should be enabled
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-threads=yes|no
+#
+# Defines the following vars:
+# TCL_THREADS
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_THREADS, [
+ AC_MSG_CHECKING(for building with threads)
+ AC_ARG_ENABLE(threads, [ --enable-threads build with threads],
+ [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "$tcl_ok" = "yes"; then
+ AC_MSG_RESULT(yes)
+ TCL_THREADS=1
+ AC_DEFINE(TCL_THREADS)
+ else
+ TCL_THREADS=0
+ AC_MSG_RESULT([no (default)])
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_SYMBOLS --
+#
+# Specify if debugging symbols should be used
+#
+# Arguments:
+# none
+#
+# Requires the following vars to be set in the Makefile:
+# CFLAGS_DEBUG
+# CFLAGS_OPTIMIZE
+# LDFLAGS_DEBUG
+# LDFLAGS_OPTIMIZE
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-symbols
+#
+# Defines the following vars:
+# CFLAGS_DEFAULT Set to $(CFLAGS_DEBUG) if true
+# Set to $(CFLAGS_OPTIMIZE) if false
+# LDFLAGS_DEFAULT Set to $(LDFLAGS_DEBUG) if true
+# Set to $(LDFLAGS_OPTIMIZE) if false
+# DBGX Debug library extension
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_SYMBOLS, [
+ AC_MSG_CHECKING([for build with symbols])
+ AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "$tcl_ok" = "yes"; then
+ CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
+ DBGX=d
+ AC_MSG_RESULT([yes])
+ else
+ CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ DBGX=""
+ AC_MSG_RESULT([no])
+ fi
+])
+
+
+#--------------------------------------------------------------------
+# SC_CONFIG_CFLAGS
+#
+# Try to determine the proper flags to pass to the compiler
+# for building shared libraries and other such nonsense.
+#
+# NOTE: The backslashes in quotes below are substituted twice
+# due to the fact that they are in a macro and then inlined
+# in the final configure script.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Can set the following vars:
+# EXTRA_CFLAGS
+# CFLAGS_DEBUG
+# CFLAGS_OPTIMIZE
+# CFLAGS_WARNING
+# LDFLAGS_DEBUG
+# LDFLAGS_OPTIMIZE
+# LDFLAGS_CONSOLE
+# LDFLAGS_WINDOW
+# CC_OBJNAME
+# CC_EXENAME
+# CYGPATH
+# STLIB_LD
+# SHLIB_LD
+# SHLIB_LD_LIBS
+# LIBS
+# AR
+# RC
+# RES
+#
+# MAKE_LIB
+# MAKE_EXE
+# MAKE_DLL
+#
+# LIBSUFFIX
+# LIBPREFIX
+# VENDORPREFIX
+# LIBRARIES
+# EXESUFFIX
+# DLLSUFFIX
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_CONFIG_CFLAGS, [
+ TCL_LIB_VERSIONS_OK=nodots
+
+ AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo)
+
+ # Check for a bug in gcc's windres that causes the
+ # compile to fail when a Windows native path is
+ # passed into windres. The mingw toolchain requires
+ # Windows native paths while Cygwin should work
+ # with both. Avoid the bug by passing a POSIX
+ # path when using the Cygwin toolchain.
+
+ if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
+ conftest=/tmp/conftest.rc
+ echo "STRINGTABLE BEGIN" > $conftest
+ echo "101 \"name\"" >> $conftest
+ echo "END" >> $conftest
+
+ AC_MSG_CHECKING([for Windows native path bug in windres])
+ cyg_conftest=`$CYGPATH $conftest`
+ if AC_TRY_COMMAND($RC -o conftest.res.o $cyg_conftest) ; then
+ AC_MSG_RESULT([no])
+ else
+ AC_MSG_RESULT([yes])
+ CYGPATH=echo
+ fi
+ conftest=
+ cyg_conftest=
+ fi
+
+ if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
+ DEPARG='"$<"'
+ else
+ DEPARG='"$(shell $(CYGPATH) $<)"'
+ fi
+
+ # CYGNUS LOCAL
+ VENDORPREFIX="rh"
+ # END CYGNUS LOCAL
+
+ # set various compiler flags depending on whether we are using gcc or cl
+
+ AC_MSG_CHECKING([compiler flags])
+ if test "${GCC}" = "yes" ; then
+
+ # CYGNUS LOCAL
+ if test "$ac_cv_cygwin" = "yes" ; then
+ VENDORPREFIX="cyg"
+ fi
+ # END CYGNUS LOCAL
+
+ SHLIB_LD=""
+ SHLIB_LD_LIBS=""
+ LIBS=""
+ LIBS_GUI="-lgdi32 -lcomdlg32"
+ STLIB_LD="${AR} cr"
+ RC_OUT=-o
+ RC_TYPE=
+ RC_INCLUDE=--include
+ RES=res.o
+ MAKE_LIB="\${STLIB_LD} \[$]@"
+ POST_MAKE_LIB="\${RANLIB} \[$]@"
+ MAKE_EXE="\${CC} -o \[$]@"
+ LIBPREFIX="lib${VENDORPREFIX}"
+
+ if test "${SHARED_BUILD}" = "0" ; then
+ # static
+ AC_MSG_RESULT([using static flags])
+ runtime=
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.a"
+ LIBRARIES="\${STATIC_LIBRARIES}"
+ EXESUFFIX="s\${DBGX}.exe"
+ DLLSUFFIX=""
+ else
+ # dynamic
+ AC_MSG_RESULT([using shared flags])
+
+ # ad-hoc check to see if CC supports -shared.
+ if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
+ AC_MSG_ERROR([${CC} does not support the -shared option.
+ You will need to upgrade to a newer version of the toolchain.])
+ fi
+
+ runtime=
+ # Link with gcc since ld does not link to default libs like
+ # -luser32 and -lmsvcrt. We also need to add CFLAGS so important
+ # flags like -mno-cygwin get passed in to CC.
+ SHLIB_LD='${CC} -shared ${CFLAGS}'
+ # Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
+ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
+
+ LIBSUFFIX="\${DBGX}.a"
+ DLLSUFFIX="\${DBGX}.dll"
+ EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ fi
+
+ CFLAGS_DEBUG=-g
+ CFLAGS_OPTIMIZE=-O
+ CFLAGS_WARNING="-Wall -Wconversion"
+ LDFLAGS_DEBUG=
+ LDFLAGS_OPTIMIZE=
+
+ # Specify the CC output file names based on the target name
+ CC_OBJNAME="-o \[$]@"
+ CC_EXENAME="-o \[$]@"
+
+ # Specify linker flags depending on the type of app being
+ # built -- Console vs. Window.
+ #
+ # We need to pass -e _WinMain@16 so that ld will use
+ # WinMain() instead of main() as the entry point. We can't
+ # use autoconf to check for this case since it would need
+ # to run an executable and that does not work when
+ # cross compiling. Remove this -e workaround once we
+ # require a gcc that does not have this bug.
+ LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
+ LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
+ else
+ SHLIB_LD="link -dll -nologo"
+ SHLIB_LD_LIBS="user32.lib advapi32.lib"
+ LIBS="user32.lib advapi32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib"
+ STLIB_LD="lib -nologo"
+ RC="rc"
+ RC_OUT=-fo
+ RC_TYPE=-r
+ RC_INCLUDE=-i
+ RES=res
+ MAKE_LIB="\${STLIB_LD} -out:\[$]@"
+ POST_MAKE_LIB=
+ MAKE_EXE="\${CC} -Fe\[$]@"
+ LIBPREFIX=${VENDORPREFIX}
+
+ if test "${SHARED_BUILD}" = "0" ; then
+ # static
+ AC_MSG_RESULT([using static flags])
+ runtime=-MT
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.lib"
+ LIBRARIES="\${STATIC_LIBRARIES}"
+ EXESUFFIX="s\${DBGX}.exe"
+ DLLSUFFIX=""
+ else
+ # dynamic
+ AC_MSG_RESULT([using shared flags])
+ runtime=-MD
+ # Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
+ LIBSUFFIX="\${DBGX}.lib"
+ DLLSUFFIX="\${DBGX}.dll"
+ EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ fi
+
+ EXTRA_CFLAGS="-YX"
+ CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
+# CFLAGS_OPTIMIZE="-nologo -O2 -Gs -GD ${runtime}"
+ CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}"
+ CFLAGS_WARNING="-W3"
+ LDFLAGS_DEBUG="-debug:full -debugtype:cv"
+ LDFLAGS_OPTIMIZE="-release"
+
+ # Specify the CC output file names based on the target name
+ CC_OBJNAME="-Fo\[$]@"
+ CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\""
+
+ # Specify linker flags depending on the type of app being
+ # built -- Console vs. Window.
+ LDFLAGS_CONSOLE="-link -subsystem:console"
+ LDFLAGS_WINDOW="-link -subsystem:windows"
+ fi
+
+ # Define the same variables as used in tclConfig.sh so that macros
+ # that depend on these variables work for both Tcl and extensions.
+ TCL_LIB_SUFFIX=$LIBSUFFIX
+ TCL_VENDOR_PREFIX=$VENDORPREFIX
+])
+
+#------------------------------------------------------------------------
+# SC_WITH_TCL --
+#
+# Location of the Tcl build directory.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tcl=...
+#
+# Defines the following vars:
+# TCL_BIN_DIR Full path to the tcl build dir.
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_WITH_TCL, [
+ if test -d ../../tcl8.3$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.3$1/win
+ else
+ TCL_BIN_DEFAULT=../../tcl8.3/win
+ fi
+
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.3 binaries from DIR],
+ TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
+ if test ! -d $TCL_BIN_DIR; then
+ AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
+ fi
+ if test ! -f $TCL_BIN_DIR/Makefile; then
+ AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
+ else
+ echo "building against Tcl binaries in: $TCL_BIN_DIR"
+ fi
+ AC_SUBST(TCL_BIN_DIR)
+])
+
+#--------------------------------------------------------------------
+# SC_TIME_HANLDER
+#
+# Checks how the system deals with time.h, what time structures
+# are used on the system, and what fields the structures have.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# USE_DELTA_FOR_TZ
+# HAVE_TM_GMTOFF
+# HAVE_TM_TZADJ
+# HAVE_TIMEZONE_VAR
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_TIME_HANDLER, [
+ AC_CHECK_HEADERS(sys/time.h)
+ AC_HEADER_TIME
+ AC_STRUCT_TIMEZONE
+
+ AC_MSG_CHECKING([tm_tzadj in struct tm])
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
+ [AC_DEFINE(HAVE_TM_TZADJ)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ AC_MSG_CHECKING([tm_gmtoff in struct tm])
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
+ [AC_DEFINE(HAVE_TM_GMTOFF)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ #
+ # Its important to include time.h in this check, as some systems
+ # (like convex) have timezone functions, etc.
+ #
+ have_timezone=no
+ AC_MSG_CHECKING([long timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern long timezone;
+ timezone += 1;
+ exit (0);],
+ [have_timezone=yes
+ AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ #
+ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ #
+ if test "$have_timezone" = no; then
+ AC_MSG_CHECKING([time_t timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern time_t timezone;
+ timezone += 1;
+ exit (0);],
+ [AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+ fi
+
+ #
+ # On some systems (eg Solaris 2.5.1), timezone is not declared in
+ # time.h unless you jump through hoops. Instead of that, we just
+ # declare it ourselves when necessary.
+ #
+ if test "$have_timezone" = yes; then
+ AC_MSG_CHECKING(for timezone declaration)
+ changequote(<<,>>)
+ tzrx='^[ ]*extern.*timezone'
+ changequote([,])
+ AC_EGREP_HEADER($tzrx, time.h, [
+ AC_DEFINE(HAVE_TIMEZONE_DECL)
+ AC_MSG_RESULT(found)], AC_MSG_RESULT(missing))
+ fi
+
+ #
+ # AIX does not have a timezone field in struct tm. When the AIX bsd
+ # library is used, the timezone global and the gettimeofday methods are
+ # to be avoided for timezone deduction instead, we deduce the timezone
+ # by comparing the localtime result on a known GMT value.
+ #
+
+ if test "`uname -s`" = "AIX" ; then
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ if test $libbsd = yes; then
+ AC_DEFINE(USE_DELTA_FOR_TZ)
+ fi
+ fi
+])
+
diff --git a/tcl/win/tcl.rc b/tcl/win/tcl.rc
index 31e70755eda..504b68f6a20 100644
--- a/tcl/win/tcl.rc
+++ b/tcl/win/tcl.rc
@@ -3,30 +3,34 @@
// Version
//
+#define VS_VERSION_INFO 1
+
#define RESOURCE_INCLUDED
#include <tcl.h>
+LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */
+
VS_VERSION_INFO VERSIONINFO
FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
FILEFLAGSMASK 0x3fL
FILEFLAGS 0x0L
- FILEOS 0x4L
- FILETYPE 0x2L
+ FILEOS 0x4 /* VOS__WINDOWS32 */
+ FILETYPE 0x2 /* VFT_DLL */
FILESUBTYPE 0x0L
BEGIN
BLOCK "StringFileInfo"
BEGIN
- BLOCK "040904b0"
+ BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
BEGIN
VALUE "FileDescription", "Tcl DLL\0"
VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".dll\0"
- VALUE "CompanyName", "Sun Microsystems, Inc\0"
+ VALUE "CompanyName", "Scriptics Corporation\0"
VALUE "FileVersion", TCL_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright \251 1995-1997\0"
+ VALUE "LegalCopyright", "Copyright (c) 2000 by Scriptics Corporation\0"
VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
VALUE "ProductVersion", TCL_PATCH_LEVEL
- END
+ END
END
BLOCK "VarFileInfo"
BEGIN
@@ -40,3 +44,6 @@ END
+
+
+
diff --git a/tcl/win/tclAppInit.c b/tcl/win/tclAppInit.c
index 1d1f970907f..6870adcf653 100644
--- a/tcl/win/tclAppInit.c
+++ b/tcl/win/tclAppInit.c
@@ -5,7 +5,8 @@
* procedure for Tcl applications (without Tk). Note that this
* program must be built in Win32 console mode to work properly.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -18,10 +19,13 @@
#include <locale.h>
#ifdef TCL_TEST
-EXTERN int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#ifdef TCL_THREADS
+extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif
#endif /* TCL_TEST */
static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
@@ -49,16 +53,36 @@ main(argc, argv)
int argc; /* Number of command-line arguments. */
char **argv; /* Values of command-line arguments. */
{
- char *p;
- char buffer[MAX_PATH];
+ /*
+ * The following #if block allows you to change the AppInit
+ * function by using a #define of TCL_LOCAL_APPINIT instead
+ * of rewriting this entire file. The #if checks for that
+ * #define and uses Tcl_AppInit if it doesn't exist.
+ */
+
+#ifndef TCL_LOCAL_APPINIT
+#define TCL_LOCAL_APPINIT Tcl_AppInit
+#endif
+ extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
+
+ /*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv,
+ * etc., without needing to rewrite Tcl_Main()
+ */
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+ extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
+#endif
+ char buffer[MAX_PATH +1];
+ char *p;
/*
* Set up the default locale to be standard "C" locale so parsing
* is performed correctly.
*/
setlocale(LC_ALL, "C");
-
setargv(&argc, &argv);
/*
@@ -74,7 +98,12 @@ main(argc, argv)
}
}
- Tcl_Main(argc, argv, Tcl_AppInit);
+#ifdef TCL_LOCAL_MAIN_HOOK
+ TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
+ Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
+
return 0; /* Needed only to prevent compiler warning. */
}
@@ -90,7 +119,7 @@ main(argc, argv)
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -115,6 +144,11 @@ Tcl_AppInit(interp)
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
+#ifdef TCL_THREADS
+ if (TclThread_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#endif
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -185,7 +219,7 @@ setargv(argcPtr, argvPtr)
char **argv;
int argc, size, inquote, copy, slashes;
- cmdLine = GetCommandLine();
+ cmdLine = GetCommandLine(); /* INTL: BUG */
/*
* Precompute an overly pessimistic guess at the number of arguments
@@ -194,9 +228,9 @@ setargv(argcPtr, argvPtr)
size = 2;
for (p = cmdLine; *p != '\0'; p++) {
- if (isspace(*p)) {
+ if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
size++;
- while (isspace(*p)) {
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
p++;
}
if (*p == '\0') {
@@ -204,8 +238,8 @@ setargv(argcPtr, argvPtr)
}
}
}
- argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *)
- + strlen(cmdLine) + 1));
+ argSpace = (char *) Tcl_Alloc(
+ (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
argv = (char **) argSpace;
argSpace += size * sizeof(char *);
size--;
@@ -213,7 +247,7 @@ setargv(argcPtr, argvPtr)
p = cmdLine;
for (argc = 0; argc < size; argc++) {
argv[argc] = arg = argSpace;
- while (isspace(*p)) {
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
p++;
}
if (*p == '\0') {
@@ -247,7 +281,8 @@ setargv(argcPtr, argvPtr)
slashes--;
}
- if ((*p == '\0') || (!inquote && isspace(*p))) {
+ if ((*p == '\0')
+ || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
break;
}
if (copy != 0) {
@@ -264,3 +299,5 @@ setargv(argcPtr, argvPtr)
*argcPtr = argc;
*argvPtr = argv;
}
+
+
diff --git a/tcl/win/tclConfig.sh.in b/tcl/win/tclConfig.sh.in
new file mode 100644
index 00000000000..7748a5d9c2d
--- /dev/null
+++ b/tcl/win/tclConfig.sh.in
@@ -0,0 +1,185 @@
+# tclConfig.sh --
+#
+# This shell script (for sh) is generated automatically by Tcl's
+# configure script. It will create shell variables for most of
+# the configuration options discovered by the configure script.
+# This script is intended to be included by the configure scripts
+# for Tcl extensions so that they don't have to figure this all
+# out for themselves.
+#
+# The information in this file is specific to a single platform.
+#
+# RCS: @(#) $Id$
+
+# Tcl's version number.
+TCL_VERSION='@TCL_VERSION@'
+TCL_MAJOR_VERSION='@TCL_MAJOR_VERSION@'
+TCL_MINOR_VERSION='@TCL_MINOR_VERSION@'
+TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@'
+
+# C compiler to use for compilation.
+TCL_CC='@CC@'
+
+# -D flags for use with the C compiler.
+TCL_DEFS='@DEFS@'
+
+# If TCL was built with debugging symbols, generated libraries contain
+# this string at the end of the library name (before the extension).
+TCL_DBGX=@TCL_DBGX@
+
+# Default flags used in an optimized and debuggable build, respectively.
+TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
+TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@'
+
+# Default linker flags used in an optimized and debuggable build, respectively.
+TCL_LDFLAGS_DEBUG='@LDFLAGS_DEBUG@'
+TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'
+
+# Flag, 1: we built a shared lib, 0 we didn't
+TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
+
+# The name of the Tcl library (may be either a .a file or a shared library):
+TCL_LIB_FILE='@TCL_LIB_FILE@'
+
+# The fullpath of the Tcl library (used for dependency checking)
+TCL_LIB_FULL_PATH='@TCL_LIB_FULL_PATH@'
+
+# Flag to indicate whether shared libraries need export files.
+TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@
+
+# String that can be evaluated to generate the part of the export file
+# name that comes after the "libxxx" (includes version number, if any,
+# extension, and anything else needed). May depend on the variables
+# VERSION. On most UNIX systems this is ${VERSION}.exp.
+TCL_EXPORT_FILE_SUFFIX='@CFG_TCL_EXPORT_FILE_SUFFIX@'
+
+# Additional libraries to use when linking Tcl.
+TCL_LIBS='@LIBS@'
+
+# Top-level directory in which Tcl's platform-independent files are
+# installed.
+TCL_PREFIX='@prefix@'
+
+# Top-level directory in which Tcl's platform-specific files (e.g.
+# executables) are installed.
+TCL_EXEC_PREFIX='@exec_prefix@'
+
+# Flags to pass to cc when compiling the components of a shared library:
+TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@'
+
+# Flags to pass to cc to get warning messages
+TCL_CFLAGS_WARNING='@CFLAGS_WARNING@'
+
+# Extra flags to pass to cc:
+TCL_EXTRA_CFLAGS='@EXTRA_CFLAGS@'
+
+# Base command to use for combining object files into a shared library:
+TCL_SHLIB_LD='@SHLIB_LD@'
+
+# Base command to use for combining object files into a static library:
+TCL_STLIB_LD='@STLIB_LD@'
+
+# Either '$LIBS' (if dependent libraries should be included when linking
+# shared libraries) or an empty string. See Tcl's configure.in for more
+# explanation.
+TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'
+
+# Suffix to use in the name of a shared library.
+TCL_SHLIB_SUFFIX='@DLLSUFFIX@'
+
+# Suffix to use in the name of an unshared library.
+TCL_LIB_SUFFIX='@LIBSUFFIX@'
+
+# Library file(s) to include in tclsh and other base applications
+# in order to provide facilities needed by DLOBJ above.
+TCL_DL_LIBS='@DL_LIBS@'
+
+# Flags to pass to the compiler when linking object files into
+# an executable tclsh or tcltest binary.
+TCL_LD_FLAGS='@LDFLAGS@'
+
+# Flags to pass to ld, such as "-R /usr/local/tcl/lib", that tell the
+# run-time dynamic linker where to look for shared libraries such as
+# libtcl.so. Used when linking applications. Only works if there
+# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
+TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
+
+# Additional object files linked with Tcl to provide compatibility
+# with standard facilities from ANSI C or POSIX.
+TCL_COMPAT_OBJS='@LIBOBJS@'
+
+# Name of the ranlib program to use.
+TCL_RANLIB='@RANLIB@'
+
+# -l flag to pass to the linker to pick up the Tcl library
+TCL_LIB_FLAG='@TCL_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tcl library from its
+# build directory.
+TCL_BUILD_LIB_SPEC='@TCL_BUILD_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tcl library from its
+# installed directory.
+TCL_LIB_SPEC='@TCL_LIB_SPEC@'
+
+# Indicates whether a version numbers should be used in -l switches
+# ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means
+# use switches like -ltcl75). SunOS and FreeBSD require "nodots", for
+# example.
+TCL_LIB_VERSIONS_OK='@TCL_LIB_VERSIONS_OK@'
+
+# String that can be evaluated to generate the part of a shared library
+# name that comes after the "libxxx" (includes version number, if any,
+# extension, and anything else needed). May depend on the variables
+# VERSION and SHLIB_SUFFIX. On most UNIX systems this is
+# ${VERSION}${SHLIB_SUFFIX}.
+TCL_SHARED_LIB_SUFFIX='@CFG_TCL_SHARED_LIB_SUFFIX@'
+
+# String that can be evaluated to generate the part of an unshared library
+# name that comes after the "libxxx" (includes version number, if any,
+# extension, and anything else needed). May depend on the variable
+# VERSION. On most UNIX systems this is ${VERSION}.a.
+TCL_UNSHARED_LIB_SUFFIX='@CFG_TCL_UNSHARED_LIB_SUFFIX@'
+
+# Location of the top-level source directory from which Tcl was built.
+# This is the directory that contains a README file as well as
+# subdirectories such as generic, unix, etc. If Tcl was compiled in a
+# different place than the directory containing the source files, this
+# points to the location of the sources, not the location where Tcl was
+# compiled.
+TCL_SRC_DIR='@TCL_SRC_DIR@'
+
+# List of standard directories in which to look for packages during
+# "package require" commands. Contains the "prefix" directory plus also
+# the "exec_prefix" directory, if it is different.
+TCL_PACKAGE_PATH='@TCL_PACKAGE_PATH@'
+
+# Tcl supports stub.
+TCL_SUPPORTS_STUBS=1
+
+# The name of the Tcl stub library (.a):
+TCL_STUB_LIB_FILE='@TCL_STUB_LIB_FILE@'
+
+# -l flag to pass to the linker to pick up the Tcl stub library
+TCL_STUB_LIB_FLAG='@TCL_STUB_LIB_FLAG@'
+
+# String to pass to linker to pick up the Tcl stub library from its
+# build directory.
+TCL_BUILD_STUB_LIB_SPEC='@TCL_BUILD_STUB_LIB_SPEC@'
+
+# String to pass to linker to pick up the Tcl stub library from its
+# installed directory.
+TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'
+
+# Path to the Tcl stub library in the build directory.
+TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'
+
+# Path to the Tcl stub library in the install directory.
+TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'
+
+TCL_DLL_FILE="@TCL_DLL_FILE@"
+TCL_STUB_LIB_FILE="@TCL_STUB_LIB_FILE@"
+
+# Vendor prefix to be added to lib names
+TCL_VENDOR_PREFIX=@VENDORPREFIX@
+
diff --git a/tcl/win/tclWin32Dll.c b/tcl/win/tclWin32Dll.c
index f44f17aeb86..26b53c92e63 100644
--- a/tcl/win/tclWin32Dll.c
+++ b/tcl/win/tclWin32Dll.c
@@ -1,10 +1,10 @@
/*
* tclWin32Dll.c --
*
- * This file contains the DLL entry point which sets up the 32-to-16-bit
- * thunking code for SynchSpawn if the library is running under Win32s.
+ * This file contains the DLL entry point.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -14,57 +14,131 @@
#include "tclWinInt.h"
-typedef DWORD (WINAPI * UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
+/*
+ * The following data structures are used when loading the thunking
+ * library for execing child processes under Win32s.
+ */
+
+typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
LPVOID *lpTranslationList);
-typedef BOOL (WINAPI * PUTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
- LPCSTR InitName, LPCSTR ProcName, UT32PROC* ThirtyTwoBitThunk,
+typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
+ LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
FARPROC UT32Callback, LPVOID Buff);
-typedef VOID (WINAPI * PUTUNREGISTER)(HANDLE hModule);
-
-static PUTUNREGISTER UTUnRegister = NULL;
-static int tclProcessesAttached = 0;
+typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
-/*
- * The following data structure is used to keep track of all of the DLL's
- * opened by Tcl so that they can be freed with the Tcl.dll is unloaded.
+/*
+ * The following variables keep track of information about this DLL
+ * on a per-instance basis. Each time this DLL is loaded, it gets its own
+ * new data segment with its own copy of all static and global information.
*/
-typedef struct LibraryList {
- HINSTANCE handle;
- struct LibraryList *nextPtr;
-} LibraryList;
-
-static LibraryList *libraryList = NULL; /* List of currently loaded DLL's. */
-
-static HINSTANCE tclInstance; /* Global library instance handle. */
-static int tclPlatformId; /* Running under NT, 95, or Win32s? */
+static HINSTANCE hInstance; /* HINSTANCE of this DLL. */
+static int platformId; /* Running under NT, or 95/98? */
/*
- * Declarations for functions that are only used in this file.
+ * The following function tables are used to dispatch to either the
+ * wide-character or multi-byte versions of the operating system calls,
+ * depending on whether the Unicode calls are available.
*/
-static void UnloadLibraries _ANSI_ARGS_((void));
+static TclWinProcs asciiProcs = {
+ 0,
+
+ (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,
+ (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
+ (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
+ DWORD, DWORD, HANDLE)) CreateFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
+ LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
+ LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,
+ (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,
+ (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,
+ (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
+ (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
+ (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
+ TCHAR **)) GetFullPathNameA,
+ (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,
+ (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
+ (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
+ WCHAR *)) GetTempFileNameA,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,
+ (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
+ WCHAR *, DWORD)) GetVolumeInformationA,
+ (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA,
+ (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,
+ (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
+ WCHAR *, TCHAR **)) SearchPathA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
+ (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
+};
+
+static TclWinProcs unicodeProcs = {
+ 1,
+
+ (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,
+ (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
+ (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
+ DWORD, DWORD, HANDLE)) CreateFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
+ LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
+ LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,
+ (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,
+ (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,
+ (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
+ (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
+ (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
+ TCHAR **)) GetFullPathNameW,
+ (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,
+ (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
+ (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
+ WCHAR *)) GetTempFileNameW,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
+ (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
+ WCHAR *, DWORD)) GetVolumeInformationW,
+ (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW,
+ (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,
+ (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
+ WCHAR *, TCHAR **)) SearchPathW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
+ (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
+};
+
+TclWinProcs *tclWinProcs;
+static Tcl_Encoding tclWinTCharEncoding;
/*
* The following declaration is for the VC++ DLL entry point.
*/
-BOOL APIENTRY DllMain _ANSI_ARGS_((HINSTANCE hInst,
- DWORD reason, LPVOID reserved));
-
-#ifdef __WIN32__
-#ifndef STATIC_BUILD
+BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
+ LPVOID reserved);
/* CYGNUS LOCAL */
#ifdef __CYGWIN32__
/* cygwin32 requires an impure pointer variable, which must be
explicitly initialized when the DLL starts up. */
struct _reent *_impure_ptr;
-extern struct _reent *_imp__reent_data;
+extern struct _reent __declspec(dllimport) reent_data;
#endif
/* END CYGNUS LOCAL */
+
+#ifdef __WIN32__
+#ifndef STATIC_BUILD
+
/*
*----------------------------------------------------------------------
@@ -122,24 +196,18 @@ DllMain(hInst, reason, reserved)
#ifdef __CYGWIN32__
/* cygwin32 requires the impure data pointer to be initialized
when the DLL starts up. */
- _impure_ptr = _imp__reent_data;
+ _impure_ptr = &reent_data;
#endif
/* END CYGNUS LOCAL */
switch (reason) {
case DLL_PROCESS_ATTACH:
- if (tclProcessesAttached++) {
- return FALSE; /* Not the first initialization. */
- }
-
TclWinInit(hInst);
return TRUE;
case DLL_PROCESS_DETACH:
-
- tclProcessesAttached--;
- if (tclProcessesAttached == 0) {
- Tcl_Finalize();
+ if (hInst == hInstance) {
+ Tcl_Finalize();
}
break;
}
@@ -153,6 +221,28 @@ DllMain(hInst, reason, reserved)
/*
*----------------------------------------------------------------------
*
+ * TclWinGetTclInstance --
+ *
+ * Retrieves the global library instance handle.
+ *
+ * Results:
+ * Returns the global library instance handle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HINSTANCE
+TclWinGetTclInstance()
+{
+ return hInstance;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclWinInit --
*
* This function initializes the internal state of the tcl library.
@@ -161,8 +251,7 @@ DllMain(hInst, reason, reserved)
* None.
*
* Side effects:
- * Initializes the 16-bit thunking library, and the tclPlatformId
- * variable.
+ * Initializes the tclPlatformId variable.
*
*----------------------------------------------------------------------
*/
@@ -173,248 +262,257 @@ TclWinInit(hInst)
{
OSVERSIONINFO os;
- tclInstance = hInst;
- os.dwOSVersionInfoSize = sizeof(os);
+ hInstance = hInst;
+ os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&os);
- tclPlatformId = os.dwPlatformId;
+ platformId = os.dwPlatformId;
/*
- * The following code stops Windows 3.x from automatically putting
- * up Sharing Violation dialogs, e.g, when someone tries to
- * access a file that is locked or a drive with no disk in it.
- * Tcl already returns the appropriate error to the caller, and they
- * can decide to put up their own dialog in response to that failure.
- *
- * Under 95 and NT, the system doesn't automatically put up dialogs
- * when the above operations fail.
+ * We no longer support Win32s, so just in case someone manages to
+ * get a runtime there, make sure they know that.
*/
- if (tclPlatformId == VER_PLATFORM_WIN32s) {
- SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+ if (platformId == VER_PLATFORM_WIN32s) {
+ panic("Win32s is not a supported platform");
}
+
+ tclWinProcs = &asciiProcs;
}
/*
*----------------------------------------------------------------------
*
- * TclpFinalize --
+ * TclWinGetPlatformId --
*
- * Clean up the Windows specific library state.
+ * Determines whether running under NT, 95, or Win32s, to allow
+ * runtime conditional code.
*
* Results:
- * None.
+ * The return value is one of:
+ * VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported)
+ * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
+ * VER_PLATFORM_WIN32_NT Win32 on Windows NT
*
* Side effects:
- * Unloads any DLLs and cleans up the thunking library, if
- * necessary.
+ * None.
*
*----------------------------------------------------------------------
*/
-void
-TclpFinalize()
+int
+TclWinGetPlatformId()
{
- /*
- * Unregister the Tcl thunk.
- */
-
- if (UTUnRegister != NULL) {
- UTUnRegister(tclInstance);
- UTUnRegister = NULL;
- }
-
- /*
- * Cleanup any dynamically loaded libraries.
- */
-
- UnloadLibraries();
+ return platformId;
}
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * TclWinLoadLibrary --
+ * TclWinNoBackslash --
*
- * This function is a wrapper for the system LoadLibrary. It is
- * responsible for adding library handles to the library list so
- * the libraries can be freed when tcl.dll is unloaded.
+ * We're always iterating through a string in Windows, changing the
+ * backslashes to slashes for use in Tcl.
*
* Results:
- * Returns the handle of the newly loaded library, or NULL on
- * failure.
+ * All backslashes in given string are changed to slashes.
*
* Side effects:
- * Loads the specified library into the process.
+ * None.
*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-HINSTANCE
-TclWinLoadLibrary(name)
- char *name; /* Library file to load. */
+char *
+TclWinNoBackslash(
+ char *path) /* String to change. */
{
- HINSTANCE handle;
- LibraryList *ptr;
-
- handle = LoadLibrary(name);
- if (handle != NULL) {
- ptr = (LibraryList*) ckalloc(sizeof(LibraryList));
- ptr->handle = handle;
- ptr->nextPtr = libraryList;
- libraryList = ptr;
- } else {
- TclWinConvertError(GetLastError());
+ char *p;
+
+ for (p = path; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
}
- return handle;
+ return path;
}
/*
*----------------------------------------------------------------------
*
- * UnloadLibraries --
+ * TclpCheckStackSpace --
*
- * Frees any dynamically allocated libraries loaded by Tcl.
+ * Detect if we are about to blow the stack. Called before an
+ * evaluation can happen when nesting depth is checked.
*
* Results:
- * None.
+ * 1 if there is enough stack space to continue; 0 if not.
*
* Side effects:
- * Frees the libraries on the library list as well as the list.
+ * None.
*
*----------------------------------------------------------------------
*/
-static void
-UnloadLibraries()
+int
+TclpCheckStackSpace()
{
- LibraryList *ptr;
+ /*
+ * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD
+ * bytes of stack space left. alloca() is cheap on windows; basically
+ * it just subtracts from the stack pointer causing the OS to throw an
+ * exception if the stack pointer is set below the bottom of the stack.
+ */
- while (libraryList != NULL) {
- FreeLibrary(libraryList->handle);
- ptr = libraryList->nextPtr;
- ckfree((char*)libraryList);
- libraryList = ptr;
- }
+#ifndef __GNUC__
+ __try {
+ alloca(TCL_WIN_STACK_THRESHOLD);
+ return 1;
+ /* CYGNUS LOCAL */
+ } __except (1) {}
+#else
+ return alloca(TCL_WIN_STACK_THRESHOLD) != NULL;
+#endif
+
+ return 0;
}
+
/*
*----------------------------------------------------------------------
*
- * TclWinSynchSpawn --
+ * TclWinGetPlatform --
*
- * 32-bit entry point to the 16-bit SynchSpawn code.
+ * This is a kludge that allows the test library to get access
+ * the internal tclPlatform variable.
*
* Results:
- * 1 on success, 0 on failure.
+ * Returns a pointer to the tclPlatform variable.
*
* Side effects:
- * Spawns a command and waits for it to complete.
+ * None.
*
*----------------------------------------------------------------------
*/
-int
-TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
-{
- static UT32PROC UTProc = NULL;
- static int utErrorCode;
-
- if (UTUnRegister == NULL) {
- /*
- * Load the Universal Thunking routines from kernel32.dll.
- */
- HINSTANCE hKernel;
- PUTREGISTER UTRegister;
- char buffer[] = "TCL16xx.DLL";
-
- hKernel = TclWinLoadLibrary("Kernel32.Dll");
- if (hKernel == NULL) {
- return 0;
- }
-
- UTRegister = (PUTREGISTER) GetProcAddress(hKernel, "UTRegister");
- UTUnRegister = (PUTUNREGISTER) GetProcAddress(hKernel, "UTUnRegister");
- if (!UTRegister || !UTUnRegister) {
- UnloadLibraries();
- return 0;
- }
-
- /*
- * Construct the complete name of tcl16xx.dll.
- */
-
- buffer[5] = '0' + TCL_MAJOR_VERSION;
- buffer[6] = '0' + TCL_MINOR_VERSION;
-
- /*
- * Register the Tcl thunk.
- */
-
- if (UTRegister(tclInstance, buffer, NULL, "UTProc", &UTProc, NULL,
- NULL) == FALSE) {
- utErrorCode = GetLastError();
- }
- }
-
- if (UTProc == NULL) {
- /*
- * The 16-bit thunking DLL wasn't found. Return error code that
- * indicates this problem.
- */
-
- SetLastError(utErrorCode);
- return 0;
- }
-
- UTProc(args, type, trans);
- *pidPtr = 0;
- return 1;
+TclPlatformType *
+TclWinGetPlatform()
+{
+ return &tclPlatform;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclWinGetTclInstance --
+ * TclWinSetInterfaces --
*
- * Retrieves the global library instance handle.
+ * A helper proc that allows the test library to change the
+ * tclWinProcs structure to dispatch to either the wide-character
+ * or multi-byte versions of the operating system calls, depending
+ * on whether Unicode is the system encoding.
*
* Results:
- * Returns the global library instance handle.
+ * None.
*
* Side effects:
* None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-HINSTANCE
-TclWinGetTclInstance()
+void
+TclWinSetInterfaces(
+ int wide) /* Non-zero to use wide interfaces, 0
+ * otherwise. */
{
- return tclInstance;
+ Tcl_FreeEncoding(tclWinTCharEncoding);
+
+ if (wide) {
+ tclWinProcs = &unicodeProcs;
+ tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
+ } else {
+ tclWinProcs = &asciiProcs;
+ tclWinTCharEncoding = NULL;
+ }
}
/*
- *----------------------------------------------------------------------
- *
- * TclWinGetPlatformId --
- *
- * Determines whether running under NT, 95, or Win32s, to allow
- * runtime conditional code.
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
+ *
+ * Convert between UTF-8 and Unicode when running Windows NT or
+ * the current ANSI code page when running Windows 95.
+ *
+ * On Mac, Unix, and Windows 95, all strings exchanged between Tcl
+ * and the OS are "char" oriented. We need only one Tcl_Encoding to
+ * convert between UTF-8 and the system's native encoding. We use
+ * NULL to represent that encoding.
+ *
+ * On NT, some strings exchanged between Tcl and the OS are "char"
+ * oriented, while others are in Unicode. We need two Tcl_Encoding
+ * APIs depending on whether we are targeting a "char" or Unicode
+ * interface.
+ *
+ * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an
+ * encoding of NULL should always used to convert between UTF-8
+ * and the system's "char" oriented encoding. The following two
+ * functions are used in Windows-specific code to convert between
+ * UTF-8 and Unicode strings (NT) or "char" strings(95). This saves
+ * you the trouble of writing the following type of fragment over and
+ * over:
+ *
+ * if (running NT) {
+ * encoding <- Tcl_GetEncoding("unicode");
+ * nativeBuffer <- UtfToExternal(encoding, utfBuffer);
+ * Tcl_FreeEncoding(encoding);
+ * } else {
+ * nativeBuffer <- UtfToExternal(NULL, utfBuffer);
+ * }
+ *
+ * By convention, in Windows a TCHAR is a character in the ANSI code
+ * page on Windows 95, a Unicode character on Windows NT. If you
+ * plan on targeting a Unicode interfaces when running on NT and a
+ * "char" oriented interface while running on 95, these functions
+ * should be used. If you plan on targetting the same "char"
+ * oriented function on both 95 and NT, use Tcl_UtfToExternal()
+ * with an encoding of NULL.
*
* Results:
- * The return value is one of:
- * VER_PLATFORM_WIN32s Win32s on Windows 3.1.
- * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
- * VER_PLATFORM_WIN32_NT Win32 on Windows NT
+ * The result is a pointer to the string in the desired target
+ * encoding. Storage for the result string is allocated in
+ * dsPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
*
* Side effects:
* None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-int
-TclWinGetPlatformId()
+TCHAR *
+Tcl_WinUtfToTChar(string, len, dsPtr)
+ CONST char *string; /* Source string in UTF-8. */
+ int len; /* Source string length in bytes, or < 0 for
+ * strlen(). */
+ Tcl_DString *dsPtr; /* Uninitialized or free DString in which
+ * the converted string is stored. */
+{
+ return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
+ string, len, dsPtr);
+}
+
+char *
+Tcl_WinTCharToUtf(string, len, dsPtr)
+ CONST TCHAR *string; /* Source string in Unicode when running
+ * NT, ANSI when running 95. */
+ int len; /* Source string length in bytes, or < 0 for
+ * platform-specific string length. */
+ Tcl_DString *dsPtr; /* Uninitialized or free DString in which
+ * the converted string is stored. */
{
- return tclPlatformId;
+ return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
+ (CONST char *) string, len, dsPtr);
}
+
+
+
diff --git a/tcl/win/tclWinChan.c b/tcl/win/tclWinChan.c
index c9690a1ea2a..8b6c0acf7c5 100644
--- a/tcl/win/tclWinChan.c
+++ b/tcl/win/tclWinChan.c
@@ -15,20 +15,6 @@
#include "tclWinInt.h"
/*
- * This is the size of the channel name for File based channels
- */
-
-#define CHANNEL_NAME_SIZE 64
-static char channelName[CHANNEL_NAME_SIZE+1];
-
-/*
- * The following variable is used to tell whether this module has been
- * initialized.
- */
-
-static int initialized = 0;
-
-/*
* State flags used in the info structures below.
*/
@@ -36,6 +22,9 @@ static int initialized = 0;
#define FILE_ASYNC (1<<1) /* Channel is non-blocking. */
#define FILE_APPEND (1<<2) /* File is in append mode. */
+#define FILE_TYPE_SERIAL (FILE_TYPE_PIPE+1)
+#define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
+
/*
* The following structure contains per-instance data for a file based channel.
*/
@@ -53,11 +42,15 @@ typedef struct FileInfo {
struct FileInfo *nextPtr; /* Pointer to next registered file. */
} FileInfo;
-/*
- * List of all file channels currently open.
- */
+typedef struct ThreadSpecificData {
+ /*
+ * List of all file channels currently open.
+ */
+
+ FileInfo *firstFilePtr;
+} ThreadSpecificData;
-static FileInfo *firstFilePtr;
+static Tcl_ThreadDataKey dataKey;
/*
* The following structure is what is added to the Tcl event queue when
@@ -77,14 +70,6 @@ typedef struct FileEvent {
* Static routines for this file:
*/
-static int ComGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
- Tcl_DString *dsPtr));
-static int ComInputProc _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toRead, int *errorCode));
-static int ComSetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
- char *value));
static int FileBlockProc _ANSI_ARGS_((ClientData instanceData,
int mode));
static void FileChannelExitHandler _ANSI_ARGS_((
@@ -97,7 +82,7 @@ static int FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
int flags));
static int FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
int direction, ClientData *handlePtr));
-static void FileInit _ANSI_ARGS_((void));
+static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutputProc _ANSI_ARGS_((ClientData instanceData,
@@ -116,7 +101,7 @@ static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- FileBlockProc, /* Set blocking or non-blocking mode.*/
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
@@ -125,20 +110,12 @@ static Tcl_ChannelType fileChannelType = {
NULL, /* Get option proc. */
FileWatchProc, /* Set up the notifier to watch the channel. */
FileGetHandleProc, /* Get an OS handle from channel. */
-};
-
-static Tcl_ChannelType comChannelType = {
- "com", /* Type name. */
+ NULL, /* close2proc. */
FileBlockProc, /* Set blocking or non-blocking mode.*/
- FileCloseProc, /* Close proc. */
- ComInputProc, /* Input proc. */
- FileOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- ComSetOptionProc, /* Set option proc. */
- ComGetOptionProc, /* Get option proc. */
- FileWatchProc, /* Set up notifier to watch the channel. */
- FileGetHandleProc /* Get an OS handle from channel. */
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
+
/*
*----------------------------------------------------------------------
@@ -156,13 +133,18 @@ static Tcl_ChannelType comChannelType = {
*----------------------------------------------------------------------
*/
-static void
+static ThreadSpecificData *
FileInit()
{
- initialized = 1;
- firstFilePtr = NULL;
- Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
- Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstFilePtr = NULL;
+ Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
+ }
+ return tsdPtr;
}
/*
@@ -187,7 +169,6 @@ FileChannelExitHandler(clientData)
ClientData clientData; /* Old window proc */
{
Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
- initialized = 0;
}
/*
@@ -214,6 +195,7 @@ FileSetupProc(data, flags)
{
FileInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -223,7 +205,8 @@ FileSetupProc(data, flags)
* Check to see if there is a ready file. If so, poll.
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask) {
Tcl_SetMaxBlockTime(&blockTime);
break;
@@ -255,6 +238,7 @@ FileCheckProc(data, flags)
{
FileEvent *evPtr;
FileInfo *infoPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -266,7 +250,8 @@ FileCheckProc(data, flags)
* events).
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
infoPtr->flags |= FILE_PENDING;
evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
@@ -305,6 +290,7 @@ FileEventProc(evPtr, flags)
{
FileEvent *fileEvPtr = (FileEvent *)evPtr;
FileInfo *infoPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -317,7 +303,8 @@ FileEventProc(evPtr, flags)
* event is in the queue.
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (fileEvPtr->infoPtr == infoPtr) {
infoPtr->flags &= ~(FILE_PENDING);
Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
@@ -390,6 +377,7 @@ FileCloseProc(instanceData, interp)
FileInfo *fileInfoPtr = (FileInfo *) instanceData;
FileInfo **nextPtrPtr;
int errorCode = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Remove the file from the watch list.
@@ -397,11 +385,22 @@ FileCloseProc(instanceData, interp)
FileWatchProc(instanceData, 0);
- if (CloseHandle(fileInfoPtr->handle) == FALSE) {
- TclWinConvertError(GetLastError());
- errorCode = errno;
+ /*
+ * Don't close the Win32 handle if the handle is a standard channel
+ * during the exit process. Otherwise, one thread may kill the stdio
+ * of another.
+ */
+
+ if (!TclInExit()
+ || ((GetStdHandle(STD_INPUT_HANDLE) != fileInfoPtr->handle)
+ && (GetStdHandle(STD_OUTPUT_HANDLE) != fileInfoPtr->handle)
+ && (GetStdHandle(STD_ERROR_HANDLE) != fileInfoPtr->handle))) {
+ if (CloseHandle(fileInfoPtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ errorCode = errno;
+ }
}
- for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
+ for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == fileInfoPtr) {
(*nextPtrPtr) = fileInfoPtr->nextPtr;
@@ -454,7 +453,8 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr)
newPos = SetFilePointer(infoPtr->handle, offset, NULL, moveMethod);
if (newPos == 0xFFFFFFFF) {
TclWinConvertError(GetLastError());
- return -1;
+ *errorCodePtr = errno;
+ return -1;
}
return newPos;
}
@@ -604,7 +604,7 @@ FileWatchProc(instanceData, mask)
*
* FileGetHandleProc --
*
- * Called from Tcl_GetChannelFile to retrieve OS handles from
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from
* a file based channel.
*
* Results:
@@ -632,196 +632,7 @@ FileGetHandleProc(instanceData, direction, handlePtr)
return TCL_ERROR;
}
}
-
-/*
- *----------------------------------------------------------------------
- *
- * ComInputProc --
- *
- * Reads input from the IO channel into the buffer given. Returns
- * count of how many bytes were actually read, and an error indication.
- *
- * Results:
- * A count of how many bytes were read is returned and an error
- * indication is returned in an output argument.
- *
- * Side effects:
- * Reads input from the actual channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ComInputProc(instanceData, buf, bufSize, errorCode)
- ClientData instanceData; /* File state. */
- char *buf; /* Where to store data read. */
- int bufSize; /* How much space is available
- * in the buffer? */
- int *errorCode; /* Where to store error code. */
-{
- FileInfo *infoPtr;
- DWORD bytesRead;
- DWORD dw;
- COMSTAT cs;
-
- *errorCode = 0;
- infoPtr = (FileInfo *) instanceData;
-
- if (ClearCommError(infoPtr->handle, &dw, &cs)) {
- if (dw != 0) {
- *errorCode = EIO;
- return -1;
- }
- if (cs.cbInQue != 0) {
- if ((DWORD) bufSize > cs.cbInQue) {
- bufSize = cs.cbInQue;
- }
- } else {
- if (infoPtr->flags & FILE_ASYNC) {
- errno = *errorCode = EAGAIN;
- return -1;
- } else {
- bufSize = 1;
- }
- }
- }
-
- if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
- (LPOVERLAPPED) NULL) == FALSE) {
- TclWinConvertError(GetLastError());
- *errorCode = errno;
- return -1;
- }
-
- return bytesRead;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ComSetOptionProc --
- *
- * Sets an option on a channel.
- *
- * Results:
- * A standard Tcl result. Also sets interp->result on error if
- * interp is not NULL.
- *
- * Side effects:
- * May modify an option on a device.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ComSetOptionProc(instanceData, interp, optionName, value)
- ClientData instanceData; /* File state. */
- Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Which option to set? */
- char *value; /* New value for option. */
-{
- FileInfo *infoPtr;
- DCB dcb;
- int len;
-
- infoPtr = (FileInfo *) instanceData;
-
- len = strlen(optionName);
- if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
- if (GetCommState(infoPtr->handle, &dcb)) {
- if ((BuildCommDCB(value, &dcb) == FALSE) ||
- (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
- /*
- * one should separate the 2 errors...
- */
- if (interp) {
- Tcl_AppendResult(interp, "bad value for -mode: should be ",
- "baud,parity,data,stop", NULL);
- }
- return TCL_ERROR;
- } else {
- return TCL_OK;
- }
- } else {
- if (interp) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
- }
- return TCL_ERROR;
- }
- } else {
- return Tcl_BadChannelOption(interp, optionName, "mode");
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ComGetOptionProc --
- *
- * Gets a mode associated with an IO channel. If the optionName arg
- * is non NULL, retrieves the value of that option. If the optionName
- * arg is NULL, retrieves a list of alternating option names and
- * values for the given channel.
- *
- * Results:
- * A standard Tcl result. Also sets the supplied DString to the
- * string value of the option(s) returned.
- *
- * Side effects:
- * The string returned by this function is in static storage and
- * may be reused at any time subsequent to the call.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ComGetOptionProc(instanceData, interp, optionName, dsPtr)
- ClientData instanceData; /* File state. */
- Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Option to get. */
- Tcl_DString *dsPtr; /* Where to store value(s). */
-{
- FileInfo *infoPtr;
- DCB dcb;
- int len;
-
- infoPtr = (FileInfo *) instanceData;
-
- if (optionName == NULL) {
- Tcl_DStringAppendElement(dsPtr, "-mode");
- len = 0;
- } else {
- len = strlen(optionName);
- }
- if ((len == 0) ||
- ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
- if (GetCommState(infoPtr->handle, &dcb) == 0) {
- /*
- * shouldn't we flag an error instead ?
- */
- Tcl_DStringAppendElement(dsPtr, "");
- } else {
- char parity;
- char *stop;
- char buf[32];
-
- parity = 'n';
- if (dcb.Parity < 4) {
- parity = "noems"[dcb.Parity];
- }
-
- stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
- (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
- wsprintf(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize,
- stop);
- Tcl_DStringAppendElement(dsPtr, buf);
- }
- return TCL_OK;
- } else {
- return Tcl_BadChannelOption(interp, optionName, "mode");
- }
-}
/*
*----------------------------------------------------------------------
@@ -852,28 +663,39 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
* file, with what modes to create
* it? */
{
- FileInfo *infoPtr;
+ Tcl_Channel channel = 0;
int seekFlag, mode, channelPermissions;
- DWORD accessMode, createMode, shareMode, flags;
- char *nativeName;
- Tcl_DString buffer;
+ DWORD accessMode, createMode, shareMode, flags, consoleParams, type;
+ TCHAR *nativeName;
+ Tcl_DString ds, buffer;
DCB dcb;
- Tcl_ChannelType *channelTypePtr;
HANDLE handle;
-
- if (!initialized) {
- FileInit();
- }
+ char channelName[16 + TCL_INTEGER_SPACE];
+ TclFile readFile = NULL;
+ TclFile writeFile = NULL;
+#ifdef __CYGWIN__
+ char winbuf[MAX_PATH];
+#endif
mode = TclGetOpenMode(interp, modeString, &seekFlag);
if (mode == -1) {
return NULL;
}
- nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (nativeName == NULL) {
+ if (Tcl_TranslateFileName(interp, fileName, &ds) == NULL) {
return NULL;
}
+ nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), &buffer);
+
+#ifdef __CYGWIN__
+ /* In the Cygwin world, call conv_to_win32_path in order to use
+ the mount table to translate the file name into something
+ Windows will understand. */
+ cygwin_conv_to_win32_path(nativeName, winbuf);
+ Tcl_DStringFree(&buffer);
+ Tcl_DStringAppend(&buffer, winbuf, -1);
+#endif
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
@@ -929,7 +751,7 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
flags = FILE_ATTRIBUTE_READONLY;
}
} else {
- flags = GetFileAttributes(nativeName);
+ flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
@@ -945,13 +767,11 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
* Now we get to create the file.
*/
- handle = CreateFile(nativeName, accessMode, shareMode, NULL, createMode,
- flags, (HANDLE) NULL);
+ handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
+ shareMode, NULL, createMode, flags, (HANDLE) NULL);
if (handle == INVALID_HANDLE_VALUE) {
DWORD err;
-
- openerr:
err = GetLastError();
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
@@ -959,87 +779,90 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), (char *) NULL);
}
Tcl_DStringFree(&buffer);
return NULL;
}
+
+ type = GetFileType(handle);
- if (GetFileType(handle) == FILE_TYPE_CHAR) {
- dcb.DCBlength = sizeof( DCB ) ;
- if (GetCommState(handle, &dcb)) {
- /*
- * This is a com port. Reopen it with the correct modes.
- */
-
- COMMTIMEOUTS cto;
-
- CloseHandle(handle);
- handle = CreateFile(nativeName, accessMode, 0, NULL, OPEN_EXISTING,
- flags, NULL);
- if (handle == INVALID_HANDLE_VALUE) {
- goto openerr;
- }
+ /*
+ * If the file is a character device, we need to try to figure out
+ * whether it is a serial port, a console, or something else. We
+ * test for the console case first because this is more common.
+ */
- /*
- * FileInit the com port.
- */
-
- SetCommMask(handle, EV_RXCHAR);
- SetupComm(handle, 4096, 4096);
- PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
- | PURGE_RXCLEAR);
- cto.ReadIntervalTimeout = MAXDWORD;
- cto.ReadTotalTimeoutMultiplier = 0;
- cto.ReadTotalTimeoutConstant = 0;
- cto.WriteTotalTimeoutMultiplier = 0;
- cto.WriteTotalTimeoutConstant = 0;
- SetCommTimeouts(handle, &cto);
-
- GetCommState(handle, &dcb);
- SetCommState(handle, &dcb);
- channelTypePtr = &comChannelType;
+ if (type == FILE_TYPE_CHAR) {
+ if (GetConsoleMode(handle, &consoleParams)) {
+ type = FILE_TYPE_CONSOLE;
} else {
- channelTypePtr = &fileChannelType;
+ dcb.DCBlength = sizeof( DCB ) ;
+ if (GetCommState(handle, &dcb)) {
+ type = FILE_TYPE_SERIAL;
+ }
+
}
- } else {
- channelTypePtr = &fileChannelType;
}
- Tcl_DStringFree(&buffer);
- infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
- infoPtr->nextPtr = firstFilePtr;
- firstFilePtr = infoPtr;
- infoPtr->validMask = channelPermissions;
- infoPtr->watchMask = 0;
- infoPtr->flags = (mode & O_APPEND) ? FILE_APPEND : 0;
- infoPtr->handle = handle;
-
- sprintf(channelName, "file%d", (int) handle);
-
- infoPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
- (ClientData) infoPtr, channelPermissions);
-
- if (seekFlag) {
- if (Tcl_Seek(infoPtr->channel, 0, SEEK_END) < 0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "could not seek to end of file on \"",
- channelName, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
- }
- Tcl_Close(NULL, infoPtr->channel);
- return NULL;
- }
+ channel = NULL;
+
+ switch (type) {
+ case FILE_TYPE_SERIAL:
+ channel = TclWinOpenSerialChannel(handle, channelName,
+ channelPermissions);
+ break;
+ case FILE_TYPE_CONSOLE:
+ channel = TclWinOpenConsoleChannel(handle, channelName,
+ channelPermissions);
+ break;
+ case FILE_TYPE_PIPE:
+ if (channelPermissions & TCL_READABLE) {
+ readFile = TclWinMakeFile(handle);
+ }
+ if (channelPermissions & TCL_WRITABLE) {
+ writeFile = TclWinMakeFile(handle);
+ }
+ channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
+ break;
+ case FILE_TYPE_CHAR:
+ case FILE_TYPE_DISK:
+ case FILE_TYPE_UNKNOWN:
+ channel = TclWinOpenFileChannel(handle, channelName,
+ channelPermissions,
+ (mode & O_APPEND) ? FILE_APPEND : 0);
+ break;
+
+ default:
+ /*
+ * The handle is of an unknown type, probably /dev/nul equivalent
+ * or possibly a closed handle.
+ */
+
+ channel = NULL;
+ Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
+ "bad file type", (char *) NULL);
+ break;
}
- /*
- * Files have default translation of AUTO and ^Z eof char, which
- * means that a ^Z will be appended to them at close.
- */
-
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
- return infoPtr->channel;
+ Tcl_DStringFree(&buffer);
+ Tcl_DStringFree(&ds);
+
+ if (channel != NULL) {
+ if (seekFlag) {
+ if (Tcl_Seek(channel, 0, SEEK_END) < 0) {
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp,
+ "could not seek to end of file on \"",
+ channelName, "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
+ }
+ Tcl_Close(NULL, channel);
+ return NULL;
+ }
+ }
+ }
+ return channel;
}
/*
@@ -1060,57 +883,87 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
*/
Tcl_Channel
-Tcl_MakeFileChannel(handle, mode)
- ClientData handle; /* OS level handle */
+Tcl_MakeFileChannel(rawHandle, mode)
+ ClientData rawHandle; /* OS level handle */
int mode; /* ORed combination of TCL_READABLE and
* TCL_WRITABLE to indicate file mode. */
{
- char channelName[20];
- FileInfo *infoPtr;
-
- if (!initialized) {
- FileInit();
- }
+ char channelName[16 + TCL_INTEGER_SPACE];
+ Tcl_Channel channel = NULL;
+ HANDLE handle = (HANDLE) rawHandle;
+ DCB dcb;
+ DWORD consoleParams;
+ DWORD type;
+ TclFile readFile = NULL;
+ TclFile writeFile = NULL;
if (mode == 0) {
return NULL;
}
- sprintf(channelName, "file%d", (int) handle);
+ type = GetFileType(handle);
/*
- * See if a channel with this handle already exists.
+ * If the file is a character device, we need to try to figure out
+ * whether it is a serial port, a console, or something else. We
+ * test for the console case first because this is more common.
*/
-
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
- if (infoPtr->handle == (HANDLE) handle) {
- return (mode == infoPtr->validMask) ? infoPtr->channel : NULL;
+
+ if (type == FILE_TYPE_CHAR) {
+ if (GetConsoleMode(handle, &consoleParams)) {
+ type = FILE_TYPE_CONSOLE;
+ } else {
+ dcb.DCBlength = sizeof( DCB ) ;
+ if (GetCommState(handle, &dcb)) {
+ type = FILE_TYPE_SERIAL;
+ }
}
}
- infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
- infoPtr->nextPtr = firstFilePtr;
- firstFilePtr = infoPtr;
- infoPtr->validMask = mode;
- infoPtr->watchMask = 0;
- infoPtr->flags = 0;
- infoPtr->handle = (HANDLE) handle;
- infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
- (ClientData) infoPtr, mode);
+ switch (type)
+ {
+ case FILE_TYPE_SERIAL:
+ channel = TclWinOpenSerialChannel(handle, channelName, mode);
+ break;
+ case FILE_TYPE_CONSOLE:
+ channel = TclWinOpenConsoleChannel(handle, channelName, mode);
+ break;
+ case FILE_TYPE_PIPE:
+ if (mode & TCL_READABLE)
+ {
+ readFile = TclWinMakeFile(handle);
+ }
+ if (mode & TCL_WRITABLE)
+ {
+ writeFile = TclWinMakeFile(handle);
+ }
+ channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
+ break;
+
+ case FILE_TYPE_DISK:
+ case FILE_TYPE_CHAR:
+ case FILE_TYPE_UNKNOWN:
+ channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
+ break;
+
+ default:
+ /*
+ * The handle is of an unknown type, probably /dev/nul equivalent
+ * or possibly a closed handle.
+ */
+
+ channel = NULL;
+ break;
- /*
- * Windows files have AUTO translation mode and ^Z eof char on input.
- */
-
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
- return infoPtr->channel;
+ }
+
+ return channel;
}
/*
*----------------------------------------------------------------------
*
- * TclGetDefaultStdChannel --
+ * TclpGetDefaultStdChannel --
*
* Constructs a channel for the specified standard OS handle.
*
@@ -1125,7 +978,7 @@ Tcl_MakeFileChannel(handle, mode)
*/
Tcl_Channel
-TclGetDefaultStdChannel(type)
+TclpGetDefaultStdChannel(type)
int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel;
@@ -1154,20 +1007,25 @@ TclGetDefaultStdChannel(type)
panic("TclGetDefaultStdChannel: Unexpected channel type");
break;
}
+
handle = GetStdHandle(handleId);
/*
- * Note that we need to check for 0 because Windows will return 0 if this
+ * Note that we need to check for 0 because Windows may return 0 if this
* is not a console mode application, even though this is not a valid
- * handle.
+ * handle.
*/
-
+
if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
return NULL;
}
-
+
channel = Tcl_MakeFileChannel(handle, mode);
+ if (channel == NULL) {
+ return NULL;
+ }
+
/*
* Set up the normal channel options for stdio handles.
*/
@@ -1183,3 +1041,73 @@ TclGetDefaultStdChannel(type)
}
return channel;
}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinOpenFileChannel --
+ *
+ * Constructs a File channel for the specified standard OS handle.
+ * This is a helper function to break up the construction of
+ * channels into File, Console, or Serial.
+ *
+ * Results:
+ * Returns the new channel, or NULL.
+ *
+ * Side effects:
+ * May open the channel and may cause creation of a file on the
+ * file system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
+ HANDLE handle;
+ char *channelName;
+ int permissions;
+ int appendMode;
+{
+ FileInfo *infoPtr;
+ ThreadSpecificData *tsdPtr;
+
+ tsdPtr = FileInit();
+
+ /*
+ * See if a channel with this handle already exists.
+ */
+
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->handle == (HANDLE) handle) {
+ return (permissions == infoPtr->validMask) ? infoPtr->channel : NULL;
+ }
+ }
+
+ infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
+ infoPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = infoPtr;
+ infoPtr->validMask = permissions;
+ infoPtr->watchMask = 0;
+ infoPtr->flags = appendMode;
+ infoPtr->handle = handle;
+
+ wsprintfA(channelName, "file%lx", (int) infoPtr);
+
+ infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
+ (ClientData) infoPtr, permissions);
+
+ /*
+ * Files have default translation of AUTO and ^Z eof char, which
+ * means that a ^Z will be accepted as EOF when reading.
+ */
+
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+
+ return infoPtr->channel;
+}
+
+
diff --git a/tcl/win/tclWinConsole.c b/tcl/win/tclWinConsole.c
new file mode 100644
index 00000000000..4e38631a54f
--- /dev/null
+++ b/tcl/win/tclWinConsole.c
@@ -0,0 +1,1269 @@
+/*
+ * tclWinConsole.c --
+ *
+ * This file implements the Windows-specific console functions,
+ * and the "console" channel driver.
+ *
+ * Copyright (c) 1999 by Scriptics Corp.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+
+#include <fcntl.h>
+#include <io.h>
+#include <sys/stat.h>
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * The consoleMutex locks around access to the initialized variable, and it is
+ * used to protect background threads from being terminated while they are
+ * using APIs that hold locks.
+ */
+
+TCL_DECLARE_MUTEX(consoleMutex)
+
+/*
+ * Bit masks used in the flags field of the ConsoleInfo structure below.
+ */
+
+#define CONSOLE_PENDING (1<<0) /* Message is pending in the queue. */
+#define CONSOLE_ASYNC (1<<1) /* Channel is non-blocking. */
+
+/*
+ * Bit masks used in the sharedFlags field of the ConsoleInfo structure below.
+ */
+
+#define CONSOLE_EOF (1<<2) /* Console has reached EOF. */
+#define CONSOLE_BUFFERED (1<<3) /* data was read into a buffer by the reader
+ thread */
+
+#define CONSOLE_BUFFER_SIZE (8*1024)
+/*
+ * This structure describes per-instance data for a console based channel.
+ */
+
+typedef struct ConsoleInfo {
+ HANDLE handle;
+ int type;
+ struct ConsoleInfo *nextPtr;/* Pointer to next registered console. */
+ Tcl_Channel channel; /* Pointer to channel structure. */
+ int validMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which operations are valid on the file. */
+ int watchMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which events should be reported. */
+ int flags; /* State flags, see above for a list. */
+ Tcl_ThreadId threadId; /* Thread to which events should be reported.
+ * This value is used by the reader/writer
+ * threads. */
+ HANDLE writeThread; /* Handle to writer thread. */
+ HANDLE readThread; /* Handle to reader thread. */
+ HANDLE writable; /* Manual-reset event to signal when the
+ * writer thread has finished waiting for
+ * the current buffer to be written. */
+ HANDLE readable; /* Manual-reset event to signal when the
+ * reader thread has finished waiting for
+ * input. */
+ HANDLE startWriter; /* Auto-reset event used by the main thread to
+ * signal when the writer thread should attempt
+ * to write to the console. */
+ HANDLE startReader; /* Auto-reset event used by the main thread to
+ * signal when the reader thread should attempt
+ * to read from the console. */
+ DWORD writeError; /* An error caused by the last background
+ * write. Set to 0 if no error has been
+ * detected. This word is shared with the
+ * writer thread so access must be
+ * synchronized with the writable object.
+ */
+ char *writeBuf; /* Current background output buffer.
+ * Access is synchronized with the writable
+ * object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the writable
+ * object. */
+ int toWrite; /* Current amount to be written. Access is
+ * synchronized with the writable object. */
+ int readFlags; /* Flags that are shared with the reader
+ * thread. Access is synchronized with the
+ * readable object. */
+ int bytesRead; /* number of bytes in the buffer */
+ int offset; /* number of bytes read out of the buffer */
+ char buffer[CONSOLE_BUFFER_SIZE];
+ /* Data consumed by reader thread. */
+} ConsoleInfo;
+
+typedef struct ThreadSpecificData {
+ /*
+ * The following pointer refers to the head of the list of consoles
+ * that are being watched for file events.
+ */
+
+ ConsoleInfo *firstConsolePtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * console events are generated.
+ */
+
+typedef struct ConsoleEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ ConsoleInfo *infoPtr; /* Pointer to console info structure. Note
+ * that we still have to verify that the
+ * console exists before dereferencing this
+ * pointer. */
+} ConsoleEvent;
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static int ConsoleBlockModeProc(ClientData instanceData, int mode);
+static void ConsoleCheckProc(ClientData clientData, int flags);
+static int ConsoleCloseProc(ClientData instanceData,
+ Tcl_Interp *interp);
+static int ConsoleEventProc(Tcl_Event *evPtr, int flags);
+static void ConsoleExitHandler(ClientData clientData);
+static int ConsoleGetHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+static ThreadSpecificData *ConsoleInit(void);
+static int ConsoleInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCode);
+static int ConsoleOutputProc(ClientData instanceData, char *buf,
+ int toWrite, int *errorCode);
+static DWORD WINAPI ConsoleReaderThread(LPVOID arg);
+static void ConsoleSetupProc(ClientData clientData, int flags);
+static void ConsoleWatchProc(ClientData instanceData, int mask);
+static DWORD WINAPI ConsoleWriterThread(LPVOID arg);
+static void ProcExitHandler(ClientData clientData);
+static int WaitForRead(ConsoleInfo *infoPtr, int blocking);
+
+/*
+ * This structure describes the channel type structure for command console
+ * based IO.
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ ConsoleCloseProc, /* Close proc. */
+ ConsoleInputProc, /* Input proc. */
+ ConsoleOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ ConsoleWatchProc, /* Set up notifier to watch the channel. */
+ ConsoleGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ ConsoleBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInit --
+ *
+ * This function initializes the static variables for this file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData *
+ConsoleInit()
+{
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Check the initialized flag first, then check again in the mutex.
+ * This is a speed enhancement.
+ */
+
+ if (!initialized) {
+ Tcl_MutexLock(&consoleMutex);
+ if (!initialized) {
+ initialized = 1;
+ Tcl_CreateExitHandler(ProcExitHandler, NULL);
+ }
+ Tcl_MutexUnlock(&consoleMutex);
+ }
+
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstConsolePtr = NULL;
+ Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
+ }
+ return tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleExitHandler --
+ *
+ * This function is called to cleanup the console module before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Removes the console event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleExitHandler(
+ ClientData clientData) /* Old window proc */
+{
+ Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcExitHandler --
+ *
+ * This function is called to cleanup the process list before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resets the process list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcExitHandler(
+ ClientData clientData) /* Old window proc */
+{
+ Tcl_MutexLock(&consoleMutex);
+ initialized = 0;
+ Tcl_MutexUnlock(&consoleMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleSetupProc --
+ *
+ * This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ * for an event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConsoleSetupProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ ConsoleInfo *infoPtr;
+ Tcl_Time blockTime = { 0, 0 };
+ int block = 1;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Look to see if any events are already pending. If they are, poll.
+ */
+
+ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ block = 0;
+ }
+ }
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (WaitForRead(infoPtr, 0) >= 0) {
+ block = 0;
+ }
+ }
+ }
+ if (!block) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCheckProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent to check the console
+ * event source for events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ ConsoleInfo *infoPtr;
+ ConsoleEvent *evPtr;
+ int needEvent;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Queue events for any ready consoles that don't already have events
+ * queued.
+ */
+
+ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->flags & CONSOLE_PENDING) {
+ continue;
+ }
+
+ /*
+ * Queue an event if the console is signaled for reading or writing.
+ */
+
+ needEvent = 0;
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ needEvent = 1;
+ }
+ }
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (WaitForRead(infoPtr, 0) >= 0) {
+ needEvent = 1;
+ }
+ }
+
+ if (needEvent) {
+ infoPtr->flags |= CONSOLE_PENDING;
+ evPtr = (ConsoleEvent *) ckalloc(sizeof(ConsoleEvent));
+ evPtr->header.proc = ConsoleEventProc;
+ evPtr->infoPtr = infoPtr;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ }
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleBlockModeProc --
+ *
+ * Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ * 0 if successful, errno when failed.
+ *
+ * Side effects:
+ * Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleBlockModeProc(
+ ClientData instanceData, /* Instance data for channel. */
+ int mode) /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+
+ /*
+ * Consoles on Windows can not be switched between blocking and nonblocking,
+ * hence we have to emulate the behavior. This is done in the input
+ * function by checking against a bit in the state. We set or unset the
+ * bit here to cause the input function to emulate the correct behavior.
+ */
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ infoPtr->flags |= CONSOLE_ASYNC;
+ } else {
+ infoPtr->flags &= ~(CONSOLE_ASYNC);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCloseProc --
+ *
+ * Closes a console based IO channel.
+ *
+ * Results:
+ * 0 on success, errno otherwise.
+ *
+ * Side effects:
+ * Closes the physical channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCloseProc(
+ ClientData instanceData, /* Pointer to ConsoleInfo structure. */
+ Tcl_Interp *interp) /* For error reporting. */
+{
+ ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData;
+ int errorCode;
+ ConsoleInfo *infoPtr, **nextPtrPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ errorCode = 0;
+
+ /*
+ * Clean up the background thread if necessary. Note that this
+ * must be done before we can close the file, since the
+ * thread may be blocking trying to read from the console.
+ */
+
+ if (consolePtr->readThread) {
+ /*
+ * Forcibly terminate the background thread. We cannot rely on the
+ * thread to cleanly terminate itself because we have no way of
+ * closing the handle without blocking in the case where the
+ * thread is in the middle of an I/O operation. Note that we need
+ * to guard against terminating the thread while it is in the
+ * middle of Tcl_ThreadAlert because it won't be able to release
+ * the notifier lock.
+ */
+
+ Tcl_MutexLock(&consoleMutex);
+ TerminateThread(consolePtr->readThread, 0);
+
+ /*
+ * Wait for the thread to terminate. This ensures that we are
+ * completely cleaned up before we leave this function.
+ */
+
+ WaitForSingleObject(consolePtr->readThread, INFINITE);
+ Tcl_MutexUnlock(&consoleMutex);
+
+ CloseHandle(consolePtr->readThread);
+ CloseHandle(consolePtr->readable);
+ CloseHandle(consolePtr->startReader);
+ consolePtr->readThread = NULL;
+ }
+ consolePtr->validMask &= ~TCL_READABLE;
+
+ /*
+ * Wait for the writer thread to finish the current buffer, then
+ * terminate the thread and close the handles. If the channel is
+ * nonblocking, there should be no pending write operations.
+ */
+
+ if (consolePtr->writeThread) {
+ WaitForSingleObject(consolePtr->writable, INFINITE);
+
+ /*
+ * Forcibly terminate the background thread. We cannot rely on the
+ * thread to cleanly terminate itself because we have no way of
+ * closing the handle without blocking in the case where the
+ * thread is in the middle of an I/O operation. Note that we need
+ * to guard against terminating the thread while it is in the
+ * middle of Tcl_ThreadAlert because it won't be able to release
+ * the notifier lock.
+ */
+
+ Tcl_MutexLock(&consoleMutex);
+ TerminateThread(consolePtr->writeThread, 0);
+
+ /*
+ * Wait for the thread to terminate. This ensures that we are
+ * completely cleaned up before we leave this function.
+ */
+
+ WaitForSingleObject(consolePtr->writeThread, INFINITE);
+ Tcl_MutexUnlock(&consoleMutex);
+
+ CloseHandle(consolePtr->writeThread);
+ CloseHandle(consolePtr->writable);
+ CloseHandle(consolePtr->startWriter);
+ consolePtr->writeThread = NULL;
+ }
+ consolePtr->validMask &= ~TCL_WRITABLE;
+
+
+ /*
+ * Don't close the Win32 handle if the handle is a standard channel
+ * during the exit process. Otherwise, one thread may kill the stdio
+ * of another.
+ */
+
+ if (!TclInExit()
+ || ((GetStdHandle(STD_INPUT_HANDLE) != consolePtr->handle)
+ && (GetStdHandle(STD_OUTPUT_HANDLE) != consolePtr->handle)
+ && (GetStdHandle(STD_ERROR_HANDLE) != consolePtr->handle))) {
+ if (CloseHandle(consolePtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ errorCode = errno;
+ }
+ }
+
+ consolePtr->watchMask &= consolePtr->validMask;
+
+ /*
+ * Remove the file from the list of watched files.
+ */
+
+ for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
+ infoPtr != NULL;
+ nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
+ if (infoPtr == (ConsoleInfo *)consolePtr) {
+ *nextPtrPtr = infoPtr->nextPtr;
+ break;
+ }
+ }
+ if (consolePtr->writeBuf != NULL) {
+ ckfree(consolePtr->writeBuf);
+ consolePtr->writeBuf = 0;
+ }
+ ckfree((char*) consolePtr);
+
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInputProc --
+ *
+ * Reads input from the IO channel into the buffer given. Returns
+ * count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were read is returned and an error
+ * indication is returned in an output argument.
+ *
+ * Side effects:
+ * Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleInputProc(
+ ClientData instanceData, /* Console state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available
+ * in the buffer? */
+ int *errorCode) /* Where to store error code. */
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ DWORD count, bytesRead = 0;
+ int result;
+
+ *errorCode = 0;
+
+ /*
+ * Synchronize with the reader thread.
+ */
+
+ result = WaitForRead(infoPtr, (infoPtr->flags & CONSOLE_ASYNC) ? 0 : 1);
+
+ /*
+ * If an error occurred, return immediately.
+ */
+
+ if (result == -1) {
+ *errorCode = errno;
+ return -1;
+ }
+
+ if (infoPtr->readFlags & CONSOLE_BUFFERED) {
+ /*
+ * Data is stored in the buffer.
+ */
+
+ if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) {
+ memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
+ bytesRead = bufSize;
+ infoPtr->offset += bufSize;
+ } else {
+ memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
+ bytesRead = infoPtr->bytesRead - infoPtr->offset;
+
+ /*
+ * Reset the buffer
+ */
+
+ infoPtr->readFlags &= ~CONSOLE_BUFFERED;
+ infoPtr->offset = 0;
+ }
+
+ return bytesRead;
+ }
+
+ /*
+ * Attempt to read bufSize bytes. The read will return immediately
+ * if there is any data available. Otherwise it will block until
+ * at least one byte is available or an EOF occurs.
+ */
+
+ if (ReadConsole(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
+ (LPOVERLAPPED) NULL) == TRUE) {
+ buf[count] = '\0';
+ return count;
+ }
+
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutputProc --
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleOutputProc(
+ ClientData instanceData, /* Console state. */
+ char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ DWORD bytesWritten, timeout;
+
+ *errorCode = 0;
+ timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE;
+ if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
+ /*
+ * The writer thread is blocked waiting for a write to complete
+ * and the channel is in non-blocking mode.
+ */
+
+ errno = EAGAIN;
+ goto error;
+ }
+
+ /*
+ * Check for a background error on the last write.
+ */
+
+ if (infoPtr->writeError) {
+ TclWinConvertError(infoPtr->writeError);
+ infoPtr->writeError = 0;
+ goto error;
+ }
+
+ if (infoPtr->flags & CONSOLE_ASYNC) {
+ /*
+ * The console is non-blocking, so copy the data into the output
+ * buffer and restart the writer thread.
+ */
+
+ if (toWrite > infoPtr->writeBufLen) {
+ /*
+ * Reallocate the buffer to be large enough to hold the data.
+ */
+
+ if (infoPtr->writeBuf) {
+ ckfree(infoPtr->writeBuf);
+ }
+ infoPtr->writeBufLen = toWrite;
+ infoPtr->writeBuf = ckalloc(toWrite);
+ }
+ memcpy(infoPtr->writeBuf, buf, toWrite);
+ infoPtr->toWrite = toWrite;
+ ResetEvent(infoPtr->writable);
+ SetEvent(infoPtr->startWriter);
+ bytesWritten = toWrite;
+ } else {
+ /*
+ * In the blocking case, just try to write the buffer directly.
+ * This avoids an unnecessary copy.
+ */
+
+ if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
+ TclWinConvertError(GetLastError());
+ goto error;
+ }
+ }
+ return bytesWritten;
+
+ error:
+ *errorCode = errno;
+ return -1;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This function is invoked by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure invokes
+ * Tcl_NotifyChannel on the console.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+{
+ ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr;
+ ConsoleInfo *infoPtr;
+ int mask;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /*
+ * Search through the list of watched consoles for the one whose handle
+ * matches the event. We do this rather than simply dereferencing
+ * the handle in the event so that consoles can be deleted while the
+ * event is in the queue.
+ */
+
+ for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (consoleEvPtr->infoPtr == infoPtr) {
+ infoPtr->flags &= ~(CONSOLE_PENDING);
+ break;
+ }
+ }
+
+ /*
+ * Remove stale events.
+ */
+
+ if (!infoPtr) {
+ return 1;
+ }
+
+ /*
+ * Check to see if the console is readable. Note
+ * that we can't tell if a console is writable, so we always report it
+ * as being writable unless we have detected EOF.
+ */
+
+ mask = 0;
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ mask = TCL_WRITABLE;
+ }
+ }
+
+ if (infoPtr->watchMask & TCL_READABLE) {
+ if (WaitForRead(infoPtr, 0) >= 0) {
+ if (infoPtr->readFlags & CONSOLE_EOF) {
+ mask = TCL_READABLE;
+ } else {
+ mask |= TCL_READABLE;
+ }
+ }
+ }
+
+ /*
+ * Inform the channel of the events.
+ */
+
+ Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatchProc --
+ *
+ * Called by the notifier to set up to watch for events on this
+ * channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleWatchProc(
+ ClientData instanceData, /* Console state. */
+ int mask) /* What events to watch for, OR-ed
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+ ConsoleInfo **nextPtrPtr, *ptr;
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+ int oldMask = infoPtr->watchMask;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Since most of the work is handled by the background threads,
+ * we just need to update the watchMask and then force the notifier
+ * to poll once.
+ */
+
+ infoPtr->watchMask = mask & infoPtr->validMask;
+ if (infoPtr->watchMask) {
+ Tcl_Time blockTime = { 0, 0 };
+ if (!oldMask) {
+ infoPtr->nextPtr = tsdPtr->firstConsolePtr;
+ tsdPtr->firstConsolePtr = infoPtr;
+ }
+ Tcl_SetMaxBlockTime(&blockTime);
+ } else {
+ if (oldMask) {
+ /*
+ * Remove the console from the list of watched consoles.
+ */
+
+ for (nextPtrPtr = &(tsdPtr->firstConsolePtr), ptr = *nextPtrPtr;
+ ptr != NULL;
+ nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+ if (infoPtr == ptr) {
+ *nextPtrPtr = ptr->nextPtr;
+ break;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleGetHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from
+ * inside a command consoleline based channel.
+ *
+ * Results:
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
+ * there is no handle for the specified direction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleGetHandleProc(
+ ClientData instanceData, /* The console state. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr) /* Where to store the handle. */
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
+
+ *handlePtr = (ClientData) infoPtr->handle;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForRead --
+ *
+ * Wait until some data is available, the console is at
+ * EOF or the reader thread is blocked waiting for data (if the
+ * channel is in non-blocking mode).
+ *
+ * Results:
+ * Returns 1 if console is readable. Returns 0 if there is no data
+ * on the console, but there is buffered data. Returns -1 if an
+ * error occurred. If an error occurred, the threads may not
+ * be synchronized.
+ *
+ * Side effects:
+ * Updates the shared state flags. If no error occurred,
+ * the reader thread is blocked waiting for a signal from the
+ * main thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForRead(
+ ConsoleInfo *infoPtr, /* Console state. */
+ int blocking) /* Indicates whether call should be
+ * blocking or not. */
+{
+ DWORD timeout, count;
+ HANDLE *handle = infoPtr->handle;
+ INPUT_RECORD input;
+
+ while (1) {
+ /*
+ * Synchronize with the reader thread.
+ */
+
+ timeout = blocking ? INFINITE : 0;
+ if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
+ /*
+ * The reader thread is blocked waiting for data and the channel
+ * is in non-blocking mode.
+ */
+ errno = EAGAIN;
+ return -1;
+ }
+
+ /*
+ * At this point, the two threads are synchronized, so it is safe
+ * to access shared state.
+ */
+
+ /*
+ * If the console has hit EOF, it is always readable.
+ */
+
+ if (infoPtr->readFlags & CONSOLE_EOF) {
+ return 1;
+ }
+
+ if (PeekConsoleInput(handle, &input, 1, &count) == FALSE) {
+ /*
+ * Check to see if the peek failed because of EOF.
+ */
+
+ TclWinConvertError(GetLastError());
+
+ if (errno == EOF) {
+ infoPtr->readFlags |= CONSOLE_EOF;
+ return 1;
+ }
+
+ /*
+ * Ignore errors if there is data in the buffer.
+ */
+
+ if (infoPtr->readFlags & CONSOLE_BUFFERED) {
+ return 0;
+ } else {
+ return -1;
+ }
+ }
+
+ /*
+ * If there is data in the buffer, the console must be
+ * readable (since it is a line-oriented device).
+ */
+
+ if (infoPtr->readFlags & CONSOLE_BUFFERED) {
+ return 1;
+ }
+
+
+ /*
+ * There wasn't any data available, so reset the thread and
+ * try again.
+ */
+
+ ResetEvent(infoPtr->readable);
+ SetEvent(infoPtr->startReader);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleReaderThread --
+ *
+ * This function runs in a separate thread and waits for input
+ * to become available on a console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Signals the main thread when input become available. May
+ * cause the main thread to wake up by posting a message. May
+ * one line from the console for each wait operation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+ConsoleReaderThread(LPVOID arg)
+{
+ ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
+ HANDLE *handle = infoPtr->handle;
+ DWORD count;
+
+ for (;;) {
+ /*
+ * Wait for the main thread to signal before attempting to wait.
+ */
+
+ WaitForSingleObject(infoPtr->startReader, INFINITE);
+
+ count = 0;
+
+ /*
+ * Look for data on the console, but first ignore any events
+ * that are not KEY_EVENTs
+ */
+ if (ReadConsole(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
+ &infoPtr->bytesRead, NULL) != FALSE) {
+ /*
+ * Data was stored in the buffer.
+ */
+
+ infoPtr->readFlags |= CONSOLE_BUFFERED;
+ } else {
+ DWORD err;
+ err = GetLastError();
+
+ if (err == EOF) {
+ infoPtr->readFlags = CONSOLE_EOF;
+ }
+ }
+
+ /*
+ * Signal the main thread by signalling the readable event and
+ * then waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->readable);
+
+ /*
+ * Alert the foreground thread. Note that we need to treat this like
+ * a critical section so the foreground thread does not terminate
+ * this thread while we are holding a mutex in the notifier code.
+ */
+
+ Tcl_MutexLock(&consoleMutex);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ Tcl_MutexUnlock(&consoleMutex);
+ }
+ return 0; /* NOT REACHED */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWriterThread --
+ *
+ * This function runs in a separate thread and writes data
+ * onto a console.
+ *
+ * Results:
+ * Always returns 0.
+ *
+ * Side effects:
+ * Signals the main thread when an output operation is completed.
+ * May cause the main thread to wake up by posting a message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+ConsoleWriterThread(LPVOID arg)
+{
+
+ ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
+ HANDLE *handle = infoPtr->handle;
+ DWORD count, toWrite;
+ char *buf;
+
+ for (;;) {
+ /*
+ * Wait for the main thread to signal before attempting to write.
+ */
+
+ WaitForSingleObject(infoPtr->startWriter, INFINITE);
+
+ buf = infoPtr->writeBuf;
+ toWrite = infoPtr->toWrite;
+
+ /*
+ * Loop until all of the bytes are written or an error occurs.
+ */
+
+ while (toWrite > 0) {
+ if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) {
+ infoPtr->writeError = GetLastError();
+ break;
+ } else {
+ toWrite -= count;
+ buf += count;
+ }
+ }
+
+ /*
+ * Signal the main thread by signalling the writable event and
+ * then waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->writable);
+
+ /*
+ * Alert the foreground thread. Note that we need to treat this like
+ * a critical section so the foreground thread does not terminate
+ * this thread while we are holding a mutex in the notifier code.
+ */
+
+ Tcl_MutexLock(&consoleMutex);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ Tcl_MutexUnlock(&consoleMutex);
+ }
+ return 0; /* NOT REACHED */
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinOpenConsoleChannel --
+ *
+ * Constructs a Console channel for the specified standard OS handle.
+ * This is a helper function to break up the construction of
+ * channels into File, Console, or Serial.
+ *
+ * Results:
+ * Returns the new channel, or NULL.
+ *
+ * Side effects:
+ * May open the channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclWinOpenConsoleChannel(handle, channelName, permissions)
+ HANDLE handle;
+ char *channelName;
+ int permissions;
+{
+ char encoding[4 + TCL_INTEGER_SPACE];
+ ConsoleInfo *infoPtr;
+ ThreadSpecificData *tsdPtr;
+ DWORD id;
+
+ tsdPtr = ConsoleInit();
+
+ /*
+ * See if a channel with this handle already exists.
+ */
+
+ infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
+ memset(infoPtr, 0, sizeof(ConsoleInfo));
+
+ infoPtr->validMask = permissions;
+ infoPtr->handle = handle;
+
+ wsprintfA(encoding, "cp%d", GetConsoleCP());
+
+ /*
+ * Use the pointer for the name of the result channel.
+ * This keeps the channel names unique, since some may share
+ * handles (stdin/stdout/stderr for instance).
+ */
+
+ wsprintfA(channelName, "file%lx", (int) infoPtr);
+
+ infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
+ (ClientData) infoPtr, permissions);
+
+ infoPtr->threadId = Tcl_GetCurrentThread();
+
+ if (permissions & TCL_READABLE) {
+ infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->readThread = CreateThread(NULL, 8000, ConsoleReaderThread,
+ infoPtr, 0, &id);
+ SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
+ }
+
+ if (permissions & TCL_WRITABLE) {
+ infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->writeThread = CreateThread(NULL, 8000, ConsoleWriterThread,
+ infoPtr, 0, &id);
+ }
+
+ /*
+ * Files have default translation of AUTO and ^Z eof char, which
+ * means that a ^Z will be accepted as EOF when reading.
+ */
+
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
+
+ return infoPtr->channel;
+}
+
diff --git a/tcl/win/tclWinDde.c b/tcl/win/tclWinDde.c
new file mode 100644
index 00000000000..c540f8026ac
--- /dev/null
+++ b/tcl/win/tclWinDde.c
@@ -0,0 +1,1351 @@
+/*
+ * tclWinDde.c --
+ *
+ * This file provides procedures that implement the "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter.
+ *
+ * Copyright (c) 1997 by Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclPort.h"
+#include <ddeml.h>
+
+/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Registry_Init declaration is in the source file itself, which is only
+ * accessed when we are building a library.
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+/*
+ * The following structure is used to keep track of the interpreters
+ * registered by this process.
+ */
+
+typedef struct RegisteredInterp {
+ struct RegisteredInterp *nextPtr;
+ /* The next interp this application knows
+ * about. */
+ char *name; /* Interpreter's name (malloc-ed). */
+ Tcl_Interp *interp; /* The interpreter attached to this name. */
+} RegisteredInterp;
+
+/*
+ * Used to keep track of conversations.
+ */
+
+typedef struct Conversation {
+ struct Conversation *nextPtr;
+ /* The next conversation in the list. */
+ RegisteredInterp *riPtr; /* The info we know about the conversation. */
+ HCONV hConv; /* The DDE handle for this conversation. */
+ Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
+} Conversation;
+
+typedef struct ThreadSpecificData {
+ Conversation *currentConversations;
+ /* A list of conversations currently
+ * being processed. */
+ RegisteredInterp *interpListPtr;
+ /* List of all interpreters registered
+ * in the current process. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following variables cannot be placed in thread-local storage.
+ * The Mutex ddeMutex guards access to the ddeInstance.
+ */
+static HSZ ddeServiceGlobal = 0;
+static DWORD ddeInstance; /* The application instance handle given
+ * to us by DdeInitialize. */
+static int ddeIsServer = 0;
+
+#define TCL_DDE_VERSION "1.1"
+#define TCL_DDE_PACKAGE_NAME "dde"
+#define TCL_DDE_SERVICE_NAME "TclEval"
+
+TCL_DECLARE_MUTEX(ddeMutex)
+
+/*
+ * Forward declarations for procedures defined later in this file.
+ */
+
+static void DdeExitProc _ANSI_ARGS_((ClientData clientData));
+static void DeleteProc _ANSI_ARGS_((ClientData clientData));
+static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_((
+ RegisteredInterp *riPtr,
+ Tcl_Obj *ddeObjectPtr));
+static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, HCONV *ddeConvPtr));
+static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType,
+ UINT uFmt, HCONV hConv, HSZ ddeTopic,
+ HSZ ddeItem, HDDEDATA hData, DWORD dwData1,
+ DWORD dwData2));
+static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
+int Tcl_DdeObjCmd(ClientData clientData, /* Used only for deletion */
+ Tcl_Interp *interp, /* The interp we are sending from */
+ int objc, /* Number of arguments */
+ Tcl_Obj *CONST objv[]); /* The arguments */
+
+EXTERN int Dde_Init(Tcl_Interp *interp);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Dde_Init --
+ *
+ * This procedure initializes the dde command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Dde_Init(
+ Tcl_Interp *interp)
+{
+ ThreadSpecificData *tsdPtr;
+
+ if (!Tcl_InitStubs(interp, "8.0", 0)) {
+ return TCL_ERROR;
+ }
+
+ Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);
+
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData((Tcl_ThreadDataKey *) &dataKey, sizeof(ThreadSpecificData));
+
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->currentConversations = NULL;
+ tsdPtr->interpListPtr = NULL;
+ }
+ Tcl_CreateExitHandler(DdeExitProc, NULL);
+
+ return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Initialize --
+ *
+ * Initialize the global DDE instance.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Registers the DDE server proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Initialize(void)
+{
+ int nameFound = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * See if the application is already registered; if so, remove its
+ * current name from the registry. The deletion of the command
+ * will take care of disposing of this entry.
+ */
+
+ if (tsdPtr->interpListPtr != NULL) {
+ nameFound = 1;
+ }
+
+ /*
+ * Make sure that the DDE server is there. This is done only once,
+ * add an exit handler tear it down.
+ */
+
+ if (ddeInstance == 0) {
+ Tcl_MutexLock(&ddeMutex);
+ if (ddeInstance == 0) {
+ if (DdeInitialize(&ddeInstance, DdeServerProc,
+ CBF_SKIP_REGISTRATIONS
+ | CBF_SKIP_UNREGISTRATIONS
+ | CBF_FAIL_POKES, 0)
+ != DMLERR_NO_ERROR) {
+ ddeInstance = 0;
+ }
+ }
+ Tcl_MutexUnlock(&ddeMutex);
+ }
+ if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
+ Tcl_MutexLock(&ddeMutex);
+ if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
+ ddeIsServer = 1;
+ Tcl_CreateExitHandler(DdeExitProc, NULL);
+ ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \
+ TCL_DDE_SERVICE_NAME, 0);
+ DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
+ } else {
+ ddeIsServer = 0;
+ }
+ Tcl_MutexUnlock(&ddeMutex);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DdeSetServerName --
+ *
+ * This procedure is called to associate an ASCII name with a Dde
+ * server. If the interpreter has already been named, the
+ * name replaces the old one.
+ *
+ * Results:
+ * The return value is the name actually given to the interp.
+ * This will normally be the same as name, but if name was already
+ * in use for a Dde Server then a name of the form "name #2" will
+ * be chosen, with a high enough number to make the name unique.
+ *
+ * Side effects:
+ * Registration info is saved, thereby allowing the "send" command
+ * to be used later to invoke commands in the application. In
+ * addition, the "send" command is created in the application's
+ * interpreter. The registration will be removed automatically
+ * if the interpreter is deleted or the "send" command is removed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+DdeSetServerName(
+ Tcl_Interp *interp,
+ char *name /* The name that will be used to
+ * refer to the interpreter in later
+ * "send" commands. Must be globally
+ * unique. */
+ )
+{
+ int suffix, offset;
+ RegisteredInterp *riPtr, *prevPtr;
+ Tcl_DString dString;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * See if the application is already registered; if so, remove its
+ * current name from the registry. The deletion of the command
+ * will take care of disposing of this entry.
+ */
+
+ for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
+ prevPtr = riPtr, riPtr = riPtr->nextPtr) {
+ if (riPtr->interp == interp) {
+ if (name != NULL) {
+ if (prevPtr == NULL) {
+ tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = riPtr->nextPtr;
+ }
+ break;
+ } else {
+ /*
+ * the name was NULL, so the caller is asking for
+ * the name of the current interp.
+ */
+
+ return riPtr->name;
+ }
+ }
+ }
+
+ if (name == NULL) {
+ /*
+ * the name was NULL, so the caller is asking for
+ * the name of the current interp, but it doesn't
+ * have a name.
+ */
+
+ return "";
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * larger and larger numbers until we eventually find one that is
+ * unique.
+ */
+
+ suffix = 1;
+ offset = 0;
+ Tcl_DStringInit(&dString);
+
+ /*
+ * We have found a unique name. Now add it to the registry.
+ */
+
+ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr->interp = interp;
+ riPtr->name = ckalloc(strlen(name) + 1);
+ riPtr->nextPtr = tsdPtr->interpListPtr;
+ tsdPtr->interpListPtr = riPtr;
+ strcpy(riPtr->name, name);
+
+ Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
+ (ClientData) riPtr, DeleteProc);
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "dde", "dde");
+ }
+ Tcl_DStringFree(&dString);
+
+ /*
+ * re-initialize with the new name
+ */
+ Initialize();
+
+ return riPtr->name;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteProc
+ *
+ * This procedure is called when the command "dde" is destroyed.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * The interpreter given by riPtr is unregistered.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteProc(clientData)
+ ClientData clientData; /* The interp we are deleting passed
+ * as ClientData. */
+{
+ RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
+ RegisteredInterp *searchPtr, *prevPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
+ (searchPtr != NULL) && (searchPtr != riPtr);
+ prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+ }
+
+ if (searchPtr != NULL) {
+ if (prevPtr == NULL) {
+ tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = searchPtr->nextPtr;
+ }
+ }
+ ckfree(riPtr->name);
+ Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExecuteRemoteObject --
+ *
+ * Takes the package delivered by DDE and executes it in
+ * the server's interpreter.
+ *
+ * Results:
+ * A list Tcl_Obj * that describes what happened. The first
+ * element is the numerical return code (TCL_ERROR, etc.).
+ * The second element is the result of the script. If the
+ * return result was TCL_ERROR, then the third element
+ * will be the value of the global "errorCode", and the
+ * fourth will be the value of the global "errorInfo".
+ * The return result will have a refCount of 0.
+ *
+ * Side effects:
+ * A Tcl script is run, which can cause all kinds of other
+ * things to happen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ExecuteRemoteObject(
+ RegisteredInterp *riPtr, /* Info about this server. */
+ Tcl_Obj *ddeObjectPtr) /* The object to execute. */
+{
+ Tcl_Obj *errorObjPtr;
+ Tcl_Obj *returnPackagePtr;
+ int result;
+
+ result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
+ returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr,
+ Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr,
+ Tcl_GetObjResult(riPtr->interp));
+ if (result == TCL_ERROR) {
+ errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+ errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+ }
+
+ return returnPackagePtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DdeServerProc --
+ *
+ * Handles all transactions for this server. Can handle
+ * execute, request, and connect protocols. Dde will
+ * call this routine when a client attempts to run a dde
+ * command using this server.
+ *
+ * Results:
+ * A DDE Handle with the result of the dde command.
+ *
+ * Side effects:
+ * Depending on which command is executed, arbitrary
+ * Tcl scripts can be run.
+ *
+ *--------------------------------------------------------------
+ */
+
+static HDDEDATA CALLBACK
+DdeServerProc (
+ UINT uType, /* The type of DDE transaction we
+ * are performing. */
+ UINT uFmt, /* The format that data is sent or
+ * received. */
+ HCONV hConv, /* The conversation associated with the
+ * current transaction. */
+ HSZ ddeTopic, /* A string handle. Transaction-type
+ * dependent. */
+ HSZ ddeItem, /* A string handle. Transaction-type
+ * dependent. */
+ HDDEDATA hData, /* DDE data. Transaction-type dependent. */
+ DWORD dwData1, /* Transaction-dependent data. */
+ DWORD dwData2) /* Transaction-dependent data. */
+{
+ Tcl_DString dString;
+ int len;
+ char *utilString;
+ Tcl_Obj *ddeObjectPtr;
+ HDDEDATA ddeReturn = NULL;
+ RegisteredInterp *riPtr;
+ Conversation *convPtr, *prevConvPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ switch(uType) {
+ case XTYP_CONNECT:
+
+ /*
+ * Dde is trying to initialize a conversation with us. Check
+ * and make sure we have a valid topic.
+ */
+
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
+ CP_WINANSI);
+
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if (stricmp(utilString, riPtr->name) == 0) {
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) TRUE;
+ }
+ }
+
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) FALSE;
+
+ case XTYP_CONNECT_CONFIRM:
+
+ /*
+ * Dde has decided that we can connect, so it gives us a
+ * conversation handle. We need to keep track of it
+ * so we know which execution result to return in an
+ * XTYP_REQUEST.
+ */
+
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
+ CP_WINANSI);
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if (stricmp(riPtr->name, utilString) == 0) {
+ convPtr = (Conversation *) ckalloc(sizeof(Conversation));
+ convPtr->nextPtr = tsdPtr->currentConversations;
+ convPtr->returnPackagePtr = NULL;
+ convPtr->hConv = hConv;
+ convPtr->riPtr = riPtr;
+ tsdPtr->currentConversations = convPtr;
+ break;
+ }
+ }
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) TRUE;
+
+ case XTYP_DISCONNECT:
+
+ /*
+ * The client has disconnected from our server. Forget this
+ * conversation.
+ */
+
+ for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
+ convPtr != NULL;
+ prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
+ if (hConv == convPtr->hConv) {
+ if (prevConvPtr == NULL) {
+ tsdPtr->currentConversations = convPtr->nextPtr;
+ } else {
+ prevConvPtr->nextPtr = convPtr->nextPtr;
+ }
+ if (convPtr->returnPackagePtr != NULL) {
+ Tcl_DecrRefCount(convPtr->returnPackagePtr);
+ }
+ ckfree((char *) convPtr);
+ break;
+ }
+ }
+ return (HDDEDATA) TRUE;
+
+ case XTYP_REQUEST:
+
+ /*
+ * This could be either a request for a value of a Tcl variable,
+ * or it could be the send command requesting the results of the
+ * last execute.
+ */
+
+ if (uFmt != CF_TEXT) {
+ return (HDDEDATA) FALSE;
+ }
+
+ ddeReturn = (HDDEDATA) FALSE;
+ for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+ }
+
+ if (convPtr != NULL) {
+ char *returnString;
+
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,
+ CP_WINANSI);
+ Tcl_DStringInit(&dString);
+ Tcl_DStringSetLength(&dString, len);
+ utilString = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeItem, utilString,
+ len + 1, CP_WINANSI);
+ if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
+ returnString =
+ Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
+ ddeReturn = DdeCreateDataHandle(ddeInstance,
+ returnString, len+1, 0, ddeItem, CF_TEXT,
+ 0);
+ } else {
+ Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
+ convPtr->riPtr->interp, utilString, NULL,
+ TCL_GLOBAL_ONLY);
+ if (variableObjPtr != NULL) {
+ returnString = Tcl_GetStringFromObj(variableObjPtr,
+ &len);
+ ddeReturn = DdeCreateDataHandle(ddeInstance,
+ returnString, len+1, 0, ddeItem, CF_TEXT, 0);
+ } else {
+ ddeReturn = NULL;
+ }
+ }
+ Tcl_DStringFree(&dString);
+ }
+ return ddeReturn;
+
+ case XTYP_EXECUTE: {
+
+ /*
+ * Execute this script. The results will be saved into
+ * a list object which will be retreived later. See
+ * ExecuteRemoteObject.
+ */
+
+ Tcl_Obj *returnPackagePtr;
+
+ for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ if (convPtr == NULL) {
+ return (HDDEDATA) DDE_FNOTPROCESSED;
+ }
+
+ utilString = (char *) DdeAccessData(hData, &len);
+ ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
+ Tcl_IncrRefCount(ddeObjectPtr);
+ DdeUnaccessData(hData);
+ if (convPtr->returnPackagePtr != NULL) {
+ Tcl_DecrRefCount(convPtr->returnPackagePtr);
+ }
+ convPtr->returnPackagePtr = NULL;
+ returnPackagePtr =
+ ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
+ for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+ if (convPtr != NULL) {
+ Tcl_IncrRefCount(returnPackagePtr);
+ convPtr->returnPackagePtr = returnPackagePtr;
+ }
+ Tcl_DecrRefCount(ddeObjectPtr);
+ if (returnPackagePtr == NULL) {
+ return (HDDEDATA) DDE_FNOTPROCESSED;
+ } else {
+ return (HDDEDATA) DDE_FACK;
+ }
+ }
+
+ case XTYP_WILDCONNECT: {
+
+ /*
+ * Dde wants a list of services and topics that we support.
+ */
+
+ HSZPAIR *returnPtr;
+ int i;
+ int numItems;
+
+ for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ i++, riPtr = riPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ numItems = i;
+ ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
+ (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
+ returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &len);
+ for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
+ i++, riPtr = riPtr->nextPtr) {
+ returnPtr[i].hszSvc = DdeCreateStringHandle(
+ ddeInstance, "TclEval", CP_WINANSI);
+ returnPtr[i].hszTopic = DdeCreateStringHandle(
+ ddeInstance, riPtr->name, CP_WINANSI);
+ }
+ returnPtr[i].hszSvc = NULL;
+ returnPtr[i].hszTopic = NULL;
+ DdeUnaccessData(ddeReturn);
+ return ddeReturn;
+ }
+
+ }
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DdeExitProc --
+ *
+ * Gets rid of our DDE server when we go away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The DDE server is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DdeExitProc(
+ ClientData clientData) /* Not used in this handler. */
+{
+ DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
+ DdeUninitialize(ddeInstance);
+ ddeInstance = 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MakeDdeConnection --
+ *
+ * This procedure is a utility used to connect to a DDE
+ * server when given a server name and a topic name.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ *
+ * Side effects:
+ * Passes back a conversation through ddeConvPtr
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MakeDdeConnection(
+ Tcl_Interp *interp, /* Used to report errors. */
+ char *name, /* The connection to use. */
+ HCONV *ddeConvPtr)
+{
+ HSZ ddeTopic, ddeService;
+ HCONV ddeConv;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
+
+ ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
+
+ if (ddeConv == (HCONV) NULL) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "no registered server named \"",
+ name, "\"", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *ddeConvPtr = ddeConv;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetDdeError --
+ *
+ * Sets the interp result to a cogent error message
+ * describing the last DDE error.
+ *
+ * Results:
+ * None.
+ *
+ *
+ * Side effects:
+ * The interp's result object is changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SetDdeError(
+ Tcl_Interp *interp) /* The interp to put the message in.*/
+{
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ int err;
+
+ err = DdeGetLastError(ddeInstance);
+ switch (err) {
+ case DMLERR_DATAACKTIMEOUT:
+ case DMLERR_EXECACKTIMEOUT:
+ case DMLERR_POKEACKTIMEOUT:
+ Tcl_SetStringObj(resultPtr,
+ "remote interpreter did not respond", -1);
+ break;
+
+ case DMLERR_BUSY:
+ Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
+ break;
+
+ case DMLERR_NOTPROCESSED:
+ Tcl_SetStringObj(resultPtr,
+ "remote server cannot handle this command", -1);
+ break;
+
+ default:
+ Tcl_SetStringObj(resultPtr, "dde command failed", -1);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_DdeObjCmd --
+ *
+ * This procedure is invoked to process the "dde" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_DdeObjCmd(
+ ClientData clientData, /* Used only for deletion */
+ Tcl_Interp *interp, /* The interp we are sending from */
+ int objc, /* Number of arguments */
+ Tcl_Obj *CONST objv[]) /* The arguments */
+{
+ enum {
+ DDE_SERVERNAME,
+ DDE_EXECUTE,
+ DDE_POKE,
+ DDE_REQUEST,
+ DDE_SERVICES,
+ DDE_EVAL
+ };
+
+ static char *ddeCommands[] = {"servername", "execute", "poke",
+ "request", "services", "eval",
+ (char *) NULL};
+ static char *ddeOptions[] = {"-async", (char *) NULL};
+ int index, argIndex;
+ int async = 0;
+ int result = TCL_OK;
+ HSZ ddeService = NULL;
+ HSZ ddeTopic = NULL;
+ HSZ ddeItem = NULL;
+ HDDEDATA ddeData = NULL;
+ HDDEDATA ddeItemData = NULL;
+ HCONV hConv = NULL;
+ HSZ ddeCookie = 0;
+ char *serviceName, *topicName, *itemString, *dataString;
+ char *string;
+ int firstArg, length, dataLength;
+ DWORD ddeResult;
+ HDDEDATA ddeReturn;
+ RegisteredInterp *riPtr;
+ Tcl_Interp *sendInterp;
+ Tcl_Obj *objPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Initialize DDE server/client
+ */
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case DDE_SERVERNAME:
+ if ((objc != 3) && (objc != 2)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "servername ?serverName?");
+ return TCL_ERROR;
+ }
+ firstArg = (objc - 1);
+ break;
+ case DDE_EXECUTE:
+ if ((objc < 5) || (objc > 6)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
+ &argIndex) != TCL_OK) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ async = 0;
+ firstArg = 2;
+ } else {
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ async = 1;
+ firstArg = 3;
+ }
+ break;
+ case DDE_POKE:
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "poke serviceName topicName item value");
+ return TCL_ERROR;
+ }
+ firstArg = 2;
+ break;
+ case DDE_REQUEST:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "request serviceName topicName value");
+ return TCL_ERROR;
+ }
+ firstArg = 2;
+ break;
+ case DDE_SERVICES:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "services serviceName topicName");
+ return TCL_ERROR;
+ }
+ firstArg = 2;
+ break;
+ case DDE_EVAL:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "eval ?-async? serviceName args");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
+ &argIndex) != TCL_OK) {
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "eval ?-async? serviceName args");
+ return TCL_ERROR;
+ }
+ async = 0;
+ firstArg = 2;
+ } else {
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "eval ?-async? serviceName args");
+ return TCL_ERROR;
+ }
+ async = 1;
+ firstArg = 3;
+ }
+ break;
+ }
+
+ Initialize();
+
+ if (firstArg != 1) {
+ serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
+ } else {
+ length = 0;
+ }
+
+ if (length == 0) {
+ serviceName = NULL;
+ } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
+ ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
+ CP_WINANSI);
+ }
+
+ if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
+ topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
+ if (length == 0) {
+ topicName = NULL;
+ } else {
+ ddeTopic = DdeCreateStringHandle(ddeInstance,
+ topicName, CP_WINANSI);
+ }
+ }
+
+ switch (index) {
+ case DDE_SERVERNAME: {
+ serviceName = DdeSetServerName(interp, serviceName);
+ if (serviceName != NULL) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ serviceName, -1);
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ break;
+ }
+ case DDE_EXECUTE: {
+ dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
+ if (dataLength == 0) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "cannot execute null data", -1);
+ result = TCL_ERROR;
+ break;
+ }
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic,
+ NULL);
+ DdeFreeStringHandle (ddeInstance, ddeService) ;
+ DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ break;
+ }
+
+ ddeData = DdeCreateDataHandle(ddeInstance, dataString,
+ dataLength+1, 0, 0, CF_TEXT, 0);
+ if (ddeData != NULL) {
+ if (async) {
+ DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ DdeAbandonTransaction(ddeInstance, hConv,
+ ddeResult);
+ } else {
+ ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
+ hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+ if (ddeReturn == 0) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ }
+ DdeFreeDataHandle(ddeData);
+ } else {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ break;
+ }
+ case DDE_REQUEST: {
+ itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ if (length == 0) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "cannot request value of null data", -1);
+ return TCL_ERROR;
+ }
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle (ddeInstance, ddeService) ;
+ DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ } else {
+ Tcl_Obj *returnObjPtr;
+ ddeItem = DdeCreateStringHandle(ddeInstance,
+ itemString, CP_WINANSI);
+ if (ddeItem != NULL) {
+ ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
+ CF_TEXT, XTYP_REQUEST, 5000, NULL);
+ if (ddeData == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ } else {
+ dataString = DdeAccessData(ddeData, &dataLength);
+ returnObjPtr = Tcl_NewStringObj(dataString, -1);
+ DdeUnaccessData(ddeData);
+ DdeFreeDataHandle(ddeData);
+ Tcl_SetObjResult(interp, returnObjPtr);
+ }
+ } else {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ }
+
+ break;
+ }
+ case DDE_POKE: {
+ itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ if (length == 0) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "cannot have a null item", -1);
+ return TCL_ERROR;
+ }
+ dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
+
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle (ddeInstance,ddeService) ;
+ DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ } else {
+ ddeItem = DdeCreateStringHandle(ddeInstance, itemString, \
+ CP_WINANSI);
+ if (ddeItem != NULL) {
+ ddeData = DdeClientTransaction(dataString,length+1, \
+ hConv, ddeItem,
+ CF_TEXT, XTYP_POKE, 5000, NULL);
+ if (ddeData == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ } else {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ }
+ break;
+ }
+
+ case DDE_SERVICES: {
+ HCONVLIST hConvList;
+ CONVINFO convInfo;
+ Tcl_Obj *convListObjPtr, *elementObjPtr;
+ Tcl_DString dString;
+ char *name;
+
+ convInfo.cb = sizeof(CONVINFO);
+ hConvList = DdeConnectList(ddeInstance, ddeService,
+ ddeTopic, 0, NULL);
+ DdeFreeStringHandle (ddeInstance,ddeService) ;
+ DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+ hConv = 0;
+ convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_DStringInit(&dString);
+
+ while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) {
+ elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ DdeQueryConvInfo(hConv, QID_SYNC, &convInfo);
+ length = DdeQueryString(ddeInstance,
+ convInfo.hszSvcPartner, NULL, 0, CP_WINANSI);
+ Tcl_DStringSetLength(&dString, length);
+ name = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, convInfo.hszSvcPartner,
+ name, length + 1, CP_WINANSI);
+ Tcl_ListObjAppendElement(interp, elementObjPtr,
+ Tcl_NewStringObj(name, length));
+ length = DdeQueryString(ddeInstance, convInfo.hszTopic,
+ NULL, 0, CP_WINANSI);
+ Tcl_DStringSetLength(&dString, length);
+ name = Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, convInfo.hszTopic, name,
+ length + 1, CP_WINANSI);
+ Tcl_ListObjAppendElement(interp, elementObjPtr,
+ Tcl_NewStringObj(name, length));
+ Tcl_ListObjAppendElement(interp, convListObjPtr, elementObjPtr);
+ }
+ DdeDisconnectList(hConvList);
+ Tcl_SetObjResult(interp, convListObjPtr);
+ Tcl_DStringFree(&dString);
+ break;
+ }
+ case DDE_EVAL: {
+ objc -= (async + 3);
+ ((Tcl_Obj **) objv) += (async + 3);
+
+ /*
+ * See if the target interpreter is local. If so, execute
+ * the command directly without going through the DDE server.
+ * Don't exchange objects between interps. The target interp could
+ * compile an object, producing a bytecode structure that refers to
+ * other objects owned by the target interp. If the target interp
+ * is then deleted, the bytecode structure would be referring to
+ * deallocated objects.
+ */
+
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr
+ = riPtr->nextPtr) {
+ if (stricmp(serviceName, riPtr->name) == 0) {
+ break;
+ }
+ }
+
+ if (riPtr != NULL) {
+ /*
+ * This command is to a local interp. No need to go through
+ * the server.
+ */
+
+ Tcl_Preserve((ClientData) riPtr);
+ sendInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) sendInterp);
+
+ /*
+ * Don't exchange objects between interps. The target interp would
+ * compile an object, producing a bytecode structure that refers to
+ * other objects owned by the target interp. If the target interp
+ * is then deleted, the bytecode structure would be referring to
+ * deallocated objects.
+ */
+
+ if (objc == 1) {
+ result = Tcl_EvalObjEx(sendInterp, objv[0], TCL_EVAL_GLOBAL);
+ } else {
+ objPtr = Tcl_ConcatObj(objc, objv);
+ Tcl_IncrRefCount(objPtr);
+ result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(objPtr);
+ }
+ if (interp != sendInterp) {
+ if (result == TCL_ERROR) {
+ /*
+ * An error occurred, so transfer error information from the
+ * destination interpreter back to our interpreter.
+ */
+
+ Tcl_ResetResult(interp);
+ objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
+ TCL_GLOBAL_ONLY);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_AddObjErrorInfo(interp, string, length);
+
+ objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetObjErrorCode(interp, objPtr);
+ }
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
+ }
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) sendInterp);
+ } else {
+ /*
+ * This is a non-local request. Send the script to the server and poll
+ * it for a result.
+ */
+
+ if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
+ goto error;
+ }
+
+ objPtr = Tcl_ConcatObj(objc, objv);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ ddeItemData = DdeCreateDataHandle(ddeInstance, string, length+1, 0, 0,
+ CF_TEXT, 0);
+
+ if (async) {
+ ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+ DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
+ } else {
+ ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0,
+ CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+ if (ddeData != 0) {
+
+ ddeCookie = DdeCreateStringHandle(ddeInstance,
+ "$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
+ ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
+ CF_TEXT, XTYP_REQUEST, 30000, NULL);
+ }
+ }
+
+
+ Tcl_DecrRefCount(objPtr);
+
+ if (ddeData == 0) {
+ SetDdeError(interp);
+ goto errorNoResult;
+ }
+
+ if (async == 0) {
+ Tcl_Obj *resultPtr;
+
+ /*
+ * The return handle has a two or four element list in it. The first
+ * element is the return code (TCL_OK, TCL_ERROR, etc.). The
+ * second is the result of the script. If the return code is TCL_ERROR,
+ * then the third element is the value of the variable "errorCode",
+ * and the fourth is the value of the variable "errorInfo".
+ */
+
+ resultPtr = Tcl_NewObj();
+ length = DdeGetData(ddeData, NULL, 0, 0);
+ Tcl_SetObjLength(resultPtr, length);
+ string = Tcl_GetString(resultPtr);
+ DdeGetData(ddeData, string, length, 0);
+ Tcl_SetObjLength(resultPtr, strlen(string));
+
+ if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto error;
+ }
+ if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto error;
+ }
+ if (result == TCL_ERROR) {
+ Tcl_ResetResult(interp);
+
+ if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto error;
+ }
+ length = -1;
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_AddObjErrorInfo(interp, string, length);
+
+ Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
+ Tcl_SetObjErrorCode(interp, objPtr);
+ }
+ if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_DecrRefCount(resultPtr);
+ }
+ }
+ }
+ }
+ if (ddeCookie != NULL) {
+ DdeFreeStringHandle(ddeInstance, ddeCookie);
+ }
+ if (ddeItem != NULL) {
+ DdeFreeStringHandle(ddeInstance, ddeItem);
+ }
+ if (ddeItemData != NULL) {
+ DdeFreeDataHandle(ddeItemData);
+ }
+ if (ddeData != NULL) {
+ DdeFreeDataHandle(ddeData);
+ }
+ if (hConv != NULL) {
+ DdeDisconnect(hConv);
+ }
+ return result;
+
+ error:
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "invalid data returned from server", -1);
+
+ errorNoResult:
+ if (ddeCookie != NULL) {
+ DdeFreeStringHandle(ddeInstance, ddeCookie);
+ }
+ if (ddeItem != NULL) {
+ DdeFreeStringHandle(ddeInstance, ddeItem);
+ }
+ if (ddeItemData != NULL) {
+ DdeFreeDataHandle(ddeItemData);
+ }
+ if (ddeData != NULL) {
+ DdeFreeDataHandle(ddeData);
+ }
+ if (hConv != NULL) {
+ DdeDisconnect(hConv);
+ }
+ return TCL_ERROR;
+}
diff --git a/tcl/win/tclWinError.c b/tcl/win/tclWinError.c
index 940343381b4..1c10e2778d3 100644
--- a/tcl/win/tclWinError.c
+++ b/tcl/win/tclWinError.c
@@ -12,8 +12,7 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
+#include "tclWinInt.h"
/*
* The following table contains the mapping from Win32 errors to
@@ -391,3 +390,5 @@ TclWinConvertWSAError(errCode)
Tcl_SetErrno(EINVAL);
}
}
+
+
diff --git a/tcl/win/tclWinFCmd.c b/tcl/win/tclWinFCmd.c
index eb017e5842d..e55049e6da2 100644
--- a/tcl/win/tclWinFCmd.c
+++ b/tcl/win/tclWinFCmd.c
@@ -4,7 +4,7 @@
* This file implements the Windows specific portion of file manipulation
* subcommands of the "file" command.
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -28,19 +28,19 @@
*/
static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **attributePtrPtr));
static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **attributePtrPtr));
static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **attributePtrPtr));
static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj *attributePtr));
static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj *attributePtr));
/*
@@ -60,9 +60,12 @@ static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
-char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-longname", "-readonly",
- "-shortname", "-system", (char *) NULL};
-CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+char *tclpFileAttrStrings[] = {
+ "-archive", "-hidden", "-longname", "-readonly",
+ "-shortname", "-system", (char *) NULL
+};
+
+const TclFileAttrProcs tclpFileAttrProcs[] = {
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileLongName, CannotSetAttribute},
@@ -74,31 +77,36 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
* Prototype for the TraverseWinTree callback function.
*/
-typedef int (TraversalProc)(char *src, char *dst, DWORD attr, int type,
- Tcl_DString *errorPtr);
+typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+ int type, Tcl_DString *errorPtr);
/*
* Declarations for local procedures defined in this file:
*/
-static void AttributesPosixError _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName, int getOrSet));
-static int ConvertFileNameFormat _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName, int longShort,
- Tcl_Obj **attributePtrPtr));
-static int TraversalCopy(char *src, char *dst, DWORD attr,
- int type, Tcl_DString *errorPtr);
-static int TraversalDelete(char *src, char *dst, DWORD attr,
- int type, Tcl_DString *errorPtr);
+static void StatError(Tcl_Interp *interp, CONST char *fileName);
+static int ConvertFileNameFormat(Tcl_Interp *interp,
+ int objIndex, CONST char *fileName, int longShort,
+ Tcl_Obj **attributePtrPtr);
+static int DoCopyFile(Tcl_DString *srcPtr, Tcl_DString *dstPtr);
+static int DoCreateDirectory(Tcl_DString *pathPtr);
+static int DoDeleteFile(Tcl_DString *pathPtr);
+static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
+ Tcl_DString *errorPtr);
+static int DoRenameFile(const TCHAR *nativeSrc, Tcl_DString *dstPtr);
+static int TraversalCopy(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+ int type, Tcl_DString *errorPtr);
+static int TraversalDelete(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+ int type, Tcl_DString *errorPtr);
static int TraverseWinTree(TraversalProc *traverseProc,
- Tcl_DString *sourcePtr, Tcl_DString *destPtr,
+ Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
Tcl_DString *errorPtr);
/*
*---------------------------------------------------------------------------
*
- * TclpRenameFile --
+ * TclpRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
@@ -110,10 +118,11 @@ static int TraverseWinTree(TraversalProc *traverseProc,
* fail.
*
* Results:
- * If the directory was successfully created, returns TCL_OK.
+ * If the file or directory was successfully renamed, returns TCL_OK.
* Otherwise the return value is TCL_ERROR and errno is set to
* indicate the error. Some possible values for errno are:
*
+ * ENAMETOOLONG: src or dst names are too long.
* EACCES: src or dst parent directory can't be read and/or written.
* EEXIST: dst is a non-empty directory.
* EINVAL: src is a root directory or dst is a subdirectory of src.
@@ -138,11 +147,36 @@ static int TraverseWinTree(TraversalProc *traverseProc,
int
TclpRenameFile(
- char *src, /* Pathname of file or dir to be renamed. */
- char *dst) /* New pathname for file or directory. */
+ CONST char *src, /* Pathname of file or dir to be renamed
+ * (UTF-8). */
+ CONST char *dst) /* New pathname of file or directory
+ * (UTF-8). */
{
+ int result;
+ TCHAR *nativeSrc;
+ Tcl_DString srcString, dstString;
+
+ nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString);
+ Tcl_WinUtfToTChar(dst, -1, &dstString);
+
+ result = DoRenameFile(nativeSrc, &dstString);
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoRenameFile(
+ CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
+ * (native). */
+ Tcl_DString *dstPtr) /* New pathname for file or directory
+ * (native). */
+{
+ const TCHAR *nativeDst;
DWORD srcAttr, dstAttr;
-
+
+ nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
+
/*
* Would throw an exception under NT if one of the arguments is a
* char block device.
@@ -150,26 +184,33 @@ TclpRenameFile(
/* CYGNUS LOCAL */
#ifndef __GNUC__
- try {
+ __try {
#endif
- /* END CYGNUS LOCAL */
- if (MoveFile(src, dst) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
return TCL_OK;
}
/* CYGNUS LOCAL */
#ifndef __GNUC__
- } except (-1) {}
+ } __except (-1) {}
#endif
/* END CYGNUS LOCAL */
TclWinConvertError(GetLastError());
- srcAttr = GetFileAttributes(src);
- dstAttr = GetFileAttributes(dst);
- if (srcAttr == (DWORD) -1) {
+ srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
+ dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
+ if (srcAttr == 0xffffffff) {
+ if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
+ errno = ENAMETOOLONG;
+ return TCL_ERROR;
+ }
srcAttr = 0;
}
- if (dstAttr == (DWORD) -1) {
+ if (dstAttr == 0xffffffff) {
+ if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) {
+ errno = ENAMETOOLONG;
+ return TCL_ERROR;
+ }
dstAttr = 0;
}
@@ -177,46 +218,47 @@ TclpRenameFile(
errno = EACCES;
return TCL_ERROR;
}
- if ((errno == EACCES) && (TclWinGetPlatformId() == VER_PLATFORM_WIN32s)) {
- if ((srcAttr != 0) && (dstAttr != 0)) {
- /*
- * Win32s reports trying to overwrite an existing file or directory
- * as EACCES.
- */
-
- errno = EEXIST;
- }
- }
if (errno == EACCES) {
decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
- char srcPath[MAX_PATH], dstPath[MAX_PATH];
- int srcArgc, dstArgc;
+ TCHAR *nativeSrcRest, *nativeDstRest;
char **srcArgv, **dstArgv;
- char *srcRest, *dstRest;
- int size;
-
- size = GetFullPathName(src, sizeof(srcPath), srcPath, &srcRest);
- if ((size == 0) || (size > sizeof(srcPath))) {
+ int size, srcArgc, dstArgc;
+ WCHAR nativeSrcPath[MAX_PATH];
+ WCHAR nativeDstPath[MAX_PATH];
+ Tcl_DString srcString, dstString;
+ CONST char *src, *dst;
+
+ size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
+ nativeSrcPath, &nativeSrcRest);
+ if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- size = GetFullPathName(dst, sizeof(dstPath), dstPath, &dstRest);
- if ((size == 0) || (size > sizeof(dstPath))) {
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
+ nativeDstPath, &nativeDstRest);
+ if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- if (srcRest == NULL) {
- srcRest = srcPath + strlen(srcPath);
- }
- if (strnicmp(srcPath, dstPath, srcRest - srcPath) == 0) {
+ (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
+ (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
+
+ src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
+ dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
+ if (strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString)) == 0) {
/*
* Trying to move a directory into itself.
*/
errno = EINVAL;
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
return TCL_ERROR;
}
- Tcl_SplitPath(srcPath, &srcArgc, &srcArgv);
- Tcl_SplitPath(dstPath, &dstArgc, &dstArgv);
+ Tcl_SplitPath(src, &srcArgc, &srcArgv);
+ Tcl_SplitPath(dst, &dstArgc, &dstArgv);
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+
if (srcArgc == 1) {
/*
* They are trying to move a root directory. Whether
@@ -224,9 +266,9 @@ TclpRenameFile(
* done.
*/
- errno = EINVAL;
+ Tcl_SetErrno(EINVAL);
} else if ((srcArgc > 0) && (dstArgc > 0) &&
- (stricmp(srcArgv[0], dstArgv[0]) != 0)) {
+ (strcmp(srcArgv[0], dstArgv[0]) != 0)) {
/*
* If src is a directory and dst filesystem != src
* filesystem, errno should be EXDEV. It is very
@@ -237,7 +279,7 @@ TclpRenameFile(
* file between filesystems.
*/
- errno = EXDEV;
+ Tcl_SetErrno(EXDEV);
}
ckfree((char *) srcArgv);
@@ -251,7 +293,7 @@ TclpRenameFile(
* current filesystem. EACCES is returned for those cases.
*/
- } else if (errno == EEXIST) {
+ } else if (Tcl_GetErrno() == EEXIST) {
/*
* Reports EEXIST any time the target already exists. If it makes
* sense, remove the old file and try renaming again.
@@ -265,14 +307,14 @@ TclpRenameFile(
* fails, it's because it wasn't empty.
*/
- if (TclpRemoveDirectory(dst, 0, NULL) == TCL_OK) {
+ if (DoRemoveDirectory(dstPtr, 0, NULL) == TCL_OK) {
/*
* Now that that empty directory is gone, we can try
* renaming again. If that fails, we'll put this empty
* directory back, for completeness.
*/
- if (MoveFile(src, dst) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
return TCL_OK;
}
@@ -282,9 +324,9 @@ TclpRenameFile(
*/
TclWinConvertError(GetLastError());
- CreateDirectory(dst, NULL);
- SetFileAttributes(dst, dstAttr);
- if (errno == EACCES) {
+ (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
+ (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
+ if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
@@ -293,11 +335,11 @@ TclpRenameFile(
}
}
} else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
- errno = ENOTDIR;
+ Tcl_SetErrno(ENOTDIR);
}
} else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
- errno = EISDIR;
+ Tcl_SetErrno(EISDIR);
} else {
/*
* Overwrite existing file by:
@@ -308,17 +350,24 @@ TclpRenameFile(
* put temp file back to old name.
*/
- char tempName[MAX_PATH];
+ TCHAR *nativeRest, *nativeTmp, *nativePrefix;
int result, size;
- char *rest;
+ WCHAR tempBuf[MAX_PATH];
- size = GetFullPathName(dst, sizeof(tempName), tempName, &rest);
- if ((size == 0) || (size > sizeof(tempName)) || (rest == NULL)) {
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
+ tempBuf, &nativeRest);
+ if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
}
- *rest = '\0';
+ nativeTmp = (TCHAR *) tempBuf;
+ ((char *) nativeRest)[0] = '\0';
+ ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */
+
result = TCL_ERROR;
- if (GetTempFileName(tempName, "tclr", 0, tempName) != 0) {
+ nativePrefix = (tclWinProcs->useWide)
+ ? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
+ if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
+ nativePrefix, 0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
* MoveFile to be joined as an atomic operation so no
@@ -326,15 +375,17 @@ TclpRenameFile(
* same temp file.
*/
- DeleteFile(tempName);
- if (MoveFile(dst, tempName) != FALSE) {
- if (MoveFile(src, dst) != FALSE) {
- SetFileAttributes(tempName, FILE_ATTRIBUTE_NORMAL);
- DeleteFile(tempName);
+ nativeTmp = (TCHAR *) tempBuf;
+ (*tclWinProcs->deleteFileProc)(nativeTmp);
+ if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
+ (*tclWinProcs->setFileAttributesProc)(nativeTmp,
+ FILE_ATTRIBUTE_NORMAL);
+ (*tclWinProcs->deleteFileProc)(nativeTmp);
return TCL_OK;
} else {
- DeleteFile(dst);
- MoveFile(tempName, dst);
+ (*tclWinProcs->deleteFileProc)(nativeDst);
+ (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
}
}
@@ -344,7 +395,7 @@ TclpRenameFile(
*/
TclWinConvertError(GetLastError());
- if (errno == EACCES) {
+ if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
@@ -362,7 +413,7 @@ TclpRenameFile(
/*
*---------------------------------------------------------------------------
*
- * TclpCopyFile --
+ * TclpCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
@@ -388,9 +439,30 @@ TclpRenameFile(
int
TclpCopyFile(
- char *src, /* Pathname of file to be copied. */
- char *dst) /* Pathname of file to copy to. */
+ CONST char *src, /* Pathname of file to be copied (UTF-8). */
+ CONST char *dst) /* Pathname of file to copy to (UTF-8). */
{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_WinUtfToTChar(src, -1, &srcString);
+ Tcl_WinUtfToTChar(dst, -1, &dstString);
+ result = DoCopyFile(&srcString, &dstString);
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoCopyFile(
+ Tcl_DString *srcPtr, /* Pathname of file to be copied (native). */
+ Tcl_DString *dstPtr) /* Pathname of file to copy to (native). */
+{
+ CONST TCHAR *nativeSrc, *nativeDst;
+
+ nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
+ nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
+
/*
* Would throw an exception under NT if one of the arguments is a char
* block device.
@@ -398,37 +470,40 @@ TclpCopyFile(
/* CYGNUS LOCAL */
#ifndef __GNUC__
- try {
-#endif /* __GNUC__ */
- if (CopyFile(src, dst, 0) != FALSE) {
+ __try {
+ if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
+#endif
+ /* END CYGNUS LOCAL */
return TCL_OK;
+#ifndef __GNUC__
}
/* CYGNUS LOCAL */
-#ifndef __GNUC__
- } except (-1) {}
-#endif /* __GNUC__ */
+ } __except (-1) {}
+#endif
+ /* END CYGNUS LOCAL */
TclWinConvertError(GetLastError());
- if (errno == EBADF) {
- errno = EACCES;
+ if (Tcl_GetErrno() == EBADF) {
+ Tcl_SetErrno(EACCES);
return TCL_ERROR;
}
- if (errno == EACCES) {
+ if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
- srcAttr = GetFileAttributes(src);
- dstAttr = GetFileAttributes(dst);
- if (srcAttr != (DWORD) -1) {
- if (dstAttr == (DWORD) -1) {
+ srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
+ dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
+ if (srcAttr != 0xffffffff) {
+ if (dstAttr == 0xffffffff) {
dstAttr = 0;
}
if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
(dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
- errno = EISDIR;
+ Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
- SetFileAttributes(dst, dstAttr & ~FILE_ATTRIBUTE_READONLY);
- if (CopyFile(src, dst, 0) != FALSE) {
+ (*tclWinProcs->setFileAttributesProc)(nativeDst,
+ dstAttr & ~FILE_ATTRIBUTE_READONLY);
+ if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
return TCL_OK;
}
/*
@@ -437,7 +512,7 @@ TclpCopyFile(
*/
TclWinConvertError(GetLastError());
- SetFileAttributes(dst, dstAttr);
+ (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
}
}
}
@@ -447,7 +522,7 @@ TclpCopyFile(
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile --
+ * TclpDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -471,59 +546,86 @@ TclpCopyFile(
int
TclpDeleteFile(
- char *path) /* Pathname of file to be removed. */
+ CONST char *path) /* Pathname of file to be removed (UTF-8). */
+{
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_WinUtfToTChar(path, -1, &pathString);
+ result = DoDeleteFile(&pathString);
+ Tcl_DStringFree(&pathString);
+ return result;
+}
+
+static int
+DoDeleteFile(
+ Tcl_DString *pathPtr) /* Pathname of file to be removed (native). */
{
DWORD attr;
+ CONST TCHAR *nativePath;
- if (DeleteFile(path) != FALSE) {
+ nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
+
+ if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- if (path[0] == '\0') {
- /*
- * Win32s thinks that "" is the same as "." and then reports EISDIR
- * instead of ENOENT.
- */
- errno = ENOENT;
- } else if (errno == EACCES) {
- attr = GetFileAttributes(path);
- if (attr != (DWORD) -1) {
+ /*
+ * Win32s thinks that "" is the same as "." and then reports EISDIR
+ * instead of ENOENT.
+ */
+
+ if (tclWinProcs->useWide) {
+ if (((WCHAR *) nativePath)[0] == '\0') {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
+ } else {
+ if (((char *) nativePath)[0] == '\0') {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
+ }
+ if (Tcl_GetErrno() == EACCES) {
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Windows NT reports removing a directory as EACCES instead
* of EISDIR.
*/
- errno = EISDIR;
+ Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
- SetFileAttributes(path, attr & ~FILE_ATTRIBUTE_READONLY);
- if (DeleteFile(path) != FALSE) {
+ (*tclWinProcs->setFileAttributesProc)(nativePath,
+ attr & ~FILE_ATTRIBUTE_READONLY);
+ if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- SetFileAttributes(path, attr);
+ (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
}
}
- } else if (errno == ENOENT) {
- attr = GetFileAttributes(path);
- if (attr != (DWORD) -1) {
+ } else if (Tcl_GetErrno() == ENOENT) {
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Windows 95 reports removing a directory as ENOENT instead
* of EISDIR.
*/
- errno = EISDIR;
+ Tcl_SetErrno(EISDIR);
}
}
- } else if (errno == EINVAL) {
+ } else if (Tcl_GetErrno() == EINVAL) {
/*
* Windows NT reports removing a char device as EINVAL instead of
* EACCES.
*/
- errno = EACCES;
+ Tcl_SetErrno(EACCES);
}
return TCL_ERROR;
@@ -556,18 +658,27 @@ TclpDeleteFile(
int
TclpCreateDirectory(
- char *path) /* Pathname of directory to create */
+ CONST char *path) /* Pathname of directory to create (UTF-8). */
{
- int error;
+ int result;
+ Tcl_DString pathString;
- if (CreateDirectory(path, NULL) == 0) {
+ Tcl_WinUtfToTChar(path, -1, &pathString);
+ result = DoCreateDirectory(&pathString);
+ Tcl_DStringFree(&pathString);
+ return result;
+}
+
+static int
+DoCreateDirectory(
+ Tcl_DString *pathPtr) /* Pathname of directory to create (native). */
+{
+ DWORD error;
+ CONST TCHAR *nativePath;
+
+ nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
+ if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
error = GetLastError();
- if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
- if ((error == ERROR_ACCESS_DENIED)
- && (GetFileAttributes(path) != (DWORD) -1)) {
- error = ERROR_FILE_EXISTS;
- }
- }
TclWinConvertError(error);
return TCL_ERROR;
}
@@ -602,30 +713,30 @@ TclpCreateDirectory(
int
TclpCopyDirectory(
- char *src, /* Pathname of directory to be copied. */
- char *dst, /* Pathname of target directory. */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error reporting. */
+ CONST char *src, /* Pathname of directory to be copied
+ * (UTF-8). */
+ CONST char *dst, /* Pathname of target directory (UTF-8). */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
int result;
- Tcl_DString srcBuffer;
- Tcl_DString dstBuffer;
-
- Tcl_DStringInit(&srcBuffer);
- Tcl_DStringInit(&dstBuffer);
- Tcl_DStringAppend(&srcBuffer, src, -1);
- Tcl_DStringAppend(&dstBuffer, dst, -1);
- result = TraverseWinTree(TraversalCopy, &srcBuffer, &dstBuffer,
- errorPtr);
- Tcl_DStringFree(&srcBuffer);
- Tcl_DStringFree(&dstBuffer);
+ Tcl_DString srcString, dstString;
+
+ Tcl_WinUtfToTChar(src, -1, &srcString);
+ Tcl_WinUtfToTChar(dst, -1, &dstString);
+
+ result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr);
+
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
return result;
}
/*
*----------------------------------------------------------------------
*
- * TclpRemoveDirectory --
+ * TclpRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
@@ -653,52 +764,87 @@ TclpCopyDirectory(
int
TclpRemoveDirectory(
- char *path, /* Pathname of directory to be removed. */
+ CONST char *path, /* Pathname of directory to be removed
+ * (UTF-8). */
int recursive, /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error reporting. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
int result;
- Tcl_DString buffer;
+ Tcl_DString pathString;
+
+ Tcl_WinUtfToTChar(path, -1, &pathString);
+ result = DoRemoveDirectory(&pathString, recursive, errorPtr);
+ Tcl_DStringFree(&pathString);
+
+ return result;
+}
+
+static int
+DoRemoveDirectory(
+ Tcl_DString *pathPtr, /* Pathname of directory to be removed
+ * (native). */
+ int recursive, /* If non-zero, removes directories that
+ * are nonempty. Otherwise, will only remove
+ * empty directories. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ CONST TCHAR *nativePath;
DWORD attr;
- if (RemoveDirectory(path) != FALSE) {
+ nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
+
+ if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- if (path[0] == '\0') {
- /*
- * Win32s thinks that "" is the same as "." and then reports EACCES
- * instead of ENOENT.
- */
- errno = ENOENT;
+ /*
+ * Win32s thinks that "" is the same as "." and then reports EACCES
+ * instead of ENOENT.
+ */
+
+
+ if (tclWinProcs->useWide) {
+ if (((WCHAR *) nativePath)[0] == '\0') {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
+ } else {
+ if (((char *) nativePath)[0] == '\0') {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
}
- if (errno == EACCES) {
- attr = GetFileAttributes(path);
- if (attr != (DWORD) -1) {
+ if (Tcl_GetErrno() == EACCES) {
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Windows 95 reports calling RemoveDirectory on a file as an
* EACCES, not an ENOTDIR.
*/
- errno = ENOTDIR;
+ Tcl_SetErrno(ENOTDIR);
goto end;
}
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
- if (SetFileAttributes(path, attr) == FALSE) {
+ if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
goto end;
}
- if (RemoveDirectory(path) != FALSE) {
+ if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- SetFileAttributes(path, attr | FILE_ATTRIBUTE_READONLY);
+ (*tclWinProcs->setFileAttributesProc)(nativePath,
+ attr | FILE_ATTRIBUTE_READONLY);
}
/*
@@ -708,20 +854,22 @@ TclpRemoveDirectory(
*/
if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
+ char *path, *find;
HANDLE handle;
- WIN32_FIND_DATA data;
+ WIN32_FIND_DATAA data;
Tcl_DString buffer;
- char *find;
int len;
+ path = (char *) nativePath;
+
Tcl_DStringInit(&buffer);
- find = Tcl_DStringAppend(&buffer, path, -1);
- len = Tcl_DStringLength(&buffer);
+ len = strlen(path);
+ find = Tcl_DStringAppend(&buffer, path, len);
if ((len > 0) && (find[len - 1] != '\\')) {
Tcl_DStringAppend(&buffer, "\\", 1);
}
find = Tcl_DStringAppend(&buffer, "*.*", 3);
- handle = FindFirstFile(find, &data);
+ handle = FindFirstFileA(find, &data);
if (handle != INVALID_HANDLE_VALUE) {
while (1) {
if ((strcmp(data.cFileName, ".") != 0)
@@ -730,10 +878,10 @@ TclpRemoveDirectory(
* Found something in this directory.
*/
- errno = EEXIST;
+ Tcl_SetErrno(EEXIST);
break;
}
- if (FindNextFile(handle, &data) == FALSE) {
+ if (FindNextFileA(handle, &data) == FALSE) {
break;
}
}
@@ -743,30 +891,26 @@ TclpRemoveDirectory(
}
}
}
- if (errno == ENOTEMPTY) {
+ if (Tcl_GetErrno() == ENOTEMPTY) {
/*
* The caller depends on EEXIST to signify that the directory is
* not empty, not ENOTEMPTY.
*/
- errno = EEXIST;
+ Tcl_SetErrno(EEXIST);
}
- if ((recursive != 0) && (errno == EEXIST)) {
+ if ((recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
/*
* The directory is nonempty, but the recursive flag has been
* specified, so we recursively remove all the files in the directory.
*/
- Tcl_DStringInit(&buffer);
- Tcl_DStringAppend(&buffer, path, -1);
- result = TraverseWinTree(TraversalDelete, &buffer, NULL, errorPtr);
- Tcl_DStringFree(&buffer);
- return result;
+ return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
}
-
+
end:
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, path, -1);
+ Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -798,34 +942,28 @@ TraverseWinTree(
TraversalProc *traverseProc,/* Function to call for every file and
* directory in source hierarchy. */
Tcl_DString *sourcePtr, /* Pathname of source directory to be
- * traversed. */
+ * traversed (native). */
Tcl_DString *targetPtr, /* Pathname of directory to traverse in
- * parallel with source directory. */
- Tcl_DString *errorPtr) /* If non-NULL, an initialized DString for
- * error reporting. */
+ * parallel with source directory (native). */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
DWORD sourceAttr;
- char *source, *target, *errfile;
- int result, sourceLen, targetLen, sourceLenOriginal, targetLenOriginal;
+ TCHAR *nativeSource, *nativeErrfile;
+ int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen;
HANDLE handle;
- WIN32_FIND_DATA data;
+ WIN32_FIND_DATAT data;
+ nativeErrfile = NULL;
result = TCL_OK;
- source = Tcl_DStringValue(sourcePtr);
- sourceLenOriginal = Tcl_DStringLength(sourcePtr);
- if (targetPtr != NULL) {
- target = Tcl_DStringValue(targetPtr);
- targetLenOriginal = Tcl_DStringLength(targetPtr);
- } else {
- target = NULL;
- targetLenOriginal = 0;
- }
-
- errfile = NULL;
+ oldTargetLen = 0; /* lint. */
- sourceAttr = GetFileAttributes(source);
- if (sourceAttr == (DWORD) -1) {
- errfile = source;
+ nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
+ oldSourceLen = Tcl_DStringLength(sourcePtr);
+ sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
+ if (sourceAttr == 0xffffffff) {
+ nativeErrfile = nativeSource;
goto end;
}
if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
@@ -833,76 +971,112 @@ TraverseWinTree(
* Process the regular file
*/
- return (*traverseProc)(source, target, sourceAttr, DOTREE_F, errorPtr);
+ return (*traverseProc)(sourcePtr, targetPtr, DOTREE_F, errorPtr);
}
- /*
- * When given the pathname of the form "c:\" (one that already ends
- * with a backslash), must make sure not to add another "\" to the end
- * otherwise it will try to access a network drive.
- */
-
- sourceLen = sourceLenOriginal;
- if ((sourceLen > 0) && (source[sourceLen - 1] != '\\')) {
- Tcl_DStringAppend(sourcePtr, "\\", 1);
- sourceLen++;
+ if (tclWinProcs->useWide) {
+ Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
+ Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
+ } else {
+ Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
}
- source = Tcl_DStringAppend(sourcePtr, "*.*", 3);
- handle = FindFirstFile(source, &data);
- Tcl_DStringSetLength(sourcePtr, sourceLen);
- if (handle == INVALID_HANDLE_VALUE) {
+ nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
+ if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory
*/
TclWinConvertError(GetLastError());
- errfile = source;
+ nativeErrfile = nativeSource;
goto end;
}
- result = (*traverseProc)(source, target, sourceAttr, DOTREE_PRED, errorPtr);
+ nativeSource[oldSourceLen + 1] = '\0';
+ Tcl_DStringSetLength(sourcePtr, oldSourceLen);
+ result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_PRED, errorPtr);
if (result != TCL_OK) {
FindClose(handle);
return result;
}
+ sourceLen = oldSourceLen;
+
+ if (tclWinProcs->useWide) {
+ sourceLen += sizeof(WCHAR);
+ Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
+ Tcl_DStringSetLength(sourcePtr, sourceLen);
+ } else {
+ sourceLen += 1;
+ Tcl_DStringAppend(sourcePtr, "\\", 1);
+ }
if (targetPtr != NULL) {
- targetLen = targetLenOriginal;
- if ((targetLen > 0) && (target[targetLen - 1] != '\\')) {
- target = Tcl_DStringAppend(targetPtr, "\\", 1);
- targetLen++;
+ oldTargetLen = Tcl_DStringLength(targetPtr);
+
+ targetLen = oldTargetLen;
+ if (tclWinProcs->useWide) {
+ targetLen += sizeof(WCHAR);
+ Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
+ Tcl_DStringSetLength(targetPtr, targetLen);
+ } else {
+ targetLen += 1;
+ Tcl_DStringAppend(targetPtr, "\\", 1);
}
}
- while (1) {
- if ((strcmp(data.cFileName, ".") != 0)
- && (strcmp(data.cFileName, "..") != 0)) {
- /*
- * Append name after slash, and recurse on the file.
- */
+ found = 1;
+ for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ TCHAR *nativeName;
+ int len;
- Tcl_DStringAppend(sourcePtr, data.cFileName, -1);
- if (targetPtr != NULL) {
- Tcl_DStringAppend(targetPtr, data.cFileName, -1);
+ if (tclWinProcs->useWide) {
+ WCHAR *wp;
+
+ wp = data.w.cFileName;
+ if (*wp == '.') {
+ wp++;
+ if (*wp == '.') {
+ wp++;
+ }
+ if (*wp == '\0') {
+ continue;
+ }
}
- result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
- errorPtr);
- if (result != TCL_OK) {
- break;
+ nativeName = (TCHAR *) data.w.cFileName;
+ len = Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR);
+ } else {
+ if ((strcmp(data.a.cFileName, ".") == 0)
+ || (strcmp(data.a.cFileName, "..") == 0)) {
+ continue;
}
+ nativeName = (TCHAR *) data.a.cFileName;
+ len = strlen(data.a.cFileName);
+ }
- /*
- * Remove name after slash.
- */
+ /*
+ * Append name after slash, and recurse on the file.
+ */
- Tcl_DStringSetLength(sourcePtr, sourceLen);
- if (targetPtr != NULL) {
- Tcl_DStringSetLength(targetPtr, targetLen);
- }
+ Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
+ Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
+ if (targetPtr != NULL) {
+ Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);
+ Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1);
}
- if (FindNextFile(handle, &data) == FALSE) {
+ result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
+ errorPtr);
+ if (result != TCL_OK) {
break;
}
+
+ /*
+ * Remove name after slash.
+ */
+
+ Tcl_DStringSetLength(sourcePtr, sourceLen);
+ if (targetPtr != NULL) {
+ Tcl_DStringSetLength(targetPtr, targetLen);
+ }
}
FindClose(handle);
@@ -910,27 +1084,26 @@ TraverseWinTree(
* Strip off the trailing slash we added
*/
- Tcl_DStringSetLength(sourcePtr, sourceLenOriginal);
- source = Tcl_DStringValue(sourcePtr);
+ Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
+ Tcl_DStringSetLength(sourcePtr, oldSourceLen);
if (targetPtr != NULL) {
- Tcl_DStringSetLength(targetPtr, targetLenOriginal);
- target = Tcl_DStringValue(targetPtr);
+ Tcl_DStringSetLength(targetPtr, oldTargetLen + 1);
+ Tcl_DStringSetLength(targetPtr, oldTargetLen);
}
-
if (result == TCL_OK) {
/*
* Call traverseProc() on a directory after visiting all the
* files in that directory.
*/
- result = (*traverseProc)(source, target, sourceAttr,
- DOTREE_POSTD, errorPtr);
+ result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_POSTD,
+ errorPtr);
}
end:
- if (errfile != NULL) {
+ if (nativeErrfile != NULL) {
TclWinConvertError(GetLastError());
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, errfile, -1);
+ Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
}
result = TCL_ERROR;
}
@@ -957,32 +1130,37 @@ TraverseWinTree(
static int
TraversalCopy(
- char *src, /* Source pathname to copy. */
- char *dst, /* Destination pathname of copy. */
- DWORD srcAttr, /* File attributes for src. */
+ Tcl_DString *srcPtr, /* Source pathname to copy. */
+ Tcl_DString *dstPtr, /* Destination pathname of copy. */
int type, /* Reason for call - see TraverseWinTree() */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error return. */
+ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
+ * with UTF-8 name of file causing error. */
{
+ TCHAR *nativeDst, *nativeSrc;
+ DWORD attr;
+
switch (type) {
- case DOTREE_F:
- if (TclpCopyFile(src, dst) == TCL_OK) {
+ case DOTREE_F: {
+ if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {
return TCL_OK;
}
break;
-
- case DOTREE_PRED:
- if (TclpCreateDirectory(dst) == TCL_OK) {
- if (SetFileAttributes(dst, srcAttr) != FALSE) {
+ }
+ case DOTREE_PRED: {
+ if (DoCreateDirectory(dstPtr) == TCL_OK) {
+ nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
+ nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
+ if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
}
break;
-
- case DOTREE_POSTD:
+ }
+ case DOTREE_POSTD: {
return TCL_OK;
-
+ }
}
/*
@@ -991,7 +1169,8 @@ TraversalCopy(
*/
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, dst, -1);
+ nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
+ Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -1019,33 +1198,35 @@ TraversalCopy(
static int
TraversalDelete(
- char *src, /* Source pathname. */
- char *ignore, /* Destination pathname (not used). */
- DWORD srcAttr, /* File attributes for src (not used). */
- int type, /* Reason for call - see TraverseWinTree(). */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error return. */
+ Tcl_DString *srcPtr, /* Source pathname to delete. */
+ Tcl_DString *dstPtr, /* Not used. */
+ int type, /* Reason for call - see TraverseWinTree() */
+ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
+ * with UTF-8 name of file causing error. */
{
+ TCHAR *nativeSrc;
+
switch (type) {
- case DOTREE_F:
- if (TclpDeleteFile(src) == TCL_OK) {
+ case DOTREE_F: {
+ if (DoDeleteFile(srcPtr) == TCL_OK) {
return TCL_OK;
}
break;
-
- case DOTREE_PRED:
+ }
+ case DOTREE_PRED: {
return TCL_OK;
-
- case DOTREE_POSTD:
- if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
+ }
+ case DOTREE_POSTD: {
+ if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) {
return TCL_OK;
}
break;
-
+ }
}
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, src, -1);
+ nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
+ Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -1053,7 +1234,7 @@ TraversalDelete(
/*
*----------------------------------------------------------------------
*
- * AttributesPosixError --
+ * StatError --
*
* Sets the object result with the appropriate error.
*
@@ -1068,18 +1249,15 @@ TraversalDelete(
*/
static void
-AttributesPosixError(
+StatError(
Tcl_Interp *interp, /* The interp that has the error */
- int objIndex, /* The attribute which caused the problem. */
- char *fileName, /* The name of the file which caused the
+ CONST char *fileName) /* The name of the file which caused the
* error. */
- int getOrSet) /* 0 for get; 1 for set */
{
TclWinConvertError(GetLastError());
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "cannot ", getOrSet ? "set" : "get", " attribute \"",
- tclpFileAttrStrings[objIndex], "\" for file \"", fileName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ "could not read \"", fileName, "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
}
/*
@@ -1103,19 +1281,25 @@ AttributesPosixError(
static int
GetWinFileAttributes(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ CONST char *fileName, /* The name of the file. */
+ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
- DWORD result = GetFileAttributes(fileName);
+ DWORD result;
+ Tcl_DString ds;
+ TCHAR *nativeName;
+
+ nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ result = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ Tcl_DStringFree(&ds);
- if (result == 0xFFFFFFFF) {
- AttributesPosixError(interp, objIndex, fileName, 0);
+ if (result == 0xffffffff) {
+ StatError(interp, fileName);
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);
+ *attributePtrPtr = Tcl_NewBooleanObj((int) (result & attributeArray[objIndex]));
return TCL_OK;
}
@@ -1140,87 +1324,138 @@ GetWinFileAttributes(
static int
ConvertFileNameFormat(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- int longShort, /* 0 to short name, 1 to long name. */
- Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ CONST char *fileName, /* The name of the file. */
+ int longShort, /* 0 to short name, 1 to long name. */
+ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
- HANDLE findHandle;
- WIN32_FIND_DATA findData;
- int pathArgc, i;
- char **pathArgv, **newPathArgv;
- char *currentElement, *resultStr;
+ int pathc, i;
+ char **pathv, **newv;
+ char *resultStr;
Tcl_DString resultDString;
int result = TCL_OK;
- Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
- newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));
-
- i = 0;
- if ((pathArgv[0][0] == '/')
- || ((strlen(pathArgv[0]) == 3) && (pathArgv[0][1] == ':'))) {
- newPathArgv[0] = (char *) ckalloc(strlen(pathArgv[0]) + 1);
- strcpy(newPathArgv[0], pathArgv[0]);
- i = 1;
- }
- for ( ; i < pathArgc; i++) {
- if (strcmp(pathArgv[i], ".") == 0) {
- currentElement = ckalloc(2);
- strcpy(currentElement, ".");
- } else if (strcmp(pathArgv[i], "..") == 0) {
- currentElement = ckalloc(3);
- strcpy(currentElement, "..");
+ Tcl_SplitPath(fileName, &pathc, &pathv);
+ newv = (char **) ckalloc(pathc * sizeof(char *));
+
+ if (pathc == 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not read \"", fileName,
+ "\": no such file or directory",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ for (i = 0; i < pathc; i++) {
+ if ((pathv[i][0] == '/')
+ || ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':'))
+ || (strcmp(pathv[i], ".") == 0)
+ || (strcmp(pathv[i], "..") == 0)) {
+ /*
+ * Handle "/", "//machine/export", "c:/", "." or ".." by just
+ * copying the string literally. Uppercase the drive letter,
+ * just because it looks better under Windows to do so.
+ */
+
+ simple:
+ pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0]));
+ newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1);
+ lstrcpyA(newv[i], pathv[i]);
} else {
- int useLong;
+ char *str;
+ TCHAR *nativeName;
+ Tcl_DString ds;
+ WIN32_FIND_DATAT data;
+ HANDLE handle;
+ DWORD attr;
Tcl_DStringInit(&resultDString);
- resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
- findHandle = FindFirstFile(resultStr, &findData);
- if (findHandle == INVALID_HANDLE_VALUE) {
- pathArgc = i - 1;
- AttributesPosixError(interp, objIndex, fileName, 0);
+ str = Tcl_JoinPath(i + 1, pathv, &resultDString);
+ nativeName = Tcl_WinUtfToTChar(str, -1, &ds);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * FindFirstFile() doesn't like root directories. We
+ * would only get a root directory here if the caller
+ * specified "c:" or "c:." and the current directory on the
+ * drive was the root directory
+ */
+
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&resultDString);
+
+ goto simple;
+ }
+ }
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&resultDString);
+
+ if (handle == INVALID_HANDLE_VALUE) {
+ pathc = i - 1;
+ StatError(interp, fileName);
result = TCL_ERROR;
- Tcl_DStringFree(&resultDString);
goto cleanup;
}
- if (longShort) {
- if (findData.cFileName[0] != '\0') {
- useLong = 1;
+ if (tclWinProcs->useWide) {
+ nativeName = (TCHAR *) data.w.cAlternateFileName;
+ if (longShort) {
+ if (data.w.cFileName[0] != '\0') {
+ nativeName = (TCHAR *) data.w.cFileName;
+ }
} else {
- useLong = 0;
+ if (data.w.cAlternateFileName[0] == '\0') {
+ nativeName = (TCHAR *) data.w.cFileName;
+ }
}
} else {
- if (findData.cAlternateFileName[0] == '\0') {
- useLong = 1;
+ nativeName = (TCHAR *) data.a.cAlternateFileName;
+ if (longShort) {
+ if (data.a.cFileName[0] != '\0') {
+ nativeName = (TCHAR *) data.a.cFileName;
+ }
} else {
- useLong = 0;
+ if (data.a.cAlternateFileName[0] == '\0') {
+ nativeName = (TCHAR *) data.a.cFileName;
+ }
}
}
- if (useLong) {
- currentElement = ckalloc(strlen(findData.cFileName) + 1);
- strcpy(currentElement, findData.cFileName);
- } else {
- currentElement = ckalloc(strlen(findData.cAlternateFileName)
- + 1);
- strcpy(currentElement, findData.cAlternateFileName);
- }
- Tcl_DStringFree(&resultDString);
- FindClose(findHandle);
+
+ /*
+ * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
+ * to dereference nativeName as a Unicode string. I have proven
+ * to myself that purify is wrong by running the following
+ * example when nativeName == data.w.cAlternateFileName and
+ * noting that purify doesn't complain about the first line,
+ * but does complain about the second.
+ *
+ * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
+ * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
+ */
+
+ Tcl_WinTCharToUtf(nativeName, -1, &ds);
+ newv[i] = ckalloc((unsigned int) (Tcl_DStringLength(&ds) + 1));
+ lstrcpyA(newv[i], Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ FindClose(handle);
}
- newPathArgv[i] = currentElement;
}
Tcl_DStringInit(&resultDString);
- resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
- *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString));
+ resultStr = Tcl_JoinPath(pathc, newv, &resultDString);
+ *attributePtrPtr = Tcl_NewStringObj(resultStr,
+ Tcl_DStringLength(&resultDString));
Tcl_DStringFree(&resultDString);
cleanup:
- for (i = 0; i < pathArgc; i++) {
- ckfree(newPathArgv[i]);
+ for (i = 0; i < pathc; i++) {
+ ckfree(newv[i]);
}
- ckfree((char *) newPathArgv);
+ ckfree((char *) newv);
+ ckfree((char *) pathv);
return result;
}
@@ -1245,10 +1480,10 @@ cleanup:
static int
GetWinFileLongName(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ CONST char *fileName, /* The name of the file. */
+ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
}
@@ -1274,10 +1509,10 @@ GetWinFileLongName(
static int
GetWinFileShortName(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ CONST char *fileName, /* The name of the file. */
+ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
}
@@ -1301,23 +1536,29 @@ GetWinFileShortName(
static int
SetWinFileAttributes(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj *attributePtr) /* The new value of the attribute. */
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- DWORD fileAttributes = GetFileAttributes(fileName);
+ DWORD fileAttributes;
int yesNo;
int result;
+ Tcl_DString ds;
+ TCHAR *nativeName;
- if (fileAttributes == 0xFFFFFFFF) {
- AttributesPosixError(interp, objIndex, fileName, 1);
- return TCL_ERROR;
+ nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
+
+ if (fileAttributes == 0xffffffff) {
+ StatError(interp, fileName);
+ result = TCL_ERROR;
+ goto end;
}
result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
if (result != TCL_OK) {
- return result;
+ goto end;
}
if (yesNo) {
@@ -1326,11 +1567,16 @@ SetWinFileAttributes(
fileAttributes &= ~(attributeArray[objIndex]);
}
- if (!SetFileAttributes(fileName, fileAttributes)) {
- AttributesPosixError(interp, objIndex, fileName, 1);
- return TCL_ERROR;
+ if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
+ StatError(interp, fileName);
+ result = TCL_ERROR;
+ goto end;
}
- return TCL_OK;
+
+ end:
+ Tcl_DStringFree(&ds);
+
+ return result;
}
/*
@@ -1352,14 +1598,14 @@ SetWinFileAttributes(
static int
CannotSetAttribute(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj *attributePtr) /* The new value of the attribute. */
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"cannot set attribute \"", tclpFileAttrStrings[objIndex],
- "\" for file \"", fileName, "\" : attribute is readonly",
+ "\" for file \"", fileName, "\": attribute is readonly",
(char *) NULL);
return TCL_ERROR;
}
@@ -1385,31 +1631,52 @@ CannotSetAttribute(
int
TclpListVolumes(
- Tcl_Interp *interp) /* Interpreter to which to pass the volume list */
+ Tcl_Interp *interp) /* Interpreter for returning volume list. */
{
Tcl_Obj *resultPtr, *elemPtr;
- char buf[4];
+ char buf[40 * 4]; /* There couldn't be more than 30 drives??? */
int i;
+ char *p;
resultPtr = Tcl_GetObjResult(interp);
- buf[1] = ':';
- buf[2] = '/';
- buf[3] = '\0';
-
/*
- * On Win32s:
+ * On Win32s:
* GetLogicalDriveStrings() isn't implemented.
* GetLogicalDrives() returns incorrect information.
*/
- for (i = 0; i < 26; i++) {
- buf[0] = (char) ('a' + i);
- if (GetVolumeInformation(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
- || (GetLastError() == ERROR_NOT_READY)) {
- elemPtr = Tcl_NewStringObj(buf, -1);
+ if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) {
+ /*
+ * GetVolumeInformation() will detects all drives, but causes
+ * chattering on empty floppy drives. We only do this if
+ * GetLogicalDriveStrings() didn't work. It has also been reported
+ * that on some laptops it takes a while for GetVolumeInformation()
+ * to return when pinging an empty floppy drive, another reason to
+ * try to avoid calling it.
+ */
+
+ buf[1] = ':';
+ buf[2] = '/';
+ buf[3] = '\0';
+
+ for (i = 0; i < 26; i++) {
+ buf[0] = (char) ('a' + i);
+ if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
+ || (GetLastError() == ERROR_NOT_READY)) {
+ elemPtr = Tcl_NewStringObj(buf, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
+ }
+ }
+ } else {
+ for (p = buf; *p != '\0'; p += 4) {
+ p[2] = '/';
+ elemPtr = Tcl_NewStringObj(p, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
}
}
return TCL_OK;
}
+
+
+
diff --git a/tcl/win/tclWinFile.c b/tcl/win/tclWinFile.c
index b0d9b9fc318..859878e077b 100644
--- a/tcl/win/tclWinFile.c
+++ b/tcl/win/tclWinFile.c
@@ -6,7 +6,7 @@
* files, which can be manipulated through the Win32 console redirection
* interfaces.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -16,50 +16,58 @@
#include "tclWinInt.h"
#include <sys/stat.h>
-#ifndef __CYGWIN32__
#include <shlobj.h>
-#endif
+#include <lmaccess.h> /* For TclpGetUserHome(). */
-/*
- * The variable below caches the name of the current working directory
- * in order to avoid repeated calls to getcwd. The string is malloc-ed.
- * NULL means the cache needs to be refreshed.
- */
+static time_t ToCTime(FILETIME fileTime);
-static char *currentDir = NULL;
+typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC
+ (LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);
+
+typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC
+ (LPVOID Buffer);
+
+typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC
+ (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_FindExecutable --
+ * TclpFindExecutable --
*
* This procedure computes the absolute path name of the current
* application, given its argv[0] value.
*
* Results:
- * None.
+ * A dirty UTF string that is the path to the executable. At this
+ * point we may not know the system encoding. Convert the native
+ * string value to UTF using the default encoding. The assumption
+ * is that we will still be able to parse the path given the path
+ * name contains ASCII string and '/' chars do not conflict with
+ * other UTF chars.
*
* Side effects:
- * The variable tclExecutableName gets filled in with the file
+ * The variable tclNativeExecutableName gets filled in with the file
* name for the application, if we figured it out. If we couldn't
- * figure it out, Tcl_FindExecutable is set to NULL.
+ * figure it out, tclNativeExecutableName is set to NULL.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-void
-Tcl_FindExecutable(argv0)
- char *argv0; /* The value of the application's argv[0]. */
+char *
+TclpFindExecutable(argv0)
+ CONST char *argv0; /* The value of the application's argv[0]
+ * (native). */
{
- Tcl_DString buffer;
- int length;
+ Tcl_DString ds;
+ WCHAR wName[MAX_PATH];
- Tcl_DStringInit(&buffer);
-
- if (tclExecutableName != NULL) {
- ckfree(tclExecutableName);
- tclExecutableName = NULL;
+ if (argv0 == NULL) {
+ return NULL;
+ }
+ if (tclNativeExecutableName != NULL) {
+ return tclNativeExecutableName;
}
/*
@@ -67,26 +75,28 @@ Tcl_FindExecutable(argv0)
* create this process.
*/
- Tcl_DStringSetLength(&buffer, MAX_PATH+1);
- length = GetModuleFileName(NULL, Tcl_DStringValue(&buffer), MAX_PATH+1);
- if (length > 0) {
- tclExecutableName = (char *) ckalloc((unsigned) (length + 1));
- strcpy(tclExecutableName, Tcl_DStringValue(&buffer));
- }
- Tcl_DStringFree(&buffer);
+ (*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH);
+ Tcl_WinTCharToUtf((TCHAR *) wName, -1, &ds);
+
+ tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1));
+ strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+
+ TclWinNoBackslash(tclNativeExecutableName);
+ return tclNativeExecutableName;
}
/*
*----------------------------------------------------------------------
*
- * TclMatchFiles --
+ * TclpMatchFilesTypes --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
* If the tail argument is NULL, then the matching files are
- * added to the interp->result. Otherwise, TclDoGlob is called
+ * added to the the interp's result. Otherwise, TclDoGlob is called
* recursively for each matching subdirectory. The return value
* is a standard Tcl result indicating whether an error occurred
* in globbing.
@@ -97,25 +107,30 @@ Tcl_FindExecutable(argv0)
*---------------------------------------------------------------------- */
int
-TclMatchFiles(interp, separators, dirPtr, pattern, tail)
- Tcl_Interp *interp; /* Interpreter to receive results. */
- char *separators; /* Directory separators to pass to TclDoGlob. */
- Tcl_DString *dirPtr; /* Contains path to directory to search. */
- char *pattern; /* Pattern to match against. */
- char *tail; /* Pointer to end of pattern. Tail must
- * point to a location in pattern. */
+TclpMatchFilesTypes(
+ Tcl_Interp *interp, /* Interpreter to receive results. */
+ char *separators, /* Directory separators to pass to TclDoGlob. */
+ Tcl_DString *dirPtr, /* Contains path to directory to search. */
+ char *pattern, /* Pattern to match against. */
+ char *tail, /* Pointer to end of pattern. Tail must
+ * point to a location in pattern and must
+ * not be static.*/
+ GlobTypeData *types) /* Object containing list of acceptable types.
+ * May be NULL. */
{
- char drivePattern[4] = "?:\\";
- char *newPattern, *p, *dir, *root, c;
- char *src, *dest;
- int length, matchDotFiles;
- int result = TCL_OK;
- int baseLength = Tcl_DStringLength(dirPtr);
- Tcl_DString buffer;
- DWORD atts, volFlags;
+ char drivePat[] = "?:\\";
+ const char *message;
+ char *dir, *newPattern, *root;
+ int matchDotFiles;
+ int dirLength, result = TCL_OK;
+ Tcl_DString dirString, patternString;
+ DWORD attr, volFlags;
HANDLE handle;
- WIN32_FIND_DATA data;
+ WIN32_FIND_DATAT data;
BOOL found;
+ Tcl_DString ds;
+ TCHAR *nativeName;
+ Tcl_Obj *resultPtr;
/*
* Convert the path to normalized form since some interfaces only
@@ -123,31 +138,37 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* separator character.
*/
- Tcl_DStringInit(&buffer);
- if (baseLength == 0) {
- Tcl_DStringAppend(&buffer, ".", 1);
+ dirLength = Tcl_DStringLength(dirPtr);
+ Tcl_DStringInit(&dirString);
+ if (dirLength == 0) {
+ Tcl_DStringAppend(&dirString, ".\\", 2);
} else {
- Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
+ char *p;
+
+ Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr),
Tcl_DStringLength(dirPtr));
- }
- for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
- if (*p == '/') {
- *p = '\\';
+ for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
+ if (*p == '/') {
+ *p = '\\';
+ }
+ }
+ p--;
+ if ((*p != '\\') && (*p != ':')) {
+ Tcl_DStringAppend(&dirString, "\\", 1);
}
}
- p--;
- if (*p != '\\' && *p != ':') {
- Tcl_DStringAppend(&buffer, "\\", 1);
- }
- dir = Tcl_DStringValue(&buffer);
-
+ dir = Tcl_DStringValue(&dirString);
+
/*
* First verify that the specified path is actually a directory.
*/
- atts = GetFileAttributes(dir);
- if ((atts == 0xFFFFFFFF) || ((atts & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
- Tcl_DStringFree(&buffer);
+ nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ Tcl_DStringFree(&ds);
+
+ if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+ Tcl_DStringFree(&dirString);
return TCL_OK;
}
@@ -160,82 +181,67 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
switch (Tcl_GetPathType(dir)) {
case TCL_PATH_RELATIVE:
- found = GetVolumeInformation(NULL, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
+ found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
break;
case TCL_PATH_VOLUME_RELATIVE:
- if (*dir == '\\') {
+ if (dir[0] == '\\') {
root = NULL;
} else {
- root = drivePattern;
- *root = *dir;
+ root = drivePat;
+ *root = dir[0];
}
- found = GetVolumeInformation(root, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
+ found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
break;
case TCL_PATH_ABSOLUTE:
if (dir[1] == ':') {
- root = drivePattern;
- *root = *dir;
- found = GetVolumeInformation(root, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
+ root = drivePat;
+ *root = dir[0];
+ found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
} else if (dir[1] == '\\') {
- p = strchr(dir+2, '\\');
- p = strchr(p+1, '\\');
+ char *p;
+
+ p = strchr(dir + 2, '\\');
+ p = strchr(p + 1, '\\');
p++;
- c = *p;
- *p = 0;
- found = GetVolumeInformation(dir, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
- *p = c;
+ nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds);
+ found = (*tclWinProcs->getVolumeInformationProc)(nativeName,
+ NULL, 0, NULL, NULL, &volFlags, NULL, 0);
+ Tcl_DStringFree(&ds);
}
break;
}
- if (!found) {
- Tcl_DStringFree(&buffer);
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read volume information for \"",
- dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
+ if (found == 0) {
+ message = "couldn't read volume information for \"";
+ goto error;
}
-
+
/*
* In Windows, although some volumes may support case sensitivity, Windows
* doesn't honor case. So in globbing we need to ignore the case
* of file names.
*/
- length = tail - pattern;
- newPattern = ckalloc(length+1);
- for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
- *dest = (char) tolower(*src);
- }
- *dest = '\0';
-
+ Tcl_DStringInit(&patternString);
+ newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern);
+ Tcl_UtfToLower(newPattern);
+
/*
* We need to check all files in the directory, so append a *.*
* to the path.
*/
-
- dir = Tcl_DStringAppend(&buffer, "*.*", 3);
-
- /*
- * Now open the directory for reading and iterate over the contents.
- */
-
- handle = FindFirstFile(dir, &data);
- Tcl_DStringFree(&buffer);
+ dir = Tcl_DStringAppend(&dirString, "*.*", 3);
+ nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
+ Tcl_DStringFree(&ds);
if (handle == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
- ckfree(newPattern);
- return TCL_ERROR;
+ message = "couldn't read directory \"";
+ goto error;
}
/*
@@ -267,42 +273,43 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* Now iterate over all of the files in the directory.
*/
- Tcl_DStringInit(&buffer);
- for (found = 1; found; found = FindNextFile(handle, &data)) {
- char *matchResult;
+ resultPtr = Tcl_GetObjResult(interp);
+ for (found = 1; found != 0;
+ found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ TCHAR *nativeMatchResult;
+ char *name, *fname;
- /*
- * Ignore hidden files.
- */
-
- if (!matchDotFiles && (data.cFileName[0] == '.')) {
- continue;
+ if (tclWinProcs->useWide) {
+ nativeName = (TCHAR *) data.w.cFileName;
+ } else {
+ nativeName = (TCHAR *) data.a.cFileName;
}
+ name = Tcl_WinTCharToUtf(nativeName, -1, &ds);
/*
* Check to see if the file matches the pattern. We need to convert
* the file name to lower case for comparison purposes. Note that we
* are ignoring the case sensitivity flag because Windows doesn't honor
* case even if the volume is case sensitive. If the volume also
- * doesn't preserve case, then we return the lower case form of the
- * name, otherwise we return the system form.
+ * doesn't preserve case, then we previously returned the lower case
+ * form of the name. This didn't seem quite right since there are
+ * non-case-preserving volumes that actually return mixed case. So now
+ * we are returning exactly what we get from the system.
*/
- matchResult = NULL;
- Tcl_DStringSetLength(&buffer, 0);
- Tcl_DStringAppend(&buffer, data.cFileName, -1);
- for (p = buffer.string; *p != '\0'; p++) {
- *p = (char) tolower(*p);
- }
- if (Tcl_StringMatch(buffer.string, newPattern)) {
- if (volFlags & FS_CASE_IS_PRESERVED) {
- matchResult = data.cFileName;
- } else {
- matchResult = buffer.string;
- }
+ Tcl_UtfToLower(name);
+ nativeMatchResult = NULL;
+
+ if ((matchDotFiles == 0) && (name[0] == '.')) {
+ /*
+ * Ignore hidden files.
+ */
+ } else if (Tcl_StringMatch(name, newPattern) != 0) {
+ nativeMatchResult = nativeName;
}
+ Tcl_DStringFree(&ds);
- if (matchResult == NULL) {
+ if (nativeMatchResult == NULL) {
continue;
}
@@ -313,231 +320,498 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* file to the result.
*/
- Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, matchResult, -1);
+ name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds);
+ Tcl_DStringAppend(dirPtr, name, -1);
+ Tcl_DStringFree(&ds);
+
+ fname = Tcl_DStringValue(dirPtr);
+ nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ Tcl_DStringFree(&ds);
+
if (tail == NULL) {
- Tcl_AppendElement(interp, dirPtr->string);
- } else {
- atts = GetFileAttributes(dirPtr->string);
- if (atts & FILE_ATTRIBUTE_DIRECTORY) {
- Tcl_DStringAppend(dirPtr, "/", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail);
- if (result != TCL_OK) {
- break;
+ int typeOk = 1;
+ if (types != NULL) {
+ if (types->perm != 0) {
+ if (
+ ((types->perm & TCL_GLOB_PERM_RONLY) &&
+ !(attr & FILE_ATTRIBUTE_READONLY)) ||
+ ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
+ !(attr & FILE_ATTRIBUTE_HIDDEN)) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (TclpAccess(fname, R_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (TclpAccess(fname, W_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (TclpAccess(fname, X_OK) != 0))
+ ) {
+ typeOk = 0;
+ }
}
+ if (typeOk && types->type != 0) {
+ struct stat buf;
+ /*
+ * We must match at least one flag to be listed
+ */
+ typeOk = 0;
+ if (TclpLstat(fname, &buf) >= 0) {
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
+ if (
+ ((types->type & TCL_GLOB_TYPE_BLOCK) &&
+ S_ISBLK(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_CHAR) &&
+ S_ISCHR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_DIR) &&
+ S_ISDIR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_PIPE) &&
+ S_ISFIFO(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_FILE) &&
+ S_ISREG(buf.st_mode))
+#ifdef S_ISLNK
+ || ((types->type & TCL_GLOB_TYPE_LINK) &&
+ S_ISLNK(buf.st_mode))
+#endif
+#ifdef S_ISSOCK
+ || ((types->type & TCL_GLOB_TYPE_SOCK) &&
+ S_ISSOCK(buf.st_mode))
+#endif
+ ) {
+ typeOk = 1;
+ }
+ } else {
+ /* Posix error occurred */
+ }
+ }
+ }
+ if (typeOk) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr)));
+ }
+ } else if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+ Tcl_DStringAppend(dirPtr, "/", 1);
+ result = TclDoGlob(interp, separators, dirPtr, tail, types);
+ if (result != TCL_OK) {
+ break;
}
}
+ Tcl_DStringSetLength(dirPtr, dirLength);
}
- Tcl_DStringFree(&buffer);
FindClose(handle);
- ckfree(newPattern);
+ Tcl_DStringFree(&dirString);
+ Tcl_DStringFree(&patternString);
+
return result;
+
+ error:
+ Tcl_DStringFree(&dirString);
+ TclWinConvertError(GetLastError());
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ * TclpMatchFiles --
+ *
+ * This function is now obsolete. Call the above function
+ * 'TclpMatchFilesTypes' instead.
+ */
+int
+TclpMatchFiles(
+ Tcl_Interp *interp, /* Interpreter to receive results. */
+ char *separators, /* Directory separators to pass to TclDoGlob. */
+ Tcl_DString *dirPtr, /* Contains path to directory to search. */
+ char *pattern, /* Pattern to match against. */
+ char *tail) /* Pointer to end of pattern. Tail must
+ * point to a location in pattern and must
+ * not be static.*/
+{
+ return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
}
/*
*----------------------------------------------------------------------
*
- * TclChdir --
+ * TclpGetUserHome --
*
- * Change the current working directory.
+ * This function takes the passed in user name and finds the
+ * corresponding home directory specified in the password file.
*
* Results:
- * The result is a standard Tcl result. If an error occurs and
- * interp isn't NULL, an error message is left in interp->result.
+ * The result is a pointer to a string specifying the user's home
+ * directory, or NULL if the user's home directory could not be
+ * determined. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
*
* Side effects:
- * The working directory for this application is changed. Also
- * the cache maintained used by TclGetCwd is deallocated and
- * set to NULL.
+ * None.
*
*----------------------------------------------------------------------
*/
-int
-TclChdir(interp, dirName)
- Tcl_Interp *interp; /* If non NULL, used for error reporting. */
- char *dirName; /* Path to new working directory. */
+char *
+TclpGetUserHome(name, bufferPtr)
+ CONST char *name; /* User name for desired home directory. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name of user's home directory. */
{
- if (currentDir != NULL) {
- ckfree(currentDir);
- currentDir = NULL;
+ char *result;
+ HINSTANCE netapiInst;
+
+ result = NULL;
+
+ Tcl_DStringInit(bufferPtr);
+
+ netapiInst = LoadLibraryA("netapi32.dll");
+ if (netapiInst != NULL) {
+ NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
+ NETGETDCNAMEPROC *netGetDCNameProc;
+ NETUSERGETINFOPROC *netUserGetInfoProc;
+
+ netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
+ GetProcAddress(netapiInst, "NetApiBufferFree");
+ netGetDCNameProc = (NETGETDCNAMEPROC *)
+ GetProcAddress(netapiInst, "NetGetDCName");
+ netUserGetInfoProc = (NETUSERGETINFOPROC *)
+ GetProcAddress(netapiInst, "NetUserGetInfo");
+ if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
+ && (netApiBufferFreeProc != NULL)) {
+ USER_INFO_1 *uiPtr;
+ Tcl_DString ds;
+ int nameLen, badDomain;
+ char *domain;
+ WCHAR *wName, *wHomeDir, *wDomain;
+ WCHAR buf[MAX_PATH];
+
+ badDomain = 0;
+ nameLen = -1;
+ wDomain = NULL;
+ domain = strchr(name, '@');
+ if (domain != NULL) {
+ Tcl_DStringInit(&ds);
+ wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
+ badDomain = (*netGetDCNameProc)(NULL, wName,
+ (LPBYTE *) &wDomain);
+ Tcl_DStringFree(&ds);
+ nameLen = domain - name;
+ }
+ if (badDomain == 0) {
+ Tcl_DStringInit(&ds);
+ wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
+ if ((*netUserGetInfoProc)(wDomain, wName, 1,
+ (LPBYTE *) &uiPtr) == 0) {
+ wHomeDir = uiPtr->usri1_home_dir;
+ if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
+ Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
+ bufferPtr);
+ } else {
+ /*
+ * User exists but has no home dir. Return
+ * "{Windows Drive}:/users/default".
+ */
+
+ GetWindowsDirectoryW(buf, MAX_PATH);
+ Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
+ Tcl_DStringAppend(bufferPtr, "/users/default", -1);
+ }
+ result = Tcl_DStringValue(bufferPtr);
+ (*netApiBufferFreeProc)((void *) uiPtr);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ if (wDomain != NULL) {
+ (*netApiBufferFreeProc)((void *) wDomain);
+ }
+ }
+ FreeLibrary(netapiInst);
}
- /* CYGNUS LOCAL: On cygwin32, we must use chdir. Otherwise, the
- cygwin32 notion of the current directory will get messed up. */
-#ifdef __CYGWIN32__
- if (chdir(dirName) < 0) {
-#else
- if (!SetCurrentDirectory(dirName)) {
- TclWinConvertError(GetLastError());
-#endif
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ if (result == NULL) {
+ /*
+ * Look in the "Password Lists" section of system.ini for the
+ * local user. There are also entries in that section that begin
+ * with a "*" character that are used by Windows for other
+ * purposes; ignore user names beginning with a "*".
+ */
+
+ char buf[MAX_PATH];
+
+ if (name[0] != '*') {
+ if (GetPrivateProfileStringA("Password Lists", name, "", buf,
+ MAX_PATH, "system.ini") > 0) {
+ /*
+ * User exists, but there is no such thing as a home
+ * directory in system.ini. Return "{Windows drive}:/".
+ */
+
+ GetWindowsDirectoryA(buf, MAX_PATH);
+ Tcl_DStringAppend(bufferPtr, buf, 3);
+ result = Tcl_DStringValue(bufferPtr);
+ }
}
- return TCL_ERROR;
}
- return TCL_OK;
+
+ return result;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclGetCwd --
+ * TclpAccess --
*
- * Return the path name of the current working directory.
+ * This function replaces the library version of access(), fixing the
+ * following bugs:
+ *
+ * 1. access() returns that all files have execute permission.
*
* Results:
- * The result is the full path name of the current working
- * directory, or NULL if an error occurred while figuring it
- * out. If an error occurs and interp isn't NULL, an error
- * message is left in interp->result.
+ * See access documentation.
*
* Side effects:
- * The path name is cached to avoid having to recompute it
- * on future calls; if it is already cached, the cached
- * value is returned.
+ * See access documentation.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-char *
-TclGetCwd(interp)
- Tcl_Interp *interp; /* If non NULL, used for error reporting. */
+int
+TclpAccess(
+ CONST char *path, /* Path of file to access (UTF-8). */
+ int mode) /* Permission setting. */
{
- static char buffer[MAXPATHLEN+1];
- char *bufPtr, *p;
-
- if (currentDir == NULL) {
- if (GetCurrentDirectory(MAXPATHLEN+1, buffer) == 0) {
- TclWinConvertError(GetLastError());
- if (interp != NULL) {
- if (errno == ERANGE) {
- Tcl_SetResult(interp,
- "working directory name is too long",
- TCL_STATIC);
- } else {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- }
- return NULL;
- }
+ Tcl_DString ds;
+ TCHAR *nativePath;
+ DWORD attr;
+
+ nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ Tcl_DStringFree(&ds);
+
+ if (attr == 0xffffffff) {
/*
- * Watch for the wierd Windows '95 c:\\UNC syntax.
+ * File doesn't exist.
*/
- if (buffer[0] != '\0' && buffer[1] == ':' && buffer[2] == '\\'
- && buffer[3] == '\\') {
- bufPtr = &buffer[2];
- } else {
- bufPtr = buffer;
- }
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
/*
- * Convert to forward slashes for easier use in scripts.
+ * File is not writable.
*/
- for (p = bufPtr; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
+ Tcl_SetErrno(EACCES);
+ return -1;
+ }
+
+ if (mode & X_OK) {
+ CONST char *p;
+
+ if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+ /*
+ * Directories are always executable.
+ */
+
+ return 0;
+ }
+ p = strrchr(path, '.');
+ if (p != NULL) {
+ p++;
+ if ((stricmp(p, "exe") == 0)
+ || (stricmp(p, "com") == 0)
+ || (stricmp(p, "bat") == 0)) {
+ /*
+ * File that ends with .exe, .com, or .bat is executable.
+ */
+
+ return 0;
}
}
+ Tcl_SetErrno(EACCES);
+ return -1;
}
- return bufPtr;
+
+ return 0;
}
-#if 0
/*
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclWinResolveShortcut --
+ * TclpChdir --
*
- * Resolve a potential Windows shortcut to get the actual file or
- * directory in question.
+ * This function replaces the library version of chdir().
*
* Results:
- * Returns 1 if the shortcut could be resolved, or 0 if there was
- * an error or if the filename was not a shortcut.
- * If bufferPtr did hold the name of a shortcut, it is modified to
- * hold the resolved target of the shortcut instead.
+ * See chdir() documentation.
*
* Side effects:
- * Loads and unloads OLE package to determine if filename refers to
- * a shortcut.
+ * See chdir() documentation.
*
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
-TclWinResolveShortcut(bufferPtr)
- Tcl_DString *bufferPtr; /* Holds name of file to resolve. On
- * return, holds resolved file name. */
+TclpChdir(path)
+ CONST char *path; /* Path to new working directory (UTF-8). */
{
- HRESULT hres;
- IShellLink *psl;
- IPersistFile *ppf;
- WIN32_FIND_DATA wfd;
- WCHAR wpath[MAX_PATH];
- char *path, *ext;
- char realFileName[MAX_PATH];
+ int result;
+ Tcl_DString ds;
+ TCHAR *nativePath;
+
+ nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+ result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
+ Tcl_DStringFree(&ds);
+
+#ifdef __CYGWIN__
+ /* We use chdir on Cygwin which follows POSIX return code. */
+ result = !result;
+#endif
+
+ if (result == 0) {
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ return 0;
+}
+
+#ifdef __CYGWIN__
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpReadlink --
+ *
+ * This function replaces the library version of readlink().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the contents
+ * of the symbolic link given by 'path', or NULL if the symbolic
+ * link could not be read. Storage for the result string is
+ * allocated in bufferPtr; the caller must call Tcl_DStringFree()
+ * when the result is no longer needed.
+ *
+ * Side effects:
+ * See readlink() documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclpReadlink(path, linkPtr)
+ CONST char *path; /* Path of file to readlink (UTF-8). */
+ Tcl_DString *linkPtr; /* Uninitialized or free DString filled
+ * with contents of link (UTF-8). */
+{
+ char link[MAXPATHLEN];
+ int length;
+ char *native;
+ Tcl_DString ds;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ length = readlink(native, link, sizeof(link)); /* INTL: Native. */
+ Tcl_DStringFree(&ds);
+
+ if (length < 0) {
+ return NULL;
+ }
+
+ Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
+ return Tcl_DStringValue(linkPtr);
+}
+#endif /* __CYGWIN__ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetCwd --
+ *
+ * This function replaces the library version of getcwd().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the current
+ * directory, or NULL if the current directory could not be
+ * determined. If NULL is returned, an error message is left in the
+ * interp's result. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetCwd(interp, bufferPtr)
+ Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name of current directory. */
+{
+ WCHAR buffer[MAX_PATH];
+ char *p;
+
+ if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
+ TclWinConvertError(GetLastError());
+ if (interp != NULL) {
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return NULL;
+ }
/*
- * Windows system calls do not automatically resolve
- * shortcuts like UNIX automatically will with symbolic links.
+ * Watch for the wierd Windows c:\\UNC syntax.
*/
- path = Tcl_DStringValue(bufferPtr);
- ext = strrchr(path, '.');
- if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
- return 0;
- }
+ if (tclWinProcs->useWide) {
+ WCHAR *native;
- CoInitialize(NULL);
- path = Tcl_DStringValue(bufferPtr);
- realFileName[0] = '\0';
- hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
- &IID_IShellLink, &psl);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
- if (SUCCEEDED(hres)) {
- MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
- hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->Resolve(psl, NULL,
- SLR_ANY_MATCH | SLR_NO_UI);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
- &wfd, 0);
- }
- }
- ppf->lpVtbl->Release(ppf);
- }
- psl->lpVtbl->Release(psl);
- }
- CoUninitialize();
+ native = (WCHAR *) buffer;
+ if ((native[0] != '\0') && (native[1] == ':')
+ && (native[2] == '\\') && (native[3] == '\\')) {
+ native += 2;
+ }
+ Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
+ } else {
+ char *native;
- if (realFileName[0] != '\0') {
- Tcl_DStringSetLength(bufferPtr, 0);
- Tcl_DStringAppend(bufferPtr, realFileName, -1);
- return 1;
+ native = (char *) buffer;
+ if ((native[0] != '\0') && (native[1] == ':')
+ && (native[2] == '\\') && (native[3] == '\\')) {
+ native += 2;
+ }
+ Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
}
- return 0;
+
+ /*
+ * Convert to forward slashes for easier use in scripts.
+ */
+
+ for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ return Tcl_DStringValue(bufferPtr);
}
-#endif
/*
*----------------------------------------------------------------------
*
- * TclpStat, TclpLstat --
+ * TclpStat --
*
- * These functions replace the library versions of stat and lstat.
+ * This function replaces the library version of stat(), fixing
+ * the following bugs:
*
- * The stat and lstat functions provided by some Windows compilers
- * are incomplete. Ideally, a complete rewrite of stat would go
- * here; now, the only fix is that stat("c:") used to return an
- * error instead infor for current dir on specified drive.
+ * 1. stat("c:") returns an error.
+ * 2. Borland stat() return time in GMT instead of localtime.
+ * 3. stat("\\server\mount") would return error.
+ * 4. Accepts slashes or backslashes.
+ * 5. st_dev and st_rdev were wrong for UNC paths.
*
* Results:
* See stat documentation.
@@ -549,25 +823,164 @@ TclWinResolveShortcut(bufferPtr)
*/
int
-TclpStat(path, buf)
- CONST char *path; /* Path of file to stat (in current CP). */
- struct stat *buf; /* Filled with results of stat call. */
+TclpStat(path, statPtr)
+ CONST char *path; /* Path of file to stat (UTF-8). */
+ struct stat *statPtr; /* Filled with results of stat call. */
{
- char name[4];
- int result;
+ Tcl_DString ds;
+ TCHAR *nativePath;
+ WIN32_FIND_DATAT data;
+ HANDLE handle;
+ DWORD attr;
+ WCHAR nativeFullPath[MAX_PATH];
+ TCHAR *nativePart;
+ char *p, *fullPath;
+ int dev, mode;
- if ((strlen(path) == 2) && (path[1] == ':')) {
- strcpy(name, path);
- name[2] = '.';
- name[3] = '\0';
- path = name;
+ /*
+ * Eliminate file names containing wildcard characters, or subsequent
+ * call to FindFirstFile() will expand them, matching some other file.
+ */
+
+ if (strpbrk(path, "?*") != NULL) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
}
-#undef stat
+ nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+ handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * FindFirstFile() doesn't work on root directories, so call
+ * GetFileAttributes() to see if the specified file exists.
+ */
+
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr == 0xffffffff) {
+ Tcl_DStringFree(&ds);
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+
+ /*
+ * Make up some fake information for this file. It has the
+ * correct file attributes and a time of 0.
+ */
+
+ memset(&data, 0, sizeof(data));
+ data.a.dwFileAttributes = attr;
+ } else {
+ FindClose(handle);
+ }
- result = stat(path, buf);
+ (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
+ &nativePart);
+
+ Tcl_DStringFree(&ds);
+ fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
+
+ dev = -1;
+ if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
+ char *p;
+ DWORD dw;
+ TCHAR *nativeVol;
+ Tcl_DString volString;
+
+ p = strchr(fullPath + 2, '\\');
+ p = strchr(p + 1, '\\');
+ if (p == NULL) {
+ /*
+ * Add terminating backslash to fullpath or
+ * GetVolumeInformation() won't work.
+ */
+
+ fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ p = fullPath + Tcl_DStringLength(&ds);
+ } else {
+ p++;
+ }
+ nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
+ dw = (DWORD) -1;
+ (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
+ NULL, NULL, NULL, 0);
+ /*
+ * GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
+ * but GetVolumeInformation() returns failure for "\\.\NUL". This
+ * will cause "NUL" to get a drive number of -1, which makes about
+ * as much sense as anything since the special devices don't live on
+ * any drive.
+ */
+
+ dev = dw;
+ Tcl_DStringFree(&volString);
+ } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
+ dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
+ }
+ Tcl_DStringFree(&ds);
+
+ attr = data.a.dwFileAttributes;
+ mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
+ mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;
+ p = strrchr(path, '.');
+ if (p != NULL) {
+ if ((lstrcmpiA(p, ".exe") == 0)
+ || (lstrcmpiA(p, ".com") == 0)
+ || (lstrcmpiA(p, ".bat") == 0)
+ || (lstrcmpiA(p, ".pif") == 0)) {
+ mode |= S_IEXEC;
+ }
+ }
+
+ /*
+ * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and
+ * other positions.
+ */
+
+ mode |= (mode & 0x0700) >> 3;
+ mode |= (mode & 0x0700) >> 6;
+
+ statPtr->st_dev = (dev_t) dev;
+ statPtr->st_ino = 0;
+ statPtr->st_mode = (unsigned short) mode;
+ statPtr->st_nlink = 1;
+ statPtr->st_uid = 0;
+ statPtr->st_gid = 0;
+ statPtr->st_rdev = (dev_t) dev;
+ statPtr->st_size = data.a.nFileSizeLow;
+ statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
+ return 0;
+}
+
+static time_t
+ToCTime(
+ FILETIME fileTime) /* UTC Time to convert to local time_t. */
+{
+ FILETIME localFileTime;
+ SYSTEMTIME systemTime;
+ struct tm tm;
+
+ if (FileTimeToLocalFileTime(&fileTime, &localFileTime) == 0) {
+ return 0;
+ }
+ if (FileTimeToSystemTime(&localFileTime, &systemTime) == 0) {
+ return 0;
+ }
+ tm.tm_sec = systemTime.wSecond;
+ tm.tm_min = systemTime.wMinute;
+ tm.tm_hour = systemTime.wHour;
+ tm.tm_mday = systemTime.wDay;
+ tm.tm_mon = systemTime.wMonth - 1;
+ tm.tm_year = systemTime.wYear - 1900;
+ tm.tm_wday = 0;
+ tm.tm_yday = 0;
+ tm.tm_isdst = -1;
+
+ return mktime(&tm);
+}
-#if ! defined (_MSC_VER) && ! defined (__CYGWIN32__)
+#if 0
/*
* Borland's stat doesn't take into account localtime.
@@ -590,66 +1003,84 @@ TclpStat(path, buf)
#endif
- return result;
-}
-
+
+#if 0
/*
- *---------------------------------------------------------------------------
- *
- * TclpAccess --
+ *-------------------------------------------------------------------------
*
- * This function replaces the library version of access.
+ * TclWinResolveShortcut --
*
- * The library version of access returns that all files have execute
- * permission.
+ * Resolve a potential Windows shortcut to get the actual file or
+ * directory in question.
*
* Results:
- * See access documentation.
+ * Returns 1 if the shortcut could be resolved, or 0 if there was
+ * an error or if the filename was not a shortcut.
+ * If bufferPtr did hold the name of a shortcut, it is modified to
+ * hold the resolved target of the shortcut instead.
*
* Side effects:
- * See access documentation.
+ * Loads and unloads OLE package to determine if filename refers to
+ * a shortcut.
*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
int
-TclpAccess(
- CONST char *path, /* Path of file to access (in current CP). */
- int mode) /* Permission setting. */
+TclWinResolveShortcut(bufferPtr)
+ Tcl_DString *bufferPtr; /* Holds name of file to resolve. On
+ * return, holds resolved file name. */
{
- int result;
- CONST char *p;
-
-#undef access
+ HRESULT hres;
+ IShellLink *psl;
+ IPersistFile *ppf;
+ WIN32_FIND_DATA wfd;
+ WCHAR wpath[MAX_PATH];
+ char *path, *ext;
+ char realFileName[MAX_PATH];
- result = access(path, mode);
+ /*
+ * Windows system calls do not automatically resolve
+ * shortcuts like UNIX automatically will with symbolic links.
+ */
- if (result == 0) {
- if (mode & 1) {
- if (GetFileAttributes(path) & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Directories are always executable.
- */
+ path = Tcl_DStringValue(bufferPtr);
+ ext = strrchr(path, '.');
+ if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
+ return 0;
+ }
- return 0;
- }
- p = strrchr(path, '.');
- if (p != NULL) {
- p++;
- if ((stricmp(p, "exe") == 0)
- || (stricmp(p, "com") == 0)
- || (stricmp(p, "bat") == 0)) {
- /*
- * File that ends with .exe, .com, or .bat is executable.
- */
+ CoInitialize(NULL);
+ path = Tcl_DStringValue(bufferPtr);
+ realFileName[0] = '\0';
+ hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
+ &IID_IShellLink, &psl);
+ if (SUCCEEDED(hres)) {
+ hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
+ if (SUCCEEDED(hres)) {
+ MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
+ hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
+ if (SUCCEEDED(hres)) {
+ hres = psl->lpVtbl->Resolve(psl, NULL,
+ SLR_ANY_MATCH | SLR_NO_UI);
+ if (SUCCEEDED(hres)) {
+ hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
+ &wfd, 0);
+ }
+ }
+ ppf->lpVtbl->Release(ppf);
+ }
+ psl->lpVtbl->Release(psl);
+ }
+ CoUninitialize();
- return 0;
- }
- }
- errno = EACCES;
- return -1;
- }
+ if (realFileName[0] != '\0') {
+ Tcl_DStringSetLength(bufferPtr, 0);
+ Tcl_DStringAppend(bufferPtr, realFileName, -1);
+ return 1;
}
- return result;
+ return 0;
}
+#endif
+
diff --git a/tcl/win/tclWinInit.c b/tcl/win/tclWinInit.c
index c06e8314fd7..b96154aa7fb 100644
--- a/tcl/win/tclWinInit.c
+++ b/tcl/win/tclWinInit.c
@@ -3,16 +3,14 @@
*
* Contains the Windows-specific interpreter initialization functions.
*
- * Copyright (c) 1994-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.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * All rights reserved.
*
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
+#include "tclWinInt.h"
#include <winreg.h>
#include <winnt.h>
#include <winbase.h>
@@ -75,78 +73,496 @@ static char* processors[NUMPROCESSORS] = {
};
/*
- * The Init script, tclPreInitScript variable, and the routine
- * TclSetPreInitScript (common to Windows and Unix platforms) are defined
- * in generic/tclInitScript.h
+ * Thread id used for asynchronous notification from signal handlers.
+ */
+
+static DWORD mainThreadId;
+
+/*
+ * The Init script (common to Windows and Unix platforms) is
+ * defined in tkInitScript.h
*/
#include "tclInitScript.h"
+static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib);
+static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule,
+ CONST char *lib);
+static void AppendRegistry(Tcl_Obj *listPtr, CONST char *lib);
+static int ToUtf(CONST WCHAR *wSrc, char *dst);
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
+ *
+ * TclpInitPlatform --
*
- * TclPlatformInit --
+ * Initialize all the platform-dependant things like signals and
+ * floating-point error handling.
*
- * Performs Windows-specific interpreter initialization related to the
- * tcl_library variable. Also sets up the HOME environment variable
- * if it is not already set.
+ * Called at process initialization time.
*
* Results:
* None.
*
* Side effects:
- * Sets "tcl_library" and "env(HOME)" Tcl variables
+ * None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
void
-TclPlatformInit(interp)
- Tcl_Interp *interp;
+TclpInitPlatform()
{
- char *p;
- char buffer[13];
- Tcl_DString ds;
- OSVERSIONINFO osInfo;
- SYSTEM_INFO sysInfo;
- int isWin32s; /* True if we are running under Win32s. */
- OemId *oemId;
- HKEY key;
- DWORD size, result, type;
-
tclPlatform = TCL_PLATFORM_WINDOWS;
+ /*
+ * The following code stops Windows 3.X and Windows NT 3.51 from
+ * automatically putting up Sharing Violation dialogs, e.g, when
+ * someone tries to access a file that is locked or a drive with no
+ * disk in it. Tcl already returns the appropriate error to the
+ * caller, and they can decide to put up their own dialog in response
+ * to that failure.
+ *
+ * Under 95 and NT 4.0, this is a NOOP because the system doesn't
+ * automatically put up dialogs when the above operations fail.
+ */
+
+ SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+
+ /*
+ * Save the id of the first thread to intialize the Tcl library. This
+ * thread will be used to handle notifications from async event
+ * procedures. This is not strictly correct. A better solution involves
+ * using a designated "main" notifier that is kept up to date as threads
+ * come and go.
+ */
+
+ mainThreadId = GetCurrentThreadId();
+
+#ifdef STATIC_BUILD
+ /*
+ * If we are in a statically linked executable, then we need to
+ * explicitly initialize the Windows function tables here since
+ * DllMain() will not be invoked.
+ */
+
+ TclWinInit(GetModuleHandle(NULL));
+#endif
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpInitLibraryPath --
+ *
+ * Initialize the library path at startup.
+ *
+ * This call sets the library path to strings in UTF-8. Any
+ * pre-existing library path information is assumed to have been
+ * in the native multibyte encoding.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclpInitLibraryPath(path)
+ CONST char *path; /* Potentially dirty UTF string that is */
+ /* the path to the executable name. */
+{
+#define LIBRARY_SIZE 32
+ Tcl_Obj *pathPtr, *objPtr;
+ char *str;
+ Tcl_DString ds;
+ int pathc;
+ char **pathv;
+ char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
+
Tcl_DStringInit(&ds);
+ pathPtr = Tcl_NewObj();
+
+ /*
+ * Initialize the substrings used when locating an executable. The
+ * installLib variable computes the path as though the executable
+ * is installed. The developLib computes the path as though the
+ * executable is run from a develpment directory.
+ */
+
+ /* CYGNUS LOCAL */
+ sprintf(installLib, "share/tcl%s", TCL_VERSION);
+ /* END CYGNUS LOCAL */
+ sprintf(developLib, "../tcl%s/library",
+ ((TCL_RELEASE_LEVEL < 2) ? TCL_PATCH_LEVEL : TCL_VERSION));
/*
- * Find out what kind of system we are running on.
+ * Look for the library relative to default encoding dir.
*/
- osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&osInfo);
+ str = Tcl_GetDefaultEncodingDir();
+ if ((str != NULL) && (str[0] != '\0')) {
+ objPtr = Tcl_NewStringObj(str, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ }
+
+ /*
+ * Look for the library relative to the TCL_LIBRARY env variable.
+ * If the last dirname in the TCL_LIBRARY path does not match the
+ * last dirname in the installLib variable, use the last dir name
+ * of installLib in addition to the orginal TCL_LIBRARY path.
+ */
- isWin32s = (osInfo.dwPlatformId == VER_PLATFORM_WIN32s);
+ AppendEnvironment(pathPtr, installLib);
/*
- * Since Win32s doesn't support GetSystemInfo, we use a default value.
+ * Look for the library relative to the DLL. Only use the installLib
+ * because in practice, the DLL is always installed.
*/
- oemId = (OemId *) &sysInfo;
- if (!isWin32s) {
- GetSystemInfo(&sysInfo);
+ AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib);
+
+
+ /*
+ * Look for the library relative to the executable. This algorithm
+ * should be the same as the one in the tcl_findLibrary procedure.
+ *
+ * This code looks in the following directories:
+ *
+ * <bindir>/../<installLib>
+ * (e.g. /usr/local/bin/../lib/tcl8.2)
+ * <bindir>/../../<installLib>
+ * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.2)
+ * <bindir>/../library
+ * (e.g. /usr/src/tcl8.2/unix/../library)
+ * <bindir>/../../library
+ * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../library)
+ * <bindir>/../../<developLib>
+ * (e.g. /usr/src/tcl8.2/unix/../../tcl8.2/library)
+ * <bindir>/../../../<devlopLib>
+ * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library)
+ */
+
+ if (path != NULL) {
+ Tcl_SplitPath(path, &pathc, &pathv);
+ if (pathc > 1) {
+ pathv[pathc - 2] = installLib;
+ path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 2) {
+ pathv[pathc - 3] = installLib;
+ path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 1) {
+ pathv[pathc - 2] = "library";
+ path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 2) {
+ pathv[pathc - 3] = "library";
+ path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 1) {
+ pathv[pathc - 3] = developLib;
+ path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ if (pathc > 3) {
+ pathv[pathc - 4] = developLib;
+ path = Tcl_JoinPath(pathc - 3, pathv, &ds);
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ ckfree((char *) pathv);
+ }
+
+ TclSetLibraryPath(pathPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * AppendEnvironment --
+ *
+ * Append the value of the TCL_LIBRARY environment variable onto the
+ * path pointer. If the env variable points to another version of
+ * tcl (e.g. "tcl7.6") also append the path to this version (e.g.,
+ * "tcl7.6/../tcl8.2")
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+AppendEnvironment(
+ Tcl_Obj *pathPtr,
+ CONST char *lib)
+{
+ int pathc;
+ WCHAR wBuf[MAX_PATH];
+ char buf[MAX_PATH * TCL_UTF_MAX];
+ Tcl_Obj *objPtr;
+ char *str;
+ Tcl_DString ds;
+ char **pathv;
+
+ /*
+ * The "L" preceeding the TCL_LIBRARY string is used to tell VC++
+ * that this is a unicode string.
+ */
+
+ if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
+ buf[0] = '\0';
+ GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
} else {
- oemId->wProcessorArchitecture = PROCESSOR_ARCHITECTURE_INTEL;
+ ToUtf(wBuf, buf);
}
- /* CYGNUS LOCAL: don't set tclDefaultLibrary from the registry; instead
- always compute it at runtime. We do have to set it to
- something, though, so that initScript will work correctly. */
+ if (buf[0] != '\0') {
+ objPtr = Tcl_NewStringObj(buf, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+
+ TclWinNoBackslash(buf);
+ Tcl_SplitPath(buf, &pathc, &pathv);
+
+ /*
+ * The lstrcmpi() will work even if pathv[pathc - 1] is random
+ * UTF-8 chars because I know lib is ascii.
+ */
+
+ if ((pathc > 0) && (lstrcmpiA(lib + 4, pathv[pathc - 1]) != 0)) {
+ /*
+ * TCL_LIBRARY is set but refers to a different tcl
+ * installation than the current version. Try fiddling with the
+ * specified directory to make it refer to this installation by
+ * removing the old "tclX.Y" and substituting the current
+ * version string.
+ */
+
+ pathv[pathc - 1] = (char *) (lib + 4);
+ Tcl_DStringInit(&ds);
+ str = Tcl_JoinPath(pathc, pathv, &ds);
+ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ } else {
+ objPtr = Tcl_NewStringObj(buf, -1);
+ }
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ ckfree((char *) pathv);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * AppendDllPath --
+ *
+ * Append a path onto the path pointer that tries to locate the Tcl
+ * library relative to the location of the Tcl DLL.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+AppendDllPath(
+ Tcl_Obj *pathPtr,
+ HMODULE hModule,
+ CONST char *lib)
+{
+ WCHAR wName[MAX_PATH + LIBRARY_SIZE];
+ char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+
+ if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
+ GetModuleFileNameA(hModule, name, MAX_PATH);
+ } else {
+ ToUtf(wName, name);
+ }
+ if (lib != NULL) {
+ char *end, *p;
+
+ end = strrchr(name, '\\');
+ *end = '\0';
+ p = strrchr(name, '\\');
+ if (p != NULL) {
+ end = p;
+ }
+ *end = '\\';
+ strcpy(end + 1, lib);
+ }
+ TclWinNoBackslash(name);
+ Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ToUtf --
+ *
+ * Convert a char string to a UTF string.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ToUtf(
+ CONST WCHAR *wSrc,
+ char *dst)
+{
+ char *start;
+
+ start = dst;
+ while (*wSrc != '\0') {
+ dst += Tcl_UniCharToUtf(*wSrc, dst);
+ wSrc++;
+ }
+ *dst = '\0';
+ return dst - start;
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpSetInitialEncodings --
+ *
+ * Based on the locale, determine the encoding of the operating
+ * system and the default encoding for newly opened files.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The Tcl library path is converted from native encoding to UTF-8.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclpSetInitialEncodings()
+{
+ CONST char *encoding;
+ char buf[4 + TCL_INTEGER_SPACE];
+ int platformId;
+ Tcl_Obj *pathPtr;
+
+ platformId = TclWinGetPlatformId();
+
+ TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT);
+
+ wsprintfA(buf, "cp%d", GetACP());
+ Tcl_SetSystemEncoding(NULL, buf);
+
+ if (platformId != VER_PLATFORM_WIN32_NT) {
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int i, objc;
+ Tcl_Obj **objv;
+
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ for (i = 0; i < objc; i++) {
+ int length;
+ char *string;
+ Tcl_DString ds;
+
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ }
+ }
+
+ /*
+ * Keep this encoding preloaded. The IO package uses it for gets on a
+ * binary channel.
+ */
+
+ encoding = "iso8859-1";
+ Tcl_GetEncoding(NULL, encoding);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpSetVariables --
+ *
+ * Performs platform-specific interpreter initialization related to
+ * the tcl_platform and env variables, and other platform-specific
+ * things.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets "tclDefaultLibrary", "tcl_platform", and "env(HOME)" Tcl
+ * variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpSetVariables(interp)
+ Tcl_Interp *interp; /* Interp to initialize. */
+{
+ char *ptr;
+ char buffer[TCL_INTEGER_SPACE * 2];
+ SYSTEM_INFO sysInfo;
+ OemId *oemId;
+ OSVERSIONINFOA osInfo;
+ Tcl_DString ds;
+
+ osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+ GetVersionExA(&osInfo);
+
+ oemId = (OemId *) &sysInfo;
+ GetSystemInfo(&sysInfo);
+
+ /*
+ * Initialize the tclDefaultLibrary variable from the registry.
+ */
+
Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
- /* ditto, but this is a hack - dj */
- Tcl_SetVar(interp, "tcl_pkgPath", "", TCL_GLOBAL_ONLY);
- /* END CYGNUS LOCAL */
-
+
/*
* Define the tcl_platform array.
*/
@@ -157,7 +573,7 @@ TclPlatformInit(interp)
Tcl_SetVar2(interp, "tcl_platform", "os",
platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
}
- sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
+ wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
Tcl_SetVar2(interp, "tcl_platform", "machine",
@@ -174,7 +590,7 @@ TclPlatformInit(interp)
*/
Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
- TCL_GLOBAL_ONLY);
+ TCL_GLOBAL_ONLY);
#endif
/*
@@ -182,16 +598,16 @@ TclPlatformInit(interp)
* environment variables, if necessary.
*/
- p = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
- if (p == NULL) {
- Tcl_DStringSetLength(&ds, 0);
- p = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
- if (p != NULL) {
- Tcl_DStringAppend(&ds, p, -1);
+ Tcl_DStringInit(&ds);
+ ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
+ if (ptr == NULL) {
+ ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
+ if (ptr != NULL) {
+ Tcl_DStringAppend(&ds, ptr, -1);
}
- p = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
- if (p != NULL) {
- Tcl_DStringAppend(&ds, p, -1);
+ ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
+ if (ptr != NULL) {
+ Tcl_DStringAppend(&ds, ptr, -1);
}
if (Tcl_DStringLength(&ds) > 0) {
Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
@@ -201,61 +617,143 @@ TclPlatformInit(interp)
}
}
+ /*
+ * Initialize the user name from the environment first, since this is much
+ * faster than asking the system.
+ */
+
+ Tcl_DStringSetLength(&ds, 100);
+ if (TclGetEnv("USERNAME", &ds) == NULL) {
+ if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) == 0) {
+ Tcl_DStringSetLength(&ds, 0);
+ }
+ }
+ Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
+ TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
}
/*
*----------------------------------------------------------------------
*
- * Tcl_Init --
+ * TclpFindVariable --
*
- * This procedure is typically invoked by Tcl_AppInit procedures
- * to perform additional initialization for a Tcl interpreter,
- * such as sourcing the "init.tcl" script.
+ * Locate the entry in environ for a given name. On Unix this
+ * routine is case sensetive, on Windows this matches mioxed case.
*
* Results:
- * Returns a standard Tcl completion code and sets interp->result
- * if there is an error.
+ * The return value is the index in environ of an entry with the
+ * name "name", or -1 if there is no such entry. The integer at
+ * *lengthPtr is filled in with the length of name (if a matching
+ * entry is found) or the length of the environ array (if no matching
+ * entry is found).
*
* Side effects:
- * Depends on what's in the init.tcl script.
+ * None.
*
*----------------------------------------------------------------------
*/
int
-Tcl_Init(interp)
- Tcl_Interp *interp; /* Interpreter to initialize. */
+TclpFindVariable(name, lengthPtr)
+ CONST char *name; /* Name of desired environment variable
+ * (UTF-8). */
+ int *lengthPtr; /* Used to return length of name (for
+ * successful searches) or number of non-NULL
+ * entries in environ (for unsuccessful
+ * searches). */
{
- if (tclPreInitScript != NULL) {
- if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
- return (TCL_ERROR);
- };
+ int i, length, result = -1;
+ register CONST char *env, *p1, *p2;
+ char *envUpper, *nameUpper;
+ Tcl_DString envString;
+
+ /*
+ * Convert the name to all upper case for the case insensitive
+ * comparison.
+ */
+
+ length = strlen(name);
+ nameUpper = (char *) ckalloc((unsigned) length+1);
+ memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1);
+ Tcl_UtfToUpper(nameUpper);
+
+ Tcl_DStringInit(&envString);
+ for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
+ /*
+ * Chop the env string off after the equal sign, then Convert
+ * the name to all upper case, so we do not have to convert
+ * all the characters after the equal sign.
+ */
+
+ envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
+ p1 = strchr(envUpper, '=');
+ if (p1 == NULL) {
+ continue;
+ }
+ length = p1 - envUpper;
+ Tcl_DStringSetLength(&envString, length+1);
+ Tcl_UtfToUpper(envUpper);
+
+ p1 = envUpper;
+ p2 = nameUpper;
+ for (; *p2 == *p1; p1++, p2++) {
+ /* NULL loop body. */
+ }
+ if ((*p1 == '=') && (*p2 == '\0')) {
+ *lengthPtr = length;
+ result = i;
+ goto done;
+ }
+
+ Tcl_DStringFree(&envString);
}
- return(Tcl_Eval(interp, initScript));
+
+ *lengthPtr = i;
+
+ done:
+ Tcl_DStringFree(&envString);
+ ckfree(nameUpper);
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * TclWinGetPlatform --
+ * Tcl_Init --
*
- * This is a kludge that allows the test library to get access
- * the internal tclPlatform variable.
+ * This procedure is typically invoked by Tcl_AppInit procedures
+ * to perform additional initialization for a Tcl interpreter,
+ * such as sourcing the "init.tcl" script.
*
* Results:
- * Returns a pointer to the tclPlatform variable.
+ * Returns a standard Tcl completion code and sets the interp's
+ * result if there is an error.
*
* Side effects:
- * None.
+ * Depends on what's in the init.tcl script.
*
*----------------------------------------------------------------------
*/
-TclPlatformType *
-TclWinGetPlatform()
+int
+Tcl_Init(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
{
- return &tclPlatform;
+ Tcl_Obj *pathPtr;
+
+ if (tclPreInitScript != NULL) {
+ if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
+ return (TCL_ERROR);
+ };
+ }
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr == NULL) {
+ pathPtr = Tcl_NewObj();
+ }
+ Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
+ return Tcl_Eval(interp, initScript);
}
/*
@@ -310,8 +808,8 @@ Tcl_SourceRCFile(interp)
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
}
}
@@ -319,3 +817,34 @@ Tcl_SourceRCFile(interp)
Tcl_DStringFree(&temp);
}
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpAsyncMark --
+ *
+ * Wake up the main thread from a signal handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sends a message to the main thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpAsyncMark(async)
+ Tcl_AsyncHandler async; /* Token for handler. */
+{
+ /*
+ * Need a way to kick the Windows event loop and tell it to go look at
+ * asynchronous events.
+ */
+
+ PostThreadMessage(mainThreadId, WM_USER, 0, 0);
+}
+
+
+
diff --git a/tcl/win/tclWinInt.h b/tcl/win/tclWinInt.h
index 915c3083624..e375dd87480 100644
--- a/tcl/win/tclWinInt.h
+++ b/tcl/win/tclWinInt.h
@@ -21,6 +21,14 @@
#include "tclPort.h"
#endif
+/*
+ * The following specifies how much stack space TclpCheckStackSpace()
+ * ensures is available. TclpCheckStackSpace() is called by Tcl_EvalObj()
+ * to help avoid overflowing the stack in the case of infinite recursion.
+ */
+
+#define TCL_WIN_STACK_THRESHOLD 0x2000
+
#ifdef BUILD_tcl
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
@@ -35,12 +43,69 @@
#define VER_PLATFORM_WIN32_WINDOWS 1
#endif
-EXTERN int TclWinGetPlatformId(void);
+/*
+ * The following structure keeps track of whether we are using the
+ * multi-byte or the wide-character interfaces to the operating system.
+ * System calls should be made through the following function table.
+ */
+
+typedef union {
+ WIN32_FIND_DATAA a;
+ WIN32_FIND_DATAW w;
+} WIN32_FIND_DATAT;
+
+typedef struct TclWinProcs {
+ int useWide;
+
+ BOOL (WINAPI *buildCommDCBProc)(CONST TCHAR *, LPDCB);
+ TCHAR *(WINAPI *charLowerProc)(TCHAR *);
+ BOOL (WINAPI *copyFileProc)(CONST TCHAR *, CONST TCHAR *, BOOL);
+ BOOL (WINAPI *createDirectoryProc)(CONST TCHAR *, LPSECURITY_ATTRIBUTES);
+ HANDLE (WINAPI *createFileProc)(CONST TCHAR *, DWORD, DWORD,
+ LPSECURITY_ATTRIBUTES, DWORD, DWORD, HANDLE);
+ BOOL (WINAPI *createProcessProc)(CONST TCHAR *, TCHAR *,
+ LPSECURITY_ATTRIBUTES, LPSECURITY_ATTRIBUTES, BOOL, DWORD,
+ LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION);
+ BOOL (WINAPI *deleteFileProc)(CONST TCHAR *);
+ HANDLE (WINAPI *findFirstFileProc)(CONST TCHAR *, WIN32_FIND_DATAT *);
+ BOOL (WINAPI *findNextFileProc)(HANDLE, WIN32_FIND_DATAT *);
+ BOOL (WINAPI *getComputerNameProc)(WCHAR *, LPDWORD);
+ DWORD (WINAPI *getCurrentDirectoryProc)(DWORD, WCHAR *);
+ DWORD (WINAPI *getFileAttributesProc)(CONST TCHAR *);
+ DWORD (WINAPI *getFullPathNameProc)(CONST TCHAR *, DWORD nBufferLength,
+ WCHAR *, TCHAR **);
+ DWORD (WINAPI *getModuleFileNameProc)(HMODULE, WCHAR *, int);
+ DWORD (WINAPI *getShortPathNameProc)(CONST TCHAR *, WCHAR *, DWORD);
+ UINT (WINAPI *getTempFileNameProc)(CONST TCHAR *, CONST TCHAR *, UINT,
+ WCHAR *);
+ DWORD (WINAPI *getTempPathProc)(DWORD, WCHAR *);
+ BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *, WCHAR *, DWORD,
+ LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD);
+ HINSTANCE (WINAPI *loadLibraryProc)(CONST TCHAR *);
+ TCHAR (WINAPI *lstrcpyProc)(WCHAR *, CONST TCHAR *);
+ BOOL (WINAPI *moveFileProc)(CONST TCHAR *, CONST TCHAR *);
+ BOOL (WINAPI *removeDirectoryProc)(CONST TCHAR *);
+ DWORD (WINAPI *searchPathProc)(CONST TCHAR *, CONST TCHAR *,
+ CONST TCHAR *, DWORD, WCHAR *, TCHAR **);
+ BOOL (WINAPI *setCurrentDirectoryProc)(CONST TCHAR *);
+ BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD);
+} TclWinProcs;
+
+EXTERN TclWinProcs *tclWinProcs;
+EXTERN Tcl_Encoding tclWinTCharEncoding;
+
+/*
+ * Declarations of functions that are not accessible by way of the
+ * stubs table.
+ */
+
EXTERN void TclWinInit(HINSTANCE hInst);
-EXTERN int TclWinSynchSpawn(void *args, int type, void **trans,
- Tcl_Pid *pidPtr);
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT
+#include "tclIntPlatDecls.h"
+
#endif /* _TCLWININT */
+
+
diff --git a/tcl/win/tclWinLoad.c b/tcl/win/tclWinLoad.c
index 9709aa9966c..c27cfd3f3c2 100644
--- a/tcl/win/tclWinLoad.c
+++ b/tcl/win/tclWinLoad.c
@@ -5,7 +5,7 @@
* works with the Windows "LoadLibrary" and "GetProcAddress"
* API for dynamic loading.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -13,14 +13,13 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
+#include "tclWinInt.h"
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpLoadFile --
*
* Dynamically loads a binary code file into memory and returns
* the addresses of two procedures within that file, if they
@@ -28,7 +27,7 @@
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in interp->result.
+ * message is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -37,7 +36,7 @@
*/
int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
+TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
* code. */
@@ -46,14 +45,64 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
HINSTANCE handle;
- char *buffer;
+ TCHAR *nativeName;
+ Tcl_DString ds;
- handle = TclWinLoadLibrary(fileName);
+ nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ handle = (*tclWinProcs->loadLibraryProc)(nativeName);
+ Tcl_DStringFree(&ds);
+
+ *clientDataPtr = (ClientData) handle;
+
if (handle == NULL) {
- Tcl_AppendResult(interp, "couldn't load file \"", fileName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ DWORD lastError = GetLastError();
+#if 0
+ /*
+ * It would be ideal if the FormatMessage stuff worked better,
+ * but unfortunately it doesn't seem to want to...
+ */
+ LPTSTR lpMsgBuf;
+ char *buf;
+ int size;
+ size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
+ FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
+ (LPTSTR) &lpMsgBuf, 0, NULL);
+ buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
+ sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
+#endif
+ Tcl_AppendResult(interp, "couldn't load library \"",
+ fileName, "\": ", (char *) NULL);
+ /*
+ * Check for possible DLL errors. This doesn't work quite right,
+ * because Windows seems to only return ERROR_MOD_NOT_FOUND for
+ * just about any problem, but it's better than nothing. It'd be
+ * even better if there was a way to get what DLLs
+ */
+ switch (lastError) {
+ case ERROR_MOD_NOT_FOUND:
+ case ERROR_DLL_NOT_FOUND:
+ Tcl_AppendResult(interp, "this library or a dependent library",
+ " could not be found in library path", (char *)
+ NULL);
+ break;
+ case ERROR_INVALID_DLL:
+ Tcl_AppendResult(interp, "this library or a dependent library",
+ " is damaged", (char *) NULL);
+ break;
+ case ERROR_DLL_INIT_FAILED:
+ Tcl_AppendResult(interp, "the library initialization",
+ " routine failed", (char *) NULL);
+ break;
+ default:
+ TclWinConvertError(lastError);
+ Tcl_AppendResult(interp, Tcl_PosixError(interp),
+ (char *) NULL);
+ }
return TCL_ERROR;
}
@@ -64,28 +113,56 @@ TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
*proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
if (*proc1Ptr == NULL) {
- buffer = ckalloc(strlen(sym1)+2);
- buffer[0] = '_';
- strcpy(buffer+1, sym1);
- *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, buffer);
- ckfree(buffer);
+ Tcl_DStringAppend(&ds, "_", 1);
+ sym1 = Tcl_DStringAppend(&ds, sym1, -1);
+ *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
+ Tcl_DStringFree(&ds);
}
*proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
if (*proc2Ptr == NULL) {
- buffer = ckalloc(strlen(sym2)+2);
- buffer[0] = '_';
- strcpy(buffer+1, sym2);
- *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, buffer);
- ckfree(buffer);
+ Tcl_DStringAppend(&ds, "_", 1);
+ sym2 = Tcl_DStringAppend(&ds, sym2, -1);
+ *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
+ Tcl_DStringFree(&ds);
}
-
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Code removed from memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+ HINSTANCE handle;
+
+ handle = (HINSTANCE) clientData;
+ FreeLibrary(handle);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
@@ -112,3 +189,5 @@ TclGuessPackageName(fileName, bufPtr)
{
return 0;
}
+
+
diff --git a/tcl/win/tclWinMtherr.c b/tcl/win/tclWinMtherr.c
index 654094a1915..f307a8c2b03 100644
--- a/tcl/win/tclWinMtherr.c
+++ b/tcl/win/tclWinMtherr.c
@@ -12,18 +12,9 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
+#include "tclWinInt.h"
#include <math.h>
-/*
- * The following variable is secretly shared with Tcl so we can
- * tell if expression evaluation is in progress. If not, matherr
- * just emulates the default behavior, which includes printing
- * a message.
- */
-
-extern int tcl_MathInProgress;
/*
*----------------------------------------------------------------------
@@ -49,7 +40,7 @@ int
_matherr(xPtr)
struct exception *xPtr; /* Describes error that occurred. */
{
- if (!tcl_MathInProgress) {
+ if (!TclMathInProgress()) {
return 0;
}
if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
@@ -59,3 +50,5 @@ _matherr(xPtr)
}
return 1;
}
+
+
diff --git a/tcl/win/tclWinNotify.c b/tcl/win/tclWinNotify.c
index 6603bcae85b..46915158b34 100644
--- a/tcl/win/tclWinNotify.c
+++ b/tcl/win/tclWinNotify.c
@@ -13,8 +13,7 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
+#include "tclWinInt.h"
#include <winsock.h>
/*
@@ -23,129 +22,207 @@
static int initialized = 0;
-#define INTERVAL_TIMER 1 /* Handle of interval timer. */
+#define INTERVAL_TIMER 1 /* Handle of interval timer. */
+#define WM_WAKEUP WM_USER /* Message that is send by
+ * Tcl_AlertNotifier. */
/*
* The following static structure contains the state information for the
- * Windows implementation of the Tcl notifier.
+ * Windows implementation of the Tcl notifier. One of these structures
+ * is created for each thread that is using the notifier.
*/
-static struct {
+typedef struct ThreadSpecificData {
+ CRITICAL_SECTION crit; /* Monitor for this notifier. */
+ DWORD thread; /* Identifier for thread associated with this
+ * notifier. */
+ HANDLE event; /* Event object used to wake up the notifier
+ * thread. */
+ int pending; /* Alert message pending, this field is
+ * locked by the notifierMutex. */
HWND hwnd; /* Messaging window. */
int timeout; /* Current timeout value. */
int timerActive; /* 1 if interval timer is running. */
-} notifier;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+extern TclStubs tclStubs;
+/*
+ * The following static indicates the number of threads that have
+ * initialized notifiers. It controls the lifetime of the TclNotifier
+ * window class.
+ *
+ * You must hold the notifierMutex lock before accessing this variable.
+ */
+
+static int notifierCount = 0;
+TCL_DECLARE_MUTEX(notifierMutex)
/*
* Static routines defined in this file.
*/
-static void InitNotifier(void);
-static void NotifierExitHandler(ClientData clientData);
static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message,
WPARAM wParam, LPARAM lParam);
-static void UpdateTimer(int timeout);
+
/*
*----------------------------------------------------------------------
*
- * InitNotifier --
+ * Tcl_InitNotifier --
*
- * Initializes the notifier window.
+ * Initializes the platform specific notifier state.
*
* Results:
- * None.
+ * Returns a handle to the notifier state for this thread..
*
* Side effects:
- * Creates a new notifier window and window class.
+ * None.
*
*----------------------------------------------------------------------
*/
-static void
-InitNotifier(void)
+ClientData
+Tcl_InitNotifier()
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
WNDCLASS class;
- initialized = 1;
- notifier.timerActive = 0;
- class.style = 0;
- class.cbClsExtra = 0;
- class.cbWndExtra = 0;
- class.hInstance = TclWinGetTclInstance();
- class.hbrBackground = NULL;
- class.lpszMenuName = NULL;
- class.lpszClassName = "TclNotifier";
- class.lpfnWndProc = NotifierProc;
- class.hIcon = NULL;
- class.hCursor = NULL;
-
- if (!RegisterClass(&class)) {
- panic("Unable to register TclNotifier window class");
+ /*
+ * Register Notifier window class if this is the first thread to
+ * use this module.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ if (notifierCount == 0) {
+ class.style = 0;
+ class.cbClsExtra = 0;
+ class.cbWndExtra = 0;
+ class.hInstance = TclWinGetTclInstance();
+ class.hbrBackground = NULL;
+ class.lpszMenuName = NULL;
+ class.lpszClassName = "TclNotifier";
+ class.lpfnWndProc = NotifierProc;
+ class.hIcon = NULL;
+ class.hCursor = NULL;
+
+ if (!RegisterClassA(&class)) {
+ panic("Unable to register TclNotifier window class");
+ }
}
- notifier.hwnd = CreateWindow("TclNotifier", "TclNotifier", WS_TILED,
- 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
- Tcl_CreateExitHandler(NotifierExitHandler, NULL);
+ notifierCount++;
+ Tcl_MutexUnlock(&notifierMutex);
+
+ tsdPtr->pending = 0;
+ tsdPtr->timerActive = 0;
+
+ InitializeCriticalSection(&tsdPtr->crit);
+
+ tsdPtr->hwnd = NULL;
+ tsdPtr->thread = GetCurrentThreadId();
+ tsdPtr->event = CreateEvent(NULL, TRUE /* manual */,
+ FALSE /* !signaled */, NULL);
+
+ return (ClientData) tsdPtr;
}
/*
*----------------------------------------------------------------------
*
- * NotifierExitHandler --
+ * Tcl_FinalizeNotifier --
*
* This function is called to cleanup the notifier state before
- * Tcl is unloaded.
+ * a thread is terminated.
*
* Results:
* None.
*
* Side effects:
- * Destroys the notifier window.
+ * May dispose of the notifier window and class.
*
*----------------------------------------------------------------------
*/
-static void
-NotifierExitHandler(
- ClientData clientData) /* Old window proc */
+void
+Tcl_FinalizeNotifier(clientData)
+ ClientData clientData; /* Pointer to notifier data. */
{
- initialized = 0;
- if (notifier.hwnd) {
- KillTimer(notifier.hwnd, INTERVAL_TIMER);
- DestroyWindow(notifier.hwnd);
- UnregisterClass("TclNotifier", TclWinGetTclInstance());
- notifier.hwnd = NULL;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+
+ DeleteCriticalSection(&tsdPtr->crit);
+ CloseHandle(tsdPtr->event);
+
+ /*
+ * Clean up the timer and messaging window for this thread.
+ */
+
+ if (tsdPtr->hwnd) {
+ KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
+ DestroyWindow(tsdPtr->hwnd);
+ }
+
+ /*
+ * If this is the last thread to use the notifier, unregister
+ * the notifier window class.
+ */
+
+ Tcl_MutexLock(&notifierMutex);
+ notifierCount--;
+ if (notifierCount == 0) {
+ UnregisterClassA("TclNotifier", TclWinGetTclInstance());
}
+ Tcl_MutexUnlock(&notifierMutex);
}
/*
*----------------------------------------------------------------------
*
- * UpdateTimer --
+ * Tcl_AlertNotifier --
*
- * This function starts or stops the notifier interval timer.
+ * Wake up the specified notifier from any thread. This routine
+ * is called by the platform independent notifier code whenever
+ * the Tcl_ThreadAlert routine is called. This routine is
+ * guaranteed not to be called on a given notifier after
+ * Tcl_FinalizeNotifier is called for that notifier. This routine
+ * is typically called from a thread other than the notifier's
+ * thread.
*
* Results:
* None.
*
* Side effects:
- * None.
+ * Sends a message to the messaging window for the notifier
+ * if there isn't already one pending.
*
*----------------------------------------------------------------------
*/
void
-UpdateTimer(
- int timeout) /* ms timeout, 0 means cancel timer */
+Tcl_AlertNotifier(clientData)
+ ClientData clientData; /* Pointer to thread data. */
{
- notifier.timeout = timeout;
- if (timeout != 0) {
- notifier.timerActive = 1;
- SetTimer(notifier.hwnd, INTERVAL_TIMER,
- (unsigned long) notifier.timeout, NULL);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+
+ /*
+ * Note that we do not need to lock around access to the hwnd
+ * because the race condition has no effect since any race condition
+ * implies that the notifier thread is already awake.
+ */
+
+ if (tsdPtr->hwnd) {
+ /*
+ * We do need to lock around access to the pending flag.
+ */
+
+ EnterCriticalSection(&tsdPtr->crit);
+ if (!tsdPtr->pending) {
+ PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
+ }
+ tsdPtr->pending = 1;
+ LeaveCriticalSection(&tsdPtr->crit);
} else {
- notifier.timerActive = 0;
- KillTimer(notifier.hwnd, INTERVAL_TIMER);
+ SetEvent(tsdPtr->event);
}
}
@@ -171,10 +248,28 @@ void
Tcl_SetTimer(
Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
UINT timeout;
- if (!initialized) {
- InitNotifier();
+ /*
+ * Allow the notifier to be hooked. This may not make sense
+ * on Windows, but mirrors the UNIX hook.
+ */
+
+ if (tclStubs.tcl_SetTimer != Tcl_SetTimer) {
+ tclStubs.tcl_SetTimer(timePtr);
+ return;
+ }
+
+ /*
+ * We only need to set up an interval timer if we're being called
+ * from an external event loop. If we don't have a window handle
+ * then we just return immediately and let Tcl_WaitForEvent handle
+ * timeouts.
+ */
+
+ if (!tsdPtr->hwnd) {
+ return;
}
if (!timePtr) {
@@ -184,12 +279,69 @@ Tcl_SetTimer(
* Make sure we pass a non-zero value into the timeout argument.
* Windows seems to get confused by zero length timers.
*/
+
timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
if (timeout == 0) {
timeout = 1;
}
}
- UpdateTimer(timeout);
+ tsdPtr->timeout = timeout;
+ if (timeout != 0) {
+ tsdPtr->timerActive = 1;
+ SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
+ (unsigned long) tsdPtr->timeout, NULL);
+ } else {
+ tsdPtr->timerActive = 0;
+ KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ServiceModeHook --
+ *
+ * This function is invoked whenever the service mode changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If this is the first time the notifier is set into
+ * TCL_SERVICE_ALL, then the communication window is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ServiceModeHook(mode)
+ int mode; /* Either TCL_SERVICE_ALL, or
+ * TCL_SERVICE_NONE. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * If this is the first time that the notifier has been used from a
+ * modal loop, then create a communication window. Note that after
+ * this point, the application needs to service events in a timely
+ * fashion or Windows will hang waiting for the window to respond
+ * to synchronous system messages. At some point, we may want to
+ * consider destroying the window if we leave the modal loop, but
+ * for now we'll leave it around.
+ */
+
+ if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
+ tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED,
+ 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
+ /*
+ * Send an initial message to the window to ensure that we wake up the
+ * notifier once we get into the modal loop. This will force the
+ * notifier to recompute the timeout value and schedule a timer
+ * if one is needed.
+ */
+
+ Tcl_AlertNotifier((ClientData)tsdPtr);
+ }
}
/*
@@ -197,8 +349,10 @@ Tcl_SetTimer(
*
* NotifierProc --
*
- * This procedure is invoked by Windows to process the timer
- * message whenever we are using an external dispatch loop.
+ * This procedure is invoked by Windows to process events on
+ * the notifier window. Messages will be sent to this window
+ * in response to external timer events or calls to
+ * TclpAlertTsdPtr->
*
* Results:
* A standard windows result.
@@ -216,8 +370,13 @@ NotifierProc(
WPARAM wParam,
LPARAM lParam)
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (message != WM_TIMER) {
+ if (message == WM_WAKEUP) {
+ EnterCriticalSection(&tsdPtr->crit);
+ tsdPtr->pending = 0;
+ LeaveCriticalSection(&tsdPtr->crit);
+ } else if (message != WM_TIMER) {
return DefWindowProc(hwnd, message, wParam, lParam);
}
@@ -253,52 +412,82 @@ int
Tcl_WaitForEvent(
Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
MSG msg;
- int timeout;
+ DWORD timeout, result;
+ int status;
+
+ /*
+ * Allow the notifier to be hooked. This may not make
+ * sense on windows, but mirrors the UNIX hook.
+ */
- if (!initialized) {
- InitNotifier();
+ if (tclStubs.tcl_WaitForEvent != Tcl_WaitForEvent) {
+ return tclStubs.tcl_WaitForEvent(timePtr);
}
/*
- * Only use the interval timer for non-zero timeouts. This avoids
- * generating useless messages when we really just want to poll.
+ * Compute the timeout in milliseconds.
*/
if (timePtr) {
timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
} else {
- timeout = 0;
+ timeout = INFINITE;
}
- UpdateTimer(timeout);
-
- if (!timePtr || (timeout != 0)
- || PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
- if (!GetMessage(&msg, NULL, 0, 0)) {
- /*
- * The application is exiting, so repost the quit message
- * and start unwinding.
- */
+ /*
+ * Check to see if there are any messages in the queue before waiting
+ * because MsgWaitForMultipleObjects will not wake up if there are events
+ * currently sitting in the queue.
+ */
- PostQuitMessage(msg.wParam);
- return -1;
- }
+ if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
+ /*
+ * Wait for something to happen (a signal from another thread, a
+ * message, or timeout).
+ */
+
+ result = MsgWaitForMultipleObjects(1, &tsdPtr->event, FALSE, timeout,
+ QS_ALLINPUT);
+ }
+
+ /*
+ * Check to see if there are any messages to process.
+ */
+ if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
/*
- * Handle timer expiration as a special case so we don't
- * claim to be doing work when we aren't.
+ * Retrieve and dispatch the first message.
*/
- if (msg.message == WM_TIMER && msg.hwnd == notifier.hwnd) {
- return 0;
- }
+ result = GetMessage(&msg, NULL, 0, 0);
+ if (result == 0) {
+ /*
+ * We received a request to exit this thread (WM_QUIT), so
+ * propagate the quit message and start unwinding.
+ */
+
+ PostQuitMessage(msg.wParam);
+ status = -1;
+ } else if (result == -1) {
+ /*
+ * We got an error from the system. I have no idea why this would
+ * happen, so we'll just unwind.
+ */
- TranslateMessage(&msg);
- DispatchMessage(&msg);
- return 1;
+ status = -1;
+ } else {
+ TranslateMessage(&msg);
+ DispatchMessage(&msg);
+ status = 1;
+ }
+ } else {
+ status = 0;
}
- return 0;
+
+ ResetEvent(tsdPtr->event);
+ return status;
}
/*
@@ -323,3 +512,5 @@ Tcl_Sleep(ms)
{
Sleep(ms);
}
+
+
diff --git a/tcl/win/tclWinPipe.c b/tcl/win/tclWinPipe.c
index 0582e964f29..3f4d6a64ef6 100644
--- a/tcl/win/tclWinPipe.c
+++ b/tcl/win/tclWinPipe.c
@@ -14,11 +14,6 @@
#include "tclWinInt.h"
-/* CYGNUS LOCAL */
-#ifndef __CYGWIN32__
-#include <dos.h>
-#endif
-/* END CYGNUS LOCAL */
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
@@ -31,6 +26,14 @@
static int initialized = 0;
/*
+ * The pipeMutex locks around access to the initialized and procList variables,
+ * and it is used to protect background threads from being terminated while
+ * they are using APIs that hold locks.
+ */
+
+TCL_DECLARE_MUTEX(pipeMutex)
+
+/*
* The following defines identify the various types of applications that
* run under windows. There is special case code for the various types.
*/
@@ -43,10 +46,9 @@ static int initialized = 0;
/*
* The following constants and structures are used to encapsulate the state
* of various types of files used in a pipeline.
+ * This used to have a 1 && 2 that supported Win32s.
*/
-#define WIN32S_PIPE 1 /* Win32s emulated pipe. */
-#define WIN32S_TMPFILE 2 /* Win32s emulated temporary file. */
#define WIN_FILE 3 /* Basic Win32 file. */
/*
@@ -60,36 +62,6 @@ typedef struct WinFile {
} WinFile;
/*
- * The following structure is used to keep track of temporary files under
- * Win32s and delete the disk file when the open handle is closed.
- * The type field will be WIN32S_TMPFILE.
- */
-
-typedef struct TmpFile {
- WinFile file; /* Common part. */
- char name[MAX_PATH]; /* Name of temp file. */
-} TmpFile;
-
-/*
- * The following structure represents a synchronous pipe under Win32s.
- * The type field will be WIN32S_PIPE. The handle field will refer to
- * an open file when Tcl is reading from the "pipe", otherwise it is
- * INVALID_HANDLE_VALUE.
- */
-
-typedef struct WinPipe {
- WinFile file; /* Common part. */
- struct WinPipe *otherPtr; /* Pointer to the WinPipe structure that
- * corresponds to the other end of this
- * pipe. */
- char *fileName; /* The name of the staging file that gets
- * the data written to this pipe. Malloc'd.
- * and shared by both ends of the pipe. Only
- * when both ends are freed will fileName be
- * freed and the file it refers to deleted. */
-} WinPipe;
-
-/*
* This list is used to map from pids to process handles.
*/
@@ -102,21 +74,25 @@ typedef struct ProcInfo {
static ProcInfo *procList;
/*
- * State flags used in the PipeInfo structure below.
+ * Bit masks used in the flags field of the PipeInfo structure below.
*/
#define PIPE_PENDING (1<<0) /* Message is pending in the queue. */
#define PIPE_ASYNC (1<<1) /* Channel is non-blocking. */
-#define PIPE_READABLE (1<<2) /* Pipe is readable. */
-#define PIPE_CLOSED (1<<3) /* Pipe is being closed. */
-#define PIPE_HAS_THREAD (1<<4) /* Pipe has an associated thread. */
-#define PIPE_READAHEAD (1<<5) /* Readahead byte is valid. */
+
+/*
+ * Bit masks used in the sharedFlags field of the PipeInfo structure below.
+ */
+
+#define PIPE_EOF (1<<2) /* Pipe has reached EOF. */
+#define PIPE_EXTRABYTE (1<<3) /* The reader thread has consumed one byte. */
/*
* This structure describes per-instance data for a pipe based channel.
*/
typedef struct PipeInfo {
+ struct PipeInfo *nextPtr; /* Pointer to next registered pipe. */
Tcl_Channel channel; /* Pointer to channel structure. */
int validMask; /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, or TCL_EXCEPTION: indicates
@@ -130,20 +106,56 @@ typedef struct PipeInfo {
TclFile errorFile; /* Error output from pipe. */
int numPids; /* Number of processes attached to pipe. */
Tcl_Pid *pidPtr; /* Pids of attached processes. */
- struct PipeInfo *nextPtr; /* Pointer to next registered pipe. */
- /* CYGNUS LOCAL: Several new fields. */
- HANDLE flagsMutex; /* Mutex to control access to flags. */
- HANDLE mutex; /* Mutex for read fields. */
- HANDLE tryReadEvent; /* Event to tell thread to try a read. */
- char readAhead; /* Read ahead byte. */
+ Tcl_ThreadId threadId; /* Thread to which events should be reported.
+ * This value is used by the reader/writer
+ * threads. */
+ HANDLE writeThread; /* Handle to writer thread. */
+ HANDLE readThread; /* Handle to reader thread. */
+ HANDLE writable; /* Manual-reset event to signal when the
+ * writer thread has finished waiting for
+ * the current buffer to be written. */
+ HANDLE readable; /* Manual-reset event to signal when the
+ * reader thread has finished waiting for
+ * input. */
+ HANDLE startWriter; /* Auto-reset event used by the main thread to
+ * signal when the writer thread should attempt
+ * to write to the pipe. */
+ HANDLE startReader; /* Auto-reset event used by the main thread to
+ * signal when the reader thread should attempt
+ * to read from the pipe. */
+ DWORD writeError; /* An error caused by the last background
+ * write. Set to 0 if no error has been
+ * detected. This word is shared with the
+ * writer thread so access must be
+ * synchronized with the writable object.
+ */
+ char *writeBuf; /* Current background output buffer.
+ * Access is synchronized with the writable
+ * object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the writable
+ * object. */
+ int toWrite; /* Current amount to be written. Access is
+ * synchronized with the writable object. */
+ int readFlags; /* Flags that are shared with the reader
+ * thread. Access is synchronized with the
+ * readable object. */
+ char extraByte; /* Buffer for extra character consumed by
+ * reader thread. This byte is shared with
+ * the reader thread so access must be
+ * synchronized with the readable object. */
} PipeInfo;
-/*
- * The following pointer refers to the head of the list of pipes
- * that are being watched for file events.
- */
+typedef struct ThreadSpecificData {
+ /*
+ * The following pointer refers to the head of the list of pipes
+ * that are being watched for file events.
+ */
+
+ PipeInfo *firstPipePtr;
+} ThreadSpecificData;
-static PipeInfo *firstPipePtr;
+static Tcl_ThreadDataKey dataKey;
/*
* The following structure is what is added to the Tcl event queue when
@@ -163,38 +175,31 @@ typedef struct PipeEvent {
* Declarations for functions used only in this file.
*/
-static int ApplicationType(Tcl_Interp *interp, const char *fileName,
- char *fullName);
-static void BuildCommandLine(int argc, char **argv, Tcl_DString *linePtr);
-static void CopyChannel(HANDLE dst, HANDLE src);
-static BOOL HasConsole(void);
-static TclFile MakeFile(HANDLE handle);
-static char * MakeTempFile(Tcl_DString *namePtr);
-static int PipeBlockModeProc(ClientData instanceData, int mode);
-static void PipeCheckProc _ANSI_ARGS_((ClientData clientData,
- int flags));
-static int PipeCloseProc(ClientData instanceData, Tcl_Interp *interp);
-static int PipeEventProc(Tcl_Event *evPtr, int flags);
-static void PipeExitHandler(ClientData clientData);
-static int PipeGetHandleProc(ClientData instanceData, int direction,
- ClientData *handlePtr);
-static void PipeInit(void);
-static int PipeInputProc(ClientData instanceData, char *buf, int toRead,
- int *errorCode);
-static int PipeOutputProc(ClientData instanceData, char *buf, int toWrite,
- int *errorCode);
-static void PipeWatchProc(ClientData instanceData, int mask);
-static void PipeSetupProc _ANSI_ARGS_((ClientData clientData,
- int flags));
-static int TempFileName(char name[MAX_PATH]);
-
-/* CYGNUS LOCAL. */
-static int PipeGetFlags _ANSI_ARGS_((PipeInfo *));
-static void PipeSetFlag _ANSI_ARGS_((PipeInfo *, int));
-static void PipeResetFlag _ANSI_ARGS_((PipeInfo *, int));
-static DWORD PipeThread _ANSI_ARGS_((LPVOID arg));
-static LRESULT CALLBACK PipeProc _ANSI_ARGS_((HWND hwnd, UINT message,
- WPARAM wParam, LPARAM lParam));
+static int ApplicationType(Tcl_Interp *interp,
+ const char *fileName, char *fullName);
+static void BuildCommandLine(const char *executable, int argc,
+ char **argv, Tcl_DString *linePtr);
+static BOOL HasConsole(void);
+static int PipeBlockModeProc(ClientData instanceData, int mode);
+static void PipeCheckProc(ClientData clientData, int flags);
+static int PipeClose2Proc(ClientData instanceData,
+ Tcl_Interp *interp, int flags);
+static int PipeEventProc(Tcl_Event *evPtr, int flags);
+static void PipeExitHandler(ClientData clientData);
+static int PipeGetHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+static void PipeInit(void);
+static int PipeInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCode);
+static int PipeOutputProc(ClientData instanceData, char *buf,
+ int toWrite, int *errorCode);
+static DWORD WINAPI PipeReaderThread(LPVOID arg);
+static void PipeSetupProc(ClientData clientData, int flags);
+static void PipeWatchProc(ClientData instanceData, int mask);
+static DWORD WINAPI PipeWriterThread(LPVOID arg);
+static void ProcExitHandler(ClientData clientData);
+static int TempFileName(WCHAR name[MAX_PATH]);
+static int WaitForRead(PipeInfo *infoPtr, int blocking);
/*
* This structure describes the channel type structure for command pipe
@@ -203,8 +208,8 @@ static LRESULT CALLBACK PipeProc _ANSI_ARGS_((HWND hwnd, UINT message,
static Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
- PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
- PipeCloseProc, /* Close proc. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CLOSE2PROC, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -212,203 +217,105 @@ static Tcl_ChannelType pipeChannelType = {
NULL, /* Get option proc. */
PipeWatchProc, /* Set up notifier to watch the channel. */
PipeGetHandleProc, /* Get an OS handle from channel. */
+ PipeClose2Proc, /* close2proc */
+ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
-
-/* CYGNUS LOCAL: Event notification window. */
-
-static HWND pipeHwnd;
-
-#define PIPE_MESSAGE (WM_USER + 1)
-/* CYGNUS LOCAL: Because we use a thread that manipulates the flags
- field, we use helper routines for the field. */
-
-static int
-PipeGetFlags(pipe)
- PipeInfo *pipe;
-{
- int flags;
-
- WaitForSingleObject(pipe->flagsMutex, INFINITE);
- flags = pipe->flags;
- ReleaseMutex(pipe->flagsMutex);
- return flags;
-}
-
-static void
-PipeSetFlag(pipe, flag)
- PipeInfo *pipe;
- int flag;
-{
- WaitForSingleObject(pipe->flagsMutex, INFINITE);
- pipe->flags |= flag;
- ReleaseMutex(pipe->flagsMutex);
-}
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeInit --
+ *
+ * This function initializes the static variables for this file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
static void
-PipeResetFlag(pipe, flag)
- PipeInfo *pipe;
- int flag;
-{
- WaitForSingleObject(pipe->flagsMutex, INFINITE);
- pipe->flags &= ~ (flag);
- ReleaseMutex(pipe->flagsMutex);
-}
-
-/* CYGNUS LOCAL: We use a thread to detect when a pipe may be read.
- The thread runs this function. The argument is the pipe to read. */
-
-static DWORD
-PipeThread(arg)
- LPVOID arg;
+PipeInit()
{
- PipeInfo *pipe = (PipeInfo *) arg;
- WinFile *file = (WinFile*) pipe->readFile;
- HANDLE handle = file->handle;
-
- while (1) {
- char b;
- DWORD got;
-
- WaitForSingleObject(pipe->tryReadEvent, INFINITE);
-
- if (PipeGetFlags(pipe) & PIPE_CLOSED) {
- break;
- }
-
- WaitForSingleObject(pipe->mutex, INFINITE);
+ ThreadSpecificData *tsdPtr;
- if ((PipeGetFlags(pipe) & PIPE_READAHEAD) == 0) {
- if (ReadFile(handle, &b, 1, &got, NULL) && got == 1) {
- pipe->readAhead = b;
- PipeSetFlag(pipe, PIPE_READAHEAD);
- }
- }
-
- PipeSetFlag(pipe, PIPE_READABLE);
-
- /* We've indicated that the pipe is readable, so ignore any
- recent requests to do so. */
- ResetEvent(pipe->tryReadEvent);
-
- ReleaseMutex(pipe->mutex);
+ /*
+ * Check the initialized flag first, then check again in the mutex.
+ * This is a speed enhancement.
+ */
- if (PipeGetFlags(pipe) & PIPE_CLOSED) {
- break;
+ if (!initialized) {
+ Tcl_MutexLock(&pipeMutex);
+ if (!initialized) {
+ initialized = 1;
+ procList = NULL;
+ Tcl_CreateExitHandler(ProcExitHandler, NULL);
}
-
- /* Post a message to wake up the event loop. */
- PostMessage(pipeHwnd, PIPE_MESSAGE, 0, (LPARAM) pipe);
+ Tcl_MutexUnlock(&pipeMutex);
}
- /* PipeCloseProc will set PIPE_CLOSED when the pipe is ready to be
- closed and freed. */
-
- CloseHandle(pipe->flagsMutex);
- CloseHandle(pipe->tryReadEvent);
- CloseHandle(pipe->mutex);
- ckfree((char *)pipe);
- return 0;
-}
-
-/* CYGNUS LOCAL: This function is called when the PipeThread posts a
- message. */
-
-static LRESULT CALLBACK
-PipeProc(hwnd, message, wParam, lParam)
- HWND hwnd;
- UINT message;
- WPARAM wParam;
- LPARAM lParam;
-{
- if (message != PIPE_MESSAGE) {
- return DefWindowProc(hwnd, message, wParam, lParam);
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstPipePtr = NULL;
+ Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(PipeExitHandler, NULL);
}
-
- /* This function really only exists to wake up the event loop. We
- don't actually have to do anything. */
-
- return 0;
}
/*
*----------------------------------------------------------------------
*
- * PipeInit --
+ * PipeExitHandler --
*
- * This function initializes the static variables for this file.
+ * This function is called to cleanup the pipe module before
+ * Tcl is unloaded.
*
* Results:
* None.
*
* Side effects:
- * Creates a new event source.
+ * Removes the pipe event source.
*
*----------------------------------------------------------------------
*/
static void
-PipeInit()
+PipeExitHandler(
+ ClientData clientData) /* Old window proc */
{
- WNDCLASS class;
-
- initialized = 1;
- firstPipePtr = NULL;
- procList = NULL;
- Tcl_CreateEventSource(PipeSetupProc, PipeCheckProc, NULL);
- Tcl_CreateExitHandler(PipeExitHandler, NULL);
-
- /* CYGNUS LOCAL: Create a window for asynchronous notification. */
-
- class.style = 0;
- class.cbClsExtra = 0;
- class.cbWndExtra = 0;
- class.hInstance = TclWinGetTclInstance();
- class.hbrBackground = NULL;
- class.lpszMenuName = NULL;
- class.lpszClassName = "TclPipe";
- class.lpfnWndProc = PipeProc;
- class.hIcon = NULL;
- class.hCursor = NULL;
-
- if (RegisterClass(&class)) {
- pipeHwnd = CreateWindow("TclPipe", "TclPipe", WS_TILED, 0, 0,
- 0, 0, NULL, NULL, class.hInstance, NULL);
- } else {
- pipeHwnd = NULL;
- TclWinConvertError(GetLastError());
- }
+ Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
}
/*
*----------------------------------------------------------------------
*
- * PipeExitHandler --
+ * ProcExitHandler --
*
- * This function is called to cleanup the pipe module before
+ * This function is called to cleanup the process list before
* Tcl is unloaded.
*
* Results:
* None.
*
* Side effects:
- * Removes the pipe event source.
+ * Resets the process list.
*
*----------------------------------------------------------------------
*/
static void
-PipeExitHandler(clientData)
- ClientData clientData; /* Old window proc */
+ProcExitHandler(
+ ClientData clientData) /* Old window proc */
{
- Tcl_DeleteEventSource(PipeSetupProc, PipeCheckProc, NULL);
+ Tcl_MutexLock(&pipeMutex);
initialized = 0;
- /* CYGNUS LOCAL: Delete the window. */
- UnregisterClass("TclPipe", TclWinGetTclInstance());
- if (pipeHwnd != NULL) {
- DestroyWindow(pipeHwnd);
- pipeHwnd = NULL;
- }
+ Tcl_MutexUnlock(&pipeMutex);
}
/*
@@ -429,36 +336,42 @@ PipeExitHandler(clientData)
*/
void
-PipeSetupProc(data, flags)
- ClientData data; /* Not used. */
- int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+PipeSetupProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
PipeInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
+ int block = 1;
+ WinFile *filePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
/*
- * Check to see if there is a watched pipe. If so, poll.
+ * Look to see if any events are already pending. If they are, poll.
*/
- for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
- /* CYGNUS LOCAL: Only poll for a readable pipe if it really is
- readable. */
- if ((infoPtr->watchMask &~ TCL_READABLE)
- || ((infoPtr->watchMask & TCL_READABLE)
- && ((PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) == 0
- || (PipeGetFlags(infoPtr) & PIPE_READABLE)))) {
- Tcl_SetMaxBlockTime(&blockTime);
- break;
- } else if (infoPtr->watchMask & TCL_READABLE) {
- /* CYGNUS LOCAL: Tell the thread to try a read, and let us
- know when it is done. */
- SetEvent(infoPtr->tryReadEvent);
+ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ filePtr = (WinFile*) infoPtr->writeFile;
+ if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
+ block = 0;
+ }
+ }
+ if (infoPtr->watchMask & TCL_READABLE) {
+ filePtr = (WinFile*) infoPtr->readFile;
+ if (WaitForRead(infoPtr, 0) >= 0) {
+ block = 0;
+ }
}
}
+ if (!block) {
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
}
/*
@@ -479,31 +392,50 @@ PipeSetupProc(data, flags)
*/
static void
-PipeCheckProc(data, flags)
- ClientData data; /* Not used. */
- int flags; /* Event flags as passed to Tcl_DoOneEvent. */
+PipeCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
PipeInfo *infoPtr;
PipeEvent *evPtr;
+ WinFile *filePtr;
+ int needEvent;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
/*
- * Queue events for any watched pipes that don't already have events
+ * Queue events for any ready pipes that don't already have events
* queued.
*/
- for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
- /* CYGNUS LOCAL: Only poll for a readable pipe if it really is
- readable. */
- if (((infoPtr->watchMask &~ TCL_READABLE)
- || ((infoPtr->watchMask & TCL_READABLE)
- && ((PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) == 0
- || (PipeGetFlags(infoPtr) & PIPE_READABLE))))
- && !(PipeGetFlags(infoPtr) & PIPE_PENDING)) {
- PipeSetFlag(infoPtr, PIPE_PENDING);
+ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->flags & PIPE_PENDING) {
+ continue;
+ }
+
+ /*
+ * Queue an event if the pipe is signaled for reading or writing.
+ */
+
+ needEvent = 0;
+ filePtr = (WinFile*) infoPtr->writeFile;
+ if ((infoPtr->watchMask & TCL_WRITABLE) &&
+ (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
+ needEvent = 1;
+ }
+
+ filePtr = (WinFile*) infoPtr->readFile;
+ if ((infoPtr->watchMask & TCL_READABLE) &&
+ (WaitForRead(infoPtr, 0) >= 0)) {
+ needEvent = 1;
+ }
+
+ if (needEvent) {
+ infoPtr->flags |= PIPE_PENDING;
evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
evPtr->header.proc = PipeEventProc;
evPtr->infoPtr = infoPtr;
@@ -515,7 +447,7 @@ PipeCheckProc(data, flags)
/*
*----------------------------------------------------------------------
*
- * MakeFile --
+ * TclWinMakeFile --
*
* This function constructs a new TclFile from a given data and
* type value.
@@ -529,9 +461,9 @@ PipeCheckProc(data, flags)
*----------------------------------------------------------------------
*/
-static TclFile
-MakeFile(handle)
- HANDLE handle; /* Type-specific data. */
+TclFile
+TclWinMakeFile(
+ HANDLE handle) /* Type-specific data. */
{
WinFile *filePtr;
@@ -545,37 +477,6 @@ MakeFile(handle)
/*
*----------------------------------------------------------------------
*
- * TclpMakeFile --
- *
- * Make a TclFile from a channel.
- *
- * Results:
- * Returns a new TclFile or NULL on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-TclFile
-TclpMakeFile(channel, direction)
- Tcl_Channel channel; /* Channel to get file from. */
- int direction; /* Either TCL_READABLE or TCL_WRITABLE. */
-{
- HANDLE handle;
-
- if (Tcl_GetChannelHandle(channel, direction,
- (ClientData *) &handle) == TCL_OK) {
- return MakeFile(handle);
- } else {
- return (TclFile) NULL;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TempFileName --
*
* Gets a temporary file name and deals with the fact that the
@@ -596,117 +497,58 @@ TclpMakeFile(channel, direction)
static int
TempFileName(name)
- char name[MAX_PATH]; /* Buffer in which name for temporary
+ WCHAR name[MAX_PATH]; /* Buffer in which name for temporary
* file gets stored. */
{
- if ((GetTempPath(MAX_PATH, name) == 0) ||
- (GetTempFileName(name, "TCL", 0, name) == 0)) {
- name[0] = '.';
- name[1] = '\0';
- if (GetTempFileName(name, "TCL", 0, name) == 0) {
- return 0;
+ TCHAR *prefix;
+
+ prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL";
+ if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) {
+ if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
+ name) != 0) {
+ return 1;
}
}
- return 1;
+ if (tclWinProcs->useWide) {
+ ((WCHAR *) name)[0] = '.';
+ ((WCHAR *) name)[1] = '\0';
+ } else {
+ ((char *) name)[0] = '.';
+ ((char *) name)[1] = '\0';
+ }
+ return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
+ name);
}
/*
*----------------------------------------------------------------------
*
- * TclpCreateTempFile --
+ * TclpMakeFile --
*
- * This function opens a unique file with the property that it
- * will be deleted when its file handle is closed. The temporary
- * file is created in the system temporary directory.
+ * Make a TclFile from a channel.
*
* Results:
- * Returns a valid TclFile, or NULL on failure.
+ * Returns a new TclFile or NULL on failure.
*
* Side effects:
- * Creates a new temporary file.
+ * None.
*
*----------------------------------------------------------------------
*/
TclFile
-TclpCreateTempFile(contents, namePtr)
- char *contents; /* String to write into temp file, or NULL. */
- Tcl_DString *namePtr; /* If non-NULL, pointer to initialized
- * DString that is filled with the name of
- * the temp file that was created. */
+TclpMakeFile(channel, direction)
+ Tcl_Channel channel; /* Channel to get file from. */
+ int direction; /* Either TCL_READABLE or TCL_WRITABLE. */
{
- char name[MAX_PATH];
HANDLE handle;
- if (TempFileName(name) == 0) {
- return NULL;
- }
-
- handle = CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, NULL,
- CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE,
- NULL);
- if (handle == INVALID_HANDLE_VALUE) {
- goto error;
- }
-
- /*
- * Write the file out, doing line translations on the way.
- */
-
- if (contents != NULL) {
- DWORD result, length;
- char *p;
-
- for (p = contents; *p != '\0'; p++) {
- if (*p == '\n') {
- length = p - contents;
- if (length > 0) {
- if (!WriteFile(handle, contents, length, &result, NULL)) {
- goto error;
- }
- }
- if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
- goto error;
- }
- contents = p+1;
- }
- }
- length = p - contents;
- if (length > 0) {
- if (!WriteFile(handle, contents, length, &result, NULL)) {
- goto error;
- }
- }
- }
-
- if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
- goto error;
- }
-
- if (namePtr != NULL) {
- Tcl_DStringAppend(namePtr, name, -1);
- }
-
- /*
- * Under Win32s a file created with FILE_FLAG_DELETE_ON_CLOSE won't
- * actually be deleted when it is closed, so we have to do it ourselves.
- */
-
- if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
- TmpFile *tmpFilePtr = (TmpFile *) ckalloc(sizeof(TmpFile));
- tmpFilePtr->file.type = WIN32S_TMPFILE;
- tmpFilePtr->file.handle = handle;
- strcpy(tmpFilePtr->name, name);
- return (TclFile)tmpFilePtr;
+ if (Tcl_GetChannelHandle(channel, direction,
+ (ClientData *) &handle) == TCL_OK) {
+ return TclWinMakeFile(handle);
} else {
- return MakeFile(handle);
+ return (TclFile) NULL;
}
-
- error:
- TclWinConvertError(GetLastError());
- CloseHandle(handle);
- DeleteFile(name);
- return NULL;
}
/*
@@ -728,13 +570,14 @@ TclpCreateTempFile(contents, namePtr)
TclFile
TclpOpenFile(path, mode)
- char *path;
- int mode;
+ CONST char *path; /* The name of the file to open. */
+ int mode; /* In what mode to open the file? */
{
HANDLE handle;
DWORD accessMode, createMode, shareMode, flags;
- SECURITY_ATTRIBUTES sec;
-
+ Tcl_DString ds;
+ TCHAR *nativePath;
+
/*
* Map the access bits to the NT access mode.
*/
@@ -778,28 +621,21 @@ TclpOpenFile(path, mode)
break;
}
+ nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+
/*
* If the file is not being created, use the existing file attributes.
*/
flags = 0;
if (!(mode & O_CREAT)) {
- flags = GetFileAttributes(path);
+ flags = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
}
/*
- * Set up the security attributes so this file is not inherited by
- * child processes.
- */
-
- sec.nLength = sizeof(sec);
- sec.lpSecurityDescriptor = NULL;
- sec.bInheritHandle = 0;
-
- /*
* Set up the file sharing mode. We want to allow simultaneous access.
*/
@@ -809,10 +645,14 @@ TclpOpenFile(path, mode)
* Now we get to create the file.
*/
- handle = CreateFile(path, accessMode, shareMode, &sec, createMode, flags,
- (HANDLE) NULL);
+ handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
+ shareMode, NULL, createMode, flags, NULL);
+ Tcl_DStringFree(&ds);
+
if (handle == INVALID_HANDLE_VALUE) {
- DWORD err = GetLastError();
+ DWORD err;
+
+ err = GetLastError();
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
}
@@ -828,7 +668,98 @@ TclpOpenFile(path, mode)
SetFilePointer(handle, 0, NULL, FILE_END);
}
- return MakeFile(handle);
+ return TclWinMakeFile(handle);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCreateTempFile --
+ *
+ * This function opens a unique file with the property that it
+ * will be deleted when its file handle is closed. The temporary
+ * file is created in the system temporary directory.
+ *
+ * Results:
+ * Returns a valid TclFile, or NULL on failure.
+ *
+ * Side effects:
+ * Creates a new temporary file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclFile
+TclpCreateTempFile(contents)
+ CONST char *contents; /* String to write into temp file, or NULL. */
+{
+ WCHAR name[MAX_PATH];
+ CONST char *native;
+ Tcl_DString dstring;
+ HANDLE handle;
+
+ if (TempFileName(name) == 0) {
+ return NULL;
+ }
+
+ handle = (*tclWinProcs->createFileProc)((TCHAR *) name,
+ GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
+ FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
+ if (handle == INVALID_HANDLE_VALUE) {
+ goto error;
+ }
+
+ /*
+ * Write the file out, doing line translations on the way.
+ */
+
+ if (contents != NULL) {
+ DWORD result, length;
+ CONST char *p;
+
+ /*
+ * Convert the contents from UTF to native encoding
+ */
+ native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
+
+ for (p = native; *p != '\0'; p++) {
+ if (*p == '\n') {
+ length = p - native;
+ if (length > 0) {
+ if (!WriteFile(handle, native, length, &result, NULL)) {
+ goto error;
+ }
+ }
+ if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
+ goto error;
+ }
+ native = p+1;
+ }
+ }
+ length = p - native;
+ if (length > 0) {
+ if (!WriteFile(handle, native, length, &result, NULL)) {
+ goto error;
+ }
+ }
+ Tcl_DStringFree(&dstring);
+ if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
+ goto error;
+ }
+ }
+
+ return TclWinMakeFile(handle);
+
+ error:
+ /* Free the native representation of the contents if necessary */
+ if (contents != NULL) {
+ Tcl_DStringFree(&dstring);
+ }
+
+ TclWinConvertError(GetLastError());
+ CloseHandle(handle);
+ (*tclWinProcs->deleteFileProc)((TCHAR *) name);
+ return NULL;
}
/*
@@ -836,8 +767,7 @@ TclpOpenFile(path, mode)
*
* TclpCreatePipe --
*
- * Creates an anonymous pipe. Under Win32s, creates a temp file
- * that is used to simulate a pipe.
+ * Creates an anonymous pipe.
*
* Results:
* Returns 1 on success, 0 on failure.
@@ -849,44 +779,20 @@ TclpOpenFile(path, mode)
*/
int
-TclpCreatePipe(readPipe, writePipe)
- TclFile *readPipe; /* Location to store file handle for
+TclpCreatePipe(
+ TclFile *readPipe, /* Location to store file handle for
* read side of pipe. */
- TclFile *writePipe; /* Location to store file handle for
+ TclFile *writePipe) /* Location to store file handle for
* write side of pipe. */
{
HANDLE readHandle, writeHandle;
if (CreatePipe(&readHandle, &writeHandle, NULL, 0) != 0) {
- *readPipe = MakeFile(readHandle);
- *writePipe = MakeFile(writeHandle);
+ *readPipe = TclWinMakeFile(readHandle);
+ *writePipe = TclWinMakeFile(writeHandle);
return 1;
}
- if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
- WinPipe *readPipePtr, *writePipePtr;
- char buf[MAX_PATH];
-
- if (TempFileName(buf) != 0) {
- readPipePtr = (WinPipe *) ckalloc(sizeof(WinPipe));
- writePipePtr = (WinPipe *) ckalloc(sizeof(WinPipe));
-
- readPipePtr->file.type = WIN32S_PIPE;
- readPipePtr->otherPtr = writePipePtr;
- readPipePtr->fileName = strcpy(ckalloc(strlen(buf) + 1), buf);
- readPipePtr->file.handle = INVALID_HANDLE_VALUE;
- writePipePtr->file.type = WIN32S_PIPE;
- writePipePtr->otherPtr = readPipePtr;
- writePipePtr->fileName = readPipePtr->fileName;
- writePipePtr->file.handle = INVALID_HANDLE_VALUE;
-
- *readPipe = (TclFile)readPipePtr;
- *writePipe = (TclFile)writePipePtr;
-
- return 1;
- }
- }
-
TclWinConvertError(GetLastError());
return 0;
}
@@ -909,45 +815,33 @@ TclpCreatePipe(readPipe, writePipe)
*/
int
-TclpCloseFile(file)
- TclFile file; /* The file to close. */
+TclpCloseFile(
+ TclFile file) /* The file to close. */
{
WinFile *filePtr = (WinFile *) file;
- WinPipe *pipePtr;
switch (filePtr->type) {
case WIN_FILE:
- case WIN32S_TMPFILE:
- if (CloseHandle(filePtr->handle) == FALSE) {
- TclWinConvertError(GetLastError());
- ckfree((char *) filePtr);
- return -1;
- }
/*
- * Simulate deleting the file on close for Win32s.
+ * Don't close the Win32 handle if the handle is a standard channel
+ * during the exit process. Otherwise, one thread may kill the
+ * stdio of another.
*/
- if (filePtr->type == WIN32S_TMPFILE) {
- DeleteFile(((TmpFile*)filePtr)->name);
- }
- break;
-
- case WIN32S_PIPE:
- pipePtr = (WinPipe *) file;
-
- if (pipePtr->otherPtr != NULL) {
- pipePtr->otherPtr->otherPtr = NULL;
- } else {
- if (pipePtr->file.handle != INVALID_HANDLE_VALUE) {
- CloseHandle(pipePtr->file.handle);
+ if (!TclInExit()
+ || ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
+ && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
+ && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
+ if (CloseHandle(filePtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ ckfree((char *) filePtr);
+ return -1;
}
- DeleteFile(pipePtr->fileName);
- ckfree((char *) pipePtr->fileName);
}
break;
default:
- panic("Tcl_CloseFile: unexpected file type");
+ panic("TclpCloseFile: unexpected file type");
}
ckfree((char *) filePtr);
@@ -974,16 +868,19 @@ TclpCloseFile(file)
*/
unsigned long
-TclpGetPid(pid)
- Tcl_Pid pid; /* The HANDLE of the child process. */
+TclpGetPid(
+ Tcl_Pid pid) /* The HANDLE of the child process. */
{
ProcInfo *infoPtr;
-
+
+ Tcl_MutexLock(&pipeMutex);
for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
if (infoPtr->hProcess == (HANDLE) pid) {
+ Tcl_MutexUnlock(&pipeMutex);
return infoPtr->dwProcessId;
}
}
+ Tcl_MutexUnlock(&pipeMutex);
return (unsigned long) -1;
}
@@ -994,9 +891,8 @@ TclpGetPid(pid)
*
* Create a child process that has the specified files as its
* standard input, output, and error. The child process runs
- * synchronously under Win32s and asynchronously under Windows NT
- * and Windows 95, and runs with the same environment variables
- * as the creating process.
+ * asynchronously under Windows NT and Windows 9x, and runs
+ * with the same environment variables as the creating process.
*
* The complete Windows search path is searched to find the specified
* executable. If an executable by the given name is not found,
@@ -1005,7 +901,7 @@ TclpGetPid(pid)
*
* Results:
* The return value is TCL_ERROR and an error message is left in
- * interp->result if there was a problem creating the child
+ * the interp's result if there was a problem creating the child
* process. Otherwise, the return value is TCL_OK and *pidPtr is
* filled with the process id of the child process.
*
@@ -1016,214 +912,53 @@ TclpGetPid(pid)
*/
int
-TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
- pidPtr)
- Tcl_Interp *interp; /* Interpreter in which to leave errors that
+TclpCreateProcess(
+ Tcl_Interp *interp, /* Interpreter in which to leave errors that
* occurred when creating the child process.
* Error messages from the child process
* itself are sent to errorFile. */
- int argc; /* Number of arguments in following array. */
- char **argv; /* Array of argument strings. argv[0]
+ int argc, /* Number of arguments in following array. */
+ char **argv, /* Array of argument strings. argv[0]
* contains the name of the executable
* converted to native format (using the
* Tcl_TranslateFileName call). Additional
* arguments have not been converted. */
- TclFile inputFile; /* If non-NULL, gives the file to use as
+ TclFile inputFile, /* If non-NULL, gives the file to use as
* input for the child process. If inputFile
* file is not readable or is NULL, the child
* will receive no standard input. */
- TclFile outputFile; /* If non-NULL, gives the file that
+ TclFile outputFile, /* If non-NULL, gives the file that
* receives output from the child process. If
* outputFile file is not writeable or is
* NULL, output from the child will be
* discarded. */
- TclFile errorFile; /* If non-NULL, gives the file that
+ TclFile errorFile, /* If non-NULL, gives the file that
* receives errors from the child process. If
* errorFile file is not writeable or is NULL,
* errors from the child will be discarded.
* errorFile may be the same as outputFile. */
- Tcl_Pid *pidPtr; /* If this procedure is successful, pidPtr
+ Tcl_Pid *pidPtr) /* If this procedure is successful, pidPtr
* is filled with the process id of the child
* process. */
{
int result, applType, createFlags;
- Tcl_DString cmdLine;
- STARTUPINFO startInfo;
+ Tcl_DString cmdLine; /* Complete command line (TCHAR). */
+ STARTUPINFOA startInfo;
PROCESS_INFORMATION procInfo;
SECURITY_ATTRIBUTES secAtts;
HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
- char execPath[MAX_PATH];
- char *originalName;
+ char execPath[MAX_PATH * TCL_UTF_MAX];
WinFile *filePtr;
- if (!initialized) {
- PipeInit();
- }
+ PipeInit();
applType = ApplicationType(interp, argv[0], execPath);
if (applType == APPL_NONE) {
return TCL_ERROR;
}
- originalName = argv[0];
- argv[0] = execPath;
result = TCL_ERROR;
Tcl_DStringInit(&cmdLine);
-
- if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
- /*
- * Under Win32s, there are no pipes. In order to simulate pipe
- * behavior, the child processes are run synchronously and their
- * I/O is redirected from/to temporary files before the next
- * stage of the pipeline is started.
- */
-
- MSG msg;
- DWORD status;
- DWORD args[4];
- void *trans[5];
- char *inputFileName, *outputFileName;
- Tcl_DString inputTempFile, outputTempFile;
-
- BuildCommandLine(argc, argv, &cmdLine);
-
- ZeroMemory(&startInfo, sizeof(startInfo));
- startInfo.cb = sizeof(startInfo);
-
- Tcl_DStringInit(&inputTempFile);
- Tcl_DStringInit(&outputTempFile);
- outputHandle = INVALID_HANDLE_VALUE;
-
- inputFileName = NULL;
- outputFileName = NULL;
- if (inputFile != NULL) {
- filePtr = (WinFile *) inputFile;
- switch (filePtr->type) {
- case WIN_FILE:
- case WIN32S_TMPFILE: {
- h = INVALID_HANDLE_VALUE;
- inputFileName = MakeTempFile(&inputTempFile);
- if (inputFileName != NULL) {
- h = CreateFile(inputFileName, GENERIC_WRITE, 0,
- NULL, CREATE_ALWAYS, 0, NULL);
- }
- if (h == INVALID_HANDLE_VALUE) {
- Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
- Tcl_PosixError(interp), (char *) NULL);
- goto end32s;
- }
- CopyChannel(h, filePtr->handle);
- CloseHandle(h);
- break;
- }
- case WIN32S_PIPE: {
- inputFileName = ((WinPipe*)inputFile)->fileName;
- break;
- }
- }
- }
- if (inputFileName == NULL) {
- inputFileName = "nul";
- }
- if (outputFile != NULL) {
- filePtr = (WinFile *)outputFile;
- if (filePtr->type == WIN_FILE) {
- outputFileName = MakeTempFile(&outputTempFile);
- if (outputFileName == NULL) {
- Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
- Tcl_PosixError(interp), (char *) NULL);
- goto end32s;
- }
- outputHandle = filePtr->handle;
- } else if (filePtr->type == WIN32S_PIPE) {
- outputFileName = ((WinPipe*)outputFile)->fileName;
- }
- }
- if (outputFileName == NULL) {
- outputFileName = "nul";
- }
-
- if (applType == APPL_DOS) {
- args[0] = (DWORD) Tcl_DStringValue(&cmdLine);
- args[1] = (DWORD) inputFileName;
- args[2] = (DWORD) outputFileName;
- trans[0] = &args[0];
- trans[1] = &args[1];
- trans[2] = &args[2];
- trans[3] = NULL;
- if (TclWinSynchSpawn(args, 0, trans, pidPtr) != 0) {
- result = TCL_OK;
- }
- } else if (applType == APPL_WIN3X) {
- args[0] = (DWORD) Tcl_DStringValue(&cmdLine);
- trans[0] = &args[0];
- trans[1] = NULL;
- if (TclWinSynchSpawn(args, 1, trans, pidPtr) != 0) {
- result = TCL_OK;
- }
- } else {
- if (CreateProcess(NULL, Tcl_DStringValue(&cmdLine), NULL, NULL,
- FALSE, DETACHED_PROCESS, NULL, NULL, &startInfo,
- &procInfo) != 0) {
- CloseHandle(procInfo.hThread);
- while (1) {
- if (GetExitCodeProcess(procInfo.hProcess, &status) == FALSE) {
- break;
- }
- if (status != STILL_ACTIVE) {
- break;
- }
- if (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) == TRUE) {
- TranslateMessage(&msg);
- DispatchMessage(&msg);
- }
- }
- *pidPtr = (Tcl_Pid) procInfo.hProcess;
- if (*pidPtr != 0) {
- ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
- procPtr->hProcess = procInfo.hProcess;
- procPtr->dwProcessId = procInfo.dwProcessId;
- procPtr->nextPtr = procList;
- procList = procPtr;
- }
- result = TCL_OK;
- }
- }
- if (result != TCL_OK) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't execute \"", originalName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
- }
-
- end32s:
- if (outputHandle != INVALID_HANDLE_VALUE) {
- /*
- * Now copy stuff from temp file to actual output handle. Don't
- * close outputHandle because it is associated with the output
- * file owned by the caller.
- */
-
- h = CreateFile(outputFileName, GENERIC_READ, 0, NULL, OPEN_ALWAYS,
- 0, NULL);
- if (h != INVALID_HANDLE_VALUE) {
- CopyChannel(outputHandle, h);
- }
- CloseHandle(h);
- }
-
- if (inputFileName == Tcl_DStringValue(&inputTempFile)) {
- DeleteFile(inputFileName);
- }
-
- if (outputFileName == Tcl_DStringValue(&outputTempFile)) {
- DeleteFile(outputFileName);
- }
-
- Tcl_DStringFree(&inputTempFile);
- Tcl_DStringFree(&outputTempFile);
- Tcl_DStringFree(&cmdLine);
- return result;
- }
hProcess = GetCurrentProcess();
/*
@@ -1326,7 +1061,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
CloseHandle(h);
}
} else {
- startInfo.hStdOutput = CreateFile("NUL:", GENERIC_WRITE, 0,
+ startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,
&secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
}
} else {
@@ -1346,7 +1081,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
* deep sink.
*/
- startInfo.hStdError = CreateFile("NUL:", GENERIC_WRITE, 0,
+ startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
} else {
DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
@@ -1433,8 +1168,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
startInfo.dwFlags |= STARTF_USESHOWWINDOW;
createFlags = CREATE_NEW_CONSOLE;
}
- /* CYGNUS LOCAL: We name the DLL cygtclpip. */
- Tcl_DStringAppend(&cmdLine, "cygtclpip" STRINGIFY(TCL_MAJOR_VERSION)
+ Tcl_DStringAppend(&cmdLine, "tclpip" STRINGIFY(TCL_MAJOR_VERSION)
STRINGIFY(TCL_MINOR_VERSION) ".dll ", -1);
}
}
@@ -1458,18 +1192,24 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
* using ab~1.def instead of "a b.default").
*/
- BuildCommandLine(argc, argv, &cmdLine);
+ BuildCommandLine(execPath, argc, argv, &cmdLine);
- if (!CreateProcess(NULL, Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
- createFlags, NULL, NULL, &startInfo, &procInfo)) {
+ if ((*tclWinProcs->createProcessProc)(NULL,
+ (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
+ createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't execute \"", originalName,
+ Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto end;
}
+ /*
+ * This wait is used to force the OS to give some time to the DOS
+ * process.
+ */
+
if (applType == APPL_DOS) {
- WaitForSingleObject(hProcess, 50);
+ WaitForSingleObject(procInfo.hProcess, 50);
}
/*
@@ -1486,11 +1226,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
*pidPtr = (Tcl_Pid) procInfo.hProcess;
if (*pidPtr != 0) {
- ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
- procPtr->hProcess = procInfo.hProcess;
- procPtr->dwProcessId = procInfo.dwProcessId;
- procPtr->nextPtr = procList;
- procList = procPtr;
+ TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
}
result = TCL_OK;
@@ -1529,7 +1265,9 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
static BOOL
HasConsole()
{
- HANDLE handle = CreateFile("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
+ HANDLE handle;
+
+ handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
if (handle != INVALID_HANDLE_VALUE) {
@@ -1577,18 +1315,22 @@ HasConsole()
*/
static int
-ApplicationType(interp, originalName, fullPath)
+ApplicationType(interp, originalName, fullName)
Tcl_Interp *interp; /* Interp, for error message. */
const char *originalName; /* Name of the application to find. */
- char fullPath[MAX_PATH]; /* Filled with complete path to
+ char fullName[]; /* Filled with complete path to
* application. */
{
- int applType, i;
+ int applType, i, nameLen, found;
HANDLE hFile;
- char *ext, *rest;
+ TCHAR *rest;
+ char *ext;
char buf[2];
- DWORD read;
+ DWORD attr, read;
IMAGE_DOS_HEADER header;
+ Tcl_DString nameBuf, ds;
+ TCHAR *nativeName;
+ WCHAR nativeFullPath[MAX_PATH];
static char extensions[][5] = {"", ".com", ".exe", ".bat"};
/* Look for the program as an external program. First try the name
@@ -1605,29 +1347,43 @@ ApplicationType(interp, originalName, fullPath)
*/
applType = APPL_NONE;
+ Tcl_DStringInit(&nameBuf);
+ Tcl_DStringAppend(&nameBuf, originalName, -1);
+ nameLen = Tcl_DStringLength(&nameBuf);
+
for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
- lstrcpyn(fullPath, originalName, MAX_PATH - 5);
- lstrcat(fullPath, extensions[i]);
-
- SearchPath(NULL, fullPath, NULL, MAX_PATH, fullPath, &rest);
+ Tcl_DStringSetLength(&nameBuf, nameLen);
+ Tcl_DStringAppend(&nameBuf, extensions[i], -1);
+ nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
+ Tcl_DStringLength(&nameBuf), &ds);
+ found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
+ MAX_PATH, nativeFullPath, &rest);
+ Tcl_DStringFree(&ds);
+ if (found == 0) {
+ continue;
+ }
/*
* Ignore matches on directories or data files, return if identified
* a known type.
*/
- if (GetFileAttributes(fullPath) & FILE_ATTRIBUTE_DIRECTORY) {
+ attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
+ if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
continue;
}
+ strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
+ Tcl_DStringFree(&ds);
- ext = strrchr(fullPath, '.');
- if ((ext != NULL) && (strcmpi(ext, ".bat") == 0)) {
+ ext = strrchr(fullName, '.');
+ if ((ext != NULL) && (stricmp(ext, ".bat") == 0)) {
applType = APPL_DOS;
break;
}
-
- hFile = CreateFile(fullPath, GENERIC_READ, FILE_SHARE_READ, NULL,
- OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+
+ hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,
+ GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
+ FILE_ATTRIBUTE_NORMAL, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
continue;
}
@@ -1644,7 +1400,7 @@ ApplicationType(interp, originalName, fullPath)
*/
CloseHandle(hFile);
- if ((ext != NULL) && (strcmpi(ext, ".com") == 0)) {
+ if ((ext != NULL) && (strcmp(ext, ".com") == 0)) {
applType = APPL_DOS;
break;
}
@@ -1688,6 +1444,7 @@ ApplicationType(interp, originalName, fullPath)
}
break;
}
+ Tcl_DStringFree(&nameBuf);
if (applType == APPL_NONE) {
TclWinConvertError(GetLastError());
@@ -1704,7 +1461,10 @@ ApplicationType(interp, originalName, fullPath)
* application name from the arguments.
*/
- GetShortPathName(fullPath, fullPath, MAX_PATH);
+ (*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
+ nativeFullPath, MAX_PATH);
+ strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
+ Tcl_DStringFree(&ds);
}
return applType;
}
@@ -1729,18 +1489,32 @@ ApplicationType(interp, originalName, fullPath)
*/
static void
-BuildCommandLine(argc, argv, linePtr)
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
- Tcl_DString *linePtr; /* Initialized Tcl_DString that receives the
- * command line. */
+BuildCommandLine(
+ CONST char *executable, /* Full path of executable (including
+ * extension). Replacement for argv[0]. */
+ int argc, /* Number of arguments. */
+ char **argv, /* Argument strings in UTF. */
+ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the
+ * command line (TCHAR). */
{
- char *start, *special;
+ CONST char *arg, *start, *special;
int quote, i;
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+
+ /*
+ * Prime the path.
+ */
+
+ Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
+
for (i = 0; i < argc; i++) {
- if (i > 0) {
- Tcl_DStringAppend(linePtr, " ", 1);
+ if (i == 0) {
+ arg = executable;
+ } else {
+ arg = argv[i];
+ Tcl_DStringAppend(&ds, " ", 1);
}
quote = 0;
@@ -1748,21 +1522,21 @@ BuildCommandLine(argc, argv, linePtr)
quote = 1;
} else {
for (start = argv[i]; *start != '\0'; start++) {
- if (isspace(*start)) {
+ if (isspace(*start)) { /* INTL: ISO space. */
quote = 1;
break;
}
}
}
if (quote) {
- Tcl_DStringAppend(linePtr, "\"", 1);
+ Tcl_DStringAppend(&ds, "\"", 1);
}
- start = argv[i];
- for (special = argv[i]; ; ) {
+ start = arg;
+ for (special = arg; ; ) {
if ((*special == '\\') &&
(special[1] == '\\' || special[1] == '"')) {
- Tcl_DStringAppend(linePtr, start, special - start);
+ Tcl_DStringAppend(&ds, start, special - start);
start = special;
while (1) {
special++;
@@ -1772,19 +1546,19 @@ BuildCommandLine(argc, argv, linePtr)
* N * 2 + 1 backslashes then a quote.
*/
- Tcl_DStringAppend(linePtr, start, special - start);
+ Tcl_DStringAppend(&ds, start, special - start);
break;
}
if (*special != '\\') {
break;
}
}
- Tcl_DStringAppend(linePtr, start, special - start);
+ Tcl_DStringAppend(&ds, start, special - start);
start = special;
}
if (*special == '"') {
- Tcl_DStringAppend(linePtr, start, special - start);
- Tcl_DStringAppend(linePtr, "\\\"", 2);
+ Tcl_DStringAppend(&ds, start, special - start);
+ Tcl_DStringAppend(&ds, "\\\"", 2);
start = special + 1;
}
if (*special == '\0') {
@@ -1792,85 +1566,13 @@ BuildCommandLine(argc, argv, linePtr)
}
special++;
}
- Tcl_DStringAppend(linePtr, start, special - start);
+ Tcl_DStringAppend(&ds, start, special - start);
if (quote) {
- Tcl_DStringAppend(linePtr, "\"", 1);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MakeTempFile --
- *
- * Helper function for TclpCreateProcess under Win32s. Makes a
- * temporary file that _won't_ go away automatically when it's file
- * handle is closed. Used for simulated pipes, which are written
- * in one pass and reopened and read in the next pass.
- *
- * Results:
- * namePtr is filled with the name of the temporary file.
- *
- * Side effects:
- * A temporary file with the name specified by namePtr is created.
- * The caller is responsible for deleting this temporary file.
- *
- *----------------------------------------------------------------------
- */
-
-static char *
-MakeTempFile(namePtr)
- Tcl_DString *namePtr; /* Initialized Tcl_DString that is filled
- * with the name of the temporary file that
- * was created. */
-{
- char name[MAX_PATH];
-
- if (TempFileName(name) == 0) {
- return NULL;
- }
-
- Tcl_DStringAppend(namePtr, name, -1);
- return Tcl_DStringValue(namePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CopyChannel --
- *
- * Helper function used by TclpCreateProcess under Win32s. Copies
- * what remains of source file to destination file; source file
- * pointer need not be positioned at the beginning of the file if
- * all of source file is not desired, but data is copied up to end
- * of source file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-CopyChannel(dst, src)
- HANDLE dst; /* Destination file. */
- HANDLE src; /* Source file. */
-{
- char buf[8192];
- DWORD dwRead, dwWrite;
-
- while (ReadFile(src, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
- if (dwRead == 0) {
- break;
- }
- if (WriteFile(dst, buf, dwRead, &dwWrite, NULL) == FALSE) {
- break;
+ Tcl_DStringAppend(&ds, "\"", 1);
}
}
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
+ Tcl_DStringFree(&ds);
}
/*
@@ -1892,32 +1594,32 @@ CopyChannel(dst, src)
*/
Tcl_Channel
-TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
- TclFile readFile; /* If non-null, gives the file for reading. */
- TclFile writeFile; /* If non-null, gives the file for writing. */
- TclFile errorFile; /* If non-null, gives the file where errors
+TclpCreateCommandChannel(
+ TclFile readFile, /* If non-null, gives the file for reading. */
+ TclFile writeFile, /* If non-null, gives the file for writing. */
+ TclFile errorFile, /* If non-null, gives the file where errors
* can be read. */
- int numPids; /* The number of pids in the pid array. */
- Tcl_Pid *pidPtr; /* An array of process identifiers. */
+ int numPids, /* The number of pids in the pid array. */
+ Tcl_Pid *pidPtr) /* An array of process identifiers. */
{
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
int channelId;
+ DWORD id;
PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));
- if (!initialized) {
- PipeInit();
- }
+ PipeInit();
infoPtr->watchMask = 0;
infoPtr->flags = 0;
+ infoPtr->readFlags = 0;
infoPtr->readFile = readFile;
infoPtr->writeFile = writeFile;
infoPtr->errorFile = errorFile;
infoPtr->numPids = numPids;
infoPtr->pidPtr = pidPtr;
-
- /* CYGNUS LOCAL: Mutex for flags. */
- infoPtr->flagsMutex = CreateMutex(NULL, FALSE, NULL);
+ infoPtr->writeBuf = 0;
+ infoPtr->writeBufLen = 0;
+ infoPtr->writeError = 0;
/*
* Use one of the fds associated with the channel as the
@@ -1925,13 +1627,7 @@ TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
*/
if (readFile) {
- WinPipe *pipePtr = (WinPipe *) readFile;
- if (pipePtr->file.type == WIN32S_PIPE
- && pipePtr->file.handle == INVALID_HANDLE_VALUE) {
- pipePtr->file.handle = CreateFile(pipePtr->fileName, GENERIC_READ,
- 0, NULL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
- }
- channelId = (int) pipePtr->file.handle;
+ channelId = (int) ((WinFile*)readFile)->handle;
} else if (writeFile) {
channelId = (int) ((WinFile*)writeFile)->handle;
} else if (errorFile) {
@@ -1941,10 +1637,33 @@ TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
}
infoPtr->validMask = 0;
+
+ infoPtr->threadId = Tcl_GetCurrentThread();
+
if (readFile != NULL) {
+ /*
+ * Start the background reader thread.
+ */
+
+ infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->readThread = CreateThread(NULL, 8000, PipeReaderThread,
+ infoPtr, 0, &id);
+ SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
infoPtr->validMask |= TCL_READABLE;
+ } else {
+ infoPtr->readThread = 0;
}
if (writeFile != NULL) {
+ /*
+ * Start the background writeer thwrite.
+ */
+
+ infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
+ infoPtr->writeThread = CreateThread(NULL, 8000, PipeWriterThread,
+ infoPtr, 0, &id);
+ SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
infoPtr->validMask |= TCL_WRITABLE;
}
@@ -1952,9 +1671,11 @@ TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
* For backward compatibility with previous versions of Tcl, we
* use "file%d" as the base name for pipes even though it would
* be more natural to use "pipe%d".
+ * Use the pointer to keep the channel names unique, in case
+ * channels share handles (stdin/stdout).
*/
- sprintf(channelName, "file%d", channelId);
+ wsprintfA(channelName, "file%lx", infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
(ClientData) infoPtr, infoPtr->validMask);
@@ -1977,26 +1698,26 @@ TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
* TclGetAndDetachPids --
*
* Stores a list of the command PIDs for a command channel in
- * interp->result.
+ * the interp's result.
*
* Results:
* None.
*
* Side effects:
- * Modifies interp->result.
+ * Modifies the interp's result.
*
*----------------------------------------------------------------------
*/
void
-TclGetAndDetachPids(interp, chan)
- Tcl_Interp *interp;
- Tcl_Channel chan;
+TclGetAndDetachPids(
+ Tcl_Interp *interp,
+ Tcl_Channel chan)
{
PipeInfo *pipePtr;
Tcl_ChannelType *chanTypePtr;
int i;
- char buf[20];
+ char buf[TCL_INTEGER_SPACE];
/*
* Punt if the channel is not a command channel.
@@ -2009,7 +1730,7 @@ TclGetAndDetachPids(interp, chan)
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
for (i = 0; i < pipePtr->numPids; i++) {
- sprintf(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
+ wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
Tcl_AppendElement(interp, buf);
Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
}
@@ -2036,9 +1757,9 @@ TclGetAndDetachPids(interp, chan)
*/
static int
-PipeBlockModeProc(instanceData, mode)
- ClientData instanceData; /* Instance data for channel. */
- int mode; /* TCL_MODE_BLOCKING or
+PipeBlockModeProc(
+ ClientData instanceData, /* Instance data for channel. */
+ int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
@@ -2051,9 +1772,9 @@ PipeBlockModeProc(instanceData, mode)
*/
if (mode == TCL_MODE_NONBLOCKING) {
- PipeSetFlag(infoPtr, PIPE_ASYNC);
+ infoPtr->flags |= PIPE_ASYNC;
} else {
- PipeResetFlag(infoPtr, PIPE_ASYNC);
+ infoPtr->flags &= ~(PIPE_ASYNC);
}
return 0;
}
@@ -2061,7 +1782,7 @@ PipeBlockModeProc(instanceData, mode)
/*
*----------------------------------------------------------------------
*
- * PipeCloseProc --
+ * PipeClose2Proc --
*
* Closes a pipe based IO channel.
*
@@ -2075,82 +1796,158 @@ PipeBlockModeProc(instanceData, mode)
*/
static int
-PipeCloseProc(instanceData, interp)
- ClientData instanceData; /* Pointer to PipeInfo structure. */
- Tcl_Interp *interp; /* For error reporting. */
+PipeClose2Proc(
+ ClientData instanceData, /* Pointer to PipeInfo structure. */
+ Tcl_Interp *interp, /* For error reporting. */
+ int flags) /* Flags that indicate which side to close. */
{
PipeInfo *pipePtr = (PipeInfo *) instanceData;
Tcl_Channel errChan;
int errorCode, result;
PipeInfo *infoPtr, **nextPtrPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- /*
- * Remove the file from the list of watched files.
- */
+ errorCode = 0;
+ if ((!flags || (flags == TCL_CLOSE_READ))
+ && (pipePtr->readFile != NULL)) {
+ /*
+ * Clean up the background thread if necessary. Note that this
+ * must be done before we can close the file, since the
+ * thread may be blocking trying to read from the pipe.
+ */
- for (nextPtrPtr = &firstPipePtr, infoPtr = *nextPtrPtr; infoPtr != NULL;
- nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
- if (infoPtr == (PipeInfo *)pipePtr) {
- *nextPtrPtr = infoPtr->nextPtr;
- break;
- }
- }
+ if (pipePtr->readThread) {
+ /*
+ * Forcibly terminate the background thread. We cannot rely on the
+ * thread to cleanly terminate itself because we have no way of
+ * closing the pipe handle without blocking in the case where the
+ * thread is in the middle of an I/O operation. Note that we need
+ * to guard against terminating the thread while it is in the
+ * middle of Tcl_ThreadAlert because it won't be able to release
+ * the notifier lock.
+ */
- errorCode = 0;
- if (pipePtr->readFile != NULL) {
+ Tcl_MutexLock(&pipeMutex);
+ TerminateThread(pipePtr->readThread, 0);
+
+ /*
+ * Wait for the thread to terminate. This ensures that we are
+ * completely cleaned up before we leave this function.
+ */
+
+ WaitForSingleObject(pipePtr->readThread, INFINITE);
+ Tcl_MutexUnlock(&pipeMutex);
+
+ CloseHandle(pipePtr->readThread);
+ CloseHandle(pipePtr->readable);
+ CloseHandle(pipePtr->startReader);
+ pipePtr->readThread = NULL;
+ }
if (TclpCloseFile(pipePtr->readFile) != 0) {
errorCode = errno;
}
+ pipePtr->validMask &= ~TCL_READABLE;
+ pipePtr->readFile = NULL;
}
- if (pipePtr->writeFile != NULL) {
+ if ((!flags || (flags & TCL_CLOSE_WRITE))
+ && (pipePtr->writeFile != NULL)) {
+ /*
+ * Wait for the writer thread to finish the current buffer, then
+ * terminate the thread and close the handles. If the channel is
+ * nonblocking, there should be no pending write operations.
+ */
+
+ if (pipePtr->writeThread) {
+ WaitForSingleObject(pipePtr->writable, INFINITE);
+
+ /*
+ * Forcibly terminate the background thread. We cannot rely on the
+ * thread to cleanly terminate itself because we have no way of
+ * closing the pipe handle without blocking in the case where the
+ * thread is in the middle of an I/O operation. Note that we need
+ * to guard against terminating the thread while it is in the
+ * middle of Tcl_ThreadAlert because it won't be able to release
+ * the notifier lock.
+ */
+
+ Tcl_MutexLock(&pipeMutex);
+ TerminateThread(pipePtr->writeThread, 0);
+
+ /*
+ * Wait for the thread to terminate. This ensures that we are
+ * completely cleaned up before we leave this function.
+ */
+
+ WaitForSingleObject(pipePtr->writeThread, INFINITE);
+ Tcl_MutexUnlock(&pipeMutex);
+
+
+ CloseHandle(pipePtr->writeThread);
+ CloseHandle(pipePtr->writable);
+ CloseHandle(pipePtr->startWriter);
+ pipePtr->writeThread = NULL;
+ }
if (TclpCloseFile(pipePtr->writeFile) != 0) {
if (errorCode == 0) {
errorCode = errno;
}
}
+ pipePtr->validMask &= ~TCL_WRITABLE;
+ pipePtr->writeFile = NULL;
}
-
+
+ pipePtr->watchMask &= pipePtr->validMask;
+
+ /*
+ * Don't free the channel if any of the flags were set.
+ */
+
+ if (flags) {
+ return errorCode;
+ }
+
+ /*
+ * Remove the file from the list of watched files.
+ */
+
+ for (nextPtrPtr = &(tsdPtr->firstPipePtr), infoPtr = *nextPtrPtr;
+ infoPtr != NULL;
+ nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
+ if (infoPtr == (PipeInfo *)pipePtr) {
+ *nextPtrPtr = infoPtr->nextPtr;
+ break;
+ }
+ }
+
/*
* Wrap the error file into a channel and give it to the cleanup
- * routine. If we are running in Win32s, just delete the error file
- * immediately, because it was never used.
+ * routine.
*/
if (pipePtr->errorFile) {
WinFile *filePtr;
- OSVERSIONINFO os;
- os.dwOSVersionInfoSize = sizeof(os);
- GetVersionEx(&os);
- if (os.dwPlatformId == VER_PLATFORM_WIN32s) {
- TclpCloseFile(pipePtr->errorFile);
- errChan = NULL;
- } else {
- filePtr = (WinFile*)pipePtr->errorFile;
- errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
- TCL_READABLE);
- }
+ filePtr = (WinFile*)pipePtr->errorFile;
+ errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
+ TCL_READABLE);
+ ckfree((char *) filePtr);
} else {
errChan = NULL;
}
+
result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
errChan);
+
if (pipePtr->numPids > 0) {
ckfree((char *) pipePtr->pidPtr);
}
- /* CYGNUS LOCAL: If the pipe has a thread, let the thread free the
- structure. */
- if (PipeGetFlags(pipePtr) & PIPE_HAS_THREAD) {
- WaitForSingleObject(pipePtr->flagsMutex, INFINITE);
- pipePtr->flags |= PIPE_CLOSED;
- SetEvent(pipePtr->tryReadEvent);
- ReleaseMutex(pipePtr->flagsMutex);
- } else {
- CloseHandle(pipePtr->flagsMutex);
- ckfree((char*) pipePtr);
+ if (pipePtr->writeBuf != NULL) {
+ ckfree(pipePtr->writeBuf);
}
+ ckfree((char*) pipePtr);
+
if (errorCode == 0) {
return result;
}
@@ -2176,107 +1973,75 @@ PipeCloseProc(instanceData, interp)
*/
static int
-PipeInputProc(instanceData, buf, bufSize, errorCode)
- ClientData instanceData; /* Pipe state. */
- char *buf; /* Where to store data read. */
- int bufSize; /* How much space is available
+PipeInputProc(
+ ClientData instanceData, /* Pipe state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available
* in the buffer? */
- int *errorCode; /* Where to store error code. */
+ int *errorCode) /* Where to store error code. */
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
WinFile *filePtr = (WinFile*) infoPtr->readFile;
- DWORD count;
- DWORD bytesRead;
- int gotReadAhead = 0;
- int origBufSize = bufSize;
+ DWORD count, bytesRead = 0;
+ int result;
- /* CYGNUS LOCAL: If the pipe has a thread, lock it. */
- if (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) {
- WaitForSingleObject(infoPtr->mutex, INFINITE);
+ *errorCode = 0;
+ /*
+ * Synchronize with the reader thread.
+ */
+
+ result = WaitForRead(infoPtr, (infoPtr->flags & PIPE_ASYNC) ? 0 : 1);
+
+ /*
+ * If an error occurred, return immediately.
+ */
+
+ if (result == -1) {
+ *errorCode = errno;
+ return -1;
}
- *errorCode = 0;
- if (filePtr->type == WIN32S_PIPE) {
- if (((WinPipe *)filePtr)->otherPtr != NULL) {
- panic("PipeInputProc: child process isn't finished writing");
- }
- if (filePtr->handle == INVALID_HANDLE_VALUE) {
- filePtr->handle = CreateFile(((WinPipe *)filePtr)->fileName,
- GENERIC_READ, 0, NULL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL,
- NULL);
- }
- if (filePtr->handle == INVALID_HANDLE_VALUE) {
- goto error;
- }
- } else {
+ if (infoPtr->readFlags & PIPE_EXTRABYTE) {
/*
- * Pipes will block until the requested number of bytes has been
- * read. To avoid blocking unnecessarily, we look ahead and only
- * read as much as is available.
+ * The reader thread consumed 1 byte as a side effect of
+ * waiting so we need to move it into the buffer.
*/
- if (PeekNamedPipe(filePtr->handle, (LPVOID) NULL, (DWORD) 0,
- (LPDWORD) NULL, &count, (LPDWORD) NULL) == TRUE) {
- if ((count != 0) && ((DWORD) bufSize > count)) {
- bufSize = (int) count;
+ *buf = infoPtr->extraByte;
+ infoPtr->readFlags &= ~PIPE_EXTRABYTE;
+ buf++;
+ bufSize--;
+ bytesRead = 1;
- /*
- * This code is commented out because on Win95 we don't get
- * notifier of eof on a pipe unless we try to read it.
- * The correct solution is to move to threads.
- */
+ /*
+ * If further read attempts would block, return what we have.
+ */
-/* } else if ((count == 0) && (PipeGetFlags(infoPtr) & PIPE_ASYNC)) { */
-/* errno = *errorCode = EAGAIN; */
-/* return -1; */
- } else if ((count == 0) && !(PipeGetFlags(infoPtr) & PIPE_ASYNC)) {
- bufSize = 1;
- }
- } else {
- goto error;
- }
- }
-
- /* CYGNUS LOCAL: Check for the readahead byte. */
- if (PipeGetFlags(infoPtr) & PIPE_READAHEAD) {
- *buf++ = infoPtr->readAhead;
- PipeResetFlag(infoPtr, PIPE_READAHEAD);
- if (bufSize <= 1) {
- PipeResetFlag(infoPtr, PIPE_READABLE);
- ReleaseMutex(infoPtr->mutex);
- return 1;
- }
- gotReadAhead = 1;
- if (bufSize == origBufSize) {
- --bufSize;
+ if (result == 0) {
+ return bytesRead;
}
}
/*
- * Note that we will block on reads from a console buffer until a
- * full line has been entered. The only way I know of to get
- * around this is to write a console driver. We should probably
- * do this at some point, but for now, we just block.
+ * Attempt to read bufSize bytes. The read will return immediately
+ * if there is any data available. Otherwise it will block until
+ * at least one byte is available or an EOF occurs.
*/
- if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
- (LPOVERLAPPED) NULL) == FALSE) {
- goto error;
- }
-
- if (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) {
- PipeResetFlag(infoPtr, PIPE_READABLE);
- ReleaseMutex(infoPtr->mutex);
- }
+ if (ReadFile(filePtr->handle, (LPVOID) buf, (DWORD) bufSize, &count,
+ (LPOVERLAPPED) NULL) == TRUE) {
+ return bytesRead + count;
+ } else if (bytesRead) {
+ /*
+ * Ignore errors if we have data to return.
+ */
- return bytesRead + gotReadAhead;
+ return bytesRead;
+ }
- error:
TclWinConvertError(GetLastError());
- if (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) {
- ReleaseMutex(infoPtr->mutex);
- }
if (errno == EPIPE) {
+ infoPtr->readFlags |= PIPE_EOF;
return 0;
}
*errorCode = errno;
@@ -2302,27 +2067,78 @@ PipeInputProc(instanceData, buf, bufSize, errorCode)
*/
static int
-PipeOutputProc(instanceData, buf, toWrite, errorCode)
- ClientData instanceData; /* Pipe state. */
- char *buf; /* The data buffer. */
- int toWrite; /* How many bytes to write? */
- int *errorCode; /* Where to store error code. */
+PipeOutputProc(
+ ClientData instanceData, /* Pipe state. */
+ char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
WinFile *filePtr = (WinFile*) infoPtr->writeFile;
- DWORD bytesWritten;
+ DWORD bytesWritten, timeout;
*errorCode = 0;
- if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
- &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
- TclWinConvertError(GetLastError());
- if (errno == EPIPE) {
- return 0;
- }
- *errorCode = errno;
- return -1;
+ timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE;
+ if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
+ /*
+ * The writer thread is blocked waiting for a write to complete
+ * and the channel is in non-blocking mode.
+ */
+
+ errno = EAGAIN;
+ goto error;
+ }
+
+ /*
+ * Check for a background error on the last write.
+ */
+
+ if (infoPtr->writeError) {
+ TclWinConvertError(infoPtr->writeError);
+ infoPtr->writeError = 0;
+ goto error;
+ }
+
+ if (infoPtr->flags & PIPE_ASYNC) {
+ /*
+ * The pipe is non-blocking, so copy the data into the output
+ * buffer and restart the writer thread.
+ */
+
+ if (toWrite > infoPtr->writeBufLen) {
+ /*
+ * Reallocate the buffer to be large enough to hold the data.
+ */
+
+ if (infoPtr->writeBuf) {
+ ckfree(infoPtr->writeBuf);
+ }
+ infoPtr->writeBufLen = toWrite;
+ infoPtr->writeBuf = ckalloc(toWrite);
+ }
+ memcpy(infoPtr->writeBuf, buf, toWrite);
+ infoPtr->toWrite = toWrite;
+ ResetEvent(infoPtr->writable);
+ SetEvent(infoPtr->startWriter);
+ bytesWritten = toWrite;
+ } else {
+ /*
+ * In the blocking case, just try to write the buffer directly.
+ * This avoids an unnecessary copy.
+ */
+
+ if (WriteFile(filePtr->handle, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
+ TclWinConvertError(GetLastError());
+ goto error;
+ }
}
return bytesWritten;
+
+ error:
+ *errorCode = errno;
+ return -1;
+
}
/*
@@ -2347,16 +2163,16 @@ PipeOutputProc(instanceData, buf, toWrite, errorCode)
*/
static int
-PipeEventProc(evPtr, flags)
- Tcl_Event *evPtr; /* Event to service. */
- int flags; /* Flags that indicate what events to
+PipeEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to
* handle, such as TCL_FILE_EVENTS. */
{
PipeEvent *pipeEvPtr = (PipeEvent *)evPtr;
PipeInfo *infoPtr;
WinFile *filePtr;
int mask;
-/* DWORD count;*/
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -2369,9 +2185,10 @@ PipeEventProc(evPtr, flags)
* event is in the queue.
*/
- for (infoPtr = firstPipePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstPipePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (pipeEvPtr->infoPtr == infoPtr) {
- PipeResetFlag(infoPtr, PIPE_PENDING);
+ infoPtr->flags &= ~(PIPE_PENDING);
break;
}
}
@@ -2385,42 +2202,26 @@ PipeEventProc(evPtr, flags)
}
/*
- * If we aren't on Win32s, check to see if the pipe is readable. Note
+ * Check to see if the pipe is readable. Note
* that we can't tell if a pipe is writable, so we always report it
- * as being writable.
+ * as being writable unless we have detected EOF.
*/
- filePtr = (WinFile*) ((PipeInfo*)infoPtr)->readFile;
- if (filePtr->type != WIN32S_PIPE) {
+ filePtr = (WinFile*) ((PipeInfo*)infoPtr)->writeFile;
+ mask = 0;
+ if ((infoPtr->watchMask & TCL_WRITABLE) &&
+ (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT)) {
+ mask = TCL_WRITABLE;
+ }
- /* CYGNUS LOCAL: Check PIPE_READABLE if we have a thread. */
- if (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) {
- mask = TCL_WRITABLE;
- if (PipeGetFlags(infoPtr) & PIPE_READABLE) {
- mask |= TCL_READABLE;
- }
+ filePtr = (WinFile*) ((PipeInfo*)infoPtr)->readFile;
+ if ((infoPtr->watchMask & TCL_READABLE) &&
+ (WaitForRead(infoPtr, 0) >= 0)) {
+ if (infoPtr->readFlags & PIPE_EOF) {
+ mask = TCL_READABLE;
} else {
- mask = TCL_WRITABLE|TCL_READABLE;
+ mask |= TCL_READABLE;
}
-
-/* if (PeekNamedPipe(filePtr->handle, (LPVOID) NULL, (DWORD) 0, */
-/* (LPDWORD) NULL, &count, (LPDWORD) NULL) == TRUE) { */
-/* if (count != 0) { */
-/* mask |= TCL_READABLE; */
-/* } */
-/* } else { */
-
- /*
- * If the pipe has been closed by the other side, then
- * mark the pipe as readable, but not writable.
- */
-
-/* if (GetLastError() == ERROR_BROKEN_PIPE) { */
-/* mask = TCL_READABLE; */
-/* } */
-/* } */
- } else {
- mask = TCL_READABLE | TCL_WRITABLE;
}
/*
@@ -2449,41 +2250,29 @@ PipeEventProc(evPtr, flags)
*/
static void
-PipeWatchProc(instanceData, mask)
- ClientData instanceData; /* Pipe state. */
- int mask; /* What events to watch for; OR-ed
+PipeWatchProc(
+ ClientData instanceData, /* Pipe state. */
+ int mask) /* What events to watch for, OR-ed
* combination of TCL_READABLE,
* TCL_WRITABLE and TCL_EXCEPTION. */
{
PipeInfo **nextPtrPtr, *ptr;
PipeInfo *infoPtr = (PipeInfo *) instanceData;
int oldMask = infoPtr->watchMask;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
- * For now, we just send a message to ourselves so we can poll the
- * channel for readable events.
+ * Since most of the work is handled by the background threads,
+ * we just need to update the watchMask and then force the notifier
+ * to poll once.
*/
infoPtr->watchMask = mask & infoPtr->validMask;
if (infoPtr->watchMask) {
Tcl_Time blockTime = { 0, 0 };
-
- /* CYGNUS LOCAL: Set up a thread if necessary. */
- if ((infoPtr->watchMask & TCL_READABLE) != 0
- && (PipeGetFlags(infoPtr) & PIPE_HAS_THREAD) == 0) {
- HANDLE thread;
- DWORD tid;
-
- infoPtr->tryReadEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->mutex = CreateMutex(NULL, FALSE, NULL);
- PipeSetFlag(infoPtr, PIPE_HAS_THREAD);
- thread = CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE) PipeThread, infoPtr, 0, &tid);
- CloseHandle(thread);
- }
-
if (!oldMask) {
- infoPtr->nextPtr = firstPipePtr;
- firstPipePtr = infoPtr;
+ infoPtr->nextPtr = tsdPtr->firstPipePtr;
+ tsdPtr->firstPipePtr = infoPtr;
}
Tcl_SetMaxBlockTime(&blockTime);
} else {
@@ -2492,7 +2281,7 @@ PipeWatchProc(instanceData, mask)
* Remove the pipe from the list of watched pipes.
*/
- for (nextPtrPtr = &firstPipePtr, ptr = *nextPtrPtr;
+ for (nextPtrPtr = &(tsdPtr->firstPipePtr), ptr = *nextPtrPtr;
ptr != NULL;
nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
if (infoPtr == ptr) {
@@ -2523,26 +2312,16 @@ PipeWatchProc(instanceData, mask)
*/
static int
-PipeGetHandleProc(instanceData, direction, handlePtr)
- ClientData instanceData; /* The pipe state. */
- int direction; /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr; /* Where to store the handle. */
+PipeGetHandleProc(
+ ClientData instanceData, /* The pipe state. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr) /* Where to store the handle. */
{
PipeInfo *infoPtr = (PipeInfo *) instanceData;
WinFile *filePtr;
if (direction == TCL_READABLE && infoPtr->readFile) {
filePtr = (WinFile*) infoPtr->readFile;
- if (filePtr->type == WIN32S_PIPE) {
- if (filePtr->handle == INVALID_HANDLE_VALUE) {
- filePtr->handle = CreateFile(((WinPipe *)filePtr)->fileName,
- GENERIC_READ, 0, NULL, OPEN_ALWAYS,
- FILE_ATTRIBUTE_NORMAL, NULL);
- }
- if (filePtr->handle == INVALID_HANDLE_VALUE) {
- return TCL_ERROR;
- }
- }
*handlePtr = (ClientData) filePtr->handle;
return TCL_OK;
}
@@ -2574,19 +2353,17 @@ PipeGetHandleProc(instanceData, direction, handlePtr)
*/
Tcl_Pid
-Tcl_WaitPid(pid, statPtr, options)
- Tcl_Pid pid;
- int *statPtr;
- int options;
+Tcl_WaitPid(
+ Tcl_Pid pid,
+ int *statPtr,
+ int options)
{
ProcInfo *infoPtr, **prevPtrPtr;
int flags;
Tcl_Pid result;
DWORD ret;
- if (!initialized) {
- PipeInit();
- }
+ PipeInit();
/*
* If no pid is specified, do nothing.
@@ -2601,6 +2378,7 @@ Tcl_WaitPid(pid, statPtr, options)
* Find the process on the process list.
*/
+ Tcl_MutexLock(&pipeMutex);
prevPtrPtr = &procList;
for (infoPtr = procList; infoPtr != NULL;
prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
@@ -2608,12 +2386,13 @@ Tcl_WaitPid(pid, statPtr, options)
break;
}
}
+ Tcl_MutexUnlock(&pipeMutex);
/*
* If the pid is not one of the processes we know about (we started it)
* then do nothing.
*/
-
+
if (infoPtr == NULL) {
*statPtr = 0;
return 0;
@@ -2639,15 +2418,15 @@ Tcl_WaitPid(pid, statPtr, options)
}
} else if (ret != WAIT_FAILED) {
GetExitCodeProcess(infoPtr->hProcess, (DWORD*)statPtr);
-#ifdef __CYGWIN32__
- /* A cygwin32 program that exits because of a signal will set
+#ifdef __CYGWIN__
+ /* A Cygwin program that exits because of a signal will set
the exit status to 0x10000 | (sig << 8). Fix that back
into a standard Unix wait status. */
- if ((*statPtr & 0x10000) != 0
- && (*statPtr & 0xff00) != 0
- && (*statPtr & ~ 0x1ff00) == 0) {
- *statPtr = (*statPtr >> 8) & 0xff;
- } else
+ if ((*statPtr & 0x10000) != 0
+ && (*statPtr & 0xff00) != 0
+ && (*statPtr & ~ 0x1ff00) == 0) {
+ *statPtr = (*statPtr >> 8) & 0xff;
+ } else
#endif
*statPtr = ((*statPtr << 8) & 0xff00);
result = pid;
@@ -2671,6 +2450,38 @@ Tcl_WaitPid(pid, statPtr, options)
/*
*----------------------------------------------------------------------
*
+ * TclWinAddProcess --
+ *
+ * Add a process to the process list so that we can use
+ * Tcl_WaitPid on the process.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Adds the specified process handle to the process list so
+ * Tcl_WaitPid knows about it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclWinAddProcess(hProcess, id)
+ HANDLE hProcess; /* Handle to process */
+ DWORD id; /* Global process identifier */
+{
+ ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));
+ procPtr->hProcess = hProcess;
+ procPtr->dwProcessId = id;
+ Tcl_MutexLock(&pipeMutex);
+ procPtr->nextPtr = procList;
+ procList = procPtr;
+ Tcl_MutexUnlock(&pipeMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_PidObjCmd --
*
* This procedure is invoked to process the "pid" Tcl command.
@@ -2687,18 +2498,18 @@ Tcl_WaitPid(pid, statPtr, options)
/* ARGSUSED */
int
-Tcl_PidObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST *objv; /* Argument strings. */
+Tcl_PidObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST *objv) /* Argument strings. */
{
Tcl_Channel chan;
Tcl_ChannelType *chanTypePtr;
PipeInfo *pipePtr;
int i;
Tcl_Obj *resultPtr;
- char buf[20];
+ char buf[TCL_INTEGER_SPACE];
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
@@ -2706,7 +2517,7 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
}
if (objc == 1) {
resultPtr = Tcl_GetObjResult(interp);
- sprintf(buf, "%lu", (unsigned long) getpid());
+ wsprintfA(buf, "%lu", (unsigned long) getpid());
Tcl_SetStringObj(resultPtr, buf, -1);
} else {
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
@@ -2722,10 +2533,305 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
resultPtr = Tcl_GetObjResult(interp);
for (i = 0; i < pipePtr->numPids; i++) {
- sprintf(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
+ wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
Tcl_NewStringObj(buf, -1));
}
}
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForRead --
+ *
+ * Wait until some data is available, the pipe is at
+ * EOF or the reader thread is blocked waiting for data (if the
+ * channel is in non-blocking mode).
+ *
+ * Results:
+ * Returns 1 if pipe is readable. Returns 0 if there is no data
+ * on the pipe, but there is buffered data. Returns -1 if an
+ * error occurred. If an error occurred, the threads may not
+ * be synchronized.
+ *
+ * Side effects:
+ * Updates the shared state flags and may consume 1 byte of data
+ * from the pipe. If no error occurred, the reader thread is
+ * blocked waiting for a signal from the main thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForRead(
+ PipeInfo *infoPtr, /* Pipe state. */
+ int blocking) /* Indicates whether call should be
+ * blocking or not. */
+{
+ DWORD timeout, count;
+ HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
+
+ while (1) {
+ /*
+ * Synchronize with the reader thread.
+ */
+
+ timeout = blocking ? INFINITE : 0;
+ if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
+ /*
+ * The reader thread is blocked waiting for data and the channel
+ * is in non-blocking mode.
+ */
+
+ errno = EAGAIN;
+ return -1;
+ }
+
+ /*
+ * At this point, the two threads are synchronized, so it is safe
+ * to access shared state.
+ */
+
+
+ /*
+ * If the pipe has hit EOF, it is always readable.
+ */
+
+ if (infoPtr->readFlags & PIPE_EOF) {
+ return 1;
+ }
+
+ /*
+ * Check to see if there is any data sitting in the pipe.
+ */
+
+ if (PeekNamedPipe(handle, (LPVOID) NULL, (DWORD) 0,
+ (LPDWORD) NULL, &count, (LPDWORD) NULL) != TRUE) {
+ TclWinConvertError(GetLastError());
+ /*
+ * Check to see if the peek failed because of EOF.
+ */
+
+ if (errno == EPIPE) {
+ infoPtr->readFlags |= PIPE_EOF;
+ return 1;
+ }
+
+ /*
+ * Ignore errors if there is data in the buffer.
+ */
+
+ if (infoPtr->readFlags & PIPE_EXTRABYTE) {
+ return 0;
+ } else {
+ return -1;
+ }
+ }
+
+ /*
+ * We found some data in the pipe, so it must be readable.
+ */
+
+ if (count > 0) {
+ return 1;
+ }
+
+ /*
+ * The pipe isn't readable, but there is some data sitting
+ * in the buffer, so return immediately.
+ */
+
+ if (infoPtr->readFlags & PIPE_EXTRABYTE) {
+ return 0;
+ }
+
+ /*
+ * There wasn't any data available, so reset the thread and
+ * try again.
+ */
+
+ ResetEvent(infoPtr->readable);
+ SetEvent(infoPtr->startReader);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeReaderThread --
+ *
+ * This function runs in a separate thread and waits for input
+ * to become available on a pipe.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Signals the main thread when input become available. May
+ * cause the main thread to wake up by posting a message. May
+ * consume one byte from the pipe for each wait operation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+PipeReaderThread(LPVOID arg)
+{
+ PipeInfo *infoPtr = (PipeInfo *)arg;
+ HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
+ DWORD count, err;
+ int done = 0;
+
+ while (!done) {
+ /*
+ * Wait for the main thread to signal before attempting to wait.
+ */
+
+ WaitForSingleObject(infoPtr->startReader, INFINITE);
+
+ /*
+ * Try waiting for 0 bytes. This will block until some data is
+ * available on NT, but will return immediately on Win 95. So,
+ * if no data is available after the first read, we block until
+ * we can read a single byte off of the pipe.
+ */
+
+ if ((ReadFile(handle, NULL, 0, &count, NULL) == FALSE)
+ || (PeekNamedPipe(handle, NULL, 0, NULL, &count,
+ NULL) == FALSE)) {
+ /*
+ * The error is a result of an EOF condition, so set the
+ * EOF bit before signalling the main thread.
+ */
+
+ err = GetLastError();
+ if (err == ERROR_BROKEN_PIPE) {
+ infoPtr->readFlags |= PIPE_EOF;
+ done = 1;
+ } else if (err == ERROR_INVALID_HANDLE) {
+ break;
+ }
+ } else if (count == 0) {
+ if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL)
+ != FALSE) {
+ /*
+ * One byte was consumed as a side effect of waiting
+ * for the pipe to become readable.
+ */
+
+ infoPtr->readFlags |= PIPE_EXTRABYTE;
+ } else {
+ err = GetLastError();
+ if (err == ERROR_BROKEN_PIPE) {
+ /*
+ * The error is a result of an EOF condition, so set the
+ * EOF bit before signalling the main thread.
+ */
+
+ infoPtr->readFlags |= PIPE_EOF;
+ done = 1;
+ } else if (err == ERROR_INVALID_HANDLE) {
+ break;
+ }
+ }
+ }
+
+
+ /*
+ * Signal the main thread by signalling the readable event and
+ * then waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->readable);
+
+ /*
+ * Alert the foreground thread. Note that we need to treat this like
+ * a critical section so the foreground thread does not terminate
+ * this thread while we are holding a mutex in the notifier code.
+ */
+
+ Tcl_MutexLock(&pipeMutex);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ Tcl_MutexUnlock(&pipeMutex);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PipeWriterThread --
+ *
+ * This function runs in a separate thread and writes data
+ * onto a pipe.
+ *
+ * Results:
+ * Always returns 0.
+ *
+ * Side effects:
+ * Signals the main thread when an output operation is completed.
+ * May cause the main thread to wake up by posting a message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+PipeWriterThread(LPVOID arg)
+{
+
+ PipeInfo *infoPtr = (PipeInfo *)arg;
+ HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle;
+ DWORD count, toWrite;
+ char *buf;
+ int done = 0;
+
+ while (!done) {
+ /*
+ * Wait for the main thread to signal before attempting to write.
+ */
+
+ WaitForSingleObject(infoPtr->startWriter, INFINITE);
+
+ buf = infoPtr->writeBuf;
+ toWrite = infoPtr->toWrite;
+
+ /*
+ * Loop until all of the bytes are written or an error occurs.
+ */
+
+ while (toWrite > 0) {
+ if (WriteFile(handle, buf, toWrite, &count, NULL) == FALSE) {
+ infoPtr->writeError = GetLastError();
+ done = 1;
+ break;
+ } else {
+ toWrite -= count;
+ buf += count;
+ }
+ }
+
+ /*
+ * Signal the main thread by signalling the writable event and
+ * then waking up the notifier thread.
+ */
+
+ SetEvent(infoPtr->writable);
+
+ /*
+ * Alert the foreground thread. Note that we need to treat this like
+ * a critical section so the foreground thread does not terminate
+ * this thread while we are holding a mutex in the notifier code.
+ */
+
+ Tcl_MutexLock(&pipeMutex);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ Tcl_MutexUnlock(&pipeMutex);
+ }
+ return 0;
+}
+
+
+
+
diff --git a/tcl/win/tclWinPort.h b/tcl/win/tclWinPort.h
index 3dad58381cc..1ea45fe6b9a 100644
--- a/tcl/win/tclWinPort.h
+++ b/tcl/win/tclWinPort.h
@@ -5,7 +5,7 @@
* differences between Windows and Unix. It should be the only
* file that contains #ifdefs to handle different flavors of OS.
*
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -16,30 +16,61 @@
#ifndef _TCLWINPORT
#define _TCLWINPORT
-#include <malloc.h>
-#include <stdio.h>
+#ifndef _TCLINT
+# include "tclInt.h"
+#endif
+
+#ifdef CHECK_UNICODE_CALLS
+
+#define _UNICODE
+#define UNICODE
+
+#define __TCHAR_DEFINED
+typedef float *_TCHAR;
+
+#define _TCHAR_DEFINED
+typedef float *TCHAR;
+
+#endif
+
+/*
+ *---------------------------------------------------------------------------
+ * The following sets of #includes and #ifdefs are required to get Tcl to
+ * compile under the windows compilers.
+ *---------------------------------------------------------------------------
+ */
+#include <stdio.h>
#include <stdlib.h>
-#include <string.h>
+
#include <errno.h>
+#include <fcntl.h>
+#include <float.h>
+#include <io.h>
+#include <malloc.h>
#include <process.h>
#include <signal.h>
-#include <winsock.h>
+#include <string.h>
+
+/*
+ * Need to block out these includes for building extensions with MetroWerks
+ * compiler for Win32.
+ */
+
+#ifndef __MWERKS__
#include <sys/stat.h>
#include <sys/timeb.h>
+#include <sys/utime.h>
+#endif
+
#include <time.h>
-#include <io.h>
-#include <fcntl.h>
-#include <float.h>
+
+#include <winsock2.h>
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
-#ifdef _MSC_VER
-#define PASCAL
-#endif
-
#ifdef BUILD_tcl
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
@@ -62,37 +93,112 @@
#endif
/*
- * The following defines wrap the system memory allocation routines for
- * use by tclAlloc.c.
+ * The following defines redefine the Windows Socket errors as
+ * BSD errors so Tcl_PosixError can do the right thing.
*/
-/* On cygwin32, we just use the supplied malloc and free, rather than
- using tclAlloc.c. The cygwin32 malloc is derived from the same
- sources as tclAlloc.c, anyhow. */
-#ifdef __CYGWIN32__
-#define TclpAlloc(size) malloc(size)
-#define TclpFree(ptr) free(ptr)
-#define TclpRealloc(ptr, size) realloc(ptr, size)
-#else
-#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \
- (DWORD)0, (DWORD)size))
-#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \
- (DWORD)0, (HGLOBAL)ptr))
-#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
- (DWORD)0, (LPVOID)ptr, (DWORD)size))
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK EAGAIN
+#endif
+#ifndef EALREADY
+#define EALREADY 149 /* operation already in progress */
+#endif
+#ifndef ENOTSOCK
+#define ENOTSOCK 95 /* Socket operation on non-socket */
+#endif
+#ifndef EDESTADDRREQ
+#define EDESTADDRREQ 96 /* Destination address required */
+#endif
+#ifndef EMSGSIZE
+#define EMSGSIZE 97 /* Message too long */
+#endif
+#ifndef EPROTOTYPE
+#define EPROTOTYPE 98 /* Protocol wrong type for socket */
+#endif
+#ifndef ENOPROTOOPT
+#define ENOPROTOOPT 99 /* Protocol not available */
+#endif
+#ifndef EPROTONOSUPPORT
+#define EPROTONOSUPPORT 120 /* Protocol not supported */
+#endif
+#ifndef ESOCKTNOSUPPORT
+#define ESOCKTNOSUPPORT 121 /* Socket type not supported */
+#endif
+#ifndef EOPNOTSUPP
+#define EOPNOTSUPP 122 /* Operation not supported on socket */
+#endif
+#ifndef EPFNOSUPPORT
+#define EPFNOSUPPORT 123 /* Protocol family not supported */
+#endif
+#ifndef EAFNOSUPPORT
+#define EAFNOSUPPORT 124 /* Address family not supported */
+#endif
+#ifndef EADDRINUSE
+#define EADDRINUSE 125 /* Address already in use */
+#endif
+#ifndef EADDRNOTAVAIL
+#define EADDRNOTAVAIL 126 /* Can't assign requested address */
+#endif
+#ifndef ENETDOWN
+#define ENETDOWN 127 /* Network is down */
+#endif
+#ifndef ENETUNREACH
+#define ENETUNREACH 128 /* Network is unreachable */
+#endif
+#ifndef ENETRESET
+#define ENETRESET 129 /* Network dropped connection on reset */
+#endif
+#ifndef ECONNABORTED
+#define ECONNABORTED 130 /* Software caused connection abort */
+#endif
+#ifndef ECONNRESET
+#define ECONNRESET 131 /* Connection reset by peer */
+#endif
+#ifndef ENOBUFS
+#define ENOBUFS 132 /* No buffer space available */
+#endif
+#ifndef EISCONN
+#define EISCONN 133 /* Socket is already connected */
+#endif
+#ifndef ENOTCONN
+#define ENOTCONN 134 /* Socket is not connected */
+#endif
+#ifndef ESHUTDOWN
+#define ESHUTDOWN 143 /* Can't send after socket shutdown */
+#endif
+#ifndef ETOOMANYREFS
+#define ETOOMANYREFS 144 /* Too many references: can't splice */
+#endif
+#ifndef ETIMEDOUT
+#define ETIMEDOUT 145 /* Connection timed out */
+#endif
+#ifndef ECONNREFUSED
+#define ECONNREFUSED 146 /* Connection refused */
+#endif
+#ifndef ELOOP
+#define ELOOP 90 /* Symbolic link loop */
+#endif
+#ifndef EHOSTDOWN
+#define EHOSTDOWN 147 /* Host is down */
+#endif
+#ifndef EHOSTUNREACH
+#define EHOSTUNREACH 148 /* No route to host */
+#endif
+#ifndef ENOTEMPTY
+#define ENOTEMPTY 93 /* directory not empty */
+#endif
+#ifndef EUSERS
+#define EUSERS 94 /* Too many users (for UFS) */
+#endif
+#ifndef EDQUOT
+#define EDQUOT 49 /* Disc quota exceeded */
+#endif
+#ifndef ESTALE
+#define ESTALE 151 /* Stale NFS file handle */
+#endif
+#ifndef EREMOTE
+#define EREMOTE 66 /* The object is remote */
#endif
-
-/*
- * The default platform eol translation on Windows is TCL_TRANSLATE_CRLF:
- */
-
-#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CRLF
-
-/*
- * Declare dynamic loading extension macro.
- */
-
-#define TCL_SHLIB_EXT ".dll"
/*
* Supply definitions for macros to query wait status, if not already
@@ -142,17 +248,9 @@
#endif
/*
- * Define MAXPATHLEN in terms of MAXPATH if available
+ * Define access mode constants if they aren't already defined.
*/
-#ifndef MAXPATH
-#define MAXPATH MAX_PATH
-#endif /* MAXPATH */
-
-#ifndef MAXPATHLEN
-#define MAXPATHLEN MAXPATH
-#endif /* MAXPATHLEN */
-
#ifndef F_OK
# define F_OK 00
#endif
@@ -208,6 +306,18 @@
# endif
/*
+ * Define MAXPATHLEN in terms of MAXPATH if available
+ */
+
+#ifndef MAXPATH
+#define MAXPATH MAX_PATH
+#endif /* MAXPATH */
+
+#ifndef MAXPATHLEN
+#define MAXPATHLEN MAXPATH
+#endif /* MAXPATHLEN */
+
+/*
* Define pid_t and uid_t if they're not already defined.
*/
@@ -219,145 +329,49 @@
#endif
/*
- * Provide a stub definition for TclGetUserHome().
- */
-
-#define TclGetUserHome(name,bufferPtr) (NULL)
-
-/*
* Visual C++ has some odd names for common functions, so we need to
* define a few macros to handle them. Also, it defines EDEADLOCK and
* EDEADLK as the same value, which confuses Tcl_ErrnoId().
*/
-#ifdef _MSC_VER
+#if defined(_MSC_VER) || defined(__MINGW32__)
# define environ _environ
# define hypot _hypot
# define exception _exception
# undef EDEADLOCK
-#endif /* _MSC_VER */
+# if defined(__MINGW32__) && !defined(__MSVCRT__)
+# define timezone _timezone
+# endif
+#endif /* _MSC_VER || __MINGW32__ */
+
+#ifdef __CYGWIN__
+/* On cygwin32, the environment is imported from the cygwin32 DLL. */
+__declspec(dllimport) extern char **__cygwin_environ;
+# define environ __cygwin_environ
+# define putenv TclCygwinPutenv
+# define timezone _timezone
+extern int chdir (const char*);
+#endif /* __CYGWIN__ */
/*
- * When building DLLs using GCC on mingw32, we must import environ via
- * indirection. This hack will eventually go away once GCC understands
- * dllimport attribute and mingw32 headers are fixed.
+ *---------------------------------------------------------------------------
+ * The following macros and declarations represent the interface between
+ * generic and windows-specific parts of Tcl. Some of the macros may
+ * override functions declared in tclInt.h.
+ *---------------------------------------------------------------------------
*/
-#ifdef __MINGW32__
- extern char *** __imp__environ_dll;
-# define environ (*__imp__environ_dll)
-# define hypot _hypot
-# define exception _exception
-# undef EDEADLOCK
-#endif /* __MINGW32__ */
+/*
+ * The default platform eol translation on Windows is TCL_TRANSLATE_CRLF:
+ */
+
+#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CRLF
/*
- * The following defines redefine the Windows Socket errors as
- * BSD errors so Tcl_PosixError can do the right thing.
+ * Declare dynamic loading extension macro.
*/
-#ifndef EWOULDBLOCK
-#define EWOULDBLOCK EAGAIN
-#endif
-#ifndef EALREADY
-#define EALREADY 149 /* operation already in progress */
-#endif
-#ifndef ENOTSOCK
-#define ENOTSOCK 95 /* Socket operation on non-socket */
-#endif
-#ifndef EDESTADDRREQ
-#define EDESTADDRREQ 96 /* Destination address required */
-#endif
-#ifndef EMSGSIZE
-#define EMSGSIZE 97 /* Message too long */
-#endif
-#ifndef EPROTOTYPE
-#define EPROTOTYPE 98 /* Protocol wrong type for socket */
-#endif
-#ifndef ENOPROTOOPT
-#define ENOPROTOOPT 99 /* Protocol not available */
-#endif
-#ifndef EPROTONOSUPPORT
-#define EPROTONOSUPPORT 120 /* Protocol not supported */
-#endif
-#ifndef ESOCKTNOSUPPORT
-#define ESOCKTNOSUPPORT 121 /* Socket type not supported */
-#endif
-#ifndef EOPNOTSUPP
-#define EOPNOTSUPP 122 /* Operation not supported on socket */
-#endif
-#ifndef EPFNOSUPPORT
-#define EPFNOSUPPORT 123 /* Protocol family not supported */
-#endif
-#ifndef EAFNOSUPPORT
-#define EAFNOSUPPORT 124 /* Address family not supported */
-#endif
-#ifndef EADDRINUSE
-#define EADDRINUSE 125 /* Address already in use */
-#endif
-#ifndef EADDRNOTAVAIL
-#define EADDRNOTAVAIL 126 /* Can't assign requested address */
-#endif
-#ifndef ENETDOWN
-#define ENETDOWN 127 /* Network is down */
-#endif
-#ifndef ENETUNREACH
-#define ENETUNREACH 128 /* Network is unreachable */
-#endif
-#ifndef ENETRESET
-#define ENETRESET 129 /* Network dropped connection on reset */
-#endif
-#ifndef ECONNABORTED
-#define ECONNABORTED 130 /* Software caused connection abort */
-#endif
-#ifndef ECONNRESET
-#define ECONNRESET 131 /* Connection reset by peer */
-#endif
-#ifndef ENOBUFS
-#define ENOBUFS 132 /* No buffer space available */
-#endif
-#ifndef EISCONN
-#define EISCONN 133 /* Socket is already connected */
-#endif
-#ifndef ENOTCONN
-#define ENOTCONN 134 /* Socket is not connected */
-#endif
-#ifndef ESHUTDOWN
-#define ESHUTDOWN 143 /* Can't send after socket shutdown */
-#endif
-#ifndef ETOOMANYREFS
-#define ETOOMANYREFS 144 /* Too many references: can't splice */
-#endif
-#ifndef ETIMEDOUT
-#define ETIMEDOUT 145 /* Connection timed out */
-#endif
-#ifndef ECONNREFUSED
-#define ECONNREFUSED 146 /* Connection refused */
-#endif
-#ifndef ELOOP
-#define ELOOP 90 /* Symbolic link loop */
-#endif
-#ifndef EHOSTDOWN
-#define EHOSTDOWN 147 /* Host is down */
-#endif
-#ifndef EHOSTUNREACH
-#define EHOSTUNREACH 148 /* No route to host */
-#endif
-#ifndef ENOTEMPTY
-#define ENOTEMPTY 93 /* directory not empty */
-#endif
-#ifndef EUSERS
-#define EUSERS 94 /* Too many users (for UFS) */
-#endif
-#ifndef EDQUOT
-#define EDQUOT 49 /* Disc quota exceeded */
-#endif
-#ifndef ESTALE
-#define ESTALE 151 /* Stale NFS file handle */
-#endif
-#ifndef EREMOTE
-#define EREMOTE 66 /* The object is remote */
-#endif
+#define TCL_SHLIB_EXT ".dll"
/*
* The following define ensures that we use the native putenv
@@ -366,7 +380,19 @@
*/
#define USE_PUTENV 1
-
+
+/*
+ * The following defines wrap the system memory allocation routines for
+ * use by tclAlloc.c.
+ */
+
+#define TclpSysAlloc(size, isBin) ((void*)HeapAlloc(GetProcessHeap(), \
+ (DWORD)0, (DWORD)size))
+#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \
+ (DWORD)0, (HGLOBAL)ptr))
+#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
+ (DWORD)0, (LPVOID)ptr, (DWORD)size))
+
/*
* The following defines map from standard socket names to our internal
* wrappers that redirect through the winSock function table (see the
@@ -379,56 +405,59 @@
#define setsockopt TclWinSetSockOpt
/*
- * The following implements the Windows method for exiting the process.
+ * The following macros have trivial definitions, allowing generic code to
+ * address platform-specific issues.
*/
-#define TclPlatformExit(status) exit(status)
+#define TclpReleaseFile(file) ckfree((char *) file)
/*
- * The following declarations belong in tclInt.h, but depend on platform
- * specific types (e.g. struct tm).
+ * The following macros and declarations wrap the C runtime library
+ * functions.
*/
-EXTERN struct tm * TclpGetDate _ANSI_ARGS_((const time_t *tp,
- int useGMT));
-EXTERN unsigned long TclpGetPid _ANSI_ARGS_((Tcl_Pid pid));
-EXTERN size_t TclStrftime _ANSI_ARGS_((char *s, size_t maxsize,
- const char *format, const struct tm *t));
+#define TclpExit exit
+#define TclpLstat TclpStat
/*
- * The following prototypes and defines replace the Windows versions
- * of POSIX function that various compilier vendors didn't implement
- * well or consistantly.
+ * Declarations for Windows-only functions.
*/
-#define lstat TclStat
+EXTERN Tcl_Channel TclWinOpenSerialChannel _ANSI_ARGS_((HANDLE handle,
+ char *channelName, int permissions));
+
+EXTERN Tcl_Channel TclWinOpenConsoleChannel _ANSI_ARGS_((HANDLE handle,
+ char *channelName, int permissions));
-EXTERN int TclpStat _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-EXTERN int TclpAccess _ANSI_ARGS_((CONST char *path,
- int mode));
+EXTERN Tcl_Channel TclWinOpenFileChannel _ANSI_ARGS_((HANDLE handle,
+ char *channelName, int permissions, int appendMode));
-#define TclpReleaseFile(file) ckfree((char *) file)
+EXTERN TclFile TclWinMakeFile _ANSI_ARGS_((HANDLE handle));
/*
- * Declarations for Windows specific functions.
+ * Platform specific mutex definition used by memory allocators.
+ * These mutexes are statically allocated and explicitly initialized.
+ * Most modules do not use this, but instead use Tcl_Mutex types and
+ * Tcl_MutexLock and Tcl_MutexUnlock that are self-initializing.
*/
-EXTERN void TclWinConvertError _ANSI_ARGS_((DWORD errCode));
-EXTERN void TclWinConvertWSAError _ANSI_ARGS_((DWORD errCode));
-EXTERN struct servent * PASCAL FAR
- TclWinGetServByName _ANSI_ARGS_((const char FAR *nm,
- const char FAR *proto));
-EXTERN int PASCAL FAR TclWinGetSockOpt _ANSI_ARGS_((SOCKET s, int level,
- int optname, char FAR * optval, int FAR *optlen));
-EXTERN HINSTANCE TclWinGetTclInstance _ANSI_ARGS_((void));
-EXTERN HINSTANCE TclWinLoadLibrary _ANSI_ARGS_((char *name));
-EXTERN u_short PASCAL FAR
- TclWinNToHS _ANSI_ARGS_((u_short ns));
-EXTERN int PASCAL FAR TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level,
- int optname, const char FAR * optval, int optlen));
+#ifdef TCL_THREADS
+typedef CRITICAL_SECTION TclpMutex;
+EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr));
+EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr));
+EXTERN void TclpMutexUnlock _ANSI_ARGS_((TclpMutex *mPtr));
+#else
+typedef int TclpMutex;
+#define TclpMutexInit(a)
+#define TclpMutexLock(a)
+#define TclpMutexUnlock(a)
+#endif /* TCL_THREADS */
+
+#include "tclPlatDecls.h"
+#include "tclIntPlatDecls.h"
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLWINPORT */
+
diff --git a/tcl/win/tclWinReg.c b/tcl/win/tclWinReg.c
index de6489104a7..8967e03d930 100644
--- a/tcl/win/tclWinReg.c
+++ b/tcl/win/tclWinReg.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclWinReg.c --
*
* This file contains the implementation of the "registry" Tcl
@@ -6,6 +6,7 @@
* loadable extension in a separate DLL.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -13,7 +14,7 @@
* RCS: @(#) $Id$
*/
-#include <tcl.h>
+#include <tclPort.h>
#include <stdlib.h>
#define WIN32_LEAN_AND_MEAN
@@ -30,23 +31,12 @@
#define TCL_STORAGE_CLASS DLLEXPORT
/*
- * VC++ has an alternate entry point called DllMain, so we need to rename
- * our entry point.
- */
-
-#ifdef DLL_BUILD
-# if defined(_MSC_VER)
-# define DllEntryPoint DllMain
-# endif
-#endif
-
-/*
* The following macros convert between different endian ints.
*/
#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
-
+
/*
* The following flag is used in OpenKeys to indicate that the specified
* key should be created if it doesn't currently exist.
@@ -61,7 +51,8 @@
static char *rootKeyNames[] = {
"HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
- "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", NULL
+ "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
+ "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
};
static HKEY rootKeys[] = {
@@ -77,12 +68,95 @@ static HKEY rootKeys[] = {
*/
static char *typeNames[] = {
- "none", "sz", "expand_sz", "binary", "dword",
+ "none", "sz", "expand_sz", "binary", "dword",
"dword_big_endian", "link", "multi_sz", "resource_list", NULL
};
static DWORD lastType = REG_RESOURCE_LIST;
+/*
+ * The following structures allow us to select between the Unicode and ASCII
+ * interfaces at run time based on whether Unicode APIs are available. The
+ * Unicode APIs are preferable because they will handle characters outside
+ * of the current code page.
+ */
+
+typedef struct RegWinProcs {
+ int useWide;
+
+ LONG (WINAPI *regConnectRegistryProc)(TCHAR *, HKEY, PHKEY);
+ LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
+ DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
+ LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *);
+ LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *);
+ LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD);
+ LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ TCHAR *, DWORD *, FILETIME *);
+ LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ DWORD *, BYTE *, DWORD *);
+ LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM,
+ HKEY *);
+ LONG (WINAPI *regQueryInfoKeyProc)(HKEY, TCHAR *, DWORD *, DWORD *,
+ DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
+ FILETIME *);
+ LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
+ BYTE *, DWORD *);
+ LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD,
+ CONST BYTE*, DWORD);
+} RegWinProcs;
+
+static RegWinProcs *regWinProcs;
+
+static RegWinProcs asciiProcs = {
+ 0,
+
+ (LONG (WINAPI *)(TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
+ DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
+ DWORD *)) RegCreateKeyExA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ DWORD *, BYTE *, DWORD *)) RegEnumValueA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
+ HKEY *)) RegOpenKeyExA,
+ (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
+ DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
+ FILETIME *)) RegQueryInfoKeyA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
+ BYTE *, DWORD *)) RegQueryValueExA,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
+ CONST BYTE*, DWORD)) RegSetValueExA,
+};
+
+static RegWinProcs unicodeProcs = {
+ 1,
+
+ (LONG (WINAPI *)(TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
+ DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
+ DWORD *)) RegCreateKeyExW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW,
+ (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
+ DWORD *, BYTE *, DWORD *)) RegEnumValueW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
+ HKEY *)) RegOpenKeyExW,
+ (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
+ DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
+ FILETIME *)) RegQueryInfoKeyW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
+ BYTE *, DWORD *)) RegQueryValueExW,
+ (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
+ CONST BYTE*, DWORD)) RegSetValueExW,
+};
+
/*
* Declarations for functions defined in this file.
@@ -109,9 +183,10 @@ static DWORD OpenSubKey(char *hostName, HKEY rootKey,
static int ParseKeyName(Tcl_Interp *interp, char *name,
char **hostNamePtr, HKEY *rootKeyPtr,
char **keyNamePtr);
-static DWORD RecursiveDeleteKey(HKEY hStartKey, LPTSTR pKeyName);
+static DWORD RecursiveDeleteKey(HKEY hStartKey, TCHAR * pKeyName);
static int RegistryObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]);
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]);
static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
Tcl_Obj *typeObj);
@@ -121,38 +196,6 @@ EXTERN int Registry_Init(Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
*
- * DllEntryPoint --
- *
- * This wrapper function is used by Windows to invoke the
- * initialization code for the DLL. If we are compiling
- * with Visual C++, this routine will be renamed to DllMain.
- * routine.
- *
- * Results:
- * Returns TRUE;
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef __WIN32__
-#ifdef DLL_BUILD
-BOOL APIENTRY
-DllEntryPoint(
- HINSTANCE hInst, /* Library instance handle. */
- DWORD reason, /* Reason this function is being called. */
- LPVOID reserved) /* Not used. */
-{
- return TRUE;
-}
-#endif
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
* Registry_Init --
*
* This procedure initializes the registry command.
@@ -170,6 +213,21 @@ int
Registry_Init(
Tcl_Interp *interp)
{
+ if (!Tcl_InitStubs(interp, "8.0", 0)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Determine if the unicode interfaces are available and select the
+ * appropriate registry function table.
+ */
+
+ if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ regWinProcs = &unicodeProcs;
+ } else {
+ regWinProcs = &asciiProcs;
+ }
+
Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
return Tcl_PkgProvide(interp, "registry", "1.0");
}
@@ -302,6 +360,7 @@ DeleteKey(
DWORD result;
int length;
Tcl_Obj *resultPtr;
+ Tcl_DString buf;
/*
* Find the parent of the key being deleted and open it.
@@ -349,7 +408,9 @@ DeleteKey(
* Now we recursively delete the key and everything below it.
*/
+ tail = Tcl_WinUtfToTChar(tail, -1, &buf);
result = RecursiveDeleteKey(subkey, tail);
+ Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
@@ -391,7 +452,8 @@ DeleteValue(
int length;
DWORD result;
Tcl_Obj *resultPtr;
-
+ Tcl_DString ds;
+
/*
* Attempt to open the key for deletion.
*/
@@ -403,11 +465,13 @@ DeleteValue(
resultPtr = Tcl_GetObjResult(interp);
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
- result = RegDeleteValue(key, valueName);
+ Tcl_WinUtfToTChar(valueName, length, &ds);
+ result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"",
- Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"",
- Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
+ Tcl_GetString(valueNameObj), "\" from key \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -444,9 +508,10 @@ GetKeyNames(
{
HKEY key;
DWORD index;
- char buffer[MAX_PATH+1], *pattern;
+ char buffer[MAX_PATH+1], *pattern, *name;
Tcl_Obj *resultPtr;
int result = TCL_OK;
+ Tcl_DString ds;
/*
* Attempt to open the key for enumeration.
@@ -458,7 +523,7 @@ GetKeyNames(
}
if (patternObj) {
- pattern = Tcl_GetStringFromObj(patternObj, NULL);
+ pattern = Tcl_GetString(patternObj);
} else {
pattern = NULL;
}
@@ -469,13 +534,17 @@ GetKeyNames(
*/
resultPtr = Tcl_GetObjResult(interp);
- for (index = 0; RegEnumKey(key, index, buffer, MAX_PATH+1)
- == ERROR_SUCCESS; index++) {
- if (pattern && !Tcl_StringMatch(buffer, pattern)) {
+ for (index = 0; (*regWinProcs->regEnumKeyProc)(key, index, buffer,
+ MAX_PATH+1) == ERROR_SUCCESS; index++) {
+ Tcl_WinTCharToUtf((TCHAR *) buffer, -1, &ds);
+ name = Tcl_DStringValue(&ds);
+ if (pattern && !Tcl_StringMatch(name, pattern)) {
+ Tcl_DStringFree(&ds);
continue;
}
result = Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(buffer, -1));
+ Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
+ Tcl_DStringFree(&ds);
if (result != TCL_OK) {
break;
}
@@ -512,7 +581,10 @@ GetType(
Tcl_Obj *resultPtr;
DWORD result;
DWORD type;
-
+ Tcl_DString ds;
+ char *valueName;
+ int length;
+
/*
* Attempt to open the key for reading.
*/
@@ -528,14 +600,17 @@ GetType(
resultPtr = Tcl_GetObjResult(interp);
- result = RegQueryValueEx(key, Tcl_GetStringFromObj(valueNameObj, NULL),
- NULL, &type, NULL, NULL);
+ valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+ valueName = Tcl_WinUtfToTChar(valueName, length, &ds);
+ result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type,
+ NULL, NULL);
+ Tcl_DStringFree(&ds);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
Tcl_AppendStringsToObj(resultPtr, "unable to get type of value \"",
- Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"",
- Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
+ Tcl_GetString(valueNameObj), "\" from key \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -581,7 +656,8 @@ GetValue(
char *valueName;
DWORD result, length, type;
Tcl_Obj *resultPtr;
- Tcl_DString data;
+ Tcl_DString data, buf;
+ int nameLen;
/*
* Attempt to open the key for reading.
@@ -596,30 +672,40 @@ GetValue(
* Initialize a Dstring to maximum statically allocated size
* we could get one more byte by avoiding Tcl_DStringSetLength()
* and just setting length to TCL_DSTRING_STATIC_SIZE, but this
- * should be safer if the implementation Dstrings changes.
+ * should be safer if the implementation of Dstrings changes.
*
* This allows short values to be read from the registy in one call.
* Longer values need a second call with an expanded DString.
*/
Tcl_DStringInit(&data);
- Tcl_DStringSetLength(&data, length = TCL_DSTRING_STATIC_SIZE - 1);
+ length = TCL_DSTRING_STATIC_SIZE - 1;
+ Tcl_DStringSetLength(&data, length);
resultPtr = Tcl_GetObjResult(interp);
-
- valueName = Tcl_GetStringFromObj(valueNameObj, NULL);
- result = RegQueryValueEx(key, valueName, NULL, &type,
- (LPBYTE) Tcl_DStringValue(&data), &length);
- if (result == ERROR_MORE_DATA) {
+
+ valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
+ valueName = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
+
+ result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type,
+ (BYTE *) Tcl_DStringValue(&data), &length);
+ while (result == ERROR_MORE_DATA) {
+ /*
+ * The Windows docs say that in this error case, we just need
+ * to expand our buffer and request more data.
+ * Required for HKEY_PERFORMANCE_DATA
+ */
+ length *= 2;
Tcl_DStringSetLength(&data, length);
- result = RegQueryValueEx(key, valueName, NULL, &type,
- (LPBYTE) Tcl_DStringValue(&data), &length);
+ result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL,
+ &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
+ Tcl_DStringFree(&buf);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
Tcl_AppendStringsToObj(resultPtr, "unable to get value \"",
- Tcl_GetStringFromObj(valueNameObj, NULL), "\" from key \"",
- Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
+ Tcl_GetString(valueNameObj), "\" from key \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
Tcl_DStringFree(&data);
return TCL_ERROR;
@@ -637,23 +723,38 @@ GetValue(
*((DWORD*) Tcl_DStringValue(&data))));
} else if (type == REG_MULTI_SZ) {
char *p = Tcl_DStringValue(&data);
- char *lastChar = Tcl_DStringValue(&data) + Tcl_DStringLength(&data);
+ char *end = Tcl_DStringValue(&data) + length;
/*
* Multistrings are stored as an array of null-terminated strings,
* terminated by two null characters. Also do a bounds check in
* case we get bogus data.
*/
-
- while (p < lastChar && *p != '\0') {
+
+ while (p < end && ((regWinProcs->useWide)
+ ? *((Tcl_UniChar *)p) : *p) != 0) {
+ Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(p, -1));
- while (*p++ != '\0') {}
+ Tcl_NewStringObj(Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf)));
+ if (regWinProcs->useWide) {
+ while (*((Tcl_UniChar *)p)++ != 0) {}
+ } else {
+ while (*p++ != '\0') {}
+ }
+ Tcl_DStringFree(&buf);
}
} else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) {
- Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), -1);
+ Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf);
+ Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf));
+ Tcl_DStringFree(&buf);
} else {
- Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), length);
+ /*
+ * Save binary data as a byte array.
+ */
+
+ Tcl_SetByteArrayObj(resultPtr, Tcl_DStringValue(&data), length);
}
Tcl_DStringFree(&data);
return result;
@@ -686,9 +787,9 @@ GetValueNames(
{
HKEY key;
Tcl_Obj *resultPtr;
- DWORD index, size, result;
- Tcl_DString buffer;
- char *pattern;
+ DWORD index, size, maxSize, result;
+ Tcl_DString buffer, ds;
+ char *pattern, *name;
/*
* Attempt to open the key for enumeration.
@@ -706,26 +807,27 @@ GetValueNames(
* largest value name plus the terminating null.
*/
- result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL, NULL, NULL, &index,
- &size, NULL, NULL, NULL);
+ result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL,
+ NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
Tcl_AppendStringsToObj(resultPtr, "unable to query key \"",
- Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
+ Tcl_GetString(keyNameObj), "\": ", NULL);
AppendSystemError(interp, result);
RegCloseKey(key);
result = TCL_ERROR;
goto done;
}
- size++;
+ maxSize++;
Tcl_DStringInit(&buffer);
- Tcl_DStringSetLength(&buffer, size);
+ Tcl_DStringSetLength(&buffer,
+ (regWinProcs->useWide) ? maxSize*2 : maxSize);
index = 0;
result = TCL_OK;
if (patternObj) {
- pattern = Tcl_GetStringFromObj(patternObj, NULL);
+ pattern = Tcl_GetString(patternObj);
} else {
pattern = NULL;
}
@@ -736,17 +838,29 @@ GetValueNames(
* after each iteration because RegEnumValue smashes the old value.
*/
- while (RegEnumValue(key, index, Tcl_DStringValue(&buffer), &size, NULL,
- NULL, NULL, NULL) == ERROR_SUCCESS) {
- if (!pattern || Tcl_StringMatch(Tcl_DStringValue(&buffer), pattern)) {
+ size = maxSize;
+ while ((*regWinProcs->regEnumValueProc)(key, index,
+ Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL)
+ == ERROR_SUCCESS) {
+
+ if (regWinProcs->useWide) {
+ size *= 2;
+ }
+
+ Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), size, &ds);
+ name = Tcl_DStringValue(&ds);
+ if (!pattern || Tcl_StringMatch(name, pattern)) {
result = Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(Tcl_DStringValue(&buffer), size));
+ Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
if (result != TCL_OK) {
+ Tcl_DStringFree(&ds);
break;
}
}
+ Tcl_DStringFree(&ds);
+
index++;
- size = Tcl_DStringLength(&buffer);
+ size = maxSize;
}
Tcl_DStringFree(&buffer);
@@ -835,13 +949,17 @@ OpenSubKey(
HKEY *keyPtr) /* Returned HKEY. */
{
DWORD result;
+ Tcl_DString buf;
/*
* Attempt to open the root key on a remote host if necessary.
*/
if (hostName) {
- result = RegConnectRegistry(hostName, rootKey, &rootKey);
+ hostName = Tcl_WinUtfToTChar(hostName, -1, &buf);
+ result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey,
+ &rootKey);
+ Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS) {
return result;
}
@@ -852,13 +970,26 @@ OpenSubKey(
* that this key must be closed by the caller.
*/
+ keyName = Tcl_WinUtfToTChar(keyName, -1, &buf);
if (flags & REG_CREATE) {
DWORD create;
- result = RegCreateKeyEx(rootKey, keyName, 0, "",
+ result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, "",
REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
} else {
- result = RegOpenKeyEx(rootKey, keyName, 0, mode, keyPtr);
+ if (rootKey == HKEY_PERFORMANCE_DATA) {
+ /*
+ * Here we fudge it for this special root key.
+ * See MSDN for more info on HKEY_PERFORMANCE_DATA and
+ * the peculiarities surrounding it
+ */
+ *keyPtr = HKEY_PERFORMANCE_DATA;
+ result = ERROR_SUCCESS;
+ } else {
+ result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0,
+ mode, keyPtr);
+ }
}
+ Tcl_DStringFree(&buf);
/*
* Be sure to close the root key since we are done with it now.
@@ -867,7 +998,7 @@ OpenSubKey(
if (hostName) {
RegCloseKey(rootKey);
}
- return result;
+ return result;
}
/*
@@ -876,7 +1007,7 @@ OpenSubKey(
* ParseKeyName --
*
* This function parses a key name into the host, root, and subkey
- * parts.
+ * parts.
*
* Results:
* The pointers to the start of the host and subkey names are
@@ -975,9 +1106,10 @@ ParseKeyName(
static DWORD
RecursiveDeleteKey(
HKEY startKey, /* Parent of key to be deleted. */
- char *keyName) /* Name of key to be deleted. */
+ char *keyName) /* Name of key to be deleted in external
+ * encoding, not UTF. */
{
- DWORD result, subKeyLength;
+ DWORD result, size, maxSize;
Tcl_DString subkey;
HKEY hKey;
@@ -985,35 +1117,36 @@ RecursiveDeleteKey(
* Do not allow NULL or empty key name.
*/
- if (!keyName || lstrlen(keyName) == '\0') {
+ if (!keyName || *keyName == '\0') {
return ERROR_BADKEY;
}
- result = RegOpenKeyEx(startKey, keyName, 0,
+ result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0,
KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey);
if (result != ERROR_SUCCESS) {
return result;
}
- result = RegQueryInfoKey(hKey, NULL, NULL, NULL, NULL, &subKeyLength,
- NULL, NULL, NULL, NULL, NULL, NULL);
- subKeyLength++;
+ result = (*regWinProcs->regQueryInfoKeyProc)(hKey, NULL, NULL, NULL, NULL,
+ &maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
+ maxSize++;
if (result != ERROR_SUCCESS) {
return result;
}
Tcl_DStringInit(&subkey);
- Tcl_DStringSetLength(&subkey, subKeyLength);
+ Tcl_DStringSetLength(&subkey,
+ (regWinProcs->useWide) ? maxSize * 2 : maxSize);
while (result == ERROR_SUCCESS) {
/*
* Always get index 0 because key deletion changes ordering.
*/
- subKeyLength = Tcl_DStringLength(&subkey);
- result=RegEnumKeyEx(hKey, 0, Tcl_DStringValue(&subkey), &subKeyLength,
- NULL, NULL, NULL, NULL);
+ size = maxSize;
+ result=(*regWinProcs->regEnumKeyExProc)(hKey, 0,
+ Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
if (result == ERROR_NO_MORE_ITEMS) {
- result = RegDeleteKey(startKey, keyName);
+ result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName);
break;
} else if (result == ERROR_SUCCESS) {
result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
@@ -1055,6 +1188,7 @@ SetValue(
int length;
char *valueName;
Tcl_Obj *resultPtr;
+ Tcl_DString nameBuf;
if (typeObj == NULL) {
type = REG_SZ;
@@ -1070,26 +1204,28 @@ SetValue(
}
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+ valueName = Tcl_WinUtfToTChar(valueName, length, &nameBuf);
resultPtr = Tcl_GetObjResult(interp);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
DWORD value;
if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
RegCloseKey(key);
+ Tcl_DStringFree(&nameBuf);
return TCL_ERROR;
}
value = ConvertDWORD(type, value);
- result = RegSetValueEx(key, valueName, 0, type, (BYTE*) &value,
- sizeof(DWORD));
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
+ (BYTE*) &value, sizeof(DWORD));
} else if (type == REG_MULTI_SZ) {
- Tcl_DString data;
+ Tcl_DString data, buf;
int objc, i;
Tcl_Obj **objv;
- char *element;
if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) {
RegCloseKey(key);
+ Tcl_DStringFree(&nameBuf);
return TCL_ERROR;
}
@@ -1101,29 +1237,55 @@ SetValue(
Tcl_DStringInit(&data);
for (i = 0; i < objc; i++) {
- element = Tcl_GetStringFromObj(objv[i], NULL);
- Tcl_DStringAppend(&data, element, -1);
+ Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
+
+ /*
+ * Add a null character to separate this value from the next.
+ * We accomplish this by growing the string by one byte. Since the
+ * DString always tacks on an extra null byte, the new byte will
+ * already be set to null.
+ */
+
Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
}
- result = RegSetValueEx(key, valueName, 0, type,
- (LPBYTE) Tcl_DStringValue(&data),
- (DWORD) (Tcl_DStringLength(&data)+1));
+
+ Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
+ &buf);
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
+ (BYTE *) Tcl_DStringValue(&buf),
+ (DWORD) Tcl_DStringLength(&buf));
Tcl_DStringFree(&data);
- } else {
+ Tcl_DStringFree(&buf);
+ } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
+ Tcl_DString buf;
char *data = Tcl_GetStringFromObj(dataObj, &length);
+ data = Tcl_WinUtfToTChar(data, length, &buf);
+
/*
- * Include the null in the length if we are storing a null terminated
- * string. Note that we also need to call strlen to find the first
- * null so we don't pass bad data to the registry.
+ * Include the null in the length, padding if needed for Unicode.
*/
- if (type == REG_SZ || type == REG_EXPAND_SZ) {
- length = strlen(data) + 1;
+ if (regWinProcs->useWide) {
+ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
}
+ length = Tcl_DStringLength(&buf) + 1;
+
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
+ (BYTE*)data, length);
+ Tcl_DStringFree(&buf);
+ } else {
+ char *data;
- result = RegSetValueEx(key, valueName, 0, type, (LPBYTE)data, length);
+ /*
+ * Store binary data in the registry.
+ */
+
+ data = Tcl_GetByteArrayFromObj(dataObj, &length);
+ result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
+ (BYTE *)data, length);
}
+ Tcl_DStringFree(&nameBuf);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
@@ -1156,36 +1318,65 @@ AppendSystemError(
DWORD error) /* Result code from error. */
{
int length;
- char *msgbuf, id[10];
+ WCHAR *wMsgPtr;
+ char *msg;
+ char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
+ Tcl_DString ds;
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
- sprintf(id, "%d", error);
- length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
+ length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPTSTR)&msgbuf,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr,
0, NULL);
if (length == 0) {
+ char *msgPtr;
+
+ length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
+ 0, NULL);
+ if (length > 0) {
+ wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
+ MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
+ length + 1);
+ LocalFree(msgPtr);
+ }
+ }
+ if (length == 0) {
if (error == ERROR_CALL_NOT_IMPLEMENTED) {
- msgbuf = "function not supported under Win32s";
+ msg = "function not supported under Win32s";
} else {
- msgbuf = id;
+ sprintf(msgBuf, "unknown error: %d", error);
+ msg = msgBuf;
}
} else {
+ Tcl_Encoding encoding;
+
+ encoding = Tcl_GetEncoding(NULL, "unicode");
+ Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
+ Tcl_FreeEncoding(encoding);
+ LocalFree(wMsgPtr);
+
+ msg = Tcl_DStringValue(&ds);
+ length = Tcl_DStringLength(&ds);
+
/*
* Trim the trailing CR/LF from the system message.
*/
- if (msgbuf[length-1] == '\n') {
- msgbuf[--length] = 0;
+ if (msg[length-1] == '\n') {
+ msg[--length] = 0;
}
- if (msgbuf[length-1] == '\r') {
- msgbuf[--length] = 0;
+ if (msg[length-1] == '\r') {
+ msg[--length] = 0;
}
}
- Tcl_SetErrorCode(interp, "WINDOWS", id, msgbuf, (char *) NULL);
- Tcl_AppendToObj(resultPtr, msgbuf, -1);
+
+ sprintf(id, "%d", error);
+ Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL);
+ Tcl_AppendToObj(resultPtr, msg, length);
if (length != 0) {
- LocalFree(msgbuf);
+ Tcl_DStringFree(&ds);
}
}
@@ -1221,3 +1412,6 @@ ConvertDWORD(
localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
return (type != localType) ? SWAPLONG(value) : value;
}
+
+
+
diff --git a/tcl/win/tclWinSerial.c b/tcl/win/tclWinSerial.c
new file mode 100644
index 00000000000..43f00f6328d
--- /dev/null
+++ b/tcl/win/tclWinSerial.c
@@ -0,0 +1,1206 @@
+/*
+ * Tclwinserial.c --
+ *
+ * This file implements the Windows-specific serial port functions,
+ * and the "serial" channel driver.
+ *
+ * Copyright (c) 1999 by Scriptics Corp.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * Changes by Rolf.Schroedter@dlr.de June 25-27, 1999
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+
+#include <fcntl.h>
+#include <io.h>
+#include <sys/stat.h>
+
+/*
+ * The following variable is used to tell whether this module has been
+ * initialized.
+ */
+
+static int initialized = 0;
+
+/*
+ * Bit masks used in the flags field of the SerialInfo structure below.
+ */
+
+#define SERIAL_PENDING (1<<0) /* Message is pending in the queue. */
+#define SERIAL_ASYNC (1<<1) /* Channel is non-blocking. */
+
+/*
+ * Bit masks used in the sharedFlags field of the SerialInfo structure below.
+ */
+
+#define SERIAL_EOF (1<<2) /* Serial has reached EOF. */
+#define SERIAL_ERROR (1<<4)
+#define SERIAL_WRITE (1<<5) /* enables fileevent writable
+ * one time after write operation */
+
+/*
+ * Default time to block between checking status on the serial port.
+ */
+#define SERIAL_DEFAULT_BLOCKTIME 10 /* 10 msec */
+
+/*
+ * Define Win32 read/write error masks returned by ClearCommError()
+ */
+#define SERIAL_READ_ERRORS ( CE_RXOVER | CE_OVERRUN | CE_RXPARITY \
+ | CE_FRAME | CE_BREAK )
+#define SERIAL_WRITE_ERRORS ( CE_TXFULL )
+
+/*
+ * This structure describes per-instance data for a serial based channel.
+ */
+
+typedef struct SerialInfo {
+ HANDLE handle;
+ struct SerialInfo *nextPtr; /* Pointer to next registered serial. */
+ Tcl_Channel channel; /* Pointer to channel structure. */
+ int validMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which operations are valid on the file. */
+ int watchMask; /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, or TCL_EXCEPTION: indicates
+ * which events should be reported. */
+ int flags; /* State flags, see above for a list. */
+ int writable; /* flag that the channel is readable */
+ int readable; /* flag that the channel is readable */
+ int blockTime; /* max. blocktime in msec */
+ DWORD error; /* pending error code returned by
+ * ClearCommError() */
+ DWORD lastError; /* last error code, can be fetched with
+ * fconfigure chan -lasterror */
+} SerialInfo;
+
+typedef struct ThreadSpecificData {
+ /*
+ * The following pointer refers to the head of the list of serials
+ * that are being watched for file events.
+ */
+
+ SerialInfo *firstSerialPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following structure is what is added to the Tcl event queue when
+ * serial events are generated.
+ */
+
+typedef struct SerialEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ SerialInfo *infoPtr; /* Pointer to serial info structure. Note
+ * that we still have to verify that the
+ * serial exists before dereferencing this
+ * pointer. */
+} SerialEvent;
+
+COMMTIMEOUTS timeout_sync = { /* Timouts for blocking mode */
+ MAXDWORD, /* ReadIntervalTimeout */
+ MAXDWORD, /* ReadTotalTimeoutMultiplier */
+ MAXDWORD-1, /* ReadTotalTimeoutConstant,
+ MAXDWORD-1 works for both Win95/NT */
+ 0, /* WriteTotalTimeoutMultiplier */
+ 0, /* WriteTotalTimeoutConstant */
+};
+
+COMMTIMEOUTS timeout_async = { /* Timouts for non-blocking mode */
+ 0, /* ReadIntervalTimeout */
+ 0, /* ReadTotalTimeoutMultiplier */
+ 1, /* ReadTotalTimeoutConstant */
+ 0, /* WriteTotalTimeoutMultiplier */
+ 0, /* WriteTotalTimeoutConstant */
+};
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static int SerialBlockProc(ClientData instanceData, int mode);
+static void SerialCheckProc(ClientData clientData, int flags);
+static int SerialCloseProc(ClientData instanceData,
+ Tcl_Interp *interp);
+static int SerialEventProc(Tcl_Event *evPtr, int flags);
+static void SerialExitHandler(ClientData clientData);
+static int SerialGetHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+static ThreadSpecificData *SerialInit(void);
+static int SerialInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCode);
+static int SerialOutputProc(ClientData instanceData, char *buf,
+ int toWrite, int *errorCode);
+static void SerialSetupProc(ClientData clientData, int flags);
+static void SerialWatchProc(ClientData instanceData, int mask);
+static void ProcExitHandler(ClientData clientData);
+static int SerialGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ Tcl_DString *dsPtr));
+static int SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, char *optionName,
+ char *value));
+
+/*
+ * This structure describes the channel type structure for command serial
+ * based IO.
+ */
+
+static Tcl_ChannelType serialChannelType = {
+ "serial", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ SerialCloseProc, /* Close proc. */
+ SerialInputProc, /* Input proc. */
+ SerialOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ SerialSetOptionProc, /* Set option proc. */
+ SerialGetOptionProc, /* Get option proc. */
+ SerialWatchProc, /* Set up notifier to watch the channel. */
+ SerialGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ SerialBlockProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialInit --
+ *
+ * This function initializes the static variables for this file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData *
+SerialInit()
+{
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Check the initialized flag first, then check it again in the mutex.
+ * This is a speed enhancement.
+ */
+
+ if (!initialized) {
+ if (!initialized) {
+ initialized = 1;
+ Tcl_CreateExitHandler(ProcExitHandler, NULL);
+ }
+ }
+
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstSerialPtr = NULL;
+ Tcl_CreateEventSource(SerialSetupProc, SerialCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(SerialExitHandler, NULL);
+ }
+ return tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialExitHandler --
+ *
+ * This function is called to cleanup the serial module before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Removes the serial event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialExitHandler(
+ ClientData clientData) /* Old window proc */
+{
+ Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ProcExitHandler --
+ *
+ * This function is called to cleanup the process list before
+ * Tcl is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resets the process list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ProcExitHandler(
+ ClientData clientData) /* Old window proc */
+{
+ initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialBlockTime --
+ *
+ * Wrapper to set Tcl's block time in msec
+ *
+ * Results:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+void
+SerialBlockTime(
+ int msec) /* milli-seconds */
+{
+ Tcl_Time blockTime;
+
+ blockTime.sec = msec / 1000;
+ blockTime.usec = (msec % 1000) * 1000;
+ Tcl_SetMaxBlockTime(&blockTime);
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialSetupProc --
+ *
+ * This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ * for an event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+SerialSetupProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ SerialInfo *infoPtr;
+ int block = 1;
+ int msec = INT_MAX; /* min. found block time */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Look to see if any events handlers installed. If they are, do not block.
+ */
+
+ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+
+ if( infoPtr->watchMask & (TCL_WRITABLE | TCL_READABLE) ) {
+ block = 0;
+ msec = min( msec, infoPtr->blockTime );
+ }
+ }
+
+ if (!block) {
+ SerialBlockTime(msec);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialCheckProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent to check the serial
+ * event source for events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialCheckProc(
+ ClientData data, /* Not used. */
+ int flags) /* Event flags as passed to Tcl_DoOneEvent. */
+{
+ SerialInfo *infoPtr;
+ SerialEvent *evPtr;
+ int needEvent;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ COMSTAT cStat;
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return;
+ }
+
+ /*
+ * Queue events for any ready serials that don't already have events
+ * queued.
+ */
+
+ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->flags & SERIAL_PENDING) {
+ continue;
+ }
+
+ needEvent = 0;
+
+ /*
+ * If any READABLE or WRITABLE watch mask is set
+ * call ClearCommError to poll cbInQue,cbOutQue
+ * Window errors are ignored here
+ */
+
+ if( infoPtr->watchMask & (TCL_WRITABLE | TCL_READABLE) ) {
+ if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) {
+ /*
+ * Look for empty output buffer. If empty, poll.
+ */
+
+ if( infoPtr->watchMask & TCL_WRITABLE ) {
+ /*
+ * force fileevent after serial write error
+ */
+ if (((infoPtr->flags & SERIAL_WRITE) != 0) &&
+ ((cStat.cbOutQue == 0) ||
+ (infoPtr->error & SERIAL_WRITE_ERRORS))) {
+ /*
+ * allow only one fileevent after each callback
+ */
+
+ infoPtr->flags &= ~SERIAL_WRITE;
+ infoPtr->writable = 1;
+ needEvent = 1;
+ }
+ }
+
+ /*
+ * Look for characters already pending in windows queue.
+ * If they are, poll.
+ */
+
+ if( infoPtr->watchMask & TCL_READABLE ) {
+ /*
+ * force fileevent after serial read error
+ */
+ if( (cStat.cbInQue > 0) ||
+ (infoPtr->error & SERIAL_READ_ERRORS) ) {
+ infoPtr->readable = 1;
+ needEvent = 1;
+ }
+ }
+ }
+ }
+
+ /*
+ * Queue an event if the serial is signaled for reading or writing.
+ */
+
+ if (needEvent) {
+ infoPtr->flags |= SERIAL_PENDING;
+ evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
+ evPtr->header.proc = SerialEventProc;
+ evPtr->infoPtr = infoPtr;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialBlockProc --
+ *
+ * Set blocking or non-blocking mode on channel.
+ *
+ * Results:
+ * 0 if successful, errno when failed.
+ *
+ * Side effects:
+ * Sets the device into blocking or non-blocking mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialBlockProc(
+ ClientData instanceData, /* Instance data for channel. */
+ int mode) /* TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
+{
+ COMMTIMEOUTS *timeout;
+ int errorCode = 0;
+
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+
+ /*
+ * Serial IO on Windows can not be switched between blocking & nonblocking,
+ * hence we have to emulate the behavior. This is done in the input
+ * function by checking against a bit in the state. We set or unset the
+ * bit here to cause the input function to emulate the correct behavior.
+ */
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ infoPtr->flags |= SERIAL_ASYNC;
+ timeout = &timeout_async;
+ } else {
+ infoPtr->flags &= ~(SERIAL_ASYNC);
+ timeout = &timeout_sync;
+ }
+ if (SetCommTimeouts(infoPtr->handle, timeout) == FALSE) {
+ TclWinConvertError(GetLastError());
+ errorCode = errno;
+ }
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialCloseProc --
+ *
+ * Closes a serial based IO channel.
+ *
+ * Results:
+ * 0 on success, errno otherwise.
+ *
+ * Side effects:
+ * Closes the physical channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialCloseProc(
+ ClientData instanceData, /* Pointer to SerialInfo structure. */
+ Tcl_Interp *interp) /* For error reporting. */
+{
+ SerialInfo *serialPtr = (SerialInfo *) instanceData;
+ int errorCode, result = 0;
+ SerialInfo *infoPtr, **nextPtrPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ errorCode = 0;
+ serialPtr->validMask &= ~TCL_READABLE;
+ serialPtr->validMask &= ~TCL_WRITABLE;
+
+ /*
+ * Don't close the Win32 handle if the handle is a standard channel
+ * during the exit process. Otherwise, one thread may kill the stdio
+ * of another.
+ */
+
+ if (!TclInExit()
+ || ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
+ && (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
+ && (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
+ if (CloseHandle(serialPtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ errorCode = errno;
+ }
+ }
+
+ serialPtr->watchMask &= serialPtr->validMask;
+
+ /*
+ * Remove the file from the list of watched files.
+ */
+
+ for (nextPtrPtr = &(tsdPtr->firstSerialPtr), infoPtr = *nextPtrPtr;
+ infoPtr != NULL;
+ nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
+ if (infoPtr == (SerialInfo *)serialPtr) {
+ *nextPtrPtr = infoPtr->nextPtr;
+ break;
+ }
+ }
+
+ /*
+ * Wrap the error file into a channel and give it to the cleanup
+ * routine.
+ */
+
+ ckfree((char*) serialPtr);
+
+ if (errorCode == 0) {
+ return result;
+ }
+ return errorCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialInputProc --
+ *
+ * Reads input from the IO channel into the buffer given. Returns
+ * count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were read is returned and an error
+ * indication is returned in an output argument.
+ *
+ * Side effects:
+ * Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+SerialInputProc(
+ ClientData instanceData, /* Serial state. */
+ char *buf, /* Where to store data read. */
+ int bufSize, /* How much space is available
+ * in the buffer? */
+ int *errorCode) /* Where to store error code. */
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+ DWORD bytesRead = 0;
+ DWORD err;
+ COMSTAT cStat;
+
+ *errorCode = 0;
+
+ /*
+ * Check if there is a CommError pending from SerialCheckProc
+ */
+ if( infoPtr->error & SERIAL_READ_ERRORS ){
+ goto commError;
+ }
+
+ /*
+ * Look for characters already pending in windows queue.
+ * This is the mainly restored good old code from Tcl8.0
+ */
+
+ if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) {
+ /*
+ * Check for errors here, but not in the evSetup/Check procedures
+ */
+
+ if( infoPtr->error & SERIAL_READ_ERRORS ) {
+ goto commError;
+ }
+ if( infoPtr->flags & SERIAL_ASYNC ) {
+ /*
+ * NON_BLOCKING mode:
+ * Avoid blocking by reading more bytes than available
+ * in input buffer
+ */
+
+ if( cStat.cbInQue > 0 ) {
+ if( (DWORD) bufSize > cStat.cbInQue ) {
+ bufSize = cStat.cbInQue;
+ }
+ } else {
+ errno = *errorCode = EAGAIN;
+ return -1;
+ }
+ } else {
+ /*
+ * BLOCKING mode:
+ * Tcl trys to read a full buffer of 4 kBytes here
+ */
+
+ if( cStat.cbInQue > 0 ) {
+ if( (DWORD) bufSize > cStat.cbInQue ) {
+ bufSize = cStat.cbInQue;
+ }
+ } else {
+ bufSize = 1;
+ }
+ }
+ }
+
+ if( bufSize == 0 ) {
+ return bytesRead = 0;
+ }
+
+ if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+ NULL) == FALSE) {
+ err = GetLastError();
+ if (err != ERROR_IO_PENDING) {
+ goto error;
+ }
+ }
+ return bytesRead;
+
+ error:
+ TclWinConvertError(GetLastError());
+ *errorCode = errno;
+ return -1;
+
+ commError:
+ infoPtr->lastError = infoPtr->error; /* save last error code */
+ infoPtr->error = 0; /* reset error code */
+ *errorCode = EIO; /* to return read-error only once */
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialOutputProc --
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialOutputProc(
+ ClientData instanceData, /* Serial state. */
+ char *buf, /* The data buffer. */
+ int toWrite, /* How many bytes to write? */
+ int *errorCode) /* Where to store error code. */
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+ DWORD bytesWritten, err;
+
+ *errorCode = 0;
+
+ /*
+ * Check if there is a CommError pending from SerialCheckProc
+ */
+ if( infoPtr->error & SERIAL_WRITE_ERRORS ){
+ infoPtr->lastError = infoPtr->error; /* save last error code */
+ infoPtr->error = 0; /* reset error code */
+ *errorCode = EIO; /* to return read-error only once */
+ return -1;
+ }
+
+ /*
+ * Check for a background error on the last write.
+ * Allow one write-fileevent after each callback
+ */
+
+ if( toWrite ) {
+ infoPtr->flags |= SERIAL_WRITE;
+ }
+
+ if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, NULL) == FALSE) {
+ err = GetLastError();
+ if (err != ERROR_IO_PENDING) {
+ TclWinConvertError(GetLastError());
+ goto error;
+ }
+ }
+
+ return bytesWritten;
+
+error:
+ *errorCode = errno;
+ return -1;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialEventProc --
+ *
+ * This function is invoked by Tcl_ServiceEvent when a file event
+ * reaches the front of the event queue. This procedure invokes
+ * Tcl_NotifyChannel on the serial.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the notifier callback does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialEventProc(
+ Tcl_Event *evPtr, /* Event to service. */
+ int flags) /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+{
+ SerialEvent *serialEvPtr = (SerialEvent *)evPtr;
+ SerialInfo *infoPtr;
+ int mask;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (!(flags & TCL_FILE_EVENTS)) {
+ return 0;
+ }
+
+ /*
+ * Search through the list of watched serials for the one whose handle
+ * matches the event. We do this rather than simply dereferencing
+ * the handle in the event so that serials can be deleted while the
+ * event is in the queue.
+ */
+
+ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (serialEvPtr->infoPtr == infoPtr) {
+ infoPtr->flags &= ~(SERIAL_PENDING);
+ break;
+ }
+ }
+
+ /*
+ * Remove stale events.
+ */
+
+ if (!infoPtr) {
+ return 1;
+ }
+
+ /*
+ * Check to see if the serial is readable. Note
+ * that we can't tell if a serial is writable, so we always report it
+ * as being writable unless we have detected EOF.
+ */
+
+ mask = 0;
+ if( infoPtr->watchMask & TCL_WRITABLE ) {
+ if( infoPtr->writable ) {
+ mask |= TCL_WRITABLE;
+ infoPtr->writable = 0;
+ }
+ }
+
+ if( infoPtr->watchMask & TCL_READABLE ) {
+ if( infoPtr->readable ) {
+ mask |= TCL_READABLE;
+ infoPtr->readable = 0;
+ }
+ }
+
+ /*
+ * Inform the channel of the events.
+ */
+
+ Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialWatchProc --
+ *
+ * Called by the notifier to set up to watch for events on this
+ * channel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SerialWatchProc(
+ ClientData instanceData, /* Serial state. */
+ int mask) /* What events to watch for, OR-ed
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
+{
+ SerialInfo **nextPtrPtr, *ptr;
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+ int oldMask = infoPtr->watchMask;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Since the file is always ready for events, we set the block time
+ * so we will poll.
+ */
+
+ infoPtr->watchMask = mask & infoPtr->validMask;
+ if (infoPtr->watchMask) {
+ if (!oldMask) {
+ infoPtr->nextPtr = tsdPtr->firstSerialPtr;
+ tsdPtr->firstSerialPtr = infoPtr;
+ }
+ SerialBlockTime(infoPtr->blockTime);
+ } else {
+ if (oldMask) {
+ /*
+ * Remove the serial port from the list of watched serial ports.
+ */
+
+ for (nextPtrPtr = &(tsdPtr->firstSerialPtr), ptr = *nextPtrPtr;
+ ptr != NULL;
+ nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
+ if (infoPtr == ptr) {
+ *nextPtrPtr = ptr->nextPtr;
+ break;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialGetHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from
+ * inside a command serial port based channel.
+ *
+ * Results:
+ * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
+ * there is no handle for the specified direction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialGetHandleProc(
+ ClientData instanceData, /* The serial state. */
+ int direction, /* TCL_READABLE or TCL_WRITABLE */
+ ClientData *handlePtr) /* Where to store the handle. */
+{
+ SerialInfo *infoPtr = (SerialInfo *) instanceData;
+
+ *handlePtr = (ClientData) infoPtr->handle;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinOpenSerialChannel --
+ *
+ * Constructs a Serial port channel for the specified standard OS handle.
+ * This is a helper function to break up the construction of
+ * channels into File, Console, or Serial.
+ *
+ * Results:
+ * Returns the new channel, or NULL.
+ *
+ * Side effects:
+ * May open the channel
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclWinOpenSerialChannel(handle, channelName, permissions)
+ HANDLE handle;
+ char *channelName;
+ int permissions;
+{
+ SerialInfo *infoPtr;
+ ThreadSpecificData *tsdPtr;
+
+ tsdPtr = SerialInit();
+
+ SetupComm(handle, 4096, 4096);
+ PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
+ | PURGE_RXCLEAR);
+
+ /*
+ * default is blocking
+ */
+
+ SetCommTimeouts(handle, &timeout_sync);
+
+ infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
+ memset(infoPtr, 0, sizeof(SerialInfo));
+
+ infoPtr->validMask = permissions;
+ infoPtr->handle = handle;
+
+ /*
+ * Use the pointer to keep the channel names unique, in case
+ * the handles are shared between multiple channels (stdin/stdout).
+ */
+
+ wsprintfA(channelName, "file%lx", (int) infoPtr);
+
+ infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
+ (ClientData) infoPtr, permissions);
+
+
+ infoPtr->readable = infoPtr->writable = 0;
+ infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
+ infoPtr->lastError = infoPtr->error = 0;
+
+ /*
+ * Files have default translation of AUTO and ^Z eof char, which
+ * means that a ^Z will be accepted as EOF when reading.
+ */
+
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
+ Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
+
+ return infoPtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialErrorStr --
+ *
+ * Converts a Win32 serial error code to a list of readable errors
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+SerialErrorStr(error, dsPtr)
+ DWORD error; /* Win32 serial error code */
+ Tcl_DString *dsPtr; /* Where to store string */
+{
+ if( (error & CE_RXOVER) != 0) {
+ Tcl_DStringAppendElement(dsPtr, "RXOVER");
+ }
+ if( (error & CE_OVERRUN) != 0) {
+ Tcl_DStringAppendElement(dsPtr, "OVERRUN");
+ }
+ if( (error & CE_RXPARITY) != 0) {
+ Tcl_DStringAppendElement(dsPtr, "RXPARITY");
+ }
+ if( (error & CE_FRAME) != 0) {
+ Tcl_DStringAppendElement(dsPtr, "FRAME");
+ }
+ if( (error & CE_BREAK) != 0) {
+ Tcl_DStringAppendElement(dsPtr, "BREAK");
+ }
+ if( (error & CE_TXFULL) != 0) {
+ Tcl_DStringAppendElement(dsPtr, "TXFULL");
+ }
+ if( (error & ~(SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS)) != 0) {
+ char buf[TCL_INTEGER_SPACE + 1];
+ wsprintfA(buf, "%d", error);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialSetOptionProc --
+ *
+ * Sets an option on a channel.
+ *
+ * Results:
+ * A standard Tcl result. Also sets the interp's result on error if
+ * interp is not NULL.
+ *
+ * Side effects:
+ * May modify an option on a device.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SerialSetOptionProc(instanceData, interp, optionName, value)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Which option to set? */
+ char *value; /* New value for option. */
+{
+ SerialInfo *infoPtr;
+ DCB dcb;
+ int len;
+ BOOL result;
+ Tcl_DString ds;
+ TCHAR *native;
+
+ infoPtr = (SerialInfo *) instanceData;
+
+ len = strlen(optionName);
+ if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
+ if (GetCommState(infoPtr->handle, &dcb)) {
+ native = Tcl_WinUtfToTChar(value, -1, &ds);
+ result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
+ Tcl_DStringFree(&ds);
+
+ if ((result == FALSE) ||
+ (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
+ /*
+ * one should separate the 2 errors...
+ */
+
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad value for -mode: should be ",
+ "baud,parity,data,stop", NULL);
+ }
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp, "can't get comm state", NULL);
+ }
+ return TCL_ERROR;
+ }
+ } else if ((len > 1) &&
+ (strncmp(optionName, "-pollinterval", len) == 0)) {
+ if ( Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) {
+ return TCL_ERROR;
+ }
+ } else {
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode pollinterval");
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialGetOptionProc --
+ *
+ * Gets a mode associated with an IO channel. If the optionName arg
+ * is non NULL, retrieves the value of that option. If the optionName
+ * arg is NULL, retrieves a list of alternating option names and
+ * values for the given channel.
+ *
+ * Results:
+ * A standard Tcl result. Also sets the supplied DString to the
+ * string value of the option(s) returned.
+ *
+ * Side effects:
+ * The string returned by this function is in static storage and
+ * may be reused at any time subsequent to the call.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
+ ClientData instanceData; /* File state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ char *optionName; /* Option to get. */
+ Tcl_DString *dsPtr; /* Where to store value(s). */
+{
+ SerialInfo *infoPtr;
+ DCB dcb;
+ int len;
+ int valid = 0; /* flag if valid option parsed */
+
+ infoPtr = (SerialInfo *) instanceData;
+
+ if (optionName == NULL) {
+ len = 0;
+ } else {
+ len = strlen(optionName);
+ }
+
+ /*
+ * get option -mode
+ */
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-mode");
+ }
+ if ((len == 0) ||
+ ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
+ valid = 1;
+ if (GetCommState(infoPtr->handle, &dcb) == 0) {
+ /*
+ * shouldn't we flag an error instead ?
+ */
+
+ Tcl_DStringAppendElement(dsPtr, "");
+
+ } else {
+ char parity;
+ char *stop;
+ char buf[2 * TCL_INTEGER_SPACE + 16];
+
+ parity = 'n';
+ if (dcb.Parity < 4) {
+ parity = "noems"[dcb.Parity];
+ }
+
+ stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
+ (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
+
+ wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity,
+ dcb.ByteSize, stop);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ }
+
+ /*
+ * get option -pollinterval
+ */
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-pollinterval");
+ }
+ if ((len == 0) ||
+ ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0))) {
+ char buf[TCL_INTEGER_SPACE + 1];
+
+ valid = 1;
+ wsprintfA(buf, "%d", infoPtr->blockTime);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+
+ /*
+ * get option -lasterror
+ * option is readonly and returned by [fconfigure chan -lasterror]
+ * but not returned by unnamed [fconfigure chan]
+ */
+
+ if ( (len > 1) && (strncmp(optionName, "-lasterror", len) == 0) ) {
+ valid = 1;
+ SerialErrorStr(infoPtr->lastError, dsPtr);
+ }
+
+ if (valid) {
+ return TCL_OK;
+ } else {
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode pollinterval lasterror");
+ }
+}
+
diff --git a/tcl/win/tclWinSock.c b/tcl/win/tclWinSock.c
index 55581cd22ef..c8f9b5c5385 100644
--- a/tcl/win/tclWinSock.c
+++ b/tcl/win/tclWinSock.c
@@ -11,12 +11,7 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
-
-#ifdef _MSC_VER
-#define PASCAL
-#endif
+#include "tclWinInt.h"
/*
* The following variable is used to tell whether this module has been
@@ -29,6 +24,8 @@ static int hostnameInitialized = 0;
static char hostname[255]; /* This buffer should be big enough for
* hostname plus domain name. */
+TCL_DECLARE_MUTEX(socketMutex)
+
/*
* The following structure contains pointers to all of the WinSock API entry
* points used by Tcl. It is initialized by InitSockets. Since we
@@ -38,7 +35,6 @@ static char hostname[255]; /* This buffer should be big enough for
static struct {
HINSTANCE hInstance; /* Handle to WinSock library. */
- HWND hwnd; /* Handle to window for socket messages. */
SOCKET (PASCAL FAR *accept)(SOCKET s, struct sockaddr FAR *addr,
int FAR *addrlen);
int (PASCAL FAR *bind)(SOCKET s, const struct sockaddr FAR *addr,
@@ -85,6 +81,10 @@ static struct {
*/
#define SOCKET_MESSAGE WM_USER+1
+#define SOCKET_SELECT WM_USER+2
+#define SOCKET_TERMINATE WM_USER+3
+#define SELECT TRUE
+#define UNSELECT FALSE
/*
* The following structure is used to store the data associated with
@@ -106,12 +106,11 @@ typedef struct SocketInfo {
* FD_CLOSE, FD_ACCEPT and FD_CONNECT that
* indicate which events are currently
* being selected. */
+ int acceptEventCount; /* Count of the current number of FD_ACCEPTs
+ * that have arrived and not processed. */
Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
ClientData acceptProcData; /* The data for the accept proc. */
int lastError; /* Error code from last message. */
- /* CYGNUS LOCAL */
- int clientChannel; /* Created by Tcp_MakeTcpClientChannel. */
- /* END CYGNUS LOCAL */
struct SocketInfo *nextPtr; /* The next socket on the global socket
* list. */
} SocketInfo;
@@ -149,11 +148,23 @@ typedef struct SocketEvent {
#define SOCKET_PENDING (1<<3) /* A message has been sent
* for this socket */
-/*
- * Every open socket has an entry on the following list.
- */
-
-static SocketInfo *socketList;
+typedef struct ThreadSpecificData {
+ /*
+ * Every open socket has an entry on the following list.
+ */
+
+ HWND hwnd; /* Handle to window for socket messages. */
+ HANDLE socketThread; /* Thread handling the window */
+ Tcl_ThreadId threadId; /* Parent thread. */
+ HANDLE readyEvent; /* Event indicating that a socket event is ready.
+ * Also used to indicate that the socketThread has
+ * been initialized and has started. */
+ HANDLE socketListLock; /* Win32 Event to lock the socketList */
+ SocketInfo *socketList;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+static WNDCLASSA windowClass;
/*
* Static functions defined in this file.
@@ -176,6 +187,8 @@ static LRESULT CALLBACK SocketProc _ANSI_ARGS_((HWND hwnd, UINT message,
WPARAM wParam, LPARAM lParam));
static void SocketSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
+static void SocketThreadExitHandler _ANSI_ARGS_((ClientData clientData));
+static int SocketsEnabled _ANSI_ARGS_((void));
static void TcpAccept _ANSI_ARGS_((SocketInfo *infoPtr));
static int TcpBlockProc _ANSI_ARGS_((ClientData instanceData,
int mode));
@@ -194,6 +207,7 @@ static int TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
int direction, ClientData *handlePtr));
static int WaitForSocketEvent _ANSI_ARGS_((SocketInfo *infoPtr,
int events, int *errorCodePtr));
+static DWORD WINAPI SocketThread _ANSI_ARGS_((LPVOID arg));
/*
* This structure describes the channel type structure for TCP socket
@@ -201,16 +215,20 @@ static int WaitForSocketEvent _ANSI_ARGS_((SocketInfo *infoPtr,
*/
static Tcl_ChannelType tcpChannelType = {
- "tcp", /* Type name. */
- TcpBlockProc, /* Set socket into blocking/non-blocking mode. */
- TcpCloseProc, /* Close proc. */
- TcpInputProc, /* Input proc. */
- TcpOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- NULL, /* Set option proc. */
- TcpGetOptionProc, /* Get option proc. */
- TcpWatchProc, /* Initialize notifier to watch this channel. */
- TcpGetHandleProc, /* Get an OS handle from channel. */
+ "tcp", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TcpCloseProc, /* Close proc. */
+ TcpInputProc, /* Input proc. */
+ TcpOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ TcpGetOptionProc, /* Get option proc. */
+ TcpWatchProc, /* Set up notifier to watch this channel. */
+ TcpGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ TcpBlockProc, /* Set blocking/non-blocking mode. */
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
/*
@@ -228,6 +246,8 @@ static Tcl_ChannelType tcpChannelType = {
* library and set up the winSock function table. If successful,
* registers the event window for the socket notifier code.
*
+ * Assumes Mutex is held.
+ *
* Results:
* None.
*
@@ -242,200 +262,219 @@ static Tcl_ChannelType tcpChannelType = {
static void
InitSockets()
{
+ DWORD id;
WSADATA wsaData;
- OSVERSIONINFO info;
- WNDCLASS class;
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
- initialized = 1;
- Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
+ if (! initialized) {
+ initialized = 1;
+ Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
- /*
- * Find out if we're running on Win32s.
- */
-
- info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&info);
+ winSock.hInstance = LoadLibraryA("wsock32.dll");
- /*
- * Check to see if Sockets are supported on this system. Since
- * win32s panics if we call WSAStartup on a system that doesn't
- * have winsock.dll, we need to look for it on the system first.
- * If we find winsock, then load the library and initialize the
- * stub table.
- */
-
- if ((info.dwPlatformId != VER_PLATFORM_WIN32s)
- || (SearchPath(NULL, "WINSOCK", ".DLL", 0, NULL, NULL) != 0)) {
- winSock.hInstance = LoadLibrary("wsock32.dll");
- } else {
- winSock.hInstance = NULL;
- }
-
- /*
- * Initialize the function table.
- */
+ /*
+ * Initialize the function table.
+ */
- if (winSock.hInstance == NULL) {
- return;
+ if (!SocketsEnabled()) {
+ return;
+ }
+
+ winSock.accept = (SOCKET (PASCAL FAR *)(SOCKET s,
+ struct sockaddr FAR *addr, int FAR *addrlen))
+ GetProcAddress(winSock.hInstance, "accept");
+ winSock.bind = (int (PASCAL FAR *)(SOCKET s,
+ const struct sockaddr FAR *addr, int namelen))
+ GetProcAddress(winSock.hInstance, "bind");
+ winSock.closesocket = (int (PASCAL FAR *)(SOCKET s))
+ GetProcAddress(winSock.hInstance, "closesocket");
+ winSock.connect = (int (PASCAL FAR *)(SOCKET s,
+ const struct sockaddr FAR *name, int namelen))
+ GetProcAddress(winSock.hInstance, "connect");
+ winSock.ioctlsocket = (int (PASCAL FAR *)(SOCKET s, long cmd,
+ u_long FAR *argp))
+ GetProcAddress(winSock.hInstance, "ioctlsocket");
+ winSock.getsockopt = (int (PASCAL FAR *)(SOCKET s,
+ int level, int optname, char FAR * optval, int FAR *optlen))
+ GetProcAddress(winSock.hInstance, "getsockopt");
+ winSock.htons = (u_short (PASCAL FAR *)(u_short hostshort))
+ GetProcAddress(winSock.hInstance, "htons");
+ winSock.inet_addr = (unsigned long (PASCAL FAR *)(const char FAR *cp))
+ GetProcAddress(winSock.hInstance, "inet_addr");
+ winSock.inet_ntoa = (char FAR * (PASCAL FAR *)(struct in_addr in))
+ GetProcAddress(winSock.hInstance, "inet_ntoa");
+ winSock.listen = (int (PASCAL FAR *)(SOCKET s, int backlog))
+ GetProcAddress(winSock.hInstance, "listen");
+ winSock.ntohs = (u_short (PASCAL FAR *)(u_short netshort))
+ GetProcAddress(winSock.hInstance, "ntohs");
+ winSock.recv = (int (PASCAL FAR *)(SOCKET s, char FAR * buf,
+ int len, int flags)) GetProcAddress(winSock.hInstance, "recv");
+ winSock.select = (int (PASCAL FAR *)(int nfds, fd_set FAR * readfds,
+ fd_set FAR * writefds, fd_set FAR * exceptfds,
+ const struct timeval FAR * tiemout))
+ GetProcAddress(winSock.hInstance, "select");
+ winSock.send = (int (PASCAL FAR *)(SOCKET s, const char FAR * buf,
+ int len, int flags)) GetProcAddress(winSock.hInstance, "send");
+ winSock.setsockopt = (int (PASCAL FAR *)(SOCKET s, int level,
+ int optname, const char FAR * optval, int optlen))
+ GetProcAddress(winSock.hInstance, "setsockopt");
+ winSock.shutdown = (int (PASCAL FAR *)(SOCKET s, int how))
+ GetProcAddress(winSock.hInstance, "shutdown");
+ winSock.socket = (SOCKET (PASCAL FAR *)(int af, int type,
+ int protocol)) GetProcAddress(winSock.hInstance, "socket");
+ winSock.gethostbyaddr = (struct hostent FAR * (PASCAL FAR *)
+ (const char FAR *addr, int addrlen, int addrtype))
+ GetProcAddress(winSock.hInstance, "gethostbyaddr");
+ winSock.gethostbyname = (struct hostent FAR * (PASCAL FAR *)
+ (const char FAR *name))
+ GetProcAddress(winSock.hInstance, "gethostbyname");
+ winSock.gethostname = (int (PASCAL FAR *)(char FAR * name,
+ int namelen)) GetProcAddress(winSock.hInstance, "gethostname");
+ winSock.getpeername = (int (PASCAL FAR *)(SOCKET sock,
+ struct sockaddr FAR *name, int FAR *namelen))
+ GetProcAddress(winSock.hInstance, "getpeername");
+ winSock.getservbyname = (struct servent FAR * (PASCAL FAR *)
+ (const char FAR * name, const char FAR * proto))
+ GetProcAddress(winSock.hInstance, "getservbyname");
+ winSock.getsockname = (int (PASCAL FAR *)(SOCKET sock,
+ struct sockaddr FAR *name, int FAR *namelen))
+ GetProcAddress(winSock.hInstance, "getsockname");
+ winSock.WSAStartup = (int (PASCAL FAR *)(WORD wVersionRequired,
+ LPWSADATA lpWSAData)) GetProcAddress(winSock.hInstance, "WSAStartup");
+ winSock.WSACleanup = (int (PASCAL FAR *)(void))
+ GetProcAddress(winSock.hInstance, "WSACleanup");
+ winSock.WSAGetLastError = (int (PASCAL FAR *)(void))
+ GetProcAddress(winSock.hInstance, "WSAGetLastError");
+ winSock.WSAAsyncSelect = (int (PASCAL FAR *)(SOCKET s, HWND hWnd,
+ u_int wMsg, long lEvent))
+ GetProcAddress(winSock.hInstance, "WSAAsyncSelect");
+
+ /*
+ * Now check that all fields are properly initialized. If not, return
+ * zero to indicate that we failed to initialize properly.
+ */
+
+ if ((winSock.hInstance == NULL) ||
+ (winSock.accept == NULL) ||
+ (winSock.bind == NULL) ||
+ (winSock.closesocket == NULL) ||
+ (winSock.connect == NULL) ||
+ (winSock.ioctlsocket == NULL) ||
+ (winSock.getsockopt == NULL) ||
+ (winSock.htons == NULL) ||
+ (winSock.inet_addr == NULL) ||
+ (winSock.inet_ntoa == NULL) ||
+ (winSock.listen == NULL) ||
+ (winSock.ntohs == NULL) ||
+ (winSock.recv == NULL) ||
+ (winSock.select == NULL) ||
+ (winSock.send == NULL) ||
+ (winSock.setsockopt == NULL) ||
+ (winSock.socket == NULL) ||
+ (winSock.gethostbyname == NULL) ||
+ (winSock.gethostbyaddr == NULL) ||
+ (winSock.gethostname == NULL) ||
+ (winSock.getpeername == NULL) ||
+ (winSock.getservbyname == NULL) ||
+ (winSock.getsockname == NULL) ||
+ (winSock.WSAStartup == NULL) ||
+ (winSock.WSACleanup == NULL) ||
+ (winSock.WSAGetLastError == NULL) ||
+ (winSock.WSAAsyncSelect == NULL)) {
+ goto unloadLibrary;
+ }
+
+ /*
+ * Create the async notification window with a new class. We
+ * must create a new class to avoid a Windows 95 bug that causes
+ * us to get the wrong message number for socket events if the
+ * message window is a subclass of a static control.
+ */
+
+ windowClass.style = 0;
+ windowClass.cbClsExtra = 0;
+ windowClass.cbWndExtra = 0;
+ windowClass.hInstance = TclWinGetTclInstance();
+ windowClass.hbrBackground = NULL;
+ windowClass.lpszMenuName = NULL;
+ windowClass.lpszClassName = "TclSocket";
+ windowClass.lpfnWndProc = SocketProc;
+ windowClass.hIcon = NULL;
+ windowClass.hCursor = NULL;
+
+ if (!RegisterClassA(&windowClass)) {
+ TclWinConvertError(GetLastError());
+ (*winSock.WSACleanup)();
+ goto unloadLibrary;
+ }
+
+ /*
+ * Initialize the winsock library and check the version number.
+ */
+
+ if ((*winSock.WSAStartup)(WSA_VERSION_REQD, &wsaData) != 0) {
+ goto unloadLibrary;
+ }
+ if (wsaData.wVersion != WSA_VERSION_REQD) {
+ (*winSock.WSACleanup)();
+ goto unloadLibrary;
+ }
}
-/* CYGNUS LOCAL */
-#ifdef __GNUC__
-/* gcc can't handle `PASCAL FAR' in a cast. */
-#define PASCAL_FAR
-#else
-#define PASCAL_FAR PASCAL FAR
-#endif
-
- winSock.accept = (SOCKET (PASCAL_FAR *)(SOCKET s,
- struct sockaddr FAR *addr, int FAR *addrlen))
- GetProcAddress(winSock.hInstance, "accept");
- winSock.bind = (int (PASCAL_FAR *)(SOCKET s,
- const struct sockaddr FAR *addr, int namelen))
- GetProcAddress(winSock.hInstance, "bind");
- winSock.closesocket = (int (PASCAL_FAR *)(SOCKET s))
- GetProcAddress(winSock.hInstance, "closesocket");
- winSock.connect = (int (PASCAL_FAR *)(SOCKET s,
- const struct sockaddr FAR *name, int namelen))
- GetProcAddress(winSock.hInstance, "connect");
- winSock.ioctlsocket = (int (PASCAL_FAR *)(SOCKET s, long cmd,
- u_long FAR *argp)) GetProcAddress(winSock.hInstance, "ioctlsocket");
- winSock.getsockopt = (int (PASCAL_FAR *)(SOCKET s,
- int level, int optname, char FAR * optval, int FAR *optlen))
- GetProcAddress(winSock.hInstance, "getsockopt");
- winSock.htons = (u_short (PASCAL_FAR *)(u_short hostshort))
- GetProcAddress(winSock.hInstance, "htons");
- winSock.inet_addr = (unsigned long (PASCAL_FAR *)(const char FAR *cp))
- GetProcAddress(winSock.hInstance, "inet_addr");
- winSock.inet_ntoa = (char FAR * (PASCAL_FAR *)(struct in_addr in))
- GetProcAddress(winSock.hInstance, "inet_ntoa");
- winSock.listen = (int (PASCAL_FAR *)(SOCKET s, int backlog))
- GetProcAddress(winSock.hInstance, "listen");
- winSock.ntohs = (u_short (PASCAL_FAR *)(u_short netshort))
- GetProcAddress(winSock.hInstance, "ntohs");
- winSock.recv = (int (PASCAL_FAR *)(SOCKET s, char FAR * buf,
- int len, int flags)) GetProcAddress(winSock.hInstance, "recv");
- winSock.select = (int (PASCAL_FAR *)(int nfds, fd_set FAR * readfds,
- fd_set FAR * writefds, fd_set FAR * exceptfds,
- const struct timeval FAR * tiemout))
- GetProcAddress(winSock.hInstance, "select");
- winSock.send = (int (PASCAL_FAR *)(SOCKET s, const char FAR * buf,
- int len, int flags)) GetProcAddress(winSock.hInstance, "send");
- winSock.setsockopt = (int (PASCAL_FAR *)(SOCKET s, int level,
- int optname, const char FAR * optval, int optlen))
- GetProcAddress(winSock.hInstance, "setsockopt");
- winSock.shutdown = (int (PASCAL_FAR *)(SOCKET s, int how))
- GetProcAddress(winSock.hInstance, "shutdown");
- winSock.socket = (SOCKET (PASCAL_FAR *)(int af, int type,
- int protocol)) GetProcAddress(winSock.hInstance, "socket");
- winSock.gethostbyaddr = (struct hostent FAR * (PASCAL_FAR *)
- (const char FAR *addr, int addrlen, int addrtype))
- GetProcAddress(winSock.hInstance, "gethostbyaddr");
- winSock.gethostbyname = (struct hostent FAR * (PASCAL_FAR *)
- (const char FAR *name))
- GetProcAddress(winSock.hInstance, "gethostbyname");
- winSock.gethostname = (int (PASCAL_FAR *)(char FAR * name,
- int namelen)) GetProcAddress(winSock.hInstance, "gethostname");
- winSock.getpeername = (int (PASCAL_FAR *)(SOCKET sock,
- struct sockaddr FAR *name, int FAR *namelen))
- GetProcAddress(winSock.hInstance, "getpeername");
- winSock.getservbyname = (struct servent FAR * (PASCAL_FAR *)
- (const char FAR * name, const char FAR * proto))
- GetProcAddress(winSock.hInstance, "getservbyname");
- winSock.getsockname = (int (PASCAL_FAR *)(SOCKET sock,
- struct sockaddr FAR *name, int FAR *namelen))
- GetProcAddress(winSock.hInstance, "getsockname");
- winSock.WSAStartup = (int (PASCAL_FAR *)(WORD wVersionRequired,
- LPWSADATA lpWSAData)) GetProcAddress(winSock.hInstance, "WSAStartup");
- winSock.WSACleanup = (int (PASCAL_FAR *)(void))
- GetProcAddress(winSock.hInstance, "WSACleanup");
- winSock.WSAGetLastError = (int (PASCAL_FAR *)(void))
- GetProcAddress(winSock.hInstance, "WSAGetLastError");
- winSock.WSAAsyncSelect = (int (PASCAL_FAR *)(SOCKET s, HWND hWnd,
- u_int wMsg, long lEvent))
- GetProcAddress(winSock.hInstance, "WSAAsyncSelect");
-/* END CYGNUS LOCAL */
-
/*
- * Now check that all fields are properly initialized. If not, return
- * zero to indicate that we failed to initialize properly.
+ * Check for per-thread initialization.
*/
- if ((winSock.hInstance == NULL) ||
- (winSock.accept == NULL) ||
- (winSock.bind == NULL) ||
- (winSock.closesocket == NULL) ||
- (winSock.connect == NULL) ||
- (winSock.ioctlsocket == NULL) ||
- (winSock.getsockopt == NULL) ||
- (winSock.htons == NULL) ||
- (winSock.inet_addr == NULL) ||
- (winSock.inet_ntoa == NULL) ||
- (winSock.listen == NULL) ||
- (winSock.ntohs == NULL) ||
- (winSock.recv == NULL) ||
- (winSock.select == NULL) ||
- (winSock.send == NULL) ||
- (winSock.setsockopt == NULL) ||
- (winSock.socket == NULL) ||
- (winSock.gethostbyname == NULL) ||
- (winSock.gethostbyaddr == NULL) ||
- (winSock.gethostname == NULL) ||
- (winSock.getpeername == NULL) ||
- (winSock.getservbyname == NULL) ||
- (winSock.getsockname == NULL) ||
- (winSock.WSAStartup == NULL) ||
- (winSock.WSACleanup == NULL) ||
- (winSock.WSAGetLastError == NULL) ||
- (winSock.WSAAsyncSelect == NULL)) {
- goto unloadLibrary;
- }
-
- /*
- * Initialize the winsock library and check the version number.
- */
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->socketList = NULL;
+ tsdPtr->hwnd = NULL;
- if ((*winSock.WSAStartup)(WSA_VERSION_REQD, &wsaData) != 0) {
- goto unloadLibrary;
- }
- if (wsaData.wVersion != WSA_VERSION_REQD) {
- (*winSock.WSACleanup)();
- goto unloadLibrary;
- }
+ tsdPtr->threadId = Tcl_GetCurrentThread();
+
+ tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+ tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
+ tsdPtr->socketThread = CreateThread(NULL, 8000, SocketThread,
+ tsdPtr, 0, &id);
+ SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
+
+ if (tsdPtr->socketThread == NULL) {
+ goto unloadLibrary;
+ }
+
- /*
- * Create the async notification window with a new class. We
- * must create a new class to avoid a Windows 95 bug that causes
- * us to get the wrong message number for socket events if the
- * message window is a subclass of a static control.
- */
+ /*
+ * Wait for the thread to signal that the window has
+ * been created and is ready to go. Timeout after twenty
+ * seconds.
+ */
+
+ if (WaitForSingleObject(tsdPtr->readyEvent, 20000) == WAIT_TIMEOUT) {
+ goto unloadLibrary;
+ }
- class.style = 0;
- class.cbClsExtra = 0;
- class.cbWndExtra = 0;
- class.hInstance = TclWinGetTclInstance();
- class.hbrBackground = NULL;
- class.lpszMenuName = NULL;
- class.lpszClassName = "TclSocket";
- class.lpfnWndProc = SocketProc;
- class.hIcon = NULL;
- class.hCursor = NULL;
-
- if (RegisterClass(&class)) {
- winSock.hwnd = CreateWindow("TclSocket", "TclSocket", WS_TILED, 0, 0,
- 0, 0, NULL, NULL, class.hInstance, NULL);
- } else {
- winSock.hwnd = NULL;
- }
- if (winSock.hwnd == NULL) {
- TclWinConvertError(GetLastError());
- (*winSock.WSACleanup)();
- goto unloadLibrary;
+ if (tsdPtr->hwnd == NULL) {
+ goto unloadLibrary;
+ }
+
+ Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(SocketThreadExitHandler, NULL);
}
- Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
return;
unloadLibrary:
+ if (tsdPtr != NULL) {
+ if (tsdPtr->hwnd != NULL) {
+ DestroyWindow(tsdPtr->hwnd);
+ }
+ if (tsdPtr->socketThread != NULL) {
+ TerminateThread(tsdPtr->socketThread, 0);
+ tsdPtr->socketThread = NULL;
+ }
+ CloseHandle(tsdPtr->readyEvent);
+ CloseHandle(tsdPtr->socketListLock);
+ }
FreeLibrary(winSock.hInstance);
winSock.hInstance = NULL;
return;
@@ -444,6 +483,34 @@ unloadLibrary:
/*
*----------------------------------------------------------------------
*
+ * SocketsEnabled --
+ *
+ * Check that the WinSock DLL is loaded and ready.
+ *
+ * Results:
+ * 1 if it is.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+SocketsEnabled()
+{
+ int enabled;
+ Tcl_MutexLock(&socketMutex);
+ enabled = (winSock.hInstance != NULL);
+ Tcl_MutexUnlock(&socketMutex);
+ return enabled;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* SocketExitHandler --
*
* Callback invoked during exit clean up to delete the socket
@@ -463,22 +530,69 @@ static void
SocketExitHandler(clientData)
ClientData clientData; /* Not used. */
{
+ Tcl_MutexLock(&socketMutex);
if (winSock.hInstance) {
- DestroyWindow(winSock.hwnd);
- UnregisterClass("TclSocket", TclWinGetTclInstance());
+ UnregisterClassA("TclSocket", TclWinGetTclInstance());
(*winSock.WSACleanup)();
FreeLibrary(winSock.hInstance);
winSock.hInstance = NULL;
}
- Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
initialized = 0;
hostnameInitialized = 0;
+ Tcl_MutexUnlock(&socketMutex);
}
/*
*----------------------------------------------------------------------
*
- * TclHasSockets --
+ * SocketThreadExitHandler --
+ *
+ * Callback invoked during thread clean up to delete the socket
+ * event source.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Delete the event source.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+SocketThreadExitHandler(clientData)
+ ClientData clientData; /* Not used. */
+{
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+
+ if (tsdPtr->socketThread != NULL) {
+
+ PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
+
+ /*
+ * Wait for the thread to terminate. This ensures that we are
+ * completely cleaned up before we leave this function.
+ */
+
+ WaitForSingleObject(tsdPtr->socketThread, INFINITE);
+ CloseHandle(tsdPtr->socketThread);
+ CloseHandle(tsdPtr->readyEvent);
+ CloseHandle(tsdPtr->socketListLock);
+
+ }
+ if (tsdPtr->hwnd != NULL) {
+ DestroyWindow(tsdPtr->hwnd);
+ }
+
+ Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpHasSockets --
*
* This function determines whether sockets are available on the
* current system and returns an error in interp if they are not.
@@ -495,14 +609,14 @@ SocketExitHandler(clientData)
*/
int
-TclHasSockets(interp)
+TclpHasSockets(interp)
Tcl_Interp *interp;
{
- if (!initialized) {
- InitSockets();
- }
-
- if (winSock.hInstance != NULL) {
+ Tcl_MutexLock(&socketMutex);
+ InitSockets();
+ Tcl_MutexUnlock(&socketMutex);
+
+ if (SocketsEnabled()) {
return TCL_OK;
}
if (interp != NULL) {
@@ -536,6 +650,7 @@ SocketSetupProc(data, flags)
{
SocketInfo *infoPtr;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -545,12 +660,15 @@ SocketSetupProc(data, flags)
* Check to see if there is a ready socket. If so, poll.
*/
- for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->readyEvents & infoPtr->watchEvents) {
Tcl_SetMaxBlockTime(&blockTime);
break;
}
}
+ SetEvent(tsdPtr->socketListLock);
}
/*
@@ -577,6 +695,7 @@ SocketCheckProc(data, flags)
{
SocketInfo *infoPtr;
SocketEvent *evPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -588,7 +707,9 @@ SocketCheckProc(data, flags)
* events).
*/
- for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if ((infoPtr->readyEvents & infoPtr->watchEvents)
&& !(infoPtr->flags & SOCKET_PENDING)) {
infoPtr->flags |= SOCKET_PENDING;
@@ -598,6 +719,7 @@ SocketCheckProc(data, flags)
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
}
+ SetEvent(tsdPtr->socketListLock);
}
/*
@@ -631,6 +753,7 @@ SocketEventProc(evPtr, flags)
SocketEvent *eventPtr = (SocketEvent *) evPtr;
int mask = 0;
int events;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -640,12 +763,15 @@ SocketEventProc(evPtr, flags)
* Find the specified socket on the socket list.
*/
- for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->socket == eventPtr->socket) {
break;
}
}
-
+ SetEvent(tsdPtr->socketListLock);
+
/*
* Discard events that have gone stale.
*/
@@ -661,24 +787,10 @@ SocketEventProc(evPtr, flags)
*/
if (infoPtr->readyEvents & FD_ACCEPT) {
- /* CYGNUS LOCAL: If we get an FD_ACCEPT on a client channel,
- don't accept it; just set TCL_READABLE. */
- if (infoPtr->clientChannel) {
- mask |= TCL_READABLE;
- infoPtr->readyEvents &= ~(FD_ACCEPT);
- } else {
- TcpAccept(infoPtr);
- return 1;
- }
+ TcpAccept(infoPtr);
+ return 1;
}
- /* CYGNUS LOCAL: Treat FD_CONNECT on a client channel as meaning
- that the socket is now readable and writable. Otherwise we
- won't pick up a failed connect. */
- if ((infoPtr->readyEvents & FD_CONNECT) && infoPtr->clientChannel) {
- mask |= TCL_READABLE | TCL_WRITABLE;
- infoPtr->readyEvents &= ~(FD_CONNECT);
- }
/*
* Mask off unwanted events and compute the read/write mask so
@@ -701,15 +813,6 @@ SocketEventProc(evPtr, flags)
Tcl_Time blockTime = { 0, 0 };
Tcl_SetMaxBlockTime(&blockTime);
mask |= TCL_READABLE;
-
- /* CYGNUS LOCAL: For a client channel, set TCL_WRITABLE for
- FD_CLOSE. Otherwise a program waiting to write will hang
- forever. Besides, select returns if a descriptor selected
- for write is closed. */
- if (infoPtr->clientChannel) {
- mask |= TCL_WRITABLE;
- }
- /* END CYGNUS LOCAL. */
} else if (events & FD_READ) {
fd_set readFds;
struct timeval timeout;
@@ -717,28 +820,28 @@ SocketEventProc(evPtr, flags)
/*
* We must check to see if data is really available, since someone
* could have consumed the data in the meantime. Turn off async
- * notification so select will work correctly. If the socket is
+ * notification so select will work correctly. If the socket is
* still readable, notify the channel driver, otherwise reset the
* async select handler and keep waiting.
*/
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd, 0, 0);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) UNSELECT, (LPARAM) infoPtr);
FD_ZERO(&readFds);
FD_SET(infoPtr->socket, &readFds);
timeout.tv_usec = 0;
timeout.tv_sec = 0;
-
+
if ((*winSock.select)(0, &readFds, NULL, NULL, &timeout) != 0) {
mask |= TCL_READABLE;
} else {
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
- SOCKET_MESSAGE, infoPtr->selectEvents);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
infoPtr->readyEvents &= ~(FD_READ);
}
-
}
- if (events & FD_WRITE) {
+ if (events & (FD_WRITE | FD_CONNECT)) {
mask |= TCL_WRITABLE;
}
@@ -807,6 +910,7 @@ TcpCloseProc(instanceData, interp)
SocketInfo *infoPtr = (SocketInfo *) instanceData;
SocketInfo **nextPtrPtr;
int errorCode = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Check that WinSock is initialized; do not call it if not, to
@@ -815,7 +919,7 @@ TcpCloseProc(instanceData, interp)
* use sockets.
*/
- if (winSock.hInstance != NULL) {
+ if (SocketsEnabled()) {
/*
* Clean up the OS socket handle. The default Windows setting
@@ -833,13 +937,16 @@ TcpCloseProc(instanceData, interp)
* Remove the socket from socketList.
*/
- for (nextPtrPtr = &socketList; (*nextPtrPtr) != NULL;
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == infoPtr) {
(*nextPtrPtr) = infoPtr->nextPtr;
break;
}
}
+ SetEvent(tsdPtr->socketListLock);
+
ckfree((char *) infoPtr);
return errorCode;
}
@@ -866,6 +973,7 @@ NewSocketInfo(socket)
SOCKET socket;
{
SocketInfo *infoPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
infoPtr->socket = socket;
@@ -873,13 +981,15 @@ NewSocketInfo(socket)
infoPtr->watchEvents = 0;
infoPtr->readyEvents = 0;
infoPtr->selectEvents = 0;
+ infoPtr->acceptEventCount = 0;
infoPtr->acceptProc = NULL;
infoPtr->lastError = 0;
- /* CYGNUS LOCAL. */
- infoPtr->clientChannel = 0;
- /* END CYGNUS LOCAL. */
- infoPtr->nextPtr = socketList;
- socketList = infoPtr;
+
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ infoPtr->nextPtr = tsdPtr->socketList;
+ tsdPtr->socketList = infoPtr;
+ SetEvent(tsdPtr->socketListLock);
+
return infoPtr;
}
@@ -919,6 +1029,8 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
struct sockaddr_in mysockaddr; /* Socket address for client */
SOCKET sock;
SocketInfo *infoPtr; /* The returned value. */
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
/*
* Check that WinSock is initialized; do not call it if not, to
@@ -926,11 +1038,11 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
* handler for WinSock ran before other exit handlers that want to
* use sockets.
*/
-
- if (winSock.hInstance == NULL) {
+
+ if (!SocketsEnabled()) {
return NULL;
}
-
+
if (! CreateSocketAddress(&sockaddr, host, port)) {
goto error;
}
@@ -945,6 +1057,13 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
}
/*
+ * Win-NT has a misfeature that sockets are inherited in child
+ * processes by default. Turn off the inherit bit.
+ */
+
+ SetHandleInformation( (HANDLE) sock, HANDLE_FLAG_INHERIT, 0 );
+
+ /*
* Set kernel space buffering
*/
@@ -1055,8 +1174,8 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
*/
(*winSock.ioctlsocket)(sock, FIONBIO, &flag);
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
- SOCKET_MESSAGE, infoPtr->selectEvents);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
return infoPtr;
@@ -1105,11 +1224,11 @@ CreateSocketAddress(sockaddrPtr, host, port)
* use sockets.
*/
- if (winSock.hInstance == NULL) {
+ if (!SocketsEnabled()) {
Tcl_SetErrno(EFAULT);
return 0;
}
-
+
(void) memset((char *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
sockaddrPtr->sin_family = AF_INET;
sockaddrPtr->sin_port = (*winSock.htons)((short) (port & 0xFFFF));
@@ -1170,9 +1289,10 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr)
int events; /* Events to look for. */
int *errorCodePtr; /* Where to store errors? */
{
- MSG msg;
int result = 1;
int oldMode;
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
/*
* Be sure to disable event servicing so we are truly modal.
@@ -1184,19 +1304,14 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr)
* Reset WSAAsyncSelect so we have a fresh set of events pending.
*/
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd, 0, 0);
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
- SOCKET_MESSAGE, infoPtr->selectEvents);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) UNSELECT, (LPARAM) infoPtr);
+
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
while (1) {
- /*
- * Process all outstanding messages on the socket window.
- */
- while (PeekMessage(&msg, winSock.hwnd, 0, 0, PM_REMOVE)) {
- DispatchMessage(&msg);
- }
-
if (infoPtr->lastError) {
*errorCodePtr = infoPtr->lastError;
result = 0;
@@ -1212,8 +1327,7 @@ WaitForSocketEvent(infoPtr, events, errorCodePtr)
/*
* Wait until something happens.
*/
-
- WaitMessage();
+ WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
}
(void) Tcl_SetServiceMode(oldMode);
@@ -1248,9 +1362,9 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
* client socket asynchronously. */
{
SocketInfo *infoPtr;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
@@ -1263,7 +1377,7 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
return NULL;
}
- sprintf(channelName, "sock%d", infoPtr->socket);
+ wsprintfA(channelName, "sock%d", infoPtr->socket);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
@@ -1303,12 +1417,15 @@ Tcl_MakeTcpClientChannel(sock)
ClientData sock; /* The socket to wrap up into a channel. */
{
SocketInfo *infoPtr;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
+ ThreadSpecificData *tsdPtr;
- if (TclHasSockets(NULL) != TCL_OK) {
+ if (TclpHasSockets(NULL) != TCL_OK) {
return NULL;
}
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+
/*
* Set kernel space buffering and non-blocking.
*/
@@ -1317,20 +1434,15 @@ Tcl_MakeTcpClientChannel(sock)
infoPtr = NewSocketInfo((SOCKET) sock);
- /* CYGNUS LOCAL: Set clientChannel. */
- infoPtr->clientChannel = 1;
-
/*
* Start watching for read/write events on the socket.
*/
- /* CYGNUS LOCAL: Select for FD_ACCEPT and FD_CONNECT. */
- infoPtr->selectEvents = (FD_READ | FD_CLOSE | FD_WRITE
- | FD_ACCEPT | FD_CONNECT);
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
- SOCKET_MESSAGE, infoPtr->selectEvents);
+ infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
- sprintf(channelName, "sock%d", infoPtr->socket);
+ wsprintfA(channelName, "sock%d", infoPtr->socket);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
@@ -1365,9 +1477,9 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
ClientData acceptProcData; /* Data for the callback. */
{
SocketInfo *infoPtr;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
@@ -1383,7 +1495,7 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
infoPtr->acceptProc = acceptProc;
infoPtr->acceptProcData = acceptProcData;
- sprintf(channelName, "sock%d", infoPtr->socket);
+ wsprintfA(channelName, "sock%d", infoPtr->socket);
infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) infoPtr, 0);
@@ -1421,62 +1533,86 @@ TcpAccept(infoPtr)
SocketInfo *newInfoPtr;
struct sockaddr_in addr;
int len;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
/*
* Accept the incoming connection request.
*/
len = sizeof(struct sockaddr_in);
- newSocket = (*winSock.accept)(infoPtr->socket, (struct sockaddr *)&addr,
- &len);
+ newSocket = (*winSock.accept)(infoPtr->socket,
+ (struct sockaddr *)&addr,
+ &len);
+
/*
* Clear the ready mask so we can detect the next connection request.
* Note that connection requests are level triggered, so if there is
* a request already pending, a new event will be generated.
*/
+
+ if (newSocket == INVALID_SOCKET) {
+ infoPtr->acceptEventCount = 0;
+ infoPtr->readyEvents &= ~(FD_ACCEPT);
+ return;
+ }
- infoPtr->readyEvents &= ~(FD_ACCEPT);
+ /*
+ * It is possible that more than one FD_ACCEPT has been sent, so an extra
+ * count must be kept. Decrement the count, and reset the readyEvent bit
+ * if the count is no longer > 0.
+ */
+
+ infoPtr->acceptEventCount--;
- if (newSocket == INVALID_SOCKET) {
- return;
+ if (infoPtr->acceptEventCount <= 0) {
+ infoPtr->readyEvents &= ~(FD_ACCEPT);
}
/*
+ * Win-NT has a misfeature that sockets are inherited in child
+ * processes by default. Turn off the inherit bit.
+ */
+
+ SetHandleInformation( (HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0 );
+
+ /*
* Add this socket to the global list of sockets.
*/
-
+
newInfoPtr = NewSocketInfo(newSocket);
-
+
/*
* Select on read/write events and create the channel.
*/
-
+
newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
- (void) (*winSock.WSAAsyncSelect)(newInfoPtr->socket, winSock.hwnd,
- SOCKET_MESSAGE, newInfoPtr->selectEvents);
-
- sprintf(channelName, "sock%d", newInfoPtr->socket);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) newInfoPtr);
+
+ wsprintfA(channelName, "sock%d", newInfoPtr->socket);
newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
- return;
+ Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
+ return;
}
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
- return;
+ Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
+ return;
}
-
+
/*
* Invoke the accept callback procedure.
*/
-
+
if (infoPtr->acceptProc != NULL) {
- (infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
+ (infoPtr->acceptProc) (infoPtr->acceptProcData,
+ newInfoPtr->channel,
(*winSock.inet_ntoa)(addr.sin_addr),
(*winSock.ntohs)(addr.sin_port));
}
@@ -1509,6 +1645,8 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
SocketInfo *infoPtr = (SocketInfo *) instanceData;
int bytesRead;
int error;
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
*errorCodePtr = 0;
@@ -1519,7 +1657,7 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
* use sockets.
*/
- if (winSock.hInstance == NULL) {
+ if (!SocketsEnabled()) {
*errorCodePtr = EFAULT;
return -1;
}
@@ -1551,37 +1689,37 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
*/
while (1) {
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
- 0, 0);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) UNSELECT, (LPARAM) infoPtr);
bytesRead = (*winSock.recv)(infoPtr->socket, buf, toRead, 0);
infoPtr->readyEvents &= ~(FD_READ);
-
+
/*
* Check for end-of-file condition or successful read.
*/
-
+
if (bytesRead == 0) {
infoPtr->flags |= SOCKET_EOF;
}
if (bytesRead != SOCKET_ERROR) {
break;
}
-
+
/*
* If an error occurs after the FD_CLOSE has arrived,
* then ignore the error and report an EOF.
*/
-
+
if (infoPtr->readyEvents & FD_CLOSE) {
infoPtr->flags |= SOCKET_EOF;
bytesRead = 0;
break;
}
-
+
/*
* Check for error condition or underflow in non-blocking case.
*/
-
+
error = (*winSock.WSAGetLastError)();
if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
TclWinConvertWSAError(error);
@@ -1598,11 +1736,12 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
bytesRead = -1;
break;
- }
+ }
}
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
- SOCKET_MESSAGE, infoPtr->selectEvents);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
+
return bytesRead;
}
@@ -1633,6 +1772,8 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
SocketInfo *infoPtr = (SocketInfo *) instanceData;
int bytesWritten;
int error;
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
*errorCodePtr = 0;
@@ -1643,11 +1784,11 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
* use sockets.
*/
- if (winSock.hInstance == NULL) {
+ if (!SocketsEnabled()) {
*errorCodePtr = EFAULT;
return -1;
}
-
+
/*
* Check to see if the socket is connected before trying to write.
*/
@@ -1658,8 +1799,9 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
}
while (1) {
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
- 0, 0);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) UNSELECT, (LPARAM) infoPtr);
+
bytesWritten = (*winSock.send)(infoPtr->socket, buf, toWrite, 0);
if (bytesWritten != SOCKET_ERROR) {
/*
@@ -1708,8 +1850,9 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
}
}
- (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, winSock.hwnd,
- SOCKET_MESSAGE, infoPtr->selectEvents);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
+
return bytesWritten;
}
@@ -1752,7 +1895,7 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
SOCKET sock;
int size = sizeof(struct sockaddr_in);
size_t len = 0;
- char buf[128];
+ char buf[TCL_INTEGER_SPACE];
/*
* Check that WinSock is initialized; do not call it if not, to
@@ -1761,7 +1904,7 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
* use sockets.
*/
- if (winSock.hInstance == NULL) {
+ if (!SocketsEnabled()) {
if (interp) {
Tcl_AppendResult(interp, "winsock is not initialized", NULL);
}
@@ -1774,6 +1917,24 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
len = strlen(optionName);
}
+ if ((len > 1) && (optionName[1] == 'e') &&
+ (strncmp(optionName, "-error", len) == 0)) {
+ int optlen;
+ int err, ret;
+
+ optlen = sizeof(int);
+ ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
+ (char *)&err, &optlen);
+ if (ret == SOCKET_ERROR) {
+ err = (*winSock.WSAGetLastError)();
+ }
+ if (err) {
+ TclWinConvertWSAError(err);
+ Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
+ }
+ return TCL_OK;
+ }
+
if ((len == 0) ||
((len > 1) && (optionName[1] == 'p') &&
(strncmp(optionName, "-peername", len) == 0))) {
@@ -1794,7 +1955,7 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
Tcl_DStringAppendElement(dsPtr,
(*winSock.inet_ntoa)(peername.sin_addr));
}
- sprintf(buf, "%d", (*winSock.ntohs)(peername.sin_port));
+ TclFormatInt(buf, (*winSock.ntohs)(peername.sin_port));
Tcl_DStringAppendElement(dsPtr, buf);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
@@ -1840,7 +2001,7 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
Tcl_DStringAppendElement(dsPtr,
(*winSock.inet_ntoa)(sockname.sin_addr));
}
- sprintf(buf, "%d", (*winSock.ntohs)(sockname.sin_port));
+ TclFormatInt(buf, (*winSock.ntohs)(sockname.sin_port));
Tcl_DStringAppendElement(dsPtr, buf);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
@@ -1901,18 +2062,7 @@ TcpWatchProc(instanceData, mask)
infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
}
if (mask & TCL_WRITABLE) {
- infoPtr->watchEvents |= (FD_WRITE);
- /* CYGNUS LOCAL: For a client channel, also look for FD_CLOSE
- when waiting for a socket to be writable. */
- if (infoPtr->clientChannel) {
- infoPtr->watchEvents |= (FD_CLOSE);
- }
- }
-
- /* CYGNUS LOCAL: For a client channel, also look for FD_CONNECT
- events. */
- if (infoPtr->clientChannel) {
- infoPtr->watchEvents |= (FD_CONNECT);
+ infoPtr->watchEvents |= (FD_WRITE|FD_CONNECT);
}
/*
@@ -1931,7 +2081,7 @@ TcpWatchProc(instanceData, mask)
*
* TcpGetProc --
*
- * Called from Tcl_GetChannelFile to retrieve an OS handle from inside
+ * Called from Tcl_GetChannelHandle to retrieve an OS handle from inside
* a TCP socket based channel.
*
* Results:
@@ -1958,6 +2108,66 @@ TcpGetHandleProc(instanceData, direction, handlePtr)
/*
*----------------------------------------------------------------------
*
+ * SocketThread --
+ *
+ * Helper thread used to manage the socket event handling window.
+ *
+ * Results:
+ * 1 if unable to create socket event window, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+SocketThread(LPVOID arg)
+{
+ MSG msg;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg);
+
+ tsdPtr->hwnd = CreateWindowA("TclSocket", "TclSocket",
+ WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, NULL);
+
+ /*
+ * Signal the main thread that the window has been created
+ * and that the socket thread is ready to go.
+ */
+
+ SetEvent(tsdPtr->readyEvent);
+
+ if (tsdPtr->hwnd == NULL) {
+ return 1;
+ } else {
+ /*
+ * store the tsdPtr, it's from a different thread, so it's
+ * not directly accessible, but needed.
+ */
+
+#ifdef _WIN64
+ SetWindowLongPtr(tsdPtr->hwnd, GWLP_USERDATA, (LONG) tsdPtr);
+#else
+ SetWindowLong(tsdPtr->hwnd, GWL_USERDATA, (LONG) tsdPtr);
+#endif
+ }
+
+ while (1) {
+ /*
+ * Process all outstanding messages on the socket window.
+ */
+
+ while (PeekMessage(&msg, tsdPtr->hwnd, 0, 0, PM_REMOVE)) {
+ DispatchMessage(&msg);
+ }
+ WaitMessage();
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* SocketProc --
*
* This function is called when WSAAsyncSelect has been used
@@ -1984,59 +2194,109 @@ SocketProc(hwnd, message, wParam, lParam)
int event, error;
SOCKET socket;
SocketInfo *infoPtr;
+ ThreadSpecificData *tsdPtr =
+#ifdef _WIN64
+ (ThreadSpecificData *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
+#else
+ (ThreadSpecificData *) GetWindowLong(hwnd, GWL_USERDATA);
+#endif
- if (message != SOCKET_MESSAGE) {
- return DefWindowProc(hwnd, message, wParam, lParam);
- }
-
- event = WSAGETSELECTEVENT(lParam);
- error = WSAGETSELECTERROR(lParam);
- socket = (SOCKET) wParam;
+ switch (message) {
- /*
- * Find the specified socket on the socket list and update its
- * eventState flag.
- */
+ default:
+ return DefWindowProc(hwnd, message, wParam, lParam);
+ break;
+
+ case SOCKET_MESSAGE:
+ event = WSAGETSELECTEVENT(lParam);
+ error = WSAGETSELECTERROR(lParam);
+ socket = (SOCKET) wParam;
- for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
- if (infoPtr->socket == socket) {
/*
- * Update the socket state.
+ * Find the specified socket on the socket list and update its
+ * eventState flag.
*/
- if (event & FD_CLOSE) {
- infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+ WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+ for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->socket == socket) {
+ /*
+ * Update the socket state.
+ */
+
+ /*
+ * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
+ * happens, then clear the FD_ACCEPT count. Otherwise,
+ * increment the count if the current event is and
+ * FD_ACCEPT.
+ */
+
+ if (event & FD_CLOSE) {
+ infoPtr->acceptEventCount = 0;
+ infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+ } else if (event & FD_ACCEPT) {
+ infoPtr->acceptEventCount++;
+ }
+
+ if (event & FD_CONNECT) {
+ /*
+ * The socket is now connected,
+ * clear the async connect flag.
+ */
+
+ infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+ /*
+ * Remember any error that occurred so we can report
+ * connection failures.
+ */
+
+ if (error != ERROR_SUCCESS) {
+ TclWinConvertWSAError(error);
+ infoPtr->lastError = Tcl_GetErrno();
+ }
+
+ }
+ if(infoPtr->flags & SOCKET_ASYNC_CONNECT) {
+ infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+ if (error != ERROR_SUCCESS) {
+ TclWinConvertWSAError(error);
+ infoPtr->lastError = Tcl_GetErrno();
+ }
+ infoPtr->readyEvents |= FD_WRITE;
+ }
+ infoPtr->readyEvents |= event;
+
+ /*
+ * Wake up the Main Thread.
+ */
+ SetEvent(tsdPtr->readyEvent);
+ Tcl_ThreadAlert(tsdPtr->threadId);
+ break;
+ }
}
- if (event & FD_CONNECT) {
- /*
- * The socket is now connected, so clear the async connect
- * flag.
- */
-
- infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+ SetEvent(tsdPtr->socketListLock);
+ break;
+ case SOCKET_SELECT:
+ infoPtr = (SocketInfo *) lParam;
+ if (wParam == SELECT) {
+ (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, hwnd,
+ SOCKET_MESSAGE, infoPtr->selectEvents);
+ } else {
/*
- * Remember any error that occurred so we can report
- * connection failures.
+ * Clear the selection mask
*/
-
- if (error != ERROR_SUCCESS) {
- TclWinConvertWSAError(error);
- infoPtr->lastError = Tcl_GetErrno();
- }
-
- }
- infoPtr->readyEvents |= event;
+
+ (void) (*winSock.WSAAsyncSelect)(infoPtr->socket, hwnd, 0, 0);
+ }
+ break;
+ case SOCKET_TERMINATE:
+ ExitThread(0);
break;
- }
}
- /*
- * Flush the Tcl event queue before returning to the event loop.
- */
-
- Tcl_ServiceAll();
-
return 0;
}
@@ -2062,29 +2322,47 @@ char *
Tcl_GetHostName()
{
DWORD length;
- char *p;
+ WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1];
+
+ Tcl_MutexLock(&socketMutex);
+ InitSockets();
if (hostnameInitialized) {
+ Tcl_MutexUnlock(&socketMutex);
return hostname;
}
+ Tcl_MutexUnlock(&socketMutex);
+
+ if (TclpHasSockets(NULL) == TCL_OK) {
+ /*
+ * INTL: bug
+ */
- if (TclHasSockets(NULL) == TCL_OK) {
if ((*winSock.gethostname)(hostname, sizeof(hostname)) == 0) {
+ Tcl_MutexLock(&socketMutex);
hostnameInitialized = 1;
+ Tcl_MutexUnlock(&socketMutex);
return hostname;
}
}
+ Tcl_MutexLock(&socketMutex);
length = sizeof(hostname);
- if (GetComputerName(hostname, &length) != 0) {
- for (p = hostname; *p != '\0'; p++) {
- if (isupper(*((unsigned char *) p))) {
- *p = (char) tolower(*((unsigned char *) p));
- }
- }
+ if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
+ /*
+ * Convert string from native to UTF then change to lowercase.
+ */
+
+ Tcl_DString ds;
+
+ lstrcpynA(hostname, Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds),
+ sizeof(hostname));
+ Tcl_DStringFree(&ds);
+ Tcl_UtfToLower(hostname);
} else {
hostname[0] = '\0';
}
hostnameInitialized = 1;
+ Tcl_MutexUnlock(&socketMutex);
return hostname;
}
@@ -2107,8 +2385,8 @@ Tcl_GetHostName()
*----------------------------------------------------------------------
*/
-int PASCAL FAR
-TclWinGetSockOpt(SOCKET s, int level, int optname, char FAR * optval,
+int
+TclWinGetSockOpt(SOCKET s, int level, int optname, char * optval,
int FAR *optlen)
{
/*
@@ -2118,15 +2396,15 @@ TclWinGetSockOpt(SOCKET s, int level, int optname, char FAR * optval,
* use sockets.
*/
- if (winSock.hInstance == NULL) {
+ if (!SocketsEnabled()) {
return SOCKET_ERROR;
}
return (*winSock.getsockopt)(s, level, optname, optval, optlen);
}
-int PASCAL FAR
-TclWinSetSockOpt(SOCKET s, int level, int optname, const char FAR * optval,
+int
+TclWinSetSockOpt(SOCKET s, int level, int optname, const char * optval,
int optlen)
{
/*
@@ -2135,15 +2413,14 @@ TclWinSetSockOpt(SOCKET s, int level, int optname, const char FAR * optval,
* handler for WinSock ran before other exit handlers that want to
* use sockets.
*/
-
- if (winSock.hInstance == NULL) {
+ if (!SocketsEnabled()) {
return SOCKET_ERROR;
}
return (*winSock.setsockopt)(s, level, optname, optval, optlen);
}
-u_short PASCAL FAR
+u_short
TclWinNToHS(u_short netshort)
{
/*
@@ -2153,15 +2430,15 @@ TclWinNToHS(u_short netshort)
* use sockets.
*/
- if (winSock.hInstance == NULL) {
+ if (!SocketsEnabled()) {
return (u_short) -1;
}
return (*winSock.ntohs)(netshort);
}
-struct servent FAR * PASCAL FAR
-TclWinGetServByName(const char FAR * name, const char FAR * proto)
+struct servent *
+TclWinGetServByName(const char * name, const char * proto)
{
/*
* Check that WinSock is initialized; do not call it if not, to
@@ -2169,10 +2446,12 @@ TclWinGetServByName(const char FAR * name, const char FAR * proto)
* handler for WinSock ran before other exit handlers that want to
* use sockets.
*/
-
- if (winSock.hInstance == NULL) {
- return (struct servent FAR *) NULL;
+ if (!SocketsEnabled()) {
+ return (struct servent *) NULL;
}
return (*winSock.getservbyname)(name, proto);
}
+
+
+
diff --git a/tcl/win/tclWinTest.c b/tcl/win/tclWinTest.c
index bfb5d2e7152..a66f7b3c50f 100644
--- a/tcl/win/tclWinTest.c
+++ b/tcl/win/tclWinTest.c
@@ -11,15 +11,17 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
+#include "tclWinInt.h"
/*
* Forward declarations of procedures defined later in this file:
*/
-int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
-static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
/*
*----------------------------------------------------------------------
@@ -48,6 +50,8 @@ TclplatformtestInit(interp)
Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
@@ -128,3 +132,61 @@ TesteventloopCmd(clientData, interp, argc, argv)
}
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Testvolumetype --
+ *
+ * This procedure implements the "testvolumetype" command. It is
+ * used to check the volume type (FAT, NTFS) of a volume.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestvolumetypeCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+#define VOL_BUF_SIZE 32
+ int found;
+ char volType[VOL_BUF_SIZE];
+ char *path;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?name?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ /*
+ * path has to be really a proper volume, but we don't
+ * get query APIs for that until NT5
+ */
+ path = Tcl_GetString(objv[1]);
+ } else {
+ path = NULL;
+ }
+ found = GetVolumeInformationA(path, NULL, 0, NULL, NULL,
+ NULL, volType, VOL_BUF_SIZE);
+
+ if (found == 0) {
+ Tcl_AppendResult(interp, "could not get volume type for \"",
+ (path?path:""), "\"", (char *) NULL);
+ TclWinConvertError(GetLastError());
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, volType, TCL_VOLATILE);
+ return TCL_OK;
+#undef VOL_BUF_SIZE
+}
+
+
diff --git a/tcl/win/tclWinThrd.c b/tcl/win/tclWinThrd.c
new file mode 100644
index 00000000000..35fa53ffb48
--- /dev/null
+++ b/tcl/win/tclWinThrd.c
@@ -0,0 +1,914 @@
+/*
+ * tclWinThread.c --
+ *
+ * This file implements the Windows-specific thread operations.
+ *
+ * Copyright (c) 1998 by Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+
+#include <fcntl.h>
+#include <io.h>
+#include <sys/stat.h>
+
+/*
+ * This is the master lock used to serialize access to other
+ * serialization data structures.
+ */
+
+static CRITICAL_SECTION masterLock;
+static int init = 0;
+#define MASTER_LOCK EnterCriticalSection(&masterLock)
+#define MASTER_UNLOCK LeaveCriticalSection(&masterLock)
+
+/*
+ * This is the master lock used to serialize initialization and finalization
+ * of Tcl as a whole.
+ */
+
+static CRITICAL_SECTION initLock;
+
+/*
+ * allocLock is used by Tcl's version of malloc for synchronization.
+ * For obvious reasons, cannot use any dyamically allocated storage.
+ */
+
+static CRITICAL_SECTION allocLock;
+static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock;
+
+/*
+ * Condition variables are implemented with a combination of a
+ * per-thread Windows Event and a per-condition waiting queue.
+ * The idea is that each thread has its own Event that it waits
+ * on when it is doing a ConditionWait; it uses the same event for
+ * all condition variables because it only waits on one at a time.
+ * Each condition variable has a queue of waiting threads, and a
+ * mutex used to serialize access to this queue.
+ *
+ * Special thanks to David Nichols and
+ * Jim Davidson for advice on the Condition Variable implementation.
+ */
+
+/*
+ * The per-thread event and queue pointers.
+ */
+
+typedef struct ThreadSpecificData {
+ HANDLE condEvent; /* Per-thread condition event */
+ struct ThreadSpecificData *nextPtr; /* Queue pointers */
+ struct ThreadSpecificData *prevPtr;
+ int flags; /* See flags below */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * State bits for the thread.
+ * WIN_THREAD_UNINIT Uninitialized. Must be zero because
+ * of the way ThreadSpecificData is created.
+ * WIN_THREAD_RUNNING Running, not waiting.
+ * WIN_THREAD_BLOCKED Waiting, or trying to wait.
+ * WIN_THREAD_DEAD Dying - no per-thread event anymore.
+ */
+
+#define WIN_THREAD_UNINIT 0x0
+#define WIN_THREAD_RUNNING 0x1
+#define WIN_THREAD_BLOCKED 0x2
+#define WIN_THREAD_DEAD 0x4
+
+/*
+ * The per condition queue pointers and the
+ * Mutex used to serialize access to the queue.
+ */
+
+typedef struct WinCondition {
+ CRITICAL_SECTION condLock; /* Lock to serialize queuing on the condition */
+ struct ThreadSpecificData *firstPtr; /* Queue pointers */
+ struct ThreadSpecificData *lastPtr;
+} WinCondition;
+
+static void FinalizeConditionEvent(ClientData data);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateThread --
+ *
+ * This procedure creates a new thread.
+ *
+ * Results:
+ * TCL_OK if the thread could be created. The thread ID is
+ * returned in a parameter.
+ *
+ * Side effects:
+ * A new thread is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
+ Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc proc; /* Main() function of the thread */
+ ClientData clientData; /* The one argument to Main() */
+ int stackSize; /* Size of stack for the new thread */
+ int flags; /* Flags controlling behaviour of
+ * the new thread */
+{
+ HANDLE tHandle;
+
+#ifdef __CYGWIN__
+ tHandle = CreateThread(NULL, (DWORD) stackSize,
+ (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
+ (DWORD) 0, (LPDWORD)idPtr);
+ if (tHandle == NULL) {
+#else
+ tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, proc,
+ clientData, (unsigned) 0, (unsigned *)idPtr);
+ if (tHandle == 0) {
+#endif /* __CYGWIN__ */
+ return TCL_ERROR;
+ } else {
+ CloseHandle(tHandle);
+ return TCL_OK;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadExit --
+ *
+ * This procedure terminates the current thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This procedure terminates the current thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadExit(status)
+ int status;
+{
+#ifdef __CYGWIN__
+ ExitThread((DWORD) status);
+#else
+ _endthreadex((unsigned) status);
+#endif /* __CYGWIN__ */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCurrentThread --
+ *
+ * This procedure returns the ID of the currently running thread.
+ *
+ * Results:
+ * A thread ID.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ThreadId
+Tcl_GetCurrentThread()
+{
+ return (Tcl_ThreadId)GetCurrentThreadId();
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitLock
+ *
+ * This procedure is used to grab a lock that serializes initialization
+ * and finalization of Tcl. On some platforms this may also initialize
+ * the mutex used to serialize creation of more mutexes and thread
+ * local storage keys.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitLock()
+{
+ if (!init) {
+ /*
+ * There is a fundamental race here that is solved by creating
+ * the first Tcl interpreter in a single threaded environment.
+ * Once the interpreter has been created, it is safe to create
+ * more threads that create interpreters in parallel.
+ */
+ init = 1;
+ InitializeCriticalSection(&initLock);
+ InitializeCriticalSection(&masterLock);
+ }
+ EnterCriticalSection(&initLock);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitUnlock
+ *
+ * This procedure is used to release a lock that serializes initialization
+ * and finalization of Tcl.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitUnlock()
+{
+ LeaveCriticalSection(&initLock);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterLock
+ *
+ * This procedure is used to grab a lock that serializes creation
+ * of mutexes, condition variables, and thread local storage keys.
+ *
+ * This lock must be different than the initLock because the
+ * initLock is held during creation of syncronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterLock()
+{
+ if (!init) {
+ /*
+ * There is a fundamental race here that is solved by creating
+ * the first Tcl interpreter in a single threaded environment.
+ * Once the interpreter has been created, it is safe to create
+ * more threads that create interpreters in parallel.
+ */
+ init = 1;
+ InitializeCriticalSection(&initLock);
+ InitializeCriticalSection(&masterLock);
+ }
+ EnterCriticalSection(&masterLock);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetAllocMutex
+ *
+ * This procedure returns a pointer to a statically initialized
+ * mutex for use by the memory allocator. The alloctor must
+ * use this lock, because all other locks are allocated...
+ *
+ * Results:
+ * A pointer to a mutex that is suitable for passing to
+ * Tcl_MutexLock and Tcl_MutexUnlock.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Mutex *
+Tcl_GetAllocMutex()
+{
+#ifdef TCL_THREADS
+ InitializeCriticalSection(&allocLock);
+ return &allocLockPtr;
+#else
+ return NULL;
+#endif
+}
+
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterUnlock
+ *
+ * This procedure is used to release a lock that serializes creation
+ * and deletion of synchronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterUnlock()
+{
+ LeaveCriticalSection(&masterLock);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexLock --
+ *
+ * This procedure is invoked to lock a mutex. This is a self
+ * initializing mutex that is automatically finalized during
+ * Tcl_Finalize.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May block the current thread. The mutex is aquired when
+ * this returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexLock(mutexPtr)
+ Tcl_Mutex *mutexPtr; /* The lock */
+{
+ CRITICAL_SECTION *csPtr;
+ if (*mutexPtr == NULL) {
+ MASTER_LOCK;
+
+ /*
+ * Double inside master lock check to avoid a race.
+ */
+
+ if (*mutexPtr == NULL) {
+ csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
+ InitializeCriticalSection(csPtr);
+ *mutexPtr = (Tcl_Mutex)csPtr;
+ TclRememberMutex(mutexPtr);
+ }
+ MASTER_UNLOCK;
+ }
+ csPtr = *((CRITICAL_SECTION **)mutexPtr);
+ EnterCriticalSection(csPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexUnlock --
+ *
+ * This procedure is invoked to unlock a mutex.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex is released when this returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexUnlock(mutexPtr)
+ Tcl_Mutex *mutexPtr; /* The lock */
+{
+ CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr);
+ LeaveCriticalSection(csPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeMutex --
+ *
+ * This procedure is invoked to clean up one mutex. This is only
+ * safe to call at the end of time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex list is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeMutex(mutexPtr)
+ Tcl_Mutex *mutexPtr;
+{
+ CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;
+ if (csPtr != NULL) {
+ ckfree((char *)csPtr);
+ *mutexPtr = NULL;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyInit --
+ *
+ * This procedure initializes a thread specific data block key.
+ * Each thread has table of pointers to thread specific data.
+ * all threads agree on which table entry is used by each module.
+ * this is remembered in a "data key", that is just an index into
+ * this table. To allow self initialization, the interface
+ * passes a pointer to this key and the first thread to use
+ * the key fills in the pointer to the key. The key should be
+ * a process-wide static.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Will allocate memory the first time this process calls for
+ * this key. In this case it modifies its argument
+ * to hold the pointer to information about the key.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeyInit(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (DWORD **) */
+{
+ DWORD *indexPtr;
+
+ MASTER_LOCK;
+ if (*keyPtr == NULL) {
+ indexPtr = (DWORD *)ckalloc(sizeof(DWORD));
+ *indexPtr = TlsAlloc();
+ *keyPtr = (Tcl_ThreadDataKey)indexPtr;
+ TclRememberDataKey(keyPtr);
+ }
+ MASTER_UNLOCK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyGet --
+ *
+ * This procedure returns a pointer to a block of thread local storage.
+ *
+ * Results:
+ * A thread-specific pointer to the data structure, or NULL
+ * if the memory has not been assigned to this key for this thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID *
+TclpThreadDataKeyGet(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (DWORD **) */
+{
+ DWORD *indexPtr = *(DWORD **)keyPtr;
+ if (indexPtr == NULL) {
+ return NULL;
+ } else {
+ return (VOID *) TlsGetValue(*indexPtr);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeySet --
+ *
+ * This procedure sets the pointer to a block of thread local storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up the thread so future calls to TclpThreadDataKeyGet with
+ * this key will return the data pointer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeySet(keyPtr, data)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+ VOID *data; /* Thread local storage */
+{
+ DWORD *indexPtr = *(DWORD **)keyPtr;
+ TlsSetValue(*indexPtr, (void *)data);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadData --
+ *
+ * This procedure cleans up the thread-local storage. This is
+ * called once for each thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up the memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadData(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ VOID *result;
+ DWORD *indexPtr;
+
+ if (*keyPtr != NULL) {
+ indexPtr = *(DWORD **)keyPtr;
+ result = (VOID *)TlsGetValue(*indexPtr);
+ if (result != NULL) {
+ ckfree((char *)result);
+ TlsSetValue(*indexPtr, (void *)NULL);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadDataKey --
+ *
+ * This procedure is invoked to clean up one key. This is a
+ * process-wide storage identifier. The thread finalization code
+ * cleans up the thread local storage itself.
+ *
+ * This assumes the master lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The key is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadDataKey(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ DWORD *indexPtr;
+ if (*keyPtr != NULL) {
+ indexPtr = *(DWORD **)keyPtr;
+ TlsFree(*indexPtr);
+ ckfree((char *)indexPtr);
+ *keyPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionWait --
+ *
+ * This procedure is invoked to wait on a condition variable.
+ * The mutex is automically released as part of the wait, and
+ * automatically grabbed when the condition is signaled.
+ *
+ * The mutex must be held when this procedure is called.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May block the current thread. The mutex is aquired when
+ * this returns. Will allocate memory for a HANDLE
+ * and initialize this the first time this Tcl_Condition is used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+ Tcl_Condition *condPtr; /* Really (WinCondition **) */
+ Tcl_Mutex *mutexPtr; /* Really (CRITICAL_SECTION **) */
+ Tcl_Time *timePtr; /* Timeout on waiting period */
+{
+ WinCondition *winCondPtr; /* Per-condition queue head */
+ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */
+ DWORD wtime; /* Windows time value */
+ int timeout; /* True if we got a timeout */
+ int doExit = 0; /* True if we need to do exit setup */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->flags & WIN_THREAD_DEAD) {
+ /*
+ * No more per-thread event on which to wait.
+ */
+
+ return;
+ }
+
+ /*
+ * Self initialize the two parts of the contition.
+ * The per-condition and per-thread parts need to be
+ * handled independently.
+ */
+
+ if (tsdPtr->flags == WIN_THREAD_UNINIT) {
+ MASTER_LOCK;
+
+ /*
+ * Create the per-thread event and queue pointers.
+ */
+
+ if (tsdPtr->flags == WIN_THREAD_UNINIT) {
+ tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */,
+ FALSE /* non signaled */, NULL);
+ tsdPtr->nextPtr = NULL;
+ tsdPtr->prevPtr = NULL;
+ tsdPtr->flags = WIN_THREAD_RUNNING;
+ doExit = 1;
+ }
+ MASTER_UNLOCK;
+
+ if (doExit) {
+ /*
+ * Create a per-thread exit handler to clean up the condEvent.
+ * We must be careful do do this outside the Master Lock
+ * because Tcl_CreateThreadExitHandler uses its own
+ * ThreadSpecificData, and initializing that may drop
+ * back into the Master Lock.
+ */
+
+ Tcl_CreateThreadExitHandler(FinalizeConditionEvent,
+ (ClientData) tsdPtr);
+ }
+ }
+
+ if (*condPtr == NULL) {
+ MASTER_LOCK;
+
+ /*
+ * Initialize the per-condition queue pointers and Mutex.
+ */
+
+ if (*condPtr == NULL) {
+ winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition));
+ InitializeCriticalSection(&winCondPtr->condLock);
+ winCondPtr->firstPtr = NULL;
+ winCondPtr->lastPtr = NULL;
+ *condPtr = (Tcl_Condition)winCondPtr;
+ TclRememberCondition(condPtr);
+ }
+ MASTER_UNLOCK;
+ }
+ csPtr = *((CRITICAL_SECTION **)mutexPtr);
+ winCondPtr = *((WinCondition **)condPtr);
+ if (timePtr == NULL) {
+ wtime = INFINITE;
+ } else {
+ wtime = timePtr->sec * 1000 + timePtr->usec / 1000;
+ }
+
+ /*
+ * Queue the thread on the condition, using
+ * the per-condition lock for serialization.
+ */
+
+ tsdPtr->flags = WIN_THREAD_BLOCKED;
+ tsdPtr->nextPtr = NULL;
+ EnterCriticalSection(&winCondPtr->condLock);
+ tsdPtr->prevPtr = winCondPtr->lastPtr; /* A: */
+ winCondPtr->lastPtr = tsdPtr;
+ if (tsdPtr->prevPtr != NULL) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr;
+ }
+ if (winCondPtr->firstPtr == NULL) {
+ winCondPtr->firstPtr = tsdPtr;
+ }
+
+ /*
+ * Unlock the caller's mutex and wait for the condition, or a timeout.
+ * There is a minor issue here in that we don't count down the
+ * timeout if we get notified, but another thread grabs the condition
+ * before we do. In that race condition we'll wait again for the
+ * full timeout. Timed waits are dubious anyway. Either you have
+ * the locking protocol wrong and are masking a deadlock,
+ * or you are using conditions to pause your thread.
+ */
+
+ LeaveCriticalSection(csPtr);
+ timeout = 0;
+ while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
+ ResetEvent(tsdPtr->condEvent);
+ LeaveCriticalSection(&winCondPtr->condLock);
+ if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) {
+ timeout = 1;
+ }
+ EnterCriticalSection(&winCondPtr->condLock);
+ }
+
+ /*
+ * Be careful on timeouts because the signal might arrive right around
+ * time time limit and someone else could have taken us off the queue.
+ */
+
+ if (timeout) {
+ if (tsdPtr->flags & WIN_THREAD_RUNNING) {
+ timeout = 0;
+ } else {
+ /*
+ * When dequeuing, we can leave the tsdPtr->nextPtr
+ * and tsdPtr->prevPtr with dangling pointers because
+ * they are reinitialilzed w/out reading them when the
+ * thread is enqueued later.
+ */
+
+ if (winCondPtr->firstPtr == tsdPtr) {
+ winCondPtr->firstPtr = tsdPtr->nextPtr;
+ } else {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ }
+ if (winCondPtr->lastPtr == tsdPtr) {
+ winCondPtr->lastPtr = tsdPtr->prevPtr;
+ } else {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->flags = WIN_THREAD_RUNNING;
+ }
+ }
+
+ LeaveCriticalSection(&winCondPtr->condLock);
+ EnterCriticalSection(csPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionNotify --
+ *
+ * This procedure is invoked to signal a condition variable.
+ *
+ * The mutex must be held during this call to avoid races,
+ * but this interface does not enforce that.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May unblock another thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionNotify(condPtr)
+ Tcl_Condition *condPtr;
+{
+ WinCondition *winCondPtr;
+ ThreadSpecificData *tsdPtr;
+ if (condPtr != NULL) {
+ winCondPtr = *((WinCondition **)condPtr);
+
+ /*
+ * Loop through all the threads waiting on the condition
+ * and notify them (i.e., broadcast semantics). The queue
+ * manipulation is guarded by the per-condition coordinating mutex.
+ */
+
+ EnterCriticalSection(&winCondPtr->condLock);
+ while (winCondPtr->firstPtr != NULL) {
+ tsdPtr = winCondPtr->firstPtr;
+ winCondPtr->firstPtr = tsdPtr->nextPtr;
+ if (winCondPtr->lastPtr == tsdPtr) {
+ winCondPtr->lastPtr = NULL;
+ }
+ tsdPtr->flags = WIN_THREAD_RUNNING;
+ tsdPtr->nextPtr = NULL;
+ tsdPtr->prevPtr = NULL; /* Not strictly necessary, see A: */
+ SetEvent(tsdPtr->condEvent);
+ }
+ LeaveCriticalSection(&winCondPtr->condLock);
+ } else {
+ /*
+ * Noone has used the condition variable, so there are no waiters.
+ */
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FinalizeConditionEvent --
+ *
+ * This procedure is invoked to clean up the per-thread
+ * event used to implement condition waiting.
+ * This is only safe to call at the end of time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The per-thread event is closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FinalizeConditionEvent(data)
+ ClientData data;
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
+ tsdPtr->flags = WIN_THREAD_DEAD;
+ CloseHandle(tsdPtr->condEvent);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeCondition --
+ *
+ * This procedure is invoked to clean up a condition variable.
+ * This is only safe to call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The condition variable is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeCondition(condPtr)
+ Tcl_Condition *condPtr;
+{
+ WinCondition *winCondPtr = *(WinCondition **)condPtr;
+
+ /*
+ * Note - this is called long after the thread-local storage is
+ * reclaimed. The per-thread condition waiting event is
+ * reclaimed earlier in a per-thread exit handler, which is
+ * called before thread local storage is reclaimed.
+ */
+
+ if (winCondPtr != NULL) {
+ ckfree((char *)winCondPtr);
+ *condPtr = NULL;
+ }
+}
+#endif /* TCL_THREADS */
diff --git a/tcl/win/tclWinThrd.h b/tcl/win/tclWinThrd.h
new file mode 100644
index 00000000000..7ecec1fe8df
--- /dev/null
+++ b/tcl/win/tclWinThrd.h
@@ -0,0 +1,23 @@
+/*
+ * tclWinThrd.h --
+ *
+ * This header file defines things for thread support.
+ *
+ * Copyright (c) 1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclWinThrd.h 1.2 98/01/27 11:48:05
+ */
+
+#ifndef _TCLWINTHRD
+#define _TCLWINTHRD
+
+#ifdef TCL_THREADS
+
+#endif /* TCL_THREADS */
+
+#endif /* _TCLWINTHRD */
+
+
diff --git a/tcl/win/tclWinTime.c b/tcl/win/tclWinTime.c
index c29a9ab9913..746739c98b5 100644
--- a/tcl/win/tclWinTime.c
+++ b/tcl/win/tclWinTime.c
@@ -4,7 +4,7 @@
* Contains Windows specific versions of Tcl functions that
* obtain time values from the operating system.
*
- * Copyright 1995 by Sun Microsystems, Inc.
+ * Copyright 1995-1998 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -12,8 +12,7 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h"
-#include "tclPort.h"
+#include "tclWinInt.h"
#define SECSPERDAY (60L * 60L * 24L)
#define SECSPERYEAR (SECSPERDAY * 365L)
@@ -32,6 +31,12 @@ static int leapDays[] = {
-1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
};
+typedef struct ThreadSpecificData {
+ char tzName[64]; /* Time zone name */
+ struct tm tm; /* time information */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
/*
* Declarations for functions defined later in this file.
*/
@@ -162,14 +167,73 @@ TclpGetTime(timePtr)
*/
char *
-TclpGetTZName()
+TclpGetTZName(int dst)
{
- tzset();
- if (_daylight && _tzname[1] != NULL) {
- return _tzname[1];
- } else {
- return _tzname[0];
+ int len;
+ char *zone, *p;
+ TIME_ZONE_INFORMATION tz;
+ Tcl_Encoding encoding;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ char *name = tsdPtr->tzName;
+
+ /*
+ * tzset() under Borland doesn't seem to set up tzname[] at all.
+ * tzset() under MSVC has the following weird observed behavior:
+ * First time we call "clock format [clock seconds] -format %Z -gmt 1"
+ * we get "GMT", but on all subsequent calls we get the current time
+ * zone string, even though env(TZ) is GMT and the variable _timezone
+ * is 0.
+ */
+
+ name[0] = '\0';
+
+ zone = getenv("TZ");
+ if (zone != NULL) {
+ /*
+ * TZ is of form "NST-4:30NDT", where "NST" would be the
+ * name of the standard time zone for this area, "-4:30" is
+ * the offset from GMT in hours, and "NDT is the name of
+ * the daylight savings time zone in this area. The offset
+ * and DST strings are optional.
+ */
+
+ len = strlen(zone);
+ if (len > 3) {
+ len = 3;
+ }
+ if (dst != 0) {
+ /*
+ * Skip the offset string and get the DST string.
+ */
+
+ p = zone + len;
+ p += strspn(p, "+-:0123456789");
+ if (*p != '\0') {
+ zone = p;
+ len = strlen(zone);
+ if (len > 3) {
+ len = 3;
+ }
+ }
+ }
+ Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name,
+ sizeof(tsdPtr->tzName), NULL, NULL, NULL);
}
+ if (name[0] == '\0') {
+ if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) {
+ /*
+ * MSDN: On NT this is returned if DST is not used in
+ * the current TZ
+ */
+ dst = 0;
+ }
+ encoding = Tcl_GetEncoding(NULL, "unicode");
+ Tcl_ExternalToUtf(NULL, encoding,
+ (char *) ((dst) ? tz.DaylightName : tz.StandardName), -1,
+ 0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL);
+ Tcl_FreeEncoding(encoding);
+ }
+ return name;
}
/*
@@ -191,10 +255,11 @@ TclpGetTZName()
*/
struct tm *
-TclpGetDate(tp, useGMT)
- const time_t *tp;
+TclpGetDate(t, useGMT)
+ TclpTime_t t;
int useGMT;
{
+ const time_t *tp = (const time_t *) t;
struct tm *tmPtr;
long time;
@@ -207,10 +272,11 @@ TclpGetDate(tp, useGMT)
* algorithm ignores daylight savings time before the epoch.
*/
- time = *tp - _timezone;
- if (time >= 0) {
+ if (*tp >= 0) {
return localtime(tp);
}
+
+ time = *tp - _timezone;
/*
* If we aren't near to overflowing the long, just add the bias and
@@ -272,7 +338,7 @@ TclpGetDate(tp, useGMT)
* the epoch (midnight Jan 1 1970).
*
* Results:
- * Returns a statically allocated struct tm.
+ * Returns a (per thread) statically allocated struct tm.
*
* Side effects:
* Updates the values of the static struct tm.
@@ -284,10 +350,13 @@ static struct tm *
ComputeGMT(tp)
const time_t *tp;
{
- static struct tm tm; /* This should be allocated per thread.*/
+ struct tm *tmPtr;
long tmp, rem;
int isLeap;
int *days;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ tmPtr = &tsdPtr->tm;
/*
* Compute the 4 year span containing the specified time.
@@ -327,47 +396,49 @@ ComputeGMT(tp)
}
}
}
- tm.tm_year = tmp;
+ tmPtr->tm_year = tmp;
/*
* Compute the day of year and leave the seconds in the current day in
* the remainder.
*/
- tm.tm_yday = rem / SECSPERDAY;
+ tmPtr->tm_yday = rem / SECSPERDAY;
rem %= SECSPERDAY;
/*
* Compute the time of day.
*/
- tm.tm_hour = rem / 3600;
+ tmPtr->tm_hour = rem / 3600;
rem %= 3600;
- tm.tm_min = rem / 60;
- tm.tm_sec = rem % 60;
+ tmPtr->tm_min = rem / 60;
+ tmPtr->tm_sec = rem % 60;
/*
* Compute the month and day of month.
*/
days = (isLeap) ? leapDays : normalDays;
- for (tmp = 1; days[tmp] < tm.tm_yday; tmp++) {
+ for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) {
}
- tm.tm_mon = --tmp;
- tm.tm_mday = tm.tm_yday - days[tmp];
+ tmPtr->tm_mon = --tmp;
+ tmPtr->tm_mday = tmPtr->tm_yday - days[tmp];
/*
* Compute day of week. Epoch started on a Thursday.
*/
- tm.tm_wday = (*tp / SECSPERDAY) + 4;
+ tmPtr->tm_wday = (*tp / SECSPERDAY) + 4;
if ((*tp % SECSPERDAY) < 0) {
- tm.tm_wday--;
+ tmPtr->tm_wday--;
}
- tm.tm_wday %= 7;
- if (tm.tm_wday < 0) {
- tm.tm_wday += 7;
+ tmPtr->tm_wday %= 7;
+ if (tmPtr->tm_wday < 0) {
+ tmPtr->tm_wday += 7;
}
- return &tm;
+ return tmPtr;
}
+
+
diff --git a/tcl/win/tclWinUtil.c b/tcl/win/tclWinUtil.c
new file mode 100644
index 00000000000..ac2aeb33ddd
--- /dev/null
+++ b/tcl/win/tclWinUtil.c
@@ -0,0 +1,66 @@
+/*
+ * tclWinUtil.c --
+ *
+ * This file contains a collection of utility procedures that
+ * are present in Tcl's Windows core but not in the generic
+ * core. For example, they do file manipulation and process
+ * manipulation.
+ *
+ * Copyright (c) 1994-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.
+ *
+ * SCCS: @(#) tclWinUtil.c 1.9 96/01/16 10:31:48
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitPid --
+ *
+ * Does the waitpid system call.
+ *
+ * Results:
+ * Returns return value of pid it's waiting for.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitPid(pid, statPtr, options)
+ pid_t pid;
+ int *statPtr;
+ int options;
+{
+ int flags;
+ DWORD ret;
+
+ if (options & WNOHANG) {
+ flags = 0;
+ } else {
+ flags = INFINITE;
+ }
+ ret = WaitForSingleObject((HANDLE)pid, flags);
+ if (ret == WAIT_TIMEOUT) {
+ *statPtr = 0;
+ return 0;
+ } else if (ret != WAIT_FAILED) {
+ GetExitCodeProcess((HANDLE)pid, (DWORD*)statPtr);
+ *statPtr = ((*statPtr << 8) & 0xff00);
+ CloseHandle((HANDLE)pid);
+ return pid;
+ } else {
+ errno = ECHILD;
+ return -1;
+ }
+}
+
+
diff --git a/tcl/win/tclsh.ico b/tcl/win/tclsh.ico
new file mode 100644
index 00000000000..8bcaf487096
--- /dev/null
+++ b/tcl/win/tclsh.ico
Binary files differ
diff --git a/tcl/win/tclsh.rc b/tcl/win/tclsh.rc
index b5e1f4e4f56..0df2ed58566 100644
--- a/tcl/win/tclsh.rc
+++ b/tcl/win/tclsh.rc
@@ -3,16 +3,20 @@
// Version
//
+#define VS_VERSION_INFO 1
+
#define RESOURCE_INCLUDED
#include <tcl.h>
+LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */
+
VS_VERSION_INFO VERSIONINFO
FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
FILEFLAGSMASK 0x3fL
FILEFLAGS 0x0L
- FILEOS 0x4L
- FILETYPE 0x1L
+ FILEOS 0x4 /* VOS__WINDOWS32 */
+ FILETYPE 0x2 /* VFT_DLL */
FILESUBTYPE 0x0L
BEGIN
BLOCK "StringFileInfo"
@@ -21,9 +25,9 @@ BEGIN
BEGIN
VALUE "FileDescription", "Tclsh Application\0"
VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".exe\0"
- VALUE "CompanyName", "Sun Microsystems, Inc\0"
+ VALUE "CompanyName", "Scriptics Corporation\0"
VALUE "FileVersion", TCL_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright \251 1995-1996\0"
+ VALUE "LegalCopyright", "Copyright (c) 2000 by Scriptics Corporation\0"
VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
VALUE "ProductVersion", TCL_PATCH_LEVEL
END
@@ -34,3 +38,10 @@ BEGIN
END
END
+//
+// Icon
+//
+
+tclsh ICON DISCARDABLE "tclsh.ico"
+
+